Binaryworld - EncryptString - Encode and decode a string ... [ VB -> String ]

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As _
  Any, source As Any, ByVal bytes As Long)

' encrypt a string using a password
'
' you must reapply the same function (and same password) on
' the encrypted string to obtain the original, non-encrypted string
'
' you get better, more secure results if you use a long password
' (e.g. 16 chars or longer). This routine works well only with ANSI strings.

Function EncryptString(ByVal Text As String, ByVal Password As String) As String
  Dim passLen As Long
  Dim i As Long
  Dim passChr As Integer
  Dim passNdx As Long

  passLen = Len(Password)
  ' null passwords are invalid
  If passLen = 0 Then Err.Raise 5

  ' move password chars into an array of Integers to speed up code
  ReDim passChars(0 To passLen - 1) As Integer
  CopyMemory passChars(0), ByVal StrPtr(Password), passLen * 2

  ' this simple algorithm XORs each character of the string
  ' with a character of the password, but also modifies the
  ' password while it goes, to hide obvious patterns in the
  ' result string
  For i = 1 To Len(Text)
    ' get the next char in the password
    passChr = passChars(passNdx)
    ' encrypt one character in the string
    Mid$(Text, i, 1) = Chr$(Asc(Mid$(Text, i, 1)) Xor passChr)
    ' modify the character in the password (avoid overflow)
    passChars(passNdx) = (passChr + 17) And 255
    ' prepare to use next char in the password
    passNdx = (passNdx + 1) Mod passLen
  Next

  EncryptString = Text

End Function