Option Explicit
Private Const KEY_STRING As String = "this_is_an_insecure_key"
Private Function CaeserCrypt(PlainText As String, ByVal Key As String, Optional ByVal Encrypt As Boolean = True) As String
Dim lonLoop As Long, lonLenKey As Long
Dim lonLen As Long, lonKeyPos As Long
Dim intCur As Integer, intNew As Integer
Dim strRet As String, intCurKey As Integer
lonLen = Len(PlainText)
lonLenKey = Len(Key)
'Loop through plain text.
For lonLoop = 1 To lonLen
lonKeyPos = lonLoop
'If we reach end of key, then start over.
If lonKeyPos > lonLenKey Then
lonKeyPos = 1
End If
'Get current char of plaintext.
intCur = Asc(Mid$(PlainText, lonLoop, 1))
'Get current char of key.
intCurKey = Asc(Mid$(Key, lonKeyPos, 1))
If Encrypt = True Then
'Encrypt the values.
intNew = AddASC(intCur, intCurKey)
Else
'Decrypt the values.
intNew = SubtractASC(intCur, intCurKey)
End If
strRet = strRet & Chr$(intNew)
Next lonLoop
CaeserCrypt = strRet
strRet = ""
End Function
Private Function AddASC(ByVal ASC1 As Integer, ByVal ASC2 As Integer) As Integer
If ASC1 + ASC2 > 255 Then
AddASC = Abs(255 - (ASC1 + ASC2))
Else
AddASC = ASC1 + ASC2
End If
End Function
Private Function SubtractASC(ByVal ASC1 As Integer, ByVal ASC2 As Integer) As Integer
If ASC1 - ASC2 < 0 Then
SubtractASC = 255 + (ASC1 - ASC2)
Else
SubtractASC = ASC1 - ASC2
End If
End Function
Private Sub Form_Load()
Dim strPlain As String, strCrypt As String
Dim strDeCrypt As String
strPlain = "this is some text to encrypt"
MsgBox strPlain, , "Plain Text"
'Encrypt.
strCrypt = CaeserCrypt(strPlain, KEY_STRING, True)
MsgBox strCrypt, , "Encrypted"
'Decrypt.
strDeCrypt = CaeserCrypt(strCrypt, KEY_STRING, False)
MsgBox strDeCrypt, , "Decrypted"
strPlain = ""
strCrypt = ""
strDeCrypt = ""
End Sub