Unit MD5;
/ / -------------------------------------------------------------------------------------------- ---------------------------------------------- Interface // -------------------------------------------------- ---------------------------------------------
Uses windows;
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;
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;
/ / -------------------------------------------------------------------------------------------- ----------------------------------------------- Implementation // -------------------------------------------------- ---------------------------------------------
Var Padding: MD5Buffer = ($ 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);
Function G (X, Y, Z: DWORD): DWORD; Begin Result: = (x and z) OR (Y AND (NOT Z));
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); recomgin x: = (x SHL N) or (x Shr (32 - n));
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;
/ / -------------------------------------------------------------------------------------------- -----------------------------------------------
// Encode Count Bytes At Source Into (Count / 4) DWORDS At TargetProcedure 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;
// Decode Count DWORDS at Source Into (Count * 4) Bytes At TargetProcedure 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 ^: = (S ^ SHR 16) AND $ FF; INC; T ^: = (S ^ SHR 24) AND $ FF; INC (T); Inc (s); end; end;
// Transform State According to First 64 BYtes At BufferProcedure 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, $ d76a478 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, $ fff5bb1); 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, $ EAA127FA); 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 , 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], A); INC (State [1], B); INC (State [2], C); Inc (State [3], D); end; // ---------------- -------------------------------------------------- -----------------------------
// Initialize Given ContextProcedure Md5init (VAR Context: MD5Context); Begin with Context Do Begin State [0]: = $ 67452301; state [1]: = $ EFCDAB89; State [2]: = $ 98badcfe; state [3]: = $ 10325476; Count [0]: = 0; Count [1]: = 0; ZeroMemory (@Buffer, SizeOf (MD5Buffer)); end; end; // Update given Context to include Length bytes of Inputprocedure MD5Update (var Context: MD5Context Input: pChar; Length: longword; var index: longword; partlen: longword; i: longword; begin with context do beg, index: = (count [0] shr 3) And $ 3f; inc; 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 dam CopyMemory (@ context.buffer); transform (@ context.buffer, context.state); i: = partlen; while i 63 // Finalize given Context, create Digest and zeroize Contextprocedure 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 , @BITS, 8); DECODE (@ context.state, @digest, 4); zeromemory (@Context, SizeOf (MD5Context)); / / -------------------------------------------------------------------------------------------- ----------------------------------------------- // Create digest of given Messagefunction 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 Namefunction MD5File (N: string): MD5Digest; var FileHandle: THandle; MapHandle: THandle; ViewPointer: pointer; Context: MD5Context; begin MD5Init (Context); FileHandle: = CreateFile (pChar (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 (Fil Endle); end; md5final (context, result); // Create HEX REPRESENTATION OF GIVEN DIGESTFUNCTION 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]; / / -------------------------------------------------------------------------------------------- ----------------------------------------------- // Compare Two DigestsFunction 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; end.
