unit HashUnit;

interface
uses
  SysUtils, classes;

type
//-----------------------------------------------------------------------------
// MD5
//-----------------------------------------------------------------------------

  PMD5Digest = ^TMD5Digest;
  TMD5Digest = packed 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 StrToMD5Digest(const str: String): TMD5Digest;
function MD5DigestCompare(const Digest1, Digest2: TMD5Digest): Boolean;

//-----------------------------------------------------------------------------
// CRC
//-----------------------------------------------------------------------------

function Crc16_P(X: PByteArray; N: Integer; Crc: Word = 0): Word;
function Crc16(const X: array of Byte; N: Integer; Crc: Word = 0): Word;
function Crc16_A(const X: array of Byte; Crc: Word = 0): Word;

function CheckCrc16_P(X: PByteArray; N: Integer; Crc: Word): Integer;
function CheckCrc16(var X: array of Byte; N: Integer; Crc: Word): Integer;
function CheckCrc16_A(var X: array of Byte; Crc: Word): Integer;

function Crc32_P(X: PByteArray; N: Integer; Crc: Cardinal = 0): Cardinal;
function Crc32(const X: array of Byte; N: Integer; Crc: Cardinal = 0): Cardinal;
function Crc32_A(const X: array of Byte; Crc: Cardinal = 0): Cardinal;

function CheckCrc32_P(X: PByteArray; N: Integer; Crc: Cardinal): Integer;
function CheckCrc32(var X: array of Byte; N: Integer; Crc: Cardinal): Integer;
function CheckCrc32_A(var X: array of Byte; Crc: Cardinal): Integer;

procedure InitCrc32 (Polynom, Start: Cardinal);
procedure InitCrc16 (Polynom, Start: Word);

implementation

//-----------------------------------------------------------------------------
// crc
//-----------------------------------------------------------------------------

// CRC 16

const

//  CRC16Polynom = $1021;
  Crc16Table: array [0..255] of Word =
  (
    $0000, $1021, $2042, $3063, $4084, $50A5, $60C6, $70E7,
    $8108, $9129, $A14A, $B16B, $C18C, $D1AD, $E1CE, $F1EF,
    $1231, $0210, $3273, $2252, $52B5, $4294, $72F7, $62D6,
    $9339, $8318, $B37B, $A35A, $D3BD, $C39C, $F3FF, $E3DE,
    $2462, $3443, $0420, $1401, $64E6, $74C7, $44A4, $5485,
    $A56A, $B54B, $8528, $9509, $E5EE, $F5CF, $C5AC, $D58D,
    $3653, $2672, $1611, $0630, $76D7, $66F6, $5695, $46B4,
    $B75B, $A77A, $9719, $8738, $F7DF, $E7FE, $D79D, $C7BC,
    $48C4, $58E5, $6886, $78A7, $0840, $1861, $2802, $3823,
    $C9CC, $D9ED, $E98E, $F9AF, $8948, $9969, $A90A, $B92B,
    $5AF5, $4AD4, $7AB7, $6A96, $1A71, $0A50, $3A33, $2A12,
    $DBFD, $CBDC, $FBBF, $EB9E, $9B79, $8B58, $BB3B, $AB1A,
    $6CA6, $7C87, $4CE4, $5CC5, $2C22, $3C03, $0C60, $1C41,
    $EDAE, $FD8F, $CDEC, $DDCD, $AD2A, $BD0B, $8D68, $9D49,
    $7E97, $6EB6, $5ED5, $4EF4, $3E13, $2E32, $1E51, $0E70,
    $FF9F, $EFBE, $DFDD, $CFFC, $BF1B, $AF3A, $9F59, $8F78,
    $9188, $81A9, $B1CA, $A1EB, $D10C, $C12D, $F14E, $E16F,
    $1080, $00A1, $30C2, $20E3, $5004, $4025, $7046, $6067,
    $83B9, $9398, $A3FB, $B3DA, $C33D, $D31C, $E37F, $F35E,
    $02B1, $1290, $22F3, $32D2, $4235, $5214, $6277, $7256,
    $B5EA, $A5CB, $95A8, $8589, $F56E, $E54F, $D52C, $C50D,
    $34E2, $24C3, $14A0, $0481, $7466, $6447, $5424, $4405,
    $A7DB, $B7FA, $8799, $97B8, $E75F, $F77E, $C71D, $D73C,
    $26D3, $36F2, $0691, $16B0, $6657, $7676, $4615, $5634,
    $D94C, $C96D, $F90E, $E92F, $99C8, $89E9, $B98A, $A9AB,
    $5844, $4865, $7806, $6827, $18C0, $08E1, $3882, $28A3,
    $CB7D, $DB5C, $EB3F, $FB1E, $8BF9, $9BD8, $ABBB, $BB9A,
    $4A75, $5A54, $6A37, $7A16, $0AF1, $1AD0, $2AB3, $3A92,
    $FD2E, $ED0F, $DD6C, $CD4D, $BDAA, $AD8B, $9DE8, $8DC9,
    $7C26, $6C07, $5C64, $4C45, $3CA2, $2C83, $1CE0, $0CC1,
    $EF1F, $FF3E, $CF5D, $DF7C, $AF9B, $BFBA, $8FD9, $9FF8,
    $6E17, $7E36, $4E55, $5E74, $2E93, $3EB2, $0ED1, $1EF0
   );

  Crc16Bits = 16;
  Crc16Start : Cardinal = $FFFF;
  Crc16Bytes = 2;
  Crc16HighBit = $8000;
  NotCrc16HighBit = $7FFF;

