DES算法

DES算法Delphi源代码 (14K字) 作者：

zju78

打印本页

发表于：2010年12月22日 17:41

unit Unit1;

interface uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type

TForm1 = class(TForm) Label1: TLabel; Label2: TLabel; Edit1: TEdit; Edit2: TEdit; Button1: TButton; Button2: TButton; Label3: TLabel;

procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); private

{ Private declarations } public

{ Public declarations } end; type

TKeyByte = array[0..5] of Byte;

TDesMode = (dmEncry, dmDecry);

function EncryStr(Str, Key: String): String; function DecryStr(Str, Key: String): String; function EncryStrHex(Str, Key: String): String; function DecryStrHex(StrHex, Key: String): String; const

BitIP: array[0..63] of Byte = //初始值置IP (57, 49, 41, 33, 25, 17, 9, 1, 59, 51, 43, 35, 27, 19, 11, 3, 61, 53, 45, 37, 29, 21, 13, 5, 63, 55, 47, 39, 31, 23, 15, 7, 56, 48, 40, 32, 24, 16, 8, 0, 58, 50, 42, 34, 26, 18, 10, 2, 60, 52, 44, 36, 28, 20, 12, 4, 62, , 46, 38, 30, 22, 14, 6 );

BitCP: array[0..63] of Byte = //逆初始置IP-1 ( 39, 7, 47, 15, 55, 23, 63, 31, 38, 6, 46, 14, , 22, 62, 30, 37, 5, 45, 13, 53, 21, 61, 29, 36, 4, 44, 12, 52, 20, 60, 28, 35, 3, 43, 11, 51, 19, 59, 27, 34, 2, 42, 10, 50, 18, 58, 26, 33, 1, 41, 9, 49, 17, 57, 25, 32, 0, 40, 8, 48, 16, 56, 24 );

BitExp: array[0..47] of Integer = // 位选择函数E ( 31, 0, 1, 2, 3, 4, 3, 4, 5, 6, 7, 8, 7, 8, 9,10, 11,12,11,12,13,14,15,16,15,16,17,18,19,20,19,20, 21,22,23,24,23,24,25,26,27,28,27,28,29,30,31,0 );

BitPM: array[0..31] of Byte = //置换函数P

( 15, 6,19,20,28,11,27,16, 0,14,22,25, 4,17,30, 9, 1, 7,23,13,31,26, 2, 8,18,12,29, 5,21,10, 3,24 );

sBox: array[0..7] of array[0..63] of Byte = //S盒 ( ( 14, 4, 13, 1, 2, 15, 11, 8, 3, 10, 6, 12, 5, 9, 0, 7, 0, 15, 7, 4, 14, 2, 13, 1, 10, 6, 12, 11, 9, 5, 3, 8, 4, 1, 14, 8, 13, 6, 2, 11, 15, 12, 9, 7, 3, 10, 5, 0, 15, 12, 8, 2, 4, 9, 1, 7, 5, 11, 3, 14, 10, 0, 6, 13 ),

( 15, 1, 8, 14, 6, 11, 3, 4, 9, 7, 2, 13, 12, 0, 5, 10, 3, 13, 4, 7, 15, 2, 8, 14, 12, 0, 1, 10, 6, 9, 11, 5, 0, 14, 7, 11, 10, 4, 13, 1, 5, 8, 12, 6, 9, 3, 2, 15, 13, 8, 10, 1, 3, 15, 4, 2, 11, 6, 7, 12, 0, 5, 14, 9 ),

( 10, 0, 9, 14, 6, 3, 15, 5, 1, 13, 12, 7, 11, 4, 2, 8, 13, 7, 0, 9, 3, 4, 6, 10, 2, 8, 5, 14, 12, 11, 15, 1, 13, 6, 4, 9, 8, 15, 3, 0, 11, 1, 2, 12, 5, 10, 14, 7, 1, 10, 13, 0, 6, 9, 8, 7, 4, 15, 14, 3, 11, 5, 2, 12 ),

( 7, 13, 14, 3, 0, 6, 9, 10, 1, 2, 8, 5, 11, 12, 4, 15, 13, 8, 11, 5, 6, 15, 0, 3, 4, 7, 2, 12, 1, 10, 14, 9, 10, 6, 9, 0, 12, 11, 7, 13, 15, 1, 3, 14, 5, 2, 8, 4, 3, 15, 0, 6, 10, 1, 13, 8, 9, 4, 5, 11, 12, 7, 2, 14 ),

