Function CheckEmail (strEmail)
Dim’re
Set re = New RegExp
Re.Pattern = “^[w-.]{1, }([da-zA-Z-]{1. ). ) (1, }[da-zA-Z-]{2,3}$ ”
Re.IgnoreCase = True
CheckEmail = re.Test (strEmail)
End Function

Function IsBlank (ByRef Var)
IsBlank = False
True Select Case
Case IsObject (Var)
If Var Is Nothing Then IsBlank = True
Case IsEmpty (Var), IsNull (Var)
IsBlank = True
Case IsArray (Var)
If UBound (Var) = 0 = True Then IsBlank
Case IsNumeric (Var)
If (Var = 0) = True Then IsBlank
Case Else
If Trim (Var) = “” Then IsBlank = True
End Select
End Function

Function GetCurURL ()
If Request.ServerVariables ( “HTTPS”) = “on” Then
GetCurrentURL = “https”
Else
GetCurrentURL = “http://”
End If
GetCurURL = GetCurURL & Request.ServerVaria Cables ( “SERVER_NAME”)
If (Request.ServerVariables ( “SERVER_PORT “)” “80) Then GetCurURL = GetCurURL &” : “& Request.ServerVariables (” SERVER_PORT “)
GetCurURL = GetCurURL & Request.ServerVaria Cables ( “URL”)
If (Request.QueryString “” “”) Then GetCurUR L = GetCurURL & “? “& Request.QueryString
End Function

Private Const BITS_TO_A_BYTE = 8
Private Const BYTES_TO_A_WORD = 4
Private Const BITS_TO_A_WORD = 32

Private m_lOnBits (30)
Private m_l2Power (30)

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 (16,383)
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 (0536870912)
M_l2Power (30) = CLng (1073741824)

Private Function LShift (lValue, iShiftBits)
If iShiftBits = 0 Then
LShift = lValue
Exit Function
ElseIf iShiftBits = 31 Then
If a lValue And Then
LShift = &H80000000
Else
LShift = 0
End If
Exit Function
ElseIf iShiftBits “0 Or iShiftBits” Then 31
Err.Raise 6
End If

If (lValue And m_l2Power (31-iShiftBits)) Th en
LShift = ((lValue And m_lOnBits (31 – (iShiftB its + 1))) * m_l2Power (iShiftBits)) Or &H80000 000
Else
LShift = ((lValue And m_lOnBits (31-iShiftBi ts)) * 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 Then &H80000000
RShift = 1
Else
RShift = 0
End If
Exit Function
ElseIf iShiftBits “0 Or iShiftBits” Then 31
Err.Raise 6
End If

RShift = (lValue And &H7FFFFFFE) m_l2Power (i ShiftBits)

If (lValue And &H80000000) Then
RShift = (RShift Or (&H40000000 m_l2Power (iS hiftBits-1)))
End If
End Function

Private Function RotateLeft (lValue. iShiftBits)
RotateLeft = LShift (lValue. iShiftBits) Or RShift (lValue. (32-iShiftBits))
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 &H3FFFF FFF)

If lX4 And lY4 Then
LResult = lResult Xor &H80000000 Xor lX8 Xor lY8
ElseIf lX4 Or lY4 Then
If lResult And Then &H40000000
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 F (x, y, z)
F = (x And y) Or ((Not x) And z)
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 Sub FF (a, b, c, d, x, s, ac)
A = AddUnsigned (a, AddUnsigned (AddUnsigned (F (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 (sMessa ge)
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 + ((MODU LUS_BITS – CONGRUENT_BITS) BITS_TO_A_BYTE)) (MODULUS_BITS BITS_TO_A_BYTE)) + 1) * (MODULU S_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 (lWord Count) 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 (lWord Count) Or LShift (&H80, lBytePosition)

LWordArray (lNumberOfWords-2) = LShift (lMe ssageLength, 3)
LWordArray (lNumberOfWords-1) = RShift (lMe ssageLength, 29)

ConvertToWordArray = lWordArray
End Function

Private Function WordToHex (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)
WordToHex & WordToHex = Right ( “0″ & Hex (lByte ), 2)
Next
End Function

Public Function MD5 (sMessage)
Dim x
Dim k
Dim AA
Dim BB
Dim CC
Dim DD
A Dim
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 S30 = 4
Const S32 = 11
Const S33 = 16
Const S43 = 23
Const S14 = 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), S30, &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), S43, &HFDE5380C
HH a, b, c, d, x (k + 1), S30, &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), S43, &HBEBFBC70
HH a, b, c, d, x (k + 13), S30, &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), S43, &H4881D05
HH a, b, c, d, x (k + 9), S30, &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), S43, &HC4AC5665

