VB6 - Simple ASCII Encryption/Decryption

[vbNeo]

Made this a long time ago, just dug it up - maybe some of you guys can put it to use(Yeah, I know the iKey name's a bit strange considering it's a string)...

Public Sub Encrypt(sString, iKey As String)
Dim iKeyPos As Integer
Dim CurrentLetter As String
Dim sNewString As String
 
iKeyPos = 1
 
For I = 1 To Len(sString)
CurrentLetter = Mid(sString, I, 1)
 
If Not iKeyPos + 1 = Len(iKey) Then
iKeyPos = iKeyPos + 1
If Not Asc(CurrentLetter) + Len(iKey) > 255 Then
CurrentLetter = Chr(Asc(CurrentLetter) + Val(Mid(iKey, iKeyPos, 1)))
Else
 
End If
Else
iKeyPos = 1
If Not Asc(CurrentLetter) + Len(iKey) > 255 Then
CurrentLetter = Chr(Asc(CurrentLetter) + Val(Mid(iKey, iKeyPos, 1)))
Else
 
End If
End If
 
sNewString = sNewString & CurrentLetter
 
Next
 
Encrypt = sNewString
End Sub
 
 
Public Sub Decrypt(sString, iKey As String)
Dim iKeyPos As Integer
Dim CurrentLetter As String
Dim sNewString As String
 
iKeyPos = 1
 
For I = 1 To Len(sString)
CurrentLetter = Mid(sString, I, 1)
 
If Not iKeyPos + 1 = Len(iKey) Then
iKeyPos = iKeyPos + 1
If Not Asc(CurrentLetter) + Len(iKey) > 255 Then
CurrentLetter = Chr(Asc(CurrentLetter) - Val(Mid(iKey, iKeyPos, 1)))
Else
 
End If
Else
iKeyPos = 1
If Not Asc(CurrentLetter) + Len(iKey) > 255 Then
CurrentLetter = Chr(Asc(CurrentLetter) - Val(Mid(iKey, iKeyPos, 1)))
Else
 
End If
End If
 
sNewString = sNewString & CurrentLetter
 
Next
 
Decrypt = sNewString
 
End Sub

Usage example,
Encrypt: Text1.Text = Encrypt(Text1.Text, "123456")

Decrypt: Text1.Text = Decrypt(Text1.Text, "123456")

Considering you want everything done in Text1.Text.

Feel free to use this code anywhere you wish(though I don't think it'll be to much use)


Cheers!