( 2, 12, 4, 1, 7, 10, 11, 6, 8, 5, 3, 15, 13, 0, 14, 9, 14, 11, 2, 12, 4, 7, 13, 1, 5, 0, 15, 10, 3, 9, 8, 6, 4, 2, 1, 11, 10, 13, 7, 8, 15, 9, 12, 5, 6, 3, 0, 14, 11, 8, 12, 7, 1, 14, 2, 13, 6, 15, 0, 9, 10, 4, 5, 3 ),

( 12, 1, 10, 15, 9, 2, 6, 8, 0, 13, 3, 4, 14, 7, 5, 11, 10, 15, 4, 2, 7, 12, 9, 5, 6, 1, 13, 14, 0, 11, 3, 8, 9, 14, 15, 5, 2, 8, 12, 3, 7, 0, 4, 10, 1, 13, 11, 6,

4, 3, 2, 12, 9, 5, 15, 10, 11, 14, 1, 7, 6, 0, 8, 13 ),

( 4, 11, 2, 14, 15, 0, 8, 13, 3, 12, 9, 7, 5, 10, 6, 1, 13, 0, 11, 7, 4, 9, 1, 10, 14, 3, 5, 12, 2, 15, 8, 6, 1, 4, 11, 13, 12, 3, 7, 14, 10, 15, 6, 8, 0, 5, 9, 2, 6, 11, 13, 8, 1, 4, 10, 7, 9, 5, 0, 15, 14, 2, 3, 12 ),

( 13, 2, 8, 4, 6, 15, 11, 1, 10, 9, 3, 14, 5, 0, 12, 7, 1, 15, 13, 8, 10, 3, 7, 4, 12, 5, 6, 11, 0, 14, 9, 2, 7, 11, 4, 1, 9, 12, 14, 2, 0, 6, 10, 13, 15, 3, 5, 8, 2, 1, 14, 7, 4, 10, 8, 13, 15, 12, 9, 0, 3, 5, 6, 11 ) );

BitPMC1: array[0..55] of Byte = //选择置换PC-1 ( 56, 48, 40, 32, 24, 16, 8, 0, 57, 49, 41, 33, 25, 17, 9, 1, 58, 50, 42, 34, 26, 18, 10, 2, 59, 51, 43, 35, 62, , 46, 38, 30, 22, 14, 6, 61, 53, 45, 37, 29, 21, 13, 5, 60, 52, 44, 36, 28, 20, 12, 4, 27, 19, 11, 3 );

BitPMC2: array[0..47] of Byte =//选择置换PC-2 ( 13, 16, 10, 23, 0, 4, 2, 27, 14, 5, 20, 9, 22, 18, 11, 3, 25, 7, 15, 6, 26, 19, 12, 1, 40, 51, 30, 36, 46, , 29, 39, 50, 44, 32, 47, 43, 48, 38, 55, 33, 52, 45, 41, 49, 35, 28, 31 ); var

Form1: TForm1;

subKey: array[0..15] of TKeyByte;

implementation

{$R *.dfm}

procedure initPermutation(var inData: array of Byte); var

newData: array[0..7] of Byte; i: Integer; begin

FillChar(newData, 8, 0); for i := 0 to 63 do

if (inData[BitIP[i] shr 3] and (1 shl (7- (BitIP[i] and $07)))) <> 0 then newData[i shr 3] := newData[i shr 3] or (1 shl (7-(i and $07))); for i := 0 to 7 do inData[i] := newData[i]; end;

procedure conversePermutation(var inData: array of Byte); var

newData: array[0..7] of Byte; i: Integer; begin

FillChar(newData, 8, 0); for i := 0 to 63 do

if (inData[BitCP[i] shr 3] and (1 shl (7-(BitCP[i] and $07)))) <> 0 then newData[i shr 3] := newData[i shr 3] or (1 shl (7-(i and $07))); for i := 0 to 7 do inData[i] := newData[i]; end;

procedure expand(inData: array of Byte; var outData: array of Byte); var

i: Integer; begin

FillChar(outData, 6, 0); for i := 0 to 47 do

if (inData[BitExp[i] shr 3] and (1 shl (7-(BitExp[i] and $07)))) <> 0 then outData[i shr 3] := outData[i shr 3] or (1 shl (7-(i and $07))); end;

procedure permutation(var inData: array of Byte); var

newData: array[0..3] of Byte; i: Integer; begin

FillChar(newData, 4, 0); for i := 0 to 31 do

if (inData[BitPM[i] shr 3] and (1 shl (7-(BitPM[i] and $07)))) <> 0 then newData[i shr 3] := newData[i shr 3] or (1 shl (7-(i and $07))); for i := 0 to 3 do inData[i] := newData[i]; end;

function si(s,inByte: Byte): Byte; var c: Byte; begin

c := (inByte and $20) or ((inByte and $1e) shr 1) or ((inByte and $01) shl 4); Result := (sBox[s][c] and $0f); end;

