View Code
1 unit XEMD5; 2 3 interface 4 5 uses 6 Winapi.Windows, System.SysUtils,{ Variants,} System.Classes; 7 8 type 9 MD5Count = array [0 .. 1] of DWORD; 10 MD5State = array [0 .. 3] of DWORD; 11 MD5Block = array [0 .. 15] of DWORD; 12 MD5CBits = array [0 .. 7] of Byte; 13 MD5Digest = array [0 .. 15] of Byte; 14 MD5Buffer = array [0 .. 63] of Byte; 15 16 MD5Context = record 17 State: MD5State; 18 Count: MD5Count; 19 Buffer: MD5Buffer; 20 end; 21 22 procedure MD5Init(var Context: MD5Context); 23 procedure MD5Update(var Context: MD5Context; Input: PAnsiChar; Length: longword); 24 procedure MD5Final(var Context: MD5Context; var Digest: MD5Digest); 25 function MD5File(N: String): MD5Digest; 26 function MD5Print(D: MD5Digest): AnsiString; 27 function MD5F(FileName: AnsiString): AnsiString; 28 function MD5S(Str: AnsiString): AnsiString; 29 30 // MD5F为计算文件的MD5值,MD5S为计算字符串的MD5值! 31 var 32 PADDING: MD5Buffer = ($80, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, 33 $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, 34 $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, 35 $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00); 36 37 implementation 38 39 function F(x, y, z: DWORD): DWORD; 40 begin 41 Result := (x and y) or ((not x) and z); 42 end; 43 44 function G(x, y, z: DWORD): DWORD; 45 begin 46 Result := (x and z) or (y and (not z)); 47 end; 48 49 function H(x, y, z: DWORD): DWORD; 50 begin 51 Result := x xor y xor z; 52 end; 53 54 function I(x, y, z: DWORD): DWORD; 55 begin 56 Result := y xor (x or (not z)); 57 end; 58 59 procedure rot(var x: DWORD; N: Byte); 60 begin 61 x := (x shl N) or (x shr (32 - N)); 62 end; 63 64 procedure FF(var a: DWORD; b, c, D, x: DWORD; s: Byte; ac: DWORD); 65 begin 66 inc(a, F(b, c, D) + x + ac); 67 rot(a, s); 68 inc(a, b); 69 end; 70 71 procedure GG(var a: DWORD; b, c, D, x: DWORD; s: Byte; ac: DWORD); 72 begin 73 inc(a, G(b, c, D) + x + ac); 74 rot(a, s); 75 inc(a, b); 76 end; 77 78 procedure HH(var a: DWORD; b, c, D, x: DWORD; s: Byte; ac: DWORD); 79 begin 80 inc(a, H(b, c, D) + x + ac); 81 rot(a, s); 82 inc(a, b); 83 end; 84 85 procedure II(var a: DWORD; b, c, D, x: DWORD; s: Byte; ac: DWORD); 86 begin 87 inc(a, I(b, c, D) + x + ac); 88 rot(a, s); 89 inc(a, b); 90 end; 91 92 procedure Encode(Source, Target: pointer; Count: longword); 93 var 94 s: PByte; 95 T: PDWORD; 96 I: longword; 97 begin 98 s := Source; 99 T := Target; 100 for I := 1 to Count div 4 do 101 begin 102 T^ := s^; 103 inc(s); 104 T^ := T^ or (s^ shl 8); 105 inc(s); 106 T^ := T^ or (s^ shl 16); 107 inc(s); 108 T^ := T^ or (s^ shl 24); 109 inc(s); 110 inc(T); 111 end; 112 end; 113 114 procedure Decode(Source, Target: pointer; Count: longword); 115 var 116 s: PDWORD; 117 T: PByte; 118 I: longword; 119 begin 120 s := Source; 121 T := Target; 122 for I := 1 to Count do 123 begin 124 T^ := s^ and $FF; 125 inc(T); 126 T^ := (s^ shr 8) and $FF; 127 inc(T); 128 T^ := (s^ shr 16) and $FF; 129 inc(T); 130 T^ := (s^ shr 24) and $FF; 131 inc(T); 132 inc(s); 133 end; 134 end; 135 136 procedure Transform(Buffer: pointer; var State: MD5State); 137 var 138 a, b, c, D: DWORD; 139 Block: MD5Block; 140 begin 141 Encode(Buffer, @Block, 64); 142 a := State[0]; 143 b := State[1]; 144 c := State[2]; 145 D := State[3]; 146 FF(a, b, c, D, Block[0], 7, $D76AA478); 147 FF(D, a, b, c, Block[1], 12, $E8C7B756); 148 FF(c, D, a, b, Block[2], 17, $242070DB); 149 FF(b, c, D, a, Block[3], 22, $C1BDCEEE); 150 FF(a, b, c, D, Block[4], 7, $F57C0FAF); 151 FF(D, a, b, c, Block[5], 12, $4787C62A); 152 FF(c, D, a, b, Block[6], 17, $A8304613); 153 FF(b, c, D, a, Block[7], 22, $FD469501); 154 FF(a, b, c, D, Block[8], 7, $698098D8); 155 FF(D, a, b, c, Block[9], 12, $8B44F7AF); 156 FF(c, D, a, b, Block[10], 17, $FFFF5BB1); 157 FF(b, c, D, a, Block[11], 22, $895CD7BE); 158 FF(a, b, c, D, Block[12], 7, $6B901122); 159 FF(D, a, b, c, Block[13], 12, $FD987193); 160 FF(c, D, a, b, Block[14], 17, $A679438E); 161 FF(b, c, D, a, Block[15], 22, $49B40821); 162 GG(a, b, c, D, Block[1], 5, $F61E2562); 163 GG(D, a, b, c, Block[6], 9, $C040B340); 164 GG(c, D, a, b, Block[11], 14, $265E5A51); 165 GG(b, c, D, a, Block[0], 20, $E9B6C7AA); 166 GG(a, b, c, D, Block[5], 5, $D62F105D); 167 GG(D, a, b, c, Block[10], 9, $2441453); 168 GG(c, D, a, b, Block[15], 14, $D8A1E681); 169 GG(b, c, D, a, Block[4], 20, $E7D3FBC8); 170 GG(a, b, c, D, Block[9], 5, $21E1CDE6); 171 GG(D, a, b, c, Block[14], 9, $C33707D6); 172 GG(c, D, a, b, Block[3], 14, $F4D50D87); 173 GG(b, c, D, a, Block[8], 20, $455A14ED); 174 GG(a, b, c, D, Block[13], 5, $A9E3E905); 175 GG(D, a, b, c, Block[2], 9, $FCEFA3F8); 176 GG(c, D, a, b, Block[7], 14, $676F02D9); 177 GG(b, c, D, a, Block[12], 20, $8D2A4C8A); 178 HH(a, b, c, D, Block[5], 4, $FFFA3942); 179 HH(D, a, b, c, Block[8], 11, $8771F681); 180 HH(c, D, a, b, Block[11], 16, $6D9D6122); 181 HH(b, c, D, a, Block[14], 23, $FDE5380C); 182 HH(a, b, c, D, Block[1], 4, $A4BEEA44); 183 HH(D, a, b, c, Block[4], 11, $4BDECFA9); 184 HH(c, D, a, b, Block[7], 16, $F6BB4B60); 185 HH(b, c, D, a, Block[10], 23, $BEBFBC70); 186 HH(a, b, c, D, Block[13], 4, $289B7EC6); 187 HH(D, a, b, c, Block[0], 11, $EAA127FA); 188 HH(c, D, a, b, Block[3], 16, $D4EF3085); 189 HH(b, c, D, a, Block[6], 23, $4881D05); 190 HH(a, b, c, D, Block[9], 4, $D9D4D039); 191 HH(D, a, b, c, Block[12], 11, $E6DB99E5); 192 HH(c, D, a, b, Block[15], 16, $1FA27CF8); 193 HH(b, c, D, a, Block[2], 23, $C4AC5665); 194 II(a, b, c, D, Block[0], 6, $F4292244); 195 II(D, a, b, c, Block[7], 10, $432AFF97); 196 II(c, D, a, b, Block[14], 15, $AB9423A7); 197 II(b, c, D, a, Block[5], 21, $FC93A039); 198 II(a, b, c, D, Block[12], 6, $655B59C3); 199 II(D, a, b, c, Block[3], 10, $8F0CCC92); 200 II(c, D, a, b, Block[10], 15, $FFEFF47D); 201 II(b, c, D, a, Block[1], 21, $85845DD1); 202 II(a, b, c, D, Block[8], 6, $6FA87E4F); 203 II(D, a, b, c, Block[15], 10, $FE2CE6E0); 204 II(c, D, a, b, Block[6], 15, $A3014314); 205 II(b, c, D, a, Block[13], 21, $4E0811A1); 206 II(a, b, c, D, Block[4], 6, $F7537E82); 207 II(D, a, b, c, Block[11], 10, $BD3AF235); 208 II(c, D, a, b, Block[2], 15, $2AD7D2BB); 209 II(b, c, D, a, Block[9], 21, $EB86D391); 210 inc(State[0], a); 211 inc(State[1], b); 212 inc(State[2], c); 213 inc(State[3], D); 214 end; 215 216 procedure MD5Init(var Context: MD5Context); 217 begin 218 with Context do 219 begin 220 State[0] := $67452301; 221 State[1] := $EFCDAB89; 222 State[2] := $98BADCFE; 223 State[3] := $10325476; 224 Count[0] := 0; 225 Count[1] := 0; 226 ZeroMemory(@Buffer, SizeOf(MD5Buffer)); 227 end; 228 end; 229 230 procedure MD5Update(var Context: MD5Context; Input: PAnsiChar; Length: longword); 231 var 232 Index: longword; 233 PartLen: longword; 234 I: longword; 235 begin 236 with Context do 237 begin 238 Index := (Count[0] shr 3) and $3F; 239 inc(Count[0], Length shl 3); 240 if Count[0] < (Length shl 3) then 241 inc(Count[1]); 242 inc(Count[1], Length shr 29); 243 end; 244 PartLen := 64 - Index; 245 if Length >= PartLen then 246 begin 247 CopyMemory(@Context.Buffer[Index], Input, PartLen); 248 Transform(@Context.Buffer, Context.State); 249 I := PartLen; 250 while I + 63 < Length do 251 begin 252 Transform(@Input[I], Context.State); 253 inc(I, 64); 254 end; 255 Index := 0; 256 end 257 else 258 I := 0; 259 CopyMemory(@Context.Buffer[Index], @Input[I], Length - I); 260 end; 261 262 procedure MD5Final(var Context: MD5Context; var Digest: MD5Digest); 263 var 264 Bits: MD5CBits; 265 Index: longword; 266 PadLen: longword; 267 begin 268 Decode(@Context.Count, @Bits, 2); 269 Index := (Context.Count[0] shr 3) and $3F; 270 if Index < 56 then 271 PadLen := 56 - Index 272 else 273 PadLen := 120 - Index; 274 MD5Update(Context, @PADDING, PadLen); 275 MD5Update(Context, @Bits, 8); 276 Decode(@Context.State, @Digest, 4); 277 ZeroMemory(@Context, SizeOf(MD5Context)); 278 end; 279 280 function MD5String(M: AnsiString): MD5Digest; 281 var 282 Context: MD5Context; 283 begin 284 MD5Init(Context); 285 MD5Update(Context, PAnsiChar(M), Length(M)); 286 MD5Final(Context, Result); 287 end; 288 289 function MD5File(N: String): MD5Digest; 290 var 291 FileHandle: THandle; 292 MapHandle: THandle; 293 ViewPointer: pointer; 294 Context: MD5Context; 295 begin 296 MD5Init(Context); 297 FileHandle := CreateFile(PWideChar(WideString(N)), GENERIC_READ, FILE_SHARE_READ or 298 FILE_SHARE_WRITE, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL or FILE_FLAG_SEQUENTIAL_SCAN, 0); 299 300 if FileHandle <> INVALID_HANDLE_VALUE then 301 try 302 MapHandle := CreateFileMapping(FileHandle, nil, PAGE_READONLY, 0, 0, nil); 303 if MapHandle <> 0 then 304 try 305 ViewPointer := MapViewOfFile(MapHandle, FILE_MAP_READ, 0, 0, 0); 306 if ViewPointer <> nil then 307 try 308 MD5Update(Context, ViewPointer, GetFileSize(FileHandle, nil)); 309 finally 310 UnmapViewOfFile(ViewPointer); 311 end; 312 finally 313 CloseHandle(MapHandle); 314 end; 315 finally 316 CloseHandle(FileHandle); 317 end; 318 MD5Final(Context, Result); 319 end; 320 321 function MD5Print(D: MD5Digest): AnsiString; 322 var 323 I: Byte; 324 const 325 Digits: array [0 .. 15] of Ansichar = ('0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'a', 'b', 326 'c', 'd', 'e', 'f'); 327 begin 328 Result := ''; 329 for I := 0 to 15 do 330 Result := Result + Digits[(D[I] shr 4) and $0F] + Digits[D[I] and $0F]; 331 end; 332 333 function MD5Match(D1, D2: MD5Digest): boolean; 334 var 335 I: Byte; 336 begin 337 I := 0; 338 Result := TRUE; 339 while Result and (I < 16) do 340 begin 341 Result := D1[I] = D2[I]; 342 inc(I); 343 end; 344 end; 345 346 function MD5S(Str: AnsiString): AnsiString; 347 begin 348 Result := MD5Print(MD5String(Str)); 349 end; 350 351 function MD5F(FileName: AnsiString): AnsiString; 352 begin 353 Result := MD5Print(MD5File(WideString(FileName))); 354 end; 355 356 end.
//代码来自网络，原作者不详，如。。请联系我处理
