1 {*******************************************************}
2 { }
3 { Delphi Visual Component Library }
4 { }
5 { Copyright(c) 1995-2010 Embarcadero Technologies, Inc. }
6 { }
7 { Message-digest algorithm based on C sample }
8 { provided in Appendix section of }
9 { Rivest-MD5.TXT available at: }
10 { http://theory.lcs.mit.edu/~rivest/Rivest-MD5.txt }
11 { }
12 {*******************************************************}
13 unit MessageDigest_5;
14
15 interface
16
17 uses Types;
18
19 type
20
21 IMD5 = interface
22 ['{887C9EF0-15B9-41B4-A403-0431793B6E41}']
23 procedure Init;
24 procedure Update(const Input: TByteDynArray; Len: Longword); overload;
25 procedure Update(const Input: string); overload;
26 function Final: TByteDynArray;
27 function AsString: string;
28 function AsGUID: string;
29 end;
30
31 function GetMD5: IMD5;
32
33 implementation
34
35 const
36 S11 = 7;
37 S12 = 12;
38 S13 = 17;
39 S14 = 22;
40
41 S21 = 5;
42 S22 = 9;
43 S23 = 14;
44 S24 = 20;
45
46 S31 = 4;
47 S32 = 11;
48 S33 = 16;
49 S34 = 23;
50
51 S41 = 6;
52 S42 = 10;
53 S43 = 15;
54 S44 = 21;
55
56 var
57 padding: TByteDynArray;
58
59 type
60
61 ArrayOfLWord= array of Longword;
62
63 TMD5 = class(TInterfacedObject, IMD5)
64 private
65 FContextState: ArrayOfLWord;
66 FContextCount: ArrayOfLWord;
67 FContextBuffer: TByteDynArray;
68 public
69 constructor Create;
70 procedure Init; virtual;
71 procedure Update(const Input: TByteDynArray; Len: Longword); overload; virtual;
72 procedure Update(const Input: string); overload; virtual;
73 function Final: TByteDynArray; virtual;
74 procedure Transform(const block: TByteDynArray; shift: Integer);
75 procedure Decode(var Dst: ArrayOfLWord; const Src: TByteDynArray; Len: Integer; shift: Integer);
76 procedure Encode(var Dst: TByteDynArray; const Src: ArrayOfLWord; Len: Integer);
77 function AsString: string;
78 function AsGUID: string;
79 end;
80
81 function GetMD5: IMD5;
82 begin
83 Result := TMD5.Create;
84 end;
85
86 constructor TMD5.Create;
87 begin
88 inherited Create;
89 Init;
90 end;
91
92 procedure TMD5.Init;
93 begin
94 SetLength(FContextCount, 2);
95 FContextCount[0] := 0;
96 FContextCount[1] := 0;
97 SetLength(FContextState, 4);
98 FContextState[0] := $67452301;
99 FContextState[1] := $efcdab89;
100 FContextState[2] := $98badcfe;
101 FContextState[3] := $10325476;
102 SetLength(FContextBuffer, 64);
103 end;
104
105 procedure TMD5.Update(const Input: string);
106 var
107 {$IFDEF UNICODE}
108 utf8Str: UTF8String;
109 {$ENDIF}
110 Bytes: TByteDynArray;
111 Len: Integer;
112 Str: PAnsiChar;
113 begin
114 {$IFDEF UNICODE}
115 utf8Str := UTF8Encode(Input);
116 Len := Length(utf8Str);
117 {$ELSE}
118 Len := Length(Input);
119 {$ENDIF}
120 if Len > 0 then
121 begin
122 SetLength(Bytes, Len);
123 {$IFDEF UNICODE}
124 Str := PAnsiChar(utf8Str);
125 {$ELSE}
126 Str := PAnsiChar(Input);
127 {$ENDIF}
128 Move(Str^, Pointer(Bytes)^, Len);
129 Update(Bytes, Len);
130 end;
131 end;
132
133 procedure TMD5.Update(const Input: TByteDynArray; Len: Longword);
134 var
135 index, partlen, I, start: Longword;
136 begin
137 { Compute number of bytes mod 64 }
138 index := (FContextCount[0] shr 3) and $3f;
139 { Update number of bits }
140 Inc(FContextCount[0], Len shl 3);
141 if (FContextCount[0] < (Len shl 3)) then
142 Inc(FContextCount[1]);
143 Inc(FContextCount[1], Len shr 29);
144 partlen := 64 - index;
145
146 { Transform (as many times as possible) }
147 if Len >= partLen then
148 begin
149 for I := 0 to partLen-1 do
150 FContextBuffer[I+index] := Input[I];
151
152 Transform(FContextBuffer, 0);
153 I := partLen;
154 while (I + 63) < Len do
155 begin
156 Transform(Input, I);
157 Inc(I, 64);
158 end;
159 index := 0;
160 end
161 else
162 I := 0;
163
164 { Input remaining input }
165 if (I < Len) then
166 begin
167 start := I;
168 while (I < Len) do
169 begin
170 FContextBuffer[index+I-start] := Input[I];
171 Inc(I);
172 end;
173 end;
174 end;
175
176 function TMD5.Final: TByteDynArray;
177 var
178 bits: TByteDynArray;
179 index, padlen: Integer;
180 begin
181 { Save number of bits }
182 Encode(bits, FContextCount, 8);
183 { Pad out to 56 mod 64 }
184 index := (FContextCount[0] shr 3) and $3f;
185 if index < 56 then
186 padlen := 56 - index
187 else
188 padlen := 120- index;
189
190 Update(padding, padLen);
191 { Append length (before padding) }
192 Update(bits, 8);
193 { Store state in digest }
194 Encode(Result, FContextState, 16);
195 end;
196
197 function TMD5.AsString: string;
198 const
199 XD: array[0..15] of char = ('0', '1', '2', '3', '4', '5', '6', '7',
200 '8', '9', 'A', 'B', 'C', 'D', 'E', 'F');
201 var
202 digest: TByteDynArray;
203 I: Integer;
204 begin
205 Result := '';
206 digest := Final;
207 for I := 0 to Length(digest)-1 do
208 Result := Result + XD[(digest[I] shr 4) and $0f] +
209 XD[digest[I] and $0f];
210 end;
211
212 function TMD5.AsGUID: string;
213 const
214 XD: array[0..15] of char = ('0', '1', '2', '3', '4', '5', '6', '7',
215 '8', '9', 'A', 'B', 'C', 'D', 'E', 'F');
216 var
217 digest: TByteDynArray;
218 I: Integer;
219 begin
220 Result := '';
221 digest := Final;
222 for I := 0 to Length(digest)-1 do
223 begin
224 case I of
225 0: Result := Result + '{';
226 4, 6, 8, 10: Result := Result + '-';
227 end;
228 Result := Result + XD[(digest[I] shr 4) and $0f] +
229 XD[digest[I] and $0f];
230 if I = 15 then
231 Result := Result + '}';
232 end;
233 end;
234
235 procedure TMD5.Transform(const block: TByteDynArray; shift: Integer);
236
237 function F(x, y, z: Longword): Longword;
238 begin
239 Result := (x and y) or ((not x) and z);
240 end;
241
242 function G(x, y, z: Longword): Longword;
243 begin
244 Result := (x and z) or (y and (not z));
245 end;
246
247 function H(x, y, z: Longword): Longword;
248 begin
249 Result := x xor y xor z;
250 end;
251
252 function I(x, y, z: Longword): Longword;
253 begin
254 Result := y xor (x or (not z));
255 end;
256
257 procedure RL(var x: Longword; n: Byte);
258 begin
259 x := (x shl n) or (x shr (32 - n));
260 end;
261
262 procedure FF(var a: Longword; b, c, d, x: Longword; s: Byte; ac: Longword);
263 begin
264 Inc(a, F(b, c, d) + x + ac);
265 RL(a, s);
266 Inc(a, b);
267 end;
268
269 procedure GG(var a: Longword; b, c, d, x: Longword; s: Byte; ac: Longword);
270 begin
271 Inc(a, G(b, c, d) + x + ac);
272 RL(a, s);
273 Inc(a, b);
274 end;
275
276 procedure HH(var a: Longword; b, c, d, x: Longword; s: Byte; ac: Longword);
277 begin
278 Inc(a, H(b, c, d) + x + ac);
279 RL(a, s);
280 Inc(a, b);
281 end;
282
283 procedure II(var a: Longword; b, c, d, x: Longword; s: Byte; ac: Longword);
284 begin
285 Inc(a, I(b, c, d) + x + ac);
286 RL(a, s);
287 Inc(a, b);
288 end;
289
290 var
291 a, b, c, d: Longword;
292 x: ArrayOfLWord;
293
294 begin
295 a := FContextState[0];
296 b := FContextState[1];
297 c := FContextState[2];
298 d := FContextState[3];
299
300 Decode(x, block, 64, shift);
301
302 { Round 1 }
303 FF( a, b, c, d, x[ 0], S11, $d76aa478); { 1 }
304 FF( d, a, b, c, x[ 1], S12, $e8c7b756); { 2 }
305 FF( c, d, a, b, x[ 2], S13, $242070db); { 3 }
306 FF( b, c, d, a, x[ 3], S14, $c1bdceee); { 4 }
307 FF( a, b, c, d, x[ 4], S11, $f57c0faf); { 5 }
308 FF( d, a, b, c, x[ 5], S12, $4787c62a); { 6 }
309 FF( c, d, a, b, x[ 6], S13, $a8304613); { 7 }
310 FF( b, c, d, a, x[ 7], S14, $fd469501); { 8 }
311 FF( a, b, c, d, x[ 8], S11, $698098d8); { 9 }
312 FF( d, a, b, c, x[ 9], S12, $8b44f7af); { 10 }
313 FF( c, d, a, b, x[10], S13, $ffff5bb1); { 11 }
314 FF( b, c, d, a, x[11], S14, $895cd7be); { 12 }
315 FF( a, b, c, d, x[12], S11, $6b901122); { 13 }
316 FF( d, a, b, c, x[13], S12, $fd987193); { 14 }
317 FF( c, d, a, b, x[14], S13, $a679438e); { 15 }
318 FF( b, c, d, a, x[15], S14, $49b40821); { 16 }
319
320 { Round 2 }
321 GG( a, b, c, d, x[ 1], S21, $f61e2562); { 17 }
322 GG( d, a, b, c, x[ 6], S22, $c040b340); { 18 }
323 GG( c, d, a, b, x[11], S23, $265e5a51); { 19 }
324 GG( b, c, d, a, x[ 0], S24, $e9b6c7aa); { 20 }
325 GG( a, b, c, d, x[ 5], S21, $d62f105d); { 21 }
326 GG( d, a, b, c, x[10], S22, $2441453); { 22 }
327 GG( c, d, a, b, x[15], S23, $d8a1e681); { 23 }
328 GG( b, c, d, a, x[ 4], S24, $e7d3fbc8); { 24 }
329 GG( a, b, c, d, x[ 9], S21, $21e1cde6); { 25 }
330 GG( d, a, b, c, x[14], S22, $c33707d6); { 26 }
331 GG( c, d, a, b, x[ 3], S23, $f4d50d87); { 27 }
332 GG( b, c, d, a, x[ 8], S24, $455a14ed); { 28 }
333 GG( a, b, c, d, x[13], S21, $a9e3e905); { 29 }
334 GG( d, a, b, c, x[ 2], S22, $fcefa3f8); { 30 }
335 GG( c, d, a, b, x[ 7], S23, $676f02d9); { 31 }
336 GG( b, c, d, a, x[12], S24, $8d2a4c8a); { 32 }
337
338 { Round 3 }
339 HH( a, b, c, d, x[ 5], S31, $fffa3942); { 33 }
340 HH( d, a, b, c, x[ 8], S32, $8771f681); { 34 }
341 HH( c, d, a, b, x[11], S33, $6d9d6122); { 35 }
342 HH( b, c, d, a, x[14], S34, $fde5380c); { 36 }
343 HH( a, b, c, d, x[ 1], S31, $a4beea44); { 37 }
344 HH( d, a, b, c, x[ 4], S32, $4bdecfa9); { 38 }
345 HH( c, d, a, b, x[ 7], S33, $f6bb4b60); { 39 }
346 HH( b, c, d, a, x[10], S34, $bebfbc70); { 40 }
347 HH( a, b, c, d, x[13], S31, $289b7ec6); { 41 }
348 HH( d, a, b, c, x[ 0], S32, $eaa127fa); { 42 }
349 HH( c, d, a, b, x[ 3], S33, $d4ef3085); { 43 }
350 HH( b, c, d, a, x[ 6], S34, $4881d05); { 44 }
351 HH( a, b, c, d, x[ 9], S31, $d9d4d039); { 45 }
352 HH( d, a, b, c, x[12], S32, $e6db99e5); { 46 }
353 HH( c, d, a, b, x[15], S33, $1fa27cf8); { 47 }
354 HH( b, c, d, a, x[ 2], S34, $c4ac5665); { 48 }
355
356 { Round 4 }
357 II( a, b, c, d, x[ 0], S41, $f4292244); { 49 }
358 II( d, a, b, c, x[ 7], S42, $432aff97); { 50 }
359 II( c, d, a, b, x[14], S43, $ab9423a7); { 51 }
360 II( b, c, d, a, x[ 5], S44, $fc93a039); { 52 }
361 II( a, b, c, d, x[12], S41, $655b59c3); { 53 }
362 II( d, a, b, c, x[ 3], S42, $8f0ccc92); { 54 }
363 II( c, d, a, b, x[10], S43, $ffeff47d); { 55 }
364 II( b, c, d, a, x[ 1], S44, $85845dd1); { 56 }
365 II( a, b, c, d, x[ 8], S41, $6fa87e4f); { 57 }
366 II( d, a, b, c, x[15], S42, $fe2ce6e0); { 58 }
367 II( c, d, a, b, x[ 6], S43, $a3014314); { 59 }
368 II( b, c, d, a, x[13], S44, $4e0811a1); { 60 }
369 II( a, b, c, d, x[ 4], S41, $f7537e82); { 61 }
370 II( d, a, b, c, x[11], S42, $bd3af235); { 62 }
371 II( c, d, a, b, x[ 2], S43, $2ad7d2bb); { 63 }
372 II( b, c, d, a, x[ 9], S44, $eb86d391); { 64 }
373
374 Inc(FContextState[0], a);
375 Inc(FContextState[1], b);
376 Inc(FContextState[2], c);
377 Inc(FContextState[3], d);
378 end;
379
380 procedure TMD5.Encode(var Dst: TByteDynArray; const Src: ArrayOfLWord; Len: Integer);
381 var
382 i, j: Integer;
383 begin
384 i := 0;
385 j := 0;
386 SetLength(Dst, Len);
387 while (j < Len) do
388 begin
389 Dst[j] := Byte((Src[i] and $ff));
390 Dst[j+1]:= Byte((Src[i] shr 8) and $ff);
391 Dst[j+2]:= Byte((Src[i] shr 16) and $ff);
392 Dst[J+3]:= Byte((Src[i] shr 24) and $ff);
393 Inc(j, 4);
394 Inc(i);
395 end;
396 end;
397
398
399 procedure TMD5.Decode(var Dst: ArrayOfLWord; const Src: TByteDynArray; Len: Integer; shift: Integer);
400 var
401 I, J: Integer;
402 a, b, c, d: Byte;
403 begin
404 J := 0;
405 I := 0;
406 SetLength(Dst, 16);
407 while (J < Len) do
408 begin
409 a := Src[J+shift];
410 b := Src[J+shift+1];
411 c := Src[J+shift+2];
412 d := Src[J+shift+3];
413 Dst[I] :=Longword(a and $ff) or
414 (Longword(b and $ff) shl 8) or
415 (Longword(c and $ff) shl 16) or
416 (Longword(d and $ff) shl 24);
417 Inc(J, 4);
418 Inc(I);
419 end;
420 end;
421
422 initialization
423 SetLength(padding, 64);
424 padding[0] := $80;
425
426 {
427 MD5 test suite:
428 MD5 ("") = d41d8cd98f00b204e9800998ecf8427e
429 MD5 ("a") = 0cc175b9c0f1b6a831c399e269772661
430 MD5 ("abc") = 900150983cd24fb0d6963f7d28e17f72
431 MD5 ("message digest") = f96b697d7cb7938d525a2f31aaf161d0
432 MD5 ("abcdefghijklmnopqrstuvwxyz") = c3fcd3d76192e4007dfb496cca67e13b
433 MD5 ("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789") =
434 d174ab98d277d9f5a5611c2c9f419d9f
435 MD5 ("123456789012345678901234567890123456789012345678901234567890123456
436 78901234567890") = 57edf4a22be3c955ac49da2e2107b67a
437 }
438
439 end.
浙公网安备 33010602011771号