EncryptString – Encode and decode a 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

Share the Post:
Share on facebook
Share on twitter
Share on linkedin

Overview

Recent Articles: