【Delphi】一个功能齐全的Delphi DES类（含3DES）[更新20201130]
说明：
DES要求密码长度为8Bytes，初始向量为8Bytes；
3DES要求密码长度为3*8=24Bytes，初始向量为8Bytes；
在此程序中，如果密码和初始向量的长度不足则以0补够，超出所需长度的则忽略。
ECB模式下，不需要提供初始向量
Uses列表中System.NetEncoding这个单元要较新的Delphi版本才有。
如果Delphi版本较低，但没有用到base64，可以把此单元、以及涉及此单元的过程和函数移除掉。
如果一定要用，可以用indy的TIdEncoderMIME和TIdDecoderMIME来代替，具体用法可在网上搜索。
另外本次修改把base64字符串改为默认不带换行符（#13#10）。源代码也有带换行符的设定，只是被注释掉了，如以下所示：
//Base64Encoding := TBase64Encoding.Create; //含换行符
//包含DES加/解密和3DES加/解密
//---------------------------------------------------------------------------
unit u3DES;
interface
uses
{$IF CompilerVersion <= 22}
Forms, Classes, Windows, SysUtils, NetEncoding;
{$ELSE}
Vcl.Forms, System.Classes, Winapi.Windows, System.SysUtils, System.NetEncoding;
{$ENDIF}
type
TCipherMode = (cmECB, cmCBC, cmCFB, cmOFB, cmPCBC);
TPaddingMode = (pmZERO, pmPKCS5, pmPKCS7, pmISO10126, pmANSIX923, pmOneAndZero, pmNONE);
TDES = class
Private
type
TBuffer = class
private
function GetDataLength: Integer; inline;
procedure SetDataLength(Len: Integer); inline;
function GetItem(Index: Integer): Byte; inline;
procedure SetItem(Index: Integer; Value: Byte); inline;
public
Data: TBytes; //TBytes = array of Byte;
procedure FromString(const Str: String; Encoding: TEncoding = nil); //默认为utf8
procedure FromHexString(const Str: String);
procedure FromDelimitedHexString(HexStr: String; Prefix: String = '$'; Delimitor: String = ',');
procedure FromBase64String(const Str: String);
procedure FromBytes(const InBytes: TBytes; ByteLen: Integer = -1); overload;
procedure FromBytes(const InBytes: array of Byte; ByteLen: Integer = -1); overload;
procedure FromStream(const Stream: TStream; ByteLen: Integer = -1);
procedure FromFile(const FileName: String);
function ToString(Encoding: TEncoding = nil): String; reintroduce; //默认为utf8
function ToHexString: String;
function ToDelimitedHexString(Prefix: String = '$'; Delimitor: String = ', '): String;
function ToBase64String: String;
procedure ToBytes(var OutBytes: TBytes; ByteLen: Integer = -1); overload;
procedure ToBytes(var OutBytes: array of Byte; ByteLen: Integer = -1); overload;
procedure ToStream(const Stream: TStream);
procedure ToFile(const FileName: String; Warning: Boolean = True);
property Length: Integer read GetDataLength write SetDataLength;
property Bytes[Index: Integer]: Byte read GetItem write SetItem; default;
end;
TDesType = (dtEncrypt, dtDecrypt);
TKeyByte = array[0..5 ] of Byte;
TSubKey = array[0..15] of TKeyByte;
var
DesType: TDesType;
SubKey : TSubKey;
SubKeys: array of TSubKey;
procedure InitPermutation(var InData: array of Byte);
procedure ConversePermutation(var InData: array of Byte);
procedure Expand(InData: array of Byte; var OutData: array of Byte);
procedure Permutation(var InData: array of Byte);
function Si(S, InByte: Byte): Byte;
procedure PermutationChoose1(InData: array of Byte; var OutData: array of Byte);
procedure PermutationChoose2(InData: array of Byte; var OutData: array of Byte);
procedure CycleMove(var InData: array of Byte; BitMove: Byte);
procedure MakeKey(InKey: array of Byte; var OutKey: array of TKeyByte);
procedure MakeKeys;
procedure BaseDes (InData, SubKey: array of Byte; var OutData: array of Byte);
procedure CipherBlock(DesKind: TDesType; InData: array of Byte; var OutData: array of Byte);
procedure AddPadding;
procedure RemovePadding;
procedure MultipleDES(InBLock: UInt64; var OutBlock: UInt64; ForcedEncrypt: Boolean = False);
procedure CipherData;
public
DesLevel : Byte;
PaddingMode: TPaddingMode;
CipherMode : TCipherMode;
SrcBuffer, KeyBuffer, IVBuffer, DestBuffer: TBuffer;
procedure Encrypt;
procedure Decrypt;
constructor Create; overload;
constructor Create(aDesLevel: Byte; aCipherMode: TCipherMode; aPaddingMode: TPaddingMode); overload;
destructor Destroy; override;
end;
T3DES = class(TDES)
public
constructor Create; overload;
end;
resourcestring
SInvalidBufSize = 'Invalid buffer size for ouput';
implementation
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 );
constructor TDES.Create;
begin
inherited;
DesType := TDesType.dtEncrypt;
CipherMode := TCipherMode.cmECB;
DesLevel := 1;
PaddingMode:= TPaddingMode.pmPKCS7;
SrcBuffer := TBuffer.Create;
KeyBuffer := TBuffer.Create;
IVBuffer := TBuffer.Create;
DestBuffer := TBuffer.Create;
end;
constructor TDES.Create(aDesLevel: Byte; aCipherMode: TCipherMode; aPaddingMode: TPaddingMode);
begin
Create;
DesLevel := aDesLevel;
CipherMode := aCipherMode;
PaddingMode := aPaddingMode;
end;
destructor TDES.Destroy;
begin
SrcBuffer.Free;
KeyBuffer.Free;
IVBuffer.Free;
DestBuffer.Free;
inherited;
end;
constructor T3DES.Create;
begin
inherited;
DesLevel := 3;
end;
procedure TDES.InitPermutation(var InData: array of Byte);
var
I: Integer;
NewData: array[0..7] of Byte;
begin
FillChar(NewData,8,0);
for I := 0 to 63 do
begin
if (InData[BitIP[I] shr 3] and (1 shl (7-(BitIP[I] and $07))))<>0 then
begin
NewData[I shr 3] := NewData[I shr 3] or (1 shl (7-(I and $07)));
end;
end;
for I := 0 to 7 do InData[I] := NewData[I];
end;
//---------------------------------------------------------------------------
procedure TDES.ConversePermutation(var InData: array of Byte);
var
I: Integer;
NewData: array[0..7] of Byte;
begin
FillChar(NewData, 8, 0);
for I := 0 to 63 do
begin
if (InData[BitCP[I] shr 3] and (1 shl (7-(BitCP[I] and $07))))<>0 then
begin
NewData[I shr 3] := NewData[I shr 3] or (1 shl (7-(I and $07)));
end;
end;
for I := 0 to 7 do InData[I] := NewData[I];
end;
//---------------------------------------------------------------------------
procedure TDES.Expand(InData: array of Byte; var OutData: array of Byte);
var
I: Integer;
begin
FillChar(OutData, 6, 0);
for I := 0 to 47 do
begin
if (InData[BitExp[I] shr 3] and (1 shl (7-(BitExp[I] and $07))))<>0 then
begin
OutData[I shr 3] := OutData[I shr 3] or (1 shl (7-(I and $07)));
end;
end;
end;
//---------------------------------------------------------------------------
procedure TDES.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
begin
if (InData[BitPM[I] shr 3] and (1 shl (7-(BitPM[I] and $07))))<>0 then
begin
NewData[I shr 3] := NewData[I shr 3] or (1 shl (7-(I and $07)));
end;
end;
for I := 0 to 3 do InData[I] := NewData[I];
end;
//---------------------------------------------------------------------------
function TDES.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 TDES.PermutationChoose1(InData: array of Byte; var OutData: array of Byte);
var
I: Integer;
begin
FillChar(OutData, 7, 0);
for I := 0 to 55 do
begin
if (InData[BitPMC1[I] shr 3] and (1 shl (7-(BitPMC1[I] and $07))))<>0 then
begin
OutData[I shr 3] := OutData[I shr 3] or (1 shl (7-(I and $07)));
end;
end;
end;
//---------------------------------------------------------------------------
procedure TDES.PermutationChoose2(InData: array of Byte; var OutData: array of Byte);
var
I: Integer;
begin
FillChar(OutData, 6, 0);
for I := 0 to 47 do
begin
if (InData[BitPMC2[I] shr 3] and (1 shl (7-(BitPMC2[I] and $07))))<>0 then
begin
OutData[I shr 3] := OutData[I shr 3] or (1 shl (7-(I and $07)));
end;
end;
end;
//---------------------------------------------------------------------------
procedure TDES.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 TDES.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
I: Integer;
Key56o: array[0..6] of Byte;
Key28l: array[0..3] of Byte;
Key28r: array[0..3] of Byte;
OutData56: array[0..6] of Byte;
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 TDES.BaseDes(InData, SubKey: array of Byte; var OutData: array of Byte);
var
I: Integer;
Buf: array[0..7] of Byte;
OutBuf: array[0..5] of Byte;
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 TDES.CipherBlock(DesKind: TDesType; InData: array of Byte; var OutData: array of Byte);
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 DesKind = dtEncrypt then
begin
for I := 0 to 15 do
begin
for J := 0 to 3 do Temp[J] := OutData[J];
for J := 0 to 3 do OutData[J] := OutData[J+4];
BaseDes(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
else if DesKind = dtDecrypt 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];
BaseDes(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;
//---------------------------------------------------------------------------
procedure TDES.AddPadding;
var
I, M, N, Len, NewLen: Integer;
begin
if DesType = dtEncrypt then
begin
Len := Length(SrcBuffer.Data);
M := (Len mod 8);
if (M = 0) and (PaddingMode = pmNONE) then
N := 0
else
N := 8 - M;
NewLen := Len + N;
SetLength(SrcBuffer.Data, NewLen);
case PaddingMode of
pmPKCS5, pmPKCS7:
begin
for I := Len to NewLen-1 do SrcBuffer.Data[I] := N;
end;
pmANSIX923:
begin
for I := Len to NewLen-1 do
begin
if I < NewLen-1 then
SrcBuffer.Data[I] := 0
else
SrcBuffer.Data[I] := N;
end;
end;
pmISO10126:
begin
Randomize;
for I := Len to NewLen-1 do
begin
if I < NewLen-1 then
SrcBuffer.Data[I] := Random(255)
else
SrcBuffer.Data[I] := N;
end;
end;
pmZERO, pmNONE:
begin
for I := Len to NewLen-1 do SrcBuffer.Data[I] := 0;
end;
pmOneAndZero:
begin
for I := Len to NewLen-1 do
begin
if I = Len then
SrcBuffer.Data[I] := $80
else
SrcBuffer.Data[I] := 0;
end;
end;
end;
end;
Len := Length(KeyBuffer.Data);
SetLength(KeyBuffer.Data, 8*DesLevel);
for I := Len to Length(KeyBuffer.Data)-1 do
begin
KeyBuffer.Data[I] := 0;
end;
if CipherMode <> cmECB then
begin
Len := Length(IVBuffer.Data);
SetLength(IVBuffer.Data, 8);
for I := Len to Length(IVBuffer.Data)-1 do
IVBuffer.Data[I] := 0;
end;
end;
//---------------------------------------------------------------------------
procedure TDES.RemovePadding;
var
I, M, Len: Integer;
begin
Len := Length(DestBuffer.Data);
case PaddingMode of
pmPKCS5, pmPKCS7, pmANSIX923, pmISO10126:
begin
M := DestBuffer.Data[Len-1];
SetLength(DestBuffer.Data, Len-M);
end;
pmZERO, pmNONE:
begin
for I := Len-1 downto 0 do
begin
if DestBuffer.Data[I] = 0 then
Dec(Len)
else
Break;
end;
SetLength(DestBuffer.Data, Len);
end;
pmOneAndZero:
begin
for I := Len-1 downto 0 do
begin
if DestBuffer.Data[I] <> $80 then
Dec(Len)
else
Break;
end;
SetLength(DestBuffer.Data, Len-1);
end;
end;
end;
//---------------------------------------------------------------------------
procedure TDES.MakeKeys;
var
I: Integer;
KD: array[0..7] of Byte;
begin
SetLength(SubKeys, DesLevel);
for I := 0 to DesLevel-1 do
begin
Move(KeyBuffer.Data[8*I], KD, 8);
MakeKey(KD, SubKeys[I]);
end;
end;
//---------------------------------------------------------------------------
procedure TDES.MultipleDES(InBLock: UInt64; var OutBlock: UInt64; ForcedEncrypt: Boolean);
var
I: Integer;
DT: TDesType;
InBuf : array[0..7] of Byte absolute InBLock;
OutBuf: array[0..7] of Byte absolute OutBlock;
begin
if ForcedEncrypt = True then
DT := dtEncrypt
else
begin
DT := DesType;
if (DT = dtDecrypt) and ((DesLevel mod 2) = 0) then
DT := DtEncrypt;
end;
for I := 0 to DesLevel-1 do
begin
if ForcedEncrypt or (DesType = dtEncrypt) then
Move(SubKeys[I], SubKey, Sizeof(SubKey))
else
Move(SubKeys[DesLevel-I-1], SubKey, Sizeof(SubKey));
CipherBlock(DT, InBuf, OutBuf);
InBLock := OutBlock;
if DT = dtEncrypt then
DT := dtDecrypt
else
DT := dtEncrypt;
end;
end;
//---------------------------------------------------------------------------
procedure TDES.CipherData;
var
I, Len: Integer;
InBLock, IVBlock, OutBlock: UInt64;
begin
MakeKeys;
Len := Length(SrcBuffer.Data);
SetLength(DestBuffer.Data, Len);
if CipherMode <> cmECB then
Move(IVBuffer.Data[0], IVBlock, 8);
for I := 0 to (Len div 8) - 1 do
begin
Move(SrcBuffer.Data[I*8], InBLock, 8);
case CipherMode of
cmECB: //Electronic Codebook (ECB)
begin
MultipleDES(InBLock, OutBlock);
end;
cmCBC: //Cipher Block Chaining (CBC)
begin
if DesType = dtEncrypt then
begin
InBLock := InBLock xor IVBlock;
MultipleDES(InBLock, OutBlock);
IVBlock := OutBlock;
end
else
begin
MultipleDES(InBLock, OutBlock);
OutBlock := OutBlock xor IVBlock;
IVBlock := InBLock;
end;
end;
cmPCBC: //Propagating Cipher Block Chaining (PCBC)
begin
if DesType = dtEncrypt then
begin
IVBlock := IVBlock xor InBLock;
MultipleDES(IVBlock, OutBlock);
end
else
begin
MultipleDES(InBLock, OutBlock);
OutBlock := OutBlock xor IVBlock;
end;
IVBlock := OutBlock xor InBLock;
end;
cmCFB: //Cipher Feedback (CFB)
begin
MultipleDES(IVBlock, OutBlock, True);
OutBlock := InBLock xor OutBlock;
if DesType = dtEncrypt then
IVBlock := OutBlock
else
IVBlock := InBLock;
end;
cmOFB: //Output Feedback (OFB)
begin
MultipleDES(IVBlock, OutBlock, True);
IVBlock := OutBlock;
OutBlock := InBLock xor OutBlock;
end;
end;
Move(OutBlock, DestBuffer.Data[I*8], 8);
end;
end;
//---------------------------------------------------------------------------
procedure TDES.Encrypt;
begin
DesType := dtEncrypt;
AddPadding;
CipherData;
end;
//---------------------------------------------------------------------------
procedure TDES.Decrypt;
begin
DesType := dtDecrypt;;
AddPadding;
CipherData;
RemovePadding;
end;
//---------------------------------------------------------------------------
//-----------------------------TBuffer---------------------------------------
//---------------------------------------------------------------------------
function TDES.TBuffer.GetDataLength: Integer;
begin
Result := System.Length(Data);
end;
procedure TDES.TBuffer.SetDataLength(Len: Integer);
begin
System.SetLength(Data, Len);
end;
function TDES.TBuffer.GetItem(Index: Integer): Byte;
begin
Result := Data[Index];
end;
procedure TDES.TBuffer.SetItem(Index: Integer; Value: Byte);
begin
Data[Index] := Value;
end;
procedure TDES.TBuffer.FromString(const Str: String; Encoding: TEncoding);
begin
if (Encoding = nil) then Encoding := TEncoding.UTF8;
Data := Encoding.GetBytes(Str);
end;
procedure TDES.TBuffer.FromHexString(const Str: String);
var
Len: Integer;
begin
Len := System.Length(Str) div 2;
SetLength(Data, Len);
HexToBin(PChar(Str), @Data[0], Len)
end;
procedure TDES.TBuffer.FromDelimitedHexString(HexStr: String; Prefix: String; Delimitor: String);
var
Len: Integer;
begin
HexStr := HexStr.Replace(Prefix , '');
HexStr := HexStr.Replace(Delimitor , '');
HexStr := HexStr.Replace(' ' , '');
Len := System.Length(HexStr) div 2;
SetLength(Data, Len);
HexToBin(PChar(HexStr), @Data[0], Len)
end;
procedure TDES.TBuffer.FromBase64String(const Str: String);
var
Base64Encoding: TBase64Encoding;
begin
//Base64Encoding := TBase64Encoding.Create; //含换行符
Base64Encoding := TBase64Encoding.Create(0); //不含换行符
Data := Base64Encoding.DecodeStringToBytes(Str);
Base64Encoding.Free;
end;
procedure TDES.TBuffer.FromBytes(const InBytes: array of Byte; ByteLen: Integer);
begin
if (ByteLen = -1) then ByteLen := System.Length(InBytes);
SetLength(Data, ByteLen);
Move(InBytes[0], Data[0], ByteLen);
end;
procedure TDES.TBuffer.FromBytes(const InBytes: TBytes; ByteLen: Integer);
begin
if (ByteLen = -1) then ByteLen := System.Length(InBytes);
SetLength(Data, ByteLen);
Move(InBytes[0], Data[0], ByteLen);
end;
procedure TDES.TBuffer.FromStream(const Stream: TStream; ByteLen: Integer);
begin
if (ByteLen = -1) then ByteLen := Stream.Size;
SetLength(Data, ByteLen);
Stream.Read(Data, ByteLen);
end;
procedure TDES.TBuffer.FromFile(const FileName: String);
var
Stream: TFileStream;
begin
Stream := TFileStream.Create(FileName, fmOpenRead);
SetLength(Data, Stream.Size);
Stream.Read(Data, Stream.Size);
Stream.Free;
end;
function TDES.TBuffer.ToString(Encoding: TEncoding): String;
begin
if (Encoding = nil) then Encoding := TEncoding.UTF8;
Result := Encoding.GetString(Data);
end;
function TDES.TBuffer.ToHexString: String;
var
Len: Integer;
begin
Len := System.Length(Data);
SetLength(Result, 2*Len);
BinToHex(@Data[0], PChar(Result), Len);
end;
function TDES.TBuffer.ToDelimitedHexString(Prefix: String; Delimitor: String): String;
var
I, Len: Integer;
begin
Result := '';
Len := System.Length(Data);
for I := 0 to Len-1 do
begin
Result := Result + Prefix + IntToHex(Data[I], 2);
if I < Len-1 then
Result := Result + Delimitor;
end;
end;
function TDES.TBuffer.ToBase64String: String;
var
Base64Encoding: TBase64Encoding;
begin
//Base64Encoding := TBase64Encoding.Create; //含换行符
Base64Encoding := TBase64Encoding.Create(0); //不含换行符
Result := Base64Encoding.EncodeBytesToString(Data);
Base64Encoding.Free;
end;
procedure TDES.TBuffer.ToBytes(var OutBytes: array of Byte; ByteLen: Integer);
begin
if (ByteLen = -1) then ByteLen := System.Length(Data);
if (ByteLen > System.Length(OutBytes)) then
raise Exception.Create(SInvalidBufSize);
Move(Data[0], OutBytes[0], ByteLen);
end;
procedure TDES.TBuffer.ToBytes(var OutBytes: TBytes; ByteLen: Integer);
begin
if ByteLen = -1 then ByteLen := System.Length(Data);
SetLength(OutBytes, ByteLen);
Move(Data[0], OutBytes[0], ByteLen);
end;
procedure TDES.TBuffer.ToStream(const Stream: TStream);
begin
Stream.Write(Data, System.Length(Data));
end;
procedure TDES.TBuffer.ToFile(const FileName: String; Warning: Boolean);
var
Stream: TFileStream;
begin
if Warning and FileExists(FileName) and
(Application.MessageBox(PChar('File ' + FileName + ' Exists, Overwrite It?'),
'Warning: File Exists', MB_YESNO) = IDNO) then Exit;
Stream := TFileStream.Create(FileName, fmCreate);
Stream.Write(Data, System.Length(Data));
Stream.Free;
end;
end.
//---------------------------------------------------------------------------=========================================== 示例 ================================================
![【Delphi】一个功能齐全的Delphi DES类（含3DES）[更新20201130]_第1张图片](http://img.e-com-net.com/image/info8/10b72a799f494198ad3574a47bb2ba93.png)
unit Unit1;
interface
uses
{$IF CompilerVersion <= 22}
Windows, Messages, SysUtils, Variants,
Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ComCtrls, u3DES, uRandom;
{$ELSE}
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
Vcl.StdCtrls, Vcl.ComCtrls, u3DES, uRandom;
{$ENDIF}
type
TForm1 = class(TForm)
ButtonEncrypt: TButton;
EditStr: TEdit;
EditPassword: TEdit;
EditIV: TEdit;
LabelStr: TLabel;
LabelDesType: TLabel;
ComboBoxDesType: TComboBox;
LabelBlockMode: TLabel;
ComboBoxBlockMode: TComboBox;
LabelPaddingmode: TLabel;
ComboBoxPaddingmode: TComboBox;
LabelPassword: TLabel;
LabelIV: TLabel;
LabelEncryptedStr: TLabel;
EditEncryptedStr: TEdit;
LabelDecryptedStr: TLabel;
EditDecryptedStr: TEdit;
LabelOutputType: TLabel;
ComboBoxOutputType: TComboBox;
LabelCompare: TLabel;
EditCompare: TEdit;
LabelResult: TLabel;
ButtonCompare: TButton;
Button1: TButton;
Button2: TButton;
procedure ButtonEncryptClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure ButtonCompareClick(Sender: TObject);
procedure EditCompareChange(Sender: TObject);
procedure ComboBoxBlockModeChange(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
DesFile: TDES;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.ButtonEncryptClick(Sender: TObject);
var
Des: TDES;
Str: String;
begin
LabelResult.Caption := '';
if ComboBoxDesType.Text = 'DES' then
Des := TDES.Create
else if ComboBoxDesType.Text = '3DES' then
Des := T3DES.Create
else if ComboBoxDesType.Text = '2DES' then
begin
Des := TDES.Create;
Des.DesLevel := 2;
end
else if ComboBoxDesType.Text = '4DES' then
begin
Des := TDES.Create;
Des.DesLevel := 4;
end
else if ComboBoxDesType.Text = '5DES' then
begin
Des := TDES.Create;
Des.DesLevel := 5;
end
else if ComboBoxDesType.Text = '6DES' then
begin
Des := TDES.Create;
Des.DesLevel := 6;
end
else if ComboBoxDesType.Text = '9DES' then
begin
Des := TDES.Create;
Des.DesLevel := 9;
end
else if ComboBoxDesType.Text = '10DES' then
begin
Des := TDES.Create;
Des.DesLevel := 10;
end
else
begin
Exit;
end;
with Des do
begin
if ComboBoxBlockMode.Text = 'ECB' then
CipherMode := cmECB
else if ComboBoxBlockMode.Text = 'CBC' then
CipherMode := cmCBC
else if ComboBoxBlockMode.Text = 'CFB' then
CipherMode := cmCFB
else if ComboBoxBlockMode.Text = 'OFB' then
CipherMode := cmOFB
else if ComboBoxBlockMode.Text = 'PCBC' then
CipherMode := cmPCBC;
if ComboBoxPaddingMode.Text = 'ZEROPadding' then
PaddingMode := pmZERO
else
if ComboBoxPaddingMode.Text = 'PKCS5Padding' then
PaddingMode := pmPKCS5
else
if ComboBoxPaddingMode.Text = 'PKCS7Padding' then
PaddingMode := pmPKCS7
else
if ComboBoxPaddingMode.Text = 'ISO10126Padding' then
PaddingMode := pmISO10126
else
if ComboBoxPaddingMode.Text = 'ANSIX923Padding' then
PaddingMode := pmANSIX923
else
if ComboBoxPaddingMode.Text = 'OneAndZeroPadding' then
PaddingMode := pmOneAndZero
else
if ComboBoxPaddingMode.Text = 'NoPadding' then
PaddingMode := pmNONE;
SrcBuffer.FromString(EditStr.Text);
KeyBuffer.FromString(EditPassword.Text);
IVBuffer.FromString(EditIV.Text);
Encrypt;
if ComboBoxOutputType.Text = 'HEX' then
begin
Str := DestBuffer.ToHexString;
EditEncryptedStr.Text := LowerCase(Str);
SrcBuffer.FromHexString(Str);
end
else
begin
Str := DestBuffer.ToBase64String;
EditEncryptedStr.Text := Str;
SrcBuffer.FromBase64String(Str);
end;
Decrypt;
EditDecryptedStr.Text := DestBuffer.ToString;
Free;
end;
EditCompareChange(nil)
end;
procedure TForm1.ComboBoxBlockModeChange(Sender: TObject);
begin
if ComboBoxBlockMode.Text = 'ECB' then
begin
LabelIV.Enabled := False;
EditIV.Enabled := False;
end
else
begin
LabelIV.Enabled := True;
EditIV.Enabled := True;
end;
end;
procedure TForm1.EditCompareChange(Sender: TObject);
begin
if (Trim(EditCompare.Text) = '') or (Trim(EditEncryptedStr.Text) = '') then
begin
LabelResult.Caption := '';
Exit;
end;
ButtonCompareClick(nil);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
LabelResult.Caption := '';
DesFile := T3DES.Create;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
with TFormRandom.Create(nil) do
begin
ShowModal;
Free;
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
const
Key: array[0..47] of Byte =
($FB, $F1, $03, $18, $25, $FC, $B1, $4B,
$0B, $0D, $F8, $53, $BF, $A6, $34, $B2,
$E1, $2E, $4C, $76, $38, $AE, $52, $D0,
$CF, $97, $CD, $0F, $00, $8E, $97, $36,
$36, $0E, $49, $B4, $27, $73, $5A, $72,
$AD, $CA, $4F, $D5, $9C, $A4, $D7, $DF);
IV: array[0..7] of Byte =
($CF, $46, $6E, $8B, $1E, $9E, $3B, $8A);
var
DES: TDES;
begin
DES := TDES.Create;
with DES do
begin
DesLevel := 6;
CipherMode := cmPCBC;
PaddingMode := pmPKCS5;
SrcBuffer.FromString('dvrmonitor,E8kb1Fgl7nLd3Pnf');
KeyBuffer.FromBytes(Key);
IVBuffer.FromBytes(IV);
Encrypt;
EditCompare.Text := DestBuffer.ToDelimitedHexString;
end;
end;
procedure TForm1.ButtonCompareClick(Sender: TObject);
begin
if LowerCase(EditEncryptedStr.Text) = LowerCase(EditCompare.Text) then
begin
LabelResult.Font.Color := clBlue;
LabelResult.Caption := '相同'
end
else
begin
LabelResult.Font.Color := clRed;
LabelResult.Caption := '不相同'
end;
end;
end.object Form1: TForm1
Left = 0
Top = 0
BorderStyle = bsDialog
Caption = 'DES'#27979#35797
ClientHeight = 354
ClientWidth = 720
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
Position = poScreenCenter
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object LabelStr: TLabel
Left = 14
Top = 134
Width = 36
Height = 13
Caption = #23383#31526#20018
end
object LabelDesType: TLabel
Left = 16
Top = 29
Width = 48
Height = 13
Caption = #21152#23494#26041#24335
end
object LabelBlockMode: TLabel
Left = 169
Top = 29
Width = 48
Height = 13
Caption = #21152#23494#27169#24335
end
object LabelPaddingmode: TLabel
Left = 322
Top = 29
Width = 48
Height = 13
Caption = #22635#20805#27169#24335
end
object LabelPassword: TLabel
Left = 26
Top = 82
Width = 24
Height = 13
Caption = #23494#30721
end
object LabelIV: TLabel
Left = 534
Top = 82
Width = 92
Height = 13
Caption = #20559#31227#37327'('#21021#22987#21521#37327')'
end
object LabelEncryptedStr: TLabel
Left = 14
Top = 177
Width = 36
Height = 13
Caption = #21152#23494#20018
end
object LabelDecryptedStr: TLabel
Left = 14
Top = 266
Width = 36
Height = 13
Caption = #35299#23494#20018
end
object LabelOutputType: TLabel
Left = 543
Top = 29
Width = 24
Height = 13
Caption = #36755#20986
end
object LabelCompare: TLabel
Left = 14
Top = 220
Width = 36
Height = 13
Caption = #27604#36739#20018
end
object LabelResult: TLabel
Left = 13
Top = 309
Width = 24
Height = 13
Caption = #30456#21516
end
object ButtonEncrypt: TButton
Left = 322
Top = 300
Width = 121
Height = 33
Caption = #27979#35797#21152#35299#23494
TabOrder = 0
OnClick = ButtonEncryptClick
end
object EditStr: TEdit
Left = 56
Top = 131
Width = 643
Height = 21
TabOrder = 1
Text = #20197#33258#20449#32534#30721#20026#32827
end
object EditPassword: TEdit
Left = 56
Top = 79
Width = 452
Height = 21
TabOrder = 2
Text = 'abcsefrh12f4t6b88v65w3q1'
end
object EditIV: TEdit
Left = 632
Top = 79
Width = 67
Height = 21
TabOrder = 3
Text = '12d4k6e8'
end
object ComboBoxDesType: TComboBox
Left = 70
Top = 26
Width = 51
Height = 21
TabOrder = 4
Text = '3DES'
Items.Strings = (
'DES'
'2DES'
'3DES'
'4DES'
'5DES'
'6DES'
'9DES'
'10DES')
end
object ComboBoxBlockMode: TComboBox
Left = 223
Top = 26
Width = 54
Height = 21
TabOrder = 5
Text = 'CBC'
OnChange = ComboBoxBlockModeChange
Items.Strings = (
'ECB'
'CBC'
'CFB'
'OFB'
'PCBC')
end
object ComboBoxPaddingmode: TComboBox
Left = 375
Top = 26
Width = 129
Height = 21
TabOrder = 6
Text = 'PKCS5Padding'
Items.Strings = (
'ZeroPadding'
'PKCS5Padding'
'PKCS7Padding'
'ANSIX923Padding'
'OneAndZeroPadding'
'ISO10126Padding'
'NoPadding')
end
object EditEncryptedStr: TEdit
Left = 56
Top = 174
Width = 643
Height = 21
TabOrder = 7
OnChange = EditCompareChange
end
object EditDecryptedStr: TEdit
Left = 56
Top = 259
Width = 643
Height = 21
TabOrder = 8
end
object ComboBoxOutputType: TComboBox
Left = 572
Top = 26
Width = 69
Height = 21
TabOrder = 9
Text = 'HEX'
Items.Strings = (
'BASE64'
'HEX')
end
object EditCompare: TEdit
Left = 56
Top = 217
Width = 643
Height = 21
TabOrder = 10
OnChange = EditCompareChange
end
object ButtonCompare: TButton
Left = 55
Top = 300
Width = 107
Height = 33
Caption = #27604#36739
TabOrder = 11
OnClick = ButtonCompareClick
end
object Button1: TButton
Left = 518
Top = 303
Width = 81
Height = 28
Caption = 'GenRandom'
TabOrder = 12
OnClick = Button1Click
end
object Button2: TButton
Left = 624
Top = 304
Width = 75
Height = 25
Caption = 'Make'
TabOrder = 13
OnClick = Button2Click
end
endunit uRandom;
interface
uses
{$IF CompilerVersion <= 22}
Windows, Messages, SysUtils, Variants,
Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Mask, ComCtrls;
{$ELSE}
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
Vcl.StdCtrls, Vcl.Mask, Vcl.ComCtrls;
{$ENDIF}
type
TFormRandom = class(TForm)
ListBox: TRichEdit;
Button1: TButton;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
FormRandom: TFormRandom;
implementation
{$R *.dfm}
procedure TFormRandom.FormCreate(Sender: TObject);
var
I, Len: Integer;
Str: String;
begin
Len := 8*8;
Randomize;
Str := '(';
for I := 1 to Len do
begin
Str := Str + '$' + IntToHex(Random(255), 2);
if I <> Len then
begin
Str := Str + ', ';
if I mod 8 = 0 then
Str := Str + #13#10;
end;
end;
Str := Str + ')';
ListBox.Lines.Text := Str;
end;
end.object FormRandom: TFormRandom
Left = 0
Top = 0
BorderStyle = bsDialog
Caption = #29983#20135#38543#26426#25968
ClientHeight = 258
ClientWidth = 473
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
Position = poScreenCenter
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object ListBox: TRichEdit
Left = 6
Top = 9
Width = 459
Height = 210
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
ParentFont = False
TabOrder = 0
Zoom = 100
end
object Button1: TButton
Left = 201
Top = 227
Width = 75
Height = 25
Caption = 'OK'
ModalResult = 1
TabOrder = 1
end
end