'GeoCrypt Timer: 

Option Public
Option Explicit


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 = "ABCDEFGHIJKLMNOPQRSTUVWXYZABCDEFGHIJKLMabcdefghijklmnopqrstuvwxyzabcdefghijklm"
	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 partial 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
	'** a version of the GeoCache encryption/decryption routine 
	'** that uses a full lookup table to determine if the characters
	'** are valid and what the replacement values should be.
	'** This version also does Instr lookups to skip the parts
	'** of the string that are in brackets.
	'** by Julian Robichaux ( http://www.nsftools.com )
	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