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. 准备工作为了便于 ...

随机推荐

yum和rpm命令详解
rpm,全称RPM Package Manager,是RedHat发布的,针对特定硬件,已经编译好的软件包.安装之后就可以使用,不需要自行编译,以及之前对软件和硬件的检测,目录的配置等动作. yum, ...
批处理：遍历输出指定后缀格式的文件名.bat
批处理:遍历输出指定后缀格式的文件名.bat @echo off type nul >C:\result.txt for /r "d:\我的文档\桌面\交接\webservice\We ...
join的一对多，去除重复，排序优先的group方法
想将问题列表按照最新回答来排列.但问题和回答是分拆在两张表来存放的.所以,要完成上述需求,需从主表“问题”取显示数据,但是得按照次表(回答)的更新日期来排序. 用join来做,始终无法去除重复,折腾了 ...
eclipse 安装git插件
Eclipse上安装GIT插件EGit及使用博客分类: GIT 一.Eclipse上安装GIT插件EGit Eclipse的版本eclipse-java-helios-SR2-win32.zip ...
Java按位置解析文本文件(使用Swing选择文件)
工作中遇到这样的一个需求,按位置解析一些文本文件,它们由头部.详情.尾部组成,并且每一行的长度可能不一样,每一行代表的意思也可能不一样,但是每一行各个位置代表的含义已经确定了. 例如有下面这样一段文本 ...
《深入理解linux内核》第一章序论
硬链接的限制
WCF - IIS Hosting
WCF - IIS Hosting Hosting a WCF service in IIS (Internet Information Services) is a step-by-step pro ...
开源的文件比较工具：WinMerge,KDiff3,diffuse
为了寻找免费的BeyondCompare的替代品,最后经过实用,找到如下一些: 1.diffuse 感受:如果仅仅是比较两个文本类的文件,这个软件也就够用了. 安装好后,对着文件点击右键,会出现&qu ...
hdu4671Backup Plan
http://acm.hdu.edu.cn/showproblem.php?pid=4671 这个高端的题意啊看了N久啊 n>m时直接第一列按顺序来第二列为M+1 else 第一列顺序 ...
ArrayList Iterator remove java.lang.UnsupportedOperationException
在使用Arrays.asList()后调用add,remove这些method时出现 java.lang.UnsupportedOperationException异常.这是由于Arrays.asLi ...

Delphi- 数据加密和解密

Delphi- 数据加密和解密的更多相关文章

随机推荐

热门专题