Delphi进行数据加密，在数据库方面经常要使用到。从网上转载过来的，以后会经常会用到。
一、MD5加密算法
在C#/.Net里提供了MD5加密的类库。在Delphi中没有。只能自己建一个新的单位，将网上别人写的MD5加密函数拿来用。
{******************************************************************}
{ MD5 Hashsum Evaluation Unit For Borland Delphi }
{ }
{ Copyright ? by Dimka Maslov }
{ E-mail: mail@endimus.com, }
{ Web-site: http://www.endimus.com }
{ }
{ Derived from the RSA Data Security, Inc. }
{ MD5 Message-Digest Algorithm described in RFC }
{ http://www.faqs.org/rfcs/rfc1321.html }
{******************************************************************}
unit MD5Unit;
interface
uses Windows, SysUtils, Classes;
type
{ The TMD5Digest record is the type of results of
the MD5 hashsum evaluation functions. The contents
of a record may be used as four -bit integer values
or as an array of bytes }
PMD5Digest = ^TMD5Digest;
TMD5Digest = record
case Integer of
: (A, B, C, D: LongInt);
: (v: array [..] of Byte);
end;
{ The MD5String function evaluates the MD5 hashsum for
a string. The S parameter specifies a string to
evaluate hashsum }
procedure MD5String(const S: string;PMD5:PMD5Digest);
{ The MD5File function evaluates the MD5 hashsum for
a file. The FileName parameter specifies the name
of a file to evaluate hashsum }
procedure MD5File(const FileName: string;PMD5:PMD5Digest);
{ The MD5Stream function evaluates the MD5 hashsum for
a stream. The Stream parameters specifies the
TStream descendant class object to evaluate hashsum }
procedure MD5Stream(const Stream: TStream;PMD5:PMD5Digest);
{ The MD5Buffer function evaluates the MD5 hashsum for
any memory buffer. The Buffer parameters specifies a
buffer to evaluate hashsum. The Size parameter specifies
the size (in bytes) of a buffer }
procedure MD5Buffer(const Buffer; Size: Integer;PMD5:PMD5Digest);
{ The MD5DigestToStr function converts the result of
a hashsum evaluation function into a string of
hexadecimal digits }
function MD5DigestToStr(const Digest: TMD5Digest): string;
{ The MD5DigestCompare function compares two
TMD5Digest record variables. This function returns
TRUE if parameters are equal or FALSE otherwise }
function MD5DigestCompare(const Digest1, Digest2: TMD5Digest): Boolean;
implementation
{
Copyright (C) -, RSA Data Security, Inc. Created . All
rights reserved.
License to copy and use this software is granted provided that it
is identified as the "RSA Data Security, Inc. MD5 Message-Digest
Algorithm" in all material mentioning or referencing this software
or this function.
License is also granted to make and use derivative works provided
that such works are identified as "derived from the RSA Data
Security, Inc. MD5 Message-Digest Algorithm" in all material
mentioning or referencing the derived work.
RSA Data Security, Inc. makes no representations concerning either
the merchantability of this software or the suitability of this
software for any particular purpose. It is provided "as is"
without express or implied warranty of any kind.
These notices must be retained in any copies of any part of this
documentation and/or software.
}
type
UINT4 = LongWord;
PArray4UINT4 = ^TArray4UINT4;
TArray4UINT4 = array [..] of UINT4;
PArray2UINT4 = ^TArray2UINT4;
TArray2UINT4 = array [..] of UINT4;
PArray16Byte = ^TArray16Byte;
TArray16Byte = array [..] of Byte;
PArray64Byte = ^TArray64Byte;
TArray64Byte = array [..] of Byte;
PByteArray = ^TByteArray;
TByteArray = array [..] of Byte;
PUINT4Array = ^TUINT4Array;
TUINT4Array = array [..] of UINT4;
PMD5Context = ^TMD5Context;
TMD5Context = record
state: TArray4UINT4;
count: TArray2UINT4;
buffer: TArray64Byte;
end;
const
S11 = ;
S12 = ;
S13 = ;
S14 = ;
S21 = ;
S22 = ;
S23 = ;
S24 = ;
S31 = ;
S32 = ;
S33 = ;
S34 = ;
S41 = ;
S42 = ;
S43 = ;
S44 = ;
var
Padding : TArray64Byte =
($, , , , , , , , , , , , , , , , , , , , , ,
, , , , , , , , , , , , , , , , , , , , , , ,
, , , , , , , , , , , , , , , , , , );
function _F(x, y, z: UINT4): UINT4;
begin
Result := (((x) and (y)) or ((not x) and (z)));
end;
function _G(x, y, z: UINT4): UINT4;
begin
Result := (((x) and (z)) or ((y) and (not z)));
end;
function _H(x, y, z: UINT4): UINT4;
begin
Result := ((x) xor (y) xor (z));
end;
function _I(x, y, z: UINT4): UINT4;
begin
Result := ((y) xor ((x) or ( not z)));
end;
function ROTATE_LEFT(x, n: UINT4): UINT4;
begin
Result := (((x) shl (n)) or ((x) shr (-(n))));
end;
procedure FF(var a: UINT4; b, c, d, x, s, ac: UINT4);
begin
a := a + _F(b, c, d) + x + ac;
a := ROTATE_LEFT (a, s);
a := a + b;
end;
procedure GG(var a: UINT4; b, c, d, x, s, ac: UINT4);
begin
a := a + _G(b, c, d) + x + ac;
a := ROTATE_LEFT(a, s);
a := a + b;
end;
procedure HH(var a: UINT4; b, c, d, x, s, ac: UINT4);
begin
a := a + _H(b, c, d) + x + ac;
a := ROTATE_LEFT(a, s);
a := a + b;
end;
procedure II(var a: UINT4; b, c, d, x, s, ac: UINT4);
begin
a := a + _I(b, c, d) + x + ac;
a := ROTATE_LEFT(a, s);
a := a + b;
end;
procedure MD5Encode(Output: PByteArray; Input: PUINT4Array; Len: LongWord);
var
i, j: LongWord;
begin
j:=;
i:=;
while j < Len do begin
output[j] := Byte(input[i] and $ff);
output[j+] := Byte((input[i] shr ) and $ff);
output[j+] := Byte((input[i] shr ) and $ff);
output[j+] := Byte((input[i] shr ) and $ff);
Inc(j, );
Inc(i);
end;
end;
procedure MD5Decode(Output: PUINT4Array; Input: PByteArray; Len: LongWord);
var
i, j: LongWord;
begin
j:=;
i:=;
while j < Len do begin
Output[i] := UINT4(input[j]) or (UINT4(input[j+]) shl ) or
(UINT4(input[j+]) shl ) or ( UINT4(input[j+]) shl );
Inc(j, );
Inc(i);
end;
end;
procedure MD5_memcpy(Output: PByteArray; Input: PByteArray; Len: LongWord);
begin
Move(Input^, Output^, Len);
end;
procedure MD5_memset(Output: PByteArray; Value: Integer; Len: LongWord);
begin
FillChar(Output^, Len, Byte(Value));
end;
procedure MD5Transform(State: PArray4UINT4; Buffer: PArray64Byte);
var
a, b, c, d: UINT4;
x : array[..] of UINT4;
begin
a:=State[]; b:=State[]; c:=State[]; d:=State[];
MD5Decode(PUINT4Array(@x), PByteArray(Buffer), );
FF (a, b, c, d, x[ ], S11, $d76aa478);
FF (d, a, b, c, x[ ], S12, $e8c7b756);
FF (c, d, a, b, x[ ], S13, $242070db);
FF (b, c, d, a, x[ ], S14, $c1bdceee);
FF (a, b, c, d, x[ ], S11, $f57c0faf);
FF (d, a, b, c, x[ ], S12, $4787c62a);
FF (c, d, a, b, x[ ], S13, $a8304613);
FF (b, c, d, a, x[ ], S14, $fd469501);
FF (a, b, c, d, x[ ], S11, $698098d8);
FF (d, a, b, c, x[ ], S12, $8b44f7af);
FF (c, d, a, b, x[], S13, $ffff5bb1);
FF (b, c, d, a, x[], S14, $895cd7be);
FF (a, b, c, d, x[], S11, $6b901122);
FF (d, a, b, c, x[], S12, $fd987193);
FF (c, d, a, b, x[], S13, $a679438e);
FF (b, c, d, a, x[], S14, $49b40821);
GG (a, b, c, d, x[ ], S21, $f61e2562);
GG (d, a, b, c, x[ ], S22, $c040b340);
GG (c, d, a, b, x[], S23, $265e5a51);
GG (b, c, d, a, x[ ], S24, $e9b6c7aa);
GG (a, b, c, d, x[ ], S21, $d62f105d);
GG (d, a, b, c, x[], S22, $);
GG (c, d, a, b, x[], S23, $d8a1e681);
GG (b, c, d, a, x[ ], S24, $e7d3fbc8);
GG (a, b, c, d, x[ ], S21, $21e1cde6);
GG (d, a, b, c, x[], S22, $c33707d6);
GG (c, d, a, b, x[ ], S23, $f4d50d87);
GG (b, c, d, a, x[ ], S24, $455a14ed);
GG (a, b, c, d, x[], S21, $a9e3e905);
GG (d, a, b, c, x[ ], S22, $fcefa3f8);
GG (c, d, a, b, x[ ], S23, $676f02d9);
GG (b, c, d, a, x[], S24, $8d2a4c8a);
HH (a, b, c, d, x[ ], S31, $fffa3942);
HH (d, a, b, c, x[ ], S32, $8771f681);
HH (c, d, a, b, x[], S33, $6d9d6122);
HH (b, c, d, a, x[], S34, $fde5380c);
HH (a, b, c, d, x[ ], S31, $a4beea44);
HH (d, a, b, c, x[ ], S32, $4bdecfa9);
HH (c, d, a, b, x[ ], S33, $f6bb4b60);
HH (b, c, d, a, x[], S34, $bebfbc70);
HH (a, b, c, d, x[], S31, $289b7ec6);
HH (d, a, b, c, x[ ], S32, $eaa127fa);
HH (c, d, a, b, x[ ], S33, $d4ef3085);
HH (b, c, d, a, x[ ], S34, $4881d05);
HH (a, b, c, d, x[ ], S31, $d9d4d039);
HH (d, a, b, c, x[], S32, $e6db99e5);
HH (c, d, a, b, x[], S33, $1fa27cf8);
HH (b, c, d, a, x[ ], S34, $c4ac5665);
II (a, b, c, d, x[ ], S41, $f4292244);
II (d, a, b, c, x[ ], S42, $432aff97);
II (c, d, a, b, x[], S43, $ab9423a7);
II (b, c, d, a, x[ ], S44, $fc93a039);
II (a, b, c, d, x[], S41, $655b59c3);
II (d, a, b, c, x[ ], S42, $8f0ccc92);
II (c, d, a, b, x[], S43, $ffeff47d);
II (b, c, d, a, x[ ], S44, $85845dd1);
II (a, b, c, d, x[ ], S41, $6fa87e4f);
II (d, a, b, c, x[], S42, $fe2ce6e0);
II (c, d, a, b, x[ ], S43, $a3014314);
II (b, c, d, a, x[], S44, $4e0811a1);
II (a, b, c, d, x[ ], S41, $f7537e82);
II (d, a, b, c, x[], S42, $bd3af235);
II (c, d, a, b, x[ ], S43, $2ad7d2bb);
II (b, c, d, a, x[ ], S44, $eb86d391);
Inc(State[], a);
Inc(State[], b);
Inc(State[], c);
Inc(State[], d);
MD5_memset (PByteArray(@x), , SizeOf (x));
end;
procedure MD5Init(var Context: TMD5Context);
begin
FillChar(Context, SizeOf(Context), );
Context.state[] := $;
Context.state[] := $efcdab89;
Context.state[] := $98badcfe;
Context.state[] := $;
end;
procedure MD5Update(var Context: TMD5Context; Input: PByteArray; InputLen: LongWord);
var
i, index, partLen: LongWord;
begin
index := LongWord( (context.count[] shr ) and $3F);
Inc(Context.count[], UINT4(InputLen) shl );
if Context.count[] < UINT4(InputLen) shl then Inc(Context.count[]);
Inc(Context.count[], UINT4(InputLen) shr );
partLen := - index;
if inputLen >= partLen then begin
MD5_memcpy(PByteArray(@Context.buffer[index]), Input, PartLen);
MD5Transform(@Context.state, @Context.buffer);
i := partLen;
while i + < inputLen do begin
MD5Transform(@Context.state, PArray64Byte(@Input[i]));
Inc(i, );
end;
index := ;
end else i:=;
MD5_memcpy(PByteArray(@Context.buffer[index]), PByteArray(@Input[i]), inputLen - i);
end;
procedure MD5Final(Digest: PMD5Digest; var Context: TMD5Context);
var
bits: array [..] of Byte;
index, padLen: LongWord;
begin
MD5Encode(PByteArray(@bits), PUINT4Array(@Context.count), );
index := LongWord( (Context.count[] shr ) and $3F);
if index < then padLen := - index else padLen := - index;
MD5Update(Context, PByteArray(@PADDING), padLen);
MD5Update(Context, PByteArray(@Bits), );
MD5Encode(PByteArray(Digest), PUINT4Array(@Context.state), );
MD5_memset(PByteArray(@Context), , SizeOf(Context));
end;
function MD5DigestToStr(const Digest: TMD5Digest): string;
var
i: Integer;
begin
Result:='';
for i:= to do Result:=Result+IntToHex(Digest.v[i], );
end;
procedure MD5String(const S: string;PMD5:PMD5Digest);
begin
MD5Buffer(PChar(S)^, Length(S),PMD5);
end;
procedure MD5File(const FileName: string;PMD5:PMD5Digest);
var
F: TFileStream;
begin
F:=TFileStream.Create(FileName, fmOpenRead);
try
MD5Stream(F,PMD5);
finally
F.Free;
end;
end;
procedure MD5Stream(const Stream: TStream;PMD5:PMD5Digest);
var
Context: TMD5Context;
Buffer: array[..] of Byte;
Size: Integer;
ReadBytes : Integer;
TotalBytes : Integer;
SavePos: Integer;
begin
MD5Init(Context);
Size:=Stream.Size;
SavePos:=Stream.Position;
TotalBytes:=;
try
Stream.Seek(, soFromBeginning);
repeat
ReadBytes:=Stream.Read(Buffer, SizeOf(Buffer));
Inc(TotalBytes, ReadBytes);
MD5Update(Context, @Buffer, ReadBytes);
until (ReadBytes = ) or (TotalBytes = Size);
finally
Stream.Seek(SavePos, soFromBeginning);
end;
MD5Final(PMD5, Context);
end;
procedure MD5Buffer(const Buffer; Size: Integer;PMD5:PMD5Digest);
var
Context: TMD5Context;
begin
MD5Init(Context);
MD5Update(Context, PByteArray(@Buffer), Size);
MD5Final(PMD5, Context);
end;
function MD5DigestCompare(const Digest1, Digest2: TMD5Digest): Boolean;
begin
Result:=False;
if Digest1.A <> Digest2.A then Exit;
if Digest1.B <> Digest2.B then Exit;
if Digest1.C <> Digest2.C then Exit;
if Digest1.D <> Digest2.D then Exit;
Result:=True;
end;
end.
调用方法：
var
md5: TMD5Digest; //MD5Unit.pas
passwordSource:string;
passwordDestinate:string;
begin
passwordSource:='testStringForMD5'; MD5String(passwordSource, @md5);
passwordDestinate:= LowerCase(MD5DigestToStr(md5)); ShowMessage(passwordDestinate);
end;
调用方法二：
uses MD5Unit,IdHashMessageDigest,IdHash;
procedure TForm1.btn1Click(Sender: TObject);
var
MyMD5: TIdHashMessageDigest5;//IdHashMessageDigest.pas
Digest: T4x4LongWordRecord; //IdHash.pas
passwordSource:string; passwordDestinate32:string;
passwordDestinate16:string;
begin
passwordSource:='testStringForMD5';
MyMD5 := TIdHashMessageDigest5.Create; Digest := MyMD5.HashValue(passwordSource);
passwordDestinate32:=LowerCase(MyMD5.AsHex(Digest)); //32个字符长度的MD5签名结果
passwordDestinate16:=Copy(passwordDestinate32, , );//16个字符长度的MD5签名结果 ShowMessage('32: ' +passwordDestinate32+##+'16: ' + passwordDestinate16); MyMD5.Free;
end; end.
二、DES加密算法
DES的加密、解密封库单元
unit StandardDES;
interface uses
Windows, Classes, SysUtils; type
fdArray = array of dword; function EncryStr(Str, Key: String): String;overload;
function EncryStr(Str:TStream; Key: String): String;overload;
function DecryStr(Str, Key: String): String;overload;
function DecryStr(Str:TStream; Key: String): String;overload;
function EncryStrHex(Str, Key: String): String;
function DecryStrHex(Str, Key: String): String;overload;
function DecryStrHex(Str:TStream; Key: String): String;overload; function des(key:string;smessage:string;encrypt:dword;mode:dword;iv:string):string;
function des_createKeys(key:string):fdArray;
function StrToHex(Str:string):string;
function HexToStr(Hex:string):string;
function IsInt(Str:String):Boolean; implementation function EncryStr(Str, Key: String): String;
begin
Result := des(Key, Str, , , '');
end; function EncryStr(Str:TStream; Key: String): String;
var
AStr:String;
begin
Str.Seek(,soFromBeginning);
setlength(AStr, Str.Size);
Str.Read(AStr[], Str.Size);
Result := des(Key, AStr, , , '');
end; function DecryStr(Str, Key: String): String;
begin
Result := trim(des(Key, Str, , , ''));
end; function DecryStr(Str:TStream; Key: String): String;
var
AStr:String;
begin
Str.Seek(,soFromBeginning);
setlength(AStr, Str.Size);
Str.Read(AStr[], Str.Size);
Result := trim(des(Key, AStr, , , ''));
end; function EncryStrHex(Str, Key: String): String;
begin
Result := trim(StrToHex(des(Key, Str, , , '')));
end; function DecryStrHex(Str, Key: String): String;
begin
Result := trim(des(Key, HexToStr(Str), , , ''));
end; function DecryStrHex(Str:TStream; Key: String): String;
var
AStr:String;
begin
Str.Seek(,soFromBeginning);
setlength(AStr, Str.Size);
Str.Read(AStr[], Str.Size);
Result := trim(des(Key, HexToStr(AStr), , , ''));
end; function des(key:string;smessage:string;encrypt:dword;mode:dword;iv:string):string;
const
spfunction1 : array[..] of dword = ($,,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,,$,$,,$);
spfunction2 : array[..] of dword = ($,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,,$,$,$,$,$,$,,$,$,$,$,$,,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,,$,$,$,$,$,$);
spfunction3 : array[..] of dword = ($,$,,$,$,,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,,$,$,$,$,$,$,,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$);
spfunction4 : array[..] of dword = ($,$,$,$,$,$,$,$,,$,$,$,$,,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,,,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$);
spfunction5 : array[..] of dword = ($,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,,$,$,$,$,$,$,,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,,$,$,$,$,$,$,,$,$,$);
spfunction6 : array[..] of dword = ($,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,,$,$,$,$,$,$,$,$,,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,,$,$,$,$,$,$,$,$,,$,$,$,$);
spfunction7 : array[..] of dword = ($,$,$,,$,$,$,$,$,$,,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,,$,$,,$,$,$,$,$,$,$);
spfunction8 : array[..] of dword = ($,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,,,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$,,$,$,$,$,$,$,,$,$,$,$,$,$,$,$);
var
keys:fdArray;
m, i, j:integer;
temp, temp2, right1, right2, left, right:dword;
looping:array of integer;
cbcleft, cbcleft2, cbcright, cbcright2:dword;
endloop, loopinc:integer;
len, iterations:integer;
chunk:integer;
tempresult:string;
begin
//create the or subkeys we will need
keys := des_createKeys(key);
m:=;cbcleft:=;cbcleft2:=;cbcright:=;cbcright2:=;chunk:=;
len := length(smessage);
//set up the loops for single and triple des
if length(keys) = then
iterations :=
else
iterations := ; if iterations = then
begin
if encrypt = then
begin
setlength(looping,);
looping[] := ;
looping[] := ;
looping[] := ;
end
else
begin
setlength(looping,);
looping[] := ;
looping[] := -;
looping[] := -;
end;
end
else
begin
if encrypt = then
begin
setlength(looping,);
looping[] := ;
looping[] := ;
looping[] := ;
looping[] := ;
looping[] := ;
looping[] := -;
looping[] := ;
looping[] := ;
looping[] := ;
end
else
begin
setlength(looping,);
looping[] := ;
looping[] := ;
looping[] := -;
looping[] := ;
looping[] := ;
looping[] := ;
looping[] := ;
looping[] := -;
looping[] := -;
end;
end; smessage := smessage + ########; //pad the message out with null bytes //store the result here
result := '';
tempresult := ''; if mode = then //CBC mode
begin
cbcleft := (ord(iv[m+]) shl ) or (ord(iv[m+]) shl ) or (ord(iv[m+]) shl ) or ord(iv[m+]);
cbcright := (ord(iv[m+]) shl ) or (ord(iv[m+]) shl ) or (ord(iv[m+]) shl ) or ord(iv[m+]);
m:=;
end; //loop through each bit chunk of the message
while m < len do
begin
left := (ord(smessage[m+]) shl ) or (ord(smessage[m+]) shl ) or (ord(smessage[m+]) shl ) or ord(smessage[m+]);
right := (ord(smessage[m+]) shl ) or (ord(smessage[m+]) shl ) or (ord(smessage[m+]) shl ) or ord(smessage[m+]);
m := m + ; //for Cipher Block Chaining mode, xor the message with the previous result
if mode = then
if encrypt= then
begin
left := left xor cbcleft;
right := right xor cbcright;
end
else
begin
cbcleft2 := cbcleft;
cbcright2 := cbcright;
cbcleft := left;
cbcright := right;
end; //first each but chunk of the message must be permuted according to IP
temp := ((left shr ) xor right) and $0f0f0f0f; right := right xor temp; left := left xor (temp shl );
temp := ((left shr ) xor right) and $0000ffff; right := right xor temp; left := left xor (temp shl );
temp := ((right shr ) xor left) and $; left := left xor temp; right := right xor (temp shl );
temp := ((right shr ) xor left) and $00ff00ff; left := left xor temp; right := right xor (temp shl );
temp := ((left shr ) xor right) and $; right := right xor temp; left := left xor (temp shl ); left := ((left shl ) or (left shr ));
right := ((right shl ) or (right shr )); //do this either or times for each chunk of the message
j:=;
while j<iterations do
begin
endloop := looping[j+];
loopinc := looping[j+];
//now go through and perform the encryption or decryption
i:= looping[j];
while i<>endloop do
begin
right1 := right xor keys[i];
right2 := ((right shr ) or (right shl )) xor keys[i+];
//the result is attained by passing these bytes through the S selection functions
temp := left;
left := right;
right := temp xor (spfunction2[(right1 shr ) and $3f] or spfunction4[(right1 shr ) and $3f]
or spfunction6[(right1 shr ) and $3f] or spfunction8[right1 and $3f]
or spfunction1[(right2 shr ) and $3f] or spfunction3[(right2 shr ) and $3f]
or spfunction5[(right2 shr ) and $3f] or spfunction7[right2 and $3f]);
i:=i+loopinc;
end;
temp := left; left := right; right := temp; //unreverse left and right
j:=j+;
end; //for either or iterations //move then each one bit to the right
left := ((left shr ) or (left shl ));
right := ((right shr ) or (right shl )); //now perform IP-, which is IP in the opposite direction
temp := ((left shr ) xor right) and $; right := right xor temp; left :=left xor (temp shl );
temp := ((right shr ) xor left) and $00ff00ff; left := left xor temp; right := right xor (temp shl );
temp := ((right shr ) xor left) and $; left := left xor temp; right := right xor (temp shl );
temp := ((left shr ) xor right) and $0000ffff; right := right xor temp; left := left xor (temp shl );
temp := ((left shr ) xor right) and $0f0f0f0f; right := right xor temp; left := left xor (temp shl ); //for Cipher Block Chaining mode, xor the message with the previous result
if mode = then
if encrypt= then
begin
cbcleft := left; cbcright := right;
end
else
begin
left :=left xor cbcleft2;
right := right xor cbcright2;
end; tempresult := tempresult + chr(left shr ) + chr((left shr ) and $ff) + chr((left shr ) and $ff) + chr(left and $ff) + chr(right shr ) + chr((right shr ) and $ff) + chr((right shr ) and $ff) + chr(right and $ff); chunk := chunk + ;
if chunk = then
begin
result := result + tempresult; tempresult := ''; chunk := ;
end;
end; //for every characters, or bits in the message //return the result as an array
result := result + tempresult;
end; //end of des //des_createKeys
//this takes as input a bit key (even though only bits are used)
//as an array of dwords, and returns bit keys
function des_createKeys(key:string):fdArray;
const
//declaring this locally speeds things up a bit
pc2bytes0 :array[..] of dword= (,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$);
pc2bytes1 :array[..] of dword= (,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$);
pc2bytes2 :array[..] of dword= (,$,$,$,$,$,$,$,,$,$,$,$,$,$,$);
pc2bytes3 :array[..] of dword= (,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$);
pc2bytes4 :array[..] of dword= (,$,$,$,,$,$,$,$,$,$,$,$,$,$,$);
pc2bytes5 :array[..] of dword= (,$,$,$,,$,$,$,$,$,$,$,$,$,$,$);
pc2bytes6 :array[..] of dword= (,$,$,$,$,$,$,$,,$,$,$,$,$,$,$);
pc2bytes7 :array[..] of dword= (,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$);
pc2bytes8 :array[..] of dword= (,$,,$,$,$,$,$,$,$,$,$,$,$,$,$);
pc2bytes9 :array[..] of dword= (,$,$,$,,$,$,$,$,$,$,$,$,$,$,$);
pc2bytes10 :array[..] of dword= (,$,,$,$,$,$,$,$,$,$,$,$,$,$,$);
pc2bytes11 :array[..] of dword= (,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$);
pc2bytes12 :array[..] of dword= (,$,$,$,$,$,$,$,$,$,$,$,$,$,$,$);
pc2bytes13 :array[..] of dword= (,$,$,$,,$,$,$,$,$,$,$,$,$,$,$); //now define the left shifts which need to be done
shifts :array[..] of dword = (, , , , , , , , , , , , , , , );
var
iterations:integer;
keys:fdArray;
lefttemp, righttemp, temp:dword;
m, n, j,i:integer;
left,right:dword;
begin
//how many iterations ( for des, for triple des)
if length(key) = then
iterations :=
else
iterations := ; //stores the return keys
setlength(keys, * iterations); //other variables
m:=;n:=; for j:= to iterations- do //either or iterations
begin
left := (ord(key[m+]) shl ) or (ord(key[m+]) shl ) or (ord(key[m+]) shl ) or ord(key[m+]);
right := (ord(key[m+]) shl ) or (ord(key[m+]) shl ) or (ord(key[m+]) shl ) or ord(key[m+]);
m:=m+; temp := ((left shr ) xor right) and $0f0f0f0f; right :=right xor temp; left :=left xor (temp shl );
temp := ((right shr ) xor left) and $0000ffff; left := left xor temp; right :=right xor (temp shl );
temp := ((left shr ) xor right) and $; right :=right xor temp; left := left xor (temp shl );
temp := ((right shr ) xor left) and $0000ffff; left :=left xor temp; right := right xor (temp shl );
temp := ((left shr ) xor right) and $; right := right xor temp; left := left xor (temp shl );
temp := ((right shr ) xor left) and $00ff00ff; left :=left xor temp; right := right xor (temp shl );
temp := ((left shr ) xor right) and $; right :=right xor temp; left := left xor (temp shl ); //the right side needs to be shifted and to get the last four bits of the left side
temp := (left shl ) or ((right shr ) and $000000f0);
//left needs to be put upside down
left := (right shl ) or ((right shl ) and $ff0000) or ((right shr ) and $ff00) or ((right shr ) and $f0);
right := temp; //now go through and perform these shifts on the left and right keys
for i:=low(shifts) to high(shifts) do
begin
//shift the keys either one or two bits to the left
if shifts[i] > then
begin
left := (left shl ) or (left shr );
right := (right shl ) or (right shr );
//left := left shl ;
//right:= right shl ;
end
else
begin
left := (left shl ) or (left shr );
right := (right shl ) or (right shr );
//left := left shl ;
//right:= right shl ;
end; left := left and $fffffff0;
right:= right and $fffffff0; //now apply PC-, in such a way that E is easier when encrypting or decrypting
//this conversion will look like PC- except only the last bits of each byte are used
//rather than consecutive bits and the order of lines will be according to
//how the S selection functions will be applied: S2, S4, S6, S8, S1, S3, S5, S7
lefttemp := pc2bytes0[left shr ] or pc2bytes1[(left shr ) and $f]
or pc2bytes2[(left shr ) and $f] or pc2bytes3[(left shr ) and $f]
or pc2bytes4[(left shr ) and $f] or pc2bytes5[(left shr ) and $f]
or pc2bytes6[(left shr ) and $f];
righttemp := pc2bytes7[right shr ] or pc2bytes8[(right shr ) and $f]
or pc2bytes9[(right shr ) and $f] or pc2bytes10[(right shr ) and $f]
or pc2bytes11[(right shr ) and $f] or pc2bytes12[(right shr ) and $f]
or pc2bytes13[(right shr ) and $f];
temp := ((righttemp shr ) xor lefttemp) and $0000ffff;
keys[n+] := lefttemp xor temp;
keys[n+] := righttemp xor (temp shl );
n:=n+;
end;
end; //for each iterations //return the keys we've created
Result := keys; end;//end of des_createKeys function StrToHex(Str:string):string;
var
i:integer;
begin
result := '';
for i := to length(Str) do
result := result + IntToHex(Ord(Str[i]), );
end; function HexToStr(Hex:string):string;
var
i:Integer;
begin
Result := '';
for i := to length(Hex) div do
if IsInt('$' + Hex[i * - ] + Hex[i * ]) then
Result := Result + Chr(StrToInt('$' + Hex[i * - ] + Hex[i * ]));
end; function IsInt(Str:String):Boolean;
begin
result := True;
try
StrToInt(Str);
except
result := False
end;
end; end.
调用方法，加密：
var
PlaintextStr:string;
begin
PlaintextStr:='加密测试！';
PublicCiphertextStr:=EncryStrHex(PlaintextStr, '');//StandardDES.pas showmessage(PublicCiphertextStr);
end;
调用方法，解密：
var
PlaintextStr:string;
begin
PlaintextStr:=DecryStrHex(PublicCiphertextStr, '');//StandardDES.pas showmessage(PlaintextStr);
end;
转截自：http://www.cnblogs.com/edisonfeng/archive/2011/07/22/2054520.html