Visual Basic Algorithms Pure VB: Simple Algorithms to Obfuscate a String Posted: Thursday March 11, 2004 Updated: Monday December 26, 2011 Applies to: VB3, VB6-16, VB4-32, VB5, VB6 Developed with: VB6, Windows XP OS restrictions: None Author: Larry Serflaten, 'Schmidt', VBnet - Randy Birch
Prerequisites
None.

Obfuscated: To darken; to obscure; to becloud; hence, to confuse; to bewilder. To make so confused or opaque as to be difficult to perceive or understand.

A challenge in the msnews visual basic general discussion newsgroup to generate an algorithm that would obscure an email address to thwart spammers prompted a series of replies. One of the challenge points for the competition was to produce a compact algorithm using the least number of lines.

While most of the solutions centred around converting the address to ASCII representation, either in decimal codes or hex, then converting it back using Mid\$(), Asc() and Chr\$(), two stood out as implementing methodologies that could take any address (or other string for that matter) and "encode/decode" it simply by calling (reusing) the same function.

Larry's method took an email address (S) and scrambled (jumbled) the letters while retaining the string's actual ASCII values. The result was a bogus (and usually invalid) email address which could be restored by running it through the encryption algorithm again.

Schmidt's solution was more elaborate. VB's random number generator was seeded with a fixed number, and the ASCII value of each individual character in the email address was XOR'd with another random number based on this seed. The result was a string totally unrepresentative of the original address, yet passing this string back through the function restored the original information.

The following table shows the original code posted to the newsgroup (and how compact it was):

 Schmidt: S="vx*!jf3s6mu":Rnd-4:for i=1to Len(S):Debug.Print Chr(Asc(Mid(s,i))Xor Rnd*99);:Next Larry: For i = 0 To 5: For j = 1 To 4: Debug.Print Mid\$(S, 4 * i + 5 - j, 1);: Next j, i

I reformatted this basic code to create the callable functions in the routines below which would also accept parameters. It also eases reading/debugging.

An interesting side effect of Schmidt's solution is the effect the initial Rnd -4 has on the routine. If this number is changed between calls (e.g. if you pass a string with Rnd -4, then again with Rnd -5 (or anything else) the string does not decode. This side effect may have positive implications when designing an application for evaluation trial. For example, let's say that rather than the normal 30 day trial period, you decided to restrict trials to the current calendar month. By changing the Rnd -4 to Rnd -Month(Date), the string encoded when the app is first run would only be decoded if the month was the same.  So the string "Unregistered - Evaluation Copy" in March would generate one string, while the same string would generate another in April, or May, or June, etc.:

 Original String: Unregistered - Evaluation Copy March Encode: .juI80bO:4Up;aX<)C0n%(+gl-'Y March Decode: Unregistered - Evaluation Copy April Decode: (]

Possibly something that could be used to advantage!

BAS Module Code
None.

Form Code
On a form, add two command buttons (Command1, Command2) along with the following code:

`Option Explicit`
```''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce
'               or publish this code on any web site,
'               online service, or distribute as source
'               on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''```
```Private Const sDummyEmail = "first.last@somebusiness.com"

Command1.Caption = "Schmidt (encoded)"
Command2.Caption = "Serflaten (jumbled)"

Me.AutoRedraw = True
Print "original string:", sDummyEmail

End Sub

Private Sub Command1_Click()

Dim sEncodedEmail As String

sEncodedEmail = ConvertData(sDummyEmail)

Print
Print Command1.Caption
Print Tab(5); sEncodedEmail
Print Tab(5); ConvertData(sEncodedEmail)

End Sub

Private Sub Command2_Click()

Dim sEncodedEmail As String

sEncodedEmail = ConvertData2(sDummyEmail)

Print
Print Command2.Caption
Print Tab(5); sEncodedEmail
Print Tab(5); ConvertData2(sEncodedEmail)

End Sub

Private Function ConvertData(sData As String) As String

'Schmidt - msnews.microsoft.vb.general.discussion
Dim cnt As Long
Rnd -4
For cnt = 1 To Len(sData)
ConvertData = ConvertData & Chr\$(Asc(Mid\$(sData, cnt)) Xor Rnd * 99)
Next

End Function

Private Function ConvertData2(sData As String) As String

'Larry Serflaten - msnews.microsoft.vb.general.discussion
Dim i As Long
Dim j As Long

For i = 0 To Len(sData) \ 4
For j = 1 To 4
ConvertData2 = ConvertData2 & Mid\$(sData, (4 * i) + 5 - j, 1)
Next j
Next i

End Function```

 Like what you see here? Help ensure continued VB Classic development by making a small PayPal donation today. Thank you. PayPal Link