<%
Dim EncryptionUtils : Set EncryptionUtils = New Utils_EncryptionUtils
''
' Uncomment the next line to test the encryption facilities
'EncryptionUtils.TestEncryptions
''
' MD5
' MD5 is one of a series of message digest algorithms.
' It is a one way encryption, and although not the securest form of
' encrytion it can be used for simple encrytion to pass unreadable data
' into the database to store passwords and other second security rated
' information. This should not be used to store credit card details or
' other personal information.
'
' Derived from the RSA Data Security, Inc. MD5 Message-Digest Algorithm,
' as set out in the memo RFC1321.
' MD5 algorithm is one of the industry standard methods for generating digital
' signatures. It is generically known as a digest, digital signature, one-way
' encryption, hash or checksum algorithm. A common use for MD5 is for password
' encryption as it is one-way in nature, that does not mean that your passwords
' are not free from a dictionary attack.
'
'
' RC4
' RC4 generates a pseudorandom stream of bits (a "keystream") which, for
' encryption, is combined with the plaintext using XOR as with any
' Vernam cipher; decryption is performed the same way. To generate the
' keystream, the cipher makes use of a secret internal state which
' consists of two parts:
' A permutation of all 256 possible bytes (denoted "cipher" below).
' Two 8-bit index-pointers (denoted "i" and "j").
'
'
' SHA1
' The SHA (Secure Hash Algorithm) family is a set of related cryptographic hash functions.
' The most commonly used function in the family, SHA-1, is employed in a large variety of
' popular security applications and protocols, including TLS, SSL, PGP, SSH, S/MIME, and
' IPSec. SHA-1 was considered to be the successor to MD5, an earlier, widely-used hash function.
' The encryption is one way, and is a slightly stronger variation from MD5, although
' it requires a little more processing time, this could be used for small series of calculations
'
'
' AES
' Advanced Encryption Standard (AES), also known as Rijndael, is a block cipher
' adopted as an encryption standard by the U.S. government. It is expected to be
' used worldwide and analysed extensively, as was the case with its predecessor,
' the Data Encryption Standard (DES).
'
' AES operates on a 4? array of bytes, termed the state (versions of Rijndael
' with a larger block size have additional columns in the state). For encryption,
' each round of AES (except the last round) consists of four stages:
' AddRoundKey ?each byte of the state is combined with the round key; each
' round key is derived from the cipher key using a key schedule.
' SubBytes ? a non-linear substitution step where each byte is replaced with
' another according to a lookup table.
' ShiftRows ? a transposition step where each row of the state is shifted
' cyclically a certain number of steps.
' MixColumns ?a mixing operation which operates on the columns of the state,
' combining the four bytes in each column using a linear transformation.
'
Const BITS_TO_A_BYTE = 8
Const BYTES_TO_A_WORD = 4
Const BITS_TO_A_WORD = 32
Class Utils_EncryptionUtils
''
' RC4 Variables
Private sbox(255)
Private key(255)
''
' MD5 stuff
Private m_lOnBits(30)
Private m_l2Power(30)
Private m_InCo(3)
Private m_byt2Power(7)
Private m_bytOnBits(7)
Private m_fbsub(255)
Private m_rbsub(255)
Private m_ptab(255)
Private m_ltab(255)
Private m_ftable(255)
Private m_rtable(255)
Private m_rco(29)
Private m_Nk
Private m_Nb
Private m_Nr
Private m_fi(23)
Private m_ri(23)
Private m_fkey(119)
Private m_rkey(119)
Private Sub Class_Initialize
m_lOnBits(0) = CLng(1)
m_lOnBits(1) = CLng(3)
m_lOnBits(2) = CLng(7)
m_lOnBits(3) = CLng(15)
m_lOnBits(4) = CLng(31)
m_lOnBits(5) = CLng(63)
m_lOnBits(6) = CLng(127)
m_lOnBits(7) = CLng(255)
m_lOnBits(8) = CLng(511)
m_lOnBits(9) = CLng(1023)
m_lOnBits(10) = CLng(2047)
m_lOnBits(11) = CLng(4095)
m_lOnBits(12) = CLng(8191)
m_lOnBits(13) = CLng(16383)
m_lOnBits(14) = CLng(32767)
m_lOnBits(15) = CLng(65535)
m_lOnBits(16) = CLng(131071)
m_lOnBits(17) = CLng(262143)
m_lOnBits(18) = CLng(524287)
m_lOnBits(19) = CLng(1048575)
m_lOnBits(20) = CLng(2097151)
m_lOnBits(21) = CLng(4194303)
m_lOnBits(22) = CLng(8388607)
m_lOnBits(23) = CLng(16777215)
m_lOnBits(24) = CLng(33554431)
m_lOnBits(25) = CLng(67108863)
m_lOnBits(26) = CLng(134217727)
m_lOnBits(27) = CLng(268435455)
m_lOnBits(28) = CLng(536870911)
m_lOnBits(29) = CLng(1073741823)
m_lOnBits(30) = CLng(2147483647)
m_l2Power(0) = CLng(1)
m_l2Power(1) = CLng(2)
m_l2Power(2) = CLng(4)
m_l2Power(3) = CLng(8)
m_l2Power(4) = CLng(16)
m_l2Power(5) = CLng(32)
m_l2Power(6) = CLng(64)
m_l2Power(7) = CLng(128)
m_l2Power(8) = CLng(256)
m_l2Power(9) = CLng(512)
m_l2Power(10) = CLng(1024)
m_l2Power(11) = CLng(2048)
m_l2Power(12) = CLng(4096)
m_l2Power(13) = CLng(8192)
m_l2Power(14) = CLng(16384)
m_l2Power(15) = CLng(32768)
m_l2Power(16) = CLng(65536)
m_l2Power(17) = CLng(131072)
m_l2Power(18) = CLng(262144)
m_l2Power(19) = CLng(524288)
m_l2Power(20) = CLng(1048576)
m_l2Power(21) = CLng(2097152)
m_l2Power(22) = CLng(4194304)
m_l2Power(23) = CLng(8388608)
m_l2Power(24) = CLng(16777216)
m_l2Power(25) = CLng(33554432)
m_l2Power(26) = CLng(67108864)
m_l2Power(27) = CLng(134217728)
m_l2Power(28) = CLng(268435456)
m_l2Power(29) = CLng(536870912)
m_l2Power(30) = CLng(1073741824)
m_InCo(0) = &HB
m_InCo(1) = &HD
m_InCo(2) = &H9
m_InCo(3) = &HE
m_bytOnBits(0) = 1
m_bytOnBits(1) = 3
m_bytOnBits(2) = 7
m_bytOnBits(3) = 15
m_bytOnBits(4) = 31
m_bytOnBits(5) = 63
m_bytOnBits(6) = 127
m_bytOnBits(7) = 255
m_byt2Power(0) = 1
m_byt2Power(1) = 2
m_byt2Power(2) = 4
m_byt2Power(3) = 8
m_byt2Power(4) = 16
m_byt2Power(5) = 32
m_byt2Power(6) = 64
m_byt2Power(7) = 128
End Sub
Private Sub Class_Terminate
End Sub
Function TestEncryptions
Dim PlainText : PlainText = "Some Plain Text"
Dim CypherKey : CypherKey = "A Cypher Key"
Response.Write "<p>Plain Text: '" & PlainText & "'<br />"
Response.Write "Cypher Key: '" & CypherKey & "'</p>"
Response.Write "<p>MD5:<br />" & MD5(PlainText) & "</p>"
Response.Write "<p>SHA1:<br />" & SHA1(PlainText) & "</p>"
Response.Write "<p>- RC4 Encryption -<br />"
Dim RC4EnStr : RC4EnStr = RC4(PlainText, CypherKey)
Response.Write "Encrypted: " & RC4EnStr & "<br />"
Response.Write "Decrypted: " & RC4(RC4EnStr, CypherKey) & "</p>"
Response.Write "<p>- AES Encryption -<br />"
Dim AESEnStr : AESEnStr = AESEncyptString(PlainText, CypherKey)
Response.Write "Encrypted: " & AESEnStr & "<br />"
Response.Write "Decrypted: " & AESDecyptString(AESEnStr, CypherKey) & "</p>"
' Just use AESEncrypt or AESDecrypt if you want to deal with bytes for database transactions
End Function
Private Function AddUnsigned(lX, lY)
Dim lX4
Dim lY4
Dim lX8
Dim lY8
Dim lResult
lX8 = lX And &H80000000
lY8 = lY And &H80000000
lX4 = lX And &H40000000
lY4 = lY And &H40000000
lResult = (lX And &H3FFFFFFF) + (lY And &H3FFFFFFF)
If lX4 And lY4 Then
lResult = lResult Xor &H80000000 Xor lX8 Xor lY8
ElseIf lX4 Or lY4 Then
If lResult And &H40000000 Then
lResult = lResult Xor &HC0000000 Xor lX8 Xor lY8
Else
lResult = lResult Xor &H40000000 Xor lX8 Xor lY8
End If
Else
lResult = lResult Xor lX8 Xor lY8
End If
AddUnsigned = lResult
End Function
Private Function G(x, y, z)
G = (x And z) Or (y And (Not z))
End Function
Private Function H(x, y, z)
H = (x Xor y Xor z)
End Function
Private Function I(x, y, z)
I = (y Xor (x Or (Not z)))
End Function
Private Function MD5F(x, y, z)
MD5F = (x And y) Or ((Not x) And z)
End Function
Private Sub FF(a, b, c, d, x, s, ac)
a = AddUnsigned(a, AddUnsigned(AddUnsigned(MD5F(b, c, d), x), ac))
a = RotateLeft(a, s)
a = AddUnsigned(a, b)
End Sub
Private Sub GG(a, b, c, d, x, s, ac)
a = AddUnsigned(a, AddUnsigned(AddUnsigned(G(b, c, d), x), ac))
a = RotateLeft(a, s)
a = AddUnsigned(a, b)
End Sub
Private Sub HH(a, b, c, d, x, s, ac)
a = AddUnsigned(a, AddUnsigned(AddUnsigned(H(b, c, d), x), ac))
a = RotateLeft(a, s)
a = AddUnsigned(a, b)
End Sub
Private Sub II(a, b, c, d, x, s, ac)
a = AddUnsigned(a, AddUnsigned(AddUnsigned(I(b, c, d), x), ac))
a = RotateLeft(a, s)
a = AddUnsigned(a, b)
End Sub
Private Function ConvertToWordArray(sMessage)
Dim lMessageLength
Dim lNumberOfWords
Dim lWordArray()
Dim lBytePosition
Dim lByteCount
Dim lWordCount
Const MODULUS_BITS = 512
Const CONGRUENT_BITS = 448
lMessageLength = Len(sMessage)
lNumberOfWords = (((lMessageLength + ((MODULUS_BITS - CONGRUENT_BITS) \ BITS_TO_A_BYTE)) \ (MODULUS_BITS \ BITS_TO_A_BYTE)) + 1) * (MODULUS_BITS \ BITS_TO_A_WORD)
ReDim lWordArray(lNumberOfWords - 1)
lBytePosition = 0
lByteCount = 0
Do Until lByteCount >= lMessageLength
lWordCount = lByteCount \ BYTES_TO_A_WORD
lBytePosition = (lByteCount Mod BYTES_TO_A_WORD) * BITS_TO_A_BYTE
lWordArray(lWordCount) = lWordArray(lWordCount) Or LShift(Asc(Mid(sMessage, lByteCount + 1, 1)), lBytePosition)
lByteCount = lByteCount + 1
Loop
lWordCount = lByteCount \ BYTES_TO_A_WORD
lBytePosition = (lByteCount Mod BYTES_TO_A_WORD) * BITS_TO_A_BYTE
lWordArray(lWordCount) = lWordArray(lWordCount) Or LShift(&H80, lBytePosition)
lWordArray(lNumberOfWords - 2) = LShift(lMessageLength, 3)
lWordArray(lNumberOfWords - 1) = RShift(lMessageLength, 29)
ConvertToWordArray = lWordArray
End Function
Public Function MD5(sMessage)
Dim x
Dim k
Dim AA
Dim BB
Dim CC
Dim DD
Dim a
Dim b
Dim c
Dim d
Const S11 = 7
Const S12 = 12
Const S13 = 17
Const S14 = 22
Const S21 = 5
Const S22 = 9
Const S23 = 14
Const S24 = 20
Const S31 = 4
Const S32 = 11
Const S33 = 16
Const S34 = 23
Const S41 = 6
Const S42 = 10
Const S43 = 15
Const S44 = 21
x = ConvertToWordArray(sMessage)
a = &H67452301
b = &HEFCDAB89
c = &H98BADCFE
d = &H10325476
For k = 0 To UBound(x) Step 16
AA = a
BB = b
CC = c
DD = d
FF a, b, c, d, x(k + 0), S11, &HD76AA478
FF d, a, b, c, x(k + 1), S12, &HE8C7B756
FF c, d, a, b, x(k + 2), S13, &H242070DB
FF b, c, d, a, x(k + 3), S14, &HC1BDCEEE
FF a, b, c, d, x(k + 4), S11, &HF57C0FAF
FF d, a, b, c, x(k + 5), S12, &H4787C62A
FF c, d, a, b, x(k + 6), S13, &HA8304613
FF b, c, d, a, x(k + 7), S14, &HFD469501
FF a, b, c, d, x(k + 8), S11, &H698098D8
FF d, a, b, c, x(k + 9), S12, &H8B44F7AF
FF c, d, a, b, x(k + 10), S13, &HFFFF5BB1
FF b, c, d, a, x(k + 11), S14, &H895CD7BE
FF a, b, c, d, x(k + 12), S11, &H6B901122
FF d, a, b, c, x(k + 13), S12, &HFD987193
FF c, d, a, b, x(k + 14), S13, &HA679438E
FF b, c, d, a, x(k + 15), S14, &H49B40821
GG a, b, c, d, x(k + 1), S21, &HF61E2562
GG d, a, b, c, x(k + 6), S22, &HC040B340
GG c, d, a, b, x(k + 11), S23, &H265E5A51
GG b, c, d, a, x(k + 0), S24, &HE9B6C7AA
GG a, b, c, d, x(k + 5), S21, &HD62F105D
GG d, a, b, c, x(k + 10), S22, &H2441453
GG c, d, a, b, x(k + 15), S23, &HD8A1E681
GG b, c, d, a, x(k + 4), S24, &HE7D3FBC8
GG a, b, c, d, x(k + 9), S21, &H21E1CDE6
GG d, a, b, c, x(k + 14), S22, &HC33707D6
GG c, d, a, b, x(k + 3), S23, &HF4D50D87
GG b, c, d, a, x(k + 8), S24, &H455A14ED
GG a, b, c, d, x(k + 13), S21, &HA9E3E905
GG d, a, b, c, x(k + 2), S22, &HFCEFA3F8
GG c, d, a, b, x(k + 7), S23, &H676F02D9
GG b, c, d, a, x(k + 12), S24, &H8D2A4C8A
HH a, b, c, d, x(k + 5), S31, &HFFFA3942
HH d, a, b, c, x(k + 8), S32, &H8771F681
HH c, d, a, b, x(k + 11), S33, &H6D9D6122
HH b, c, d, a, x(k + 14), S34, &HFDE5380C
HH a, b, c, d, x(k + 1), S31, &HA4BEEA44
HH d, a, b, c, x(k + 4), S32, &H4BDECFA9
HH c, d, a, b, x(k + 7), S33, &HF6BB4B60
HH b, c, d, a, x(k + 10), S34, &HBEBFBC70
HH a, b, c, d, x(k + 13), S31, &H289B7EC6
HH d, a, b, c, x(k + 0), S32, &HEAA127FA
HH c, d, a, b, x(k + 3), S33, &HD4EF3085
HH b, c, d, a, x(k + 6), S34, &H4881D05
HH a, b, c, d, x(k + 9), S31, &HD9D4D039
HH d, a, b, c, x(k + 12), S32, &HE6DB99E5
HH c, d, a, b, x(k + 15), S33, &H1FA27CF8
HH b, c, d, a, x(k + 2), S34, &HC4AC5665
II a, b, c, d, x(k + 0), S41, &HF4292244
II d, a, b, c, x(k + 7), S42, &H432AFF97
II c, d, a, b, x(k + 14), S43, &HAB9423A7
II b, c, d, a, x(k + 5), S44, &HFC93A039
II a, b, c, d, x(k + 12), S41, &H655B59C3
II d, a, b, c, x(k + 3), S42, &H8F0CCC92
II c, d, a, b, x(k + 10), S43, &HFFEFF47D
II b, c, d, a, x(k + 1), S44, &H85845DD1
II a, b, c, d, x(k + 8), S41, &H6FA87E4F
II d, a, b, c, x(k + 15), S42, &HFE2CE6E0
II c, d, a, b, x(k + 6), S43, &HA3014314
II b, c, d, a, x(k + 13), S44, &H4E0811A1
II a, b, c, d, x(k + 4), S41, &HF7537E82
II d, a, b, c, x(k + 11), S42, &HBD3AF235
II c, d, a, b, x(k + 2), S43, &H2AD7D2BB
II b, c, d, a, x(k + 9), S44, &HEB86D391
a = AddUnsigned(a, AA)
b = AddUnsigned(b, BB)
c = AddUnsigned(c, CC)
d = AddUnsigned(d, DD)
Next
MD5 = LCase(MD5WordToHex(a) & MD5WordToHex(b) & MD5WordToHex(c) & MD5WordToHex(d))
End Function
''''''''''''''''' Start RC4 section
''
' This routine called by EnDeCrypt function.
' Initializes the sbox and the key array
Sub RC4Initialize(strPwd)
Dim tempSwap
Dim a
Dim b
intLength = len(strPwd)
For a = 0 To 255
key(a) = asc(mid(strpwd, (a mod intLength)+1, 1))
sbox(a) = a
Next
b = 0
For a = 0 To 255
b = (b + sbox(a) + key(a)) Mod 256
tempSwap = sbox(a)
sbox(a) = sbox(b)
sbox(b) = tempSwap
Next
End Sub
''
' This routine does all the work.
' Call it both to ENcrypt and to DEcrypt your data.
Function RC4(plaintxt, psw)
Dim temp
Dim a
Dim i : i = 0
Dim j : j = 0
Dim k
Dim cipherby
Dim cipher
RC4Initialize psw
For a = 1 To Len(plaintxt)
i = (i + 1) Mod 256
j = (j + sbox(i)) Mod 256
temp = sbox(i)
sbox(i) = sbox(j)
sbox(j) = temp
k = sbox((sbox(i) + sbox(j)) Mod 256)
cipherby = Asc(Mid(plaintxt, a, 1)) Xor k
cipher = cipher & Chr(cipherby)
Next
RC4 = cipher
End Function
''''''''''''''' Start SHA1 section
Function AndW(ByRef pBytWord1Ary, ByRef pBytWord2Ary)
Dim lBytWordAry(3)
Dim lLngIndex
For lLngIndex = 0 To 3
lBytWordAry(lLngIndex) = CByte(pBytWord1Ary(lLngIndex) And pBytWord2Ary(lLngIndex))
Next
AndW = lBytWordAry
End Function
Function OrW(ByRef pBytWord1Ary, ByRef pBytWord2Ary)
Dim lBytWordAry(3)
Dim lLngIndex
For lLngIndex = 0 To 3
lBytWordAry(lLngIndex) = CByte(pBytWord1Ary(lLngIndex) Or pBytWord2Ary(lLngIndex))
Next
OrW = lBytWordAry
End Function
Function XorW(ByRef pBytWord1Ary, ByRef pBytWord2Ary)
Dim lBytWordAry(3)
Dim lLngIndex
For lLngIndex = 0 To 3
lBytWordAry(lLngIndex) = CByte(pBytWord1Ary(lLngIndex) Xor pBytWord2Ary(lLngIndex))
Next
XorW = lBytWordAry
End Function
Function NotW(ByRef pBytWordAry)
Dim lBytWordAry(3)
Dim lLngIndex
For lLngIndex = 0 To 3
lBytWordAry(lLngIndex) = Not CByte(pBytWordAry(lLngIndex))
Next
NotW = lBytWordAry
End Function
Function AddW(ByRef pBytWord1Ary, ByRef pBytWord2Ary)
Dim lLngIndex
Dim lIntTotal
Dim lBytWordAry(3)
For lLngIndex = 3 To 0 Step -1
If lLngIndex = 3 Then
lIntTotal = CInt(pBytWord1Ary(lLngIndex)) + pBytWord2Ary(lLngIndex)
lBytWordAry(lLngIndex) = lIntTotal Mod 256
Else
lIntTotal = CInt(pBytWord1Ary(lLngIndex)) + pBytWord2Ary(lLngIndex) + (lIntTotal \ 256)
lBytWordAry(lLngIndex) = lIntTotal Mod 256
End If
Next
AddW = lBytWordAry
End Function
Function CircShiftLeftW(ByRef pBytWordAry, ByRef pLngShift)
Dim lDbl1
Dim lDbl2
lDbl1 = WordToDouble(pBytWordAry)
lDbl2 = lDbl1
lDbl1 = CDbl(lDbl1 * (2 ^ pLngShift))
lDbl2 = CDbl(lDbl2 / (2 ^ (32 - pLngShift)))
CircShiftLeftW = OrW(DoubleToWord(lDbl1), DoubleToWord(lDbl2))
End Function
Private Function MD5WordToHex(lValue)
Dim lByte
Dim lCount
For lCount = 0 To 3
lByte = RShift(lValue, lCount * BITS_TO_A_BYTE) And m_lOnBits(BITS_TO_A_BYTE - 1)
MD5WordToHex = MD5WordToHex & Right("0" & Hex(lByte), 2)
Next
End Function
Function WordToHex(ByRef pBytWordAry)
Dim lLngIndex
For lLngIndex = 0 To 3
WordToHex = WordToHex & Right("0" & Hex(pBytWordAry(lLngIndex)), 2)
Next
End Function
Function HexToWord(ByRef pStrHex)
HexToWord = DoubleToWord(CDbl("&h" & pStrHex)) ' needs "#" at end for VB?
End Function
Function DoubleToWord(ByRef pDblValue)
Dim lBytWordAry(3)
lBytWordAry(0) = Int(DMod(pDblValue, 2 ^ 32) / (2 ^ 24))
lBytWordAry(1) = Int(DMod(pDblValue, 2 ^ 24) / (2 ^ 16))
lBytWordAry(2) = Int(DMod(pDblValue, 2 ^ 16) / (2 ^ 8))
lBytWordAry(3) = Int(DMod(pDblValue, 2 ^ 8))
DoubleToWord = lBytWordAry
End Function
Function WordToDouble(ByRef pBytWordAry)
WordToDouble = CDbl((pBytWordAry(0) * (2 ^ 24)) + (pBytWordAry(1) * (2 ^ 16)) + (pBytWordAry(2) * (2 ^ 8)) + pBytWordAry(3))
End Function
Function DMod(ByRef pDblValue, ByRef pDblDivisor)
Dim lDblMod
lDblMod = CDbl(CDbl(pDblValue) - (Int(CDbl(pDblValue) / CDbl(pDblDivisor)) * CDbl(pDblDivisor)))
If lDblMod < 0 Then
lDblMod = CDbl(lDblMod + pDblDivisor)
End If
DMod = lDblMod
End Function
Function F( ByRef lIntT, ByRef pBytWordBAry, ByRef pBytWordCAry, ByRef pBytWordDAry)
If lIntT <= 19 Then
F = OrW(AndW(pBytWordBAry, pBytWordCAry), AndW((NotW(pBytWordBAry)), pBytWordDAry))
ElseIf lIntT <= 39 Then
F = XorW(XorW(pBytWordBAry, pBytWordCAry), pBytWordDAry)
ElseIf lIntT <= 59 Then
F = OrW(OrW(AndW(pBytWordBAry, pBytWordCAry), AndW(pBytWordBAry, pBytWordDAry)), AndW(pBytWordCAry, pBytWordDAry))
Else
F = XorW(XorW(pBytWordBAry, pBytWordCAry), pBytWordDAry)
End If
End Function
Function SHA1(pStrMessage)
Dim lLngLen, lBytLenW, lLngTempWordWAry, lLngNumBlocks, lLngBlock, lIntT, lBytTempAry
Dim lVarWordWAry(79), lVarWordKAry(3)
Dim lStrBlockText, lStrWordText, lStrPadMessage
Dim lBytWordH0Ary, lBytWordH1Ary, lBytWordH2Ary, lBytWordH3Ary, lBytWordH4Ary
Dim lBytWordAAry, lBytWordBAry, lBytWordCAry, lBytWordDAry, lBytWordEAry, lBytWordFAry
lLngLen = Len(cstr(pStrMessage))
lBytLenW = DoubleToWord(CDbl(lLngLen) * 8)
lStrPadMessage = pStrMessage & Chr(128) & String((128 - (lLngLen Mod 64) - 9) Mod 64, Chr(0)) & String(4, Chr(0)) & Chr(lBytLenW(0)) & Chr(lBytLenW(1)) & Chr(lBytLenW(2)) & Chr(lBytLenW(3))
lLngNumBlocks = Len(lStrPadMessage) / 64
lVarWordKAry(0) = HexToWord("5A827999")
lVarWordKAry(1) = HexToWord("6ED9EBA1")
lVarWordKAry(2) = HexToWord("8F1BBCDC")
lVarWordKAry(3) = HexToWord("CA62C1D6")
lBytWordH0Ary = HexToWord("67452301")
lBytWordH1Ary = HexToWord("EFCDAB89")
lBytWordH2Ary = HexToWord("98BADCFE")
lBytWordH3Ary = HexToWord("10325476")
lBytWordH4Ary = HexToWord("C3D2E1F0")
For lLngBlock = 0 To lLngNumBlocks - 1
lStrBlockText = Mid(lStrPadMessage, (lLngBlock * 64) + 1, 64)
For lIntT = 0 To 15
lStrWordText = Mid(lStrBlockText, (lIntT * 4) + 1, 4)
lVarWordWAry(lIntT) = Array(Asc(Mid(lStrWordText, 1, 1)), Asc(Mid(lStrWordText, 2, 1)), Asc(Mid(lStrWordText, 3, 1)), Asc(Mid(lStrWordText, 4, 1)))
Next
For lIntT = 16 To 79
lVarWordWAry(lIntT) = CircShiftLeftW(XorW(XorW(XorW(lVarWordWAry(lIntT - 3), lVarWordWAry(lIntT - 8)), lVarWordWAry(lIntT - 14)), lVarWordWAry(lIntT - 16)), 1)
Next
lBytWordAAry = lBytWordH0Ary
lBytWordBAry = lBytWordH1Ary
lBytWordCAry = lBytWordH2Ary
lBytWordDAry = lBytWordH3Ary
lBytWordEAry = lBytWordH4Ary
For lIntT = 0 To 79
lBytWordFAry = F(lIntT, lBytWordBAry, lBytWordCAry, lBytWordDAry)
lBytTempAry = AddW(AddW(AddW(AddW(CircShiftLeftW(lBytWordAAry, 5), lBytWordFAry), lBytWordEAry), lVarWordWAry(lIntT)), lVarWordKAry(lIntT \ 20))
lBytWordEAry = lBytWordDAry
lBytWordDAry = lBytWordCAry
lBytWordCAry = CircShiftLeftW(lBytWordBAry, 30)
lBytWordBAry = lBytWordAAry
lBytWordAAry = lBytTempAry
Next
lBytWordH0Ary = AddW(lBytWordH0Ary, lBytWordAAry)
lBytWordH1Ary = AddW(lBytWordH1Ary, lBytWordBAry)
lBytWordH2Ary = AddW(lBytWordH2Ary, lBytWordCAry)
lBytWordH3Ary = AddW(lBytWordH3Ary, lBytWordDAry)
lBytWordH4Ary = AddW(lBytWordH4Ary, lBytWordEAry)
Next
SHA1 = WordToHex(lBytWordH0Ary) & WordToHex(lBytWordH1Ary) & WordToHex(lBytWordH2Ary) & WordToHex(lBytWordH3Ary) & WordToHex(lBytWordH4Ary)
End Function
''''''''''''''''''''''' start AES stuff
Private Function LShift(lValue, iShiftBits)
If iShiftBits = 0 Then
LShift = lValue
Exit Function
ElseIf iShiftBits = 31 Then
If lValue And 1 Then
LShift = &H80000000
Else
LShift = 0
End If
Exit Function
ElseIf iShiftBits < 0 Or iShiftBits > 31 Then
Err.Raise 6
End If
If (lValue And m_l2Power(31 - iShiftBits)) Then
LShift = ((lValue And m_lOnBits(31 - (iShiftBits + 1))) * m_l2Power(iShiftBits)) Or &H80000000
Else
LShift = ((lValue And m_lOnBits(31 - iShiftBits)) * m_l2Power(iShiftBits))
End If
End Function
Private Function RShift(lValue, iShiftBits)
If iShiftBits = 0 Then
RShift = lValue
Exit Function
ElseIf iShiftBits = 31 Then
If lValue And &H80000000 Then
RShift = 1
Else
RShift = 0
End If
Exit Function
ElseIf iShiftBits < 0 Or iShiftBits > 31 Then
Err.Raise 6
End If
RShift = (lValue And &H7FFFFFFE) \ m_l2Power(iShiftBits)
If (lValue And &H80000000) Then
RShift = (RShift Or (&H40000000 \ m_l2Power(iShiftBits - 1)))
End If
End Function
Private Function LShiftByte(bytValue, bytShiftBits)
If bytShiftBits = 0 Then
LShiftByte = bytValue
Exit Function
ElseIf bytShiftBits = 7 Then
If bytValue And 1 Then
LShiftByte = &H80
Else
LShiftByte = 0
End If
Exit Function
ElseIf bytShiftBits < 0 Or bytShiftBits > 7 Then
Err.Raise 6
End If
LShiftByte = ((bytValue And m_bytOnBits(7 - bytShiftBits)) * m_byt2Power(bytShiftBits))
End Function
Private Function RShiftByte(bytValue, bytShiftBits)
If bytShiftBits = 0 Then
RShiftByte = bytValue
Exit Function
ElseIf bytShiftBits = 7 Then
If bytValue And &H80 Then
RShiftByte = 1
Else
RShiftByte = 0
End If
Exit Function
ElseIf bytShiftBits < 0 Or bytShiftBits > 7 Then
Err.Raise 6
End If
RShiftByte = bytValue \ m_byt2Power(bytShiftBits)
End Function
Private Function RotateLeft(lValue, iShiftBits)
RotateLeft = LShift(lValue, iShiftBits) Or RShift(lValue, (32 - iShiftBits))
End Function
Private Function RotateLeftByte(bytValue, bytShiftBits)
RotateLeftByte = LShiftByte(bytValue, bytShiftBits) Or RShiftByte(bytValue, (8 - bytShiftBits))
End Function
Private Function Pack(b())
Dim lCount
Dim lTemp
For lCount = 0 To 3
lTemp = b(lCount)
Pack = Pack Or LShift(lTemp, (lCount * 8))
Next
End Function
Private Function PackFrom(b(), k)
Dim lCount
Dim lTemp
For lCount = 0 To 3
lTemp = b(lCount + k)
PackFrom = PackFrom Or LShift(lTemp, (lCount * 8))
Next
End Function
Private Sub Unpack(a, b())
b(0) = a And m_lOnBits(7)
b(1) = RShift(a, 8) And m_lOnBits(7)
b(2) = RShift(a, 16) And m_lOnBits(7)
b(3) = RShift(a, 24) And m_lOnBits(7)
End Sub
Private Sub UnpackFrom(a, b(), k)
b(0 + k) = a And m_lOnBits(7)
b(1 + k) = RShift(a, 8) And m_lOnBits(7)
b(2 + k) = RShift(a, 16) And m_lOnBits(7)
b(3 + k) = RShift(a, 24) And m_lOnBits(7)
End Sub
Private Function xtime(a)
Dim b
If (a And &H80) Then
b = &H1B
Else
b = 0
End If
xtime = LShiftByte(a, 1)
xtime = xtime Xor b
End Function
Private Function bmul(x, y)
If x <> 0 And y <> 0 Then
bmul = m_ptab((CLng(m_ltab(x)) + CLng(m_ltab(y))) Mod 255)
Else
bmul = 0
End If
End Function
Private Function SubByte(a)
Dim b(3)
Unpack a, b
b(0) = m_fbsub(b(0))
b(1) = m_fbsub(b(1))
b(2) = m_fbsub(b(2))
b(3) = m_fbsub(b(3))
SubByte = Pack(b)
End Function
Private Function product(x, y)
Dim xb(3)
Dim yb(3)
Unpack x, xb
Unpack y, yb
product = bmul(xb(0), yb(0)) Xor bmul(xb(1), yb(1)) Xor bmul(xb(2), yb(2)) Xor bmul(xb(3), yb(3))
End Function
Private Function InvMixCol(x)
Dim y
Dim m
Dim b(3)
m = Pack(m_InCo)
b(3) = product(m, x)
m = RotateLeft(m, 24)
b(2) = product(m, x)
m = RotateLeft(m, 24)
b(1) = product(m, x)
m = RotateLeft(m, 24)
b(0) = product(m, x)
y = Pack(b)
InvMixCol = y
End Function
Private Function ByteSub(x)
Dim y
Dim z
z = x
y = m_ptab(255 - m_ltab(z))
z = y
z = RotateLeftByte(z, 1)
y = y Xor z
z = RotateLeftByte(z, 1)
y = y Xor z
z = RotateLeftByte(z, 1)
y = y Xor z
z = RotateLeftByte(z, 1)
y = y Xor z
y = y Xor &H63
ByteSub = y
End Function
Public Sub gentables()
Dim i
Dim y
Dim b(3)
Dim ib
m_ltab(0) = 0
m_ptab(0) = 1
m_ltab(1) = 0
m_ptab(1) = 3
m_ltab(3) = 1
For i = 2 To 255
m_ptab(i) = m_ptab(i - 1) Xor xtime(m_ptab(i - 1))
m_ltab(m_ptab(i)) = i
Next
m_fbsub(0) = &H63
m_rbsub(&H63) = 0
For i = 1 To 255
ib = i
y = ByteSub(ib)
m_fbsub(i) = y
m_rbsub(y) = i
Next
y = 1
For i = 0 To 29
m_rco(i) = y
y = xtime(y)
Next
For i = 0 To 255
y = m_fbsub(i)
b(3) = y Xor xtime(y)
b(2) = y
b(1) = y
b(0) = xtime(y)
m_ftable(i) = Pack(b)
y = m_rbsub(i)
b(3) = bmul(m_InCo(0), y)
b(2) = bmul(m_InCo(1), y)
b(1) = bmul(m_InCo(2), y)
b(0) = bmul(m_InCo(3), y)
m_rtable(i) = Pack(b)
Next
End Sub
Public Sub gkey(nb, nk, key())
Dim i
Dim j
Dim k
Dim m
Dim N
Dim C1
Dim C2
Dim C3
Dim CipherKey(7)
m_Nb = nb
m_Nk = nk
If m_Nb >= m_Nk Then
m_Nr = 6 + m_Nb
Else
m_Nr = 6 + m_Nk
End If
C1 = 1
If m_Nb < 8 Then
C2 = 2
C3 = 3
Else
C2 = 3
C3 = 4
End If
For j = 0 To nb - 1
m = j * 3
m_fi(m) = (j + C1) Mod nb
m_fi(m + 1) = (j + C2) Mod nb
m_fi(m + 2) = (j + C3) Mod nb
m_ri(m) = (nb + j - C1) Mod nb
m_ri(m + 1) = (nb + j - C2) Mod nb
m_ri(m + 2) = (nb + j - C3) Mod nb
Next
N = m_Nb * (m_Nr + 1)
For i = 0 To m_Nk - 1
j = i * 4
CipherKey(i) = PackFrom(key, j)
Next
For i = 0 To m_Nk - 1
m_fkey(i) = CipherKey(i)
Next
j = m_Nk
k = 0
Do While j < N
m_fkey(j) = m_fkey(j - m_Nk) Xor _
SubByte(RotateLeft(m_fkey(j - 1), 24)) Xor m_rco(k)
If m_Nk <= 6 Then
i = 1
Do While i < m_Nk And (i + j) < N
m_fkey(i + j) = m_fkey(i + j - m_Nk) Xor _
m_fkey(i + j - 1)
i = i + 1
Loop
Else
i = 1
Do While i < 4 And (i + j) < N
m_fkey(i + j) = m_fkey(i + j - m_Nk) Xor _
m_fkey(i + j - 1)
i = i + 1
Loop
If j + 4 < N Then
m_fkey(j + 4) = m_fkey(j + 4 - m_Nk) Xor _
SubByte(m_fkey(j + 3))
End If
i = 5
Do While i < m_Nk And (i + j) < N
m_fkey(i + j) = m_fkey(i + j - m_Nk) Xor _
m_fkey(i + j - 1)
i = i + 1
Loop
End If
j = j + m_Nk
k = k + 1
Loop
For j = 0 To m_Nb - 1
m_rkey(j + N - nb) = m_fkey(j)
Next
i = m_Nb
Do While i < N - m_Nb
k = N - m_Nb - i
For j = 0 To m_Nb - 1
m_rkey(k + j) = InvMixCol(m_fkey(i + j))
Next
i = i + m_Nb
Loop
j = N - m_Nb
Do While j < N
m_rkey(j - N + m_Nb) = m_fkey(j)
j = j + 1
Loop
End Sub
Public Sub encrypt(buff())
Dim i
Dim j
Dim k
Dim m
Dim a(7)
Dim b(7)
Dim x
Dim y
Dim t
For i = 0 To m_Nb - 1
j = i * 4
a(i) = PackFrom(buff, j)
a(i) = a(i) Xor m_fkey(i)
Next
k = m_Nb
x = a
y = b
For i = 1 To m_Nr - 1
For j = 0 To m_Nb - 1
m = j * 3
y(j) = m_fkey(k) Xor m_ftable(x(j) And m_lOnBits(7)) Xor _
RotateLeft(m_ftable(RShift(x(m_fi(m)), 8) And m_lOnBits(7)), 8) Xor _
RotateLeft(m_ftable(RShift(x(m_fi(m + 1)), 16) And m_lOnBits(7)), 16) Xor _
RotateLeft(m_ftable(RShift(x(m_fi(m + 2)), 24) And m_lOnBits(7)), 24)
k = k + 1
Next
t = x
x = y
y = t
Next
For j = 0 To m_Nb - 1
m = j * 3
y(j) = m_fkey(k) Xor m_fbsub(x(j) And m_lOnBits(7)) Xor _
RotateLeft(m_fbsub(RShift(x(m_fi(m)), 8) And m_lOnBits(7)), 8) Xor _
RotateLeft(m_fbsub(RShift(x(m_fi(m + 1)), 16) And m_lOnBits(7)), 16) Xor _
RotateLeft(m_fbsub(RShift(x(m_fi(m + 2)), 24) And m_lOnBits(7)), 24)
k = k + 1
Next
For i = 0 To m_Nb - 1
j = i * 4
UnpackFrom y(i), buff, j
x(i) = 0
y(i) = 0
Next
End Sub
Public Sub decrypt(buff())
Dim i
Dim j
Dim k
Dim m
Dim a(7)
Dim b(7)
Dim x
Dim y
Dim t
For i = 0 To m_Nb - 1
j = i * 4
a(i) = PackFrom(buff, j)
a(i) = a(i) Xor m_rkey(i)
Next
k = m_Nb
x = a
y = b
For i = 1 To m_Nr - 1
For j = 0 To m_Nb - 1
m = j * 3
y(j) = m_rkey(k) Xor m_rtable(x(j) And m_lOnBits(7)) Xor _
RotateLeft(m_rtable(RShift(x(m_ri(m)), 8) And m_lOnBits(7)), 8) Xor _
RotateLeft(m_rtable(RShift(x(m_ri(m + 1)), 16) And m_lOnBits(7)), 16) Xor _
RotateLeft(m_rtable(RShift(x(m_ri(m + 2)), 24) And m_lOnBits(7)), 24)
k = k + 1
Next
t = x
x = y
y = t
Next
For j = 0 To m_Nb - 1
m = j * 3
y(j) = m_rkey(k) Xor m_rbsub(x(j) And m_lOnBits(7)) Xor _
RotateLeft(m_rbsub(RShift(x(m_ri(m)), 8) And m_lOnBits(7)), 8) Xor _
RotateLeft(m_rbsub(RShift(x(m_ri(m + 1)), 16) And m_lOnBits(7)), 16) Xor _
RotateLeft(m_rbsub(RShift(x(m_ri(m + 2)), 24) And m_lOnBits(7)), 24)
k = k + 1
Next
For i = 0 To m_Nb - 1
j = i * 4
UnpackFrom y(i), buff, j
x(i) = 0
y(i) = 0
Next
End Sub
Private Function IsInitialized(vArray)
On Error Resume Next
IsInitialized = IsNumeric(UBound(vArray))
End Function
Private Sub CopyBytesASP(bytDest, lDestStart, bytSource(), lSourceStart, lLength)
Dim lCount
lCount = 0
Do
bytDest(lDestStart + lCount) = bytSource(lSourceStart + lCount)
lCount = lCount + 1
Loop Until lCount = lLength
End Sub
Public Function AESEncrypt(bytMessage, bytPassword)
Dim bytKey(31)
Dim bytIn()
Dim bytOut()
Dim bytTemp(31)
Dim lCount
Dim lLength
Dim lEncodedLength
Dim bytLen(3)
Dim lPosition
If Not IsInitialized(bytMessage) Then
Exit Function
End If
If Not IsInitialized(bytPassword) Then
Exit Function
End If
For lCount = 0 To UBound(bytPassword)
bytKey(lCount) = bytPassword(lCount)
If lCount = 31 Then
Exit For
End If
Next
gentables
gkey 8, 8, bytKey
lLength = UBound(bytMessage) + 1
lEncodedLength = lLength + 4
If lEncodedLength Mod 32 <> 0 Then
lEncodedLength = lEncodedLength + 32 - (lEncodedLength Mod 32)
End If
ReDim bytIn(lEncodedLength - 1)
ReDim bytOut(lEncodedLength - 1)
Unpack lLength, bytIn
CopyBytesASP bytIn, 4, bytMessage, 0, lLength
For lCount = 0 To lEncodedLength - 1 Step 32
CopyBytesASP bytTemp, 0, bytIn, lCount, 32
Encrypt bytTemp
CopyBytesASP bytOut, lCount, bytTemp, 0, 32
Next
AESEncrypt = bytOut
End Function
Public Function AESDecrypt(bytIn, bytPassword)
Dim bytMessage()
Dim bytKey(31)
Dim bytOut()
Dim bytTemp(31)
Dim lCount
Dim lLength
Dim lEncodedLength
Dim bytLen(3)
Dim lPosition
If Not IsInitialized(bytIn) Then
Exit Function
End If
If Not IsInitialized(bytPassword) Then
Exit Function
End If
lEncodedLength = UBound(bytIn) + 1
If lEncodedLength Mod 32 <> 0 Then
Exit Function
End If
For lCount = 0 To UBound(bytPassword)
bytKey(lCount) = bytPassword(lCount)
If lCount = 31 Then
Exit For
End If
Next
gentables
gkey 8, 8, bytKey
ReDim bytOut(lEncodedLength - 1)
For lCount = 0 To lEncodedLength - 1 Step 32
CopyBytesASP bytTemp, 0, bytIn, lCount, 32
Decrypt bytTemp
CopyBytesASP bytOut, lCount, bytTemp, 0, 32
Next
lLength = Pack(bytOut)
If lLength > lEncodedLength - 4 Then
Exit Function
End If
ReDim bytMessage(lLength - 1)
CopyBytesASP bytMessage, 0, bytOut, 4, lLength
AESDecrypt = bytMessage
End Function
Function StringToPairArray(str_or_int)
Dim l, arr, i, j : j = 0
l = len(str_or_int)
ReDim arr((l / 2) - 1)
For i = 0 To l-1 Step 2
arr(j) = CStr("&h" & Mid(str_or_int,i+1,2))
j = j + 1
Next
StringToPairArray = arr
End Function
Public Function AESDecyptString(sPlain, sPassword)
lLength = Len(sPassword)
ReDim bytPassword(lLength-1)
For lCount = 1 To lLength
bytPassword(lCount-1)=CByte(AscB(Mid(sPassword,lCount,1)))
Next
bytClear = EncryptionUtils.AESDecrypt(EncryptionUtils.StringToPairArray(sPlain), bytPassword)
lLength = UBound(bytClear) + 1
sTemp = ""
For lCount = 0 To lLength - 1
sTemp = sTemp & Chr(bytClear(lCount))
Next
AESDecyptString = sTemp
End Function
Public Function AESEncyptString(sPlain, sPassword)
lLength = Len(sPlain)
ReDim bytIn(lLength-1)
For lCount = 1 To lLength
bytIn(lCount-1)=CByte(AscB(Mid(sPlain,lCount,1)))
Next
lLength = Len(sPassword)
ReDim bytPassword(lLength-1)
For lCount = 1 To lLength
bytPassword(lCount-1)=CByte(AscB(Mid(sPassword,lCount,1)))
Next
bytOut = AESEncrypt(bytIn, bytPassword)
sTemp = ""
For lCount = 0 To UBound(bytOut)
sTemp = sTemp & Right("0" & Hex(bytOut(lCount)), 2)
Next
AESEncyptString = sTemp
End Function
End Class
%>
'asp' 카테고리의 다른 글
| FSO example (0) | 2010.08.24 |
|---|---|
| read/write configuration class (xml version) (0) | 2010.08.24 |
| 엑셀(CSV) 파일 DB에 입력하기 (2) | 2010.07.09 |
| asp로 화일업로드 형태를 취해 csv아니면 excel화일을 ms-sql db로 저장하기 (0) | 2010.07.09 |
| csv파일을 asp를 이용해 db에 저장하는 방법 (0) | 2010.07.09 |