Алгоритм хэширования MD5

Function md5(s:string):string;
{©Drkb v.3(2007): <a href="http://www.drkb.ru" title="www.drkb.ru">www.drkb.ru</a>,
 ®Vit (Vitaly Nevzorov) - nevzorov@yahoo.com}

 var a:array[0..15] of byte;
  i:integer;
 LenHi, LenLo: longword;
 Index: DWord;
 HashBuffer: array[0..63] of byte;
 CurrentHash: array[0..3] of DWord;
 procedure Burn;
 begin
  LenHi:= 0; LenLo:= 0;
  Index:= 0;
  FillChar(HashBuffer,Sizeof(HashBuffer),0);
  FillChar(CurrentHash,Sizeof(CurrentHash),0);
 end;
 procedure Init;
 begin
  Burn;
  CurrentHash[0]:= $67452301;
  CurrentHash[1]:= $efcdab89;
  CurrentHash[2]:= $98badcfe;
  CurrentHash[3]:= $10325476;
 end;
 function LRot32(a, b: longword): longword;
 begin
  Result:= (a shl b) or (a shr (32-b));
 end;
 procedure Compress;
 var
  Data: array[0..15] of dword;
  A, B, C, D: dword;
 begin
  Move(HashBuffer,Data,Sizeof(Data));
  A:= CurrentHash[0];
  B:= CurrentHash[1];
  C:= CurrentHash[2];
  D:= CurrentHash[3];
  A:= B + LRot32(A + (D xor (B and (C xor D))) + Data[ 0] + $d76aa478,7);
  D:= A + LRot32(D + (C xor (A and (B xor C))) + Data[ 1] + $e8c7b756,12);
  C:= D + LRot32(C + (B xor (D and (A xor B))) + Data[ 2] + $242070db,17);
  B:= C + LRot32(B + (A xor (C and (D xor A))) + Data[ 3] + $c1bdceee,22);
  A:= B + LRot32(A + (D xor (B and (C xor D))) + Data[ 4] + $f57c0faf,7);
  D:= A + LRot32(D + (C xor (A and (B xor C))) + Data[ 5] + $4787c62a,12);
  C:= D + LRot32(C + (B xor (D and (A xor B))) + Data[ 6] + $a8304613,17);
  B:= C + LRot32(B + (A xor (C and (D xor A))) + Data[ 7] + $fd469501,22);
  A:= B + LRot32(A + (D xor (B and (C xor D))) + Data[ 8] + $698098d8,7);
  D:= A + LRot32(D + (C xor (A and (B xor C))) + Data[ 9] + $8b44f7af,12);
  C:= D + LRot32(C + (B xor (D and (A xor B))) + Data[10] + $ffff5bb1,17);
  B:= C + LRot32(B + (A xor (C and (D xor A))) + Data[11] + $895cd7be,22);
  A:= B + LRot32(A + (D xor (B and (C xor D))) + Data[12] + $6b901122,7);
  D:= A + LRot32(D + (C xor (A and (B xor C))) + Data[13] + $fd987193,12);
  C:= D + LRot32(C + (B xor (D and (A xor B))) + Data[14] + $a679438e,17);
  B:= C + LRot32(B + (A xor (C and (D xor A))) + Data[15] + $49b40821,22);
  A:= B + LRot32(A + (C xor (D and (B xor C))) + Data[ 1] + $f61e2562,5);
  D:= A + LRot32(D + (B xor (C and (A xor B))) + Data[ 6] + $c040b340,9);
  C:= D + LRot32(C + (A xor (B and (D xor A))) + Data[11] + $265e5a51,14);
  B:= C + LRot32(B + (D xor (A and (C xor D))) + Data[ 0] + $e9b6c7aa,20);
  A:= B + LRot32(A + (C xor (D and (B xor C))) + Data[ 5] + $d62f105d,5);
  D:= A + LRot32(D + (B xor (C and (A xor B))) + Data[10] + $02441453,9);
  C:= D + LRot32(C + (A xor (B and (D xor A))) + Data[15] + $d8a1e681,14);
  B:= C + LRot32(B + (D xor (A and (C xor D))) + Data[ 4] + $e7d3fbc8,20);
  A:= B + LRot32(A + (C xor (D and (B xor C))) + Data[ 9] + $21e1cde6,5);
  D:= A + LRot32(D + (B xor (C and (A xor B))) + Data[14] + $c33707d6,9);
  C:= D + LRot32(C + (A xor (B and (D xor A))) + Data[ 3] + $f4d50d87,14);
  B:= C + LRot32(B + (D xor (A and (C xor D))) + Data[ 8] + $455a14ed,20);
  A:= B + LRot32(A + (C xor (D and (B xor C))) + Data[13] + $a9e3e905,5);
  D:= A + LRot32(D + (B xor (C and (A xor B))) + Data[ 2] + $fcefa3f8,9);
  C:= D + LRot32(C + (A xor (B and (D xor A))) + Data[ 7] + $676f02d9,14);
  B:= C + LRot32(B + (D xor (A and (C xor D))) + Data[12] + $8d2a4c8a,20);
  A:= B + LRot32(A + (B xor C xor D) + Data[ 5] + $fffa3942,4);
  D:= A + LRot32(D + (A xor B xor C) + Data[ 8] + $8771f681,11);
  C:= D + LRot32(C + (D xor A xor B) + Data[11] + $6d9d6122,16);
  B:= C + LRot32(B + (C xor D xor A) + Data[14] + $fde5380c,23);
  A:= B + LRot32(A + (B xor C xor D) + Data[ 1] + $a4beea44,4);
  D:= A + LRot32(D + (A xor B xor C) + Data[ 4] + $4bdecfa9,11);
  C:= D + LRot32(C + (D xor A xor B) + Data[ 7] + $f6bb4b60,16);
  B:= C + LRot32(B + (C xor D xor A) + Data[10] + $bebfbc70,23);
  A:= B + LRot32(A + (B xor C xor D) + Data[13] + $289b7ec6,4);
  D:= A + LRot32(D + (A xor B xor C) + Data[ 0] + $eaa127fa,11);
  C:= D + LRot32(C + (D xor A xor B) + Data[ 3] + $d4ef3085,16);
  B:= C + LRot32(B + (C xor D xor A) + Data[ 6] + $04881d05,23);
  A:= B + LRot32(A + (B xor C xor D) + Data[ 9] + $d9d4d039,4);
  D:= A + LRot32(D + (A xor B xor C) + Data[12] + $e6db99e5,11);
  C:= D + LRot32(C + (D xor A xor B) + Data[15] + $1fa27cf8,16);
  B:= C + LRot32(B + (C xor D xor A) + Data[ 2] + $c4ac5665,23);
  A:= B + LRot32(A + (C xor (B or (not D))) + Data[ 0] + $f4292244,6);
  D:= A + LRot32(D + (B xor (A or (not C))) + Data[ 7] + $432aff97,10);
  C:= D + LRot32(C + (A xor (D or (not B))) + Data[14] + $ab9423a7,15);
  B:= C + LRot32(B + (D xor (C or (not A))) + Data[ 5] + $fc93a039,21);
  A:= B + LRot32(A + (C xor (B or (not D))) + Data[12] + $655b59c3,6);
  D:= A + LRot32(D + (B xor (A or (not C))) + Data[ 3] + $8f0ccc92,10);
  C:= D + LRot32(C + (A xor (D or (not B))) + Data[10] + $ffeff47d,15);
  B:= C + LRot32(B + (D xor (C or (not A))) + Data[ 1] + $85845dd1,21);
  A:= B + LRot32(A + (C xor (B or (not D))) + Data[ 8] + $6fa87e4f,6);
  D:= A + LRot32(D + (B xor (A or (not C))) + Data[15] + $fe2ce6e0,10);
  C:= D + LRot32(C + (A xor (D or (not B))) + Data[ 6] + $a3014314,15);
  B:= C + LRot32(B + (D xor (C or (not A))) + Data[13] + $4e0811a1,21);
  A:= B + LRot32(A + (C xor (B or (not D))) + Data[ 4] + $f7537e82,6);
  D:= A + LRot32(D + (B xor (A or (not C))) + Data[11] + $bd3af235,10);
  C:= D + LRot32(C + (A xor (D or (not B))) + Data[ 2] + $2ad7d2bb,15);
  B:= C + LRot32(B + (D xor (C or (not A))) + Data[ 9] + $eb86d391,21);
  Inc(CurrentHash[0],A);
  Inc(CurrentHash[1],B);
  Inc(CurrentHash[2],C);
  Inc(CurrentHash[3],D);
  Index:= 0;
  FillChar(HashBuffer,Sizeof(HashBuffer),0);
 end;

 procedure Update(const Buffer; Size: longword);
 var
  PBuf: ^byte;
 begin
  Inc(LenHi,Size shr 29);
  Inc(LenLo,Size*8);
  if LenLo< (Size*8) then
  Inc(LenHi);
  PBuf:= @Buffer;
  while Size> 0 do
  begin
  if (Sizeof(HashBuffer)-Index)<= DWord(Size) then
  begin
  Move(PBuf^,HashBuffer[Index],Sizeof(HashBuffer)-Index);
  Dec(Size,Sizeof(HashBuffer)-Index);
  Inc(PBuf,Sizeof(HashBuffer)-Index);
  Compress;
  end
  else
  begin
  Move(PBuf^,HashBuffer[Index],Size);
  Inc(Index,Size);
  Size:= 0;
  end;
  end;
 end;
 procedure Final(var Digest);
 begin
  HashBuffer[Index]:= $80;
  if Index>= 56 then Compress;
  PDWord(@HashBuffer[56])^:= LenLo;
  PDWord(@HashBuffer[60])^:= LenHi;
  Compress;
  Move(CurrentHash,Digest,Sizeof(CurrentHash));
  Burn;
 end;

