MD5 Delphi source code

// Tabs = 2
// Configure //-----------------------------------------------------------------------------------------------
//
// MD5 message-digest for Delphi 4
//
// Delphi 4 unit implementing
// RSA Data Security, Inc. MD5 message-Digest algorithm
//
// Implementation of Ronald L. Rivest's RFC 1321.
//
// Copyright? 1997-1999 medienagentur fichtner & Meyer
// Written by Matthias fichtner
//
// Configure //-----------------------------------------------------------------------------------------------
// See RFC 1321 for RSA Data Security's copyright and license notice!
// Configure //-----------------------------------------------------------------------------------------------
//
// 14-jun-97 MF implemented MD5 according to RFC 1321 RFC 1321
// 16-jun-97 MF initial release of the compiled unit (no source code) RFC 1321
// 28-feb-99 MF added md5match function for comparing two digests RFC 1321.
// 13-sep-99 MF reworked the entire unit RFC 1321.
// 17-sep-99 MF reworked the "test driver" project RFC 1321
// 19-sep-99 MF release of sources for MD5 unit and "test driver" project RFC 1321
//
// Configure //-----------------------------------------------------------------------------------------------
// The latest release of md5.pas will always be available from
// The distribution site at: http://www.fichtner.net/delphi/md5/
// Configure //-----------------------------------------------------------------------------------------------
// Please send questions, bug reports and Suggestions
// Regarding this code to: mfichtner@fichtner-meyer.com
// Configure //-----------------------------------------------------------------------------------------------
// This code is provided "as is" without express or
// Implied warranty of any kind. Use it at your own risk.
// Configure //-----------------------------------------------------------------------------------------------

Unit MD5;

{$ Warnings off}

// Configure //-----------------------------------------------------------------------------------------------
Interface
// Configure //-----------------------------------------------------------------------------------------------

Uses
Windows, dialogs;

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: pchar; Length: longword );
Procedure md5final (VAR context: md5context; var Digest: md5digest );

Function md5string (M: string): md5digest;
Function md5file (N: string): md5digest;
Function md5print (D: md5digest): string;

Function md5match (D1, D2: md5digest): Boolean;

// Added by crazy worm 2005.6.7
Function md5digesttostring (D: md5digest): string;
Function md5stringtodigest (M: string): md5digest;
Function stringtomd5string (M: string): string;

// Configure //-----------------------------------------------------------------------------------------------
Implementation
// Configure //-----------------------------------------------------------------------------------------------

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
);

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;

// Configure //-----------------------------------------------------------------------------------------------

// encode count bytes at source into (count/4) Dwords at target
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;

// Decode count Dwords at source into (count * 4) bytes at Target
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;

// Transform State according to first 64 bytes at Buffer
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;

// Configure //-----------------------------------------------------------------------------------------------

// Initialize given context
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;

// Update given context to include length bytes of input
Procedure md5update (VAR context: md5context; input: pchar; 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;

// Finalize given context, create digest and zeroize Context
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;

// Configure //-----------------------------------------------------------------------------------------------

// Create digest of given message
Function md5string (M: string): md5digest;
VaR
Context: md5context;
Begin
Md5init (context );
Md5update (context, pchar (M), length (m ));
Md5final (context, result );
End;

// Create digest of file with given name
Function md5file (N: string): md5digest;
VaR
Filehandle: thandle;
Maphandle: thandle;
Viewpointer: pointer;
Context: md5context;
Begin
Md5init (context );
Filehandle: = createfile (pchar (N), generic_read, file_1__read or file_1__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;

// Create hex representation of given Digest
Function md5print (D: md5digest): string;
VaR
I: byte;
Const
Digits: array [0 .. 15] of char =
('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;

// Configure //-----------------------------------------------------------------------------------------------

// Compare two digests
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 md5digesttostring (D: md5digest): string;
VaR
I: byte;
Const
Digits: array [0 .. 15] of char =
('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 md5stringtodigest (M: string): md5digest;
VaR
I, j, H1, H2: byte;
MD5: md5digest;
Begin
If length (m) <16 then
Begin
Result: = MD5;
Exit;
End;
For I: = 0 to 15 do
Begin
J: = (I shl 1) + 1;
H1: = byte (M [J]);
If h1> $60 then H1: = h1-$61 + $
Else H1: = h1-$30;
H2: = byte (M [J + 1]);
If H2> $60 then H2: = h2-$61 + $
Else H2: = h2-$30;
MD5 [I]: = (H1 SHL 4) + H2;
End;
Result: = MD5;
End;

Function stringtomd5string (M: string): string;
VaR
D: md5digest;
Begin
D: = md5string (m );
Result: = md5digesttostring (d );
End;

End.