unit md5;
interface
type
MD5Digest = array[0..15] of Byte;
MD5State = array[0..3] of LongWord;
MD5Buffer = array[0..63] of Byte;
TMD5 = class
private
FState: MD5State;
FCount: Int64;
FBuffer: MD5Buffer;
public
constructor Create;
procedure Update(const Input; Length: Cardinal);
function Final: MD5Digest;
end;
function MD5Message(const Message; Length: Cardinal): MD5Digest;
function MD5String(const S: string): MD5Digest;
function MD5File(const FileName: string): MD5Digest;
function MD5Print(const D: MD5Digest): string;
implementation
{$IFDEF MSWINDOWS}
uses
Windows;
{$ENDIF}
function ROL(X: LongWord; Count: Integer): LongWord;
{$IFDEF PUREPASCAL}
begin
Result := (X shl Count) or (X shr (32 - Count));
end;
{$ELSE}
asm
MOV ECX,EDX
ROL EAX,CL
end;
{$ENDIF}
type
MD5Iters = 0..63;
var
k: array[MD5Iters] of Integer;
T: array[MD5Iters] of LongWord;
s: array[MD5Iters] of Integer;
procedure InitLUTs;
const
A: array[0..15] of Integer =
(
7, 12, 17, 22,
5, 9, 14, 20,
4, 11, 16, 23,
6, 10, 15, 21
);
var
I: Integer;
begin
for I := 0 to 63 do
begin
case I of
0..15: k[I] := I;
16..31: k[I] := (5 * I + 1) and $f;
32..47: k[I] := (3 * I + 5) and $f;
48..63: k[I] := (7 * I) and $f;
end;
T[I] := Trunc(Abs(Sin(I + 1)) * $100000000);
s[I] := A[I shr 2 and $c or I and $3];
end;
end;
// MD5 basic transformation. Transforms state based on block.
procedure Transform(var State: MD5State; const Block);
var
X: array[0..15] of LongWord absolute Block;
a, b, c, d, i, f, temp: LongWord;
begin
f := 0;
a := State[0];
b := State[1];
c := State[2];
d := State[3];
for i := 0 to 63 do
begin
case i of
0..15: f := d xor (b and (c xor d));
16..31: f := c xor (d and (b xor c));
32..47: f := b xor c xor d;
48..63: f := c xor (b or (not d));
end;
temp := d;
d := c;
c := b;
Inc(b, ROL(a + f + X[k[i]] + T[i], s[i]));
a := temp;
end;
Inc(State[0], a);
Inc(State[1], b);
Inc(State[2], c);
Inc(State[3], d);
end;
{ TMD5 }
constructor TMD5.Create;
begin
FState[0] := $67452301;
FState[1] := $efcdab89;
FState[2] := $98badcfe;
FState[3] := $10325476;
end;
type
Bytes = array[0..0] of Byte;
procedure TMD5.Update(const Input; Length: Cardinal);
var
I, Index, PartLen: Cardinal;
begin
Index := FCount and $3f;
Inc(FCount, Length);
PartLen := 64 - Index;
if Length >= PartLen then
begin
Move(Input, FBuffer[Index], PartLen);
Transform(FState, FBuffer);
I := PartLen;
while I + 63 < Length do
begin
Transform(FState, Bytes(Input)[I]);
Inc(I, 64);
end;
Index := 0;
end
else
I := 0;
Move(Bytes(Input)[I], FBuffer[Index], Length - I);
end;
function TMD5.Final: MD5Digest;
var
BitLength: Int64;
Padding: MD5Buffer;
PadLen: Integer;
begin
BitLength := FCount shl 3;
PadLen := (119 - FCount and $3f) and $3f + 1;
FillChar(Padding, PadLen, 0);
Padding[0] := $80;
Update(Padding, PadLen);
Update(BitLength, SizeOf(Int64));
Result := MD5Digest(FState);
Free;
end;
// ----------------------------------------------------------------------------
function MD5Message(const Message; Length: Cardinal): MD5Digest;
begin
with TMD5.Create do
try
Update(Message, Length);
Result := Final;
except
Free;
raise;
end;
end;
function MD5String(const S: string): MD5Digest;
begin
Result := MD5Message(Pointer(S)^, Length(S));
end;
function MD5File(const FileName: string): MD5Digest;
{$IFDEF MSWINDOWS}
var
FileHandle: THandle;
MapHandle: THandle;
ViewPointer: Pointer;
{$ENDIF}
begin
FillChar(Result, SizeOf(MD5Digest), 0);
{$IFDEF MSWINDOWS}
FileHandle := CreateFile(PChar(FileName), GENERIC_READ, FILE_SHARE_READ or
FILE_SHARE_WRITE, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL or
FILE_FLAG_SEQUENTIAL_SCAN, 0);
if FileHandle <> INVALID_HANDLE_VALUE then
try
MapHandle := CreateFileMapping(FileHandle, nil, PAGE_READONLY, 0, 0, nil);
if MapHandle <> 0 then
try
ViewPointer := MapViewOfFile(MapHandle, FILE_MAP_READ, 0, 0, 0);
if ViewPointer <> nil then
try
Result := MD5Message(ViewPointer^, GetFileSize(FileHandle, nil));
finally
UnmapViewOfFile(ViewPointer);
end;
finally
CloseHandle(MapHandle);
end;
finally
CloseHandle(FileHandle);
end;
{$ENDIF}
end;
function MD5Print(const D: MD5Digest): string;
const
Digits: array[0..15] of Char =
('0','1','2','3','4','5','6','7','8','9','a','b',' c','d','e','f');
var
I: Integer;
TempStr: string[32];
begin
TempStr := '';
for I := 0 to 15 do
TempStr := TempStr + Digits[D[I] shr 4] + Digits[D[I] and $f];
Result := TempStr;
end;
initialization
InitLUTs;
end.