The source code shown below is really a combination of four different files. Start.asp and End.asp are
examples. The Encryption.asp does all of the encrypting/decrypting work, which KeyGen.asp needs only to be
run once, to generate the initial key. (For more information, be sure to read
Encryption with ASP.
<![CDATA[
START.ASP
************************************************************************
<%@ LANGUAGE="VBSCRIPT" %>
<% Response.Buffer = "True" %>
<!--#INCLUDE VIRTUAL="/4Guys/Encryption.asp"-->
<%
'set up our querystring variables to pass to the next file
Script_Language = "Active Server Pages"
Nomination_1 = "4GuysFromRolla.com"
Nomination_2 = "FreeURL.com"
'set up the querystring
Encryption_String = "?SL=" & Script_Language & "&N1=" & Nomination_1 & "&N2=" & Nomination_2
'get key
Encryption_Key = mid(ReadKeyFromFile(Encryption_KeyLocation),1,Len(Encryption_String))
'encrypt the querystring and create new format
ENCRYPTED_CYPHERTEXT = "crypt=" & EnCrypt(Encryption_String)
'Redirect to next page with syntax [page.asp?crypt=youcantseeme]
Response.Redirect "end.asp?" & ENCRYPTED_CYPHERTEXT
%>
************************************************************************
END.ASP
************************************************************************
<%@ LANGUAGE="VBSCRIPT" %>
<% Response.Buffer = "True" %>
<!--#INCLUDE VIRTUAL="/4Guys/Encryption.asp"-->
<%
'retrieve out encrypted querystring info - replace Request.QueryString with request_equerystring
Script_Language = request_equerystring("SL")
Nomination_1 = request_equerystring("N1")
Nomination_2 = request_equerystring("N2")
Response.Write "The Y2K award for top scripting language goes to " & Script_Language & "<br><br>"
Response.Write "The nominations for cool website are: -<br><br>"
Response.Write Nomination_1 & ", " & Nomination_2
%>
************************************************************************
ENCRYPTION.ASP
************************************************************************
<%
Dim Encryption_Key, Encryption_KeyLocation, DECRYPTED_CYPHERTEXT, g_CryptThis
Encryption_KeyLocation = "c:\emmanoble\4Guys\key.txt"
g_CryptThis = request.querystring("crypt")
Encryption_Key = mid(ReadKeyFromFile(Encryption_KeyLocation),1,Len(g_CryptThis))
If Len(g_CryptThis) > 1 then
DECRYPTED_CYPHERTEXT = DeCrypt(g_CryptThis)
End If
Function request_equerystring(GetQueryString)
Dim i,Found_It,Chop_DECRYPTED_CYPHERTEXT,Found_It_Here, TrimExcess
Found_It_Here = 0
TrimExcess = 0
Chop_DECRYPTED_CYPHERTEXT = ""
for i = 0 to Len(GetQueryString)
Found_It = InStr(1, DECRYPTED_CYPHERTEXT, "&" & GetQueryString & "=", 1)
If CInt(Found_It) > 0 then
Found_It_Here = Found_It
TrimExcess = 1
End If
If Found_It_Here < 1 then
Found_It = InStr(1, DECRYPTED_CYPHERTEXT, "?" & GetQueryString & "=", 1)
If (CInt(Found_It) > 0) then
Found_It_Here = Found_It
TrimExcess = 2
End If
End If
if Found_It_Here > 0 then
Chop_DECRYPTED_CYPHERTEXT = Right(DECRYPTED_CYPHERTEXT,(Len(DECRYPTED_CYPHERTEXT))-Found_It-Len(GetQueryString)-TrimExcess)
Found_It = InStr(1, Chop_DECRYPTED_CYPHERTEXT, "&", 1)
if CInt(Found_It) > 0 then
Chop_DECRYPTED_CYPHERTEXT = Left(Chop_DECRYPTED_CYPHERTEXT,Found_It-1)
End If
End If
Next
request_equerystring = Chop_DECRYPTED_CYPHERTEXT
End Function
Function EnCrypt(strCryptThis)
strCryptThis = ChkString(strCryptThis)
Dim strChar, iKeyChar, iStringChar, i
for i = 1 to Len(strCryptThis)
iKeyChar = Asc(mid(Encryption_Key,i,1))
iStringChar = Asc(mid(strCryptThis,i,1))
iCryptChar = iStringChar + iKeyChar
If iCryptChar > 255 then
iCryptChar = iCryptChar - 256
End If
'iCryptChar = iKeyChar Xor iStringChar
strEncrypted = strEncrypted & Chr(iCryptChar)
next
EnCrypt = Server.URLEncode(strEncrypted)
End Function
Function DeCrypt(strEncrypted)
Dim strChar, iKeyChar, iStringChar, i, iDeCryptChar
for i = 1 to Len(strEncrypted)
iKeyChar = (Asc(mid(Encryption_Key,i,1)))
iStringChar = Asc(mid(strEncrypted,i,1))
iDeCryptChar = iStringChar - iKeyChar
'iDeCryptChar = iKeyChar Xor iStringChar
If iDeCryptChar < 0 then
iDeCryptChar = iDeCryptChar + 256
End If
If (iDeCryptChar = 34) or (iDeCryptChar = 39) then
Response.write "We detected a possible encryption ERROR<br>"
Response.write "please contact webmaster@LasVeg.as?subject=Encryption Error:" & g_CryptThis & "<br>"
Response.end
Else
strDecrypted = strDecrypted & Chr(iDeCryptChar)
End If
next
DeCrypt = strDecrypted
End Function
Function ReadKeyFromFile(strFileName)
Dim keyFile, fso, f
set fso = Server.CreateObject("Scripting.FileSystemObject")
set f = fso.GetFile(strFileName)
set ts = f.OpenAsTextStream(1, -2)
Do While not ts.AtEndOfStream
keyFile = keyFile & ts.ReadLine
Loop
ReadKeyFromFile = keyFile
End Function
Function ChkString(string)
If string = "" then
string = " "
End If
ChkString = Replace(string, """", "")
ChkString = Replace(ChkString, "'", "")
End Function
%>
************************************************************************
KEYGEN.ASP
************************************************************************
<%
Const g_KeyLocation = "C:\emmanoble\4Guys\key.txt"
Const g_KeyLen = 512
On Error Resume Next
Call WriteKeyToFile(KeyGeN(g_KeyLen),g_KeyLocation)
if Err <> 0 Then
Response.Write "ERROR GENERATING KEY." & "<P>"
Response.Write Err.Number & "<BR>"
Response.Write Err.Description & "<BR>"
Else
Response.Write "KEY SUCCESSFULLY GENERATED."
End If
Sub WriteKeyToFile(MyKeyString,strFileName)
Dim keyFile, fso
set fso = Server.CreateObject("scripting.FileSystemObject")
set keyFile = fso.CreateTextFile(strFileName, true)
keyFile.WriteLine(MyKeyString)
keyFile.Close
End Sub
Function KeyGeN(iKeyLength)
Dim k, iCount, strMyKey
lowerbound = 35
upperbound = 96
Randomize
for i = 1 to iKeyLength
s = 255
k = Int(((upperbound - lowerbound) + 1) * Rnd + lowerbound)
strMyKey = strMyKey & Chr(k) & ""
next
KeyGeN = strMyKey
End Function
%>
************************************************************************
]]>