EncryptHex

Function Encrypt_Hex(Action As String, key As String, _
Src As String) As String
Dim Count As Long, KeyPos As Long, KeyLen As Long
Dim SrcAsc As Long
Dim Dest As String, offset As Long, TmpSrcAsc
Dim SrcPos As Long
KeyLen = Len(key)
If Action = "E" Then
Randomize
offset = (Rnd * 10000 Mod 255) + 1
Dest = Hex$(offset)
For SrcPos = 1 To Len(Src)
SrcAsc = (Asc(Mid$(Src, SrcPos, 1)) + offset) Mod 255
If KeyPos < KeyLen Then KeyPos = KeyPos + 1 Else _
KeyPos = 1
SrcAsc = SrcAsc Xor Asc(Mid$(key, KeyPos, 1))
Dest = Dest + Format$(Hex$(SrcAsc), "@@")
offset = SrcAsc
Next
ElseIf Action = "D" Then
offset = Val("&H" + Left$(Src, 2))
For SrcPos = 3 To Len(Src) Step 2
SrcAsc = Val("&H" + Trim(Mid$(Src, SrcPos, 2)))
If KeyPos < KeyLen Then KeyPos = KeyPos + 1 Else _
KeyPos = 1
TmpSrcAsc = SrcAsc Xor Asc(Mid$(key, KeyPos, 1))
If TmpSrcAsc <= offset Then
TmpSrcAsc = 255 + TmpSrcAsc - offset
Else
TmpSrcAsc = TmpSrcAsc - offset
End If
Dest = Dest + Chr(TmpSrcAsc)
offset = SrcAsc
Next
End If
Encrypt_Hex = Dest
End Function

Inputs:
Action="D"(Decrypt) OR "E"(Encrypt)
Key=Password to de/encrypt With
Src=The String to be encrypted

Returns:
Encrypted String