在delphi7+indy 10下如何实现MD5加密?

storm4566 2005-08-11 10:55:55
我装的是indy10,在indy mic控件页里为什么没有IdCoderMD5控件?该如何实现?有没有可供直接调用的DLL,有的话请给提供一个,谢谢!
...全文
380 7 打赏 收藏 转发到动态 举报
写回复
用AI写文章
7 条回复
切换为时间正序
请发表友善的回复…
发表回复
chenchangfu 2005-08-12
  • 打赏
  • 举报
回复
别人写的,我现在也在用
chenchangfu 2005-08-12
  • 打赏
  • 举报
回复
if (lX4 or lY4) <> 0 then
begin
if (lResult and $40000000) <>0 then
begin result := (lResult xor $C0000000 xor lX8 xor lY8); end
else
begin result := (lResult xor $40000000 xor lX8 xor lY8); end
end
else
begin result := (lResult xor lX8 xor lY8); end
end;

function F(x,y,z:integer):integer; begin result := (x and y) or (( not x) and z); end;
function G(x,y,z:integer):integer; begin result := (x and z) or (y and ( not z)); end;
function H(x,y,z:integer):integer; begin result := (x xor y xor z); end;
function I(x,y,z:integer):integer; begin result := (y xor (x or ( not z))); end;

function FF(a,b,c,d,x,s,ac:integer):integer;
begin
a := AddUnsigned(a, AddUnsigned(AddUnsigned(F(b, c, d), x), ac));
result := AddUnsigned(RotateLeft(a, s), b);
end;
function GG(a,b,c,d,x,s,ac:integer):integer;
begin
a := AddUnsigned(a, AddUnsigned(AddUnsigned(G(b, c, d), x), ac));
result := AddUnsigned(RotateLeft(a, s), b);
end;
function HH(a,b,c,d,x,s,ac:integer):integer;
begin
a := AddUnsigned(a, AddUnsigned(AddUnsigned(H(b, c, d), x), ac));
result := AddUnsigned(RotateLeft(a, s), b);
end;
function II(a,b,c,d,x,s,ac:integer):integer;
begin
a := AddUnsigned(a, AddUnsigned(AddUnsigned(I(b, c, d), x), ac));
result := AddUnsigned(RotateLeft(a, s), b);
end;

type IntArray = array of integer;
function ConvertToWordArray(sMessage:WideString):IntArray;
var lWordCount:integer;
var lMessageLength:integer;
var lNumberOfWords_temp1:integer;
var lNumberOfWords_temp2:integer;
var lNumberOfWords:integer;
var lWordArray:IntArray;
var lBytePosition:integer;
var lByteCount:integer;
begin
lMessageLength := length(sMessage);
lNumberOfWords_temp1:=lMessageLength + 8;
lNumberOfWords_temp2:=(lNumberOfWords_temp1-(lNumberOfWords_temp1 mod 64)) div 64;
lNumberOfWords := (lNumberOfWords_temp2+1)*16;
SetLength(lWordArray,lNumberOfWords);
lBytePosition := 0;
lByteCount := 0;
while ( lByteCount < lMessageLength ) do
begin
lWordCount := (lByteCount-(lByteCount mod 4)) div 4;
lBytePosition := (lByteCount mod 4)*8;
lWordArray[lWordCount] := (lWordArray[lWordCount] or (ord(sMessage[lByteCount+1]) shl lBytePosition));
inc(lByteCount);
end;
lWordCount := (lByteCount-(lByteCount mod 4)) div 4;
lBytePosition := (lByteCount mod 4)*8;
lWordArray[lWordCount] := lWordArray[lWordCount] or ($80 shl lBytePosition);
lWordArray[lNumberOfWords-2] := lMessageLength shl 3;
lWordArray[lNumberOfWords-1] := lMessageLength shr 29;
result := lWordArray;
end;

function WordToHex(lValue:integer):WideString;
var WordToHexValue,WordToHexValue_temp:WideString;
lByte,lCount:integer;
begin
Result := '';
for lCount := 0 to 3 do
begin
lByte := (lValue shr (lCount*8)) and 255;
result := result + IntToHex(lByte,2);
end;
end;

var x:IntArray;
k,AA,BB,CC,DD,a,b,c,d:integer;
const S11:integer=7;
S12:integer=12;
S13:integer=17;
S14:integer=22;