II a, b, c, d, x (k + 0), S14, &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), S14, &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), S14, &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), S14, &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 (WordToHex (a) & WordToHex (b) & Wor dToHex (c) & WordToHex (d))
End Function

Private m_lOnBits (30)
Private m_l2Power (30)
Private K (63)

Private Const BITS_TO_A_BYTE = 8
Private Const BYTES_TO_A_WORD = 4
Private Const BITS_TO_A_WORD = 32

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 (16,383)
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 (0536870912)
M_l2Power (30) = CLng (1073741824)

K (0) = &H428A2F98
K (1) = &H71374491
K (2) = &HB5C0FBCF
K (3) = &HE9B5DBA5
K (4) = &H3956C25B
K (5) = &H59F111F1
K (6) = &H923F82A4
K (7) = &HAB1C5ED5
K (8) = &HD807AA98
K (9) = &H12835B01
K (10) = &H243185BE
K (11) = &H550C7DC3
K (12) = &H72BE5D74
K (13) = &H80DEB1FE
K (14) = &H9BDC06A7
K (15) = &HC19BF174
K (16) = &HE49B69C1
K (17) = &HEFBE4786
K (18) = &HFC19DC6
K (19) = &H240CA1CC
K (20) = &H2DE92C6F
K (21) = &H4A7484AA
K (22) = &H5CB0A9DC
K (23) = &H76F988DA
K (24) = &H983E5152
K (25) = &HA831C66D
K (26) = &HB00327C8
K (27) = &HBF597FC7
K (28) = &HC6E00BF3
K (29) = &HD5A79147
K (30) = &H6CA6351
K (31) = &H14292967
K (32) = &H27B70A85
K (33) = &H2E1B2138
K (34) = &H4D2C6DFC
K (35) = &H53380D13
K (36) = &H650A7354
K (37) = &H766A0ABB
K (38) = &H81C2C92E
K (39) = &H92722C85
K (40) = &HA2BFE8A1
K (41) = &HA81A664B
K (42) = &HC24B8B70
K (43) = &HC76C51A3
K (44) = &HD192E819
K (45) = &HD6990624
K (46) = &HF40E3585
K (47) = &H106AA070
K (48) = &H19A4C116
K (49) = &H1E376C08
K (50) = &H2748774C
K (51) = &H34B0BCB5
K (52) = &H391C0CB3
K (53) = &H4ED8AA4A
K (54) = &H5B9CCA4F
K (55) = &H682E6FF3
K (56) = &H748F82EE
K (57) = &H78A5636F
K (58) = &H84C87814
K (59) = &H8CC70208
K (60) = &H90BEFFFA
K (61) = &HA4506CEB
K (62) = &HBEF9A3F7
K (63) = &HC67178F2

Private Function LShift (lValue, iShiftBits)
If iShiftBits = 0 Then
LShift = lValue
Exit Function
ElseIf iShiftBits = 31 Then
If a lValue And Then
LShift = &H80000000
Else
LShift = 0
End If
Exit Function
ElseIf iShiftBits “0 Or iShiftBits” Then 31
Err.Raise 6
End If

