uMD5.pas
上传用户:yjb1804
上传日期:2021-01-30
资源大小:3105k
文件大小:15k
源码类别:

Email服务器

开发平台:

Delphi

  1. {*_* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  2. Author:       Fran鏾is PIETTE. Based on work given by Louis S. Berman from
  3.               BrainTree Ltd, lsb@braintree.com
  4. Description:  MD5 is an implmentation for the MD5 Message-Digest Algorithm
  5.               as described in RFC-1321
  6. Creation:     October 11, 1997
  7. Version:      1.05
  8. EMail:        francois.piette@overbyte.be  http://www.overbyte.be
  9.               francois.piette@rtfm.be      http://www.rtfm.be/fpiette
  10.               francois.piette@pophost.eunet.be
  11. Support:      Use the mailing list twsocket@elists.org
  12.               Follow "support" link at http://www.overbyte.be for subscription.
  13. Legal issues: Copyright (C) 1996-2004 by Fran鏾is PIETTE
  14.               Rue de Grady 24, 4053 Embourg, Belgium. Fax: +32-4-365.74.56
  15.               <francois.piette@overbyte.be>
  16.               This software is provided 'as-is', without any express or
  17.               implied warranty.  In no event will the author be held liable
  18.               for any  damages arising from the use of this software.
  19.               Permission is granted to anyone to use this software for any
  20.               purpose, including commercial applications, and to alter it
  21.               and redistribute it freely, subject to the following
  22.               restrictions:
  23.               1. The origin of this software must not be misrepresented,
  24.                  you must not claim that you wrote the original software.
  25.                  If you use this software in a product, an acknowledgment
  26.                  in the product documentation would be appreciated but is
  27.                  not required.
  28.               2. Altered source versions must be plainly marked as such, and
  29.                  must not be misrepresented as being the original software.
  30.               3. This notice may not be removed or altered from any source
  31.                  distribution.
  32.               4. You must register this software by sending a picture postcard
  33.                  to the author. Use a nice stamp and mention your name, street
  34.                  address, EMail address and any comment you like to say.
  35. Updates:
  36. Oct 26, 1997 Changed MD5Final form function to procedure to be compatible
  37.              with C++Builder.
  38. Jul 09, 1998 V1.01 Adapted for Delphi 4
  39. Aug 06, 1998 V1.02 Added R- Q- directive
  40. Jun 05, 1999 V1.03 Wolfgang Klein found a bug in MD5Update.
  41. Dec 04, 2002 V1.04 Added function FileMD5 from Leon Zandman <leon@wirwar.com>
  42. Mar 14, 2003 V1.05 Bas Steendijk <steendijk@xs4all.nl> corrected a bug when
  43.              file size is exactly 256MB. See comment in code.
  44. * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
  45. unit uMD5;
  46. //{$I DEFS.INC}
  47. interface
  48. uses
  49.     SysUtils, Classes;
  50. const
  51.     MD5Version         = 105;
  52. {$Q-}
  53. {$R-}
  54. type
  55.     TMD5Context = record
  56.         State: array [0..3] of LongInt;
  57.         Count: array [0..1] of LongInt;
  58.         case Integer of
  59.         0: (BufChar: array [0..63] of Byte);
  60.         1: (BufLong: array [0..15] of LongInt);
  61.     end;
  62.     TMD5Digest = array [0..15] of Char;
  63. procedure MD5Init(var MD5Context: TMD5Context);
  64. procedure MD5Update(var MD5Context: TMD5Context;
  65.                     const Data;
  66.                     Len: Integer);
  67. procedure MD5Transform(var Buf: array of LongInt;
  68.                        const Data: array of LongInt);
  69. procedure MD5UpdateBuffer(var MD5Context: TMD5Context;
  70.                           Buffer: Pointer;
  71.                           BufSize: Integer);
  72. procedure MD5Final(var Digest: TMD5Digest; var MD5Context: TMD5Context);
  73. function GetMD5(Buffer: Pointer; BufSize: Integer): string;
  74. function StrMD5(Buffer : String): string;
  75. function FileMD5(const Filename: String) : String;
  76. implementation
  77. const
  78.     MaxBufSize = 16384;
  79. type
  80.     PMD5Buffer = ^TMD5Buffer;
  81.     TMD5Buffer = array [0..(MaxBufSize - 1)] of Char;
  82. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
  83. { MD5 initialization. Begins an MD5 operation, writing a new context.         }
  84. procedure MD5Init(var MD5Context: TMD5Context);
  85. begin
  86.     FillChar(MD5Context, SizeOf(TMD5Context), #0);
  87.     with MD5Context do begin
  88.         { Load magic initialization constants. }
  89.         State[0] := LongInt($67452301);
  90.         State[1] := LongInt($EFCDAB89);
  91.         State[2] := LongInt($98BADCFE);
  92.         State[3] := LongInt($10325476);
  93.     end
  94. end;
  95. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
  96. { MD5 block update operation. Continues an MD5 message-digest operation,      }
  97. { processing another message block, and updating the context.                 }
  98. procedure MD5Update(
  99.     var MD5Context: TMD5Context;            { Context                         }
  100.     const Data;                             { Input block                     }
  101.     Len: Integer);                          { Length of input block           }
  102. type
  103.     TByteArray = array [0..0] of Byte;
  104. var
  105.     Index: Word;
  106.     T: LongInt;
  107. begin
  108.     with MD5Context do begin
  109.         T := Count[0];
  110.         Inc(Count[0], LongInt(Len) shl 3);
  111.         if Cardinal(Count[0]) < Cardinal(T) then    {20030314 Bas Steendijk}
  112.             Inc(Count[1]);
  113.         Inc(Count[1], Len shr 29);
  114.         T := (T shr 3) and $3F;
  115.         Index := 0;
  116.         if T <> 0 then begin
  117.             Index := T;
  118.             T := 64 - T;
  119.             if Len < T then begin
  120.                 Move(Data, BufChar[Index], Len);
  121.                 Exit;
  122.             end;
  123.             Move(Data, BufChar[Index], T);
  124.             MD5Transform(State, BufLong);
  125.             Dec(Len, T);
  126.             Index := T;  { Wolfgang Klein, 05/06/99 }
  127.         end;
  128.         while Len >= 64 do begin
  129.             Move(TByteArray(Data)[Index], BufChar, 64);
  130.             MD5Transform(State, BufLong);
  131.             Inc(Index, 64);
  132.             Dec(Len, 64);
  133.         end;
  134.         Move(TByteArray(Data)[Index], BufChar, Len);
  135.     end
  136. end;
  137. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
  138. { MD5 finalization. Ends an MD5 message-digest operation, writing the message }
  139. { digest and zeroizing the context.                                           }
  140. procedure MD5Final(var Digest: TMD5Digest; var MD5Context: TMD5Context);
  141. var
  142.     Cnt : Word;
  143.     P   : Byte;
  144. begin
  145.     with MD5Context do begin
  146.         Cnt := (Count[0] shr 3) and $3F;
  147.         P := Cnt;
  148.         BufChar[P] := $80;
  149.         Inc(P);
  150.         Cnt := 64 - 1 - Cnt;
  151.         if Cnt < 8 then begin
  152.             FillChar(BufChar[P], Cnt, #0);
  153.             MD5Transform(State, BufLong);
  154.             FillChar(BufChar, 56, #0);
  155.         end
  156.         else
  157.             FillChar(BufChar[P], Cnt - 8, #0);
  158.         BufLong[14] := Count[0];
  159.         BufLong[15] := Count[1];
  160.         MD5Transform(State, BufLong);
  161.         Move(State, Digest, 16)
  162.     end;
  163.     FillChar(MD5Context, SizeOf(TMD5Context), #0)
  164. end;
  165. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
  166. { MD5 basic transformation. Transforms state based on block.                  }
  167. procedure MD5Transform(
  168.     var Buf: array of LongInt;
  169.     const Data: array of LongInt);
  170. var
  171.     A, B, C, D: LongInt;
  172.     procedure Round1(var W: LongInt; X, Y, Z, Data: LongInt; S: Byte);
  173.     begin
  174.         Inc(W, (Z xor (X and (Y xor Z))) + Data);
  175.         W := (W shl S) or (W shr (32 - S));
  176.         Inc(W, X)
  177.     end;
  178.     procedure Round2(var W: LongInt; X, Y, Z, Data: LongInt; S: Byte);
  179.     begin
  180.         Inc(W, (Y xor (Z and (X xor Y))) + Data);
  181.         W := (W shl S) or (W shr (32 - S));
  182.         Inc(W, X)
  183.     end;
  184.     procedure Round3(var W: LongInt; X, Y, Z, Data: LongInt; S: Byte);
  185.     begin
  186.         Inc(W, (X xor Y xor Z) + Data);
  187.         W := (W shl S) or (W shr (32 - S));
  188.         Inc(W, X)
  189.     end;
  190.     procedure Round4(var W: LongInt; X, Y, Z, Data: LongInt; S: Byte);
  191.     begin
  192.         Inc(W, (Y xor (X or not Z)) + Data);
  193.         W := (W shl S) or (W shr (32 - S));
  194.         Inc(W, X)
  195.     end;
  196. begin
  197.     A := Buf[0];
  198.     B := Buf[1];
  199.     C := Buf[2];
  200.     D := Buf[3];
  201.     Round1(A, B, C, D, Data[ 0] + LongInt($d76aa478),  7);
  202.     Round1(D, A, B, C, Data[ 1] + LongInt($e8c7b756), 12);
  203.     Round1(C, D, A, B, Data[ 2] + LongInt($242070db), 17);
  204.     Round1(B, C, D, A, Data[ 3] + LongInt($c1bdceee), 22);
  205.     Round1(A, B, C, D, Data[ 4] + LongInt($f57c0faf),  7);
  206.     Round1(D, A, B, C, Data[ 5] + LongInt($4787c62a), 12);
  207.     Round1(C, D, A, B, Data[ 6] + LongInt($a8304613), 17);
  208.     Round1(B, C, D, A, Data[ 7] + LongInt($fd469501), 22);
  209.     Round1(A, B, C, D, Data[ 8] + LongInt($698098d8),  7);
  210.     Round1(D, A, B, C, Data[ 9] + LongInt($8b44f7af), 12);
  211.     Round1(C, D, A, B, Data[10] + LongInt($ffff5bb1), 17);
  212.     Round1(B, C, D, A, Data[11] + LongInt($895cd7be), 22);
  213.     Round1(A, B, C, D, Data[12] + LongInt($6b901122),  7);
  214.     Round1(D, A, B, C, Data[13] + LongInt($fd987193), 12);
  215.     Round1(C, D, A, B, Data[14] + LongInt($a679438e), 17);
  216.     Round1(B, C, D, A, Data[15] + LongInt($49b40821), 22);
  217.     Round2(A, B, C, D, Data[ 1] + LongInt($f61e2562),  5);
  218.     Round2(D, A, B, C, Data[ 6] + LongInt($c040b340),  9);
  219.     Round2(C, D, A, B, Data[11] + LongInt($265e5a51), 14);
  220.     Round2(B, C, D, A, Data[ 0] + LongInt($e9b6c7aa), 20);
  221.     Round2(A, B, C, D, Data[ 5] + LongInt($d62f105d),  5);
  222.     Round2(D, A, B, C, Data[10] + LongInt($02441453),  9);
  223.     Round2(C, D, A, B, Data[15] + LongInt($d8a1e681), 14);
  224.     Round2(B, C, D, A, Data[ 4] + LongInt($e7d3fbc8), 20);
  225.     Round2(A, B, C, D, Data[ 9] + LongInt($21e1cde6),  5);
  226.     Round2(D, A, B, C, Data[14] + LongInt($c33707d6),  9);
  227.     Round2(C, D, A, B, Data[ 3] + LongInt($f4d50d87), 14);
  228.     Round2(B, C, D, A, Data[ 8] + LongInt($455a14ed), 20);
  229.     Round2(A, B, C, D, Data[13] + LongInt($a9e3e905),  5);
  230.     Round2(D, A, B, C, Data[ 2] + LongInt($fcefa3f8),  9);
  231.     Round2(C, D, A, B, Data[ 7] + LongInt($676f02d9), 14);
  232.     Round2(B, C, D, A, Data[12] + LongInt($8d2a4c8a), 20);
  233.     Round3(A, B, C, D, Data[ 5] + LongInt($fffa3942),  4);
  234.     Round3(D, A, B, C, Data[ 8] + LongInt($8771f681), 11);
  235.     Round3(C, D, A, B, Data[11] + LongInt($6d9d6122), 16);
  236.     Round3(B, C, D, A, Data[14] + LongInt($fde5380c), 23);
  237.     Round3(A, B, C, D, Data[ 1] + LongInt($a4beea44),  4);
  238.     Round3(D, A, B, C, Data[ 4] + LongInt($4bdecfa9), 11);
  239.     Round3(C, D, A, B, Data[ 7] + LongInt($f6bb4b60), 16);
  240.     Round3(B, C, D, A, Data[10] + LongInt($bebfbc70), 23);
  241.     Round3(A, B, C, D, Data[13] + LongInt($289b7ec6),  4);
  242.     Round3(D, A, B, C, Data[ 0] + LongInt($eaa127fa), 11);
  243.     Round3(C, D, A, B, Data[ 3] + LongInt($d4ef3085), 16);
  244.     Round3(B, C, D, A, Data[ 6] + LongInt($04881d05), 23);
  245.     Round3(A, B, C, D, Data[ 9] + LongInt($d9d4d039),  4);
  246.     Round3(D, A, B, C, Data[12] + LongInt($e6db99e5), 11);
  247.     Round3(C, D, A, B, Data[15] + LongInt($1fa27cf8), 16);
  248.     Round3(B, C, D, A, Data[ 2] + LongInt($c4ac5665), 23);
  249.     Round4(A, B, C, D, Data[ 0] + LongInt($f4292244),  6);
  250.     Round4(D, A, B, C, Data[ 7] + LongInt($432aff97), 10);
  251.     Round4(C, D, A, B, Data[14] + LongInt($ab9423a7), 15);
  252.     Round4(B, C, D, A, Data[ 5] + LongInt($fc93a039), 21);
  253.     Round4(A, B, C, D, Data[12] + LongInt($655b59c3),  6);
  254.     Round4(D, A, B, C, Data[ 3] + LongInt($8f0ccc92), 10);
  255.     Round4(C, D, A, B, Data[10] + LongInt($ffeff47d), 15);
  256.     Round4(B, C, D, A, Data[ 1] + LongInt($85845dd1), 21);
  257.     Round4(A, B, C, D, Data[ 8] + LongInt($6fa87e4f),  6);
  258.     Round4(D, A, B, C, Data[15] + LongInt($fe2ce6e0), 10);
  259.     Round4(C, D, A, B, Data[ 6] + LongInt($a3014314), 15);
  260.     Round4(B, C, D, A, Data[13] + LongInt($4e0811a1), 21);
  261.     Round4(A, B, C, D, Data[ 4] + LongInt($f7537e82),  6);
  262.     Round4(D, A, B, C, Data[11] + LongInt($bd3af235), 10);
  263.     Round4(C, D, A, B, Data[ 2] + LongInt($2ad7d2bb), 15);
  264.     Round4(B, C, D, A, Data[ 9] + LongInt($eb86d391), 21);
  265.     Inc(Buf[0], A);
  266.     Inc(Buf[1], B);
  267.     Inc(Buf[2], C);
  268.     Inc(Buf[3], D);
  269. end;
  270. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
  271. procedure MD5UpdateBuffer(
  272.     var MD5Context: TMD5Context;
  273.     Buffer: Pointer;
  274.     BufSize: Integer);
  275. var
  276.     BufTmp : PMD5Buffer;
  277.     BufPtr : PChar;
  278.     Bytes  : Word;
  279. begin
  280.     New(BufTmp);
  281.     BufPtr := Buffer;
  282.     try
  283.         repeat
  284.             if BufSize > MaxBufSize then
  285.                 Bytes := MaxBufSize
  286.             else
  287.                 Bytes := BufSize;
  288.             Move(BufPtr^, BufTmp^, Bytes);
  289.             Inc(BufPtr, Bytes);
  290.             Dec(BufSize, Bytes);
  291.             if Bytes > 0 then
  292.                 MD5Update(MD5Context, BufTmp^, Bytes);
  293.         until Bytes < MaxBufSize;
  294.     finally
  295.         Dispose(BufTmp);
  296.     end;
  297. end;
  298. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
  299. function GetMD5(Buffer: Pointer; BufSize: Integer): string;
  300. var
  301.     I          : Integer;
  302.     MD5Digest  : TMD5Digest;
  303.     MD5Context : TMD5Context;
  304. begin
  305.     for I := 0 to 15 do
  306.         Byte(MD5Digest[I]) := I + 1;
  307.     MD5Init(MD5Context);
  308.     MD5UpdateBuffer(MD5Context, Buffer, BufSize);
  309.     MD5Final(MD5Digest, MD5Context);
  310.     Result := '';
  311.     for I := 0 to 15 do
  312.         Result := Result + IntToHex(Byte(MD5Digest[I]), 2);
  313. end;
  314. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
  315. function StrMD5(Buffer : String): string;
  316. begin
  317.     Result := GetMD5(@Buffer[1], Length(Buffer));
  318. end;
  319. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
  320. function FileMD5(const Filename: String) : String;
  321. const
  322. {$IFDEF VER80}
  323.     ChunkSize : Cardinal = 1024 * 31;
  324. {$ELSE}
  325.     ChunkSize : Cardinal = 102400;
  326. {$ENDIF}
  327. var
  328.     I          : Integer;
  329.     J          : Integer;
  330.     Num        : Integer;
  331.     Rest       : Integer;
  332.     MD5Digest  : TMD5Digest;
  333.     MD5Context : TMD5Context;
  334.     Buf        : ^Byte;
  335.     Stream     : TFileStream;
  336. begin
  337.     Result := '';
  338.     { Open file }
  339.     Stream := TFileStream.Create(Filename, fmOpenRead or fmShareDenyWrite);
  340.     try
  341.         { Allocate buffer to read file }
  342.         GetMem(Buf, ChunkSize);
  343.         try
  344.             { Initialize MD5 engine }
  345.             for I := 0 to 15 do
  346.                 Byte(MD5Digest[I]) := I + 1;
  347.             MD5Init(MD5Context);
  348.             { Calculate number of full chunks that will fit into the buffer }
  349.             Num  := Cardinal(Stream.Size) div ChunkSize;
  350.             { Calculate remaining bytes }
  351.             Rest := Cardinal(Stream.Size) mod ChunkSize;
  352.             { Set the stream to the beginning of the file }
  353.             Stream.Position := 0;
  354.             { Process full chunks }
  355.             for J := 0 to Num-1 do begin
  356.                 Stream.Read(buf^, ChunkSize);
  357.                 MD5UpdateBuffer(MD5Context, buf, ChunkSize);
  358.             end;
  359.             { Process remaining bytes }
  360.             if Rest > 0 then begin
  361.                 Stream.Read(buf^, Rest);
  362.                 MD5UpdateBuffer(MD5Context, buf, Rest);
  363.             end;
  364.         finally
  365.             FreeMem(Buf, ChunkSize);
  366.         end;
  367.         { Finalize MD5 calculation }
  368.         MD5Final(MD5Digest, MD5Context);
  369.         for I := 0 to 15 do
  370.             Result := Result + IntToHex(Byte(MD5Digest[I]), 2);
  371.     finally
  372.         { Free the file }
  373.         Stream.Free;
  374.     end;
  375. end;
  376. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
  377. end.