I've gone through the many different solutions you clever programmers
sent in to solve the Geocaching encryption/decryption puzzle. When I
wrote the code, I had several different variations in mind. However,
the fastest method I could find from those you sent in was one that I
didn't consider.
I'm going to include some code sent in by Julian Robichaux. It includes
six different variants and tests their speed, so you can see for
yourself which technique is the fastest. It's a bit long, but here's
the code:
Sub Initialize
'** do a simple timing test to try to calculate the speed of
'** various GeoCache encryption/decryption routines
Dim str1 As String, str2 As String
Dim foo1 As String, foo2 As String
Dim i As Integer, iterations As Integer
Dim startTime As Single
Dim elapsedTime As Single
str1 = "Wnzrf [No middle name] Ubbcrf"
str2 = "James [No middle name] Hoopes"
iterations = 1000
startTime! = Timer()
For i = 1 To iterations
foo1 = GeoCrypt1(str1)
foo2 = GeoCrypt1(str2)
Next
Print "Time Elapsed 1: " & Round(Timer() - startTime!, 2) & " seconds"
If (foo1 <> str2) Or (foo2 <> str1) Then
Print "Function did not return valid results!"
End If
startTime! = Timer()
For i = 1 To iterations
foo1 = GeoCrypt2(str1)
foo2 = GeoCrypt2(str2)
Next
Print "Time Elapsed 2: " & Round(Timer() - startTime!, 2) & " seconds"
If (foo1 <> str2) Or (foo2 <> str1) Then
Print "Function did not return valid results!"
End If
startTime! = Timer()
For i = 1 To iterations
foo1 = GeoCrypt3(str1)
foo2 = GeoCrypt3(str2)
Next
Print "Time Elapsed 3: " & Round(Timer() - startTime!, 2) & " seconds"
If (foo1 <> str2) Or (foo2 <> str1) Then
Print "Function did not return valid results!"
End If
startTime! = Timer()
For i = 1 To iterations
foo1 = GeoCrypt4(str1)
foo2 = GeoCrypt4(str2)
Next
Print "Time Elapsed 4: " & Round(Timer() - startTime!, 2) & " seconds"
If (foo1 <> str2) Or (foo2 <> str1) Then
Print "Function did not return valid results!"
End If
startTime! = Timer()
For i = 1 To iterations
foo1 = GeoCrypt5(str1)
foo2 = GeoCrypt5(str2)
Next
Print "Time Elapsed 5: " & Round(Timer() - startTime!, 2) & " seconds"
If (foo1 <> str2) Or (foo2 <> str1) Then
Print "Function did not return valid results!"
End If
startTime! = Timer()
For i = 1 To iterations
foo1 = GeoCrypt6(str1)
foo2 = GeoCrypt6(str2)
Next
Print "Time Elapsed 6: " & Round(Timer() - startTime!, 2) & " seconds"
If (foo1 <> str2) Or (foo2 <> str1) Then
Print "Function did not return valid results!"
End If
End Sub
Function GeoCrypt1 (txt As String) As String
'** Jim Hoopes' original encryption/decryption routine
Dim iCount As Integer
Dim iCount2 As Integer
Dim strDecrypt As String
Dim strCode As String
Dim strCurrChar As String
Dim strDecryptChar As String
Dim strDecrypted As String
Dim iSkip As Integer
strCode="NOPQRSTUVWXYZABCDEFGHIJKLMABCDEFGHIJKLMNOPQRSTUVWXYZ"
iSkip=False
strDecrypt=txt
For iCount=1 To Len(strDecrypt)
strCurrChar=Mid$(strDecrypt,iCount,1)
strDecryptChar=""
If strCurrChar="[" Then iSkip=True
If strCurrChar="]" Then iSkip=False
If Not iSkip Then
For icount2=1 To 26
If Ucase$(strCurrChar)=Mid$(strCode,iCount2,1) Then
If Ucase$(strCurrChar)=strCurrChar Then
strDecryptChar=Mid$(strCode,iCount2+26,1)
Else
strDecryptChar=Lcase$(Mid$(strCode,iCount2+26,1))
End If
End If
Next iCount2
End If
If (iCount2=27 And strDecryptChar="") Or iSkip Then
strDecryptChar=strCurrChar
End If
strDecrypted=strDecrypted+strDecryptChar
Next iCount
GeoCrypt1 = strDecrypted
End Function
Function GeoCrypt2 (txt As String) As String
'** a simple rewrite of Jim's routine, using Mod just for fun
'** by Julian Robichaux ( http://www.nsftools.com )
Dim letters As String
Dim char As String
Dim newChar As String
Dim newTxt As String
Dim skip As Integer
Dim i As Integer
Dim pos As Integer
letters = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
For i = 1 To Len(txt)
char = Mid$(txt, i, 1)
newChar = char
If (char = "[") Or (char = "]") Then
skip = Not skip
End If
If Not skip Then
pos = Instr(1, letters, char, 5)
If (pos > 0) Then
newChar = Mid$(letters, ((pos + 12) Mod 26) + 1, 1)
If (char = Lcase(char)) Then
newChar = Lcase(newChar)
End If
End If
End If
newTxt = newTxt & newChar
Next
GeoCrypt2 = newTxt
End Function
Function GeoCrypt3 (txt As String) As String
'** a version of the GeoCache encryption/decryption routine
'** that uses Instr to determine whether or not a letter is valid,
'** and then uses Mid to calculate the replacement letter
'** by Julian Robichaux ( http://www.nsftools.com )
Dim letters As String
Dim char As String
Dim newTxt As String
Dim skip As Integer
Dim i As Integer
Dim pos As Integer
newTxt = txt
letters =
"ABCDEFGHIJKLMNOPQRSTUVWXYZABCDEFGHIJKLMabcdefghijklmnopqrstuvwxyzabcde
fghijklm"
For i = 1 To Len(txt)
char = Mid$(txt, i, 1)
If Not skip Then
pos = Instr(1, letters, char, 0)
If (pos > 0) Then
Mid$(newTxt, i, 1) = Mid$(letters, pos + 13, 1)
Elseif (char = "[") Then
skip = True
End If
Elseif (char = "]") Then
skip = False
End If
Next
GeoCrypt3 = newTxt
End Function
Function GeoCrypt4 (txt As String) As String
'** a version of the GeoCache encryption/decryption routine
'** that uses ASCII representations of the characters to determine
'** if they're valid and what the replacement values should be
'** (numerical comparisons and operations are often faster than
'** using Strings)
'** by Julian Robichaux ( http://www.nsftools.com )
Dim ascChar As Integer
Dim newTxt As String
Dim skip As Integer
Dim i As Integer
newTxt = txt
For i = 1 To Len(txt)
ascChar = Asc(Mid$(txt, i, 1))
If Not skip Then
Select Case ascChar
Case 97 To 122 :
'** lower case letter (most common case, check this
first)
Mid$(newTxt, i, 1) = Chr$( ((ascChar - 97 + 13) Mod
26) + 97 )
Case 65 To 90 :
'** upper case letter
Mid$(newTxt, i, 1) = Chr$( ((ascChar - 65 + 13) Mod
26) + 65 )
Case 91 :
'** 91 is "["
skip = True
End Select
Elseif (ascChar = 93) Then
'** 93 is "]"
skip = False
End If
Next
GeoCrypt4 = newTxt
End Function
Function GeoCrypt5 (txt As String) As String
'** a version of the GeoCache encryption/decryption routine
'** that uses a lookup table to determine if the characters are
'** valid and what the replacement values should be
'** by Julian Robichaux ( http://www.nsftools.com )
Dim ascChar As Integer
Dim newTxt As String
Dim skip As Integer
Dim i As Integer
Static lookupTable(122) As String
If (lookupTable(65) = "") Then
'** populate the lookup table, if necessary
For i = 65 To 90
lookupTable(i) = Chr$( ((i - 65 + 13) Mod 26) + 65 )
lookupTable(i+32) = Chr$( ((i + 32 - 97 + 13) Mod 26) + 97
)
Next
End If
newTxt = txt
For i = 1 To Len(txt)
ascChar = Asc(Mid$(txt, i, 1))
If Not skip Then
Select Case ascChar
Case 97 To 122 :
'** lower case letter (most common case, check this
first)
Mid$(newTxt, i, 1) = lookupTable(ascChar)
Case 65 To 90 :
'** upper case letter
Mid$(newTxt, i, 1) = lookupTable(ascChar)
Case 91 :
'** 91 is "["
skip = True
End Select
Elseif (ascChar = 93) Then
'** 93 is "]"
skip = False
End If
Next
GeoCrypt5 = newTxt
End Function
Function GeoCrypt6 (txt As String) As String
On Error 9 Resume Next
Dim bracketPos As Integer
Dim endBracketPos As Integer
Dim i As Integer
Static lookupTable(255) As String
If (lookupTable(0) = "") Then
'** populate the lookup table, if necessary
For i = 0 To 255
lookupTable(i) = Chr$(i)
Next
For i = 0 To 25
lookupTable(i+65) = Chr$( ((i + 13) Mod 26) + 65 )
lookupTable(i+97) = Chr$( ((i + 13) Mod 26) + 97 )
Next
End If
GeoCrypt6 = txt
bracketPos = Instr(txt, "[")
endBracketPos = 0
While (bracketPos > 0)
For i = (endBracketPos+1) To (bracketPos-1)
Mid$(GeoCrypt6, i) = lookupTable(Asc(Mid$(txt, i, 1)))
Next
endBracketPos = Instr(bracketPos, txt, "]")
If (endBracketPos = 0) Then
endBracketPos = Len(txt)
End If
bracketPos = Instr(endBracketPos, txt, "[")
Wend
For i = (endBracketPos+1) To Len(txt)
Mid$(GeoCrypt6, i) = lookupTable(Asc(Mid$(txt, i, 1)))
Next
End Function
Several people came up with the solution that ran the fastest in
Julian's code. I'm including Julian's code because it was the easiest
way to demonstrate which was fastest side-by-side. Thanks Julian! And
thanks to everyone who sent in solutions! I'll be talking more about
some of the other clever ideas you came up with in future columns.
--James Hoopes, e-Pro Magazine Senior Technical Editor
previous page
|