frxmd5.pas

这个是功能强大的报表软件

  md5 := TfrxMD5.Create;
  try
    md5.Update(Buf, Len);
    md5.Finalize;
    d := md5.Digest;
    Move(d^, digest^, 16);
  finally
    md5.Free;
  end;
end;

{ TfrxMD5 }
constructor TfrxMD5.Create;
begin
  Init;
end;

// md5::Init
// Initializes a new context.
procedure TfrxMD5.Init;
begin
  FillChar(m_Count, 2 * SizeOf(uint4), 0);
  m_State[0] := MD5_INIT_STATE_0;
  m_State[1] := MD5_INIT_STATE_1;
  m_State[2] := MD5_INIT_STATE_2;
  m_State[3] := MD5_INIT_STATE_3;
end;

// MD5 block update operation. Continues an MD5 message-digest
// operation, processing another message block, and updating the
// context.
procedure TfrxMD5.Update(chInput: Puchar; nInputLen: uint4);
var
  i, index, partLen: uint4;
  tmp: Puchar;
begin
  // Compute number of bytes mod 64
  index := (m_Count[0] shr 3) and $3F;
  // Update number of bits
  m_Count[0] := m_Count[0] + (nInputLen shl 3);
  if m_Count[0] < (nInputLen shl 3) then
    m_Count[1] := m_Count[1] + 1;
  m_Count[1] := m_Count[1] + (nInputLen shr 29);
  partLen := 64 - index;
  // Transform as many times as possible.
  if nInputLen >= partLen then
  begin
    Move(chInput^, m_Buffer[index], partLen);
    Transform(Puchar(@m_Buffer));
    i := partLen;
    while (i + 63) < nInputLen do
    begin
      tmp := chInput;
      Inc(tmp, i);
      Transform(tmp);
      i := i + 64;
    end;
    index := 0;
  end  else
    i := 0;
  // Buffer remaining input
  tmp := chInput;
  Inc(tmp, i);
  Move(tmp^, m_Buffer[index], nInputLen - i);
end;

// MD5 finalization. Ends an MD5 message-digest operation, writing
// the message digest and zeroizing the context.
procedure TfrxMD5.Finalize;
var
  bits: array [0..7] of uchar;
  index, padLen: uint4;
begin
  // Save number of bits
  Encode(Puchar(@bits), Puint4(@m_Count), 8);
  // Pad out to 56 mod 64
  index := (m_Count[0] shr 3) and $3f;
  if index < 56 then
    padLen := 56 - index
  else
    padLen := 120 - index;
  Update(Puchar(@PADDING), padLen);
  // Append length (before padding)
  Update(Puchar(@bits), 8);
  // Store state in digest
  Encode(Puchar(@m_Digest), Puint4(@m_State), 16);
  FillChar(m_Count, 2 * sizeof(uint4), 0);
  FillChar(m_State, 4 * sizeof(uint4), 0);
  FillChar(m_Buffer, 64 * sizeof(uchar), 0);
end;

function TfrxMD5.Digest: Puchar;
begin
  Result := Puchar(@m_Digest);
end;

// MD5 basic transformation. Transforms state based on block.
procedure TfrxMD5.Transform(block: Puchar);
var
  a, b, c, d: uint4;
  X: array [0..15] of uint4;
