DES加密
来源:互联网 发布:修改淘宝绑定手机号码 编辑:程序博客网 时间:2024/05/22 06:48
unit DES;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
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
subKey: array[0..15] of TKeyByte;
implementation
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', [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;
end.
- DES加密
- DES加密
- DES加密
- DES加密
- DES加密
- DES加密
- DES加密
- DES 加密
- DES加密
- DES加密
- DES 加密
- DES加密
- DES加密
- DES加密
- DES加密
- DES加密
- des加密
- DES加密
- 网络函数库
- 内码转换单元
- access连接字符串
- about BACH
- Spring Framework标记库初学者指南(转)
- DES加密
- 用Delphi处理公历到农历的转换
- 探索 XML 加密,第 1 部分
- Java获取CPU序列号和网卡Mac地址
- 怎么加入和管理圈子
- Hibernate- 包作用详解
- 通用动态交叉表的实现
- 最优二叉树的利用程序
- Office函数库(EXCEL)