md5unit.pas

传世源码可编译的,功能齐全.是学习的好模版,会DELPHI的朋友们也可以自己修改,弄个自己的引擎.

begin
Fret := ((PLong(b)^) And (PLong(c)^)) Or ((Not(PLong(b)^)) And (PLong(d)^));
PLong(a)^ := PLong(a)^ + Fret + PLong(x)^ + ac;
{NOW DO THE ROTATE LEFT}
LongInt(a^):= ROL(LongInt(a^), s);
{LongInt(a^):= ( LongInt(a^) SHL s) Or (LongInt(a^) SHR (32-(s)) );}
Inc(PLong(a)^, PLong(b)^);
end;{FF}

Procedure TMD5.GG(a, b, c, d, x: Pointer; s: BYTE; ac: LongWord); //Longint);
{Purpose: Round 2 of the Transform.
Equivalent to a = b + ((a + G(b,c,d) + x + ac) <<< s)
Where G(b,c,d) = b And d Or c Not d
}
var
Gret: LongWord; //LongInt;
begin
Gret := (PLong(b)^ And PLong(d)^) Or ( PLong(c)^ And (Not PLong(d)^));
PLong(a)^ := PLong(a)^ + Gret + PLong(x)^ + ac;
LongInt(a^):= ROL(LongInt(a^), s);
{LongInt(a^):= ( LongInt(a^) SHL s) Or (LongInt(a^) SHR (32-(s)) );}
Inc(PLong(a)^, PLong(b)^);
end;{GG}

Procedure TMD5.HH(a, b, c, d, x: Pointer; s: BYTE; ac: LongWord); //Longint);
{Purpose: Round 3 of the Transform.
Equivalent to a = b + ((a + H(b,c,d) + x + ac) <<< s)
Where H(b,c,d) = b Xor c Xor d
}
var
Hret: LongWord; //LongInt;
begin
Hret := PLong(b)^ Xor PLong(c)^ Xor PLong(d)^;
PLong(a)^ := PLong(a)^ + Hret + PLong(x)^ + ac;
LongInt(a^):= ROL(LongInt(a^), s);
{LongInt(a^):= ( LongInt(a^) SHL s) Or (LongInt(a^) SHR (32-(s)) );}
PLong(a)^ := PLong(b)^ + PLong(a)^;
end;{HH}

Procedure TMD5.II(a, b, c, d, x: Pointer; s: BYTE; ac: LongWord); //Longint);
{Purpose: Round 4 of the Transform.
Equivalent to a = b + ((a + I(b,c,d) + x + ac) <<< s)
Where I(b,c,d) = C Xor (b Or Not(d))
}
var
Iret: LongWord; //LongInt;
begin
Iret := (PLong(c)^ Xor (PLong(b)^ Or (Not PLong(d)^)));
PLong(a)^ := PLong(a)^ + Iret + PLong(x)^ + ac;
LongInt(a^):= ROL(PLong(a)^, s );
{ LongInt(a^):= ( LongInt(a^) SHL s) Or (LongInt(a^) SHR (32-(s)) );}
PLong(a)^ := PLong(b)^ + PLong(a)^;
end;{II}

Procedure TMD5.MD5_Transform;
{Purpose: Perform Step 4 of the algorithm. This is where all the important
stuff happens. This performs the rounds on a 64Byte Block. This
procedure should be called in a loop until all input data has been
transformed.
}

begin
FAA := FA;
FBB := FB;
FCC := FC;
FDD := FD;