begin
  a := m_State[0];
  b := m_State[1];
  c := m_State[2];
  d := m_State[3];
  Decode(Puint4(@X), block, 64);
  //Perform Round 1 of the transformation
  FF (a, b, c, d, X[ 0], MD5_S11, MD5_T01);
  FF (d, a, b, c, X[ 1], MD5_S12, MD5_T02);
  FF (c, d, a, b, X[ 2], MD5_S13, MD5_T03);
  FF (b, c, d, a, X[ 3], MD5_S14, MD5_T04);
  FF (a, b, c, d, X[ 4], MD5_S11, MD5_T05);
  FF (d, a, b, c, X[ 5], MD5_S12, MD5_T06);
  FF (c, d, a, b, X[ 6], MD5_S13, MD5_T07);
  FF (b, c, d, a, X[ 7], MD5_S14, MD5_T08);
  FF (a, b, c, d, X[ 8], MD5_S11, MD5_T09);
  FF (d, a, b, c, X[ 9], MD5_S12, MD5_T10);
  FF (c, d, a, b, X[10], MD5_S13, MD5_T11);
  FF (b, c, d, a, X[11], MD5_S14, MD5_T12);
  FF (a, b, c, d, X[12], MD5_S11, MD5_T13);
  FF (d, a, b, c, X[13], MD5_S12, MD5_T14);
  FF (c, d, a, b, X[14], MD5_S13, MD5_T15);
  FF (b, c, d, a, X[15], MD5_S14, MD5_T16);
  //Perform Round 2 of the transformation
  GG (a, b, c, d, X[ 1], MD5_S21, MD5_T17);
  GG (d, a, b, c, X[ 6], MD5_S22, MD5_T18);
  GG (c, d, a, b, X[11], MD5_S23, MD5_T19);
  GG (b, c, d, a, X[ 0], MD5_S24, MD5_T20);
  GG (a, b, c, d, X[ 5], MD5_S21, MD5_T21);
  GG (d, a, b, c, X[10], MD5_S22, MD5_T22);
  GG (c, d, a, b, X[15], MD5_S23, MD5_T23);
  GG (b, c, d, a, X[ 4], MD5_S24, MD5_T24);
  GG (a, b, c, d, X[ 9], MD5_S21, MD5_T25);
  GG (d, a, b, c, X[14], MD5_S22, MD5_T26);
  GG (c, d, a, b, X[ 3], MD5_S23, MD5_T27);
  GG (b, c, d, a, X[ 8], MD5_S24, MD5_T28);
  GG (a, b, c, d, X[13], MD5_S21, MD5_T29);
  GG (d, a, b, c, X[ 2], MD5_S22, MD5_T30);
  GG (c, d, a, b, X[ 7], MD5_S23, MD5_T31);
  GG (b, c, d, a, X[12], MD5_S24, MD5_T32);
  //Perform Round 3 of the transformation
  HH (a, b, c, d, X[ 5], MD5_S31, MD5_T33);
  HH (d, a, b, c, X[ 8], MD5_S32, MD5_T34);
  HH (c, d, a, b, X[11], MD5_S33, MD5_T35);
  HH (b, c, d, a, X[14], MD5_S34, MD5_T36);
  HH (a, b, c, d, X[ 1], MD5_S31, MD5_T37);
  HH (d, a, b, c, X[ 4], MD5_S32, MD5_T38);
  HH (c, d, a, b, X[ 7], MD5_S33, MD5_T39);
  HH (b, c, d, a, X[10], MD5_S34, MD5_T40);
  HH (a, b, c, d, X[13], MD5_S31, MD5_T41);
  HH (d, a, b, c, X[ 0], MD5_S32, MD5_T42);
  HH (c, d, a, b, X[ 3], MD5_S33, MD5_T43);
  HH (b, c, d, a, X[ 6], MD5_S34, MD5_T44);
  HH (a, b, c, d, X[ 9], MD5_S31, MD5_T45);
  HH (d, a, b, c, X[12], MD5_S32, MD5_T46);
  HH (c, d, a, b, X[15], MD5_S33, MD5_T47);
  HH (b, c, d, a, X[ 2], MD5_S34, MD5_T48);
  //Perform Round 4 of the transformation
  II (a, b, c, d, X[ 0], MD5_S41, MD5_T49);
  II (d, a, b, c, X[ 7], MD5_S42, MD5_T50);
  II (c, d, a, b, X[14], MD5_S43, MD5_T51);
  II (b, c, d, a, X[ 5], MD5_S44, MD5_T52);
  II (a, b, c, d, X[12], MD5_S41, MD5_T53);
  II (d, a, b, c, X[ 3], MD5_S42, MD5_T54);
  II (c, d, a, b, X[10], MD5_S43, MD5_T55);
  II (b, c, d, a, X[ 1], MD5_S44, MD5_T56);
  II (a, b, c, d, X[ 8], MD5_S41, MD5_T57);
  II (d, a, b, c, X[15], MD5_S42, MD5_T58);
  II (c, d, a, b, X[ 6], MD5_S43, MD5_T59);
  II (b, c, d, a, X[13], MD5_S44, MD5_T60);
  II (a, b, c, d, X[ 4], MD5_S41, MD5_T61);
  II (d, a, b, c, X[11], MD5_S42, MD5_T62);
  II (c, d, a, b, X[ 2], MD5_S43, MD5_T63);
  II (b, c, d, a, X[ 9], MD5_S44, MD5_T64);
  m_State[0] := m_State[0] + a;
  m_State[1] := m_State[1] + b;
  m_State[2] := m_State[2] + c;
  m_State[3] := m_State[3] + d;
  FillChar(X, sizeof(X), 0);
