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;
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;
// -----------------------------------------------------------------------------------------------
implementation
// -----------------------------------------------------------------------------------------------
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;
// -----------------------------------------------------------------------------------------------
// 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;
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, $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, 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], a);
inc(state[1], b);
inc(state[2], c);
inc(state[3], d);
end;
// -----------------------------------------------------------------------------------------------
// initialize given context
procedure 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 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;
// -----------------------------------------------------------------------------------------------
// 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_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(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;
// -----------------------------------------------------------------------------------------------
// 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;
end.
Java Asp PHP .Net XML C/C++ CGI VB Jsp J2ee J2se J2me EJB Servlet Tomcat Resin Struts Weblogic Eclipse ANT GUI JMS Web servise IDEA Webphere Hibernate Spring Jboss Applet Swing Socket Javamail Perl Ajax P2P 安全 模式 框架 测试 开源 游戏
Windows XP Windows 2000 Windows 2003 Windows Me Windows 9.x Linux UNIX 注册表 操作系统 服务器 应用服务器