/[lcore]/trunk/fastmd5.pas
ViewVC logotype

Annotation of /trunk/fastmd5.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 54 - (hide annotations)
Wed Jun 24 11:47:15 2009 UTC (11 years, 4 months ago) by beware
File size: 10017 byte(s)
removed redundant, and no longer valid, email address
1 beware 20 { Copyright (C) 2005 Bas Steendijk and Peter Green
2     For conditions of distribution and use, see copyright notice in zlib_license.txt
3     Which is included in the package
4     ----------------------------------------------------------------------------- }
5    
6     unit fastmd5;
7    
8     {
9     pascal implementation of MD5
10    
11 beware 54 written by Bas Steendijk
12 beware 20
13     based on RFC1321 - The MD5 Message-Digest Algorithm
14    
15     optimized for speed: saved on copying and sub calls in the core routine
16    
17     verified on:
18     - Borland Delphi 3
19     - Borland Turbo Pascal 7
20     - Free Pascal 1.0.6 for i386 (on *nix)
21     - various other versions of freepascal on windows and linux i386
22     - various other versions of delphi
23     - free pascal 1.9.5 on powerpc darwin
24    
25     this unit is endian portable but is likely to be significantly slower on big endian systems
26     }
27    
28     {$Q-,R-}
29    
30     interface
31    
32    
33    
34    
35    
36     type
37     Tmd5=array[0..15] of byte;
38    
39     {$i uint32.inc}
40    
41     type
42     dvar=array[0..0] of byte;
43     Tmd5state=record
44     buf:array[0..63] of byte;
45     H:array[0..3] of uint32;
46     msglen:longint;
47     msglenhi:longint;
48     end;
49    
50     procedure md5processblock(var h:array of uint32;const data);
51    
52     procedure md5init(var state:tmd5state);
53     procedure md5process(var state:tmd5state;const data;len:longint);
54     procedure md5finish(var state:tmd5state;var result);
55    
56     procedure getmd5(const data;len:longint;var result);
57    
58     function md5tostr(const md5:tmd5):string;
59    
60     implementation
61    
62     function inttohex(val,bits:integer):string;
63     const
64     hexchar:array[0..15] of char='0123456789abcdef';
65     begin
66     inttohex := hexchar[val shr 4]+hexchar[val and $f];
67     end;
68    
69     {$ifdef cpu386}
70     function rol(w,bits:uint32): uint32; assembler;
71     asm
72     {cpu386 is not defined on freepascal. but fpc assembler is incompatible, uses different code}
73     {inline($89/$d1/$d3/$c0);}
74     mov ecx,edx
75     rol eax,cl
76     end;
77     {$else}
78     function rol(w,bits:uint32):uint32;
79     begin
80     rol := (w shl bits) or (w shr (32-bits));
81     end;
82     {$endif}
83    
84    
85     {function swapbytes(invalue:uint32):uint32;
86     var
87     inbytes : array[0..3] of byte absolute invalue;
88     outbytes : array[0..3] of byte absolute result;
89    
90    
91     begin
92     outbytes[0] := inbytes[3];
93     outbytes[1] := inbytes[2];
94     outbytes[2] := inbytes[1];
95     outbytes[3] := inbytes[0];
96     end;}
97    
98     procedure md5processblock(var h:array of uint32;const data);
99     const
100     S11=7; S12=12; S13=17; S14=22;
101     S21=5; S22=9; S23=14; S24=20;
102     S31=4; S32=11; S33=16; S34=23;
103     S41=6; S42=10; S43=15; S44=21;
104    
105     var
106     A,B,C,D:uint32;
107     w:array[0..63] of byte absolute data;
108     x:array[0..15] of uint32 {$ifndef ENDIAN_BIG} absolute data{$endif} ;
109     y:array[0..63] of byte absolute x;
110     {$ifdef ENDIAN_BIG}counter : integer;{$endif}
111     begin
112     A := h[0];
113     B := h[1];
114     C := h[2];
115     D := h[3];
116     {$ifdef ENDIAN_BIG}
117     for counter := 0 to 63 do begin
118     y[counter] := w[counter xor 3];
119     end;
120     {$endif}
121     a := rol(a + ((b and c) or ((not b) and d)) + x[ 0] + $d76aa478, S11) + b;
122     d := rol(d + ((a and b) or ((not a) and c)) + x[ 1] + $e8c7b756, S12) + a;
123     c := rol(c + ((d and a) or ((not d) and b)) + x[ 2] + $242070db, S13) + d;
124     b := rol(b + ((c and d) or ((not c) and a)) + x[ 3] + $c1bdceee, S14) + c;
125     a := rol(a + ((b and c) or ((not b) and d)) + x[ 4] + $f57c0faf, S11) + b;
126     d := rol(d + ((a and b) or ((not a) and c)) + x[ 5] + $4787c62a, S12) + a;
127     c := rol(c + ((d and a) or ((not d) and b)) + x[ 6] + $a8304613, S13) + d;
128     b := rol(b + ((c and d) or ((not c) and a)) + x[ 7] + $fd469501, S14) + c;
129     a := rol(a + ((b and c) or ((not b) and d)) + x[ 8] + $698098d8, S11) + b;
130     d := rol(d + ((a and b) or ((not a) and c)) + x[ 9] + $8b44f7af, S12) + a;
131     c := rol(c + ((d and a) or ((not d) and b)) + x[10] + $ffff5bb1, S13) + d;
132     b := rol(b + ((c and d) or ((not c) and a)) + x[11] + $895cd7be, S14) + c;
133     a := rol(a + ((b and c) or ((not b) and d)) + x[12] + $6b901122, S11) + b;
134     d := rol(d + ((a and b) or ((not a) and c)) + x[13] + $fd987193, S12) + a;
135     c := rol(c + ((d and a) or ((not d) and b)) + x[14] + $a679438e, S13) + d;
136     b := rol(b + ((c and d) or ((not c) and a)) + x[15] + $49b40821, S14) + c;
137    
138     a := rol(a + ((b and d) or (c and (not d))) + x[ 1] + $f61e2562, S21) + b;
139     d := rol(d + ((a and c) or (b and (not c))) + x[ 6] + $c040b340, S22) + a;
140     c := rol(c + ((d and b) or (a and (not b))) + x[11] + $265e5a51, S23) + d;
141     b := rol(b + ((c and a) or (d and (not a))) + x[ 0] + $e9b6c7aa, S24) + c;
142     a := rol(a + ((b and d) or (c and (not d))) + x[ 5] + $d62f105d, S21) + b;
143     d := rol(d + ((a and c) or (b and (not c))) + x[10] + $02441453, S22) + a;
144     c := rol(c + ((d and b) or (a and (not b))) + x[15] + $d8a1e681, S23) + d;
145     b := rol(b + ((c and a) or (d and (not a))) + x[ 4] + $e7d3fbc8, S24) + c;
146     a := rol(a + ((b and d) or (c and (not d))) + x[ 9] + $21e1cde6, S21) + b;
147     d := rol(d + ((a and c) or (b and (not c))) + x[14] + $c33707d6, S22) + a;
148     c := rol(c + ((d and b) or (a and (not b))) + x[ 3] + $f4d50d87, S23) + d;
149     b := rol(b + ((c and a) or (d and (not a))) + x[ 8] + $455a14ed, S24) + c;
150     a := rol(a + ((b and d) or (c and (not d))) + x[13] + $a9e3e905, S21) + b;
151     d := rol(d + ((a and c) or (b and (not c))) + x[ 2] + $fcefa3f8, S22) + a;
152     c := rol(c + ((d and b) or (a and (not b))) + x[ 7] + $676f02d9, S23) + d;
153     b := rol(b + ((c and a) or (d and (not a))) + x[12] + $8d2a4c8a, S24) + c;
154    
155     a := rol(a + (b xor c xor d) + x[ 5] + $fffa3942, S31) + b;
156     d := rol(d + (a xor b xor c) + x[ 8] + $8771f681, S32) + a;
157     c := rol(c + (d xor a xor b) + x[11] + $6d9d6122, S33) + d;
158     b := rol(b + (c xor d xor a) + x[14] + $fde5380c, S34) + c;
159     a := rol(a + (b xor c xor d) + x[ 1] + $a4beea44, S31) + b;
160     d := rol(d + (a xor b xor c) + x[ 4] + $4bdecfa9, S32) + a;
161     c := rol(c + (d xor a xor b) + x[ 7] + $f6bb4b60, S33) + d;
162     b := rol(b + (c xor d xor a) + x[10] + $bebfbc70, S34) + c;
163     a := rol(a + (b xor c xor d) + x[13] + $289b7ec6, S31) + b;
164     d := rol(d + (a xor b xor c) + x[ 0] + $eaa127fa, S32) + a;
165     c := rol(c + (d xor a xor b) + x[ 3] + $d4ef3085, S33) + d;
166     b := rol(b + (c xor d xor a) + x[ 6] + $04881d05, S34) + c;
167     a := rol(a + (b xor c xor d) + x[ 9] + $d9d4d039, S31) + b;
168     d := rol(d + (a xor b xor c) + x[12] + $e6db99e5, S32) + a;
169     c := rol(c + (d xor a xor b) + x[15] + $1fa27cf8, S33) + d;
170     b := rol(b + (c xor d xor a) + x[ 2] + $c4ac5665, S34) + c;
171    
172     a := rol(a + (c xor (b or (not d))) + x[ 0] + $f4292244, S41) + b;
173     d := rol(d + (b xor (a or (not c))) + x[ 7] + $432aff97, S42) + a;
174     c := rol(c + (a xor (d or (not b))) + x[14] + $ab9423a7, S43) + d;
175     b := rol(b + (d xor (c or (not a))) + x[ 5] + $fc93a039, S44) + c;
176     a := rol(a + (c xor (b or (not d))) + x[12] + $655b59c3, S41) + b;
177     d := rol(d + (b xor (a or (not c))) + x[ 3] + $8f0ccc92, S42) + a;
178     c := rol(c + (a xor (d or (not b))) + x[10] + $ffeff47d, S43) + d;
179     b := rol(b + (d xor (c or (not a))) + x[ 1] + $85845dd1, S44) + c;
180     a := rol(a + (c xor (b or (not d))) + x[ 8] + $6fa87e4f, S41) + b;
181     d := rol(d + (b xor (a or (not c))) + x[15] + $fe2ce6e0, S42) + a;
182     c := rol(c + (a xor (d or (not b))) + x[ 6] + $a3014314, S43) + d;
183     b := rol(b + (d xor (c or (not a))) + x[13] + $4e0811a1, S44) + c;
184     a := rol(a + (c xor (b or (not d))) + x[ 4] + $f7537e82, S41) + b;
185     d := rol(d + (b xor (a or (not c))) + x[11] + $bd3af235, S42) + a;
186     c := rol(c + (a xor (d or (not b))) + x[ 2] + $2ad7d2bb, S43) + d;
187     b := rol(b + (d xor (c or (not a))) + x[ 9] + $eb86d391, S44) + c;
188    
189     inc(h[0],A);
190     inc(h[1],B);
191     inc(h[2],C);
192     inc(h[3],D);
193     end;
194    
195     procedure md5init(var state:tmd5state);
196     begin
197     state.h[0] := $67452301;
198     state.h[1] := $EFCDAB89;
199     state.h[2] := $98BADCFE;
200     state.h[3] := $10325476;
201     state.msglen := 0;
202     state.msglenhi := 0;
203     end;
204    
205     procedure md5process(var state:tmd5state;const data;len:longint);
206     var
207     a,b:longint;
208     ofs:longint;
209     p:dvar absolute data;
210     begin
211     b := state.msglen and 63;
212    
213     inc(state.msglen,len);
214     while (state.msglen > $20000000) do begin
215     dec(state.msglen,$20000000);
216     inc(state.msglenhi);
217     end;
218     ofs := 0;
219     if b > 0 then begin
220     a := 64-b;
221     if a > len then a := len;
222     move(p[0],state.buf[b],a);
223     inc(ofs,a);
224     dec(len,a);
225     if b+a = 64 then md5processblock(state.h,state.buf);
226     if len = 0 then exit;
227     end;
228     while len >= 64 do begin
229     md5processblock(state.h,p[ofs]);
230     inc(ofs,64);
231     dec(len,64);
232     end;
233     if len > 0 then move(p[ofs],state.buf[0],len);
234     end;
235    
236     procedure md5finish(var state:tmd5state;var result);
237     var
238     b :integer;
239     {$ifdef endian_big}
240     h :tmd5 absolute state.h;
241     r :tmd5 absolute result;
242     counter :integer ;
243     {$endif}
244     begin
245     b := state.msglen and 63;
246     state.buf[b] := $80;
247     if b >= 56 then begin
248     {-- for a := b+1 to 63 do state.buf[a] := 0; }
249     fillchar(state.buf[b+1],63-b,0);
250     md5processblock(state.h,state.buf);
251     fillchar(state.buf,56,0);
252     end else begin
253     {-- for a := b+1 to 55 do state.buf[a] := 0; }
254     fillchar(state.buf[b+1],55-b,0);
255     end;
256     state.msglen := state.msglen shl 3;
257    
258     state.buf[56] := state.msglen;
259     state.buf[57] := state.msglen shr 8;
260     state.buf[58] := state.msglen shr 16;
261     state.buf[59] := state.msglen shr 24;
262     state.buf[60] := state.msglenhi;
263     state.buf[61] := state.msglenhi shr 8;
264     state.buf[62] := state.msglenhi shr 16;
265     state.buf[63] := state.msglenhi shr 24;
266    
267     md5processblock(state.h,state.buf);
268     {$ifdef ENDIAN_BIG}
269     for counter := 0 to 15 do begin
270     r[counter] := h[counter xor 3];
271     end;
272     {$else}
273     move(state.h,result,16);
274     {$endif}
275     fillchar(state,sizeof(state),0);
276     end;
277    
278     procedure getmd5(const data;len:longint;var result);
279     var
280     t:tmd5state;
281     begin
282     md5init(t);
283     md5process(t,data,len);
284     md5finish(t,result);
285     end;
286    
287     function md5tostr(const md5:tmd5):string;
288     var
289     a:integer;
290     s:string;
291     begin
292     s := '';
293     for a := 0 to 15 do s := s + inttohex(md5[a],2);
294     md5tostr := s;
295     end;
296    
297     end.

No admin address has been configured">No admin address has been configured
ViewVC Help
Powered by ViewVC 1.1.22