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
Simple Encryption
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
formulav8 0 Newbie Poster
I noticed alot of your code is legacy VB 6.0 based code. I would optimize it for .NET which should have a positive impact and probably increase performance as well. Maybe use Try/Catch/Finally/End Try error handling as well.
Otherwise it looks pretty good.
Jason
yangski 0 Newbie Poster
can you please post a comment maybe per line? about what each line does so that beginners, like me, could understand.. :) hehehe.. thanks.
enelramon 0 Newbie Poster
Public Class HexCrypt
Public Shared Function StringToHex(ByVal sCrypt As String) As String
Dim Retorno As String = ""
Dim sVal As String
Dim l As Long
Try
For l = 1 To Len(sCrypt)
sVal = CharToHex(Mid(sCrypt, l, 1))
'El valor hex debe tener una logitud mayor que 1.
Retorno = Retorno & IIf(Len(sVal) = 1, "0", "") & sVal
Next l
Catch ex As Exception
End Try
Return Retorno
End Function
Public Shared Function HexToString(ByVal sCrypt As String) As String
Dim Retorno As String = ""
Dim sVal As String
Dim str As String
Dim l As Long = 0
sVal = sCrypt.ToUpper
Try
Do Until sVal = ""
If Len(sVal) < 2 Then
str = HexToChar(sVal)
Retorno = Retorno & str
sVal = ""
Else
str = Left(sVal, 2)
If Left(str, 1) = "0" Then str = Right(str, 1)
str = HexToChar(str)
Retorno = Retorno & str
sVal = Right(sVal, Len(sVal) - 2)
End If
Loop
Catch ex As Exception
End Try
Return Retorno
End Function
Private Shared Function CharToHex(ByVal sChr As Char) As String
Return Hex(Asc(sChr))
End Function
Private Shared Function HexToChar(ByVal sHex As String) As String
Return Convert.ToInt32(sHex, 16)
End Function
End Class Be a part of the DaniWeb community
We're a friendly, industry-focused community of developers, IT pros, digital marketers, and technology enthusiasts meeting, networking, learning, and sharing knowledge.