Simple Encryption

•

What is DaniWeb IT Discussion Community?

You're currently browsing the VB.NET section within the Software Development category of DaniWeb, a massive community of 373,565 software developers, web developers, Internet marketers, and tech gurus who are all enthusiastic about making contacts, networking, and learning from each other. In fact, there are 3,844 IT professionals currently interacting right now! Registration is free, only takes a minute and lets you enjoy all of the interactive features of the site.

Join our community!

Please support our VB.NET advertiser:

•

Jun 16th, 2007

Views: 2,126

Fungus1487

below is a very simple encryption class which shows how to encrypt sensitive data (very simply) this example converts a string to hexadecimal form and back again with some simple error handling. please leave some feedback if you find this useful

Show Printable Version

•

vbnet Syntax |

Toggle Plain Text

Public Class clsCrypt
    Public Function Encrypt(ByVal sCrypt As String) As String
        On Error GoTo Err_RaiseErrorClass
        Dim tmp As String
        Dim sVal As String
        Dim l As Long
        For l = 1 To Len(sCrypt)
            sVal = HexValue(Mid(sCrypt, l, 1))
            If Len(sVal) > 4 Then
                If Left(sVal, 4) = "ERR:" Then
                    tmp = sVal
                    Exit For
                End If
            End If
            If Len(sVal) = 1 Then sVal = "0" & sVal
            tmp = tmp & sVal
        Next l
        Encrypt = tmp
Exit_RaiseErrorClass:
        Exit Function
Err_RaiseErrorClass:
        MsgBox(Err.Number & ": " & Err.Description)
        Resume Exit_RaiseErrorClass
    End Function
 
    Public Function Decrypt(ByVal sCrypt As String) As String
        On Error GoTo Err_RaiseErrorClass
        Dim tmp As String
        Dim sVal As String
        Dim str As String
        Dim l As Long
        sVal = UCase(sCrypt)
        Do Until sVal = ""
            If Len(sVal) < 2 Then
                str = ChrValue(sVal)
                If Len(str) > 4 Then
                    If Left(str, 4) = "ERR:" Then
                        tmp = str
                        Exit Do
                    End If
                End If
                tmp = tmp & str
                sVal = ""
            Else
                str = Left(sVal, 2)
                If Left(str, 1) = "0" Then str = Right(str, 1)
                str = ChrValue(str)
                If Len(str) > 4 Then
                    If Left(str, 4) = "ERR:" Then
                        tmp = str
                        Exit Do
                    End If
                End If
                tmp = tmp & str
                sVal = Right(sVal, Len(sVal) - 2)
            End If
        Loop
        Decrypt = tmp
Exit_RaiseErrorClass:
        Exit Function
Err_RaiseErrorClass:
        MsgBox(Err.Number & ": " & Err.Description)
        Resume Exit_RaiseErrorClass
    End Function
 
    Private Function HexValue(ByVal sChr As String) As String
        On Error GoTo Err_HexValue
        Dim iDec As Integer
        iDec = Asc(sChr)
        HexValue = Hex(iDec)
Exit_HexValue:
        Exit Function
Err_HexValue:
        HexValue = "ERR:" & Err.Number
        Resume Exit_HexValue
    End Function
 
    Private Function ChrValue(ByVal sHex As String) As String
        On Error GoTo Err_ChrValue
        Dim sChr As String
        Dim dblVal As Double
        Dim i As Integer
        Const cIdx = 16
        For i = 1 To Len(sHex)
            sChr = Mid(sHex, i, 1)
            If sChr <> " " Then
                If sChr <= "9" Then
                    dblVal = dblVal + CInt(sChr)
                Else
                    dblVal = dblVal + ((Asc(sChr) - 55) Mod 32)
                End If
                If i < Len(sHex) Then dblVal = dblVal * cIdx
            End If
        Next i
        ChrValue = Chr(dblVal)
Exit_ChrValue:
        Exit Function
Err_ChrValue:
        ChrValue = "ERR:" & Err.Number
        Resume Exit_ChrValue
    End Function
End Class

Public Class clsCrypt
    Public Function Encrypt(ByVal sCrypt As String) As String
        On Error GoTo Err_RaiseErrorClass
        Dim tmp As String
        Dim sVal As String
        Dim l As Long
        For l = 1 To Len(sCrypt)
            sVal = HexValue(Mid(sCrypt, l, 1))
            If Len(sVal) > 4 Then
                If Left(sVal, 4) = "ERR:" Then
                    tmp = sVal
                    Exit For
                End If
            End If
            If Len(sVal) = 1 Then sVal = "0" & sVal
            tmp = tmp & sVal
        Next l
        Encrypt = tmp
Exit_RaiseErrorClass:
        Exit Function
Err_RaiseErrorClass:
        MsgBox(Err.Number & ": " & Err.Description)
        Resume Exit_RaiseErrorClass
    End Function

    Public Function Decrypt(ByVal sCrypt As String) As String
        On Error GoTo Err_RaiseErrorClass
        Dim tmp As String
        Dim sVal As String
        Dim str As String
        Dim l As Long
        sVal = UCase(sCrypt)
        Do Until sVal = ""
            If Len(sVal) < 2 Then
                str = ChrValue(sVal)
                If Len(str) > 4 Then
                    If Left(str, 4) = "ERR:" Then
                        tmp = str
                        Exit Do
                    End If
                End If
                tmp = tmp & str
                sVal = ""
            Else
                str = Left(sVal, 2)
                If Left(str, 1) = "0" Then str = Right(str, 1)
                str = ChrValue(str)
                If Len(str) > 4 Then
                    If Left(str, 4) = "ERR:" Then
                        tmp = str
                        Exit Do
                    End If
                End If
                tmp = tmp & str
                sVal = Right(sVal, Len(sVal) - 2)
            End If
        Loop
        Decrypt = tmp
Exit_RaiseErrorClass:
        Exit Function
Err_RaiseErrorClass:
        MsgBox(Err.Number & ": " & Err.Description)
        Resume Exit_RaiseErrorClass
    End Function

    Private Function HexValue(ByVal sChr As String) As String
        On Error GoTo Err_HexValue
        Dim iDec As Integer
        iDec = Asc(sChr)
        HexValue = Hex(iDec)
Exit_HexValue:
        Exit Function
Err_HexValue:
        HexValue = "ERR:" & Err.Number
        Resume Exit_HexValue
    End Function

    Private Function ChrValue(ByVal sHex As String) As String
        On Error GoTo Err_ChrValue
        Dim sChr As String
        Dim dblVal As Double
        Dim i As Integer
        Const cIdx = 16
        For i = 1 To Len(sHex)
            sChr = Mid(sHex, i, 1)
            If sChr <> " " Then
                If sChr <= "9" Then
                    dblVal = dblVal + CInt(sChr)
                Else
                    dblVal = dblVal + ((Asc(sChr) - 55) Mod 32)
                End If
                If i < Len(sHex) Then dblVal = dblVal * cIdx
            End If
        Next i
        ChrValue = Chr(dblVal)
Exit_ChrValue:
        Exit Function
Err_ChrValue:
        ChrValue = "ERR:" & Err.Number
        Resume Exit_ChrValue
    End Function
End Class

Post Comment

•

Only community members can submit or comment on code snippets. You must register or log in to contribute.

•

DaniWeb Marketplace (Sponsored Links)

DaniWeb Home > Code Snippets > vbnet Syntax

Simple Encryption