procedure permutationChoose1(inData: array of Byte; var outData: array of Byte); var i: Integer;

begin

FillChar(outData, 7, 0); for i := 0 to 55 do

if (inData[BitPMC1[i] shr 3] and (1 shl (7-(BitPMC1[i] and $07)))) <> 0 then outData[i shr 3] := outData[i shr 3] or (1 shl (7-(i and $07))); end;

procedure permutationChoose2(inData: array of Byte; var outData: array of Byte); var i: Integer; begin

FillChar(outData, 6, 0); for i := 0 to 47 do

if (inData[BitPMC2[i] shr 3] and (1 shl (7-(BitPMC2[i] and $07)))) <> 0 then outData[i shr 3] := outData[i shr 3] or (1 shl (7-(i and $07))); end;

procedure cycleMove(var inData: array of Byte; bitMove: Byte); var i: Integer; begin

for i := 0 to bitMove - 1 do begin

inData[0] := (inData[0] shl 1) or (inData[1] shr 7); inData[1] := (inData[1] shl 1) or (inData[2] shr 7); inData[2] := (inData[2] shl 1) or (inData[3] shr 7);

inData[3] := (inData[3] shl 1) or ((inData[0] and $10) shr 4); inData[0] := (inData[0] and $0f); end; end;

procedure makeKey(inKey: array of Byte; var outKey: array of TKeyByte);

const

bitDisplace: array[0..15] of Byte = ( 1,1,2,2, 2,2,2,2, 1,2,2,2, 2,2,2,1 ); var

outData56: array[0..6] of Byte; key28l: array[0..3] of Byte; key28r: array[0..3] of Byte; key56o: array[0..6] of Byte; i: Integer; begin

permutationChoose1(inKey, outData56);

key28l[0] := outData56[0] shr 4;

key28l[1] := (outData56[0] shl 4) or (outData56[1] shr 4); key28l[2] := (outData56[1] shl 4) or (outData56[2] shr 4); key28l[3] := (outData56[2] shl 4) or (outData56[3] shr 4); key28r[0] := outData56[3] and $0f; key28r[1] := outData56[4]; key28r[2] := outData56[5]; key28r[3] := outData56[6];

for i := 0 to 15 do begin

cycleMove(key28l, bitDisplace[i]); cycleMove(key28r, bitDisplace[i]);

key56o[0] := (key28l[0] shl 4) or (key28l[1] shr 4); key56o[1] := (key28l[1] shl 4) or (key28l[2] shr 4); key56o[2] := (key28l[2] shl 4) or (key28l[3] shr 4); key56o[3] := (key28l[3] shl 4) or (key28r[0]); key56o[4] := key28r[1]; key56o[5] := key28r[2]; key56o[6] := key28r[3];

permutationChoose2(key56o, outKey[i]);

end; end;

procedure encry(inData, subKey: array of Byte; var outData: array of Byte); var

outBuf: array[0..5] of Byte; buf: array[0..7] of Byte; i: Integer; begin

expand(inData, outBuf);

for i := 0 to 5 do outBuf[i] := outBuf[i] xor subKey[i]; buf[0] := outBuf[0] shr 2;

buf[1] := ((outBuf[0] and $03) shl 4) or (outBuf[1] shr 4); buf[2] := ((outBuf[1] and $0f) shl 2) or (outBuf[2] shr 6); buf[3] := outBuf[2] and $3f; buf[4] := outBuf[3] shr 2;

buf[5] := ((outBuf[3] and $03) shl 4) or (outBuf[4] shr 4); buf[6] := ((outBuf[4] and $0f) shl 2) or (outBuf[5] shr 6); buf[7] := outBuf[5] and $3f;

for i := 0 to 7 do buf[i] := si(i, buf[i]);

for i := 0 to 3 do outBuf[i] := (buf[i*2] shl 4) or buf[i*2+1]; permutation(outBuf);

for i := 0 to 3 do outData[i] := outBuf[i]; end;

procedure desData(desMode: TDesMode;

inData: array of Byte; var outData: array of Byte); // inData, outData 都为8Bytes，否则出错 var

i, j: Integer;

temp, buf: array[0..3] of Byte; begin

for i := 0 to 7 do outData[i] := inData[i]; initPermutation(outData); if desMode = dmEncry then begin

for i := 0 to 15 do begin

for j := 0 to 3 do temp[j] := outData[j]; //temp = Ln for j := 0 to 3 do outData[j] := outData[j + 4]; //Ln+1 = Rn encry(outData, subKey[i], buf); //Rn ==Kn==> buf

for j := 0 to 3 do outData[j + 4] := temp[j] xor buf[j]; //Rn+1 = Ln^buf end;

