Зашифровать в MD5

{******************************************************************}
{ MD5 Hashsum Evaluation Unit For Borland Delphi }
{ }
{ Copyright © 2002 by Dimka Maslov }
{ E-mail: [email]mainbox@endimus.com[/email], }
{ Web-site: [url]http://www.endimus.com[/url] }
{ }
{ Derived from the RSA Data Security, Inc. }
{ MD5 Message-Digest Algorithm described in RFC 1321 }
{ [url]http://www.faqs.org/rfcs/rfc1321.html[/url] }
{******************************************************************}
 
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.

unit Umd5;
interface
uses Windows, SysUtils;
type
THash = DWord;
function md5 (buf: string): string;
implementation
var HEX: array[Word] of string;
function LRot32 (a, b: LongWord): LongWord;
asm
mov ecx, edx
rol eax, cl
end;
function md5 (buf: string): string;
type
pint = ^Integer;
tdata = array [0..15] of DWORD;
pdata = ^tdata;
tbyte = array [0..15] of byte;
pbyte = ^tbyte;
var
i, Len: Integer;
data: pdata;
CurrentHash: array[0..3] of DWord;
P: array[0..7] of Word absolute CurrentHash;
A, B, C, D: DWord;
begin
Len := Length (buf);
SetLength (buf, 64);
buf[Len+1] := #$80;
FillChar (buf[Len+2], 63 - Len, 0);
pint (@buf[57])^ := Len * 8;
CurrentHash[0] := $67452301;
CurrentHash[1] := $efcdab89;
CurrentHash[2] := $98badcfe;
CurrentHash[3] := $10325476;
A := CurrentHash[0];
B := CurrentHash[1];
C := CurrentHash[2];
D := CurrentHash[3];
data := addr (buf[1]);
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);
Result := StrLower(PChar(HEX[P[0]]));
for i := 1 to 7 do
Result := Concat (Result, StrLower(PChar(HEX[P[i]])));
end;
var DEC, Tmp: Integer;
LH: string;
initialization
for DEC := 0 to $ffff do
begin
Tmp := DEC and $ff;
LH := IntToHex (Tmp, 2);
Tmp := DEC shr 8;
HEX[DEC] := Concat (LH, IntToHex (Tmp, 2));
end;
end.

unit MD5Hash;
 
interface 
 
uses Windows, SysUtils; 
 
function md5 (S: string): string; 
 
implementation 
 
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; {proc Burn} 
 
procedure Init; 
begin 
  Burn; 
  CurrentHash[0] := $67452301; 
  CurrentHash[1] := $efcdab89; 
  CurrentHash[2] := $98badcfe; 
  CurrentHash[3] := $10325476; 
end; {proc Init} 
 
function LRot32 (a, b: LongWord): LongWord; 
begin 
  Result:= (a shl b) or (a shr (32 - b)); 
end; {func LRot32} 
 
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; {proc Compress} 
 
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; {if} 
  end; {while} 
end; {proc Update} 
 
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; {proc Final} 
 
function md5 (S: string): string; 
begin 
  Init; 
  Update (s[1], Length (s)); 
  Final (a); 
  Result := ''; 
  for i := 0 to 15 do 
    Result := Concat (Result, IntToHex (a[i], 2)); 
  Burn; 
  Result := Result; 
end; {func md5} 
 
end.

var
  bits: array[0..7] of Byte;
  index, padLen: LongWord;
begin
  MD5Encode(PByteArray(@bits),...