unit MiTeC_MD;

interface

uses SysUtils;

type
  TMD2Contex = record
    D: array[0..47] of Byte;
    C: array[0..15] of Byte;
    n: Byte;
    Last: Byte;
  end;
  PMD2Context = ^TMD2Contex;


  TMD4Context = record
    State: array[0..3] of Cardinal;
    Count: array[0..1] of Cardinal;
    Buffer: array[0..63] of Byte;
  end;
  PMD4Context = ^TMD4Context;

  TMDTransFunc = procedure(var State: array of Cardinal; Block: Pointer);

  procedure MD2Init(md: PMD2Context);
  procedure MD2Update(md: PMD2Context; SrcBuf: Pointer; BufLen: Cardinal);
  function MD2Final(md: PMD2Context): string;

  procedure MDInit(context: PMD4Context);
  procedure MDUpdate(context: PMD4Context; input: Pointer; inputLen: Cardinal; TransFunc: TMDTransFunc);
  procedure MD4Transform (var state: array of Cardinal; block: Pointer);
  procedure MD5Transform (var state: array of Cardinal; block: Pointer);
  function MDFinal(context: PMD4Context; TransFunc: TMDTransFunc): string;

  function MD5Buf(SrcBuf: Pointer; BufLen: Cardinal; var DestHash: string): Cardinal;

implementation

type
  PCardinalArray = ^TCardinalArray;
  TCardinalArray = array[0..0] of Cardinal;

const
  PI_SUBST: array[0..255] of Byte = (
    41, 46, 67, 201, 162, 216, 124, 1, 61, 54, 84, 161, 236, 240, 6,
    19, 98, 167, 5, 243, 192, 199, 115, 140, 152, 147, 43, 217, 188,
    76, 130, 202, 30, 155, 87, 60, 253, 212, 224, 22, 103, 66, 111, 24,
    138, 23, 229, 18, 190, 78, 196, 214, 218, 158, 222, 73, 160, 251,
    245, 142, 187, 47, 238, 122, 169, 104, 121, 145, 21, 178, 7, 63,
    148, 194, 16, 137, 11, 34, 95, 33, 128, 127, 93, 154, 90, 144, 50,
    39, 53, 62, 204, 231, 191, 247, 151, 3, 255, 25, 48, 179, 72, 165,
    181, 209, 215, 94, 146, 42, 172, 86, 170, 198, 79, 184, 56, 210,
    150, 164, 125, 182, 118, 252, 107, 226, 156, 116, 4, 241, 69, 157,
    112, 89, 100, 113, 135, 32, 134, 91, 207, 101, 230, 45, 168, 2, 27,
    96, 37, 173, 174, 176, 185, 246, 28, 70, 97, 105, 52, 64, 126, 15,
    85, 71, 163, 35, 221, 81, 175, 58, 195, 92, 249, 206, 186, 197,
    234, 38, 44, 83, 13, 110, 133, 40, 132, 9, 211, 223, 205, 244, 65,
    129, 77, 82, 106, 220, 55, 200, 108, 193, 171, 250, 36, 225, 123,
    8, 12, 189, 177, 74, 120, 136, 149, 139, 227, 99, 232, 109, 233,
    203, 213, 254, 59, 0, 29, 57, 242, 239, 183, 14, 102, 88, 208, 228,
    166, 119, 114, 248, 235, 117, 75, 10, 49, 68, 80, 180, 143, 237,
    31, 26, 219, 153, 141, 51, 159, 17, 131, 20
  );

function ror(x: Cardinal; y: Byte): Cardinal; assembler;
asm
  mov   cl,dl
  ror   eax,cl
end;

function rol(x: Cardinal; y: Byte): Cardinal; assembler;
asm
  mov   cl,dl
  rol   eax,cl
end;

procedure MD2Init(md: PMD2Context);
begin
  FillChar(md^.D,16,0);
  FillChar(md^.C,16,0);
  md^.n:=0;
  md^.Last:=0;
end;

procedure MD2UpdateB(md: PMD2Context; c: Byte);
var
  i,j,t: Byte;
  p: PByte;