S21:integer=5;
S22:integer=9 ;
S23:integer=14;
S24:integer=20;

S31:integer=4;
S32:integer=11;
S33:integer=16;
S34:integer=23;
S41:integer=6;
S42:integer=10;
S43:integer=15;
S44:integer=21;
begin
// Steps 1 and 2. Append padding bits and length and convert to words
x := ConvertToWordArray(sMessage);
// Step 3. Initialise
a := $67452301; b := $EFCDAB89; c := $98BADCFE; d := $10325476;
// Step 4. Process the message in 16-word blocks
k :=0 ;
while k< length(x) do
//for (k=0;k<x.length;k+=16)
begin
AA:=a; BB:=b; CC:=c; DD:=d;
a:=FF(a,b,c,d,x[k+0], S11,$D76AA478);
d:=FF(d,a,b,c,x[k+1], S12,$E8C7B756);
c:=FF(c,d,a,b,x[k+2], S13,$242070DB);
b:=FF(b,c,d,a,x[k+3], S14,$C1BDCEEE);
a:=FF(a,b,c,d,x[k+4], S11,$F57C0FAF);
d:=FF(d,a,b,c,x[k+5], S12,$4787C62A);
c:=FF(c,d,a,b,x[k+6], S13,$A8304613);
b:=FF(b,c,d,a,x[k+7], S14,$FD469501);
a:=FF(a,b,c,d,x[k+8], S11,$698098D8);
d:=FF(d,a,b,c,x[k+9], S12,$8B44F7AF);
c:=FF(c,d,a,b,x[k+10],S13,$FFFF5BB1);
b:=FF(b,c,d,a,x[k+11],S14,$895CD7BE);
a:=FF(a,b,c,d,x[k+12],S11,$6B901122);
d:=FF(d,a,b,c,x[k+13],S12,$FD987193);
c:=FF(c,d,a,b,x[k+14],S13,$A679438E);
b:=FF(b,c,d,a,x[k+15],S14,$49B40821);
a:=GG(a,b,c,d,x[k+1], S21,$F61E2562);
d:=GG(d,a,b,c,x[k+6], S22,$C040B340);
c:=GG(c,d,a,b,x[k+11],S23,$265E5A51);
b:=GG(b,c,d,a,x[k+0], S24,$E9B6C7AA);
a:=GG(a,b,c,d,x[k+5], S21,$D62F105D);
d:=GG(d,a,b,c,x[k+10],S22,$2441453);
c:=GG(c,d,a,b,x[k+15],S23,$D8A1E681);
b:=GG(b,c,d,a,x[k+4], S24,$E7D3FBC8);
a:=GG(a,b,c,d,x[k+9], S21,$21E1CDE6);
d:=GG(d,a,b,c,x[k+14],S22,$C33707D6);
c:=GG(c,d,a,b,x[k+3], S23,$F4D50D87);
b:=GG(b,c,d,a,x[k+8], S24,$455A14ED);
a:=GG(a,b,c,d,x[k+13],S21,$A9E3E905);
d:=GG(d,a,b,c,x[k+2], S22,$FCEFA3F8);
c:=GG(c,d,a,b,x[k+7], S23,$676F02D9);
b:=GG(b,c,d,a,x[k+12],S24,$8D2A4C8A);
a:=HH(a,b,c,d,x[k+5], S31,$FFFA3942);
d:=HH(d,a,b,c,x[k+8], S32,$8771F681);
c:=HH(c,d,a,b,x[k+11],S33,$6D9D6122);
b:=HH(b,c,d,a,x[k+14],S34,$FDE5380C);
a:=HH(a,b,c,d,x[k+1], S31,$A4BEEA44);
d:=HH(d,a,b,c,x[k+4], S32,$4BDECFA9);
c:=HH(c,d,a,b,x[k+7], S33,$F6BB4B60);
b:=HH(b,c,d,a,x[k+10],S34,$BEBFBC70);
a:=HH(a,b,c,d,x[k+13],S31,$289B7EC6);
d:=HH(d,a,b,c,x[k+0], S32,$EAA127FA);
c:=HH(c,d,a,b,x[k+3], S33,$D4EF3085);
b:=HH(b,c,d,a,x[k+6], S34,$4881D05);
a:=HH(a,b,c,d,x[k+9], S31,$D9D4D039);
d:=HH(d,a,b,c,x[k+12],S32,$E6DB99E5);
c:=HH(c,d,a,b,x[k+15],S33,$1FA27CF8);
b:=HH(b,c,d,a,x[k+2], S34,$C4AC5665);
a:=II(a,b,c,d,x[k+0], S41,$F4292244);
d:=II(d,a,b,c,x[k+7], S42,$432AFF97);
c:=II(c,d,a,b,x[k+14],S43,$AB9423A7);
b:=II(b,c,d,a,x[k+5], S44,$FC93A039);
a:=II(a,b,c,d,x[k+12],S41,$655B59C3);
d:=II(d,a,b,c,x[k+3], S42,$8F0CCC92);
c:=II(c,d,a,b,x[k+10],S43,$FFEFF47D);
b:=II(b,c,d,a,x[k+1], S44,$85845DD1);
a:=II(a,b,c,d,x[k+8], S41,$6FA87E4F);
d:=II(d,a,b,c,x[k+15],S42,$FE2CE6E0);
c:=II(c,d,a,b,x[k+6], S43,$A3014314);
b:=II(b,c,d,a,x[k+13],S44,$4E0811A1);
a:=II(a,b,c,d,x[k+4], S41,$F7537E82);
d:=II(d,a,b,c,x[k+11],S42,$BD3AF235);
c:=II(c,d,a,b,x[k+2], S43,$2AD7D2BB);
b:=II(b,c,d,a,x[k+9], S44,$EB86D391);
a:=AddUnsigned(a,AA); b:=AddUnsigned(b,BB); c:=AddUnsigned(c,CC); d:=AddUnsigned(d,DD);
inc (k,16);
end;
result := GetABC(LowerCase(WordToHex(a)+WordToHex(b)+WordToHex(c)+WordToHex(d)));
end;
chenchangfu 2005-08-12
  • 打赏
  • 举报