end;

// Encodes input (uint4) into output (uchar). Assumes nLength is
// a multiple of 4.
procedure TfrxMD5.Encode(dest: Puchar; src: Puint4; nLength: uint4);
var
  j: uint4;
  tmp: Puchar;
  tmp2: Puint4;
begin
  j := 0;
  tmp := dest;
  tmp2 := src;
  while j < nLength do
  begin
    tmp^ := uchar(tmp2^ and $ff);
    Inc(tmp);
    tmp^ := uchar((tmp2^ shr 8) and $ff);
    Inc(tmp);
    tmp^ := uchar((tmp2^ shr 16) and $ff);
    Inc(tmp);
    tmp^ := uchar((tmp2^ shr 24) and $ff);
    Inc(tmp);
    Inc(tmp2);
    j := j + 4;
  end;
end;

// Decodes input (uchar) into output (uint4). Assumes nLength is
// a multiple of 4.
procedure TfrxMD5.Decode(dest: Puint4; src: Puchar; nLength: uint4);
var
  j: uint4;
  tmp2: Puchar;
  tmp: Puint4;
begin
  j := 0;
  tmp := dest;
  tmp2 := src;
  while j < nLength do
  begin
    tmp^ := uint4(tmp2^);
    Inc(tmp2);
    tmp^ := tmp^ or uint4(tmp2^ shl 8);
    Inc(tmp2);
    tmp^ := tmp^ or uint4(tmp2^ shl 16);
    Inc(tmp2);
    tmp^ := tmp^ or uint4(tmp2^ shl 24);
    Inc(tmp2);
    Inc(tmp);
    j := j + 4;
  end;
end;

function TfrxMD5.RotateLeft(x: uint4; n: uint4): uint4;
begin
  Result := (x shl n) or (x shr (32 - n));
end;

procedure TfrxMD5.FF(var a: uint4; b: uint4; c: uint4; d: uint4; x: uint4; s: uint4; ac: uint4);
begin
  a := a + ((b and c) or (not b and d)) + x + ac;
  a := RotateLeft(a, s);
  a := a + b;
end;

procedure TfrxMD5.GG(var a: uint4; b: uint4; c: uint4; d: uint4; x: uint4; s: uint4; ac: uint4);
begin
  a := a + ((b and d) or (c and (not d))) + x + ac;
  a := RotateLeft(a, s);
  a := a + b;
end;

procedure TfrxMD5.HH(var a: uint4; b: uint4; c: uint4; d: uint4; x: uint4; s: uint4; ac: uint4);
begin
  a := a + (b xor c xor d) + x + ac;
  a := RotateLeft(a, s);
  a := a + b;
end;

procedure TfrxMD5.II(var a: uint4; b: uint4; c: uint4; d: uint4; x: uint4; s: uint4; ac: uint4);
begin
  a := a + (c xor (b or (not d))) + x + ac;
  a := RotateLeft(a, s);
  a := a + b;
end;

{$IFDEF OVERDEF}
  {$UNDEF OVERDEF}
  {$Q+}
{$ENDIF}

end.


//