begin
 Init;
 Update(s[1],Length(s));
 Final(a);
 result:='';
 for i:=0 to 15 do
  result:=result+IntToHex(a[i],2);
 Burn;
end;

Автор: Vit (www.delphist.com, www.drkb.ru, www.unihighlighter.com, www.nevzorov.org)
Взято из http://forum.sources.ru

{ **** UBPFD *********** by kladovka.net.ru ****
>> Вычисление хеш-суммы MD5
Зависимости: Windows, SysUtils, Classes
Автор: Dimka Maslov, <a href="mailto:mainbox@endimus.ru">mainbox@endimus.ru</a>, ICQ:148442121, Санкт-Петербург
Copyright: http://www.faqs.org/rfcs/rfc1321.html
Дата: 19 июня 2002 г.
********************************************** }

{******************************************************************}
{ MD5 Hashsum Evaluation Unit For Borland Delphi }
{ }
{ Copyright © 2002 by Dimka Maslov }
{ E-mail: <a href="mailto:mainbox@endimus.com">mainbox@endimus.com</a>, }
{ Web-site: <a href="http://www.endimus.com" title="http://www.endimus.com">http://www.endimus.com</a> }
{ }
{ Derived from the RSA Data Security, Inc. }
{ MD5 Message-Digest Algorithm described in RFC 1321 }
{ <a href="http://www.faqs.org/rfcs/rfc1321.html" title="http://www.faqs.org/rfcs/rfc1321.html">http://www.faqs.org/rfcs/rfc1321.html</a> }
{******************************************************************}
unit md5;
interface
uses Windows, SysUtils, Classes;
type
 { Тип TMD5Digest используется для получения
  результата функций вычисления хеш-суммы.
  Содержимое записи можно использовать
  как набор из 4 целых чисел, или как
  массив из 16 байт }

 PMD5Digest = ^TMD5Digest;
 TMD5Digest = record
 case Integer of
  0: (A, B, C, D: LongInt);
  1: (v: array [0..15] of Byte);
 end;
// вычисление хеш-суммы для строки
function MD5String(const S: string): TMD5Digest;
// вычисление хеш-суммы для файла
function MD5File(const FileName: string): TMD5Digest;
// вычисление хеш-суммы для содержиого потока Stream
function MD5Stream(const Stream: TStream): TMD5Digest;
// вычисление хеш-суммы для произвольного буфера
function MD5Buffer(const Buffer; Size: Integer): TMD5Digest;
// преобразование хеш-суммы в строку из шестнадцатеричных цифр
function MD5DigestToStr(const Digest: TMD5Digest): string;
// сравнение двух хеш-сумм
function MD5DigestCompare(const Digest1, Digest2: TMD5Digest): Boolean;
implementation
{
Copyright (C) 1991-2, RSA Data Security, Inc. Created 1991. All
rights reserved.
License to copy and use this software is granted provided that it
is identified as the "RSA Data Security, Inc. MD5 Message-Digest
Algorithm" in all material mentioning or referencing this software
or this function.
License is also granted to make and use derivative works provided
that such works are identified as "derived from the RSA Data
Security, Inc. MD5 Message-Digest Algorithm" in all material
mentioning or referencing the derived work.
RSA Data Security, Inc. makes no representations concerning either
the merchantability of this software or the suitability of this
software for any particular purpose. It is provided "as is"
without express or implied warranty of any kind.
These notices must be retained in any copies of any part of this
documentation and/or software.
}

type
 UINT4 = LongWord;
 PArray4UINT4 = ^TArray4UINT4;
 TArray4UINT4 = array [0..3] of UINT4;
 PArray2UINT4 = ^TArray2UINT4;
 TArray2UINT4 = array [0..1] of UINT4;
 PArray16Byte = ^TArray16Byte;
 TArray16Byte = array [0..15] of Byte;
 PArray64Byte = ^TArray64Byte;
 TArray64Byte = array [0..63] of Byte;
 PByteArray = ^TByteArray;
 TByteArray = array [0..0] of Byte;
 PUINT4Array = ^TUINT4Array;
 TUINT4Array = array [0..0] of UINT4;
 PMD5Context = ^TMD5Context;
 TMD5Context = record
  state: TArray4UINT4;
  count: TArray2UINT4;
  buffer: TArray64Byte;
 end;
const
 S11 = 7;
 S12 = 12;
 S13 = 17;
 S14 = 22;
 S21 = 5;
 S22 = 9;
 S23 = 14;
 S24 = 20;
 S31 = 4;
 S32 = 11;
 S33 = 16;
 S34 = 23;
 S41 = 6;
 S42 = 10;
 S43 = 15;
 S44 = 21;
var
 Padding : TArray64Byte =
 ($80, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);

function _F(x, y, z: UINT4): UINT4;
begin
 Result := (((x) and (y)) or ((not x) and (z)));
end;
function _G(x, y, z: UINT4): UINT4;
begin
 Result := (((x) and (z)) or ((y) and (not z)));
end;
function _H(x, y, z: UINT4): UINT4;
begin
 Result := ((x) xor (y) xor (z));
end;
function _I(x, y, z: UINT4): UINT4;
begin
 Result := ((y) xor ((x) or ( not z)));
end;
function ROTATE_LEFT(x, n: UINT4): UINT4;
begin
 Result := (((x) shl (n)) or ((x) shr (32-(n))));
end;
procedure FF(var a: UINT4; b, c, d, x, s, ac: UINT4);
begin
 a := a + _F(b, c, d) + x + ac;
 a := ROTATE_LEFT (a, s);
 a := a + b;
end;
procedure GG(var a: UINT4; b, c, d, x, s, ac: UINT4);
begin
 a := a + _G(b, c, d) + x + ac;
 a := ROTATE_LEFT(a, s);
 a := a + b;
end;
procedure HH(var a: UINT4; b, c, d, x, s, ac: UINT4);
begin
 a := a + _H(b, c, d) + x + ac;
 a := ROTATE_LEFT(a, s);
 a := a + b;
end;
procedure II(var a: UINT4; b, c, d, x, s, ac: UINT4);
begin
 a := a + _I(b, c, d) + x + ac;
 a := ROTATE_LEFT(a, s);
 a := a + b;
end;
procedure MD5Encode(Output: PByteArray; Input: PUINT4Array; Len: LongWord);
var
 i, j: LongWord;
begin
 j:=0;
 i:=0;
 while j < Len do begin
 output[j] := Byte(input[i] and $ff);
 output[j+1] := Byte((input[i] shr 8) and $ff);
 output[j+2] := Byte((input[i] shr 16) and $ff);
 output[j+3] := Byte((input[i] shr 24) and $ff);
 Inc(j, 4);
 Inc(i);
 end;
end;
procedure MD5Decode(Output: PUINT4Array; Input: PByteArray; Len: LongWord);
var
 i, j: LongWord;
begin
 j:=0;
 i:=0;
 while j < Len do begin
 Output[i] := UINT4(input[j]) or (UINT4(input[j+1]) shl 8) or
  (UINT4(input[j+2]) shl 16) or ( UINT4(input[j+3]) shl 24);
 Inc(j, 4);
 Inc(i);
 end;
end;
procedure MD5_memcpy(Output: PByteArray; Input: PByteArray; Len: LongWord);
begin
 Move(Input^, Output^, Len);
end;
procedure MD5_memset(Output: PByteArray; Value: Integer; Len: LongWord);
begin
 FillChar(Output^, Len, Byte(Value));
end;
procedure MD5Transform(State: PArray4UINT4; Buffer: PArray64Byte);
var
 a, b, c, d: UINT4;
 x : array[0..15] of UINT4;
begin
 a:=State[0]; b:=State[1]; c:=State[2]; d:=State[3];
 MD5Decode(PUINT4Array(@x), PByteArray(Buffer), 64);
 FF (a, b, c, d, x[ 0], S11, $d76aa478);
 FF (d, a, b, c, x[ 1], S12, $e8c7b756);
 FF (c, d, a, b, x[ 2], S13, $242070db);
 FF (b, c, d, a, x[ 3], S14, $c1bdceee);
 FF (a, b, c, d, x[ 4], S11, $f57c0faf);
 FF (d, a, b, c, x[ 5], S12, $4787c62a);
 FF (c, d, a, b, x[ 6], S13, $a8304613);
 FF (b, c, d, a, x[ 7], S14, $fd469501);
 FF (a, b, c, d, x[ 8], S11, $698098d8);
 FF (d, a, b, c, x[ 9], S12, $8b44f7af);
 FF (c, d, a, b, x[10], S13, $ffff5bb1);
 FF (b, c, d, a, x[11], S14, $895cd7be);
 FF (a, b, c, d, x[12], S11, $6b901122);
 FF (d, a, b, c, x[13], S12, $fd987193);
 FF (c, d, a, b, x[14], S13, $a679438e);
 FF (b, c, d, a, x[15], S14, $49b40821);
 GG (a, b, c, d, x[ 1], S21, $f61e2562);
 GG (d, a, b, c, x[ 6], S22, $c040b340);
 GG (c, d, a, b, x[11], S23, $265e5a51);
 GG (b, c, d, a, x[ 0], S24, $e9b6c7aa);
 GG (a, b, c, d, x[ 5], S21, $d62f105d);
 GG (d, a, b, c, x[10], S22, $2441453);
 GG (c, d, a, b, x[15], S23, $d8a1e681);
 GG (b, c, d, a, x[ 4], S24, $e7d3fbc8);
 GG (a, b, c, d, x[ 9], S21, $21e1cde6);
 GG (d, a, b, c, x[14], S22, $c33707d6);
 GG (c, d, a, b, x[ 3], S23, $f4d50d87);
 GG (b, c, d, a, x[ 8], S24, $455a14ed);
 GG (a, b, c, d, x[13], S21, $a9e3e905);
 GG (d, a, b, c, x[ 2], S22, $fcefa3f8);
 GG (c, d, a, b, x[ 7], S23, $676f02d9);
 GG (b, c, d, a, x[12], S24, $8d2a4c8a);
 HH (a, b, c, d, x[ 5], S31, $fffa3942);
 HH (d, a, b, c, x[ 8], S32, $8771f681);
 HH (c, d, a, b, x[11], S33, $6d9d6122);
 HH (b, c, d, a, x[14], S34, $fde5380c);
 HH (a, b, c, d, x[ 1], S31, $a4beea44);
 HH (d, a, b, c, x[ 4], S32, $4bdecfa9);
 HH (c, d, a, b, x[ 7], S33, $f6bb4b60);
 HH (b, c, d, a, x[10], S34, $bebfbc70);
 HH (a, b, c, d, x[13], S31, $289b7ec6);
 HH (d, a, b, c, x[ 0], S32, $eaa127fa);
 HH (c, d, a, b, x[ 3], S33, $d4ef3085);
 HH (b, c, d, a, x[ 6], S34, $4881d05);
 HH (a, b, c, d, x[ 9], S31, $d9d4d039);
 HH (d, a, b, c, x[12], S32, $e6db99e5);
 HH (c, d, a, b, x[15], S33, $1fa27cf8);
 HH (b, c, d, a, x[ 2], S34, $c4ac5665);
 II (a, b, c, d, x[ 0], S41, $f4292244);
 II (d, a, b, c, x[ 7], S42, $432aff97);
 II (c, d, a, b, x[14], S43, $ab9423a7);
 II (b, c, d, a, x[ 5], S44, $fc93a039);
 II (a, b, c, d, x[12], S41, $655b59c3);
 II (d, a, b, c, x[ 3], S42, $8f0ccc92);
 II (c, d, a, b, x[10], S43, $ffeff47d);
 II (b, c, d, a, x[ 1], S44, $85845dd1);
 II (a, b, c, d, x[ 8], S41, $6fa87e4f);
 II (d, a, b, c, x[15], S42, $fe2ce6e0);
 II (c, d, a, b, x[ 6], S43, $a3014314);
 II (b, c, d, a, x[13], S44, $4e0811a1);
 II (a, b, c, d, x[ 4], S41, $f7537e82);
 II (d, a, b, c, x[11], S42, $bd3af235);
 II (c, d, a, b, x[ 2], S43, $2ad7d2bb);
 II (b, c, d, a, x[ 9], S44, $eb86d391);
 Inc(State[0], a);
 Inc(State[1], b);
 Inc(State[2], c);
 Inc(State[3], d);
 MD5_memset (PByteArray(@x), 0, SizeOf (x));
end;

procedure MD5Init(var Context: TMD5Context);
begin
 FillChar(Context, SizeOf(Context), 0);
 Context.state[0] := $67452301;
 Context.state[1] := $efcdab89;
 Context.state[2] := $98badcfe;
 Context.state[3] := $10325476;
end;
procedure MD5Update(var Context: TMD5Context; Input: PByteArray; InputLen: LongWord);
var
 i, index, partLen: LongWord;
begin
 index := LongWord( (context.count[0] shr 3) and $3F);
 Inc(Context.count[0], UINT4(InputLen) shl 3);
 if Context.count[0] < UINT4(InputLen) shl 3 then Inc(Context.count[1]);
 Inc(Context.count[1], UINT4(InputLen) shr 29);
 partLen := 64 - index;
 if inputLen >= partLen then begin
 MD5_memcpy(PByteArray(@Context.buffer[index]), Input, PartLen);
 MD5Transform(@Context.state, @Context.buffer);
 i := partLen;
 while i + 63 < inputLen do begin
  MD5Transform(@Context.state, PArray64Byte(@Input[i]));
  Inc(i, 64);
 end;
 index := 0;
 end else i:=0;
 MD5_memcpy(PByteArray(@Context.buffer[index]), PByteArray(@Input[i]), inputLen - i);
end;

procedure MD5Final(var Digest: TMD5Digest; var Context: TMD5Context);
var
 bits: array [0..7] of Byte;
 index, padLen: LongWord;
begin
 MD5Encode(PByteArray(@bits), PUINT4Array(@Context.count), 8);
 index := LongWord( (Context.count[0] shr 3) and $3F);
 if index < 56 then padLen := 56 - index else padLen := 120 - index;
 MD5Update(Context, PByteArray(@PADDING), padLen);
 MD5Update(Context, PByteArray(@Bits), 8);
 MD5Encode(PByteArray(@Digest), PUINT4Array(@Context.state), 16);
 MD5_memset(PByteArray(@Context), 0, SizeOf(Context));
end;
function MD5DigestToStr(const Digest: TMD5Digest): string;
var
 i: Integer;
begin
 Result:='';
 for i:=0 to 15 do Result:=Result+IntToHex(Digest.v[i], 2);
end;
function MD5String(const S: string): TMD5Digest;
begin
 Result:=MD5Buffer(PChar(S)^, Length(S));
end;
function MD5File(const FileName: string): TMD5Digest;
var
 F: TFileStream;
begin
 F:=TFileStream.Create(FileName, fmOpenRead);
 try
 Result:=MD5Stream(F);
 finally
 F.Free;
 end;
end;
function MD5Stream(const Stream: TStream): TMD5Digest;
var
 Context: TMD5Context;
 Buffer: array[0..4095] of Byte;
 Size: Integer;
 ReadBytes : Integer;
 TotalBytes : Integer;
 SavePos: Integer;
begin
 MD5Init(Context);
 Size:=Stream.Size;
 SavePos:=Stream.Position;
 TotalBytes:=0;
 try
 Stream.Seek(0, soFromBeginning);
 repeat
  ReadBytes:=Stream.Read(Buffer, SizeOf(Buffer));
  Inc(TotalBytes, ReadBytes);
  MD5Update(Context, @Buffer, ReadBytes);
 until (ReadBytes = 0) or (TotalBytes = Size);
 finally
 Stream.Seek(SavePos, soFromBeginning);
 end;
 MD5Final(Result, Context);
end;
function MD5Buffer(const Buffer; Size: Integer): TMD5Digest;
var
 Context: TMD5Context;
begin
 MD5Init(Context);
 MD5Update(Context, PByteArray(@Buffer), Size);
 MD5Final(Result, Context);
end;
function MD5DigestCompare(const Digest1, Digest2: TMD5Digest): Boolean;
begin
 Result:=False;
 if Digest1.A <> Digest2.A then Exit;
 if Digest1.B <> Digest2.B then Exit;
 if Digest1.C <> Digest2.C then Exit;
 if Digest1.D <> Digest2.D then Exit;
 Result:=True;
end;

end.

Автор: Nikonov A.A.

unit psnMD5;

interface

uses Windows, SysUtils, Classes;

type

  PMD5Digest = ^TMD5Digest;

  TMD5Digest = record

  case Integer of

  0: (A, B, C, D: LongInt);

  1: (v: array[0..15] of Byte);

  end;

function MD5String(const S: string): TMD5Digest;

function MD5File(const FileName: string): TMD5Digest;

function MD5Stream(const Stream: TStream): TMD5Digest;

function MD5Buffer(const Buffer;

 Size: Integer): TMD5Digest;

function MD5DigestToStr(const Digest:

 TMD5Digest): string;

function MD5DigestCompare(const Digest1,

 Digest2: TMD5Digest): Boolean;

 implementation

type

  UINT4 = LongWord;

  PArray4UINT4 = ^TArray4UINT4;

  TArray4UINT4 = array[0..3] of UINT4;

  PArray2UINT4 = ^TArray2UINT4;

  TArray2UINT4 = array[0..1] of UINT4;

  PArray16Byte = ^TArray16Byte;

  TArray16Byte = array[0..15] of Byte;

  PArray64Byte = ^TArray64Byte;

  TArray64Byte = array[0..63] of Byte;

  PByteArray = ^TByteArray;

  TByteArray = array[0..0] of Byte;

  PUINT4Array = ^TUINT4Array;

  TUINT4Array = array[0..0] of UINT4;

  PMD5Context = ^TMD5Context;

  TMD5Context = record

  state: TArray4UINT4;

  count: TArray2UINT4;

  buffer: TArray64Byte;

  end;

  const

  S11 = 7;

  S12 = 12;

  S13 = 17;

  S14 = 22;

  S21 = 5;

  S22 = 9;

  S23 = 14;

  S24 = 20;

  S31 = 4;

  S32 = 11;

  S33 = 16;

  S34 = 23;

  S41 = 6;

  S42 = 10;

  S43 = 15;

  S44 = 21;

  var

  Padding: TArray64Byte =

  ($80, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,

  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,

  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);



function _F(x, y, z:

 UINT4): UINT4;

begin

  Result := (((x) and (y)) or ((not x) and (z)));

end;



function _G(x, y, z:

 UINT4): UINT4;

begin

  Result := (((x) and (z)) or ((y)

  and (not z)));

end;



function _H(x, y, z:

 UINT4): UINT4;

begin

  Result := ((x)xor (y)

  xor (z));

end;



function _I(x, y, z:

 UINT4): UINT4;

begin

  Result := ((y)xor ((x)

  or (not z)));

end;



function ROTATE_LEFT(x, n: UINT4): UINT4;

begin

  Result := (((x)shl (n))

  or ((x)shr (32 - (n))));

end;



procedure FF(var a: UINT4; b,

 c, d, x, s, ac: UINT4);

begin

  a := a + _F(b, c, d)

  + x + ac;

  a := ROTATE_LEFT(a, s);

  a := a + b;

end;



procedure GG(var a: UINT4; b,

 c, d, x, s, ac: UINT4);

begin

  a := a + _G(b, c, d)

  + x + ac;

  a := ROTATE_LEFT(a, s);

  a := a + b;

end;



procedure HH(var a: UINT4; b,

 c, d, x, s, ac: UINT4);

begin

  a := a + _H(b, c, d)

  + x + ac;

  a := ROTATE_LEFT(a, s);

  a := a + b;

end;



procedure II(var a: UINT4; b,

 c, d, x, s, ac: UINT4);

begin

  a := a + _I(b, c, d)

  + x + ac;

  a := ROTATE_LEFT(a, s);

  a := a + b;

end;



procedure MD5Encode(Output: PByteArray; Input: PUINT4Array; Len: LongWord);

var

  i, j: LongWord;

begin

  j := 0;

  i := 0;

  while j '<';

 Len do begin

  output[j] := Byte(input[i] and $FF);

  output[j + 1] := Byte((input[i]shr 8)

  and $FF);

  output[j + 2] := Byte((input[i]shr 16)

  and $FF);

  output[j + 3] := Byte((input[i]shr 24)

  and $FF);

  Inc(j, 4);

  Inc(i);

  end;

end;



procedure MD5Decode(Output: PUINT4Array; Input: PByteArray; Len: LongWord);

var

  i, j: LongWord;

begin

  j := 0;

  i := 0;

  while j '<';

 Len do

 begin

  Output[i] := UINT4(input[j])

  or (UINT4(input[j + 1])shl 8)

  or

  (UINT4(input[j + 2])shl 16)

  or (UINT4(input[j + 3])shl 24);

  Inc(j, 4);

  Inc(i);

  end;

 end;



procedure MD5_memcpy(Output:

 PByteArray; Input: PByteArray; Len: LongWord);

begin

  Move(Input^, Output^, Len);

end;



procedure MD5_memset(Output:

 PByteArray; Value: Integer; Len: LongWord);

begin

  FillChar(Output^, Len, Byte(Value));

end;



procedure MD5Transform(State: PArray4UINT4; Buffer: PArray64Byte);

var

  a, b, c, d: UINT4;

 x: array[0..15] of UINT4;

begin

  a := State[0];

 b := State[1];

 c := State[2];

 d := State[3];

  MD5Decode(PUINT4Array(@x), PByteArray(Buffer), 64);

  FF(a, b, c, d,

  x[0], S11, $D76AA478);

  FF(d, a, b,

  c, x[1], S12, $E8C7B756);

  FF(c, d, a, b,

  x[2], S13, $242070DB);

  FF(b, c, d,

  a, x[3], S14, $C1BDCEEE);

  FF(a, b, c, d,

  x[4], S11, $F57C0FAF);

  FF(d, a, b,

  c, x[5], S12, $4787C62A);

  FF(c, d, a, b,

  x[6], S13, $A8304613);

  FF(b, c, d,

  a, x[7], S14, $FD469501);

  FF(a, b, c, d,

  x[8], S11, $698098D8);

  FF(d, a, b,

  c, x[9], S12, $8B44F7AF);

  FF(c, d, a, b,

  x[10], S13, $FFFF5BB1);

  FF(b, c, d,

  a, x[11], S14, $895CD7BE);

  FF(a, b, c, d,

  x[12], S11, $6B901122);

  FF(d, a, b,

  c, x[13], S12, $FD987193);

  FF(c, d, a, b,

  x[14], S13, $A679438E);

  FF(b, c, d,

  a, x[15], S14, $49B40821);

  GG(a, b, c, d,

  x[1], S21, $F61E2562);

  GG(d, a, b,

  c, x[6], S22, $C040B340);

  GG(c, d, a, b,

  x[11], S23, $265E5A51);

  GG(b, c, d,

  a, x[0], S24, $E9B6C7AA);

  GG(a, b, c, d,

  x[5], S21, $D62F105D);

  GG(d, a, b,

  c, x[10], S22, $2441453);

  GG(c, d, a, b,

  x[15], S23, $D8A1E681);

  GG(b, c, d,

  a, x[4], S24, $E7D3FBC8);

  GG(a, b, c, d,

  x[9], S21, $21E1CDE6);

  GG(d, a, b,

  c, x[14], S22, $C33707D6);

  GG(c, d, a, b,

  x[3], S23, $F4D50D87);

  GG(b, c, d,

  a, x[8], S24, $455A14ED);

  GG(a, b, c, d,

  x[13], S21, $A9E3E905);

  GG(d, a, b,

  c, x[2], S22, $FCEFA3F8);

  GG(c, d, a, b,

  x[7], S23, $676F02D9);

  GG(b, c, d,

  a, x[12], S24, $8D2A4C8A);

  HH(a, b, c, d,

  x[5], S31, $FFFA3942);

  HH(d, a, b,

  c, x[8], S32, $8771F681);

  HH(c, d, a, b,

  x[11], S33, $6D9D6122);

  HH(b, c, d,

  a, x[14], S34, $FDE5380C);

  HH(a, b, c, d,

  x[1], S31, $A4BEEA44);

  HH(d, a, b,

  c, x[4], S32, $4BDECFA9);

  HH(c, d, a, b,

  x[7], S33, $F6BB4B60);

  HH(b, c, d,

  a, x[10], S34, $BEBFBC70);

  HH(a, b, c, d,

  x[13], S31, $289B7EC6);

  HH(d, a, b,

  c, x[0], S32, $EAA127FA);

  HH(c, d, a, b,

  x[3], S33, $D4EF3085);

  HH(b, c, d,

  a, x[6], S34, $4881d05);

  HH(a, b, c, d,

  x[9], S31, $D9D4D039);

  HH(d, a, b,

  c, x[12], S32, $E6DB99E5);

  HH(c, d, a, b,

  x[15], S33, $1FA27CF8);

  HH(b, c, d,

  a, x[2], S34, $C4AC5665);

  II(a, b, c, d,

  x[0], S41, $F4292244);

  II(d, a, b,

  c, x[7], S42, $432AFF97);

  II(c, d, a, b,

  x[14], S43, $AB9423A7);

  II(b, c, d,

  a, x[5], S44, $FC93A039);

  II(a, b, c, d,

  x[12], S41, $655B59C3);

  II(d, a, b,

  c, x[3], S42, $8F0CCC92);

  II(c, d, a, b,

  x[10], S43, $FFEFF47D);

  II(b, c, d,

  a, x[1], S44, $85845DD1);

  II(a, b, c, d,

  x[8], S41, $6FA87E4F);

  II(d, a, b,

  c, x[15], S42, $FE2CE6E0);

  II(c, d, a, b,

  x[6], S43, $A3014314);

  II(b, c, d,

  a, x[13], S44, $4E0811A1);

  II(a, b, c, d,

  x[4], S41, $F7537E82);

  II(d, a, b,

  c, x[11], S42, $BD3AF235);

  II(c, d, a, b,

  x[2], S43, $2AD7D2BB);

  II(b, c, d,

  a, x[9], S44, $EB86D391);

  Inc(State[0], a);

  Inc(State[1], b);

  Inc(State[2], c);

  Inc(State[3], d);

  MD5_memset (PByteArray(@x), 0, SizeOf(x));

end;



procedure MD5Init(var Context: TMD5Context);

begin

  FillChar(Context, SizeOf(Context), 0);

  Context.state[0] := $67452301;

  Context.state[1] := $EFCDAB89;

  Context.state[2] := $98BADCFE;

  Context.state[3] := $10325476;

end;



procedure MD5Update(var Context:

 TMD5Context; Input: PByteArray; InputLen: LongWord);

var

  i, index, partLen: LongWord;

begin

  index := LongWord((context.count[0]shr 3)

  and $3F);

  Inc(Context.count[0], UINT4(InputLen)shl 3);

  if Context.count[0]'<';

 UINT4(InputLen)shl 3

  then Inc(Context.count[1]);

  Inc(Context.count[1], UINT4(InputLen)shr 29);

  partLen := 64 - index;

  if inputLen '>';

 = partLen then

 begin

  MD5_memcpy(PByteArray(@Context.buffer[index]),

  Input, PartLen);

  MD5Transform(@Context.state, @Context.buffer);

  i := partLen;

  while i + 63 '<';

  inputLen do

  begin

  MD5Transform(@Context.state,

  PArray64Byte(@Input[i]));

  Inc(i, 64);

  end;

  index := 0;

  end

 else

  i := 0;

  MD5_memcpy(PByteArray(@Context.buffer[index]),

  PByteArray(@Input[i]), inputLen - i);

end;



procedure MD5Final(var Digest: TMD5Digest; var Context:

 TMD5Context);

var

  bits: array[0..7] of Byte;

 index, padLen: LongWord;

begin

  MD5Encode(PByteArray(@bits), PUINT4Array(@Context.count),

  8);

  index := LongWord((Context.count[0]shr 3)

  and $3F);

  if index '<';

 56 then padLen := 56 - index

else

 padLen := 120 - index;

  MD5Update(Context, PByteArray(@PADDING), padLen);

  MD5Update(Context, PByteArray(@Bits), 8);

  MD5Encode(PByteArray(@Digest), PUINT4Array(@Context.state),

  16);

  MD5_memset(PByteArray(@Context), 0, SizeOf(Context));

end;



function MD5DigestToStr(const Digest:

 TMD5Digest): string;

var

  i: Integer;

begin

  Result := '';

  for i := 0 to 15 do Result := Result + IntToHex(Digest.v[i],

  2);

end;



function MD5String(const S: string): TMD5Digest;

begin

  Result := MD5Buffer(PChar(S)^, Length(S));

end;



function MD5File(const FileName: string): TMD5Digest;

var

  F: TFileStream;

begin

  F := TFileStream.Create(FileName, fmOpenRead);

  try

  Result := MD5Stream(F);

  finally

  F.Free;

  end;

end;



function MD5Stream(const Stream: TStream): TMD5Digest;

var

  Context: TMD5Context;

 Buffer: array[0..4095] of Byte;

 Size: Integer;

 ReadBytes: Integer;

 TotalBytes: Integer;

 SavePos: Integer;

begin

  MD5Init(Context);

  Size := Stream.Size;

  SavePos := Stream.Position;

  TotalBytes := 0;

  try

  Stream.Seek(0, soFromBeginning);

  repeat

  ReadBytes := Stream.Read(Buffer, SizeOf(Buffer));

  Inc(TotalBytes, ReadBytes);

  MD5Update(Context, @Buffer, ReadBytes);

  until (ReadBytes = 0) or (TotalBytes = Size);

  finally

  Stream.Seek(SavePos, soFromBeginning);

  end;

  MD5Final(Result, Context);

end;



function MD5Buffer(const Buffer;

 Size: Integer): TMD5Digest;

var

  Context: TMD5Context;

begin

  MD5Init(Context);

  MD5Update(Context, PByteArray(@Buffer), Size);

  MD5Final(Result, Context);

end;



function MD5DigestCompare(const Digest1,

 Digest2: TMD5Digest): Boolean;

begin

  Result := False;

  if Digest1.A '<';

 '>';

 Digest2.A then Exit;

  if Digest1.B '<';

 '>';

 Digest2.B then Exit;

  if Digest1.C '<';

 '>';

 Digest2.C then Exit;

  if Digest1.D '<';

 '>';

 Digest2.D then Exit;

  Result := True;

end;

end.

/////////////////////////////////////

// Данные в модуль можно загнать так

procedure TForm1.Button1Click(Sender: TObject);

var  

 InFile: TFileStream;

begin  

 InFile := TFileStream.Create(fname, fmShareDenyNone);

 Caption := MD5DigestToStr(MD5Stream(INFILE));

end;


DelphiWorld 6.0

Отправить комментарий

Проверка
Антиспам проверка
Image CAPTCHA
...