//--------------------------------------------------------------------------------------------------

function Crc16Corr(Crc: Word; N: Integer): Integer;
var
  I: Integer;
//  CrcX : Cardinal;
begin
  // calculate Syndrome
//  CrcX := CrC;
  for I := 1 to Crc16Bytes do
//  a 16 bit value shr 8 is a Byte, explictit type conversion to Byte adds an ASM instruction
      Crc := Crc16Table[Crc shr (CRC16Bits-8)] xor Word(Crc shl 8);
  I := -1;
  repeat
    Inc(I);
    if (Crc and 1) <> 0 then
      Crc := ((Crc xor Crc16Table[1]) shr 1) or Crc16HighBit
//      Crc16Table[1] = Crc16Polynom
    else
      Crc := (Crc shr 1) and NotCrc16HighBit;
  until (Crc = Crc16HighBit) or (I = (N + Crc16Bytes) * 8);
  if Crc <> Crc16HighBit then
    Result := -1000 // not correctable
  else
      // I = No. of single faulty bit
      // (high bit first,
      // starting from lowest with CRC bits)
    Result := I - Crc16Bits;
      // Result <  0 faulty CRC-bit
      // Result >= 0 No. of faulty data bit
end;

//--------------------------------------------------------------------------------------------------

function Crc16_P(X: PByteArray; N: Integer; Crc: Word = 0): Word;
var
  I: Integer;
begin
  Result := Crc16Start;
  for I := 0 to N - 1 do // The CRC Bytes are located at the end of the information
  begin
