Delphi- 数据加密和解密
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
Delphi- 数据加密和解密的更多相关文章
- ASP.NET(C#)常用数据加密和解密方法汇总
一. 数据加密的概念 1. 基本概念 2. 基本功能 3. 加密形式 二. 数据加密的项目应用和学习 1. 媒体加密:DRM 2. 文件加密:文本 ...
- php接口数据加密、解密、验证签名代码实例
php接口数据加密.解密.验证签名 代码非常easy,这里就不多废话了,直接奉上代码 <?php /** * 数据加密.解密.验证签名 * @edit http://www.lai18.com ...
- Python之数据加密与解密及相关操作（hashlib模块、hmac模块、random模块、base64模块、pycrypto模块）
本文内容 数据加密概述 Python中实现数据加密的模块简介 hashlib与hmac模块介绍 random与secrets模块介绍 base64模块介绍 pycrypto模块介绍 总结 参考文档 提 ...
- Python之数据加密与解密及相关操作（hashlib、hmac、random、base64、pycrypto）
本文内容 数据加密概述 Python中实现数据加密的模块简介 hashlib与hmac模块介绍 random与secrets模块介绍 base64模块介绍 pycrypto模块介绍 总结 参考文档 提 ...
- php接口数据加密、解密、验证签名【转】
<?php/** * 数据加密,解密,验证签名 * @edit http://www.lai18.com * @date 2015-07-08 **///header('Content-Type ...
- Delphi RSA加解密【 (RSA公钥加密，私钥解密)、(RSA私钥加密，公钥解密)、MD5加密、SHA加密】
作者QQ:(648437169) 点击下载➨delphi RSA加解密 [Delphi RSA加解密]支持 (RSA公钥加密,私钥解密).(RSA私钥加密,公钥解密).MD5加密.SHA1加密.SHA ...
- 探讨.NET Core数据加密和解密问题
前言 一直困扰着我关于数据加密这一块,24号晚上用了接近3个小时去完成一项任务,本以为立马能解决,但是为了保证数据的安全性,我们开始去对数据进行加密,然后接下来3个小时专门去研究加密这一块,然而用着用 ...
- 从网上整理的一些delphi字符串加密解密方法
function Encode(Str: string): string; var //加密 TmpChr: AnsiChar; i, Len: integer; begin Result := St ...
- Delphi字符串加密/解密
unit uEncrypt_Decrypt; interface uses SysUtils; const XorKey: array[0..7] of Byte = ($B2, $09, ...
- MySQL敏感数据加密及解密
大数据时代的到来,数据成为企业最重要的资产之一,数据加密的也是保护数据资产的重要手段.本文主要在结合学习通过MySQL函数及Python加密方法来演示数据加密的一些简单方式. 1. 准备工作 为了便于 ...
随机推荐
- java 使用正则表达式从网页上提取网站标题
如何从网页上抓取有价值的东西?看懂了下面的程序(非常简单),想从网页上抓取什么信息(标题.内容.Email.价格等)就能抓取什么信息. package catchhtml; import java.i ...
- 如何才能学到Qt的精髓——信号槽之间的无关性，提供了绝佳的对象间通讯方式，QT的GUI全是自己的一套，并且完全开源，提供了一个绝好机会窥视gui具体实现
姚冬,中老年程序员 叶韵.KY Xu.赵奋强 等人赞同 被邀请了很久了,一直在思考,今天终于下决心开始写回答. 这个问题的确是够大的,Qt的代码规模在整个开源世界里也是名列前茅的,这么大的项目其中的精 ...
- php 中奖概率算法
我们先完成后台PHP的流程,PHP的主要工作是负责配置奖项及对应的中奖概率,当前端页面点击翻动某个方块时会想后台PHP发送ajax请求,那么后台PHP根据配置的概率,通过概率算法给出中奖结果,同时将未 ...
- linux 匹配查询列表中包含某一特殊字符的所有行中的某一列
命令: ll | grep sh | awk '{print $9}' 解析: 其中,匹配列的命令为awk '{print $n}',$n为匹配的第几列.
- Android 常用UI控件之TabHost(4)实现当Tab栏有多个tab时,可以左右滑动
<!-- <HorizontalScrollView android:id="@+id/horizontalScrollView1" android:layout_wi ...
- 【HDOJ】1114 Piggy-Bank
DP,先将coins按照重量排序可以优化. #include <stdio.h> #include <stdlib.h> #define MAXNUM 10005 #defin ...
- 【HDOJ】1045 Fire Net
经典深搜.注意满足条件. #include <stdio.h> #include <string.h> #define MAXNUM 5 char map[MAXNUM][MA ...
- IBM Rational-完整的软件工程解决方案工具集
IBM,即国际商业机器公司,1911年创立于美国,是全球最大的信息技术和业务解决方案公司,其业务遍及全球170多个国家和地区.IBM软件分为五个部分,其中Rational系列是专门针对软件工程的软件工 ...
- QNX环境
QNX开发环境和QNX虚拟机都搭建好了,开始写第一个QNX程序. 关于QNX程序开发的最好参考是QNX官网上的pdf书<10 Steps to Developing a QNX Program: ...
- Google Chrome中的高性能网络(二)
Chrome Predictor的预测功能优化 Chrome会随着使用变得更快. 它这个特性是通过一个单例对象Predictor来实现的.这个对象在浏览器内核进程(Browser Kernel Pro ...