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