begin
  i:=md^.n;
  md^.D[16+i]:=c;
  md^.D[32+i]:=c xor md^.D[i];
  md^.C[i]:=md^.C[i] xor PI_SUBST[$ff and (c xor md^.Last)];
  md^.Last:=md^.C[i];
  md^.n:=(i + 1) and 15;
  i:=md^.n;
  if i=0 then begin
    t:=0;
    for j:=0 to 17 do begin
      p:=@md.D;
      for i:=0 to 7 do begin
        p^:=p^ xor PI_SUBST[t];
        t:=p^;
        Inc(p);
        p^:=p^ xor PI_SUBST[t];
        t:=p^;
        Inc(p);
        p^:=p^ xor PI_SUBST[t];
        t:=p^;
        Inc(p);
        p^:=p^ xor PI_SUBST[t];
        t:=p^;
        Inc(p);
        p^:=p^ xor PI_SUBST[t];
        t:=p^;
        Inc(p);
        p^:=p^ xor PI_SUBST[t];
        t:=p^;
        Inc(p);
      end;
      t:=t+j;
    end;
  end;
end;

procedure MD2Update(md: PMD2Context; SrcBuf: Pointer; BufLen: Cardinal);
var
  i: Cardinal;
begin
  if BufLen>0 then
    for i:=0 to BufLen-1 do
      MD2UpdateB(md,PByte(Cardinal(SrcBuf)+i)^);
end;

function MD2Final(md: PMD2Context): string;
var
  i,pl: Cardinal;
begin
  pl:=16-md^.n;
  for i:=0 to pl-1 do
    MD2UpdateB(md,pl);
  for i:=0 to 15 do
    MD2UpdateB(md,md^.C[i]);
  for i:=0 to 15 do
    Result:=Result+IntToHex(md.D[i],2);
end;

const
  MD_PADDING: array[0..63] of Byte = (
    $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
  );

  S11 = 3;
  S12 = 7;
  S13 = 11;
  S14 = 19;
  S21 = 3;
  S22 = 5;
  S23 = 9;
  S24 = 13;
  S31 = 3;
  S32 = 9;
  S33 = 11;
  S34 = 15;

function F(x,y,z: Cardinal): Cardinal; assembler;
asm
  and   edx,eax
  not   eax
  and   eax,ecx
  or    eax,edx
end;

function G(x,y,z: Cardinal): Cardinal; assembler;
asm
  push  ecx
  and   ecx,eax
  and   eax,edx
  or    eax,ecx
  pop   ecx
  and   edx,ecx
  or    eax,edx
end;

function H(x,y,z: Cardinal): Cardinal; assembler;
asm
  xor eax,edx
  xor eax,ecx
end;

procedure FF(var a: Cardinal; b,c,d,x,s: Cardinal);
begin
  a:=a+(F(b,c,d)+x);
  a:=rol(a,s);
end;

procedure GG(var a: Cardinal; b,c,d,x,s: Cardinal);
begin
  a:=a+G(b,c,d)+x+$5A827999;
  a:=rol(a,s);
end;

procedure HH(var a: Cardinal; b,c,d,x,s: Cardinal);
begin
  a:=a+H(b,c,d)+x+$6ED9EBA1;
  a:=rol(a,s);
end;

procedure MDInit(context: PMD4Context);
begin
  context^.count[0]:=0;
  context^.count[1]:=0;
  context^.state[0]:=$67452301;
  context^.state[1]:=$efcdab89;
  context^.state[2]:=$98badcfe;
  context^.state[3]:=$10325476;
end;

procedure MDEncode(output, input: Pointer; len: Cardinal);
var
  i,j: Cardinal;
begin
  i:=0;
  j:=0;
  while j<len do begin
    PByteArray(output)^[j]:=(PCardinalArray(input)^[i] and $ff);
    PByteArray(output)^[j + 1]:=((PCardinalArray(input)^[i] shr 8) and $ff);
    PByteArray(output)^[j + 2]:=((PCardinalArray(input)^[i] shr 16) and $ff);
    PByteArray(output)^[j + 3]:=((PCardinalArray(input)^[i] shr 24) and $ff);
    Inc(i);
    Inc(j,4);
  end;
end;

procedure MDDecode(output, input: Pointer; len: Cardinal);
var
  i,j: Cardinal;
begin
  i:=0;
  j:=0;
  while j<len do begin
    PCardinalArray(output)^[i]:=PByteArray(input)^[j] or (PByteArray(input)^[j+1] shl 8) or
                             (PByteArray(input)^[j+2] shl 16) or
                             (PByteArray(input)^[j+3] shl 24);
    Inc(i);
    Inc(j,4);
  end;
