This is an improvement to the tip “Encrypt a String Easily.” I found that the szEncryptDecrypt function in this tip did not handle unicode strings properly, but otherwise worked well. The changes in the following version should work for any string by explicitly converting each character to ASCII and back. As with the other function, this is not strong encryption, but it is fast and will dissuade 99 percent of people.
'simple encryption function obtained from www.devx.com'written by Rob Bovey 'updated by Scott LikelyFunction szEncryptDecrypt(ByVal szData As String, ByVal salt As String, ByVal pepper As String) As String ''' salt is a key value can be changed to alter the ''' encryption, but it must be the same for both ''' encryption and decryption. ''' pepper is optional, and may be any ''' value 0-64. ''' Likewise, it needs to be the same coming/going. Dim bytKey() As Byte Dim bytData() As Byte Dim lNum As Long Dim szKey As String Dim strOutput As String 'use a default key if none given If Len(salt) = 0 Then salt = "123456" 'make sure the key is as long as the text we want to encode For lNum = 1 To ((Len(szData) / Len(salt)) + 1) szKey = szKey & salt Next lNum ReDim bytKey(Len(szData)) As Byte ReDim bytData(Len(szData)) As Byte 'copy the key into the key byte array 'must do it this way to avoid unicode problems 'make it no longer than the text we want to encode For lNum = 1 To Len(szData) bytKey(lNum) = Asc(Mid$(szKey, lNum, 1)) Next lNum 'copy the text we want to encode into the data byte array 'must do it this way to avoid unicode problems For lNum = 1 To Len(szData) bytData(lNum) = Asc(Mid$(szData, lNum, 1)) Next lNum strOutput = "" For lNum = 1 To UBound(bytData) If lNum Mod 2 Then bytData(lNum) = bytData(lNum) Xor (bytKey(lNum) + pepper) strOutput = strOutput & Chr(bytData(lNum)) Else bytData(lNum) = bytData(lNum) Xor (bytKey(lNum) - pepper) strOutput = strOutput & Chr(bytData(lNum)) End If Next lNum szEncryptDecrypt = strOutputEnd Function