//  a 16 bit value shr 8 is a Byte, explictit type conversion to Byte adds an ASM instruction
//    Result := Crc16Table[Result shr (CRC16Bits-8)] xor Word((Result shl 8)) xor X[I];
    Result := Crc16Table[lo(Result) xor X[I]] xor (hi(Result));
  end;
{  for i := 0 to Crc16Bytes - 1 do
  begin
//  a 16 bit value shr 8 is a Byte, explictit type conversion to Byte adds an ASM instruction
    Result := Crc16Table[Result shr (CRC16Bits-8)] xor Word((Result shl 8)) xor (Crc shr (CRC16Bits-8));
    Crc := Word(Crc shl 8);
  end; {}
end;

//--------------------------------------------------------------------------------------------------

function CheckCrc16_P(X: PByteArray; N: Integer; Crc: Word): Integer;
// checks and corrects a single bit in up to 2^15-16 Bit -> 2^12-2 = 4094 Byte
var
  I, J: Integer;
  C: Byte;
begin
  Crc := Crc16_P(X, N, Crc);
  if Crc = 0 then
    Result := 0 // No CRC-error
  else
  begin
    J := Crc16Corr(Crc, N);
    if J < -(Crc16Bytes * 8 + 1) then
      Result := -1 // non-correctable error (more than one wrong bit)
    else
    begin
      if J < 0 then
        Result := 1 // one faulty Bit in CRC itself
      else
      begin // Bit j is faulty
        I := J and 7; // I <= 7 (faulty Bit in Byte)
        C := 1 shl I; // C <= 128
        I := J shr 3; // I: Index of faulty Byte
        X[N - 1 - I] := X[N - 1 - I] xor C; // correct faulty bit
        Result := 1; // Correctable error
      end;
    end;
  end;
end;

//--------------------------------------------------------------------------------------------------

function Crc16(const X: array of Byte; N: Integer; Crc: Word = 0): Word;
begin
   Result := Crc16_P(@X, N, Crc);
end;

//--------------------------------------------------------------------------------------------------

function CheckCrc16(var X: array of Byte; N: Integer; Crc: Word): Integer;
begin
  Result := CheckCRC16_P(@X, N, CRC);
end;

//--------------------------------------------------------------------------------------------------

function Crc16_A(const X: array of Byte; Crc: Word = 0): Word;
begin
   Result := Crc16_P(@X, Length(X), Crc);
end;

//--------------------------------------------------------------------------------------------------

function CheckCrc16_A(var X: array of Byte; Crc: Word): Integer;
begin
  Result := CheckCrc16_P(@X, Length(X), Crc);
end;

//--------------------------------------------------------------------------------------------------

// The CRC Table can be generated like this:
// const crc16start0 = 0;  !!

function crc16_bitwise(x: PByteArray; n: integer; crc: Word; Polynom: Word) : Word;
var
  i, j: integer;
  sr, srhighbit: Word;
  b: Byte;

const
  crc16start0 = 0;   //Generating the table

begin
   sr := crc16start0;
   srhighbit := 0;
   for i := 0 to n-1+crc16bytes do
   begin
      if i>=n then
      begin
         b := crc shr (crc16bits-8);
         crc := crc shl 8;
        end
        else
        begin
         b := x[i]
      end;
      for j := 1 to 8 do
      begin
         if (srhighbit <> 0) then
         begin
           sr := sr xor polynom;
         end;
         srhighbit := sr and crc16highbit ;
         sr := (Word (sr shl 1)) or ((b shr 7) and 1);
         b := byte (b shl 1);
      end
   end;
   if (srhighbit <> 0) then
   begin
      sr := sr xor polynom;
   end;
   crc16_bitwise := sr;
end;

//--------------------------------------------------------------------------------------------------

procedure InitCrc16 (Polynom, Start: Word);
var
  x: array [0..0] of byte;
  i: integer;
begin
   for i := 0 to 255 do
   begin
     x[0] := i;
     crc16table[i] := crc16_bitwise (@x, 1, 0, Polynom); { nur mit crcstart=0 !!!!}
   end;
   Crc16Start := Start;
end;

//--------------------------------------------------------------------------------------------------

// CRC 32

const
//  CRC32Polynom = $04C11DB7;

  Crc32Table: array [0..255] of Cardinal = (
    $00000000, $04C11DB7, $09823B6E, $0D4326D9, $130476DC, $17C56B6B, $1A864DB2, $1E475005,
    $2608EDB8, $22C9F00F, $2F8AD6D6, $2B4BCB61, $350C9B64, $31CD86D3, $3C8EA00A, $384FBDBD,
    $4C11DB70, $48D0C6C7, $4593E01E, $4152FDA9, $5F15ADAC, $5BD4B01B, $569796C2, $52568B75,
    $6A1936C8, $6ED82B7F, $639B0DA6, $675A1011, $791D4014, $7DDC5DA3, $709F7B7A, $745E66CD,
    $9823B6E0, $9CE2AB57, $91A18D8E, $95609039, $8B27C03C, $8FE6DD8B, $82A5FB52, $8664E6E5,
    $BE2B5B58, $BAEA46EF, $B7A96036, $B3687D81, $AD2F2D84, $A9EE3033, $A4AD16EA, $A06C0B5D,
    $D4326D90, $D0F37027, $DDB056FE, $D9714B49, $C7361B4C, $C3F706FB, $CEB42022, $CA753D95,
    $F23A8028, $F6FB9D9F, $FBB8BB46, $FF79A6F1, $E13EF6F4, $E5FFEB43, $E8BCCD9A, $EC7DD02D,
    $34867077, $30476DC0, $3D044B19, $39C556AE, $278206AB, $23431B1C, $2E003DC5, $2AC12072,
    $128E9DCF, $164F8078, $1B0CA6A1, $1FCDBB16, $018AEB13, $054BF6A4, $0808D07D, $0CC9CDCA,
    $7897AB07, $7C56B6B0, $71159069, $75D48DDE, $6B93DDDB, $6F52C06C, $6211E6B5, $66D0FB02,
    $5E9F46BF, $5A5E5B08, $571D7DD1, $53DC6066, $4D9B3063, $495A2DD4, $44190B0D, $40D816BA,
    $ACA5C697, $A864DB20, $A527FDF9, $A1E6E04E, $BFA1B04B, $BB60ADFC, $B6238B25, $B2E29692,
    $8AAD2B2F, $8E6C3698, $832F1041, $87EE0DF6, $99A95DF3, $9D684044, $902B669D, $94EA7B2A,
    $E0B41DE7, $E4750050, $E9362689, $EDF73B3E, $F3B06B3B, $F771768C, $FA325055, $FEF34DE2,
    $C6BCF05F, $C27DEDE8, $CF3ECB31, $CBFFD686, $D5B88683, $D1799B34, $DC3ABDED, $D8FBA05A,
    $690CE0EE, $6DCDFD59, $608EDB80, $644FC637, $7A089632, $7EC98B85, $738AAD5C, $774BB0EB,
    $4F040D56, $4BC510E1, $46863638, $42472B8F, $5C007B8A, $58C1663D, $558240E4, $51435D53,
    $251D3B9E, $21DC2629, $2C9F00F0, $285E1D47, $36194D42, $32D850F5, $3F9B762C, $3B5A6B9B,
    $0315D626, $07D4CB91, $0A97ED48, $0E56F0FF, $1011A0FA, $14D0BD4D, $19939B94, $1D528623,
    $F12F560E, $F5EE4BB9, $F8AD6D60, $FC6C70D7, $E22B20D2, $E6EA3D65, $EBA91BBC, $EF68060B,
    $D727BBB6, $D3E6A601, $DEA580D8, $DA649D6F, $C423CD6A, $C0E2D0DD, $CDA1F604, $C960EBB3,
    $BD3E8D7E, $B9FF90C9, $B4BCB610, $B07DABA7, $AE3AFBA2, $AAFBE615, $A7B8C0CC, $A379DD7B,
    $9B3660C6, $9FF77D71, $92B45BA8, $9675461F, $8832161A, $8CF30BAD, $81B02D74, $857130C3,
    $5D8A9099, $594B8D2E, $5408ABF7, $50C9B640, $4E8EE645, $4A4FFBF2, $470CDD2B, $43CDC09C,
    $7B827D21, $7F436096, $7200464F, $76C15BF8, $68860BFD, $6C47164A, $61043093, $65C52D24,
    $119B4BE9, $155A565E, $18197087, $1CD86D30, $029F3D35, $065E2082, $0B1D065B, $0FDC1BEC,
    $3793A651, $3352BBE6, $3E119D3F, $3AD08088, $2497D08D, $2056CD3A, $2D15EBE3, $29D4F654,
    $C5A92679, $C1683BCE, $CC2B1D17, $C8EA00A0, $D6AD50A5, $D26C4D12, $DF2F6BCB, $DBEE767C,
    $E3A1CBC1, $E760D676, $EA23F0AF, $EEE2ED18, $F0A5BD1D, $F464A0AA, $F9278673, $FDE69BC4,
    $89B8FD09, $8D79E0BE, $803AC667, $84FBDBD0, $9ABC8BD5, $9E7D9662, $933EB0BB, $97FFAD0C,
    $AFB010B1, $AB710D06, $A6322BDF, $A2F33668, $BCB4666D, $B8757BDA, $B5365D03, $B1F740B4
    );

  Crc32Start : Cardinal = $FFFFFFFF;
  Crc32Bits = 32;
  Crc32Bytes = 4;
  Crc32HighBit = $80000000;
  NotCrc32HighBit = $7FFFFFFF;

//--------------------------------------------------------------------------------------------------

function Crc32Corr(Crc: Cardinal; N: Integer): Integer;
var
  I: Integer;
begin
  // calculate Syndrome
  for I := 1 to Crc32Bytes do
    Crc := Crc32Table[Crc shr (CRC32Bits-8)] xor (Crc shl 8);
  I := -1;
  repeat
    Inc(I);
    if (Crc and 1) <> 0 then
      Crc := ((Crc xor Crc32Table[1]) shr 1) or Crc32HighBit
//      Crc32Table[1] = Crc32Polynom
    else
      Crc := (Crc shr 1) and NotCrc32HighBit;
  until (Crc = Crc32HighBit) or (I = (N + Crc32Bytes) * 8);
  if Crc <> Crc32HighBit then
    Result := -1000 // not correctable
  else
    // I = No. of single faulty bit
    // (high bit first,
    // starting from lowest with CRC bits)
    Result := I - Crc32Bits;
    // Result <  0 faulty CRC-bit
    // Result >= 0 No. of faulty data bit
end;

//--------------------------------------------------------------------------------------------------

function Crc32_P(X: PByteArray; N: Integer; Crc: Cardinal = 0): Cardinal;
var
  I: Integer;
begin
  Result := Crc32Start;
  for I := 0 to N - 1 do // The CRC Bytes are located at the end of the information
  begin
    // a 32 bit value shr 24 is a Byte, explictit type conversion to Byte adds an ASM instruction
    Result := Crc32Table[Result shr (CRC32Bits-8)] xor (Result shl 8) xor X[I];
  end;
  for i := 0 to Crc32Bytes - 1 do
  begin
    // a 32 bit value shr 24 is a Byte, explictit type conversion to Byte adds an ASM instruction
    Result := Crc32Table[Result shr (CRC32Bits-8)] xor (Result shl 8) xor (Crc shr (CRC32Bits-8));
    Crc := Crc shl 8;
  end;
end;

//--------------------------------------------------------------------------------------------------

function CheckCrc32_P(X: PByteArray; N: Integer; Crc: Cardinal): Integer;
// checks and corrects a single bit in up to 2^31-32 Bit -> 2^28-4 = 268435452 Byte
var
  I, J: Integer;
  C: Byte;
begin
  Crc := Crc32_P(X, N, Crc);
  if Crc = 0 then
    Result := 0 // No CRC-error
  else
  begin
    J := Crc32Corr(Crc, N);
    if J < -(Crc32Bytes * 8 + 1) then
      Result := -1 // non-correctable error (more than one wrong bit)
    else
    begin
      if J < 0 then
        Result := 1 // one faulty Bit in CRC itself
      else
      begin // Bit j is faulty
        I := J and 7; // I <= 7 (faulty Bit in Byte)
        C := 1 shl I; // C <= 128
        I := J shr 3; // I: Index of faulty Byte
        X[N - 1 - I] := X[N - 1 - I] xor C; // correct faulty bit
        Result := 1; // Correctable error
      end;
    end;
  end;
end;

//--------------------------------------------------------------------------------------------------

function Crc32(const X: array of Byte; N: Integer; Crc: Cardinal = 0): Cardinal;
begin
   Result := Crc32_P(@X, N, Crc);
end;

//--------------------------------------------------------------------------------------------------

function CheckCrc32(var X: array of Byte; N: Integer; Crc: Cardinal): Integer;
begin
  Result := CheckCRC32_P(@X, N, CRC);
end;

//--------------------------------------------------------------------------------------------------

function Crc32_A(const X: array of Byte; Crc: Cardinal = 0): Cardinal;
begin
   Result := Crc32_P(@X, Length(X), Crc);
end;

//--------------------------------------------------------------------------------------------------

function CheckCrc32_A(var X: array of Byte; Crc: Cardinal): Integer;
begin
  Result := CheckCrc32_P(@X, Length(X), Crc);
end;

//--------------------------------------------------------------------------------------------------

// The CRC Table can be generated like this:
// const crc32start0 = 0;  !!

function crc32_bitwise (x: PByteArray; n: integer; crc: Cardinal; Polynom: Cardinal) : Cardinal;
var
 i, j: Integer;
 sr, srhighbit: Cardinal;
 b: Byte;

const
  crc32start0 = 0;   //Generating the table

begin
  sr := crc32start0;
  srhighbit := 0;
  for i := 0 to n-1+crc32bytes do begin
    if i >= n then
    begin
      b := crc shr (crc32bits-8);
      crc := crc shl 8;
    end
    else
    begin
       b := x[i]
    end;
    for j := 1 to 8 do
    begin
       if (srhighbit <> 0) then
       begin
         sr := sr xor polynom;
       end;
       srhighbit := sr and crc32highbit ;
       sr := (sr shl 1) or ((b shr 7) and 1);
       b := byte (b shl 1);
    end
  end;

  if (srhighbit <> 0) then
  begin
    sr := sr xor polynom;
  end;
  crc32_bitwise := sr;
end;

//--------------------------------------------------------------------------------------------------

procedure InitCrc32 (Polynom, Start: Cardinal);
var
  x: array [0..0] of byte;
  i: integer;

begin
   for i := 0 to 255 do
   begin
     x[0] := i;
     crc32table [i] := crc32_bitwise (@x, 1, 0, Polynom);
   end;
   Crc32Start := Start;
end;

//-----------------------------------------------------------------------------
// MD5
//-----------------------------------------------------------------------------

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 StrToMD5Digest(const str: String): TMD5Digest;
var
  MD5: TMD5Digest;
begin
  FillChar(Result, Sizeof(TMD5Digest), #0);
  if length(str)=32 then
    if HexToBin(pchar(str), pChar(@MD5), Sizeof(TMD5Digest))=Sizeof(TMD5Digest) then
      Result := MD5;
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 or fmShareDenyNone);
  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.




