<%
Private Const BITS_TO_A_BYTE3 = 8
Private Const BYTES_TO_A_WORD3 = 4
Private Const BITS_TO_A_WORD3 = 32

Private m_lOnBits3(30)
Private m_l2Power3(30)

Private Function LShift3(lValue3, iShiftBits3)
If iShiftBits3 = 0 Then
LShift3 = lValue3
Exit Function
ElseIf iShiftBits3 = 31 Then
If lValue3 And 1 Then
LShift3 = &H80000000
Else
LShift3 = 0
End If
Exit Function
ElseIf iShiftBits3 < 0 Or iShiftBits3 > 31 Then
Err.Raise 6
End If

If (lValue3 And m_l2Power3(31 - iShiftBits3)) Then
LShift3 = ((lValue3 And m_lOnBits3(31 - (iShiftBits3 + 1))) * m_l2Power3(iShiftBits3)) Or &H80000000
Else
LShift3 = ((lValue3 And m_lOnBits3(31 - iShiftBits3)) * m_l2Power3(iShiftBits3))
End If
End Function

Private Function RShift3(lValue3, iShiftBits3)
If iShiftBits3 = 0 Then
RShift3 = lValue3
Exit Function
ElseIf iShiftBits3 = 31 Then
If lValue3 And &H80000000 Then
RShift3 = 1
Else
RShift3 = 0
End If
Exit Function
ElseIf iShiftBits3 < 0 Or iShiftBits3 > 31 Then
Err.Raise 6
End If

RShift3 = (lValue3 And &H7FFFFFFE) \ m_l2Power3(iShiftBits3)

If (lValue3 And &H80000000) Then
RShift3 = (RShift3 Or (&H40000000 \ m_l2Power3(iShiftBits3 - 1)))
End If
End Function

Private Function RotateLeft3(lValue3, iShiftBits3)
RotateLeft3 = LShift3(lValue3, iShiftBits3) Or RShift3(lValue3, (32 - iShiftBits3))
End Function

Private Function AddUnsigned3(lX3, lY3)
Dim lX43
Dim lY43
Dim lX83
Dim lY83
Dim lResult3

lX83 = lX3 And &H80000000
lY83 = lY3 And &H80000000
lX43 = lX3 And &H40000000
lY43 = lY3 And &H40000000

lResult3 = (lX3 And &H3FFFFFFF) + (lY3 And &H3FFFFFFF)

If lX43 And lY43 Then
lResult3 = lResult3 Xor &H80000000 Xor lX83 Xor lY83
ElseIf lX43 Or lY43 Then
If lResult3 And &H40000000 Then
lResult3 = lResult3 Xor &HC0000000 Xor lX83 Xor lY83
Else
lResult3 = lResult3 Xor &H40000000 Xor lX83 Xor lY83
End If
Else
lResult3 = lResult3 Xor lX83 Xor lY83
End If

AddUnsigned3 = lResult3
End Function

Private Function md5_F3(x3, y, z)
md5_F3 = (x3 And y) Or ((Not x3) And z)
End Function

Private Function md5_G3(x3, y, z)
md5_G3 = (x3 And z) Or (y And (Not z))
End Function

Private Function md5_H3(x3, y, z)
md5_H3 = (x3 Xor y Xor z)
End Function

Private Function md5_I3(x3, y, z)
md5_I3 = (y Xor (x3 Or (Not z)))
End Function

Private Sub md5_FF3(a3, b3, c3, d3, x3, s, ac)
a3 = AddUnsigned3(a3, AddUnsigned3(AddUnsigned3(md5_F3(b3, c3, d3), x3), ac))
a3 = RotateLeft3(a3, s)
a3 = AddUnsigned3(a3, b3)
End Sub

Private Sub md5_GG3(a3, b3, c3, d3, x3, s, ac)
a3 = AddUnsigned3(a3, AddUnsigned3(AddUnsigned3(md5_G3(b3, c3, d3), x3), ac))
a3 = RotateLeft3(a3, s)
a3 = AddUnsigned3(a3, b3)
End Sub

Private Sub md5_HH3(a3, b3, c3, d3, x3, s, ac)
a3 = AddUnsigned3(a3, AddUnsigned3(AddUnsigned3(md5_H3(b3, c3, d3), x3), ac))
a3 = RotateLeft3(a3, s)
a3 = AddUnsigned3(a3, b3)
End Sub

Private Sub md5_II3(a3, b3, c3, d3, x3, s, ac)
a3 = AddUnsigned3(a3, AddUnsigned3(AddUnsigned3(md5_I3(b3, c3, d3), x3), ac))
a3 = RotateLeft3(a3, s)
a3 = AddUnsigned3(a3, b3)
End Sub

Private Function ConvertToWordArray3(sMessage3)
Dim lMessageLength3
Dim lNumberOfWords3
Dim lWordArray3()
Dim lBytePosition3
Dim lByteCount3
Dim lWordCount3

