Subversion Repositories delphiutils

Rev

Rev 9 | Blame | Compare with Previous | Last modification | View Log | RSS feed

  1. // tabs = 2
  2. // -----------------------------------------------------------------------------------------------
  3. //
  4. //                                 MD5 Message-Digest for Delphi 4
  5. //
  6. //                                 Delphi 4 Unit implementing the
  7. //                      RSA Data Security, Inc. MD5 Message-Digest Algorithm
  8. //
  9. //                          Implementation of Ronald L. Rivest's RFC 1321
  10. //
  11. //                      Copyright  1997-1999 Medienagentur Fichtner & Meyer
  12. //                                  Written by Matthias Fichtner
  13. //
  14. // -----------------------------------------------------------------------------------------------
  15. //               See RFC 1321 for RSA Data Security's copyright and license notice!
  16. // -----------------------------------------------------------------------------------------------
  17. //
  18. //     14-Jun-97  mf  Implemented MD5 according to RFC 1321                           RFC 1321
  19. //     16-Jun-97  mf  Initial release of the compiled unit (no source code)           RFC 1321
  20. //     28-Feb-99  mf  Added MD5Match function for comparing two digests               RFC 1321
  21. //     13-Sep-99  mf  Reworked the entire unit                                        RFC 1321
  22. //     17-Sep-99  mf  Reworked the "Test Driver" project                              RFC 1321
  23. //     19-Sep-99  mf  Release of sources for MD5 unit and "Test Driver" project       RFC 1321
  24. //
  25. // -----------------------------------------------------------------------------------------------
  26. //                   The latest release of md5.pas will always be available from
  27. //                  the distribution site at: http://www.fichtner.net/delphi/md5/
  28. // -----------------------------------------------------------------------------------------------
  29. //                       Please send questions, bug reports and suggestions
  30. //                      regarding this code to: mfichtner@fichtner-meyer.com
  31. // -----------------------------------------------------------------------------------------------
  32. //                        This code is provided "as is" without express or
  33. //                     implied warranty of any kind. Use it at your own risk.
  34. // -----------------------------------------------------------------------------------------------
  35.  
  36. unit md5;
  37.  
  38. // -----------------------------------------------------------------------------------------------
  39. INTERFACE
  40. // -----------------------------------------------------------------------------------------------
  41.  
  42. uses
  43.         Windows;
  44.  
  45. type
  46.         MD5Count = array[0..1] of DWORD;
  47.         MD5State = array[0..3] of DWORD;
  48.         MD5Block = array[0..15] of DWORD;
  49.         MD5CBits = array[0..7] of byte;
  50.         MD5Digest = array[0..15] of byte;
  51.         MD5Buffer = array[0..63] of byte;
  52.         MD5Context = record
  53.                 State: MD5State;
  54.                 Count: MD5Count;
  55.                 Buffer: MD5Buffer;
  56.         end;
  57.  
  58. procedure MD5Init(var Context: MD5Context);
  59. procedure MD5Update(var Context: MD5Context; Input: pChar; Length: longword);
  60. procedure MD5Final(var Context: MD5Context; var Digest: MD5Digest);
  61.  
  62. function MD5String(M: string): MD5Digest;
  63. function MD5File(N: string): MD5Digest;
  64. function MD5Print(D: MD5Digest): string;
  65.  
  66. function MD5Match(D1, D2: MD5Digest): boolean;
  67.  
  68. // -----------------------------------------------------------------------------------------------
  69. IMPLEMENTATION
  70. // -----------------------------------------------------------------------------------------------
  71.  
  72. var
  73.         PADDING: MD5Buffer = (
  74.                 $80, $00, $00, $00, $00, $00, $00, $00,
  75.                 $00, $00, $00, $00, $00, $00, $00, $00,
  76.                 $00, $00, $00, $00, $00, $00, $00, $00,
  77.                 $00, $00, $00, $00, $00, $00, $00, $00,
  78.                 $00, $00, $00, $00, $00, $00, $00, $00,
  79.                 $00, $00, $00, $00, $00, $00, $00, $00,
  80.                 $00, $00, $00, $00, $00, $00, $00, $00,
  81.                 $00, $00, $00, $00, $00, $00, $00, $00
  82.         );
  83.  
  84. function F(x, y, z: DWORD): DWORD;
  85. begin
  86.         Result := (x and y) or ((not x) and z);
  87. end;
  88.  
  89. function G(x, y, z: DWORD): DWORD;
  90. begin
  91.         Result := (x and z) or (y and (not z));
  92. end;
  93.  
  94. function H(x, y, z: DWORD): DWORD;
  95. begin
  96.         Result := x xor y xor z;
  97. end;
  98.  
  99. function I(x, y, z: DWORD): DWORD;
  100. begin
  101.         Result := y xor (x or (not z));
  102. end;
  103.  
  104. procedure rot(var x: DWORD; n: BYTE);
  105. begin
  106.         x := (x shl n) or (x shr (32 - n));
  107. end;
  108.  
  109. procedure FF(var a: DWORD; b, c, d, x: DWORD; s: BYTE; ac: DWORD);
  110. begin
  111.         inc(a, F(b, c, d) + x + ac);
  112.         rot(a, s);
  113.         inc(a, b);
  114. end;
  115.  
  116. procedure GG(var a: DWORD; b, c, d, x: DWORD; s: BYTE; ac: DWORD);
  117. begin
  118.         inc(a, G(b, c, d) + x + ac);
  119.         rot(a, s);
  120.         inc(a, b);
  121. end;
  122.  
  123. procedure HH(var a: DWORD; b, c, d, x: DWORD; s: BYTE; ac: DWORD);
  124. begin
  125.         inc(a, H(b, c, d) + x + ac);
  126.         rot(a, s);
  127.         inc(a, b);
  128. end;
  129.  
  130. procedure II(var a: DWORD; b, c, d, x: DWORD; s: BYTE; ac: DWORD);
  131. begin
  132.         inc(a, I(b, c, d) + x + ac);
  133.         rot(a, s);
  134.         inc(a, b);
  135. end;
  136.  
  137. // -----------------------------------------------------------------------------------------------
  138.  
  139. // Encode Count bytes at Source into (Count / 4) DWORDs at Target
  140. procedure Encode(Source, Target: pointer; Count: longword);
  141. var
  142.         S: PByte;
  143.         T: PDWORD;
  144.         I: longword;
  145. begin
  146.         S := Source;
  147.         T := Target;
  148.         for I := 1 to Count div 4 do begin
  149.                 T^ := S^;
  150.                 inc(S);
  151.                 T^ := T^ or (S^ shl 8);
  152.                 inc(S);
  153.                 T^ := T^ or (S^ shl 16);
  154.                 inc(S);
  155.                 T^ := T^ or (S^ shl 24);
  156.                 inc(S);
  157.                 inc(T);
  158.         end;
  159. end;
  160.  
  161. // Decode Count DWORDs at Source into (Count * 4) Bytes at Target
  162. procedure Decode(Source, Target: pointer; Count: longword);
  163. var
  164.         S: PDWORD;
  165.         T: PByte;
  166.         I: longword;
  167. begin
  168.         S := Source;
  169.         T := Target;
  170.         for I := 1 to Count do begin
  171.                 T^ := S^ and $ff;
  172.                 inc(T);
  173.                 T^ := (S^ shr 8) and $ff;
  174.                 inc(T);
  175.                 T^ := (S^ shr 16) and $ff;
  176.                 inc(T);
  177.                 T^ := (S^ shr 24) and $ff;
  178.                 inc(T);
  179.                 inc(S);
  180.         end;
  181. end;
  182.  
  183. // Transform State according to first 64 bytes at Buffer
  184. procedure Transform(Buffer: pointer; var State: MD5State);
  185. var
  186.         a, b, c, d: DWORD;
  187.         Block: MD5Block;
  188. begin
  189.         Encode(Buffer, @Block, 64);
  190.         a := State[0];
  191.         b := State[1];
  192.         c := State[2];
  193.         d := State[3];
  194.         FF (a, b, c, d, Block[ 0],  7, $d76aa478);
  195.         FF (d, a, b, c, Block[ 1], 12, $e8c7b756);
  196.         FF (c, d, a, b, Block[ 2], 17, $242070db);
  197.         FF (b, c, d, a, Block[ 3], 22, $c1bdceee);
  198.         FF (a, b, c, d, Block[ 4],  7, $f57c0faf);
  199.         FF (d, a, b, c, Block[ 5], 12, $4787c62a);
  200.         FF (c, d, a, b, Block[ 6], 17, $a8304613);
  201.         FF (b, c, d, a, Block[ 7], 22, $fd469501);
  202.         FF (a, b, c, d, Block[ 8],  7, $698098d8);
  203.         FF (d, a, b, c, Block[ 9], 12, $8b44f7af);
  204.         FF (c, d, a, b, Block[10], 17, $ffff5bb1);
  205.         FF (b, c, d, a, Block[11], 22, $895cd7be);
  206.         FF (a, b, c, d, Block[12],  7, $6b901122);
  207.         FF (d, a, b, c, Block[13], 12, $fd987193);
  208.         FF (c, d, a, b, Block[14], 17, $a679438e);
  209.         FF (b, c, d, a, Block[15], 22, $49b40821);
  210.         GG (a, b, c, d, Block[ 1],  5, $f61e2562);
  211.         GG (d, a, b, c, Block[ 6],  9, $c040b340);
  212.         GG (c, d, a, b, Block[11], 14, $265e5a51);
  213.         GG (b, c, d, a, Block[ 0], 20, $e9b6c7aa);
  214.         GG (a, b, c, d, Block[ 5],  5, $d62f105d);
  215.         GG (d, a, b, c, Block[10],  9,  $2441453);
  216.         GG (c, d, a, b, Block[15], 14, $d8a1e681);
  217.         GG (b, c, d, a, Block[ 4], 20, $e7d3fbc8);
  218.         GG (a, b, c, d, Block[ 9],  5, $21e1cde6);
  219.         GG (d, a, b, c, Block[14],  9, $c33707d6);
  220.         GG (c, d, a, b, Block[ 3], 14, $f4d50d87);
  221.         GG (b, c, d, a, Block[ 8], 20, $455a14ed);
  222.         GG (a, b, c, d, Block[13],  5, $a9e3e905);
  223.         GG (d, a, b, c, Block[ 2],  9, $fcefa3f8);
  224.         GG (c, d, a, b, Block[ 7], 14, $676f02d9);
  225.         GG (b, c, d, a, Block[12], 20, $8d2a4c8a);
  226.         HH (a, b, c, d, Block[ 5],  4, $fffa3942);
  227.         HH (d, a, b, c, Block[ 8], 11, $8771f681);
  228.         HH (c, d, a, b, Block[11], 16, $6d9d6122);
  229.         HH (b, c, d, a, Block[14], 23, $fde5380c);
  230.         HH (a, b, c, d, Block[ 1],  4, $a4beea44);
  231.         HH (d, a, b, c, Block[ 4], 11, $4bdecfa9);
  232.         HH (c, d, a, b, Block[ 7], 16, $f6bb4b60);
  233.         HH (b, c, d, a, Block[10], 23, $bebfbc70);
  234.         HH (a, b, c, d, Block[13],  4, $289b7ec6);
  235.         HH (d, a, b, c, Block[ 0], 11, $eaa127fa);
  236.         HH (c, d, a, b, Block[ 3], 16, $d4ef3085);
  237.         HH (b, c, d, a, Block[ 6], 23,  $4881d05);
  238.         HH (a, b, c, d, Block[ 9],  4, $d9d4d039);
  239.         HH (d, a, b, c, Block[12], 11, $e6db99e5);
  240.         HH (c, d, a, b, Block[15], 16, $1fa27cf8);
  241.         HH (b, c, d, a, Block[ 2], 23, $c4ac5665);
  242.         II (a, b, c, d, Block[ 0],  6, $f4292244);
  243.         II (d, a, b, c, Block[ 7], 10, $432aff97);
  244.         II (c, d, a, b, Block[14], 15, $ab9423a7);
  245.         II (b, c, d, a, Block[ 5], 21, $fc93a039);
  246.         II (a, b, c, d, Block[12],  6, $655b59c3);
  247.         II (d, a, b, c, Block[ 3], 10, $8f0ccc92);
  248.         II (c, d, a, b, Block[10], 15, $ffeff47d);
  249.         II (b, c, d, a, Block[ 1], 21, $85845dd1);
  250.         II (a, b, c, d, Block[ 8],  6, $6fa87e4f);
  251.         II (d, a, b, c, Block[15], 10, $fe2ce6e0);
  252.         II (c, d, a, b, Block[ 6], 15, $a3014314);
  253.         II (b, c, d, a, Block[13], 21, $4e0811a1);
  254.         II (a, b, c, d, Block[ 4],  6, $f7537e82);
  255.         II (d, a, b, c, Block[11], 10, $bd3af235);
  256.         II (c, d, a, b, Block[ 2], 15, $2ad7d2bb);
  257.         II (b, c, d, a, Block[ 9], 21, $eb86d391);
  258.         inc(State[0], a);
  259.         inc(State[1], b);
  260.         inc(State[2], c);
  261.         inc(State[3], d);
  262. end;
  263.  
  264. // -----------------------------------------------------------------------------------------------
  265.  
  266. // Initialize given Context
  267. procedure MD5Init(var Context: MD5Context);
  268. begin
  269.         with Context do begin
  270.                 State[0] := $67452301;
  271.                 State[1] := $efcdab89;
  272.                 State[2] := $98badcfe;
  273.                 State[3] := $10325476;
  274.                 Count[0] := 0;
  275.                 Count[1] := 0;
  276.                 ZeroMemory(@Buffer, SizeOf(MD5Buffer));
  277.         end;
  278. end;
  279.  
  280. // Update given Context to include Length bytes of Input
  281. procedure MD5Update(var Context: MD5Context; Input: pChar; Length: longword);
  282. var
  283.         Index: longword;
  284.         PartLen: longword;
  285.         I: longword;
  286. begin
  287.         with Context do begin
  288.                 Index := (Count[0] shr 3) and $3f;
  289.                 inc(Count[0], Length shl 3);
  290.                 if Count[0] < (Length shl 3) then inc(Count[1]);
  291.                 inc(Count[1], Length shr 29);
  292.         end;
  293.         PartLen := 64 - Index;
  294.         if Length >= PartLen then begin
  295.                 CopyMemory(@Context.Buffer[Index], Input, PartLen);
  296.                 Transform(@Context.Buffer, Context.State);
  297.                 I := PartLen;
  298.                 while I + 63 < Length do begin
  299.                         Transform(@Input[I], Context.State);
  300.                         inc(I, 64);
  301.                 end;
  302.                 Index := 0;
  303.         end else I := 0;
  304.         CopyMemory(@Context.Buffer[Index], @Input[I], Length - I);
  305. end;
  306.  
  307. // Finalize given Context, create Digest and zeroize Context
  308. procedure MD5Final(var Context: MD5Context; var Digest: MD5Digest);
  309. var
  310.         Bits: MD5CBits;
  311.         Index: longword;
  312.         PadLen: longword;
  313. begin
  314.         Decode(@Context.Count, @Bits, 2);
  315.         Index := (Context.Count[0] shr 3) and $3f;
  316.         if Index < 56 then PadLen := 56 - Index else PadLen := 120 - Index;
  317.         MD5Update(Context, @PADDING, PadLen);
  318.         MD5Update(Context, @Bits, 8);
  319.         Decode(@Context.State, @Digest, 4);
  320.         ZeroMemory(@Context, SizeOf(MD5Context));
  321. end;
  322.  
  323. // -----------------------------------------------------------------------------------------------
  324.  
  325. // Create digest of given Message
  326. function MD5String(M: string): MD5Digest;
  327. var
  328.         Context: MD5Context;
  329. begin
  330.         MD5Init(Context);
  331.         MD5Update(Context, pChar(M), length(M));
  332.         MD5Final(Context, Result);
  333. end;
  334.  
  335. // Create digest of file with given Name
  336. function MD5File(N: string): MD5Digest;
  337. var
  338.         FileHandle: THandle;
  339.         MapHandle: THandle;
  340.         ViewPointer: pointer;
  341.         Context: MD5Context;
  342. begin
  343.         MD5Init(Context);
  344.         FileHandle := CreateFile(pChar(N), GENERIC_READ, FILE_SHARE_READ or FILE_SHARE_WRITE,
  345.                 nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL or FILE_FLAG_SEQUENTIAL_SCAN, 0);
  346.         if FileHandle <> INVALID_HANDLE_VALUE then try
  347.                 MapHandle := CreateFileMapping(FileHandle, nil, PAGE_READONLY, 0, 0, nil);
  348.                 if MapHandle <> 0 then try
  349.                         ViewPointer := MapViewOfFile(MapHandle, FILE_MAP_READ, 0, 0, 0);
  350.                         if ViewPointer <> nil then try
  351.                                 MD5Update(Context, ViewPointer, GetFileSize(FileHandle, nil));
  352.                         finally
  353.                                 UnmapViewOfFile(ViewPointer);
  354.                         end;
  355.                 finally
  356.                         CloseHandle(MapHandle);
  357.                 end;
  358.         finally
  359.                 CloseHandle(FileHandle);
  360.         end;
  361.         MD5Final(Context, Result);
  362. end;
  363.  
  364. // Create hex representation of given Digest
  365. function MD5Print(D: MD5Digest): string;
  366. var
  367.         I: byte;
  368. const
  369.         Digits: array[0..15] of char =
  370.                 ('0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'a', 'b', 'c', 'd', 'e', 'f');
  371. begin
  372.         Result := '';
  373.         for I := 0 to 15 do Result := Result + Digits[(D[I] shr 4) and $0f] + Digits[D[I] and $0f];
  374. end;
  375.  
  376. // -----------------------------------------------------------------------------------------------
  377.  
  378. // Compare two Digests
  379. function MD5Match(D1, D2: MD5Digest): boolean;
  380. var
  381.         I: byte;
  382. begin
  383.         I := 0;
  384.         Result := TRUE;
  385.         while Result and (I < 16) do begin
  386.                 Result := D1[I] = D2[I];
  387.                 inc(I);
  388.         end;
  389. end;
  390.  
  391. end.
  392.  
  393.