Rev 9 | Details | Compare with Previous | Last modification | View Log | RSS feed
| Rev | Author | Line No. | Line |
|---|---|---|---|
| 9 | daniel-mar | 1 | // tabs = 2 |
| 2 | // ----------------------------------------------------------------------------------------------- |
||
| 3 | // |
||
| 4 | // MD5 Message-Digest for Delphi 4 |
||
| 5 | // |
||
| 6 | // Delphi 4 Unit implementing the |
||
| 7 | // RSA Data Security, Inc. MD5 Message-Digest Algorithm |
||
| 8 | // |
||
| 9 | // Implementation of Ronald L. Rivest's RFC 1321 |
||
| 10 | // |
||
| 11 | // Copyright 1997-1999 Medienagentur Fichtner & Meyer |
||
| 12 | // Written by Matthias Fichtner |
||
| 13 | // |
||
| 14 | // ----------------------------------------------------------------------------------------------- |
||
| 15 | // See RFC 1321 for RSA Data Security's copyright and license notice! |
||
| 16 | // ----------------------------------------------------------------------------------------------- |
||
| 17 | // |
||
| 18 | // 14-Jun-97 mf Implemented MD5 according to RFC 1321 RFC 1321 |
||
| 19 | // 16-Jun-97 mf Initial release of the compiled unit (no source code) RFC 1321 |
||
| 20 | // 28-Feb-99 mf Added MD5Match function for comparing two digests RFC 1321 |
||
| 21 | // 13-Sep-99 mf Reworked the entire unit RFC 1321 |
||
| 22 | // 17-Sep-99 mf Reworked the "Test Driver" project RFC 1321 |
||
| 23 | // 19-Sep-99 mf Release of sources for MD5 unit and "Test Driver" project RFC 1321 |
||
| 24 | // |
||
| 25 | // ----------------------------------------------------------------------------------------------- |
||
| 26 | // The latest release of md5.pas will always be available from |
||
| 27 | // the distribution site at: http://www.fichtner.net/delphi/md5/ |
||
| 28 | // ----------------------------------------------------------------------------------------------- |
||
| 29 | // Please send questions, bug reports and suggestions |
||
| 30 | // regarding this code to: mfichtner@fichtner-meyer.com |
||
| 31 | // ----------------------------------------------------------------------------------------------- |
||
| 32 | // This code is provided "as is" without express or |
||
| 33 | // implied warranty of any kind. Use it at your own risk. |
||
| 34 | // ----------------------------------------------------------------------------------------------- |
||
| 35 | |||
| 36 | unit md5; |
||
| 37 | |||
| 38 | // ----------------------------------------------------------------------------------------------- |
||
| 39 | INTERFACE |
||
| 40 | // ----------------------------------------------------------------------------------------------- |
||
| 41 | |||
| 42 | uses |
||
| 43 | Windows; |
||
| 44 | |||
| 45 | type |
||
| 46 | MD5Count = array[0..1] of DWORD; |
||
| 47 | MD5State = array[0..3] of DWORD; |
||
| 48 | MD5Block = array[0..15] of DWORD; |
||
| 49 | MD5CBits = array[0..7] of byte; |
||
| 50 | MD5Digest = array[0..15] of byte; |
||
| 51 | MD5Buffer = array[0..63] of byte; |
||
| 52 | MD5Context = record |
||
| 53 | State: MD5State; |
||
| 54 | Count: MD5Count; |
||
| 55 | Buffer: MD5Buffer; |
||
| 56 | end; |
||
| 57 | |||
| 58 | procedure MD5Init(var Context: MD5Context); |
||
| 59 | procedure MD5Update(var Context: MD5Context; Input: pChar; Length: longword); |
||
| 60 | procedure MD5Final(var Context: MD5Context; var Digest: MD5Digest); |
||
| 61 | |||
| 62 | function MD5String(M: string): MD5Digest; |
||
| 63 | function MD5File(N: string): MD5Digest; |
||
| 64 | function MD5Print(D: MD5Digest): string; |
||
| 65 | |||
| 66 | function MD5Match(D1, D2: MD5Digest): boolean; |
||
| 67 | |||
| 68 | // ----------------------------------------------------------------------------------------------- |
||
| 69 | IMPLEMENTATION |
||
| 70 | // ----------------------------------------------------------------------------------------------- |
||
| 71 | |||
| 72 | var |
||
| 73 | PADDING: MD5Buffer = ( |
||
| 74 | $80, $00, $00, $00, $00, $00, $00, $00, |
||
| 75 | $00, $00, $00, $00, $00, $00, $00, $00, |
||
| 76 | $00, $00, $00, $00, $00, $00, $00, $00, |
||
| 77 | $00, $00, $00, $00, $00, $00, $00, $00, |
||
| 78 | $00, $00, $00, $00, $00, $00, $00, $00, |
||
| 79 | $00, $00, $00, $00, $00, $00, $00, $00, |
||
| 80 | $00, $00, $00, $00, $00, $00, $00, $00, |
||
| 81 | $00, $00, $00, $00, $00, $00, $00, $00 |
||
| 82 | ); |
||
| 83 | |||
| 84 | function F(x, y, z: DWORD): DWORD; |
||
| 85 | begin |
||
| 86 | Result := (x and y) or ((not x) and z); |
||
| 87 | end; |
||
| 88 | |||
| 89 | function G(x, y, z: DWORD): DWORD; |
||
| 90 | begin |
||
| 91 | Result := (x and z) or (y and (not z)); |
||
| 92 | end; |
||
| 93 | |||
| 94 | function H(x, y, z: DWORD): DWORD; |
||
| 95 | begin |
||
| 96 | Result := x xor y xor z; |
||
| 97 | end; |
||
| 98 | |||
| 99 | function I(x, y, z: DWORD): DWORD; |
||
| 100 | begin |
||
| 101 | Result := y xor (x or (not z)); |
||
| 102 | end; |
||
| 103 | |||
| 104 | procedure rot(var x: DWORD; n: BYTE); |
||
| 105 | begin |
||
| 106 | x := (x shl n) or (x shr (32 - n)); |
||
| 107 | end; |
||
| 108 | |||
| 109 | procedure FF(var a: DWORD; b, c, d, x: DWORD; s: BYTE; ac: DWORD); |
||
| 110 | begin |
||
| 111 | inc(a, F(b, c, d) + x + ac); |
||
| 112 | rot(a, s); |
||
| 113 | inc(a, b); |
||
| 114 | end; |
||
| 115 | |||
| 116 | procedure GG(var a: DWORD; b, c, d, x: DWORD; s: BYTE; ac: DWORD); |
||
| 117 | begin |
||
| 118 | inc(a, G(b, c, d) + x + ac); |
||
| 119 | rot(a, s); |
||
| 120 | inc(a, b); |
||
| 121 | end; |
||
| 122 | |||
| 123 | procedure HH(var a: DWORD; b, c, d, x: DWORD; s: BYTE; ac: DWORD); |
||
| 124 | begin |
||
| 125 | inc(a, H(b, c, d) + x + ac); |
||
| 126 | rot(a, s); |
||
| 127 | inc(a, b); |
||
| 128 | end; |
||
| 129 | |||
| 130 | procedure II(var a: DWORD; b, c, d, x: DWORD; s: BYTE; ac: DWORD); |
||
| 131 | begin |
||
| 132 | inc(a, I(b, c, d) + x + ac); |
||
| 133 | rot(a, s); |
||
| 134 | inc(a, b); |
||
| 135 | end; |
||
| 136 | |||
| 137 | // ----------------------------------------------------------------------------------------------- |
||
| 138 | |||
| 139 | // Encode Count bytes at Source into (Count / 4) DWORDs at Target |
||
| 140 | procedure Encode(Source, Target: pointer; Count: longword); |
||
| 141 | var |
||
| 142 | S: PByte; |
||
| 143 | T: PDWORD; |
||
| 144 | I: longword; |
||
| 145 | begin |
||
| 146 | S := Source; |
||
| 147 | T := Target; |
||
| 148 | for I := 1 to Count div 4 do begin |
||
| 149 | T^ := S^; |
||
| 150 | inc(S); |
||
| 151 | T^ := T^ or (S^ shl 8); |
||
| 152 | inc(S); |
||
| 153 | T^ := T^ or (S^ shl 16); |
||
| 154 | inc(S); |
||
| 155 | T^ := T^ or (S^ shl 24); |
||
| 156 | inc(S); |
||
| 157 | inc(T); |
||
| 158 | end; |
||
| 159 | end; |
||
| 160 | |||
| 161 | // Decode Count DWORDs at Source into (Count * 4) Bytes at Target |
||
| 162 | procedure Decode(Source, Target: pointer; Count: longword); |
||
| 163 | var |
||
| 164 | S: PDWORD; |
||
| 165 | T: PByte; |
||
| 166 | I: longword; |
||
| 167 | begin |
||
| 168 | S := Source; |
||
| 169 | T := Target; |
||
| 170 | for I := 1 to Count do begin |
||
| 171 | T^ := S^ and $ff; |
||
| 172 | inc(T); |
||
| 173 | T^ := (S^ shr 8) and $ff; |
||
| 174 | inc(T); |
||
| 175 | T^ := (S^ shr 16) and $ff; |
||
| 176 | inc(T); |
||
| 177 | T^ := (S^ shr 24) and $ff; |
||
| 178 | inc(T); |
||
| 179 | inc(S); |
||
| 180 | end; |
||
| 181 | end; |
||
| 182 | |||
| 183 | // Transform State according to first 64 bytes at Buffer |
||
| 184 | procedure Transform(Buffer: pointer; var State: MD5State); |
||
| 185 | var |
||
| 186 | a, b, c, d: DWORD; |
||
| 187 | Block: MD5Block; |
||
| 188 | begin |
||
| 189 | Encode(Buffer, @Block, 64); |
||
| 190 | a := State[0]; |
||
| 191 | b := State[1]; |
||
| 192 | c := State[2]; |
||
| 193 | d := State[3]; |
||
| 194 | FF (a, b, c, d, Block[ 0], 7, $d76aa478); |
||
| 195 | FF (d, a, b, c, Block[ 1], 12, $e8c7b756); |
||
| 196 | FF (c, d, a, b, Block[ 2], 17, $242070db); |
||
| 197 | FF (b, c, d, a, Block[ 3], 22, $c1bdceee); |
||
| 198 | FF (a, b, c, d, Block[ 4], 7, $f57c0faf); |
||
| 199 | FF (d, a, b, c, Block[ 5], 12, $4787c62a); |
||
| 200 | FF (c, d, a, b, Block[ 6], 17, $a8304613); |
||
| 201 | FF (b, c, d, a, Block[ 7], 22, $fd469501); |
||
| 202 | FF (a, b, c, d, Block[ 8], 7, $698098d8); |
||
| 203 | FF (d, a, b, c, Block[ 9], 12, $8b44f7af); |
||
| 204 | FF (c, d, a, b, Block[10], 17, $ffff5bb1); |
||
| 205 | FF (b, c, d, a, Block[11], 22, $895cd7be); |
||
| 206 | FF (a, b, c, d, Block[12], 7, $6b901122); |
||
| 207 | FF (d, a, b, c, Block[13], 12, $fd987193); |
||
| 208 | FF (c, d, a, b, Block[14], 17, $a679438e); |
||
| 209 | FF (b, c, d, a, Block[15], 22, $49b40821); |
||
| 210 | GG (a, b, c, d, Block[ 1], 5, $f61e2562); |
||
| 211 | GG (d, a, b, c, Block[ 6], 9, $c040b340); |
||
| 212 | GG (c, d, a, b, Block[11], 14, $265e5a51); |
||
| 213 | GG (b, c, d, a, Block[ 0], 20, $e9b6c7aa); |
||
| 214 | GG (a, b, c, d, Block[ 5], 5, $d62f105d); |
||
| 215 | GG (d, a, b, c, Block[10], 9, $2441453); |
||
| 216 | GG (c, d, a, b, Block[15], 14, $d8a1e681); |
||
| 217 | GG (b, c, d, a, Block[ 4], 20, $e7d3fbc8); |
||
| 218 | GG (a, b, c, d, Block[ 9], 5, $21e1cde6); |
||
| 219 | GG (d, a, b, c, Block[14], 9, $c33707d6); |
||
| 220 | GG (c, d, a, b, Block[ 3], 14, $f4d50d87); |
||
| 221 | GG (b, c, d, a, Block[ 8], 20, $455a14ed); |
||
| 222 | GG (a, b, c, d, Block[13], 5, $a9e3e905); |
||
| 223 | GG (d, a, b, c, Block[ 2], 9, $fcefa3f8); |
||
| 224 | GG (c, d, a, b, Block[ 7], 14, $676f02d9); |
||
| 225 | GG (b, c, d, a, Block[12], 20, $8d2a4c8a); |
||
| 226 | HH (a, b, c, d, Block[ 5], 4, $fffa3942); |
||
| 227 | HH (d, a, b, c, Block[ 8], 11, $8771f681); |
||
| 228 | HH (c, d, a, b, Block[11], 16, $6d9d6122); |
||
| 229 | HH (b, c, d, a, Block[14], 23, $fde5380c); |
||
| 230 | HH (a, b, c, d, Block[ 1], 4, $a4beea44); |
||
| 231 | HH (d, a, b, c, Block[ 4], 11, $4bdecfa9); |
||
| 232 | HH (c, d, a, b, Block[ 7], 16, $f6bb4b60); |
||
| 233 | HH (b, c, d, a, Block[10], 23, $bebfbc70); |
||
| 234 | HH (a, b, c, d, Block[13], 4, $289b7ec6); |
||
| 235 | HH (d, a, b, c, Block[ 0], 11, $eaa127fa); |
||
| 236 | HH (c, d, a, b, Block[ 3], 16, $d4ef3085); |
||
| 237 | HH (b, c, d, a, Block[ 6], 23, $4881d05); |
||
| 238 | HH (a, b, c, d, Block[ 9], 4, $d9d4d039); |
||
| 239 | HH (d, a, b, c, Block[12], 11, $e6db99e5); |
||
| 240 | HH (c, d, a, b, Block[15], 16, $1fa27cf8); |
||
| 241 | HH (b, c, d, a, Block[ 2], 23, $c4ac5665); |
||
| 242 | II (a, b, c, d, Block[ 0], 6, $f4292244); |
||
| 243 | II (d, a, b, c, Block[ 7], 10, $432aff97); |
||
| 244 | II (c, d, a, b, Block[14], 15, $ab9423a7); |
||
| 245 | II (b, c, d, a, Block[ 5], 21, $fc93a039); |
||
| 246 | II (a, b, c, d, Block[12], 6, $655b59c3); |
||
| 247 | II (d, a, b, c, Block[ 3], 10, $8f0ccc92); |
||
| 248 | II (c, d, a, b, Block[10], 15, $ffeff47d); |
||
| 249 | II (b, c, d, a, Block[ 1], 21, $85845dd1); |
||
| 250 | II (a, b, c, d, Block[ 8], 6, $6fa87e4f); |
||
| 251 | II (d, a, b, c, Block[15], 10, $fe2ce6e0); |
||
| 252 | II (c, d, a, b, Block[ 6], 15, $a3014314); |
||
| 253 | II (b, c, d, a, Block[13], 21, $4e0811a1); |
||
| 254 | II (a, b, c, d, Block[ 4], 6, $f7537e82); |
||
| 255 | II (d, a, b, c, Block[11], 10, $bd3af235); |
||
| 256 | II (c, d, a, b, Block[ 2], 15, $2ad7d2bb); |
||
| 257 | II (b, c, d, a, Block[ 9], 21, $eb86d391); |
||
| 258 | inc(State[0], a); |
||
| 259 | inc(State[1], b); |
||
| 260 | inc(State[2], c); |
||
| 261 | inc(State[3], d); |
||
| 262 | end; |
||
| 263 | |||
| 264 | // ----------------------------------------------------------------------------------------------- |
||
| 265 | |||
| 266 | // Initialize given Context |
||
| 267 | procedure MD5Init(var Context: MD5Context); |
||
| 268 | begin |
||
| 269 | with Context do begin |
||
| 270 | State[0] := $67452301; |
||
| 271 | State[1] := $efcdab89; |
||
| 272 | State[2] := $98badcfe; |
||
| 273 | State[3] := $10325476; |
||
| 274 | Count[0] := 0; |
||
| 275 | Count[1] := 0; |
||
| 276 | ZeroMemory(@Buffer, SizeOf(MD5Buffer)); |
||
| 277 | end; |
||
| 278 | end; |
||
| 279 | |||
| 280 | // Update given Context to include Length bytes of Input |
||
| 281 | procedure MD5Update(var Context: MD5Context; Input: pChar; Length: longword); |
||
| 282 | var |
||
| 283 | Index: longword; |
||
| 284 | PartLen: longword; |
||
| 285 | I: longword; |
||
| 286 | begin |
||
| 287 | with Context do begin |
||
| 288 | Index := (Count[0] shr 3) and $3f; |
||
| 289 | inc(Count[0], Length shl 3); |
||
| 290 | if Count[0] < (Length shl 3) then inc(Count[1]); |
||
| 291 | inc(Count[1], Length shr 29); |
||
| 292 | end; |
||
| 293 | PartLen := 64 - Index; |
||
| 294 | if Length >= PartLen then begin |
||
| 295 | CopyMemory(@Context.Buffer[Index], Input, PartLen); |
||
| 296 | Transform(@Context.Buffer, Context.State); |
||
| 297 | I := PartLen; |
||
| 298 | while I + 63 < Length do begin |
||
| 299 | Transform(@Input[I], Context.State); |
||
| 300 | inc(I, 64); |
||
| 301 | end; |
||
| 302 | Index := 0; |
||
| 303 | end else I := 0; |
||
| 304 | CopyMemory(@Context.Buffer[Index], @Input[I], Length - I); |
||
| 305 | end; |
||
| 306 | |||
| 307 | // Finalize given Context, create Digest and zeroize Context |
||
| 308 | procedure MD5Final(var Context: MD5Context; var Digest: MD5Digest); |
||
| 309 | var |
||
| 310 | Bits: MD5CBits; |
||
| 311 | Index: longword; |
||
| 312 | PadLen: longword; |
||
| 313 | begin |
||
| 314 | Decode(@Context.Count, @Bits, 2); |
||
| 315 | Index := (Context.Count[0] shr 3) and $3f; |
||
| 316 | if Index < 56 then PadLen := 56 - Index else PadLen := 120 - Index; |
||
| 317 | MD5Update(Context, @PADDING, PadLen); |
||
| 318 | MD5Update(Context, @Bits, 8); |
||
| 319 | Decode(@Context.State, @Digest, 4); |
||
| 320 | ZeroMemory(@Context, SizeOf(MD5Context)); |
||
| 321 | end; |
||
| 322 | |||
| 323 | // ----------------------------------------------------------------------------------------------- |
||
| 324 | |||
| 325 | // Create digest of given Message |
||
| 326 | function MD5String(M: string): MD5Digest; |
||
| 327 | var |
||
| 328 | Context: MD5Context; |
||
| 329 | begin |
||
| 330 | MD5Init(Context); |
||
| 331 | MD5Update(Context, pChar(M), length(M)); |
||
| 332 | MD5Final(Context, Result); |
||
| 333 | end; |
||
| 334 | |||
| 335 | // Create digest of file with given Name |
||
| 336 | function MD5File(N: string): MD5Digest; |
||
| 337 | var |
||
| 338 | FileHandle: THandle; |
||
| 339 | MapHandle: THandle; |
||
| 340 | ViewPointer: pointer; |
||
| 341 | Context: MD5Context; |
||
| 342 | begin |
||
| 343 | MD5Init(Context); |
||
| 344 | FileHandle := CreateFile(pChar(N), GENERIC_READ, FILE_SHARE_READ or FILE_SHARE_WRITE, |
||
| 345 | nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL or FILE_FLAG_SEQUENTIAL_SCAN, 0); |
||
| 346 | if FileHandle <> INVALID_HANDLE_VALUE then try |
||
| 347 | MapHandle := CreateFileMapping(FileHandle, nil, PAGE_READONLY, 0, 0, nil); |
||
| 348 | if MapHandle <> 0 then try |
||
| 349 | ViewPointer := MapViewOfFile(MapHandle, FILE_MAP_READ, 0, 0, 0); |
||
| 350 | if ViewPointer <> nil then try |
||
| 351 | MD5Update(Context, ViewPointer, GetFileSize(FileHandle, nil)); |
||
| 352 | finally |
||
| 353 | UnmapViewOfFile(ViewPointer); |
||
| 354 | end; |
||
| 355 | finally |
||
| 356 | CloseHandle(MapHandle); |
||
| 357 | end; |
||
| 358 | finally |
||
| 359 | CloseHandle(FileHandle); |
||
| 360 | end; |
||
| 361 | MD5Final(Context, Result); |
||
| 362 | end; |
||
| 363 | |||
| 364 | // Create hex representation of given Digest |
||
| 365 | function MD5Print(D: MD5Digest): string; |
||
| 366 | var |
||
| 367 | I: byte; |
||
| 368 | const |
||
| 369 | Digits: array[0..15] of char = |
||
| 370 | ('0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'a', 'b', 'c', 'd', 'e', 'f'); |
||
| 371 | begin |
||
| 372 | Result := ''; |
||
| 373 | for I := 0 to 15 do Result := Result + Digits[(D[I] shr 4) and $0f] + Digits[D[I] and $0f]; |
||
| 374 | end; |
||
| 375 | |||
| 376 | // ----------------------------------------------------------------------------------------------- |
||
| 377 | |||
| 378 | // Compare two Digests |
||
| 379 | function MD5Match(D1, D2: MD5Digest): boolean; |
||
| 380 | var |
||
| 381 | I: byte; |
||
| 382 | begin |
||
| 383 | I := 0; |
||
| 384 | Result := TRUE; |
||
| 385 | while Result and (I < 16) do begin |
||
| 386 | Result := D1[I] = D2[I]; |
||
| 387 | inc(I); |
||
| 388 | end; |
||
| 389 | end; |
||
| 390 | |||
| 391 | end. |
||
| 392 |