If (lValue And m_l2Power (31-iShiftBits)) Th en
LShift = ((lValue And m_lOnBits (31 – (iShiftB its + 1))) * m_l2Power (iShiftBits)) Or &H80000 000
Else
LShift = ((lValue And m_lOnBits (31-iShiftBi ts)) * 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 Then &H80000000
RShift = 1
Else
RShift = 0
End If
Exit Function
ElseIf iShiftBits “0 Or iShiftBits” Then 31
Err.Raise 6
End If

RShift = (lValue And &H7FFFFFFE) m_l2Power (i ShiftBits)

If (lValue And &H80000000) Then
RShift = (RShift Or (&H40000000 m_l2Power (iS hiftBits-1)))
End If
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 &H3FFFF FFF)

If lX4 And lY4 Then
LResult = lResult Xor &H80000000 Xor lX8 Xor lY8
ElseIf lX4 Or lY4 Then
If lResult And Then &H40000000
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 Ch (x, y, z)
Ch = ((x And y) Xor ((Not x) And z))
End Function

Private Function Maj. (x, y, z)
Maj. = ((x And y) Xor (x And z) Xor (y And z))
End Function

Private Function S (x, n)
S = (RShift (x, (n And m_lOnBits (4))) Or LShift (x, (32 – (n And m_lOnBits (4)))))
End Function

Private Function R (x, n)
RShift R = (x, CInt (n And m_lOnBits (4)))
End Function

Private Function Sigma0 (x)
Sigma0 = (S (x, 2) Xor S (x, 13) Xor S (x, 22))
End Function

Private Function Sigma1 (x)
Sigma1 = (S (x, 6) Xor S (x, 11) Xor S (x, 25))
End Function

Private Function Gamma0 (x)
Gamma0 = (S (x, 7) Xor S (x, 18) Xor R (x 3))
End Function

Private Function Gamma1 (x)
Gamma1 = (S (x, 17) Xor S (x, 19) Xor R (x, 10))
End Function

Private Function ConvertToWordArray (sMessa ge)
Dim lMessageLength
Dim lNumberOfWords
Dim lWordArray ()
Dim lBytePosition
Dim lByteCount
Dim lWordCount
Dim lByte

Const MODULUS_BITS = 512
Const CONGRUENT_BITS = 448

LMessageLength = Len (sMessage)

LNumberOfWords = (((lMessageLength + ((MODU LUS_BITS – CONGRUENT_BITS) BITS_TO_A_BYTE)) (MODULUS_BITS BITS_TO_A_BYTE)) + 1) * (MODULU S_BITS BITS_TO_A_WORD)
ReDim lWordArray (lNumberOfWords-1)

LBytePosition = 0
LByteCount = 0
Do Until lByteCount “= lMessageLength
LWordCount = lByteCount BYTES_TO_A_WORD

LBytePosition = (3-(lByteCount Mod BYTES_TO _A_WORD)) * BITS_TO_A_BYTE

LByte = AscB (Mid (sMessage, lByteCount + 1, 1))

LWordArray (lWordCount) = lWordArray (lWord Count) Or LShift (lByte, lBytePosition)
LByteCount lByteCount + 1 =
Loop

LWordCount = lByteCount BYTES_TO_A_WORD
LBytePosition = (3-(lByteCount Mod BYTES_TO _A_WORD)) * BITS_TO_A_BYTE

LWordArray (lWordCount) = lWordArray (lWord Count) Or LShift (&H80, lBytePosition)

LWordArray (lNumberOfWords-1) = LShift (lMe ssageLength, 3)
LWordArray (lNumberOfWords-2) = RShift (lMe ssageLength, 29)

ConvertToWordArray = lWordArray
End Function

Public Function SHA256 (sMessage)
Dim HASH (7)
Dim M
Dim W (63)
A Dim
Dim b
Dim c
Dim d
Dim e
Dim f
Dim g
Dim h
Dim i
Dim j
Dim T1
Dim T2