{ Round 1 }
FF (FpA, FpB, FpC, FpD, @FActiveBlock[ 0], S11, $d76aa478); { 1 }
FF (FpD, FpA, FpB, FpC, @FActiveBlock[ 1], S12, $e8c7b756); { 2 }
FF (FpC, FpD, FpA, FpB, @FActiveBlock[ 2], S13, $242070db); { 3 }
FF (FpB, FpC, FpD, FpA, @FActiveBlock[ 3], S14, $c1bdceee); { 4 }
FF (FpA, FpB, FpC, FpD, @FActiveBlock[ 4], S11, $f57c0faf); { 5 }
FF (FpD, FpA, FpB, FpC, @FActiveBlock[ 5], S12, $4787c62a); { 6 }
FF (FpC, FpD, FpA, FpB, @FActiveBlock[ 6], S13, $a8304613); { 7 }
FF (FpB, FpC, FpD, FpA, @FActiveBlock[ 7], S14, $fd469501); { 8 }
FF (FpA, FpB, FpC, FpD, @FActiveBlock[ 8], S11, $698098d8); { 9 }
FF (FpD, FpA, FpB, FpC, @FActiveBlock[ 9], S12, $8b44f7af); { 10 }
FF (FpC, FpD, FpA, FpB, @FActiveBlock[10], S13, $ffff5bb1); { 11 }
FF (FpB, FpC, FpD, FpA, @FActiveBlock[11], S14, $895cd7be); { 12 }
FF (FpA, FpB, FpC, FpD, @FActiveBlock[12], S11, $6b901122); { 13 }
FF (FpD, FpA, FpB, FpC, @FActiveBlock[13], S12, $fd987193); { 14 }
FF (FpC, FpD, FpA, FpB, @FActiveBlock[14], S13, $a679438e); { 15 }
FF (FpB, FpC, FpD, FpA, @FActiveBlock[15], S14, $49b40821); { 16 }

{ Round 2 }
GG (FpA, FpB, FpC, FpD, @FActiveBlock[ 1], S21, $f61e2562); { 17 }
GG (FpD, FpA, FpB, FpC, @FActiveBlock[ 6], S22, $c040b340); { 18 }
GG (FpC, FpD, FpA, FpB, @FActiveBlock[11], S23, $265e5a51); { 19 }
GG (FpB, FpC, FpD, FpA, @FActiveBlock[ 0], S24, $e9b6c7aa); { 20 }
GG (FpA, FpB, FpC, FpD, @FActiveBlock[ 5], S21, $d62f105d); { 21 }
GG (FpD, FpA, FpB, FpC, @FActiveBlock[10], S22, $2441453); { 22 }
GG (FpC, FpD, FpA, FpB, @FActiveBlock[15], S23, $d8a1e681); { 23 }
GG (FpB, FpC, FpD, FpA, @FActiveBlock[ 4], S24, $e7d3fbc8); { 24 }
GG (FpA, FpB, FpC, FpD, @FActiveBlock[ 9], S21, $21e1cde6); { 25 }
GG (FpD, FpA, FpB, FpC, @FActiveBlock[14], S22, $c33707d6); { 26 }
GG (FpC, FpD, FpA, FpB, @FActiveBlock[ 3], S23, $f4d50d87); { 27 }
GG (FpB, FpC, FpD, FpA, @FActiveBlock[ 8], S24, $455a14ed); { 28 }
GG (FpA, FpB, FpC, FpD, @FActiveBlock[13], S21, $a9e3e905); { 29 }
GG (FpD, FpA, FpB, FpC, @FActiveBlock[ 2], S22, $fcefa3f8); { 30 }
GG (FpC, FpD, FpA, FpB, @FActiveBlock[ 7], S23, $676f02d9); { 31 }
GG (FpB, FpC, FpD, FpA, @FActiveBlock[12], S24, $8d2a4c8a); { 32 }

