SimpleCrypt()

Sub SimpleCrypt(PlainText As String, CipherText As String, KeyValue As String)

Dim i As Long, Prev As Integer, Result As String
Dim Char As Integer, KeyIndex As Integer
Dim KeyLen As Integer, TextValue As String
Dim NewChar As Integer, fEncrypting As Integer
Dim KeyChar1() As Integer

'//'Magic values' used for en/decryption. Change these
Const MAGIC1 = 42
Const MAGIC2 = 3

'//Determine if we're encrypting or decrypting
If Len(PlainText) Then
fEncrypting = True
TextValue = PlainText
Else
TextValue = CipherText
End If

'//Initialize 'previous character' value, index into
'//key string and length of key
Prev = MAGIC1: KeyIndex = 1
KeyLen = Len(KeyValue)

'//Convert key string to array
ReDim KeyChar1(Len(KeyValue))
For i = 1 To Len(KeyValue)
KeyChar1(i) = Asc(VBA.Mid(KeyValue, i, 1))
Next i

'//Actual en/decryption loop
For i = 1 To Len(TextValue)
Char = Asc(VBA.Mid(TextValue, i, 1))
NewChar = Char Xor KeyChar1(KeyIndex) Xor Prev Xor ((i / MAGIC2) Mod 255)
Result = Result & VBA.Chr(NewChar)
If fEncrypting Then
Prev = Char
Else
Prev = NewChar
End If
KeyIndex = KeyIndex + 1
If KeyIndex > KeyLen Then KeyIndex = 1
Next i

'//Return result to caller
If fEncrypting Then
CipherText = Result
Else
PlainText = Result
End If

End Sub

 

[Home] [Publications] [Code] [Contact Us] [Legal]