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

随机推荐

r个有标志的球放进n个不同的盒子里，要求无一空盒，问有多少种不同的分配方案？
由题意可知道r>=n,我原来想的是先取n个全排列,剩下的r-n个每个有n中选择,所以结果是n!*n^(r-n).经满神猜测,这样是会重复的.比如说,1到5个球,ABC三个盒子,ms ...
PHP漏洞全解(五)-SQL注入攻击
本文主要介绍针对PHP网站的SQL注入攻击.所谓的SQL注入攻击,即一部分程序员在编写代码的时候,没有对用户输入数据的合法性进行判断,使应用程序存在安全隐患.用户可以提交一段数据库查询代码,根据程序返 ...
[译]GotW #89 Smart Pointers
There's a lot to love about standard smart pointers in general, and unique_ptr in particular. Proble ...
BZOJ3230: 相似子串
3230: 相似子串 Time Limit: 20 Sec Memory Limit: 128 MBSubmit: 913 Solved: 223[Submit][Status]Descripti ...
【转】Xcode常用快捷键与技巧分享
原文网址:http://www.jianshu.com/p/039954b0cbe0 工欲善其事必先利其器. 虽然Xcode编写objective-c or swift很完美, 但了解其工具的常用快捷 ...
MVC 自定义AuthorizeAttribute实现权限管理
在上一节中提到可以使用AuthorizeAttribute进行权限管理: [Authorize] public ActionResult TestAuthorize() { return View() ...
Ubuntu下配置Scheme开发环境
MIT-Scheme环境 http://www.gnu.org/software/mit-scheme/ 在官网下载安装包,编译安装即可,期间会提示找不到m4这个库,安装即可 Scheme自带的交互环 ...
Codeforces 302D
思路:最短路,map[i][j] = d*(|x[i]-x[j]| + |y[i]-y[j]|) - add[i] #include<iostream> #include<cstdi ...
在Python中的格式化
str= '@SES/%i/'%-1print strstr1='@SES/%i/'%1print str1str2='@SES/%i/'%2print str2 打印出的结果: @SES/-1/@S ...
处理Google Play的相关方法
1.打开Google play软件的详细页面 Intent intent = new Intent(); intent.setAction(Intent.ACTION_VIEW); intent.se ...

Delphi- 数据加密和解密

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

随机推荐

热门专题