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

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<)C0n%(+gl-'Y
March Decode:   Unregistered - Evaluation Copy
April Decode:   (]<Z#3lkap}+D\MC{gl|zB

Possibly something that could be used to advantage!

 BAS Module Code

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

Option Explicit
' Copyright 1996-2011 VBnet/Randy Birch, All Rights Reserved.
' 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 = ""

Private Sub Form_Load()

   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 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 Command2.Caption
   Print Tab(5); sEncodedEmail
   Print Tab(5); ConvertData2(sEncodedEmail)
End Sub

Private Function ConvertData(sData As String) As String

  'Schmidt -
   Dim cnt As Long
   Rnd -4
   For cnt = 1 To Len(sData)
      ConvertData = ConvertData & Chr$(Asc(Mid$(sData, cnt)) Xor Rnd * 99)
End Function

Private Function ConvertData2(sData As String) As String

  'Larry Serflaten -
   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


PayPal Link
Make payments with PayPal - it's fast, free and secure!


Copyright 1996-2011 VBnet and Randy Birch. All Rights Reserved.
Terms of Use  |  Your Privacy



Hit Counter