1 <%
2 Private Const BITS_TO_A_BYTE=8
3 Private Const BYTES_TO_A_WORD=4
4 Private Const BITS_TO_A_WORD=32
5 Private m_lOnBits(30)
6 Private m_l2Power(30)
7 m_lOnBits(0)=CLng(1)
8 m_lOnBits(1)=CLng(3)
9 m_lOnBits(2)=CLng(7)
10 m_lOnBits(3)=CLng(15)
11 m_lOnBits(4)=CLng(31)
12 m_lOnBits(5)=CLng(63)
13 m_lOnBits(6)=CLng(127)
14 m_lOnBits(7)=CLng(255)
15 m_lOnBits(8)=CLng(511)
16 m_lOnBits(9)=CLng(1023)
17 m_lOnBits(10)=CLng(2047)
18 m_lOnBits(11)=CLng(4095)
19 m_lOnBits(12)=CLng(8191)
20 m_lOnBits(13)=CLng(16383)
21 m_lOnBits(14)=CLng(32767)
22 m_lOnBits(15)=CLng(65535)
23 m_lOnBits(16)=CLng(131071)
24 m_lOnBits(17)=CLng(262143)
25 m_lOnBits(18)=CLng(524287)
26 m_lOnBits(19)=CLng(1048575)
27 m_lOnBits(20)=CLng(2097151)
28 m_lOnBits(21)=CLng(4194303)
29 m_lOnBits(22)=CLng(8388607)
30 m_lOnBits(23)=CLng(16777215)
31 m_lOnBits(24)=CLng(33554431)
32 m_lOnBits(25)=CLng(67108863)
33 m_lOnBits(26)=CLng(134217727)
34 m_lOnBits(27)=CLng(268435455)
35 m_lOnBits(28)=CLng(536870911)
36 m_lOnBits(29)=CLng(1073741823)
37 m_lOnBits(30)=CLng(2147483647)
38
39 m_l2Power(0)=CLng(1)
40 m_l2Power(1)=CLng(2)
41 m_l2Power(2)=CLng(4)
42 m_l2Power(3)=CLng(8)
43 m_l2Power(4)=CLng(16)
44 m_l2Power(5)=CLng(32)
45 m_l2Power(6)=CLng(64)
46 m_l2Power(7)=CLng(128)
47 m_l2Power(8)=CLng(256)
48 m_l2Power(9)=CLng(512)
49 m_l2Power(10)=CLng(1024)
50 m_l2Power(11)=CLng(2048)
51 m_l2Power(12)=CLng(4096)
52 m_l2Power(13)=CLng(8192)
53 m_l2Power(14)=CLng(16384)
54 m_l2Power(15)=CLng(32768)
55 m_l2Power(16)=CLng(65536)
56 m_l2Power(17)=CLng(131072)
57 m_l2Power(18)=CLng(262144)
58 m_l2Power(19)=CLng(524288)
59 m_l2Power(20)=CLng(1048576)
60 m_l2Power(21)=CLng(2097152)
61 m_l2Power(22)=CLng(4194304)
62 m_l2Power(23)=CLng(8388608)
63 m_l2Power(24)=CLng(16777216)
64 m_l2Power(25)=CLng(33554432)
65 m_l2Power(26)=CLng(67108864)
66 m_l2Power(27)=CLng(134217728)
67 m_l2Power(28)=CLng(268435456)
68 m_l2Power(29)=CLng(536870912)
69 m_l2Power(30)=CLng(1073741824)
70
71 Private Function LShift(lValue,iShiftBits)
72 If iShiftBits=0 Then
73 LShift=lValue
74 Exit Function
75 ElseIf iShiftBits=31 Then
76 If lValue And 1 Then
77 LShift=&H80000000
78 Else
79 LShift=0
80 End If
81 Exit Function
82 ElseIf iShiftBits<0 Or iShiftBits>31 Then
83 Err.Raise 6
84 End If
85
86 If (lValue And m_l2Power(31-iShiftBits)) Then
87 LShift=((lValue And m_lOnBits(31-(iShiftBits+1)))*m_l2Power(iShiftBits)) Or &H80000000
88 Else
89 LShift=((lValue And m_lOnBits(31-iShiftBits))*m_l2Power(iShiftBits))
90 End If
91 End Function
92
93 Private Function RShift(lValue,iShiftBits)
94 If iShiftBits=0 Then
95 RShift=lValue
96 Exit Function
97 ElseIf iShiftBits=31 Then
98 If lValue And &H80000000 Then
99 RShift=1
100 Else
101 RShift=0
102 End If
103 Exit Function
104 ElseIf iShiftBits<0 Or iShiftBits>31 Then
105 Err.Raise 6
106 End If
107
108 RShift=(lValue And &H7FFFFFFE)\m_l2Power(iShiftBits)
109
110 If (lValue And &H80000000) Then
111 RShift=(RShift Or (&H40000000\m_l2Power(iShiftBits-1)))
112 End If
113 End Function
114
115 Private Function RotateLeft(lValue,iShiftBits)
116 RotateLeft=LShift(lValue,iShiftBits) Or RShift(lValue,(32-iShiftBits))
117 End Function
118
119 Private Function AddUnsigned(lX,lY)
120 Dim lX4
121 Dim lY4
122 Dim lX8
123 Dim lY8
124 Dim lResult
125
126 lX8=lX And &H80000000
127 lY8=lY And &H80000000
128 lX4=lX And &H40000000
129 lY4=lY And &H40000000
130
131 lResult=(lX And &H3FFFFFFF)+(lY And &H3FFFFFFF)
132
133 If lX4 And lY4 Then
134 lResult=lResult Xor &H80000000 Xor lX8 Xor lY8
135 ElseIf lX4 Or lY4 Then
136 If lResult And &H40000000 Then
137 lResult=lResult Xor &HC0000000 Xor lX8 Xor lY8
138 Else
139 lResult=lResult Xor &H40000000 Xor lX8 Xor lY8
140 End If
141 Else
142 lResult=lResult Xor lX8 Xor lY8
143 End If
144
145 AddUnsigned=lResult
146 End Function
147
148 Private Function F(x,y,z)
149 F=(x And y) Or ((Not x) And z)
150 End Function
151
152 Private Function G(x,y,z)
153 G=(x And z) Or (y And (Not z))
154 End Function
155
156 Private Function H(x,y,z)
157 H=(x Xor y Xor z)
158 End Function
159
160 Private Function I(x,y,z)
161 I=(y Xor (x Or (Not z)))
162 End Function
163
164 Private Sub FF(a,b,c,d,x,s,ac)
165 a=AddUnsigned(a,AddUnsigned(AddUnsigned(F(b,c,d),x),ac))
166 a=RotateLeft(a,s)
167 a=AddUnsigned(a,b)
168 End Sub
169
170 Private Sub GG(a,b,c,d,x,s,ac)
171 a=AddUnsigned(a,AddUnsigned(AddUnsigned(G(b,c,d),x),ac))
172 a=RotateLeft(a,s)
173 a=AddUnsigned(a,b)
174 End Sub
175
176 Private Sub HH(a,b,c,d,x,s,ac)
177 a=AddUnsigned(a,AddUnsigned(AddUnsigned(H(b,c,d),x),ac))
178 a=RotateLeft(a,s)
179 a=AddUnsigned(a,b)
180 End Sub
181
182 Private Sub II(a,b,c,d,x,s,ac)
183 a=AddUnsigned(a,AddUnsigned(AddUnsigned(I(b,c,d),x),ac))
184 a=RotateLeft(a,s)
185 a=AddUnsigned(a,b)
186 End Sub
187
188 Private Function ConvertToWordArray(sMessage)
189 Dim lMessageLength
190 Dim lNumberOfWords
191 Dim lWordArray()
192 Dim lBytePosition
193 Dim lByteCount
194 Dim lWordCount
195
196 Const MODULUS_BITS=512
197 Const CONGRUENT_BITS=448
198
199 lMessageLength=Len(sMessage)
200
201 lNumberOfWords=(((lMessageLength+((MODULUS_BITS-CONGRUENT_BITS)\BITS_TO_A_BYTE))\(MODULUS_BITS\BITS_TO_A_BYTE))+1)*(MODULUS_BITS\BITS_TO_A_WORD)
202 ReDim lWordArray(lNumberOfWords-1)
203
204 lBytePosition=0
205 lByteCount=0
206 Do Until lByteCount >=lMessageLength
207 lWordCount=lByteCount\BYTES_TO_A_WORD
208 lBytePosition=(lByteCount Mod BYTES_TO_A_WORD)*BITS_TO_A_BYTE
209 lWordArray(lWordCount)=lWordArray(lWordCount) Or LShift(Asc(Mid(sMessage,lByteCount+1,1)),lBytePosition)
210 lByteCount=lByteCount+1
211 Loop
212
213 lWordCount=lByteCount\BYTES_TO_A_WORD
214 lBytePosition=(lByteCount Mod BYTES_TO_A_WORD)*BITS_TO_A_BYTE
215
216 lWordArray(lWordCount)=lWordArray(lWordCount) Or LShift(&H80,lBytePosition)
217
218 lWordArray(lNumberOfWords-2)=LShift(lMessageLength,3)
219 lWordArray(lNumberOfWords-1)=RShift(lMessageLength,29)
220
221 ConvertToWordArray=lWordArray
222 End Function
223
224 Private Function WordToHex(lValue)
225 Dim lByte
226 Dim lCount
227
228 For lCount=0 To 3
229 lByte=RShift(lValue,lCount*BITS_TO_A_BYTE) And m_lOnBits(BITS_TO_A_BYTE-1)
230 WordToHex=WordToHex & Right("0" & Hex(lByte),2)
231 Next
232 End Function
233
234 Public Function MD5(sMessage)
235 Dim x
236 Dim k
237 Dim AA
238 Dim BB
239 Dim CC
240 Dim DD
241 Dim a
242 Dim b
243 Dim c
244 Dim d
245
246 Const S11=7
247 Const S12=12
248 Const S13=17
249 Const S14=22
250 Const S21=5
251 Const S22=9
252 Const S23=14
253 Const S24=20
254 Const S31=4
255 Const S32=11
256 Const S33=16
257 Const S34=23
258 Const S41=6
259 Const S42=10
260 Const S43=15
261 Const S44=21
262
263 x=ConvertToWordArray(sMessage)
264
265 a=&H67452301
266 b=&HEFCDAB89
267 c=&H98BADCFE
268 d=&H10325476
269
270 For k=0 To UBound(x) Step 16
271 AA=a
272 BB=b
273 CC=c
274 DD=d
275
276 FF a,b,c,d,x(k+0),S11,&HD76AA478
277 FF d,a,b,c,x(k+1),S12,&HE8C7B756
278 FF c,d,a,b,x(k+2),S13,&H242070DB
279 FF b,c,d,a,x(k+3),S14,&HC1BDCEEE
280 FF a,b,c,d,x(k+4),S11,&HF57C0FAF
281 FF d,a,b,c,x(k+5),S12,&H4787C62A
282 FF c,d,a,b,x(k+6),S13,&HA8304613
283 FF b,c,d,a,x(k+7),S14,&HFD469501
284 FF a,b,c,d,x(k+8),S11,&H698098D8
285 FF d,a,b,c,x(k+9),S12,&H8B44F7AF
286 FF c,d,a,b,x(k+10),S13,&HFFFF5BB1
287 FF b,c,d,a,x(k+11),S14,&H895CD7BE
288 FF a,b,c,d,x(k+12),S11,&H6B901122
289 FF d,a,b,c,x(k+13),S12,&HFD987193
290 FF c,d,a,b,x(k+14),S13,&HA679438E
291 FF b,c,d,a,x(k+15),S14,&H49B40821
292
293 GG a,b,c,d,x(k+1),S21,&HF61E2562
294 GG d,a,b,c,x(k+6),S22,&HC040B340
295 GG c,d,a,b,x(k+11),S23,&H265E5A51
296 GG b,c,d,a,x(k+0),S24,&HE9B6C7AA
297 GG a,b,c,d,x(k+5),S21,&HD62F105D
298 GG d,a,b,c,x(k+10),S22,&H2441453
299 GG c,d,a,b,x(k+15),S23,&HD8A1E681
300 GG b,c,d,a,x(k+4),S24,&HE7D3FBC8
301 GG a,b,c,d,x(k+9),S21,&H21E1CDE6
302 GG d,a,b,c,x(k+14),S22,&HC33707D6
303 GG c,d,a,b,x(k+3),S23,&HF4D50D87
304 GG b,c,d,a,x(k+8),S24,&H455A14ED
305 GG a,b,c,d,x(k+13),S21,&HA9E3E905
306 GG d,a,b,c,x(k+2),S22,&HFCEFA3F8
307 GG c,d,a,b,x(k+7),S23,&H676F02D9
308 GG b,c,d,a,x(k+12),S24,&H8D2A4C8A
309
310 HH a,b,c,d,x(k+5),S31,&HFFFA3942
311 HH d,a,b,c,x(k+8),S32,&H8771F681
312 HH c,d,a,b,x(k+11),S33,&H6D9D6122
313 HH b,c,d,a,x(k+14),S34,&HFDE5380C
314 HH a,b,c,d,x(k+1),S31,&HA4BEEA44
315 HH d,a,b,c,x(k+4),S32,&H4BDECFA9
316 HH c,d,a,b,x(k+7),S33,&HF6BB4B60
317 HH b,c,d,a,x(k+10),S34,&HBEBFBC70
318 HH a,b,c,d,x(k+13),S31,&H289B7EC6
319 HH d,a,b,c,x(k+0),S32,&HEAA127FA
320 HH c,d,a,b,x(k+3),S33,&HD4EF3085
321 HH b,c,d,a,x(k+6),S34,&H4881D05
322 HH a,b,c,d,x(k+9),S31,&HD9D4D039
323 HH d,a,b,c,x(k+12),S32,&HE6DB99E5
324 HH c,d,a,b,x(k+15),S33,&H1FA27CF8
325 HH b,c,d,a,x(k+2),S34,&HC4AC5665
326
327 II a,b,c,d,x(k+0),S41,&HF4292244
328 II d,a,b,c,x(k+7),S42,&H432AFF97
329 II c,d,a,b,x(k+14),S43,&HAB9423A7
330 II b,c,d,a,x(k+5),S44,&HFC93A039
331 II a,b,c,d,x(k+12),S41,&H655B59C3
332 II d,a,b,c,x(k+3),S42,&H8F0CCC92
333 II c,d,a,b,x(k+10),S43,&HFFEFF47D
334 II b,c,d,a,x(k+1),S44,&H85845DD1
335 II a,b,c,d,x(k+8),S41,&H6FA87E4F
336 II d,a,b,c,x(k+15),S42,&HFE2CE6E0
337 II c,d,a,b,x(k+6),S43,&HA3014314
338 II b,c,d,a,x(k+13),S44,&H4E0811A1
339 II a,b,c,d,x(k+4),S41,&HF7537E82
340 II d,a,b,c,x(k+11),S42,&HBD3AF235
341 II c,d,a,b,x(k+2),S43,&H2AD7D2BB
342 II b,c,d,a,x(k+9),S44,&HEB86D391
343
344 a=AddUnsigned(a,AA)
345 b=AddUnsigned(b,BB)
346 c=AddUnsigned(c,CC)
347 d=AddUnsigned(d,DD)
348 Next
349
350 MD5=LCase(WordToHex(a) & WordToHex(b) & WordToHex(c) & WordToHex(d))
351 End Function
352 %>