{ Round 3 }
HH (FpA, FpB, FpC, FpD, @FActiveBlock[ 5], S31, $fffa3942); { 33 }
HH (FpD, FpA, FpB, FpC, @FActiveBlock[ 8], S32, $8771f681); { 34 }
HH (FpC, FpD, FpA, FpB, @FActiveBlock[11], S33, $6d9d6122); { 35 }
HH (FpB, FpC, FpD, FpA, @FActiveBlock[14], S34, $fde5380c); { 36 }
HH (FpA, FpB, FpC, FpD, @FActiveBlock[ 1], S31, $a4beea44); { 37 }
HH (FpD, FpA, FpB, FpC, @FActiveBlock[ 4], S32, $4bdecfa9); { 38 }
HH (FpC, FpD, FpA, FpB, @FActiveBlock[ 7], S33, $f6bb4b60); { 39 }
HH (FpB, FpC, FpD, FpA, @FActiveBlock[10], S34, $bebfbc70); { 40 }
HH (FpA, FpB, FpC, FpD, @FActiveBlock[13], S31, $289b7ec6); { 41 }
HH (FpD, FpA, FpB, FpC, @FActiveBlock[ 0], S32, $eaa127fa); { 42 }
HH (FpC, FpD, FpA, FpB, @FActiveBlock[ 3], S33, $d4ef3085); { 43 }
HH (FpB, FpC, FpD, FpA, @FActiveBlock[ 6], S34, $4881d05); { 44 }
HH (FpA, FpB, FpC, FpD, @FActiveBlock[ 9], S31, $d9d4d039); { 45 }
HH (FpD, FpA, FpB, FpC, @FActiveBlock[12], S32, $e6db99e5); { 46 }
HH (FpC, FpD, FpA, FpB, @FActiveBlock[15], S33, $1fa27cf8); { 47 }
HH (FpB, FpC, FpD, FpA, @FActiveBlock[ 2], S34, $c4ac5665); { 48 }

{ Round 4 }
II (FpA, FpB, FpC, FpD, @FActiveBlock[ 0], S41, $f4292244); { 49 }
II (FpD, FpA, FpB, FpC, @FActiveBlock[ 7], S42, $432aff97); { 50 }
II (FpC, FpD, FpA, FpB, @FActiveBlock[14], S43, $ab9423a7); { 51 }
II (FpB, FpC, FpD, FpA, @FActiveBlock[ 5], S44, $fc93a039); { 52 }
II (FpA, FpB, FpC, FpD, @FActiveBlock[12], S41, $655b59c3); { 53 }
II (FpD, FpA, FpB, FpC, @FActiveBlock[ 3], S42, $8f0ccc92); { 54 }
II (FpC, FpD, FpA, FpB, @FActiveBlock[10], S43, $ffeff47d); { 55 }
II (FpB, FpC, FpD, FpA, @FActiveBlock[ 1], S44, $85845dd1); { 56 }
II (FpA, FpB, FpC, FpD, @FActiveBlock[ 8], S41, $6fa87e4f); { 57 }
II (FpD, FpA, FpB, FpC, @FActiveBlock[15], S42, $fe2ce6e0); { 58 }
II (FpC, FpD, FpA, FpB, @FActiveBlock[ 6], S43, $a3014314); { 59 }
II (FpB, FpC, FpD, FpA, @FActiveBlock[13], S44, $4e0811a1); { 60 }
II (FpA, FpB, FpC, FpD, @FActiveBlock[ 4], S41, $f7537e82); { 61 }
II (FpD, FpA, FpB, FpC, @FActiveBlock[11], S42, $bd3af235); { 62 }
II (FpC, FpD, FpA, FpB, @FActiveBlock[ 2], S43, $2ad7d2bb); { 63 }
II (FpB, FpC, FpD, FpA, @FActiveBlock[ 9], S44, $eb86d391); { 64 }

