Delphi-XE Available MD5 algorithm _delphi

Copy Code code as follows:

Unit MD5;

Interface

Uses
Windows, Messages, sysutils, variants, Classes, Graphics, Controls, Forms,
Dialogs, Stdctrls;

Type
Md5count = array [0.. 1] of DWORD;
md5state = array [0.. 3] of DWORD;
Md5block = array [0.] of DWORD;
md5cbits = array [0.. 7] of Byte;
md5digest = array [0.] of Byte;
Md5buffer = array [0..] of Byte;

Md5context = Record
State:md5state;
Count:md5count;
Buffer:md5buffer;
End

Procedure Md5init (var context:md5context);
Procedure Md5update (Var context:md5context; Input:pansichar;
Length:longword);
Procedure Md5final (var context:md5context; var digest:md5digest);
function Md5file (n:string): md5digest;
function Md5print (d:md5digest): ansistring;
function md5f (filename:ansistring): ansistring;
function md5s (str:ansistring): ansistring;

md5f is the MD5 value of the computed file, md5s is the MD5 value of the computed string!
Var
Padding:md5buffer = ($80, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00);

Implementation

function F (x, Y, Z:dword): DWORD;
Begin
Result: = (x and y) or (not x) and z);
End

function G (x, Y, Z:dword): DWORD;
Begin
Result: = (x and z) or (Y and not z);
End

function H (x, Y, Z:dword): DWORD;
Begin
Result: = x xor y xor Z;
End

function I (x, Y, Z:dword): DWORD;
Begin
Result: = y xor (x or (not z));
End

Procedure rot (Var X:dword; N:byte);
Begin
x: = (x SHL N) or (x shr (32-n));
End

Procedure FF (var A:dword; b, C, D, X:dword; s:byte; ac:dword);
Begin
Inc. (A, F (b, C, D) + x + AC);
Rot (A, s);
Inc. (A, b);
End

Procedure GG (var A:dword; b, C, D, X:dword; s:byte; ac:dword);
Begin
Inc. (A, G (b, C, D) + x + AC);
Rot (A, s);
Inc. (A, b);
End

Procedure HH (var A:dword; b, C, D, X:dword; s:byte; ac:dword);
Begin
Inc. (A, H (b, C, D) + x + AC);
Rot (A, s);
Inc. (A, b);
End

Procedure II (var A:dword; b, C, D, X:dword; s:byte; ac:dword);
Begin
Inc. (A, I (b, C, D) + x + AC);
Rot (A, s);
Inc. (A, b);
End

Procedure Encode (Source, Target:pointer; Count:longword);
Var
S:pbyte;
T:pdword;
I:longword;
Begin
s: = Source;
T: = Target;
For I: = 1 to Count Div 4 do
Begin
t^: = s^;
Inc (s);
t^: = t^ or (s^ SHL 8);
Inc (s);
t^: = t^ or (s^ SHL 16);
Inc (s);
t^: = t^ or (s^ SHL 24);
Inc (s);
Inc (T);
End
End

Procedure Decode (Source, Target:pointer; Count:longword);
Var
S:pdword;
T:pbyte;
I:longword;
Begin
s: = Source;
T: = Target;
For I: = 1 to Count do
Begin
t^: = s^ and $FF;
Inc (T);
t^: = (s^ shr 8) and $FF;
Inc (T);
t^: = (s^ shr) and $FF;
Inc (T);
t^: = (s^ shr) and $FF;
Inc (T);
Inc (s);
End
End