回复
//MD5是个不可逆推的加密函数,解密只需自己自己对应即可:
function MD_dzt(sMessage:WideString):WideString;

//把十六精制字符串转化为0..9和a..z
function GetABC(const S:string): String;
var
Temp1, Temp2, Temp3: String;
I64: Int64;
Len: Byte;
begin
Temp1 := '';
Temp2 := S;
Len := Length(P_WORD);
while Temp2 <> '' do
begin
Temp3 := LeftStr(Temp2, 15);
I64 := StrToInt64('$' + Temp3);

Temp3 := '';
while I64 > 0 do
begin
Temp3 := Temp3 + P_WORD[I64 mod Len + 1];
I64 := I64 div Len;
end;

Temp1 := Temp1 + Temp3;
Delete(Temp2, 1, 15);
end;
Result := Temp1;
end;

function RotateLeft(lValue, iShiftBits:integer):integer;
begin
result := (lValue shl iShiftBits) or (lValue shr (32-iShiftBits));
end;

function AddUnsigned(lX,lY:integer):integer;
var
lX4,lY4,lX8,lY8,lResult:integer;
begin
lX8 := (lX and $80000000);
lY8 := (lY and $80000000);
lX4 := (lX and $40000000);
lY4 := (lY and $40000000);
lResult := (lX and $3FFFFFFF)+(lY and $3FFFFFFF);
if (lX4 and lY4) <> 0 then begin result := (lResult xor $80000000 xor lX8 xor lY8); Exit; end;
bluejingling 2005-08-12
  • 打赏
  • 举报
回复
MD5加密算法(DELPHI) 一

点击数:79 发布日期:2005-8-4 22:35:00 【字体:大 中 小】【评论】【打印】



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



bluejingling 2005-08-12
  • 打赏
  • 举报
回复
發錯了地方,對不起.
關於樓主說的md5算法,建議去網開上找一下
bluejingling 2005-08-12
  • 打赏
  • 举报
回复
我懷疑是樓主的哪個unit中的uses中不小心刪除了一人fc* 的單元文件。
建議樓主:
在project菜單中remove部份窗體,再看看是哪個窗體有問題。找到出錯窗體後,
方法1、重新設計窗體
方法2、重新引用fc*控件
方法3、在unit的開頭中的uses中加入可能被刪除的單元
ly_liuyang 2005-08-11
  • 打赏
  • 举报
回复
Google上N多Delphi的MD5代码下载的

_____________________
http://lysoft.7u7.net

5,386

社区成员

发帖
与我相关
我的任务
社区描述
Delphi 开发及应用
社区管理员
  • VCL组件开发及应用社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