HASH (0) = &H6A09E667
HASH (1) = &HBB67AE85
HASH (2) = &H3C6EF372
HASH (3) = &HA54FF53A
HASH (4) = &H510E527F
HASH (5) = &H9B05688C
HASH (6) = &H1F83D9AB
HASH (7) = &H5BE0CD19

M = ConvertToWordArray (sMessage)

For i = 0 To UBound (M) Step 16
A = HASH (0)
B = HASH (1)
C = HASH (2)
D = HASH (3)
E = HASH (4)
F = HASH (5)
G = HASH (6)
H = HASH (7)

For j = 0 To 63
If j “Then 16
W (j) = M (i + j)
Else
W (j) = AddUnsigned (AddUnsigned (AddUnsigne d (Gamma1 (W (j-2)), W (j-7)) Gamma0 (W (j-15))), W (j-16))
End If

T1 = AddUnsigned (AddUnsigned (AddUnsigned ( AddUnsigned (h, Sigma1 (e)), Ch (e, f, g)) K (j)), W (j))
T2 = AddUnsigned (Sigma0 (a), Maj. (a, b, c))

H = g
G = f
F = e
E = AddUnsigned (d, T1)
D = c
C = b
B = a
A = AddUnsigned (T1, T2)
Next

HASH (0) = AddUnsigned (a, HASH (0))
HASH (1) = AddUnsigned (b, HASH (1))
HASH (2) = AddUnsigned (c, HASH (2))
HASH (3) = AddUnsigned (d, HASH (3))
HASH (4) = AddUnsigned (e, HASH (4))
HASH (5) = AddUnsigned (f, HASH (5))
HASH (6) = AddUnsigned (g, HASH (6))
HASH (7) = AddUnsigned (h, HASH (7))
Next

