在delphi中怎样实现SHA1加密？
请教各位高手，在delphi中怎样实现SHA1加密？求具体的代码？
还有一个问题，我在用TidFTP控件实现ftp上传的时候，怎样判断ftp服务器端的文件是否已存在？
需要代码？
先谢谢各位高手拉！
问题点数：70、回复次数：15Top
1 楼budded（All By Myself）回复于 2006-03-15 20:53:52 得分 0
在delphi中怎样实现SHA1加密: 用LockBoxTop
2 楼keiy（）回复于 2006-03-15 21:08:10 得分 70
SHA1算法类:
{
***************************************************
* A binary compatible SHA1 implementation *
* written by Dave Barton (davebarton@bigfoot.com) *
***************************************************
* 160bit hash size *
***************************************************
}
unit SHA1;
interface
uses
Sysutils, Tools;
type
TSHA1Digest= array[0..19] of byte;
TSHA1Context= record
Hash: array[0..4] of DWord;
Hi, Lo: integer;
Buffer: array[0..63] of byte;
Index: integer;
end;
function SHA1SelfTest: boolean;
procedure SHA1Init(var Context: TSHA1Context);
procedure SHA1Update(var Context: TSHA1Context; Buffer: pointer; Len: integer);
procedure SHA1Final(var Context: TSHA1Context; var Digest: TSHA1Digest);
//******************************************************************************
implementation
{$R-}
function SHA1SelfTest: boolean;
const
s: string= 'abc';
OutDigest: TSHA1Digest=
($a9,$99,$3e,$36,$47,$06,$81,$6a,$ba,$3e,$25,$71,$78,$50,$c2,$6c,$9c,$d0,$d8,$9d);
var
Context: TSHA1Context;
Digest: TSHA1Digest;
begin
SHA1Init(Context);
SHA1Update(Context,@s[1],length(s));
SHA1Final(Context,Digest);
if CompareMem(@Digest,@OutDigest,Sizeof(Digest)) then
Result:= true
else
Result:= false;
end;
//******************************************************************************
function F1(x, y, z: DWord): DWord;
begin
Result:= z xor (x and (y xor z));
end;
function F2(x, y, z: DWord): DWord;
begin
Result:= x xor y xor z;
end;
function F3(x, y, z: DWord): DWord;
begin
Result:= (x and y) or (z and (x or y));
end;
//******************************************************************************
function RB(A: DWord): DWord;
begin
Result:= (A shr 24) or ((A shr 8) and $FF00) or ((A shl 8) and $FF0000) or (A shl 24);
end;
procedure SHA1Compress(var Data: TSHA1Context);
var
A, B, C, D, E, T: DWord;
W: array[0..79] of DWord;
i: integer;
begin
Move(Data.Buffer,W,Sizeof(Data.Buffer));
for i:= 0 to 15 do
W[i]:= RB(W[i]);
for i:= 16 to 79 do
W[i]:= LRot32(W[i-3] xor W[i-8] xor W[i-14] xor W[i-16],1);
A:= Data.Hash[0]; B:= Data.Hash[1]; C:= Data.Hash[2]; D:= Data.Hash[3]; E:= Data.Hash[4];
for i:= 0 to 19 do
begin
T:= LRot32(A,5) + F1(B,C,D) + E + W[i] + $5A827999;
E:= D; D:= C; C:= LRot32(B,30); B:= A; A:= T;
end;
for i:= 20 to 39 do
begin
T:= LRot32(A,5) + F2(B,C,D) + E + W[i] + $6ED9EBA1;
E:= D; D:= C; C:= LRot32(B,30); B:= A; A:= T;
end;
for i:= 40 to 59 do
begin
T:= LRot32(A,5) + F3(B,C,D) + E + W[i] + $8F1BBCDC;
E:= D; D:= C; C:= LRot32(B,30); B:= A; A:= T;
end;
for i:= 60 to 79 do
begin
T:= LRot32(A,5) + F2(B,C,D) + E + W[i] + $CA62C1D6;
E:= D; D:= C; C:= LRot32(B,30); B:= A; A:= T;
end;
Data.Hash[0]:= Data.Hash[0] + A;
Data.Hash[1]:= Data.Hash[1] + B;
Data.Hash[2]:= Data.Hash[2] + C;
Data.Hash[3]:= Data.Hash[3] + D;
Data.Hash[4]:= Data.Hash[4] + E;
FillChar(W,Sizeof(W),0);
FillChar(Data.Buffer,Sizeof(Data.Buffer),0);
end;
//******************************************************************************
procedure SHA1Init(var Context: TSHA1Context);
begin
Context.Hi:= 0; Context.Lo:= 0;
Context.Index:= 0;
FillChar(Context.Buffer,Sizeof(Context.Buffer),0);
Context.Hash[0]:= $67452301;
Context.Hash[1]:= $EFCDAB89;
Context.Hash[2]:= $98BADCFE;
Context.Hash[3]:= $10325476;
Context.Hash[4]:= $C3D2E1F0;
end;
//******************************************************************************
procedure SHA1UpdateLen(var Context: TSHA1Context; Len: integer);
var
i, k: integer;
begin
for k:= 0 to 7 do
begin
i:= Context.Lo;
Inc(Context.Lo,Len);
if Context.Lo< i then
Inc(Context.Hi);
end;
end;
//******************************************************************************
procedure SHA1Update(var Context: TSHA1Context; Buffer: pointer; Len: integer);
type
PByte= ^Byte;
begin
SHA1UpdateLen(Context,Len);
while Len> 0 do
begin
Context.Buffer[Context.Index]:= PByte(Buffer)^;
Inc(PByte(Buffer));
Inc(Context.Index);
Dec(Len);
if Context.Index= 64 then
begin
Context.Index:= 0;
SHA1Compress(Context);
end;
end;
end;
//******************************************************************************
procedure SHA1Final(var Context: TSHA1Context; var Digest: TSHA1Digest);
type
PDWord= ^DWord;
begin
Context.Buffer[Context.Index]:= $80;
if Context.Index>= 56 then
SHA1Compress(Context);
PDWord(@Context.Buffer[56])^:= RB(Context.Hi);
PDWord(@Context.Buffer[60])^:= RB(Context.Lo);
SHA1Compress(Context);
Context.Hash[0]:= RB(Context.Hash[0]);
Context.Hash[1]:= RB(Context.Hash[1]);
Context.Hash[2]:= RB(Context.Hash[2]);
Context.Hash[3]:= RB(Context.Hash[3]);
Context.Hash[4]:= RB(Context.Hash[4]);
Move(Context.Hash,Digest,Sizeof(Digest));
FillChar(Context,Sizeof(Context),0);
end;
end.
其中:
unit Tools;
interface
uses
Sysutils;
type
{$IFDEF VER120}
dword= longword;
{$ELSE}
dword= longint;
{$ENDIF}
function LRot16(X: word; c: integer): word; assembler;
function RRot16(X: word; c: integer): word; assembler;
function LRot32(X: dword; c: integer): dword; assembler;
function RRot32(X: dword; c: integer): dword; assembler;
procedure XorBlock(I1, I2, O1: PByteArray; Len: integer);
procedure IncBlock(P: PByteArray; Len: integer);
implementation
function LRot16(X: word; c: integer): word; assembler;
asm
mov ecx,&c
mov ax,&X
rol ax,cl
mov &Result,ax
end;
function RRot16(X: word; c: integer): word; assembler;
asm
mov ecx,&c
mov ax,&X
ror ax,cl
mov &Result,ax
end;
function LRot32(X: dword; c: integer): dword; register; assembler;
asm
mov ecx, edx
rol eax, cl
end;
function RRot32(X: dword; c: integer): dword; register; assembler;
asm
mov ecx, edx
ror eax, cl
end;
procedure XorBlock(I1, I2, O1: PByteArray; Len: integer);
var
i: integer;
begin
for i:= 0 to Len-1 do
O1[i]:= I1[i] xor I2[i];
end;
procedure IncBlock(P: PByteArray; Len: integer);
begin
Inc(P[Len-1]);
if (P[Len-1]= 0) and (Len> 1) then
IncBlock(P,Len-1);
end;
end.
Top
3 楼keiy（）回复于 2006-03-15 21:23:12 得分 0
另外,IdFTP上传时,可用
IdFTP1.List(aaa);将服务器上的目录放入aaa(TStringList),然后在aaa中判文件是否已存在Top
4 楼gyb84021（火彬）回复于 2006-03-16 10:18:36 得分 0
我把代码拷到SHA1.pas以后，编译时提示：File not found: 'Tools.dcu'
我从哪能弄上Tools.dcu？Top
5 楼gyb84021（火彬）回复于 2006-03-16 10:25:55 得分 0
不好意思，我看到啦！在后面。
我在加密时应该调用那个方法？
如：password='test'; 怎样加密？Top
6 楼keiy（）回复于 2006-03-16 11:42:00 得分 0
uses sha1;
procedure TForm1.Button1Click(Sender: TObject);
var
SHA1Context: TSHA1Context;
SHA1Digest: TSHA1Digest;
password:string;
begin
password:='test';
SHA1Init(SHA1Context);
SHA1Update(SHA1Context, PChar(password), Length(password));
SHA1Final(SHA1Context, SHA1Digest);
ShowMessage(PChar(@SHA1Digest)); //SHA1Digest中为SHA1加密后的编码
end;
Top
7 楼gyb84021（火彬）回复于 2006-03-16 16:14:06 得分 0
我试了一下可以加密,不过加密后怎么都是乱码和我用 C#中自带的类库加密的不一样,
C#代码如下:
string pwd=FormsAuthentication.HashPasswordForStoringInConfigFile(password, "SHA1");
比如:password="123456";
在c#加密后是"7C4A8D09CA3762AF61E59520943DC26494F8941B"
而用你那个加密后为"|J??b痑鍟 ?耫旞?"
这是怎么回事 ?是不是密钥不一样?Top
8 楼keiy（）回复于 2006-03-16 17:24:50 得分 0
SHA1Digest中为加密后的内容(内存方式),你要将它显示出16进制格式,可用bintohex,完整程序如下:
procedure TForm1.Button1Click(Sender: TObject);
var
SHA1Context: TSHA1Context;
SHA1Digest: TSHA1Digest;
password:string;
p:array [0..256] of char;
begin
password:='123456';
SHA1Init(SHA1Context);
SHA1Update(SHA1Context, PChar(password), Length(password));
SHA1Final(SHA1Context, SHA1Digest);
BinToHex(PChar(@SHA1Digest),p,strlen(PChar(@SHA1Digest)));
ShowMessage(p);
end;
结果与C#完全一样Top
9 楼gyb84021（火彬）回复于 2006-03-16 18:02:22 得分 0
太感谢了!
我主要刚接触delphi不久,还有些小问题还搞不定.麻烦你再帮帮忙.你知道怎样判断ftp服务器端的文件夹和文件是否已存在,比如,我在实现上传文件的时候首先要判断ftp服务器根目录下是否存在文件夹picture，如果不存在我就创建，在picture文件夹内，再判断是否存在文件aa.pic,如果存在要给出提示信息。怎样用代码实现？
拜托啦！Top
10 楼keiy（）回复于 2006-03-16 19:02:19 得分 0
随手写了一个,供参考:
procedure TForm1.Button1Click(Sender: TObject);
var
t:tstringlist;
i:integer;
f:boolean;
begin
IdFTP1.Connect();
try
IdFTP1.ChangeDir('picture');
except
IdFTP1.MakeDir('picture');
IdFTP1.ChangeDir('picture');
end;
t:=tstringlist.Create;
IdFTP1.List(t);
f:=false;
for i:=0 to t.Count-1 do
if pos('aa.pic',t.Strings[i])<>0 then
begin
ShowMessage('文件已存在!');
f:=true;
break;
end;
if not f then
IdFTP1.Put('aa.pic','aa.pic');
t.Free;
IdFTP1.Disconnect;
end;
Top
11 楼gyb84021（火彬）回复于 2006-03-16 20:13:26 得分 0
不愧为高手！
你那有现成的自己封装好的数据访问层的代码吗，能给我发一份吗？
我的邮箱: guoyb@sisans.cn
Top
12 楼keiy（）回复于 2006-03-16 20:24:42 得分 0
"数据访问层",这个面太大了,我没现成的.不过你可用google在网上搜一下,肯定会找到你要的Top
13 楼gyb84021（火彬）回复于 2006-03-16 21:10:42 得分 0
好的，谢谢你！Top
14 楼gyb84021（火彬）回复于 2006-03-16 21:12:54 得分 0
我再有问题怎么向你请教呢?你的msn是多少?Top
15 楼keiy（）回复于 2006-03-17 09:36:21 得分 0
我不用QQ或MSN,有问题可发CSDN短信给我Top
