home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 October / Chip_2001-10_cd1.bin / zkuste / delphi / nastroje / d3456 / KBMWABD.ZIP / WABD_Crypt.pas < prev    next >
Pascal/Delphi Source File  |  1999-06-09  |  14KB  |  415 lines
  1. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  2.  
  3. Author:       Franτois PIETTE. Based on work given by Louis S. Berman from
  4.               BrainTree Ltd, lsb@braintree.com
  5. Description:  MD5 is an implmentation for the MD5 Message-Digest Algorithm
  6.               as described in RFC-1321
  7. EMail:        francois.piette@pophost.eunet.be    francois.piette@ping.be
  8.               francois.piette@rtfm.be             http://www.rtfm.be/fpiette
  9. Creation:     October 11, 1997
  10. Version:      1.00
  11. Support:      Use the mailing list twsocket@rtfm.be See website for details.
  12. Legal issues: Copyright (C) 1997, 1998 by Franτois PIETTE
  13.               Rue de Grady 24, 4053 Embourg, Belgium. Fax: +32-4-365.74.56
  14.               <francois.piette@pophost.eunet.be>
  15.  
  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.  
  20.               Permission is granted to anyone to use this software for any
  21.               purpose, including commercial applications, and to alter it
  22.               and redistribute it freely, subject to the following
  23.               restrictions:
  24.  
  25.               1. The origin of this software must not be misrepresented,
  26.                  you must not claim that you wrote the original software.
  27.                  If you use this software in a product, an acknowledgment
  28.                  in the product documentation would be appreciated but is
  29.                  not required.
  30.  
  31.               2. Altered source versions must be plainly marked as such, and
  32.                  must not be misrepresented as being the original software.
  33.  
  34.               3. This notice may not be removed or altered from any source
  35.                  distribution.
  36.  
  37. Updates:
  38. Oct 26, 1997 Changed MD5Final form function to procedure to be compatible
  39.              with C++Builder.
  40.  
  41. * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
  42. unit WABD_Crypt;
  43.  
  44. interface
  45.  
  46. uses
  47.     SysUtils;
  48.  
  49. const
  50.     MD5Version = 100;
  51.  
  52. type
  53. {$ifdef VER100} // Delphi 3
  54.     CrLongInt=Longint;
  55. {$else}
  56.     CrLongInt=Cardinal;
  57. {$endif}
  58.  
  59. // *****************************************************
  60. // * BASE 64
  61. // *****************************************************
  62. function WABD_DecodeBASE64(code:string):string;
  63.  
  64. // *****************************************************
  65. // * MD 5
  66. // *****************************************************
  67. type
  68.     TWABDMD5Context = record
  69.         State: array[0..3] of CrLongInt;
  70.         Count: array[0..1] of CrLongInt;
  71.         case Integer of
  72.         0: (BufChar: array[0..63] of Byte);
  73.         1: (BufLong: array[0..15] of CrLongInt);
  74.     end;
  75.     TWABDMD5Digest = array[0..15] of Char;
  76.  
  77. procedure WABD_MD5Init(var MD5Context: TWABDMD5Context);
  78. procedure WABD_MD5Update(var MD5Context: TWABDMD5Context;
  79.                     const Data;
  80.                     Len: CrLongInt);
  81. procedure WABD_MD5Transform(var Buf: array of CrLongInt;
  82.                        const Data: array of CrLongInt);
  83. procedure WABD_MD5UpdateBuffer(var MD5Context: TWABDMD5Context;
  84.                           Buffer: Pointer;
  85.                           BufSize: Integer);
  86. procedure WABD_MD5Final(var Digest: TWABDMD5Digest; var MD5Context: TWABDMD5Context);
  87.  
  88. function WABD_GetMD5(Buffer: Pointer; BufSize: Integer): string;
  89. function WABD_StrMD5(Buffer : String): string;
  90.  
  91. implementation
  92.  
  93. const
  94.     MaxBufSize = 16384;
  95.  
  96. type
  97.     PWABDMD5Buffer = ^TWABDMD5Buffer;
  98.     TWABDMD5Buffer = array[0..(MaxBufSize - 1)] of Char;
  99.  
  100.  
  101. // *****************************************************
  102. // * BASE 64
  103. // *****************************************************
  104.  
  105. function WABD_DecodeBASE64(code:string):string;
  106. type
  107.      Tindex_64 = array[0..255] of byte;
  108. const
  109.      XX = 127;
  110.      basis_64:string = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
  111.      index_64:Tindex_64 = (
  112.     XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
  113.     XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
  114.     XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,62, XX,XX,XX,63,
  115.     52,53,54,55, 56,57,58,59, 60,61,XX,XX, XX,XX,XX,XX,
  116.     XX, 0, 1, 2,  3, 4, 5, 6,  7, 8, 9,10, 11,12,13,14,
  117.     15,16,17,18, 19,20,21,22, 23,24,25,XX, XX,XX,XX,XX,
  118.     XX,26,27,28, 29,30,31,32, 33,34,35,36, 37,38,39,40,
  119.     41,42,43,44, 45,46,47,48, 49,50,51,XX, XX,XX,XX,XX,
  120.     XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
  121.     XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
  122.     XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
  123.     XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
  124.     XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
  125.     XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
  126.     XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
  127.     XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX );
  128. var
  129.     i:integer;
  130.     c1,c2,c3,c4:byte;
  131. begin
  132.     Result:='';
  133.  
  134.     i:=1;
  135.     while i<Length(code) do
  136.     begin
  137.          c1:=ord(code[i]);
  138.          if (index_64[c1] = XX) then break;
  139.      c2:=ord(code[i+1]);
  140.          if (index_64[c2] = XX) then break;
  141.          c3:=ord(code[i+2]);
  142.          if (c3 <> ord('=')) and (index_64[c3] = XX) then break;
  143.          c4:=ord(code[i+3]);
  144.          if (c4 <> ord('=')) and (index_64[c4] = XX) then break;
  145.  
  146.          Result:=Result+chr((index_64[c1] shl 2) + (index_64[c2] shr 4));
  147.          if c3=ord('=') then break;
  148.          Result:=Result+chr(((index_64[c2] shl 4) and $F0) + (index_64[c3] shr 2));
  149.          if c4=ord('=') then break;
  150.          Result:=Result+chr(((index_64[c3] shl 6) and $C0) + (index_64[c4]));
  151.          inc(i,4);
  152.     end;
  153. end;
  154.  
  155. // *****************************************************
  156. // * MD 5
  157. // *****************************************************
  158.  
  159. // MD5 initialization. Begins an MD5 operation, writing a new context.
  160. procedure WABD_MD5Init(var MD5Context: TWABDMD5Context);
  161. begin
  162.     FillChar(MD5Context, SizeOf(TWABDMD5Context), #0);
  163.     with MD5Context do begin
  164.         { Load magic initialization constants. }
  165.         State[0] := $67452301;
  166.         State[1] := $EFCDAB89;
  167.         State[2] := $98BADCFE;
  168.         State[3] := $10325476
  169.     end
  170. end;
  171.  
  172.  
  173. // MD5 block update operation. Continues an MD5 message-digest operation,
  174. // processing another message block, and updating the context.
  175. procedure WABD_MD5Update(
  176.     var MD5Context: TWABDMD5Context;        // Context
  177.     const Data;                             // Input block
  178.     Len: CrLongInt);                          // Length of input block
  179. type
  180.     TByteArray = array[0..0] of Byte;
  181. var
  182.     Index: Word;
  183.     T: CrLongInt;
  184. begin
  185.     with MD5Context do begin
  186.         T := Count[0];
  187.         Inc(Count[0], CrLongInt(Len) shl 3);
  188.         if Count[0] < T then
  189.             Inc(Count[1]);
  190.         Inc(Count[1], Len shr 29);
  191.         T := (T shr 3) and $3F;
  192.         Index := 0;
  193.         if T <> 0 then begin
  194.             Index := T;
  195.             T := 64 - T;
  196.             if Len < T then begin
  197.                 Move(Data, BufChar[Index], Len);
  198.                 Exit;
  199.             end;
  200.             Move(Data, BufChar[Index], T);
  201.             WABD_MD5Transform(State, BufLong);
  202.             Dec(Len, T);
  203.         end;
  204.         while Len >= 64 do begin
  205.             Move(TByteArray(Data)[Index], BufChar, 64);
  206.             WABD_MD5Transform(State, BufLong);
  207.             Inc(Index, 64);
  208.             Dec(Len, 64);
  209.         end;
  210.         Move(TByteArray(Data)[Index], BufChar, Len);
  211.     end
  212. end;
  213.  
  214.  
  215. // MD5 finalization. Ends an MD5 message-digest operation, writing the message
  216. // digest and zeroizing the context.
  217. procedure WABD_MD5Final(var Digest: TWABDMD5Digest; var MD5Context: TWABDMD5Context);
  218. var
  219.     Cnt : Word;
  220.     P   : Byte;
  221. begin
  222.     with MD5Context do begin
  223.         Cnt := (Count[0] shr 3) and $3F;
  224.         P := Cnt;
  225.         BufChar[P] := $80;
  226.         Inc(P);
  227.         Cnt := 64 - 1 - Cnt;
  228.         if Cnt < 8 then begin
  229.             FillChar(BufChar[P], Cnt, #0);
  230.             WABD_MD5Transform(State, BufLong);
  231.             FillChar(BufChar, 56, #0);
  232.         end
  233.         else
  234.             FillChar(BufChar[P], Cnt - 8, #0);
  235.         BufLong[14] := Count[0];
  236.         BufLong[15] := Count[1];
  237.         WABD_MD5Transform(State, BufLong);
  238.         Move(State, Digest, 16)
  239.     end;
  240.     FillChar(MD5Context, SizeOf(TWABDMD5Context), #0)
  241. end;
  242.  
  243.  
  244. // MD5 basic transformation. Transforms state based on block.
  245. procedure WABD_MD5Transform(
  246.     var Buf: array of CrLongInt;
  247.     const Data: array of CrLongInt);
  248. var
  249.     A, B, C, D: CrLongInt;
  250.  
  251.     procedure Round1(var W: CrLongInt; X, Y, Z, Data: CrLongInt; S: Byte);
  252.     begin
  253.         Inc(W, (Z xor (X and (Y xor Z))) + Data);
  254.         W := (W shl S) or (W shr (32 - S));
  255.         Inc(W, X)
  256.     end;
  257.  
  258.     procedure Round2(var W: CrLongInt; X, Y, Z, Data: CrLongInt; S: Byte);
  259.     begin
  260.         Inc(W, (Y xor (Z and (X xor Y))) + Data);
  261.         W := (W shl S) or (W shr (32 - S));
  262.         Inc(W, X)
  263.     end;
  264.  
  265.     procedure Round3(var W: CrLongInt; X, Y, Z, Data: CrLongInt; S: Byte);
  266.     begin
  267.         Inc(W, (X xor Y xor Z) + Data);
  268.         W := (W shl S) or (W shr (32 - S));
  269.         Inc(W, X)
  270.     end;
  271.  
  272.     procedure Round4(var W: CrLongInt; X, Y, Z, Data: CrLongInt; S: Byte);
  273.     begin
  274.         Inc(W, (Y xor (X or not Z)) + Data);
  275.         W := (W shl S) or (W shr (32 - S));
  276.         Inc(W, X)
  277.     end;
  278. begin
  279.     A := Buf[0];
  280.     B := Buf[1];
  281.     C := Buf[2];
  282.     D := Buf[3];
  283.  
  284.     Round1(A, B, C, D, Data[ 0] + $d76aa478,  7);
  285.     Round1(D, A, B, C, Data[ 1] + $e8c7b756, 12);
  286.     Round1(C, D, A, B, Data[ 2] + $242070db, 17);
  287.     Round1(B, C, D, A, Data[ 3] + $c1bdceee, 22);
  288.     Round1(A, B, C, D, Data[ 4] + $f57c0faf,  7);
  289.     Round1(D, A, B, C, Data[ 5] + $4787c62a, 12);
  290.     Round1(C, D, A, B, Data[ 6] + $a8304613, 17);
  291.     Round1(B, C, D, A, Data[ 7] + $fd469501, 22);
  292.     Round1(A, B, C, D, Data[ 8] + $698098d8,  7);
  293.     Round1(D, A, B, C, Data[ 9] + $8b44f7af, 12);
  294.     Round1(C, D, A, B, Data[10] + $ffff5bb1, 17);
  295.     Round1(B, C, D, A, Data[11] + $895cd7be, 22);
  296.     Round1(A, B, C, D, Data[12] + $6b901122,  7);
  297.     Round1(D, A, B, C, Data[13] + $fd987193, 12);
  298.     Round1(C, D, A, B, Data[14] + $a679438e, 17);
  299.     Round1(B, C, D, A, Data[15] + $49b40821, 22);
  300.  
  301.     Round2(A, B, C, D, Data[ 1] + $f61e2562,  5);
  302.     Round2(D, A, B, C, Data[ 6] + $c040b340,  9);
  303.     Round2(C, D, A, B, Data[11] + $265e5a51, 14);
  304.     Round2(B, C, D, A, Data[ 0] + $e9b6c7aa, 20);
  305.     Round2(A, B, C, D, Data[ 5] + $d62f105d,  5);
  306.     Round2(D, A, B, C, Data[10] + $02441453,  9);
  307.     Round2(C, D, A, B, Data[15] + $d8a1e681, 14);
  308.     Round2(B, C, D, A, Data[ 4] + $e7d3fbc8, 20);
  309.     Round2(A, B, C, D, Data[ 9] + $21e1cde6,  5);
  310.     Round2(D, A, B, C, Data[14] + $c33707d6,  9);
  311.     Round2(C, D, A, B, Data[ 3] + $f4d50d87, 14);
  312.     Round2(B, C, D, A, Data[ 8] + $455a14ed, 20);
  313.     Round2(A, B, C, D, Data[13] + $a9e3e905,  5);
  314.     Round2(D, A, B, C, Data[ 2] + $fcefa3f8,  9);
  315.     Round2(C, D, A, B, Data[ 7] + $676f02d9, 14);
  316.     Round2(B, C, D, A, Data[12] + $8d2a4c8a, 20);
  317.  
  318.     Round3(A, B, C, D, Data[ 5] + $fffa3942,  4);
  319.     Round3(D, A, B, C, Data[ 8] + $8771f681, 11);
  320.     Round3(C, D, A, B, Data[11] + $6d9d6122, 16);
  321.     Round3(B, C, D, A, Data[14] + $fde5380c, 23);
  322.     Round3(A, B, C, D, Data[ 1] + $a4beea44,  4);
  323.     Round3(D, A, B, C, Data[ 4] + $4bdecfa9, 11);
  324.     Round3(C, D, A, B, Data[ 7] + $f6bb4b60, 16);
  325.     Round3(B, C, D, A, Data[10] + $bebfbc70, 23);
  326.     Round3(A, B, C, D, Data[13] + $289b7ec6,  4);
  327.     Round3(D, A, B, C, Data[ 0] + $eaa127fa, 11);
  328.     Round3(C, D, A, B, Data[ 3] + $d4ef3085, 16);
  329.     Round3(B, C, D, A, Data[ 6] + $04881d05, 23);
  330.     Round3(A, B, C, D, Data[ 9] + $d9d4d039,  4);
  331.     Round3(D, A, B, C, Data[12] + $e6db99e5, 11);
  332.     Round3(C, D, A, B, Data[15] + $1fa27cf8, 16);
  333.     Round3(B, C, D, A, Data[ 2] + $c4ac5665, 23);
  334.  
  335.     Round4(A, B, C, D, Data[ 0] + $f4292244,  6);
  336.     Round4(D, A, B, C, Data[ 7] + $432aff97, 10);
  337.     Round4(C, D, A, B, Data[14] + $ab9423a7, 15);
  338.     Round4(B, C, D, A, Data[ 5] + $fc93a039, 21);
  339.     Round4(A, B, C, D, Data[12] + $655b59c3,  6);
  340.     Round4(D, A, B, C, Data[ 3] + $8f0ccc92, 10);
  341.     Round4(C, D, A, B, Data[10] + $ffeff47d, 15);
  342.     Round4(B, C, D, A, Data[ 1] + $85845dd1, 21);
  343.     Round4(A, B, C, D, Data[ 8] + $6fa87e4f,  6);
  344.     Round4(D, A, B, C, Data[15] + $fe2ce6e0, 10);
  345.     Round4(C, D, A, B, Data[ 6] + $a3014314, 15);
  346.     Round4(B, C, D, A, Data[13] + $4e0811a1, 21);
  347.     Round4(A, B, C, D, Data[ 4] + $f7537e82,  6);
  348.     Round4(D, A, B, C, Data[11] + $bd3af235, 10);
  349.     Round4(C, D, A, B, Data[ 2] + $2ad7d2bb, 15);
  350.     Round4(B, C, D, A, Data[ 9] + $eb86d391, 21);
  351.  
  352.     Inc(Buf[0], A);
  353.     Inc(Buf[1], B);
  354.     Inc(Buf[2], C);
  355.     Inc(Buf[3], D);
  356. end;
  357.  
  358.  
  359. // Internal buffer handling.
  360. procedure WABD_MD5UpdateBuffer(
  361.     var MD5Context: TWABDMD5Context;
  362.     Buffer: Pointer;
  363.     BufSize: Integer);
  364. var
  365.     BufTmp : PWABDMD5Buffer;
  366.     BufPtr : PChar;
  367.     Bytes  : Word;
  368. begin
  369.     New(BufTmp);
  370.     BufPtr := Buffer;
  371.     try
  372.         repeat
  373.             if BufSize > MaxBufSize then
  374.                 Bytes := MaxBufSize
  375.             else
  376.                 Bytes := BufSize;
  377.             Move(BufPtr^, BufTmp^, Bytes);
  378.             Inc(BufPtr, Bytes);
  379.             Dec(BufSize, Bytes);
  380.             if Bytes > 0 then
  381.                 WABD_MD5Update(MD5Context, BufTmp^, Bytes);
  382.         until Bytes < MaxBufSize;
  383.     finally
  384.         Dispose(BufTmp);
  385.     end;
  386. end;
  387.  
  388.  
  389. // Calculate MD5 from provided buffer.
  390. function WABD_GetMD5(Buffer: Pointer; BufSize: Integer): string;
  391. var
  392.     I          : Integer;
  393.     MD5Digest  : TWABDMD5Digest;
  394.     MD5Context : TWABDMD5Context;
  395. begin
  396.     for I := 0 to 15 do
  397.         Byte(MD5Digest[I]) := I + 1;
  398.     WABD_MD5Init(MD5Context);
  399.     WABD_MD5UpdateBuffer(MD5Context, Buffer, BufSize);
  400.     WABD_MD5Final(MD5Digest, MD5Context);
  401.     Result := '';
  402.     for I := 0 to 15 do
  403.         Result := Result + IntToHex(Byte(MD5Digest[I]), 2);
  404. end;
  405.  
  406. // Calculate MD5 from provided string.
  407. function WABD_StrMD5(Buffer : String): string;
  408. begin
  409.     Result := WABD_GetMD5(@Buffer[1], Length(Buffer));
  410. end;
  411.  
  412. end.
  413.  
  414.  
  415.