Const MODULUS_BITS3 = 512
Const CONGRUENT_BITS3 = 448

lMessageLength3 = Len(sMessage3)

lNumberOfWords3 = (((lMessageLength3 + ((MODULUS_BITS3 - CONGRUENT_BITS3) \ BITS_TO_A_BYTE3)) \ (MODULUS_BITS3 \ BITS_TO_A_BYTE3)) + 1) * (MODULUS_BITS3 \ BITS_TO_A_WORD3)
ReDim lWordArray3(lNumberOfWords3 - 1)

lBytePosition3 = 0
lByteCount3 = 0
Do Until lByteCount3 >= lMessageLength3
lWordCount3 = lByteCount3 \ BYTES_TO_A_WORD3
lBytePosition3 = (lByteCount3 Mod BYTES_TO_A_WORD3) * BITS_TO_A_BYTE3
lWordArray3(lWordCount3) = lWordArray3(lWordCount3) Or LShift3(Asc(Mid(sMessage3, lByteCount3 + 1, 1)), lBytePosition3)
lByteCount3 = lByteCount3 + 1
Loop

lWordCount3 = lByteCount3 \ BYTES_TO_A_WORD3
lBytePosition3 = (lByteCount3 Mod BYTES_TO_A_WORD3) * BITS_TO_A_BYTE3

lWordArray3(lWordCount3) = lWordArray3(lWordCount3) Or LShift3(&H80, lBytePosition3)

lWordArray3(lNumberOfWords3 - 2) = LShift3(lMessageLength3, 3)
lWordArray3(lNumberOfWords3 - 1) = RShift3(lMessageLength3, 29)

ConvertToWordArray3 = lWordArray3
End Function

Private Function WordToHex3(lValue3)
Dim lByte3
Dim lCount3

For lCount3 = 0 To 3
lByte3 = RShift3(lValue3, lCount3 * BITS_TO_A_BYTE3) And m_lOnBits3(BITS_TO_A_BYTE3 - 1)
WordToHex3 = WordToHex3 & Right("0" & Hex(lByte3), 2)
Next
End Function

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

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


Dim x3
Dim k3
Dim AA3
Dim BB3
Dim CC3
Dim DD3
Dim a3
Dim b3
Dim c3
Dim d3

Const S113 = 7
Const S123 = 12
Const S133 = 17
Const S143 = 22
Const S213 = 5
Const S223 = 9
Const S233 = 14
Const S243 = 20
Const S313 = 4
Const S323 = 11
Const S333 = 16
Const S343 = 23
Const S413 = 6
Const S423 = 10
Const S433 = 15
Const S443 = 21

x3 = ConvertToWordArray3(sMessage3)

a3 = &H67452301
b3 = &HEFCDAB89
c3 = &H98BADCFE
d3 = &H10325476

For k3 = 0 To UBound(x3) Step 16
AA3 = a3
BB3 = b3
CC3 = c3
DD3 = d3

md5_FF3 a3, b3, c3, d3, x3(k3 + 0), S113, &HD76AA478
md5_FF3 d3, a3, b3, c3, x3(k3 + 1), S123, &HE8C7B756
md5_FF3 c3, d3, a3, b3, x3(k3 + 2), S133, &H242070DB
md5_FF3 b3, c3, d3, a3, x3(k3 + 3), S143, &HC1BDCEEE
md5_FF3 a3, b3, c3, d3, x3(k3 + 4), S113, &HF57C0FAF
md5_FF3 d3, a3, b3, c3, x3(k3 + 5), S123, &H4787C62A
md5_FF3 c3, d3, a3, b3, x3(k3 + 6), S133, &HA8304613
md5_FF3 b3, c3, d3, a3, x3(k3 + 7), S143, &HFD469501
md5_FF3 a3, b3, c3, d3, x3(k3 + 8), S113, &H698098D8
md5_FF3 d3, a3, b3, c3, x3(k3 + 9), S123, &H8B44F7AF
md5_FF3 c3, d3, a3, b3, x3(k3 + 10), S133, &HFFFF5BB1
md5_FF3 b3, c3, d3, a3, x3(k3 + 11), S143, &H895CD7BE
md5_FF3 a3, b3, c3, d3, x3(k3 + 12), S113, &H6B901122
md5_FF3 d3, a3, b3, c3, x3(k3 + 13), S123, &HFD987193
md5_FF3 c3, d3, a3, b3, x3(k3 + 14), S133, &HA679438E
md5_FF3 b3, c3, d3, a3, x3(k3 + 15), S143, &H49B40821

