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