for j := 0 to 3 do temp[j] := outData[j + 4]; for j := 0 to 3 do outData[j + 4] := outData[j]; for j := 0 to 3 do outData[j] := temp[j]; end

else if desMode = dmDecry then begin

for i := 15 downto 0 do begin

for j := 0 to 3 do temp[j] := outData[j]; for j := 0 to 3 do outData[j] := outData[j + 4]; encry(outData, subKey[i], buf);

for j := 0 to 3 do outData[j + 4] := temp[j] xor buf[j]; end;

for j := 0 to 3 do temp[j] := outData[j + 4]; for j := 0 to 3 do outData[j + 4] := outData[j]; for j := 0 to 3 do outData[j] := temp[j]; end;

conversePermutation(outData); end;

//////////////////////////////////////////////////////////////

function EncryStr(Str, Key: String): String; var

StrByte, OutByte, KeyByte: array[0..7] of Byte; StrResult: String; I, J: Integer; begin

if (Length(Str) > 0) and (Ord(Str[Length(Str)]) = 0) then raise Exception.Create(\"Error: the last char is NULL char.\"); if Length(Key) < 8 then

while Length(Key) < 8 do Key := Key + Chr(0); while Length(Str) mod 8 <> 0 do Str := Str + Chr(0);

for J := 0 to 7 do KeyByte[J] := Ord(Key[J + 1]); makeKey(keyByte, subKey);

StrResult := \"\";

for I := 0 to Length(Str) div 8 - 1 do begin

for J := 0 to 7 do

StrByte[J] := Ord(Str[I * 8 + J + 1]); desData(dmEncry, StrByte, OutByte); for J := 0 to 7 do

StrResult := StrResult + Chr(OutByte[J]); end;

Result := StrResult; end;

function DecryStr(Str, Key: String): String; var

StrByte, OutByte, KeyByte: array[0..7] of Byte;

StrResult: String; I, J: Integer; begin

if Length(Key) < 8 then

while Length(Key) < 8 do Key := Key + Chr(0);

for J := 0 to 7 do KeyByte[J] := Ord(Key[J + 1]); makeKey(keyByte, subKey);

StrResult := \"\";

for I := 0 to Length(Str) div 8 - 1 do begin

for J := 0 to 7 do StrByte[J] := Ord(Str[I * 8 + J + 1]); desData(dmDecry, StrByte, OutByte); for J := 0 to 7 do

StrResult := StrResult + Chr(OutByte[J]); end;

while (Length(StrResult) > 0) and

(Ord(StrResult[Length(StrResult)]) = 0) do Delete(StrResult, Length(StrResult), 1); Result := StrResult; end;

///////////////////////////////////////////////////////////

function EncryStrHex(Str, Key: String): String; var

StrResult, TempResult, Temp: String; I: Integer; begin

TempResult := EncryStr(Str, Key); StrResult := \"\";

for I := 0 to Length(TempResult) - 1 do begin

Temp := Format(\"%x\if Length(Temp) = 1 then Temp := \"0\" + Temp; StrResult := StrResult + Temp; end;

Result := StrResult; end;

function DecryStrHex(StrHex, Key: String): String; function HexToInt(Hex: String): Integer; var

I, Res: Integer; ch: Char; begin Res := 0;

for I := 0 to Length(Hex) - 1 do begin

ch := Hex[I + 1];

if (ch >= \"0\") and (ch <= \"9\") then Res := Res * 16 + Ord(ch) - Ord(\"0\") else if (ch >= \"A\") and (ch <= \"F\") then Res := Res * 16 + Ord(ch) - Ord(\"A\") + 10 else if (ch >= \"a\") and (ch <= \"f\") then Res := Res * 16 + Ord(ch) - Ord(\"a\") + 10

else raise Exception.Create(\"Error: not a Hex String\"); end;

Result := Res; end; var

Str, Temp: String; I: Integer;

begin Str := \"\";

for I := 0 to Length(StrHex) div 2 - 1 do begin

Temp := Copy(StrHex, I * 2 + 1, 2); Str := Str + Chr(HexToInt(Temp)); end;

Result := DecryStr(Str, Key); end;

procedure TForm1.Button1Click(Sender: TObject); begin

//function EncryStrHex(Str, Key: String): String; //这里的Str表示你要进行加密的字符串，Key表示密钥； //function DecryStrHex(StrHex, Key: String): String; //这里的Str表示你要进行解密的字符串，Key表示密钥；

if EncryStrhex(Edit1.Text,\"ksaiy\")=Edit2.Text then //这里的ksaiy是密钥，你可以设置自己的密钥。 ShowMessage(\"注册成功！\") else

ShowMessage(\"注册失败！\");

/////////////////////////////////////////////////////////////////////////////// -