md5_GG3 a3, b3, c3, d3, x3(k3 + 1), S213, &HF61E2562
md5_GG3 d3, a3, b3, c3, x3(k3 + 6), S223, &HC040B340
md5_GG3 c3, d3, a3, b3, x3(k3 + 11), S233, &H265E5A51
md5_GG3 b3, c3, d3, a3, x3(k3 + 0), S243, &HE9B6C7AA
md5_GG3 a3, b3, c3, d3, x3(k3 + 5), S213, &HD62F105D
md5_GG3 d3, a3, b3, c3, x3(k3 + 10), S223, &H2441453
md5_GG3 c3, d3, a3, b3, x3(k3 + 15), S233, &HD8A1E681
md5_GG3 b3, c3, d3, a3, x3(k3 + 4), S243, &HE7D3FBC8
md5_GG3 a3, b3, c3, d3, x3(k3 + 9), S213, &H21E1CDE6
md5_GG3 d3, a3, b3, c3, x3(k3 + 14), S223, &HC33707D6
md5_GG3 c3, d3, a3, b3, x3(k3 + 3), S233, &HF4D50D87
md5_GG3 b3, c3, d3, a3, x3(k3 + 8), S243, &H455A14ED
md5_GG3 a3, b3, c3, d3, x3(k3 + 13), S213, &HA9E3E905
md5_GG3 d3, a3, b3, c3, x3(k3 + 2), S223, &HFCEFA3F8
md5_GG3 c3, d3, a3, b3, x3(k3 + 7), S233, &H676F02D9
md5_GG3 b3, c3, d3, a3, x3(k3 + 12), S243, &H8D2A4C8A

md5_HH3 a3, b3, c3, d3, x3(k3 + 5), S313, &HFFFA3942
md5_HH3 d3, a3, b3, c3, x3(k3 + 8), S323, &H8771F681
md5_HH3 c3, d3, a3, b3, x3(k3 + 11), S333, &H6D9D6122
md5_HH3 b3, c3, d3, a3, x3(k3 + 14), S343, &HFDE5380C
md5_HH3 a3, b3, c3, d3, x3(k3 + 1), S313, &HA4BEEA44
md5_HH3 d3, a3, b3, c3, x3(k3 + 4), S323, &H4BDECFA9
md5_HH3 c3, d3, a3, b3, x3(k3 + 7), S333, &HF6BB4B60
md5_HH3 b3, c3, d3, a3, x3(k3 + 10), S343, &HBEBFBC70
md5_HH3 a3, b3, c3, d3, x3(k3 + 13), S313, &H289B7EC6
md5_HH3 d3, a3, b3, c3, x3(k3 + 0), S323, &HEAA127FA
md5_HH3 c3, d3, a3, b3, x3(k3 + 3), S333, &HD4EF3085
md5_HH3 b3, c3, d3, a3, x3(k3 + 6), S343, &H4881D05
md5_HH3 a3, b3, c3, d3, x3(k3 + 9), S313, &HD9D4D039
md5_HH3 d3, a3, b3, c3, x3(k3 + 12), S323, &HE6DB99E5
md5_HH3 c3, d3, a3, b3, x3(k3 + 15), S333, &H1FA27CF8
md5_HH3 b3, c3, d3, a3, x3(k3 + 2), S343, &HC4AC5665

md5_II3 a3, b3, c3, d3, x3(k3 + 0), S413, &HF4292244
md5_II3 d3, a3, b3, c3, x3(k3 + 7), S423, &H432AFF97
md5_II3 c3, d3, a3, b3, x3(k3 + 14), S433, &HAB9423A7
md5_II3 b3, c3, d3, a3, x3(k3 + 5), S443, &HFC93A039
md5_II3 a3, b3, c3, d3, x3(k3 + 12), S413, &H655B59C3
md5_II3 d3, a3, b3, c3, x3(k3 + 3), S423, &H8F0CCC92
md5_II3 c3, d3, a3, b3, x3(k3 + 10), S433, &HFFEFF47D
md5_II3 b3, c3, d3, a3, x3(k3 + 1), S443, &H85845DD1
md5_II3 a3, b3, c3, d3, x3(k3 + 8), S413, &H6FA87E4F
md5_II3 d3, a3, b3, c3, x3(k3 + 15), S423, &HFE2CE6E0
md5_II3 c3, d3, a3, b3, x3(k3 + 6), S433, &HA3014314
md5_II3 b3, c3, d3, a3, x3(k3 + 13), S443, &H4E0811A1
md5_II3 a3, b3, c3, d3, x3(k3 + 4), S413, &HF7537E82
md5_II3 d3, a3, b3, c3, x3(k3 + 11), S423, &HBD3AF235
md5_II3 c3, d3, a3, b3, x3(k3 + 2), S433, &H2AD7D2BB
md5_II3 b3, c3, d3, a3, x3(k3 + 9), S443, &HEB86D391

a3 = AddUnsigned3(a3, AA3)
b3 = AddUnsigned3(b3, BB3)
c3 = AddUnsigned3(c3, CC3)
d3 = AddUnsigned3(d3, DD3)
Next

MD53 = LCase(WordToHex3(a3) & WordToHex3(b3) & WordToHex3(c3) & WordToHex3(d3))


End Function


%> 