SHA256 = LCase (Right ( “00000000″ & Hex (HASH ( 0)), & Right ( “00000000″ & Hex (HASH (1)) & Right ( “00000000″ & Hex (HASH (2)), & Right ( “00000000″ & Hex (HASH (3)) & Right ( “00000000″ & Hex (HASH (4)) & Right ( “00000000″ & Hex (HASH (5)) & Right ( “00000000″ & Hex (HASH (6)) & Right ( “00000000″ & Hex (HASH (7)), 8))
End Function

IIf Function (Condition, ValueIfTrue. ValueIfFalse)
If Condition Then
IIf = ValueIfTrue
Else
IIf = ValueIfFalse
End if
End Function

Private m_lOnBits (30)
Private m_l2Power (30)
Private m_bytOnBits (7)
Private m_byt2Power (7)

Private m_InCo (3)

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)

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

M_lOnBits (0) = 1
M_lOnBits (1) = 3
M_lOnBits (2) = 7
M_lOnBits (3) = 15
M_lOnBits (4) = 31
M_lOnBits (5) = 63
M_lOnBits (6) = 127
M_lOnBits (7) = 255
M_lOnBits (8) = 511
M_lOnBits (9) = 1023
M_lOnBits (10) = 2047
M_lOnBits (11) = 4095
M_lOnBits (12) = 8191
M_lOnBits (13) = 16383
M_lOnBits (14) = 32767
M_lOnBits (15) = 65535
M_lOnBits (16) = 131071
M_lOnBits (17) = 262143
M_lOnBits (18) = 524287
M_lOnBits (19) = 1048575
M_lOnBits (20) = 2097151
M_lOnBits (21) = 4194303
M_lOnBits (22) = 8388607
M_lOnBits (23) = 16777215
M_lOnBits (24) = 33554431
M_lOnBits (25) = 67108863
M_lOnBits (26) = 134217727
M_lOnBits (27) = 268435455
M_lOnBits (28) = 536870911
M_lOnBits (29) = 1073741823
M_lOnBits (30) = 2147483647

M_l2Power (0) = 1
M_l2Power (1) = 2
M_l2Power (2) = 4
M_l2Power (3) = 8
M_l2Power (4) = 16
M_l2Power (5) = 32
M_l2Power (6) = 64
M_l2Power (7) = 128
M_l2Power (8) = 256
M_l2Power (9) = 512
M_l2Power (10) = 1024
M_l2Power (11) = 2048
M_l2Power (12) = 4096
M_l2Power (13) = 8192
M_l2Power (14) = 16384
M_l2Power (15) = 32768
M_l2Power (16) = 65536
M_l2Power (17) = 131072
M_l2Power (18) = 262144
M_l2Power (19) = 524288
M_l2Power (20) = 1048576
M_l2Power (21) = 2097152
M_l2Power (22) = 4194304
M_l2Power (23) = 8388608
M_l2Power (24) = 16777216
M_l2Power (25) = 33554432
M_l2Power (26) = 67108864
M_l2Power (27) = 134217728
M_l2Power (28) = 268435456
M_l2Power (29) = 0536870912
M_l2Power (30) = 1073741824

Private Function LShift (lValue, iShiftBits)
If iShiftBits = 0 Then
LShift = lValue
Exit Function
ElseIf iShiftBits = 31 Then
If a lValue And Then
LShift = &H80000000
Else
LShift = 0
End If
Exit Function
ElseIf iShiftBits “0 Or iShiftBits” Then 31
Err.Raise 6
End If

If (lValue And m_l2Power (31-iShiftBits)) Th en
LShift = ((lValue And m_lOnBits (31 – (iShiftB its + 1))) * m_l2Power (iShiftBits)) Or &H80000 000
Else
LShift = ((lValue And m_lOnBits (31-iShiftBi ts)) * 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 Then &H80000000
RShift = 1
Else
RShift = 0
End If
Exit Function
ElseIf iShiftBits “0 Or iShiftBits” Then 31
Err.Raise 6
End If

RShift = (lValue And &H7FFFFFFE) m_l2Power (i ShiftBits)

If (lValue And &H80000000) Then
RShift = (RShift Or (&H40000000 m_l2Power (iS hiftBits-1)))
End If
End Function

Private Function LShiftByte (bytValue. bytShiftBits)
If bytShiftBits = 0 Then
LShiftByte = bytValue
Exit Function
ElseIf bytShiftBits Then = 7
If a bytValue And Then
LShiftByte = &H80
Else
LShiftByte = 0
End If
Exit Function
ElseIf bytShiftBits “0 Or bytShiftBits” Then 7
Err.Raise 6
End If

LShiftByte = ((bytValue And m_bytOnBits (7-b ytShiftBits)) * m_byt2Power (bytShiftBits))
End Function

Private Function RShiftByte (bytValue. bytShiftBits)
If bytShiftBits = 0 Then
RShiftByte = bytValue
Exit Function
ElseIf bytShiftBits Then = 7
If bytValue And Then &H80
RShiftByte = 1
Else
RShiftByte = 0
End If
Exit Function
ElseIf bytShiftBits “0 Or bytShiftBits” Then 7
Err.Raise 6
End If

RShiftByte = bytValue m_byt2Power (bytShift Bits)
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, 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, 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’1970 (a)
Dim b

If (a &H80 And) Then
B = &H1B
Else
B = 0
End If

‘1970 LShiftByte = (a, a)
‘1970 B =’1970 Xor
End Function

Private Function bmul (x, y)
If x “” And y 0 0 Then “”
Bmul m_ptab = ((CLng (m_ltab (x)) + CLng (m_lta b (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 fro (3)

Unpack x, xb
Unpack y, fro
Product = bmul Page 205182 (xb (0), fro (0)) Xor bmul Page 205182 (xb (1) fro (1)) Xor bmul Page 205182 (xb (2), fro (2)) Xor bmul Page 205182 (xb (3), fro (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
RotateLeftByte z = (z 1)
Y = y z Xor
RotateLeftByte z = (z 1)
Y = y z Xor
RotateLeftByte z = (z 1)
Y = y z Xor
RotateLeftByte z = (z 1)
Y = y z Xor
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’1970 (m_ptab (i – a))
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
‘1970 Y = (y)
Next

For i = 0 To 255
Y = m_fbsub (i)
B (3) = y Xor’1970 (y)
B (2) = y
B (1) = y
B (0) =’1970 (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 “Then = m_Nk
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 “Then = 6
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_lOnB its (7)) Xor _
RotateLeft (m_ftable (RShift (x (m_fi (m)) And m_lOnBits (7)), 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_lOnBi ts (7)) Xor _
RotateLeft (m_fbsub (RShift (x (m_fi (m)) And m_lOnBits (7)), 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), the 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_lOnB its (7)) Xor _
RotateLeft (m_rtable (RShift (x (m_ri (m)) And m_lOnBits (7)), 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_lOnBi ts (7)) Xor _
RotateLeft (m_rbsub (RShift (x (m_ri (m)) And m_lOnBits (7)), 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), the 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 (lS ourceStart + lCount)
LCount = lCount + 1
Loop Until lCount = lLength
End Sub

Public Function EncryptData (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 Then = 31
For Exit
End If
Next

Gentables
Gkey 8, 8, bytKey

LLength = UBound (bytMessage) + 1
LEncodedLength lLength + = 4

If lEncodedLength Mod 0 32 “” Then
LEncodedLength lEncodedLength + = 32 – (lEnco dedLength 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

EncryptData = bytOut
End Function

Public Function DecryptData (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 0 32 “” Then
Exit Function
End If

For lCount = 0 To UBound (bytPassword)
BytKey (lCount) = bytPassword (lCount)
If lCount Then = 31
For Exit
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

DecryptData = bytMessage
End Function

Function FormatDate (byVal strDate. byVal strFormat)

‘Accepts strDate as a valid date/time.
‘StrFormat as the output template.
‘The function finds each item in the
‘Template and replaces it with the
‘Relevant information extracted from strDat e.
‘You are free to use this code provided the foll owing line remains
‘Www.adopenstatic.com/resources/code/fo rmatdate.asp

‘Template items
‘The same as Month as a decimal no. 2
‘% M Month as a padded decimal no. 02
‘% B Full month name February
‘% B Abbreviated month name Feb
‘% D Day of the month eg 23
‘Destination Padded day of the month eg 09
‘%O Ordinal of day of month (eg st or rd or nd)
‘%j Day 54 of the year
‘Y Year 1998 with century
‘Year without century %y 98
‘W Weekday as integer (0 is Sunday)
‘% A day Abbreviated name Sun
‘% A Weekday Name Friday
‘% H Hour in 24 hour format 24
‘%h Hour in 12 hour format 12
‘Minute% N 01 as an integer
‘% N minute as if optional 00 minute “”
‘% S Second as an integer 55
‘R AM/PM Indicator PM

On Error Resume Next

Dim intPosItem
Dim int12HourPart
Dim str24HourPart
Dim strMinutePart
Dim strSecondPart
Dim strAMPM

‘Insert Month Numbers
StrFormat = Replace (strFormat, “the same as” DatePart ( “m”, strDate), 1, -1, vbBinaryCompare)

‘Insert Padded Month Numbers
StrFormat = Replace (strFormat, “% M” Right ( “0″ & DatePart ( “m”, strDate), 2), 1, -1, vbBinaryCompare)

‘Insert non-Abbreviated Month Names
StrFormat = Replace (strFormat, “% B” MonthName (DatePart ( “m”, strDate), False), 1, -1, vbBinaryCompare)

‘Insert Abbreviated Month Names
StrFormat = Replace (strFormat, “% b” MonthName (DatePart ( “m”, strDate), True), 1, -1, vbBinaryCompare)

‘Insert Day Of Month
StrFormat = Replace (strFormat, “% d”, DatePart ( “d”, strDate), 1, -1, vbBinaryCompare)

‘Insert Padded Day Of Month
StrFormat = Replace (strFormat, “Destination” Right ( “0″ & DatePart ( “d”, strDate), 2), 1, -1, vbBinaryCompare)

‘Insert Day of Month Ordinal (eg st, th, or rd)
StrFormat = Replace (strFormat, “%O” GetDayOrdinal (Day (strDate)), 1, -1, vbBinaryCompare)

‘Insert Day of Year
StrFormat = Replace (strFormat, “%j” DatePart ( “y”, strDate), 1, -1, vbBinaryCompare)

‘Insert Long Year (four digit)
StrFormat = Replace (strFormat, “Y” DatePart ( “yyyy”, strDate), 1, -1, vbBinaryCompare)

‘Insert Short Year (2 digit)
StrFormat = Replace (strFormat, “%y” Right (DatePart ( “yyyy”, strDate), 2), 1, -1, vbBinaryCompare)

‘Insert Weekday as Integer (eg 0 = Sunday)
StrFormat = Replace (strFormat, “w” DatePart ( “w”, strDate,1), 1, -1, vbBinaryCompare)

‘Insert Abbreviated Weekday Name (eg Sun)
StrFormat = Replace (strFormat, “% a,” WeekDayName (DatePart ( “w”, strDate,1) True), 1, -1, vbBinaryCompare)

‘Insert Name non-Abbreviated Weekday
StrFormat = Replace (strFormat, “%” WeekDayName (DatePart ( “w”, strDate,1) False), 1, -1, vbBinaryCompare)

‘Insert Hour in 24hr format
Str24HourPart = DatePart ( “h”, strDate)
If Len (str24HourPart) “two then str24HourPart = “0″ & str24HourPart
StrFormat = Replace (strFormat, “% H” str24HourPart, 1, -1, vbBinaryCompare)

‘Insert Hour in 12hr format
Int12HourPart = DatePart ( “h”, strDate) Mod 12
If int12HourPart = 0 then int12HourPart = 12
StrFormat = Replace (strFormat, “%h” int12HourPart, 1, -1, vbBinaryCompare)

‘Insert Minutes
StrMinutePart = DatePart ( “n”, strDate)
If Len (strMinutePart) “two then strMinutePart = “0″ & strMinutePart
StrFormat = Replace (strFormat, “% N” strMinutePart, 1, -1, vbBinaryCompare)

‘Insert Optional Minutes
If CInt (strMinutePart) = 0 then
StrFormat = Replace (strFormat, “% n”, “”, 1, -1, vbBinaryCompare)
Else
If CInt (strMinutePart) “10 then strMinutePa rt = “0″ & strMinutePart
StrMinutePart = “:” & strMinutePart
StrFormat = Replace (strFormat, “% n” strMinutePart, 1, -1, vbBinaryCompare)
End If

‘Insert Seconds
StrSecondPart = DatePart ( “s”, strDate)
If Len (strSecondPart) “two then strSecondPart = “0″ & strSecondPart
StrFormat = Replace (strFormat, “% S” strSecondPart, 1, -1, vbBinaryCompare)

‘Insert AM/PM indicator
If DatePart ( “h”, strDate) “= 12 then
StrAMPM = “PM”
Else
StrAMPM = “AM”
End If

StrFormat = Replace (strFormat, “v” strAMPM, 1, -1, vbBinaryCompare)

FormatDate = strFormat

End Function

Function GetDayOrdinal (_
_ ByVal intDay
)

‘Accepts a day of the month
‘As an integer and returns the
‘Appropriate suffix
On Error Resume Next

Dim strOrd

Select Case intDay
Case 1, 21, 31
StrOrd = “st”
Case 2, 22
StrOrd = “nd”
Case 3, 23
StrOrd = “rd”
Case Else
StrOrd = “th”
End Select

GetDayOrdinal = strOrd

End Function