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 Arrays.asList()和Collections.addAll()
java中的方法Arrays.asList(arg1,arg2,arg3...),经常用在将多个元素或数组转化为List中的元素,但是在使用的时候,应该注意: arg1决定返回list的元素类型(即第 ...
Hadoop集群（第5期）_Hadoop安装配置
1.1 Hadoop简介 Hadoop是Apache软件基金会旗下的一个开源分布式计算平台.以Hadoop分布式文件系统(HDFS,Hadoop Distributed Filesystem)和Map ...
POJ2201+RMQ
/* RMQ */ #include<stdio.h> #include<string.h> #include<stdlib.h> #include<algo ...
李洪强iOS开发本人集成环信的经验总结_01环信SDK的导入
李洪强iOS开发本人集成环信的经验总结_01环信SDK的导入 01 - 直接在项目中导入SDK和一些静态库这个时候,没有错误的编译没有错误的话,就说明SDK已经配置成功还有一种方法是用cocoap ...
char*,const char*和string的相互转换
好久没写东西啦,发表学术文章一篇,hiahia~ 近日和小佳子编程时遇到很多转换问题,很麻烦,在网上查了很多资料. 为了以后查找方便,特此总结如下. 如果有不对的地方或者有更简单的方法,请指出~~ 1 ...
【HDOJ】3311 Dig The Wells
Steiner Tree.概念就不讲了,引入0号结点.[1, n+m]到0连一条边,权重表示挖井的费用.这样建图spfa求MST即满足所求解. /* 3311 */ #include <iost ...
【HDOJ】5564 Clarke and digits
DP+快速矩阵幂.注意base矩阵的初始化,不难. /* 5564 */ #include <iostream> #include <string> #include < ...
【HDOJ】1033 Edge
题目英文太多,简单翻译了一下:1. For products that are wrapped in small packings it is necessary that the sheet of ...
【HDOJ】1009 FatMouse' Trade
这道题目是一道非常简单的贪心,但是我却修改了1h+.原因就是qsort的comp有bug.其实还是题目中的数据可以为0.除数为0真的要慎重啊.后来改为结构体,加一层循环选取最大值,果然ac啊.wa了几 ...
SQL Server 2008 数据库日志文件丢失处理方法
当数据库发生这种操作故障时,可以按如下操作步骤可解决此方法,打开数据库里的Sql 查询编辑器窗口,运行以下的命令. 1.修改数据库为紧急模式 ALTER DATABASE Zhangxing SET ...

Delphi- 数据加密和解密

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

随机推荐

热门专题