MD5加密算法:
方式一:
var md5: TMD5Digest; //MD5Unit.pas passwordSource:string; passwordDestinate:string; begin passwordSource:='testStringForMD5'; MD5String(passwordSource, @md5); passwordDestinate:= LowerCase(MD5DigestToStr(md5)); ShowMessage(passwordDestinate); end;
运行结果：
注：MD5Unit.pas是个独立的单元文件，代码如下：
View Code
{******************************************************************} { MD5 Hashsum Evaluation Unit For Borland Delphi } { } { Copyright ? 2002 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 1321 } { 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 32-bit integer values or as an array of 16 bytes } PMD5Digest = ^TMD5Digest; TMD5Digest = record case Integer of 0: (A, B, C, D: LongInt); 1: (v: array [0..15] 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) 1991-2, RSA Data Security, Inc. Created 1991. 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 [0..3] of UINT4; PArray2UINT4 = ^TArray2UINT4; TArray2UINT4 = array [0..1] of UINT4; PArray16Byte = ^TArray16Byte; TArray16Byte = array [0..15] of Byte; PArray64Byte = ^TArray64Byte; TArray64Byte = array [0..63] of Byte; PByteArray = ^TByteArray; TByteArray = array [0..0] of Byte; PUINT4Array = ^TUINT4Array; TUINT4Array = array [0..0] of UINT4; PMD5Context = ^TMD5Context; TMD5Context = record state: TArray4UINT4; count: TArray2UINT4; buffer: TArray64Byte; end; const S11 = 7; S12 = 12; S13 = 17; S14 = 22; S21 = 5; S22 = 9; S23 = 14; S24 = 20; S31 = 4; S32 = 11; S33 = 16; S34 = 23; S41 = 6; S42 = 10; S43 = 15; S44 = 21; var Padding : TArray64Byte = ($80, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0); 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 (32-(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:=0; i:=0; while j < Len do begin output[j] := Byte(input[i] and $ff); output[j+1] := Byte((input[i] shr 8) and $ff); output[j+2] := Byte((input[i] shr 16) and $ff); output[j+3] := Byte((input[i] shr 24) and $ff); Inc(j, 4); Inc(i); end; end; procedure MD5Decode(Output: PUINT4Array; Input: PByteArray; Len: LongWord); var i, j: LongWord; begin j:=0; i:=0; while j < Len do begin Output[i] := UINT4(input[j]) or (UINT4(input[j+1]) shl 8) or (UINT4(input[j+2]) shl 16) or ( UINT4(input[j+3]) shl 24); Inc(j, 4); 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[0..15] of UINT4; begin a:=State[0]; b:=State[1]; c:=State[2]; d:=State[3]; MD5Decode(PUINT4Array(@x), PByteArray(Buffer), 64); FF (a, b, c, d, x[ 0], S11, $d76aa478); FF (d, a, b, c, x[ 1], S12, $e8c7b756); FF (c, d, a, b, x[ 2], S13, $242070db); FF (b, c, d, a, x[ 3], S14, $c1bdceee); FF (a, b, c, d, x[ 4], S11, $f57c0faf); FF (d, a, b, c, x[ 5], S12, $4787c62a); FF (c, d, a, b, x[ 6], S13, $a8304613); FF (b, c, d, a, x[ 7], S14, $fd469501); FF (a, b, c, d, x[ 8], S11, $698098d8); FF (d, a, b, c, x[ 9], S12, $8b44f7af); FF (c, d, a, b, x[10], S13, $ffff5bb1); FF (b, c, d, a, x[11], S14, $895cd7be); FF (a, b, c, d, x[12], S11, $6b901122); FF (d, a, b, c, x[13], S12, $fd987193); FF (c, d, a, b, x[14], S13, $a679438e); FF (b, c, d, a, x[15], S14, $49b40821); GG (a, b, c, d, x[ 1], S21, $f61e2562); GG (d, a, b, c, x[ 6], S22, $c040b340); GG (c, d, a, b, x[11], S23, $265e5a51); GG (b, c, d, a, x[ 0], S24, $e9b6c7aa); GG (a, b, c, d, x[ 5], S21, $d62f105d); GG (d, a, b, c, x[10], S22, $2441453); GG (c, d, a, b, x[15], S23, $d8a1e681); GG (b, c, d, a, x[ 4], S24, $e7d3fbc8); GG (a, b, c, d, x[ 9], S21, $21e1cde6); GG (d, a, b, c, x[14], S22, $c33707d6); GG (c, d, a, b, x[ 3], S23, $f4d50d87); GG (b, c, d, a, x[ 8], S24, $455a14ed); GG (a, b, c, d, x[13], S21, $a9e3e905); GG (d, a, b, c, x[ 2], S22, $fcefa3f8); GG (c, d, a, b, x[ 7], S23, $676f02d9); GG (b, c, d, a, x[12], S24, $8d2a4c8a); HH (a, b, c, d, x[ 5], S31, $fffa3942); HH (d, a, b, c, x[ 8], S32, $8771f681); HH (c, d, a, b, x[11], S33, $6d9d6122); HH (b, c, d, a, x[14], S34, $fde5380c); HH (a, b, c, d, x[ 1], S31, $a4beea44); HH (d, a, b, c, x[ 4], S32, $4bdecfa9); HH (c, d, a, b, x[ 7], S33, $f6bb4b60); HH (b, c, d, a, x[10], S34, $bebfbc70); HH (a, b, c, d, x[13], S31, $289b7ec6); HH (d, a, b, c, x[ 0], S32, $eaa127fa); HH (c, d, a, b, x[ 3], S33, $d4ef3085); HH (b, c, d, a, x[ 6], S34, $4881d05); HH (a, b, c, d, x[ 9], S31, $d9d4d039); HH (d, a, b, c, x[12], S32, $e6db99e5); HH (c, d, a, b, x[15], S33, $1fa27cf8); HH (b, c, d, a, x[ 2], S34, $c4ac5665); II (a, b, c, d, x[ 0], S41, $f4292244); II (d, a, b, c, x[ 7], S42, $432aff97); II (c, d, a, b, x[14], S43, $ab9423a7); II (b, c, d, a, x[ 5], S44, $fc93a039); II (a, b, c, d, x[12], S41, $655b59c3); II (d, a, b, c, x[ 3], S42, $8f0ccc92); II (c, d, a, b, x[10], S43, $ffeff47d); II (b, c, d, a, x[ 1], S44, $85845dd1); II (a, b, c, d, x[ 8], S41, $6fa87e4f); II (d, a, b, c, x[15], S42, $fe2ce6e0); II (c, d, a, b, x[ 6], S43, $a3014314); II (b, c, d, a, x[13], S44, $4e0811a1); II (a, b, c, d, x[ 4], S41, $f7537e82); II (d, a, b, c, x[11], S42, $bd3af235); II (c, d, a, b, x[ 2], S43, $2ad7d2bb); II (b, c, d, a, x[ 9], S44, $eb86d391); Inc(State[0], a); Inc(State[1], b); Inc(State[2], c); Inc(State[3], d); MD5_memset (PByteArray(@x), 0, SizeOf (x)); end; procedure MD5Init(var Context: TMD5Context); begin FillChar(Context, SizeOf(Context), 0); Context.state[0] := $67452301; Context.state[1] := $efcdab89; Context.state[2] := $98badcfe; Context.state[3] := $10325476; end; procedure MD5Update(var Context: TMD5Context; Input: PByteArray; InputLen: LongWord); var i, index, partLen: LongWord; begin index := LongWord( (context.count[0] shr 3) and $3F); Inc(Context.count[0], UINT4(InputLen) shl 3); if Context.count[0] < UINT4(InputLen) shl 3 then Inc(Context.count[1]); Inc(Context.count[1], UINT4(InputLen) shr 29); partLen := 64 - index; if inputLen >= partLen then begin MD5_memcpy(PByteArray(@Context.buffer[index]), Input, PartLen); MD5Transform(@Context.state, @Context.buffer); i := partLen; while i + 63 < inputLen do begin MD5Transform(@Context.state, PArray64Byte(@Input[i])); Inc(i, 64); end; index := 0; end else i:=0; MD5_memcpy(PByteArray(@Context.buffer[index]), PByteArray(@Input[i]), inputLen - i); end; procedure MD5Final(Digest: PMD5Digest; var Context: TMD5Context); var bits: array [0..7] of Byte; index, padLen: LongWord; begin MD5Encode(PByteArray(@bits), PUINT4Array(@Context.count), 8); index := LongWord( (Context.count[0] shr 3) and $3F); if index < 56 then padLen := 56 - index else padLen := 120 - index; MD5Update(Context, PByteArray(@PADDING), padLen); MD5Update(Context, PByteArray(@Bits), 8); MD5Encode(PByteArray(Digest), PUINT4Array(@Context.state), 16); MD5_memset(PByteArray(@Context), 0, SizeOf(Context)); end; function MD5DigestToStr(const Digest: TMD5Digest): string; var i: Integer; begin Result:=''; for i:=0 to 15 do Result:=Result+IntToHex(Digest.v[i], 2); 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[0..4095] of Byte; Size: Integer; ReadBytes : Integer; TotalBytes : Integer; SavePos: Integer; begin MD5Init(Context); Size:=Stream.Size; SavePos:=Stream.Position; TotalBytes:=0; try Stream.Seek(0, soFromBeginning); repeat ReadBytes:=Stream.Read(Buffer, SizeOf(Buffer)); Inc(TotalBytes, ReadBytes); MD5Update(Context, @Buffer, ReadBytes); until (ReadBytes = 0) 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 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, 9, 16);//16个字符长度的MD5签名结果 ShowMessage('32: ' +passwordDestinate32+#13#10+'16: ' + passwordDestinate16); MyMD5.Free; end;
执行结果：
注：IdHashMessageDigest.pas、IdHash.pas 均位于Indy目录下
DES加密算法:
方式一:
a)加密
var PlaintextStr:string; CiphertextArray:array[0..2048] of char; begin PlaintextStr:='加密测试！！！'; StrEncrypt(PlaintextStr,'12345678',CiphertextArray);//Encrypt.pas PublicCiphertextStr:=string(CiphertextArray); showmessage(PublicCiphertextStr); end;
运行结果：
b)解密
var PlaintextArray:array[0..2048] of char; PlaintextStr:string; begin StrDecrypt(PublicCiphertextStr,'12345678',PlaintextArray);//Encrypt.pas PlaintextStr:=string(PlaintextArray); showmessage(PlaintextStr); end;
运行结果：
注：1）Encrypt.pas代码如下：
View Code
unit Encrypt; interface uses SysUtils,Dialogs; //标准DES加密 function encryptcharBridge(buf:PChar ; buflen:Integer ; key:PChar):Integer;cdecl;external 'EncryptDecrypt.dll'; function decryptcharBridge(buf:PChar ; buflen:Integer ; key:PChar):Integer;cdecl;external 'EncryptDecrypt.dll'; //字符串加密 procedure StrEncrypt(PlaintextStr:string;KeyStr:string;CiphertextPChar:PChar); procedure StrDecrypt(CiphertextStr:string;KeyStr:string;PlaintextPChar:PChar); implementation procedure StrEncrypt(PlaintextStr:string;KeyStr:string;CiphertextPChar:PChar); var BufArray:array[0..2048] of char; BufPChar:pchar; PlaintextStrLen:Integer; KeyArray:array[0..50] of char; KeyPChar:pchar; BufLen:Integer; CiphertextStr:string; begin PlaintextStrLen:=Length(PlaintextStr); BufPChar:=Pchar(@BufArray); StrPCopy(BufPChar,PlaintextStr); KeyPChar:=Pchar(@KeyArray); StrPCopy(KeyPChar,KeyStr); encryptcharBridge(BufPChar,PlaintextStrLen,KeyPChar); CiphertextStr:=string(BufPChar);//强转时，只会对结束符#0之前字符串强转 StrPCopy(CiphertextPChar,CiphertextStr);//拷贝过去的字符串会自动在后面加结束符#0，所以原来的字符数组无需初始化 end; procedure StrDecrypt(CiphertextStr:string;KeyStr:string;PlaintextPChar:PChar); var BufArray:array[0..2048] of char; BufPChar:pchar; CiphertextStrLen:Integer; KeyArray:array[0..50] of char; KeyPChar:pchar; BufLen:Integer; PlaintextStr:string; begin CiphertextStrLen:=Length(CiphertextStr); BufPChar:=PChar(@BufArray); StrPCopy(BufPChar,CiphertextStr); KeyPChar:=Pchar(@KeyArray); StrPCopy(KeyPChar,KeyStr); decryptcharBridge(BufPChar,CiphertextStrLen,KeyPChar); PlaintextStr:=string(BufPChar);//强转时，只会对结束符#0之前字符串强转 StrPCopy(PlaintextPChar,PlaintextStr);//拷贝过去的字符串会自动在后面加结束符#0，所以原来的字符数组无需初始化 end; end.
2）另外还需要使用两个dll文件：
方式二:
a)加密
var PlaintextStr:string; begin PlaintextStr:='加密测试！'; PublicCiphertextStr:=EncryStrHex(PlaintextStr, '11111111');//StandardDES.pas showmessage(PublicCiphertextStr); end;
运行结果：
b)解密
var PlaintextStr:string; begin PlaintextStr:=DecryStrHex(PublicCiphertextStr, '11111111');//StandardDES.pas showmessage(PlaintextStr); end;
运行结果：
注：StandardDES.pas代码如下：
View Code
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, 1, 0, ''); end; function EncryStr(Str:TStream; Key: String): String; var AStr:String; begin Str.Seek(0,soFromBeginning); setlength(AStr, Str.Size); Str.Read(AStr[1], Str.Size); Result := des(Key, AStr, 1, 0, ''); end; function DecryStr(Str, Key: String): String; begin Result := trim(des(Key, Str, 0, 0, '')); end; function DecryStr(Str:TStream; Key: String): String; var AStr:String; begin Str.Seek(0,soFromBeginning); setlength(AStr, Str.Size); Str.Read(AStr[1], Str.Size); Result := trim(des(Key, AStr, 0, 0, '')); end; function EncryStrHex(Str, Key: String): String; begin Result := trim(StrToHex(des(Key, Str, 1, 0, ''))); end; function DecryStrHex(Str, Key: String): String; begin Result := trim(des(Key, HexToStr(Str), 0, 0, '')); end; function DecryStrHex(Str:TStream; Key: String): String; var AStr:String; begin Str.Seek(0,soFromBeginning); setlength(AStr, Str.Size); Str.Read(AStr[1], Str.Size); Result := trim(des(Key, HexToStr(AStr), 0, 0, '')); end; function des(key:string;smessage:string;encrypt:dword;mode:dword;iv:string):string; const spfunction1 : array[0..63] of dword = ($1010400,0,$10000,$1010404,$1010004,$10404,$4,$10000,$400,$1010400,$1010404,$400,$1000404,$1010004,$1000000,$4,$404,$1000400,$1000400,$10400,$10400,$1010000,$1010000,$1000404,$10004,$1000004,$1000004,$10004,0,$404,$10404,$1000000,$10000,$1010404,$4,$1010000,$1010400,$1000000,$1000000,$400,$1010004,$10000,$10400,$1000004,$400,$4,$1000404,$10404,$1010404,$10004,$1010000,$1000404,$1000004,$404,$10404,$1010400,$404,$1000400,$1000400,0,$10004,$10400,0,$1010004); spfunction2 : array[0..63] of dword = ($80108020,$80008000,$8000,$108020,$100000,$20,$80100020,$80008020,$80000020,$80108020,$80108000,$80000000,$80008000,$100000,$20,$80100020,$108000,$100020,$80008020,0,$80000000,$8000,$108020,$80100000,$100020,$80000020,0,$108000,$8020,$80108000,$80100000,$8020,0,$108020,$80100020,$100000,$80008020,$80100000,$80108000,$8000,$80100000,$80008000,$20,$80108020,$108020,$20,$8000,$80000000,$8020,$80108000,$100000,$80000020,$100020,$80008020,$80000020,$100020,$108000,0,$80008000,$8020,$80000000,$80100020,$80108020,$108000); spfunction3 : array[0..63] of dword = ($208,$8020200,0,$8020008,$8000200,0,$20208,$8000200,$20008,$8000008,$8000008,$20000,$8020208,$20008,$8020000,$208,$8000000,$8,$8020200,$200,$20200,$8020000,$8020008,$20208,$8000208,$20200,$20000,$8000208,$8,$8020208,$200,$8000000,$8020200,$8000000,$20008,$208,$20000,$8020200,$8000200,0,$200,$20008,$8020208,$8000200,$8000008,$200,0,$8020008,$8000208,$20000,$8000000,$8020208,$8,$20208,$20200,$8000008,$8020000,$8000208,$208,$8020000,$20208,$8,$8020008,$20200); spfunction4 : array[0..63] of dword = ($802001,$2081,$2081,$80,$802080,$800081,$800001,$2001,0,$802000,$802000,$802081,$81,0,$800080,$800001,$1,$2000,$800000,$802001,$80,$800000,$2001,$2080,$800081,$1,$2080,$800080,$2000,$802080,$802081,$81,$800080,$800001,$802000,$802081,$81,0,0,$802000,$2080,$800080,$800081,$1,$802001,$2081,$2081,$80,$802081,$81,$1,$2000,$800001,$2001,$802080,$800081,$2001,$2080,$800000,$802001,$80,$800000,$2000,$802080); spfunction5 : array[0..63] of dword = ($100,$2080100,$2080000,$42000100,$80000,$100,$40000000,$2080000,$40080100,$80000,$2000100,$40080100,$42000100,$42080000,$80100,$40000000,$2000000,$40080000,$40080000,0,$40000100,$42080100,$42080100,$2000100,$42080000,$40000100,0,$42000000,$2080100,$2000000,$42000000,$80100,$80000,$42000100,$100,$2000000,$40000000,$2080000,$42000100,$40080100,$2000100,$40000000,$42080000,$2080100,$40080100,$100,$2000000,$42080000,$42080100,$80100,$42000000,$42080100,$2080000,0,$40080000,$42000000,$80100,$2000100,$40000100,$80000,0,$40080000,$2080100,$40000100); spfunction6 : array[0..63] of dword = ($20000010,$20400000,$4000,$20404010,$20400000,$10,$20404010,$400000,$20004000,$404010,$400000,$20000010,$400010,$20004000,$20000000,$4010,0,$400010,$20004010,$4000,$404000,$20004010,$10,$20400010,$20400010,0,$404010,$20404000,$4010,$404000,$20404000,$20000000,$20004000,$10,$20400010,$404000,$20404010,$400000,$4010,$20000010,$400000,$20004000,$20000000,$4010,$20000010,$20404010,$404000,$20400000,$404010,$20404000,0,$20400010,$10,$4000,$20400000,$404010,$4000,$400010,$20004010,0,$20404000,$20000000,$400010,$20004010); spfunction7 : array[0..63] of dword = ($200000,$4200002,$4000802,0,$800,$4000802,$200802,$4200800,$4200802,$200000,0,$4000002,$2,$4000000,$4200002,$802,$4000800,$200802,$200002,$4000800,$4000002,$4200000,$4200800,$200002,$4200000,$800,$802,$4200802,$200800,$2,$4000000,$200800,$4000000,$200800,$200000,$4000802,$4000802,$4200002,$4200002,$2,$200002,$4000000,$4000800,$200000,$4200800,$802,$200802,$4200800,$802,$4000002,$4200802,$4200000,$200800,0,$2,$4200802,0,$200802,$4200000,$800,$4000002,$4000800,$800,$200002); spfunction8 : array[0..63] of dword = ($10001040,$1000,$40000,$10041040,$10000000,$10001040,$40,$10000000,$40040,$10040000,$10041040,$41000,$10041000,$41040,$1000,$40,$10040000,$10000040,$10001000,$1040,$41000,$40040,$10040040,$10041000,$1040,0,0,$10040040,$10000040,$10001000,$41040,$40000,$41040,$40000,$10041000,$1000,$40,$10040040,$1000,$41040,$10001000,$40,$10000040,$10040000,$10040040,$10000000,$40000,$10001040,0,$10041040,$40040,$10000040,$10040000,$10001000,$10001040,0,$10041040,$41000,$41000,$1040,$1040,$40040,$10000000,$10041000); 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 16 or 48 subkeys we will need keys := des_createKeys(key); m:=0;cbcleft:=0;cbcleft2:=0;cbcright:=0;cbcright2:=0;chunk:=0; len := length(smessage); //set up the loops for single and triple des if length(keys) = 32 then iterations := 3 else iterations := 9; if iterations = 3 then begin if encrypt = 1 then begin setlength(looping,3); looping[0] := 0; looping[1] := 32; looping[2] := 2; end else begin setlength(looping,3); looping[0] := 30; looping[1] := -2; looping[2] := -2; end; end else begin if encrypt = 1 then begin setlength(looping,9); looping[0] := 0; looping[1] := 32; looping[2] := 2; looping[3] := 62; looping[4] := 30; looping[5] := -2; looping[6] := 64; looping[7] := 96; looping[8] := 2; end else begin setlength(looping,9); looping[0] := 94; looping[1] := 62; looping[2] := -2; looping[3] := 32; looping[4] := 64; looping[5] := 2; looping[6] := 30; looping[7] := -2; looping[8] := -2; end; end; smessage := smessage + #0#0#0#0#0#0#0#0; //pad the message out with null bytes //store the result here result := ''; tempresult := ''; if mode = 1 then //CBC mode begin cbcleft := (ord(iv[m+1]) shl 24) or (ord(iv[m+2]) shl 16) or (ord(iv[m+3]) shl 8) or ord(iv[m+4]); cbcright := (ord(iv[m+5]) shl 24) or (ord(iv[m+6]) shl 16) or (ord(iv[m+7]) shl 8) or ord(iv[m+8]); m:=0; end; //loop through each 64 bit chunk of the message while m < len do begin left := (ord(smessage[m+1]) shl 24) or (ord(smessage[m+2]) shl 16) or (ord(smessage[m+3]) shl 8) or ord(smessage[m+4]); right := (ord(smessage[m+5]) shl 24) or (ord(smessage[m+6]) shl 16) or (ord(smessage[m+7]) shl 8) or ord(smessage[m+8]); m := m + 8; //for Cipher Block Chaining mode, xor the message with the previous result if mode = 1 then if encrypt=1 then begin left := left xor cbcleft; right := right xor cbcright; end else begin cbcleft2 := cbcleft; cbcright2 := cbcright; cbcleft := left; cbcright := right; end; //first each 64 but chunk of the message must be permuted according to IP temp := ((left shr 4) xor right) and $0f0f0f0f; right := right xor temp; left := left xor (temp shl 4); temp := ((left shr 16) xor right) and $0000ffff; right := right xor temp; left := left xor (temp shl 16); temp := ((right shr 2) xor left) and $33333333; left := left xor temp; right := right xor (temp shl 2); temp := ((right shr 8) xor left) and $00ff00ff; left := left xor temp; right := right xor (temp shl 8); temp := ((left shr 1) xor right) and $55555555; right := right xor temp; left := left xor (temp shl 1); left := ((left shl 1) or (left shr 31)); right := ((right shl 1) or (right shr 31)); //do this either 1 or 3 times for each chunk of the message j:=0; while j<iterations do begin endloop := looping[j+1]; loopinc := looping[j+2]; //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 4) or (right shl 28)) xor keys[i+1]; //the result is attained by passing these bytes through the S selection functions temp := left; left := right; right := temp xor (spfunction2[(right1 shr 24) and $3f] or spfunction4[(right1 shr 16) and $3f] or spfunction6[(right1 shr 8) and $3f] or spfunction8[right1 and $3f] or spfunction1[(right2 shr 24) and $3f] or spfunction3[(right2 shr 16) and $3f] or spfunction5[(right2 shr 8) and $3f] or spfunction7[right2 and $3f]); i:=i+loopinc; end; temp := left; left := right; right := temp; //unreverse left and right j:=j+3; end; //for either 1 or 3 iterations //move then each one bit to the right left := ((left shr 1) or (left shl 31)); right := ((right shr 1) or (right shl 31)); //now perform IP-1, which is IP in the opposite direction temp := ((left shr 1) xor right) and $55555555; right := right xor temp; left :=left xor (temp shl 1); temp := ((right shr 8) xor left) and $00ff00ff; left := left xor temp; right := right xor (temp shl 8); temp := ((right shr 2) xor left) and $33333333; left := left xor temp; right := right xor (temp shl 2); temp := ((left shr 16) xor right) and $0000ffff; right := right xor temp; left := left xor (temp shl 16); temp := ((left shr 4) xor right) and $0f0f0f0f; right := right xor temp; left := left xor (temp shl 4); //for Cipher Block Chaining mode, xor the message with the previous result if mode = 1 then if encrypt=1 then begin cbcleft := left; cbcright := right; end else begin left :=left xor cbcleft2; right := right xor cbcright2; end; tempresult := tempresult + chr(left shr 24) + chr((left shr 16) and $ff) + chr((left shr 8) and $ff) + chr(left and $ff) + chr(right shr 24) + chr((right shr 16) and $ff) + chr((right shr 8) and $ff) + chr(right and $ff); chunk := chunk + 8; if chunk = 512 then begin result := result + tempresult; tempresult := ''; chunk := 0; end; end; //for every 8 characters, or 64 bits in the message //return the result as an array result := result + tempresult; end; //end of des //des_createKeys //this takes as input a 64 bit key (even though only 56 bits are used) //as an array of 2 dwords, and returns 16 48 bit keys function des_createKeys(key:string):fdArray; const //declaring this locally speeds things up a bit pc2bytes0 :array[0..15] of dword= (0,$4,$20000000,$20000004,$10000,$10004,$20010000,$20010004,$200,$204,$20000200,$20000204,$10200,$10204,$20010200,$20010204); pc2bytes1 :array[0..15] of dword= (0,$1,$100000,$100001,$4000000,$4000001,$4100000,$4100001,$100,$101,$100100,$100101,$4000100,$4000101,$4100100,$4100101); pc2bytes2 :array[0..15] of dword= (0,$8,$800,$808,$1000000,$1000008,$1000800,$1000808,0,$8,$800,$808,$1000000,$1000008,$1000800,$1000808); pc2bytes3 :array[0..15] of dword= (0,$200000,$8000000,$8200000,$2000,$202000,$8002000,$8202000,$20000,$220000,$8020000,$8220000,$22000,$222000,$8022000,$8222000); pc2bytes4 :array[0..15] of dword= (0,$40000,$10,$40010,0,$40000,$10,$40010,$1000,$41000,$1010,$41010,$1000,$41000,$1010,$41010); pc2bytes5 :array[0..15] of dword= (0,$400,$20,$420,0,$400,$20,$420,$2000000,$2000400,$2000020,$2000420,$2000000,$2000400,$2000020,$2000420); pc2bytes6 :array[0..15] of dword= (0,$10000000,$80000,$10080000,$2,$10000002,$80002,$10080002,0,$10000000,$80000,$10080000,$2,$10000002,$80002,$10080002); pc2bytes7 :array[0..15] of dword= (0,$10000,$800,$10800,$20000000,$20010000,$20000800,$20010800,$20000,$30000,$20800,$30800,$20020000,$20030000,$20020800,$20030800); pc2bytes8 :array[0..15] of dword= (0,$40000,0,$40000,$2,$40002,$2,$40002,$2000000,$2040000,$2000000,$2040000,$2000002,$2040002,$2000002,$2040002); pc2bytes9 :array[0..15] of dword= (0,$10000000,$8,$10000008,0,$10000000,$8,$10000008,$400,$10000400,$408,$10000408,$400,$10000400,$408,$10000408); pc2bytes10 :array[0..15] of dword= (0,$20,0,$20,$100000,$100020,$100000,$100020,$2000,$2020,$2000,$2020,$102000,$102020,$102000,$102020); pc2bytes11 :array[0..15] of dword= (0,$1000000,$200,$1000200,$200000,$1200000,$200200,$1200200,$4000000,$5000000,$4000200,$5000200,$4200000,$5200000,$4200200,$5200200); pc2bytes12 :array[0..15] of dword= (0,$1000,$8000000,$8001000,$80000,$81000,$8080000,$8081000,$10,$1010,$8000010,$8001010,$80010,$81010,$8080010,$8081010); pc2bytes13 :array[0..15] of dword= (0,$4,$100,$104,0,$4,$100,$104,$1,$5,$101,$105,$1,$5,$101,$105); //now define the left shifts which need to be done shifts :array[0..15] of dword = (0, 0, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 0); var iterations:integer; keys:fdArray; lefttemp, righttemp, temp:dword; m, n, j,i:integer; left,right:dword; begin //how many iterations (1 for des, 3 for triple des) if length(key) = 24 then iterations := 3 else iterations := 1; //stores the return keys setlength(keys,32 * iterations); //other variables m:=0;n:=0; for j:=0 to iterations-1 do //either 1 or 3 iterations begin left := (ord(key[m+1]) shl 24) or (ord(key[m+2]) shl 16) or (ord(key[m+3]) shl 8) or ord(key[m+4]); right := (ord(key[m+5]) shl 24) or (ord(key[m+6]) shl 16) or (ord(key[m+7]) shl 8) or ord(key[m+8]); m:=m+8; temp := ((left shr 4) xor right) and $0f0f0f0f; right :=right xor temp; left :=left xor (temp shl 4); temp := ((right shr 16) xor left) and $0000ffff; left := left xor temp; right :=right xor (temp shl 16); temp := ((left shr 2) xor right) and $33333333; right :=right xor temp; left := left xor (temp shl 2); temp := ((right shr 16) xor left) and $0000ffff; left :=left xor temp; right := right xor (temp shl 16); temp := ((left shr 1) xor right) and $55555555; right := right xor temp; left := left xor (temp shl 1); temp := ((right shr 8) xor left) and $00ff00ff; left :=left xor temp; right := right xor (temp shl 8); temp := ((left shr 1) xor right) and $55555555; right :=right xor temp; left := left xor (temp shl 1); //the right side needs to be shifted and to get the last four bits of the left side temp := (left shl 8) or ((right shr 20) and $000000f0); //left needs to be put upside down left := (right shl 24) or ((right shl 8) and $ff0000) or ((right shr 8) and $ff00) or ((right shr 24) 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] > 0 then begin left := (left shl 2) or (left shr 26); right := (right shl 2) or (right shr 26); //left := left shl 0; //right:= right shl 0; end else begin left := (left shl 1) or (left shr 27); right := (right shl 1) or (right shr 27); //left := left shl 0; //right:= right shl 0; end; left := left and $fffffff0; right:= right and $fffffff0; //now apply PC-2, in such a way that E is easier when encrypting or decrypting //this conversion will look like PC-2 except only the last 6 bits of each byte are used //rather than 48 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 28] or pc2bytes1[(left shr 24) and $f] or pc2bytes2[(left shr 20) and $f] or pc2bytes3[(left shr 16) and $f] or pc2bytes4[(left shr 12) and $f] or pc2bytes5[(left shr 8) and $f] or pc2bytes6[(left shr 4) and $f]; righttemp := pc2bytes7[right shr 28] or pc2bytes8[(right shr 24) and $f] or pc2bytes9[(right shr 20) and $f] or pc2bytes10[(right shr 16) and $f] or pc2bytes11[(right shr 12) and $f] or pc2bytes12[(right shr 8) and $f] or pc2bytes13[(right shr 4) and $f]; temp := ((righttemp shr 16) xor lefttemp) and $0000ffff; keys[n+0] := lefttemp xor temp; keys[n+1] := righttemp xor (temp shl 16); n:=n+2; 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 := 1 to length(Str) do result := result + IntToHex(Ord(Str[i]), 2); end; function HexToStr(Hex:string):string; var i:Integer; begin Result := ''; for i := 1 to length(Hex) div 2 do if IsInt('$' + Hex[i * 2 - 1] + Hex[i * 2]) then Result := Result + Chr(StrToInt('$' + Hex[i * 2 - 1] + Hex[i * 2])); end; function IsInt(Str:String):Boolean; begin result := True; try StrToInt(Str); except result := False end; end; end.