%
'*****************************************************************
' CRYPTOGRAPHY CLASS
'
' Author: Jason Beaudoin
' ColdFire Designs
' http://www.coldfiredesigns.com
'
' Date: 19 October 2011
'
' Addaptation of 4GuysFromRolla
' See: http://www.4guysfromrolla.com/webtech/110599-1.shtml
'*****************************************************************
Class Cryptography
'-----------------------------------------------------------------
' Standard Private Variable Declarations
'-----------------------------------------------------------------
Private m_key
Private m_sessionId
Private m_encryptedString
'-----------------------------------------------------------------
' Initialize the class
'-----------------------------------------------------------------
Private Sub Class_Initialize
m_key = Application("encryptionKey")
m_sessionId = Session("sessionId")
End Sub
'*****************************************************************
' CLASS METHODS
'*****************************************************************
'-----------------------------------------------------------------
' Encrypt
' Requires: strCryptThis (string): the string to encrypt.
'-----------------------------------------------------------------
Public Function Encrypt(ByVal strCryptThis)
Dim strChar, iKeyChar, iStringChar, i,g_Key
Dim strToEncrypt
Dim g_keypos, iCryptChar, iCryptCharHex, iCryptCharHexStr
Dim strEncrypted
Call KeyCheck()
Call stringCheck(strCryptThis)
strToEncrypt = m_sessionId & strCryptThis
g_keypos=0
for i=0 to len(strToEncrypt)
g_Key=g_Key & mid(m_key,1,g_keypos)
g_keypos=g_keypos+1
if g_keypos>len(m_key) Then g_keypos=0
next
for i = 1 to Len(strToEncrypt)
iKeyChar = Asc(mid(g_Key,i,1))
iStringChar = Asc(mid(strToEncrypt,i,1))
iCryptChar = iKeyChar Xor iStringChar
iCryptCharHex = Hex(iCryptChar)
iCryptCharHexStr = cstr(iCryptCharHex)
if len(iCryptCharHexStr)=1 then iCryptCharHexStr = "0" & iCryptCharHexStr
strEncrypted = strEncrypted & iCryptCharHexStr
next
m_encryptedString = strEncrypted
EnCrypt = strEncrypted
End Function
'-----------------------------------------------------------------
' DeCrypt
' Requires: strEncrypted (string): the string to decrypt
'-----------------------------------------------------------------
Public Function DeCrypt(strEncrypted)
Dim strChar, iKeyChar, iStringChar, i,g_Key, varSessionID
Dim LenGKey, g_keypos, iStringChar2, iDeCryptChar, strDecrypted
Call KeyCheck()
'Response.Write "String = " & strEncrypted & "
"
Call stringCheck(strEncrypted)
LenGKey=Len(strEncrypted)/2
g_keypos=0
For i=0 to LenGKey
g_Key=g_Key & mid(m_key,1,g_keypos)
g_keypos=g_keypos+1
if g_keypos>len(m_key) Then g_keypos=0
Next
for i = 1 to Len(strEncrypted) /2
iKeyChar = (Asc(mid(g_Key,i,1)))
iStringChar2 = mid(strEncrypted,(i*2)-1,2)
iStringChar = CLng("&H" & iStringChar2)
iDeCryptChar = iKeyChar Xor iStringChar
strDecrypted = strDecrypted & chr(iDeCryptChar)
next
DeCrypt = Replace(strDecrypted, m_sessionId, "")
End Function
'*****************************************************************
' PRIVATE FUNCTIONS
'*****************************************************************
'-----------------------------------------------------------------
' KeyCheck
' Ensures that there is a encryption key
'-----------------------------------------------------------------
Private Function keyCheck()
If m_key = "" Then Response.Write "Error: No encryption key was provided.":Response.End()
End Function
'-----------------------------------------------------------------
' StringCheck
' Ensures that there is a string to encrypt or decrypt
'-----------------------------------------------------------------
Private Function stringCheck(myString)
If myString = "" Then Response.Write "Error: No string was provided for encryption.":Response.End()
End Function
Public Function EncryptList(arr())
Dim x
For x = 0 To UBound(arr)
execute(arr(x) & " = Encrypt(arr(x))")
Next
End Function
Public Function DecryptList(arr())
Dim x
For x = 0 To UBound(arr)
execute(arr(x) & " = Decrypt(arr(x))")
Next
End Function
'*****************************************************************
' PUBLIC PROPERTIES
'*****************************************************************
Property Let key(value)
m_key = value
End Property
Property Get encryptedString()
encryptedString = m_encryptedString
End Property
Property Let GUID(value)
m_sessionId = value
End Property
Property Get GUID()
GUID = m_sessionId
End Property
End Class
%>