fastmd5.pas

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