Procedure Transform (Buffer:pointer; var state:md5state);
Var
A, B, C, D:dword;
Block:md5block;
Begin
Encode (Buffer, @Block, 64);
A: = State[0];
B: = state[1];
c: = state[2];
D: = State[3];
FF (A, B, C, D, Block[0], 7, $D 76aa478);
FF (D, A, B, C, block[1], $E 8c7b756);
FF (c, D, A, B, block[2], $242070db);
FF (b, C, D, A, block[3], $C 1BDCEEE);
FF (A, B, C, D, Block[4], 7, $F 57C0FAF);
FF (D, A, B, C, block[5], $4787c62a);
FF (c, D, A, B, block[6], $A 8304613);
FF (b, C, D, A, block[7], $FD 469501);
FF (A, B, C, D, Block[8], 7, $698098D8);
FF (D, A, B, C, block[9], $8B44F7AF);
FF (c, D, A, B, block[10], $FFFF 5BB1);
FF (b, C, D, A, block[11], $895cd7be);
FF (A, B, C, D, block[12], 7, $6b901122);
FF (D, A, B, C, block[13], $FD 987193);
FF (c, D, A, B, block[14], $A 679438E);
FF (b, C, D, A, block[15], $49b40821);
GG (A, B, C, D, Block[1], 5, $F 61E2562);
GG (D, A, B, C, block[6], 9, $C 040b340);
GG (c, D, A, B, block[11], $265e5a51);
GG (b, C, D, A, block[0], $E 9B6C7AA);
GG (A, B, C, D, Block[5], 5, $D 62f105d);
GG (D, A, B, C, block[10], 9, $2441453);
GG (c, D, A, B, block[15], $D 8a1e681);
GG (b, C, D, A, block[4], $E 7d3fbc8);
GG (A, B, C, D, Block[9], 5, $21e1cde6);
GG (D, A, B, C, block[14], 9, $C 33707d6);
GG (c, D, A, B, block[3], $F 4d50d87);
GG (b, C, D, A, block[8], $455a14ed);
GG (A, B, C, D, block[13], 5, $A 9e3e905);
GG (D, A, B, C, block[2], 9, $FCEFA 3f8);
GG (c, D, A, B, block[7], $676f02d9);
GG (b, C, D, A, block[12], $8d2a4c8a);
HH (A, B, C, D, Block[5], 4, $FFFA 3942);
HH (D, A, B, C, block[8], one, $8771f681);
HH (c, D, A, B, block[11], $6d9d6122);
HH (b, C, D, A, block[14], $FDE 5380C);
HH (A, B, C, D, Block[1], 4, $A 4beea44);
HH (D, A, B, C, block[4], one, $4bdecfa9);
HH (c, D, A, B, block[7], $F 6bb4b60);
HH (b, C, D, A, block[10], $BEBFBC 70);
HH (A, B, C, D, Block[13], 4, $289B7EC6);
HH (D, A, B, C, block[0], one, $EAA 127FA);
HH (c, D, A, B, block[3], $D 4ef3085);
HH (b, C, D, A, block[6], $4881d05);
HH (A, B, C, D, Block[9], 4, $D 9d4d039);
HH (D, A, B, C, block[12], one, $E 6db99e5);
HH (c, D, A, B, block[15], $1fa27cf8);
HH (b, C, D, A, block[2], $C 4ac5665);
II (A, B, C, D, Block[0], 6, $F 4292244);
II (D, A, B, C, block[7], $432aff97);
II (c, D, A, B, block[14], $AB 9423a7);
II (b, C, D, A, block[5], $FC 93a039);
II (A, B, C, D, block[12], 6, $655B59C3);
II (D, A, B, C, block[3], $8f0ccc92);
II (c, D, A, B, block[10], $FFEFF 47D);
II (b, C, D, A, block[1], $85845DD1);
II (A, B, C, D, Block[8], 6, $6fa87e4f);
II (D, A, B, C, block[15], $FE 2ce6e0);
II (c, D, A, B, block[6], $A 3014314);
II (b, C, D, A, block[13], $4E0811A1);
II (A, B, C, D, Block[4], 6, $F 7537E82);
II (D, A, B, C, block[11], $BD 3af235);
II (c, D, A, B, block[2], $2AD7D2BB);
II (b, C, D, A, block[9], $EB 86d391);
Inc. (State[0], a);
Inc (State[1], b);
Inc (State[2], c);
Inc (State[3], D);
End

Procedure Md5init (var context:md5context);
Begin
With context do
Begin
State[0]: = $67452301;
STATE[1]: = $EFCDAB 89;
STATE[2]: = $98badcfe;
STATE[3]: = $10325476;
Count[0]: = 0;
COUNT[1]: = 0;
ZeroMemory (@Buffer, SizeOf (Md5buffer));
End
End

Procedure Md5update (Var context:md5context; Input:pansichar;
Length:longword);
var
Index:longword;
Partlen:longword;
I:longword;
Begin
With the context do
begin
Index: = (count[0] shr 3) and $3f;
Inc (Count[0], Length SHL 3);
If count[0] < (Length SHL 3) then
Inc (COUNT[1);
Inc (Count[1], Length shr 29);
End;
Partlen: = 64-index;
If Length >= Partlen then
begin
CopyMemory (@Context. Buffer[index], Input, Partlen);
Transform (@Context. Buffer, Context.state);
I: = Partlen;
While I + < Length do
begin
Transform (@Input [I], context.state);
Inc. (I, 64);
End;
Index: = 0;
End
Else
I: = 0;
CopyMemory (@Context. Buffer[index], @Input [I], length-i);
End;

Procedure Md5final (var context:md5context; var digest:md5digest);
Var
Bits:md5cbits;
Index:longword;
Padlen:longword;
Begin
Decode (@Context. Count, @Bits, 2);
Index: = (context.count[0] shr 3) and $3f;
If Index < Then
Padlen: = 56-index
Else
Padlen: = 120-index;
Md5update (context, @PADDING, Padlen);
Md5update (Context, @Bits, 8);
Decode (@Context. State, @Digest, 4);
ZeroMemory (@Context, SizeOf (Md5context));
End

function md5string (m:ansistring): md5digest;
Var
Context:md5context;
Begin
Md5init (context);
Md5update (Context, Pansichar (m), Length (m));
Md5final (context, result);
End

Function Md5file (n:string): md5digest;
var
filehandle:thandle;
Maphandle:thandle;
Viewpointer:pointer;
Context:md5context;
Begin
Md5init (context);
FileHandle: = CreateFile (Pwidechar (widestring (N)), 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
md5update (context, Viewpointer, GetFileSize (FileHandle, nil));
Finally
UnmapViewOfFile (viewpointer);
End
finally
CloseHandle (maphandle);
End
finally
CloseHandle (filehandle);
End
Md5final (context, result);
End;

function Md5print (d:md5digest): ansistring;
Var
I:byte;
Const
Digits:array [0] of Ansichar = (' 0 ', ' 1 ', ' 2 ', ' 3 ', ' 4 ', ' 5 ', ' 6 ', ' 7 '),
' 8 ', ' 9 ', ' A ', ' B ', ' C ', ' d ', ' e ', ' f ';
Begin
Result: = ';
For I: = 0 Todo
Result: = result + digits[(D[i] shr 4) and $0f] + digits[d[i] and $0f];
End

function Md5match (D1, D2:md5digest): boolean;
Var
I:byte;
Begin
I: = 0;
Result: = TRUE;
While the and (I <) do
Begin
Result: = D1[i] = D2[i];
Inc (I);
End
End

function md5s (str:ansistring): ansistring;
Begin
Result: = Md5print (md5string (STR));
End

function md5f (filename:ansistring): ansistring;
Begin
Result: = Md5print (Md5file (FileName));
End