http://hanhead.tistory.com/entry/Encryption-Utils-Class

<%
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
%>

+ Recent posts