修改整合了下网上的DES算法源码，主要是方便加解密不可显示字符。代码如下：
///////////////////////////////////////////////////////////////////////////////
//Des DEMO V1.0//
//作者：ksaiy//
//整合修改：Eddy//
///////////////////////////////////////////////////////////////////////////////
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Label1: TLabel;
Label2: TLabel;
Button1: TButton;
Button2: TButton;
Label4: TLabel;
Edit3: TEdit;
Label5: TLabel;
Edit4: TEdit;
Memo1: TMemo;
Memo2: TMemo;
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, 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;
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;
///////////////////////////////////////////////////////////
//-----------------------------------------------
//16进制字符转整数,16进制字符与字符串转换中间函数
//-----------------------------------------------
function HexToInt(hex: string): integer;
var
i: integer;
function Ncf(num, f: integer): integer;
var
i: integer;
begin
Result := 1;
if f = 0 then exit;
for i := 1 to f do
result := result * num;
end;
function HexCharToInt(HexToken: char): integer;
begin
if HexToken > #97 then
HexToken := Chr(Ord(HexToken) - 32);
Result := 0;
if (HexToken > #47) and (HexToken < #58) then { chars 0....9 }
Result := Ord(HexToken) - 48
else if (HexToken > #64) and (HexToken < #71) then { chars A....F }
Result := Ord(HexToken) - 65 + 10;
end;
begin
result := 0;
hex := ansiuppercase(trim(hex));
if hex = '' then
exit;
for i := 1 to length(hex) do
result := result + HexCharToInt(hex[i]) * ncf(16, length(hex) - i);
end;
//-----------------------------------------------
//字符串转16进制字符
//-----------------------------------------------
function StringToHex(str: string): string;
var
i : integer;
s : string;
begin
for i:=1 to length(str) do begin
s := s + InttoHex(Integer(str[i]),2);
end;
Result:=s;
end;
//-----------------------------------------------
//16进制字符转字符串
//-----------------------------------------------
function hextostring(str: string): string;
var
s,t:string;
i,j:integer;
p:pchar;
begin
s:='';
i:=1;
while i< length(str) do begin
t:=str[i]+str[i+1];
s:=s+chr(hextoint(t));
i:=i+2;
end;
result:=s;
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);
var
strtem,strtem2: string;
begin
//function EncryStrHex(Str, Key: String): String;
//这里的Str表示你要进行加密的字符串，Key表示密钥；
//function DecryStrHex(StrHex, Key: String): String;
//这里的Str表示你要进行解密的字符串，Key表示密钥；
//解密
strtem2 := DecryStrHex(strtem2,'12345678');
strtem2 := DecryStrHex(StringToHex(strtem2),'12345678');
//加密
strtem := EncryStrhex(strtem,'12345678');
strtem := EncryStrhex(hextostring(strtem),'12345678');
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
Close;
end;
end.
已经有(0)位网友发表了评论，你也评一评吧！
原创文章如转载，请注明：转载自Eddy Blog
原文地址：http://www.rrgod.com/decryption/753.html 欢迎订阅Eddy Blog。