Inc(FA, FAA);
Inc(FB, FBB);
Inc(FC, FCC);
Inc(FD, FDD);
{ Zeroize sensitive information}
FillChar(FActiveBlock, SizeOf(FActiveBlock), #0);
end;{TMD5.MD5_Transform}

Procedure TMD5.MD5_Hash;
var
pStr: PChar;
begin
MD5_Initialize;
case FType of
SourceFile:
begin
MD5_Hash_File;
end;{SourceFile}
SourceByteArray:
begin
MD5_Hash_Bytes;
end;{SourceByteArray}
SourceString:
begin
{Convert Pascal String to Byte Array}
{$IFDEF DELPHI}
pStr := StrAlloc(Length(FInputString) + 1);
try {protect dyanmic memory allocation}
StrPCopy(pStr, FInputString);
{$ENDIF}
{$IFDEF BP7}
GetMem(pStr, Length(FInputString));
Move(FInputString[1],pStr^, Length(FInputString));
{$ENDIF}
FSourceLength := Length(FInputString);
FInputArray := Pointer(pStr);
MD5_Hash_Bytes;
{$IFDEF DELPHI}
finally
StrDispose(pStr);
end;
{$ENDIF}
{$IFDEF BP7}
FreeMem(pStr,Length(FInputString));
{$ENDIF}
end;{SourceString}
end;{case}
MD5_Finish;
end;{TMD5.MD5_Hash}

Procedure TMD5.MD5_Hash_Bytes;
var
Buffer: array[0..4159] of Byte;
Count64: Comp;
index: longInt;
begin
Move(FInputArray^, Buffer, FSourceLength);
Count64 := FSourceLength * 8; {Save the Length(in bits) before padding}
Buffer[FSourceLength] := $80; {Must always pad with at least a '1'}
inc(FSourceLength);

while (FSourceLength mod 64)<>56 do begin
Buffer[FSourceLength] := 0;
Inc(FSourceLength);
end;
Move(Count64,Buffer[FSourceLength],SizeOf(Count64){This better be 64bits});
index := 0;
Inc(FSourceLength, 8);
repeat
Move(Buffer[Index], FActiveBlock, 64);
{Flip bytes here on Mac??}
MD5_Transform;
Inc(Index,64);
until Index = FSourceLength;
end;{TMD5.Hash_Bytes}

Procedure TMD5.MD5_Hash_File;
var
Buffer:array[0..4159] of BYTE;
InputFile: File;
Count64: Comp;
DoneFile : Boolean;
Index: LongInt;
NumRead: longint;
begin
DoneFile := False;
{$IFDEF DELPHI}
AssignFile(InputFile, FInputFilePath);
{$ENDIF}
{$IFDEF BP7}
Assign(InputFile, FInputFilePath);
{$ENDIF}

Reset(InputFile, 1);
Count64 := 0;
repeat
BlockRead(InputFile,Buffer,4096,NumRead);
Count64 := Count64 + NumRead;
if NumRead<>4096 {reached end of file}
then begin
Buffer[NumRead]:= $80;
Inc(NumRead);
while (NumRead mod 64)<>56
do begin
Buffer[ NumRead ] := 0;
Inc(NumRead);
end;
Count64 := Count64 * 8;
Move(Count64,Buffer[NumRead],8);
Inc(NumRead,8);
DoneFile := True;
end;
Index := 0;
repeat
Move(Buffer[Index], FActiveBlock, 64);
{Flip bytes here on a Mac(I think)}

MD5_Transform;
Inc(Index,64);
until Index = NumRead;
until DoneFile;
{$IFDEF DELPHI}
CloseFile(InputFile);
{$ENDIF}
{$IFDEF BP7}
Close(InputFile);
{$ENDIF}
end;{TMD5.MD5_Hash_File}


Procedure TMD5.MD5_Finish;
begin
//FOutputDigest^.A := LongInt(FpA^);
//FOutputDigest^.B := LongInt(FpB^);
//FOutputDigest^.C := LongInt(FpC^);
//FOutputDigest^.D := LongInt(FpD^);

FPasswordString := LowerCase( HiLoChange(Longword(FpA^)) +
HiLoChange(LongInt(FpB^)) +
HiLoChange(LongInt(FpC^)) +
HiLoChange(LongInt(FpD^)) );
end;

function HiLoChange(liVal : Longword):string;
var
sztmp : string[8];
ti : shortint;
begin
Result := '';
sztmp := IntToHex(liVal,8);
for ti:=4 downto 1 do
Result := Result + sztmp[ti*2-1] + sztmp[ti*2];
end;

end.