end;

procedure MD4Transform (var state: array of Cardinal; block: Pointer);
var
  a,b,c,d: Cardinal;
  x: array[0..15] of Cardinal;
begin
  a:=state[0];
  b:=state[1];
  c:=state[2];
  d:=state[3];
  MDDecode(@x,block,64);

  FF(a,b,c,d,x[0],S11);
  FF(d,a,b,c,x[1],S12);
  FF(c,d,a,b,x[2],S13);
  FF(b,c,d,a,x[3],S14);
  FF(a,b,c,d,x[4],S11);
  FF(d,a,b,c,x[5],S12);
  FF(c,d,a,b,x[6],S13);
  FF(b,c,d,a,x[7],S14);
  FF(a,b,c,d,x[8],S11);
  FF(d,a,b,c,x[9],S12);
  FF(c,d,a,b,x[10],S13);
  FF(b,c,d,a,x[11],S14);
  FF(a,b,c,d,x[12],S11);
  FF(d,a,b,c,x[13],S12);
  FF(c,d,a,b,x[14],S13);
  FF(b,c,d,a,x[15],S14);

  GG(a,b,c,d,x[0],S21);
  GG(d,a,b,c,x[4],S22);
  GG(c,d,a,b,x[8],S23);
  GG(b,c,d,a,x[12],S24);
  GG(a,b,c,d,x[1],S21);
  GG(d,a,b,c,x[5],S22);
  GG(c,d,a,b,x[9],S23);
  GG(b,c,d,a,x[13],S24);
  GG(a,b,c,d,x[2],S21);
  GG(d,a,b,c,x[6],S22);
  GG(c,d,a,b,x[10],S23);
  GG(b,c,d,a,x[14],S24);
  GG(a,b,c,d,x[3],S21);
  GG(d,a,b,c,x[7],S22);
  GG(c,d,a,b,x[11],S23);
  GG(b,c,d,a,x[15],S24);

  HH(a,b,c,d,x[0],S31);
  HH(d,a,b,c,x[8],S32);
  HH(c,d,a,b,x[4],S33);
  HH(b,c,d,a,x[12],S34);
  HH(a,b,c,d,x[2],S31);
  HH(d,a,b,c,x[10],S32);
  HH(c,d,a,b,x[6],S33);
  HH(b,c,d,a,x[14],S34);
  HH(a,b,c,d,x[1],S31);
  HH(d,a,b,c,x[9],S32);
  HH(c,d,a,b,x[5],S33);
  HH(b,c,d,a,x[13],S34);
  HH(a,b,c,d,x[3],S31);
  HH(d,a,b,c,x[11],S32);
  HH(c,d,a,b,x[7],S33);
  HH(b,c,d,a,x[15],S34);

  state[0]:=state[0]+a;
  state[1]:=state[1]+b;
  state[2]:=state[2]+c;
  state[3]:=state[3]+d;
end;

procedure MDUpdate(context: PMD4Context; input: Pointer; inputLen: Cardinal; TransFunc: TMDTransFunc);
var
  i,Index,pl: Cardinal;
begin
  index:=(context^.count[0] shr 3) and $3F;
  context^.count[0]:=context^.count[0]+inputLen shl 3;
  if (context^.count[0]<(inputLen shl 3)) then
    Inc(context^.count[1]);
  context^.count[1]:=context^.count[1]+inputLen shr 29;
  pl:=64-index;
  if (inputLen>=pl) then begin
    Move(input^,context^.buffer[index],pl);
    TransFunc(context^.state, @context^.buffer);
    i:=pl;
    while i+63<inputLen do begin
      TransFunc(context^.state,Addr(PByteArray(input)^[i]));
      Inc(i,64);
    end;
    index:=0;
  end else
    i:=0;
  Move(PByteArray(input)^[i],context^.buffer[index],inputLen-i);
end;

function MDFinal(context: PMD4Context; TransFunc: TMDTransFunc): String;
var
  digest: array[0..15] of Char;
  bits: array[0..7] of Char;
  i,pl: Cardinal;
