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,54,46,38,30,22,14,? 6 );
? BitCP: array[0..63] of Byte = //逆初始置IP-1
??? ( 39,63,
????? 38,? 6,62,
????? 37,61,
????? 36,60,
????? 35,59,
????? 34,58,
????? 33,57,
????? 32,56,24 );
? BitExp: array[0..47] of Integer = // 位选择函数E
??? ( 31,1,2,3,4,5,6,7,8,9,
????? 11,
????? 21,0? );
? BitPM: array[0..31] of Byte =? //置换函数P
??? ( 15,
?????? 1,119); font-size:13px; line-height:24px"> ? sBox: array[0..7] of array[0..63] of Byte =??? //S盒
??? ( ( 14,
???????? 0,
???????? 4,
??????? 15,13 ),
????? ( 15,
???????? 3,
??????? 13,? 9 ),119); font-size:13px; line-height:24px"> ????? ( 10,
???????? 1,12 ),119); font-size:13px; line-height:24px"> ????? (? 7,
??????? 10,14 ),119); font-size:13px; line-height:24px"> ????? (? 2,
??????? 14,
??????? 11,? 3 ),119); font-size:13px; line-height:24px"> ????? ( 12,
???????? 9,119); font-size:13px; line-height:24px"> ????? (? 4,
???????? 6,119); font-size:13px; line-height:24px"> ????? ( 13,
???????? 7,
???????? 2,11 ) );
? BitPMC1: array[0..55] of Byte = //选择置换PC-1
??? ( 56,
?????? 0,
?????? 9,
????? 18,
????? 62,
?????? 6,
????? 13,
????? 20,? 3 );
? BitPMC2: array[0..47] of Byte =//选择置换PC-2?
??? ( 13,
?????? 2,
????? 22,
????? 15,
????? 40,
????? 29,
????? 43,
????? 45,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,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,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,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,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,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,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 );
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,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,J: Integer;
begin
? if Length(Key) < 8 then
??? while Length(Key) < 8 do Key := Key + Chr(0);
? 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,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',[Ord(TempResult[I + 1])]);
??? 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('注册失败！');
///////////////////////////////////////////////////////////////////////////////
???????????????????????? //Des DEMO V1.0//
????????????????????????? //作者：ksaiy//
//欢迎使用由ksaiy制作的DES加密算法演示程序，此算法为标准的DES算法，你可以根据的
//的自己需要进行变形。具体怎么操作可以登录我们的网站查询详细的资料。我们专门为软
//件开发者提供软件加密安全测试服务和软件加密解决方案，具体的可以参看我们的网站上
//的资料。
//技术支持:ksaiy@sina.com 在线QQ：40188696 UC：934155
??????????????????????????? //End //
????????????????? //注意：转载请保留以上信息。//
///////////////////////////////////////////////////////////////////////////////
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
Close;
end;
end.
