Browse DevX
Sign up for e-mail newsletters from DevX

Tip of the Day
Language: VB4/32,VB5,VB6
Expertise: Intermediate
Nov 9, 2000



Building the Right Environment to Support AI, Machine Learning and Deep Learning

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

    EncryptString = Text
End Function
Francesco Balena
Comment and Contribute






(Maximum characters: 1200). You have 1200 characters left.



Thanks for your registration, follow us on our social networks to keep up-to-date