begin
  MDEncode(@bits, @context^.Count,8);
  i:=(context^.count[0] shr 3) and $3f;
  if (i<56) then
    pl:=56-i
  else
    pl:=120-i;
  MDUpdate(context,@MD_PADDING,pl,TransFunc);
  MDUpdate(context,@bits,8,TransFunc);
  MDEncode(@digest,@context^.state,16);
  FillChar(context^,0,SizeOf(TMD4Context));
  Result:='';
  for i:=0 to 15 do
    Result:=Result+IntToHex(Ord(digest[i]),2);
end;

const
  MD5_S11 = 7;
  MD5_S12 = 12;
  MD5_S13 = 17;
  MD5_S14 = 22;
  MD5_S21 = 5;
  MD5_S22 = 9;
  MD5_S23 = 14;
  MD5_S24 = 20;
  MD5_S31 = 4;
  MD5_S32 = 11;
  MD5_S33 = 16;
  MD5_S34 = 23;
  MD5_S41 = 6;
  MD5_S42 = 10;
  MD5_S43 = 15;
  MD5_S44 = 21;

function MD5_G(x,y,z: Cardinal): Cardinal; assembler;
asm
  push  ecx
  and   ecx,eax
  and   eax,edx
  or    eax,ecx
  pop   ecx
  not   ecx
  and   edx,ecx
  or    eax,edx
end;

function I(x,y,z: Cardinal): Cardinal; assembler;
asm
  not   ecx
  or    eax,ecx
  xor   eax,edx
end;

procedure MD5_FF(var a: Cardinal; b,c,d,x,s,ac: Cardinal);
begin
  a:=a+F(b,c,d)+x+ac;
  a:=rol(a,s);
  a:=a+b;
end;

procedure MD5_GG(var a: Cardinal; b,c,d,x,s,ac: Cardinal);
begin
  a:=a+MD5_G(b,c,d)+x+ac;
  a:=rol(a,s);
  a:=a+b;
end;

procedure MD5_HH(var a: Cardinal; b,c,d,x,s,ac: Cardinal);
begin
 a:=a+H(b,c,d)+x+ac;
 a:=rol(a,s);
 a:=a+b;
end;

procedure MD5_II(var a: Cardinal; b,c,d,x,s,ac: Cardinal);
begin
 a:=a+I(b,c,d)+x+ac;
 a:=rol(a,s);
 a:=a+b;
end;

procedure MD5Transform (var state: array of Cardinal; block: Pointer);
var
  a,b,c,d: Cardinal;
  x: array[0..15] of Cardinal;
