Available MD5 algorithms for delphi xe

Copy codeThe Code is 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 .. 15] of DWORD;
MD5CBits = array [0 .. 7] of Byte;
MD5Digest = array [0 .. 15] of Byte;
MD5Buffer = array [0 .. 63] 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 indicates the MD5 value of the calculated file, and MD5S indicates the MD5 value of the calculated 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 16) and $ FF;
Inc (T );
T ^: = (s ^ shr 24) 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, $ D76AA478 );
FF (D, a, B, c, Block [1], 12, $ E8C7B756 );
FF (c, D, a, B, Block [2], 17, $ 242070DB );
FF (B, c, D, a, Block [3], 22, $ C1BDCEEE );
FF (a, B, c, D, Block [4], 7, $ F57C0FAF );
FF (D, a, B, c, Block [5], 12, $ 4787C62A );
FF (c, D, a, B, Block [6], 17, $ A8304613 );
FF (B, c, D, a, Block [7], 22, $ FD469501 );
FF (a, B, c, D, Block [8], 7, $698098D8 );
FF (D, a, B, c, Block [9], 12, $ 8B44F7AF );
FF (c, D, a, B, Block [10], 17, $ FFFF5BB1 );
FF (B, c, D, a, Block [11], 22, $ 895CD7BE );
FF (a, B, c, D, Block [12], 7, $6B901122 );
FF (D, a, B, c, Block [13], 12, $ FD987193 );
FF (c, D, a, B, Block [14], 17, $ A679438E );
FF (B, c, D, a, Block [15], 22, $49B40821 );
GG (a, B, c, D, Block [1], 5, $ F61E2562 );
GG (D, a, B, c, Block [6], 9, $ C040B340 );
GG (c, D, a, B, Block [11], 14, $265E5A51 );
GG (B, c, D, a, Block [0], 20, $ E9B6C7AA );
GG (a, B, c, D, Block [5], 5, $ D62F105D );
GG (D, a, B, c, Block [10], 9, $2441453 );
GG (c, D, a, B, Block [15], 14, $ D8A1E681 );
GG (B, c, D, a, Block [4], 20, $ E7D3FBC8 );
GG (a, B, c, D, Block [9], 5, $21E1CDE6 );
GG (D, a, B, c, Block [14], 9, $ C33707D6 );
GG (c, D, a, B, Block [3], 14, $ F4D50D87 );
GG (B, c, D, a, Block [8], 20, $ 455A14ED );
GG (a, B, c, D, Block [13], 5, $ A9E3E905 );
GG (D, a, B, c, Block [2], 9, $ FCEFA3F8 );
GG (c, D, a, B, Block [7], 14, $676F02D9 );
GG (B, c, D, a, Block [12], 20, $ 8D2A4C8A );
HH (a, B, c, D, Block [5], 4, $ FFFA3942 );
HH (D, a, B, c, Block [8], 11, $8771F681 );
HH (c, D, a, B, Block [11], 16, $6D9D6122 );
HH (B, c, D, a, Block [14], 23, $ FDE5380C );
HH (a, B, c, D, Block [1], 4, $ A4BEEA44 );
HH (D, a, B, c, Block [4], 11, $4BDECFA9 );
HH (c, D, a, B, Block [7], 16, $ F6BB4B60 );
HH (B, c, D, a, Block [10], 23, $ BEBFBC70 );
HH (a, B, c, D, Block [13], 4, $289B7EC6 );
HH (D, a, B, c, Block [0], 11, $ eaa1_fa );
HH (c, D, a, B, Block [3], 16, $ D4EF3085 );
HH (B, c, D, a, Block [6], 23, $4881D05 );
HH (a, B, c, D, Block [9], 4, $ D9D4D039 );
HH (D, a, B, c, Block [12], 11, $ E6DB99E5 );
HH (c, D, a, B, Block [15], 16, $1FA27CF8 );
HH (B, c, D, a, Block [2], 23, $ C4AC5665 );
II (a, B, c, D, Block [0], 6, $ F4292244 );
II (D, a, B, c, Block [7], 10, $432AFF97 );
II (c, D, a, B, Block [14], 15, $ AB9423A7 );
II (B, c, D, a, Block [5], 21, $ FC93A039 );
II (a, B, c, D, Block [12], 6, $655B59C3 );
II (D, a, B, c, Block [3], 10, $8F0CCC92 );
II (c, D, a, B, Block [10], 15, $ FFEFF47D );
II (B, c, D, a, Block [1], 21, $85845DD1 );
II (a, B, c, D, Block [8], 6, $ 6FA87E4F );
II (D, a, B, c, Block [15], 10, $ FE2CE6E0 );
II (c, D, a, B, Block [6], 15, $ A3014314 );
II (B, c, D, a, Block [13], 21, $4E0811A1 );
II (a, B, c, D, Block [4], 6, $ F7537E82 );
II (D, a, B, c, Block [11], 10, $ BD3AF235 );
II (c, D, a, B, Block [2], 15, $ 2AD7D2BB );
II (B, c, D, a, Block [9], 21, $ EB86D391 );
Inc (State [0], );
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]: = $ EFCDAB89;
State [2]: = $98 BADCFE;
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 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 + 63 <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 <56 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_cmd_read or file_cmd_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 .. 15] of Ansichar = ('0', '1', '2', '3', '4', '5', '6', '7 ',
'8', '9', 'A', 'B', 'C', 'D', 'E', 'F ');
Begin
Result: = '';
For I: = 0 to 15 do
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 Result and (I <16) 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 (string (FileName )));
End;