unit Eds; {Encrypt & Decrypt String}interfaceuses SysUtils;const StartKey = 973; {Start default key} MultKey = 790314; {Mult default key} AddKey = 23916; {Add default key}function EncryptString(s: string): string; //Encrypt to number function DecryptString(s: string): string; //Decrypt from numberfunction EncodeString(s: string): string; //Encrypt to character function DecodeString(s: string): string; //Decrypt from characterimplementation{$R-} {$Q-} function Encrypt(const InString: string; StartKey, MultKey, AddKey: Integer): string; var I : Byte; begin Result := ''; for I := 1 to Length(InString) do begin Result := Result + CHAR(Byte(InString[I]) xor (StartKey shr 8)); StartKey := (Byte(Result[I]) + StartKey) * MultKey + AddKey; end; end;function Decrypt(const InString: string; StartKey, MultKey, AddKey: Integer): string; var I : Byte; begin Result := ''; for I := 1 to Length(InString) do begin Result := Result + CHAR(Byte(InString[I]) xor (StartKey shr 8)); StartKey := (Byte(InString[I]) + StartKey) * MultKey + AddKey; end; end; {$R+} {$Q+}function EncodeString(s: string): string; begin Result := Encrypt(s, StartKey, MultKey, AddKey); end;function DecodeString(s: string): string; begin Result := Decrypt(s, StartKey, MultKey, AddKey); end;Function Int2Str(int1: Integer; Len: Integer): string; var i, j: integer; begin if Length(inttostr(int1)) >= Len then Result:=Inttostr(int1) else begin Result := ''; i := Len - Length(IntToStr(Int1)); for j := 1 to i do Result := Result + '0'; Result := Result + IntToStr(Int1); end; end;function Char2ByteStr(s: string): string; var i: Byte; begin Result:=''; for i := 1 to Length(s) do Result := Result + Int2Str(Byte(s[i]), 3); end;function Byte2CharStr(s: string): string; var i: Integer; begin i := 1; Result := ''; if (Length(s) mod 3) = 0 then while i < Length(s) do begin Result := Result + Char(StrToInt(Copy(s, i, 3))); i := i + 3; end; end;function EncryptString(s: string): string; var years, months, days, hours, mins, secs, msec: Word; Sk, Mk, Ak: Longint; begin DecodeDate(Now, years, months, days); DecodeTime(Now, hours, mins, secs, msec); Sk := msec; if Sk < 256 then Sk:= Sk + 256; Mk := ((years - 1900) * 12 + months) * 30 + days + Sk * 10 + Sk; Ak := (23 * hours + mins) * 60 + secs + Sk * 10 + Sk; Result := Char2ByteStr(Encrypt(Int2Str(Sk, 3), StartKey, MultKey, AddKey)) + Char2ByteStr(Encrypt(Int2Str(Mk, 5), StartKey, MultKey, AddKey)) + Char2ByteStr(Encrypt(Int2Str(Ak, 5), StartKey, MultKey, AddKey)) + Char2ByteStr(Encrypt(s, Sk, Mk, Ak)); end;function DecryptString(s: string): string; var Sk, Mk, Ak: Longint; begin Sk := StrToInt(Decrypt(Byte2CharStr(Copy(s, 1, 9)), StartKey, MultKey, AddKey)); Mk := StrToInt(Decrypt(Byte2CharStr(Copy(s, 10, 15)), StartKey, MultKey, AddKey)); Ak := StrToInt(Decrypt(Byte2CharStr(Copy(s, 25, 15)), StartKey, MultKey, AddKey)); Result := Decrypt(Byte2CharStr(Copy(s, 40, Length(s)-39)), Sk, Mk, Ak); end;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 3 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', [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.Button3Click(Sender: TObject); begin Edit5.Text:=EncryStrHex(Edit3.Text,Edit4.Text); end;//解密 procedure TForm1.Button4Click(Sender: TObject); begin Edit5.Text:=DecryStrHex(Edit3.Text,Edit4.Text); end;end.
SysUtils;const
StartKey = 973; {Start default key}
MultKey = 790314; {Mult default key}
AddKey = 23916; {Add default key}function EncryptString(s: string): string; //Encrypt to number
function DecryptString(s: string): string; //Decrypt from numberfunction EncodeString(s: string): string; //Encrypt to character
function DecodeString(s: string): string; //Decrypt from characterimplementation{$R-}
{$Q-}
function Encrypt(const InString: string; StartKey, MultKey, AddKey: Integer): string;
var
I : Byte;
begin
Result := '';
for I := 1 to Length(InString) do
begin
Result := Result + CHAR(Byte(InString[I]) xor (StartKey shr 8));
StartKey := (Byte(Result[I]) + StartKey) * MultKey + AddKey;
end;
end;function Decrypt(const InString: string; StartKey, MultKey, AddKey: Integer): string;
var
I : Byte;
begin
Result := '';
for I := 1 to Length(InString) do
begin
Result := Result + CHAR(Byte(InString[I]) xor (StartKey shr 8));
StartKey := (Byte(InString[I]) + StartKey) * MultKey + AddKey;
end;
end;
{$R+}
{$Q+}function EncodeString(s: string): string;
begin
Result := Encrypt(s, StartKey, MultKey, AddKey);
end;function DecodeString(s: string): string;
begin
Result := Decrypt(s, StartKey, MultKey, AddKey);
end;Function Int2Str(int1: Integer; Len: Integer): string;
var
i, j: integer;
begin
if Length(inttostr(int1)) >= Len then Result:=Inttostr(int1)
else
begin
Result := '';
i := Len - Length(IntToStr(Int1));
for j := 1 to i do Result := Result + '0';
Result := Result + IntToStr(Int1);
end;
end;function Char2ByteStr(s: string): string;
var
i: Byte;
begin
Result:='';
for i := 1 to Length(s) do Result := Result + Int2Str(Byte(s[i]), 3);
end;function Byte2CharStr(s: string): string;
var
i: Integer;
begin
i := 1;
Result := '';
if (Length(s) mod 3) = 0 then
while i < Length(s) do
begin
Result := Result + Char(StrToInt(Copy(s, i, 3)));
i := i + 3;
end;
end;function EncryptString(s: string): string;
var
years, months, days, hours, mins, secs, msec: Word;
Sk, Mk, Ak: Longint;
begin
DecodeDate(Now, years, months, days);
DecodeTime(Now, hours, mins, secs, msec);
Sk := msec;
if Sk < 256 then Sk:= Sk + 256;
Mk := ((years - 1900) * 12 + months) * 30 + days + Sk * 10 + Sk;
Ak := (23 * hours + mins) * 60 + secs + Sk * 10 + Sk;
Result := Char2ByteStr(Encrypt(Int2Str(Sk, 3), StartKey, MultKey, AddKey)) +
Char2ByteStr(Encrypt(Int2Str(Mk, 5), StartKey, MultKey, AddKey)) +
Char2ByteStr(Encrypt(Int2Str(Ak, 5), StartKey, MultKey, AddKey)) +
Char2ByteStr(Encrypt(s, Sk, Mk, Ak));
end;function DecryptString(s: string): string;
var
Sk, Mk, Ak: Longint;
begin
Sk := StrToInt(Decrypt(Byte2CharStr(Copy(s, 1, 9)), StartKey, MultKey, AddKey));
Mk := StrToInt(Decrypt(Byte2CharStr(Copy(s, 10, 15)), StartKey, MultKey, AddKey));
Ak := StrToInt(Decrypt(Byte2CharStr(Copy(s, 25, 15)), StartKey, MultKey, AddKey));
Result := Decrypt(Byte2CharStr(Copy(s, 40, Length(s)-39)), Sk, Mk, Ak);
end;end.
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;
Button3: TButton;
Edit3: TEdit;
Edit4: TEdit;
Edit5: TEdit;
Button4: TButton;
procedure Button3Click(Sender: TObject);
procedure Button4Click(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, 7, 47, 15, 55, 23, 63, 31,
38, 6, 46, 14, 54, 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, 54, 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, 54,
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;
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 3 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;
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', [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.Button3Click(Sender: TObject);
begin
Edit5.Text:=EncryStrHex(Edit3.Text,Edit4.Text);
end;//解密
procedure TForm1.Button4Click(Sender: TObject);
begin
Edit5.Text:=DecryStrHex(Edit3.Text,Edit4.Text);
end;end.
dfakdfjha;lerkgj'aler大苏打发射点发射点
qaergol3i4lkfga达到发射点发射点反对adsadfadfasdflmajghlkajdshaklsdjfhalksdjfahslkdjfashdlkahasdkajhdlfkajsdhfalkdsj
w了的安定发咔叽大会；老喀哒发噶；了卡的防噶伦当然可；啊的发了可就和了卡