begin
  a:=state[0];
  b:=state[1];
  c:=state[2];
  d:=state[3];
  MDDecode(@x,block,64);

  MD5_FF(a,b,c,d,x[0],MD5_S11,$d76aa478);
  MD5_FF(d,a,b,c,x[1],MD5_S12,$e8c7b756);
  MD5_FF(c,d,a,b,x[2],MD5_S13,$242070db);
  MD5_FF(b,c,d,a,x[3],MD5_S14,$c1bdceee);
  MD5_FF(a,b,c,d,x[4],MD5_S11,$f57c0faf);
  MD5_FF(d,a,b,c,x[5],MD5_S12,$4787c62a);
  MD5_FF(c,d,a,b,x[6],MD5_S13,$a8304613);
  MD5_FF(b,c,d,a,x[7],MD5_S14,$fd469501);
  MD5_FF(a,b,c,d,x[8],MD5_S11,$698098d8);
  MD5_FF(d,a,b,c,x[9],MD5_S12,$8b44f7af);
  MD5_FF(c,d,a,b,x[10],MD5_S13,$ffff5bb1);
  MD5_FF(b,c,d,a,x[11],MD5_S14,$895cd7be);
  MD5_FF(a,b,c,d,x[12],MD5_S11,$6b901122);
  MD5_FF(d,a,b,c,x[13],MD5_S12,$fd987193);
  MD5_FF(c,d,a,b,x[14],MD5_S13,$a679438e);
  MD5_FF(b,c,d,a,x[15],MD5_S14,$49b40821);

  MD5_GG(a,b,c,d,x[1],MD5_S21,$f61e2562);
  MD5_GG(d,a,b,c,x[6],MD5_S22,$c040b340);
  MD5_GG(c,d,a,b,x[11],MD5_S23,$265e5a51);
  MD5_GG(b,c,d,a,x[0],MD5_S24,$e9b6c7aa);
  MD5_GG(a,b,c,d,x[5],MD5_S21,$d62f105d);
  MD5_GG(d,a,b,c,x[10],MD5_S22,$02441453);
  MD5_GG(c,d,a,b,x[15],MD5_S23,$d8a1e681);
  MD5_GG(b,c,d,a,x[4],MD5_S24,$e7d3fbc8);
  MD5_GG(a,b,c,d,x[9],MD5_S21,$21e1cde6);
  MD5_GG(d,a,b,c,x[14],MD5_S22,$c33707d6);
  MD5_GG(c,d,a,b,x[3],MD5_S23,$f4d50d87);
  MD5_GG(b,c,d,a,x[8],MD5_S24,$455a14ed);
  MD5_GG(a,b,c,d,x[13],MD5_S21,$a9e3e905);
  MD5_GG(d,a,b,c,x[2],MD5_S22,$fcefa3f8);
  MD5_GG(c,d,a,b,x[7],MD5_S23,$676f02d9);
  MD5_GG(b,c,d,a,x[12],MD5_S24,$8d2a4c8a);

  MD5_HH(a,b,c,d,x[5],MD5_S31,$fffa3942);
  MD5_HH(d,a,b,c,x[8],MD5_S32,$8771f681);
  MD5_HH(c,d,a,b,x[11],MD5_S33,$6d9d6122);
  MD5_HH(b,c,d,a,x[14],MD5_S34,$fde5380c);
  MD5_HH(a,b,c,d,x[1],MD5_S31,$a4beea44);
  MD5_HH(d,a,b,c,x[4],MD5_S32,$4bdecfa9);
  MD5_HH(c,d,a,b,x[7],MD5_S33,$f6bb4b60);
  MD5_HH(b,c,d,a,x[10],MD5_S34,$bebfbc70);
  MD5_HH(a,b,c,d,x[13],MD5_S31,$289b7ec6);
  MD5_HH(d,a,b,c,x[0],MD5_S32,$eaa127fa);
  MD5_HH(c,d,a,b,x[3],MD5_S33,$d4ef3085);
  MD5_HH(b,c,d,a,x[6],MD5_S34,$04881d05);
  MD5_HH(a,b,c,d,x[9],MD5_S31,$d9d4d039);
  MD5_HH(d,a,b,c,x[12],MD5_S32,$e6db99e5);
  MD5_HH(c,d,a,b,x[15],MD5_S33,$1fa27cf8);
  MD5_HH(b,c,d,a,x[2],MD5_S34,$c4ac5665);

  MD5_II(a,b,c,d,x[0],MD5_S41,$f4292244);
  MD5_II(d,a,b,c,x[7],MD5_S42,$432aff97);
  MD5_II(c,d,a,b,x[14],MD5_S43,$ab9423a7);
  MD5_II(b,c,d,a,x[5],MD5_S44,$fc93a039);
  MD5_II(a,b,c,d,x[12],MD5_S41,$655b59c3);
  MD5_II(d,a,b,c,x[3],MD5_S42,$8f0ccc92);
  MD5_II(c,d,a,b,x[10],MD5_S43,$ffeff47d);
  MD5_II(b,c,d,a,x[1],MD5_S44,$85845dd1);
  MD5_II(a,b,c,d,x[8],MD5_S41,$6fa87e4f);
  MD5_II(d,a,b,c,x[15],MD5_S42,$fe2ce6e0);
  MD5_II(c,d,a,b,x[6],MD5_S43,$a3014314);
  MD5_II(b,c,d,a,x[13],MD5_S44,$4e0811a1);
  MD5_II(a,b,c,d,x[4],MD5_S41,$f7537e82);
  MD5_II(d,a,b,c,x[11],MD5_S42,$bd3af235);
  MD5_II(c,d,a,b,x[2],MD5_S43,$2ad7d2bb);
  MD5_II(b,c,d,a,x[9],MD5_S44,$eb86d391);

  state[0]:=state[0]+a;
  state[1]:=state[1]+b;
  state[2]:=state[2]+c;
  state[3]:=state[3]+d;
end;

function MD5Buf;
var
  Data: Pointer;
begin
  GetMem(Data,SizeOf(TMD4Context));
  try
    MDInit(Data);
    MDUpdate(Data,SrcBuf,BufLen,@MD5Transform);
    DestHash:=MDFinal(Data,@MD5Transform);
  finally
    FreeMem(Data,SizeOf(TMD4Context));
  end;  
end;

end.