String encryption


Function EncryptString (plainText As String) As String
   Dim encryptedText As String
   Dim stringLen As Integer
   Dim index As Integer
   Dim theByte As Integer


   stringLen = Len(plainText)

   If (stringLen = 0) Then
      EncryptString = ""
   End If

   encryptedText = UCase$(plainText)

   For index = 1 To stringLen
      theByte = Asc(Mid$(encryptedText, index, 1))

      theByte = eXor(stringLen, theByte)

      If (index = 1) Then
         theByte = eXor(&H2A, theByte)
      Else
         theByte = eXor(index - 1, theByte)
         theByte = eXor(Asc(Mid$(encryptedText, index - 1, 1)), theByte)
      End If

      Mid$(encryptedText, index, 1) = Chr$(theByte)
   Next index

   If (stringLen > 1) Then
      For index = stringLen To 1 Step -1
         theByte = Asc(Mid$(encryptedText, index, 1))

         theByte = eXor(stringLen, theByte)

         If (index = stringLen) Then
            theByte = eXor(&H2A, theByte)
         Else
            theByte = eXor(index - 1, theByte)
            theByte = eXor(Asc(Mid$(encryptedText, index + 1, 1)), theByte)
         End If

         Mid$(encryptedText, index, 1) = Chr$(theByte)
      Next index
   End If

   EncryptString = encryptedText

End Function

Function eXor (x1 As Integer, x2 As Integer)

   Select Case (x1 Xor x2)
      Case &H0 To &H20, &H7F To &H90, &H93 To &H9F, &H3D, &H5B, &H5D
         eXor = x2
      Case Else
         eXor = (x1 Xor x2)
   End Select

End Function



Mail to Daniel Wiman <daniel@wimania.com>
Online since June 1996, updated 980315
<- The VB home
<- Daniels homepage