📄 cryptimpt.pas
字号:
{
*************************************************************************
* A binary compatible IDEA implementation *
*************************************************************************
* 64bit block encryption *
* 128bit key size *
* Block size 64bit *
* Key size 128bit *
* Modes ECB, CBC, CFB 8bit, OFB, OFB counter 8bit *
* ECB, CBC, OFB: These modes encrypt data in blocks of 64bits (8bytes) *
* CFB, OFBC: These modes encrypt data in blocks of 8bits (1byte) *
*************************************************************************
}
unit CryptImpt;
interface
uses
Sysutils, CryptTools;
type
PWord= ^word;
TIDEAData= record
InitBlock: array[0..7] of byte; { initial IV }
LastBlock: array[0..7] of byte; { current IV }
EK: array[0..51] of word;
DK: array[0..51] of word;
end;
//------------------------------------------------------------------------------
// Encrypt type and Session's private key defines
//------------------------------------------------------------------------------
TEncryptType = (etECB, etCBC, etOFB); //Encrypt data 64bits/blocks (8bytes)
TPrivateKey = array[0..15] of byte;
//------------------------------------------------------------------------------
// functions defines
//------------------------------------------------------------------------------
function IDEASelfTest: boolean;
{* performs a self test on this implementation }
procedure IDEAInit(var Data: TIDEAData; Key: pointer; Len: integer; IV: pointer);
{* initializes the TIDEAData structure with the key information and IV if applicable }
procedure IDEABurn(var Data: TIDEAData);
{* erases all information about the key }
procedure IDEAEncryptECB(var Data: TIDEAData; InData, OutData: pointer);
{* encrypts the data in a 64bit block using the ECB mode }
procedure IDEAEncryptCBC(var Data: TIDEAData; InData, OutData: pointer);
{* encrypts the data in a 64bit block using the CBC chaining mode }
procedure IDEAEncryptOFB(var Data: TIDEAData; InData, OutData: pointer);
{* encrypts the data in a 64bit block using the OFB chaining mode }
procedure IDEAEncryptCFB(var Data: TIDEAData; InData, OutData: pointer; Len: integer);
{* encrypts Len bytes of data using the CFB chaining mode }
procedure IDEAEncryptOFBC(var Data: TIDEAData; InData, OutData: pointer; Len: integer);
{* encrypts Len bytes of data using the OFB counter chaining mode }
procedure IDEADecryptECB(var Data: TIDEAData; InData, OutData: pointer);
{* decrypts the data in a 64bit block using the ECB mode }
procedure IDEADecryptCBC(var Data: TIDEAData; InData, OutData: pointer);
{* decrypts the data in a 64bit block using the CBC chaining mode }
procedure IDEADecryptOFB(var Data: TIDEAData; InData, OutData: pointer);
{* decrypts the data in a 64bit block using the OFB chaining mode }
procedure IDEADecryptCFB(var Data: TIDEAData; InData, OutData: pointer; Len: integer);
{* decrypts Len bytes of data using the CFB chaining mode }
procedure IDEADecryptOFBC(var Data: TIDEAData; InData, OutData: pointer; Len: integer);
{* decrypts Len bytes of data using the OFB counter chaining mode }
procedure IDEAReset(var Data: TIDEAData);
{* resets the chaining mode information }
procedure Encrypt(hKey: Pointer; hKeyLen: integer; hInBuf: string;
hMaxLen: integer; hEcType: TEncryptType; var hOutBuf: string);
procedure Decrypt(hKey: Pointer; hKeyLen: integer; hInBuf: string;
hMaxLen: integer; hEcType: TEncryptType; var hOutBuf: string);
{******************************************************************************}
implementation
function IDEASelfTest: boolean;
const
Key: array[0..15] of byte=
($00, $01, $00, $02, $00, $03, $00, $04, $00, $05, $00, $06, $00, $07, $00, $08);
InBlock: array[0..7] of byte=
($00, $00, $00, $01, $00, $02, $00, $03);
OutBlock: array[0..7] of byte=
($11, $FB, $ED, $2B, $01, $98, $6D, $E5);
var
Block: array[0..7] of byte;
Data: TIDEAData;
begin
IDEAInit(Data,@Key,Sizeof(Key),nil);
IDEAEncryptECB(Data,@InBlock,@Block);
Result:= CompareMem(@Block,@OutBlock,Sizeof(Block));
IDEADecryptECB(Data,@Block,@Block);
Result:= Result and CompareMem(@Block,@InBlock,Sizeof(Block));
IDEABurn(Data);
end;
procedure Mul(var x: word; y: word);
var
p: DWord;
t16: word;
begin
p:= DWord(x)*y;
if p= 0 then
x:= 1 - x - y
else
begin
x:= p shr 16;
t16:= p and $FFFF;
x:= t16 - x;
if (t16 < x) then
Inc(x);
end;
end;
function MulInv(x: word): word;
var
t0, t1, q, y: word;
begin
if x<= 1 then
begin
Result:= x;
Exit;
end;
t1:= DWord($10001) div x;
y:= DWord($10001) mod x;
if y= 1 then
begin
Result:= (1 - t1) and $FFFF;
Exit;
end;
t0:= 1;
repeat
q:= x div y;
x:= x mod y;
t0:= t0 + (q*t1);
if x= 1 then
begin
Result:= t0;
Exit;
end;
q:= y div x;
y:= y mod x;
t1:= t1 + (q*t0);
until y= 1;
Result:= (1-t1) and $FFFF;
end;
procedure IDEAInvertKey(EK, DK: PWord);
var
i: integer;
t1, t2, t3: word;
temp: array[0..51] of word;
p: PWord;
begin
p:= pointer(integer(@temp)+Sizeof(Temp));
Dec(p);
t1:= MulInv(EK^);
Inc(EK);
t2:= -EK^;
Inc(EK);
t3:= -EK^;
Inc(EK);
p^:= MulInv(EK^);
Inc(EK);
Dec(p);
p^:= t3;
Dec(p);
p^:= t2;
Dec(p);
p^:= t1;
Dec(p);
for i:= 0 to 6 do
begin
t1:= EK^;
Inc(EK);
p^:= EK^;
Inc(EK);
Dec(p);
p^:= t1;
Dec(p);
t1:= MulInv(EK^);
Inc(EK);
t2:= -EK^;
Inc(EK);
t3:= -EK^;
Inc(EK);
p^:= MulInv(EK^);
Inc(EK);
Dec(p);
p^:= t2;
Dec(p);
p^:= t3;
Dec(p);
p^:= t1;
Dec(p);
end;
t1:= EK^;
Inc(EK);
p^:= EK^;
Dec(p);
Inc(EK);
p^:= t1;
Dec(p);
t1:= MulInv(EK^);
Inc(EK);
t2:= -EK^;
Inc(EK);
t3:= -EK^;
Inc(EK);
p^:= MulInv(EK^);
Dec(p);
p^:= t3;
Dec(p);
p^:= t2;
Dec(p);
p^:= t1;
Move(Temp,DK^,Sizeof(Temp));
FillChar(Temp,Sizeof(Temp),0);
end;
procedure IDEAInit;
var
UserKey: PByteArray;
PEK: PWordArray;
j: integer;
begin
if Len<> 16 then
raise Exception.Create('IDEA: Invalid key length');
with Data do
begin
if IV= nil then
begin
FillChar(InitBlock,8,0);
FillChar(LastBlock,8,0);
end
else
begin
Move(IV^,InitBlock,8);
Move(IV^,LastBlock,8);
end;
UserKey:= Key;
PEK:= @EK;
for j:= 0 to 7 do
begin
PEK[j]:= (UserKey[0] shl 8) + UserKey[1];
UserKey:= pointer(integer(UserKey)+2);
end;
for j:= 1 to 6 do
begin
PEK[8]:= (PEK[1]shl 9) or (PEK[2] shr 7);
PEK[9]:= (PEK[2] shl 9) or (PEK[3] shr 7);
PEK[10]:= (PEK[3] shl 9) or (PEK[4] shr 7);
PEK[11]:= (PEK[4] shl 9) or (PEK[5] shr 7);
PEK[12]:= (PEK[5] shl 9) or (PEK[6] shr 7);
PEK[13]:= (PEK[6] shl 9) or (PEK[7] shr 7);
PEK[14]:= (PEK[7] shl 9) or (PEK[0] shr 7);
PEK[15]:= (PEK[0] shl 9) or (PEK[1] shr 7);
PEK:= pointer(integer(PEK)+16);
end;
IDEAInvertKey(@EK,@DK);
end;
end;
procedure IDEABurn;
begin
FillChar(Data,Sizeof(Data),0);
end;
procedure IDEACipher(Key: PWord; Input, Output: PWordArray);
var
x1, x2, x3, x4, s2, s3: word;
i: integer;
begin
x1:= (Input[0] shr 8) or (Input[0] shl 8);
x2:= (Input[1] shr 8) or (Input[1] shl 8);
x3:= (Input[2] shr 8) or (Input[2] shl 8);
x4:= (Input[3] shr 8) or (Input[3] shl 8);
i:= 8;
repeat
Mul(x1,Key^);
Inc(Key);
x2:= x2 + Key^;
Inc(Key);
x3:= x3 + Key^;
Inc(Key);
Mul(x4,Key^);
Inc(Key);
s3:= x3;
x3:= x3 xor x1;
Mul(x3,Key^);
Inc(Key);
s2:= x2;
x2:= x2 xor x4;
x2:= x2 + x3;
Mul(x2,Key^);
Inc(Key);
x3:= x3 + x2;
x1:= x1 xor x2;
x4:= x4 xor x3;
x2:= x2 xor s3;
x3:= x3 xor s2;
Dec(i);
until (i=0);
Mul(x1,Key^);
Inc(Key);
x3:= x3 + Key^;
Inc(Key);
x2:= x2 + Key^;
Inc(Key);
Mul(x4,Key^);
Output[0]:= (x1 shr 8) or (x1 shl 8);
Output[1]:= (x3 shr 8) or (x3 shl 8);
Output[2]:= (x2 shr 8) or (x2 shl 8);
Output[3]:= (x4 shr 8) or (x4 shl 8);
end;
procedure IDEAEncryptECB;
begin
IDEACipher(@Data.EK,InData,OutData);
end;
procedure IDEADecryptECB;
begin
IDEACipher(@Data.DK,InData,OutData);
end;
procedure IDEAEncryptCBC;
begin
XorBlock(InData,@Data.LastBlock,OutData,8);
IDEAEncryptECB(Data,OutData,OutData);
Move(OutData^,Data.LastBlock,8);
end;
procedure IDEADecryptCBC;
var
TempBlock: array[0..7] of byte;
begin
Move(InData^,TempBlock,8);
IDEADecryptECB(Data,InData,OutData);
XorBlock(OutData,@Data.LastBlock,OutData,8);
Move(TempBlock,Data.LastBlock,8);
end;
procedure IDEAEncryptCFB;
var
i: integer;
TempBlock: array[0..7] of byte;
begin
for i:= 0 to Len-1 do
begin
IDEAEncryptECB(Data,@Data.LastBlock,@TempBlock);
PByteArray(OutData)[i]:= PByteArray(InData)[i] xor TempBlock[0];
Move(Data.LastBlock[1],Data.LastBlock[0],7);
Data.LastBlock[7]:= PByteArray(OutData)[i];
end;
end;
procedure IDEADecryptCFB;
var
i: integer;
TempBlock: array[0..7] of byte;
b: byte;
begin
for i:= 0 to Len-1 do
begin
b:= PByteArray(InData)[i];
IDEAEncryptECB(Data,@Data.LastBlock,@TempBlock);
PByteArray(OutData)[i]:= PByteArray(InData)[i] xor TempBlock[0];
Move(Data.LastBlock[1],Data.LastBlock[0],7);
Data.LastBlock[7]:= b;
end;
end;
procedure IDEAEncryptOFB;
begin
IDEAEncryptECB(Data,@Data.LastBlock,@Data.LastBlock);
XorBlock(@Data.LastBlock,InData,OutData,8);
end;
procedure IDEADecryptOFB;
begin
IDEAEncryptECB(Data,@Data.LastBlock,@Data.LastBlock);
XorBlock(@Data.LastBlock,InData,OutData,8);
end;
procedure IDEAEncryptOFBC;
var
i: integer;
TempBlock: array[0..7] of byte;
begin
for i:= 0 to Len-1 do
begin
IDEAEncryptECB(Data,@Data.LastBlock,@TempBlock);
PByteArray(OutData)[i]:= PByteArray(InData)[i] xor TempBlock[0];
IncBlock(@Data.LastBlock,8);
end;
end;
procedure IDEADecryptOFBC;
var
i: integer;
TempBlock: array[0..7] of byte;
begin
for i:= 0 to Len-1 do
begin
IDEAEncryptECB(Data,@Data.LastBlock,@TempBlock);
PByteArray(OutData)[i]:= PByteArray(InData)[i] xor TempBlock[0];
IncBlock(@Data.LastBlock,8);
end;
end;
procedure IDEAReset;
begin
Move(Data.InitBlock,Data.LastBlock,8);
end;
{==============================================================================}
function StrToHex(AStr: string): string;
var
I : Integer;
begin
Result := '';
for I := 1 to Length(AStr) do
begin
Result := Result + Format('%2x', [Byte(AStr[I])]);
end;
I := Pos(' ', Result);
while I <> 0 do
begin
Result[I] := '0';
I := Pos(' ', Result);
end;
end;
{==============================================================================}
function HexToStr(AStr: string): string;
// interal function
function TransChar(AChar: Char): Integer;
begin
if AChar in ['0'..'9'] then
Result := Ord(AChar) - Ord('0')
else
Result := 10 + Ord(AChar) - Ord('A');
end;
// main body
var
I : Integer;
CharValue: Word;
begin
Result := '';
For I := 1 to Trunc(Length(Astr)/2) do
begin
Result := Result + ' ';
CharValue := TransChar(AStr[2*I-1])*16 + TransChar(AStr[2*I]);
Result[I] := Char(CharValue);
end;
end;
{==============================================================================}
procedure Encrypt(hKey: Pointer; hKeyLen: integer;
hInBuf: string; hMaxLen: integer; hEcType: TEncryptType;
var hOutBuf: string);
var
Data: TIDEAData;
aInBuf: string;
Idx, LoopCount: integer;
begin
aInBuf := Copy(hInbuf, 1, hMaxLen);
LoopCount := Length(aInBuf) div 8;
if Length(aInBuf) mod 8 > 0 then Inc(LoopCount);
for Idx:= Length(aInBuf)+1 to LoopCount*8 do
aInBuf := aInBuf + #0;
//SetLength(hOutBuf, hMaxLen * 2);
//FillChar(hOutBuf[1], hMaxLen * 2, 0);
SetLength(hOutBuf, Length(aInBuf) * 2);
FillChar(hOutBuf[1], Length(aInBuf) * 2, 0);
IDEAInit(Data, hKey, hKeyLen, hKey);
try
for Idx:=0 to LoopCount-1 do
case hEcType of
etCBC: IDEAEncryptCBC(Data, @aInBuf[Idx*8+1], @hOutBuf[Idx*8+1]);
etOFB: IDEAEncryptOFB(Data, @aInBuf[Idx*8+1], @hOutBuf[Idx*8+1]);
else IDEAEncryptECB(Data, @aInBuf[Idx*8+1], @hOutBuf[Idx*8+1])
end;
SetLength(hOutBuf, LoopCount*8);
hOutBuf := StrToHex(hOutBuf);
finally
IDEABurn(Data);
end;
end;
{==============================================================================}
procedure Decrypt(hKey: Pointer; hKeyLen: integer;
hInBuf: string; hMaxLen: integer; hEcType: TEncryptType;
var hOutBuf: string);
var
Data: TIDEAData;
aInBuf: string;
Idx, LoopCount: integer;
begin
aInBuf := HexToStr(hInbuf);
LoopCount := Length(aInBuf) div 8;
if Length(aInBuf) mod 8 > 0 then Inc(LoopCount);
SetLength(hOutBuf, hMaxLen);
FillChar(hOutBuf[1], hMaxLen, 0);
IDEAInit(Data, hKey, hKeyLen, hKey);
try
for Idx:=0 to LoopCount-1 do
case hEcType of
etCBC: IDEADecryptCBC(Data, @aInBuf[Idx*8+1], @hOutBuf[Idx*8+1]);
etOFB: IDEADecryptOFB(Data, @aInBuf[Idx*8+1], @hOutBuf[Idx*8+1]);
else IDEADecryptECB(Data, @aInBuf[Idx*8+1], @hOutBuf[Idx*8+1])
end;
hOutBuf := StrPas(PChar(hOutBuf));
finally
IDEABurn(Data);
end;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -