发信人: teleme(PassWord)
整理人: teleme(2001-06-05 08:46:53), 站内信件
|
//以下文件CAST128.INC，Tools.pas为关键部分，请加入到工程文件中，如果出现不能编译通过的情况，请在相应的窗体uses这两个单元即可。
//********以下保存为CAST128.INC************
{
***************************************************
* A binary compatible Cast128 implementation *
* written by Dave Barton ([email protected]) *
* Based on C source by *
* Steve Reid <[email protected]> *
***************************************************
* 64bit block encryption *
* Variable size key - up to 128bit *
***************************************************
}
unit Cast128;
interface
uses
Sysutils, Tools;
type
TCast128Data = record
InitBlock: array[0..7] of byte; { initial IV }
LastBlock: array[0..7] of byte; { current IV }
xKey: array[0..31] of DWord;
Rounds: integer;
end;
function Cast128SelfTest: boolean;
{ performs a self test on this implementation }
procedure Cast128Init(var Data: TCast128Data; Key: pointer; Len: integer; IV: pointer);
{ initializes the TCast128Data structure with the key information and IV if applicable }
procedure Cast128Burn(var Data: TCast128Data);
//procedure Cast128Burn(data:pointer);
{ erases all information about the key }
procedure Cast128EncryptECB(const Data: TCast128Data; InData, OutData: pointer);
{ encrypts the data in a 64bit block using the ECB mode }
procedure Cast128EncryptCBC(var Data: TCast128Data; InData, OutData: pointer);
{ encrypts the data in a 64bit block using the CBC chaining mode }
procedure Cast128EncryptOFB(var Data: TCast128Data; InData, OutData: pointer);
{ encrypts the data in a 64bit block using the OFB chaining mode }
procedure Cast128EncryptCFB(var Data: TCast128Data; InData, OutData: pointer; Len: integer);
{ encrypts Len bytes of data using the CFB chaining mode }
procedure Cast128EncryptOFBC(var Data: TCast128Data; InData, OutData: pointer; Len: integer);
{ encrypts Len bytes of data using the OFB counter chaining mode }
procedure Cast128DecryptECB(const Data: TCast128Data; InData, OutData: pointer);
{ decrypts the data in a 64bit block using the ECB mode }
procedure Cast128DecryptCBC(var Data: TCast128Data; InData, OutData: pointer);
{ decrypts the data in a 64bit block using the CBC chaining mode }
procedure Cast128DecryptOFB(var Data: TCast128Data; InData, OutData: pointer);
{ decrypts the data in a 64bit block using the OFB chaining mode }
procedure Cast128DecryptCFB(var Data: TCast128Data; InData, OutData: pointer; Len: integer);
{ decrypts Len bytes of data using the CFB chaining mode }
procedure Cast128DecryptOFBC(var Data: TCast128Data; InData, OutData: pointer; Len: integer);
{ decrypts Len bytes of data using the OFB counter chaining mode }
procedure Cast128Reset(var Data: TCast128Data);
{ resets the chaining mode information }
{******************************************************************************}
implementation
{$I Cast128.inc}
{$R-}
function Cast128SelfTest;
const
Key: array[0..15] of byte = ($01, $23, $45, $67, $12, $34, $56, $78, $23, $45, $67, $89, $34, $56, $78, $9A);
InBlock: array[0..7] of byte = ($01, $23, $45, $67, $89, $AB, $CD, $EF);
OutBlock: array[0..7] of byte = ($23, $8B, $4F, $E5, $84, $7E, $44, $B2);
var
Block: array[0..7] of byte;
Data: TCast128Data;
begin
Cast128Init(Data, @Key, Sizeof(Key), nil);
Cast128EncryptECB(Data, @InBlock, @Block);
Result := CompareMem(@Block, @OutBlock, Sizeof(Block));
Cast128DecryptECB(Data, @Block, @Block);
Result := Result and CompareMem(@Block, @InBlock, Sizeof(Block));
Cast128Burn(Data);
end;
procedure Cast128Init;
var
x, t, z: array[0..3] of DWord;
i: integer;
begin
if (Len <= 0) or (Len > 16) then
raise Exception.Create('Cast128: Key must be between 1 and 16 bytes long');
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;
if Len <= 10 then
Rounds := 12
else
Rounds := 16;
FillChar(x, Sizeof(x), 0);
Move(Key^, x, Len);
x[0] := (x[0] shr 24) or ((x[0] shr 8) and $FF00) or ((x[0] shl 8) and $FF0000) or (x[0] shl 24);
x[1] := (x[1] shr 24) or ((x[1] shr 8) and $FF00) or ((x[1] shl 8) and $FF0000) or (x[1] shl 24);
x[2] := (x[2] shr 24) or ((x[2] shr 8) and $FF00) or ((x[2] shl 8) and $FF0000) or (x[2] shl 24);
x[3] := (x[3] shr 24) or ((x[3] shr 8) and $FF00) or ((x[3] shl 8) and $FF0000) or (x[3] shl 24);
i := 0;
while i < 32 do
begin
case (i and 4) of
0:
begin
z[0] := x[0] xor cast_sbox5[(x[3] shr 16) and $FF] xor
cast_sbox6[x[3] and $FF] xor cast_sbox7[x[3] shr 24] xor
cast_sbox8[(x[3] shr 8) and $FF] xor cast_sbox7[x[2] shr 24];
t[0] := z[0];
z[1] := x[2] xor cast_sbox5[z[0] shr 24] xor
cast_sbox6[(z[0] shr 8) and $FF] xor cast_sbox7[(z[0] shr 16) and $FF] xor
cast_sbox8[z[0] and $FF] xor cast_sbox8[(x[2] shr 8) and $FF];
t[1] := z[1];
z[2] := x[3] xor cast_sbox5[z[1] and $FF] xor
cast_sbox6[(z[1] shr 8) and $FF] xor cast_sbox7[(z[1] shr 16) and $FF] xor
cast_sbox8[z[1] shr 24] xor cast_sbox5[(x[2] shr 16) and $FF];
t[2] := z[2];
z[3] := x[1] xor cast_sbox5[(z[2] shr 8) and $FF] xor
cast_sbox6[(z[2] shr 16) and $FF] xor cast_sbox7[z[2] and $FF] xor
cast_sbox8[z[2] shr 24] xor cast_sbox6[x[2] and $FF];
t[3] := z[3];
end;
4:
begin
x[0] := z[2] xor cast_sbox5[(z[1] shr 16) and $FF] xor
cast_sbox6[z[1] and $FF] xor cast_sbox7[z[1] shr 24] xor
cast_sbox8[(z[1] shr 8) and $FF] xor cast_sbox7[z[0] shr 24];
t[0] := x[0];
x[1] := z[0] xor cast_sbox5[x[0] shr 24] xor
cast_sbox6[(x[0] shr 8) and $FF] xor cast_sbox7[(x[0] shr 16) and $FF] xor
cast_sbox8[x[0] and $FF] xor cast_sbox8[(z[0] shr 8) and $FF];
t[1] := x[1];
x[2] := z[1] xor cast_sbox5[x[1] and $FF] xor
cast_sbox6[(x[1] shr 8) and $FF] xor cast_sbox7[(x[1] shr 16) and $FF] xor
cast_sbox8[x[1] shr 24] xor cast_sbox5[(z[0] shr 16) and $FF];
t[2] := x[2];
x[3] := z[3] xor cast_sbox5[(x[2] shr 8) and $FF] xor
cast_sbox6[(x[2] shr 16) and $FF] xor cast_sbox7[x[2] and $FF] xor
cast_sbox8[x[2] shr 24] xor cast_sbox6[z[0] and $FF];
t[3] := x[3];
end;
end;
case (i and 12) of
0, 12:
begin
xKey[i + 0] := cast_sbox5[t[2] shr 24] xor cast_sbox6[(t[2] shr 16) and $FF] xor
cast_sbox7[t[1] and $FF] xor cast_sbox8[(t[1] shr 8) and $FF];
xKey[i + 1] := cast_sbox5[(t[2] shr 8) and $FF] xor cast_sbox6[t[2] and $FF] xor
cast_sbox7[(t[1] shr 16) and $FF] xor cast_sbox8[t[1] shr 24];
xKey[i + 2] := cast_sbox5[t[3] shr 24] xor cast_sbox6[(t[3] shr 16) and $FF] xor
cast_sbox7[t[0] and $FF] xor cast_sbox8[(t[0] shr 8) and $FF];
xKey[i + 3] := cast_sbox5[(t[3] shr 8) and $FF] xor cast_sbox6[t[3] and $FF] xor
cast_sbox7[(t[0] shr 16) and $FF] xor cast_sbox8[t[0] shr 24];
end;
4, 8:
begin
xKey[i + 0] := cast_sbox5[t[0] and $FF] xor cast_sbox6[(t[0] shr 8) and $FF] xor
cast_sbox7[t[3] shr 24] xor cast_sbox8[(t[3] shr 16) and $FF];
xKey[i + 1] := cast_sbox5[(t[0] shr 16) and $FF] xor cast_sbox6[t[0] shr 24] xor
cast_sbox7[(t[3] shr 8) and $FF] xor cast_sbox8[t[3] and $FF];
xKey[i + 2] := cast_sbox5[t[1] and $FF] xor cast_sbox6[(t[1] shr 8) and $FF] xor
cast_sbox7[t[2] shr 24] xor cast_sbox8[(t[2] shr 16) and $FF];
xKey[i + 3] := cast_sbox5[(t[1] shr 16) and $FF] xor cast_sbox6[t[1] shr 24] xor
cast_sbox7[(t[2] shr 8) and $FF] xor cast_sbox8[t[2] and $FF];
end;
end;
case (i and 12) of
0:
begin
xKey[i + 0] := xKey[i + 0] xor cast_sbox5[(z[0] shr 8) and $FF];
xKey[i + 1] := xKey[i + 1] xor cast_sbox6[(z[1] shr 8) and $FF];
xKey[i + 2] := xKey[i + 2] xor cast_sbox7[(z[2] shr 16) and $FF];
xKey[i + 3] := xKey[i + 3] xor cast_sbox8[z[3] shr 24];
end;
4:
begin
xKey[i + 0] := xKey[i + 0] xor cast_sbox5[x[2] shr 24];
xKey[i + 1] := xKey[i + 1] xor cast_sbox6[(x[3] shr 16) and $FF];
xKey[i + 2] := xKey[i + 2] xor cast_sbox7[x[0] and $FF];
xKey[i + 3] := xKey[i + 3] xor cast_sbox8[x[1] and $FF];
end;
8:
begin
xKey[i + 0] := xKey[i + 0] xor cast_sbox5[(z[2] shr 16) and $FF];
xKey[i + 1] := xKey[i + 1] xor cast_sbox6[z[3] shr 24];
xKey[i + 2] := xKey[i + 2] xor cast_sbox7[(z[0] shr 8) and $FF];
xKey[i + 3] := xKey[i + 3] xor cast_sbox8[(z[1] shr 8) and $FF];
end;
12:
begin
xKey[i + 0] := xKey[i + 0] xor cast_sbox5[x[0] and $FF];
xKey[i + 1] := xKey[i + 1] xor cast_sbox6[x[1] and $FF];
xKey[i + 2] := xKey[i + 2] xor cast_sbox7[x[2] shr 24];
xKey[i + 3] := xKey[i + 3] xor cast_sbox8[(x[3] shr 16) and $FF];
end;
end;
if (i >= 16) then
begin
xKey[i + 0] := xKey[i + 0] and 31;
xKey[i + 1] := xKey[i + 1] and 31;
xKey[i + 2] := xKey[i + 2] and 31;
xKey[i + 3] := xKey[i + 3] and 31;
end;
Inc(i, 4);
end;
end;
end;
procedure Cast128Burn;
begin
FillChar(Data, Sizeof(Data), 0);
end;
procedure Cast128EncryptECB;
var
t, l, r: DWord;
begin
Move(InData^, l, Sizeof(l));
Move(pointer(integer(InData) + 4)^, r, Sizeof(r));
l := (l shr 24) or ((l shr 8) and $FF00) or ((l shl 8) and $FF0000) or (l shl 24);
r := (r shr 24) or ((r shr 8) and $FF00) or ((r shl 8) and $FF0000) or (r shl 24);
t := LRot32(Data.xKey[0] + r, Data.xKey[0 + 16]);
l := l xor (((cast_sbox1[t shr 24] xor cast_sbox2[(t shr 16) and $FF]) -
cast_sbox3[(t shr 8) and $FF]) + cast_sbox4[t and $FF]);
t := LRot32(Data.xKey[1] xor l, Data.xKey[1 + 16]);
r := r xor (((cast_sbox1[t shr 24] - cast_sbox2[(t shr 16) and $FF]) +
cast_sbox3[(t shr 8) and $FF]) xor cast_sbox4[t and $FF]);
t := LRot32(Data.xKey[2] - r, Data.xKey[2 + 16]);
l := l xor (((cast_sbox1[t shr 24] + cast_sbox2[(t shr 16) and $FF]) xor
cast_sbox3[(t shr 8) and $FF]) - cast_sbox4[t and $FF]);
t := LRot32(Data.xKey[3] + l, Data.xKey[3 + 16]);
r := r xor (((cast_sbox1[t shr 24] xor cast_sbox2[(t shr 16) and $FF]) -
cast_sbox3[(t shr 8) and $FF]) + cast_sbox4[t and $FF]);
t := LRot32(Data.xKey[4] xor r, Data.xKey[4 + 16]);
l := l xor (((cast_sbox1[t shr 24] - cast_sbox2[(t shr 16) and $FF]) +
cast_sbox3[(t shr 8) and $FF]) xor cast_sbox4[t and $FF]);
t := LRot32(Data.xKey[5] - l, Data.xKey[5 + 16]);
r := r xor (((cast_sbox1[t shr 24] + cast_sbox2[(t shr 16) and $FF]) xor
cast_sbox3[(t shr 8) and $FF]) - cast_sbox4[t and $FF]);
t := LRot32(Data.xKey[6] + r, Data.xKey[6 + 16]);
l := l xor (((cast_sbox1[t shr 24] xor cast_sbox2[(t shr 16) and $FF]) -
cast_sbox3[(t shr 8) and $FF]) + cast_sbox4[t and $FF]);
t := LRot32(Data.xKey[7] xor l, Data.xKey[7 + 16]);
r := r xor (((cast_sbox1[t shr 24] - cast_sbox2[(t shr 16) and $FF]) +
cast_sbox3[(t shr 8) and $FF]) xor cast_sbox4[t and $FF]);
t := LRot32(Data.xKey[8] - r, Data.xKey[8 + 16]);
l := l xor (((cast_sbox1[t shr 24] + cast_sbox2[(t shr 16) and $FF]) xor
cast_sbox3[(t shr 8) and $FF]) - cast_sbox4[t and $FF]);
t := LRot32(Data.xKey[9] + l, Data.xKey[9 + 16]);
r := r xor (((cast_sbox1[t shr 24] xor cast_sbox2[(t shr 16) and $FF]) -
cast_sbox3[(t shr 8) and $FF]) + cast_sbox4[t and $FF]);
t := LRot32(Data.xKey[10] xor r, Data.xKey[10 + 16]);
l := l xor (((cast_sbox1[t shr 24] - cast_sbox2[(t shr 16) and $FF]) +
cast_sbox3[(t shr 8) and $FF]) xor cast_sbox4[t and $FF]);
t := LRot32(Data.xKey[11] - l, Data.xKey[11 + 16]);
r := r xor (((cast_sbox1[t shr 24] + cast_sbox2[(t shr 16) and $FF]) xor
cast_sbox3[(t shr 8) and $FF]) - cast_sbox4[t and $FF]);
if Data.Rounds > 12 then
begin
t := LRot32(Data.xKey[12] + r, Data.xKey[12 + 16]);
l := l xor (((cast_sbox1[t shr 24] xor cast_sbox2[(t shr 16) and $FF]) -
cast_sbox3[(t shr 8) and $FF]) + cast_sbox4[t and $FF]);
t := LRot32(Data.xKey[13] xor l, Data.xKey[13 + 16]);
r := r xor (((cast_sbox1[t shr 24] - cast_sbox2[(t shr 16) and $FF]) +
cast_sbox3[(t shr 8) and $FF]) xor cast_sbox4[t and $FF]);
t := LRot32(Data.xKey[14] - r, Data.xKey[14 + 16]);
l := l xor (((cast_sbox1[t shr 24] + cast_sbox2[(t shr 16) and $FF]) xor
cast_sbox3[(t shr 8) and $FF]) - cast_sbox4[t and $FF]);
t := LRot32(Data.xKey[15] + l, Data.xKey[15 + 16]);
r := r xor (((cast_sbox1[t shr 24] xor cast_sbox2[(t shr 16) and $FF]) -
cast_sbox3[(t shr 8) and $FF]) + cast_sbox4[t and $FF]);
end;
l := (l shr 24) or ((l shr 8) and $FF00) or ((l shl 8) and $FF0000) or (l shl 24);
r := (r shr 24) or ((r shr 8) and $FF00) or ((r shl 8) and $FF0000) or (r shl 24);
Move(r, OutData^, Sizeof(r));
Move(l, pointer(integer(OutData) + 4)^, Sizeof(l));
end;
procedure Cast128DecryptECB;
var
t, l, r: DWord;
begin
Move(InData^, r, Sizeof(l));
Move(pointer(integer(InData) + 4)^, l, Sizeof(l));
l := (l shr 24) or ((l shr 8) and $FF00) or ((l shl 8) and $FF0000) or (l shl 24);
r := (r shr 24) or ((r shr 8) and $FF00) or ((r shl 8) and $FF0000) or (r shl 24);
if Data.Rounds > 12 then
begin
t := LRot32(Data.xKey[15] + l, Data.xKey[15 + 16]);
r := r xor (((cast_sbox1[t shr 24] xor cast_sbox2[(t shr 16) and $FF]) -
cast_sbox3[(t shr 8) and $FF]) + cast_sbox4[t and $FF]);
t := LRot32(Data.xKey[14] - r, Data.xKey[14 + 16]);
l := l xor (((cast_sbox1[t shr 24] + cast_sbox2[(t shr 16) and $FF]) xor
cast_sbox3[(t shr 8) and $FF]) - cast_sbox4[t and $FF]);
t := LRot32(Data.xKey[13] xor l, Data.xKey[13 + 16]);
r := r xor (((cast_sbox1[t shr 24] - cast_sbox2[(t shr 16) and $FF]) +
cast_sbox3[(t shr 8) and $FF]) xor cast_sbox4[t and $FF]);
t := LRot32(Data.xKey[12] + r, Data.xKey[12 + 16]);
l := l xor (((cast_sbox1[t shr 24] xor cast_sbox2[(t shr 16) and $FF]) -
cast_sbox3[(t shr 8) and $FF]) + cast_sbox4[t and $FF]);
end;
t := LRot32(Data.xKey[11] - l, Data.xKey[11 + 16]);
r := r xor (((cast_sbox1[t shr 24] + cast_sbox2[(t shr 16) and $FF]) xor
cast_sbox3[(t shr 8) and $FF]) - cast_sbox4[t and $FF]);
t := LRot32(Data.xKey[10] xor r, Data.xKey[10 + 16]);
l := l xor (((cast_sbox1[t shr 24] - cast_sbox2[(t shr 16) and $FF]) +
cast_sbox3[(t shr 8) and $FF]) xor cast_sbox4[t and $FF]);
t := LRot32(Data.xKey[9] + l, Data.xKey[9 + 16]);
r := r xor (((cast_sbox1[t shr 24] xor cast_sbox2[(t shr 16) and $FF]) -
cast_sbox3[(t shr 8) and $FF]) + cast_sbox4[t and $FF]);
t := LRot32(Data.xKey[8] - r, Data.xKey[8 + 16]);
l := l xor (((cast_sbox1[t shr 24] + cast_sbox2[(t shr 16) and $FF]) xor
cast_sbox3[(t shr 8) and $FF]) - cast_sbox4[t and $FF]);
t := LRot32(Data.xKey[7] xor l, Data.xKey[7 + 16]);
r := r xor (((cast_sbox1[t shr 24] - cast_sbox2[(t shr 16) and $FF]) +
cast_sbox3[(t shr 8) and $FF]) xor cast_sbox4[t and $FF]);
t := LRot32(Data.xKey[6] + r, Data.xKey[6 + 16]);
l := l xor (((cast_sbox1[t shr 24] xor cast_sbox2[(t shr 16) and $FF]) -
cast_sbox3[(t shr 8) and $FF]) + cast_sbox4[t and $FF]);
t := LRot32(Data.xKey[5] - l, Data.xKey[5 + 16]);
r := r xor (((cast_sbox1[t shr 24] + cast_sbox2[(t shr 16) and $FF]) xor
cast_sbox3[(t shr 8) and $FF]) - cast_sbox4[t and $FF]);
t := LRot32(Data.xKey[4] xor r, Data.xKey[4 + 16]);
l := l xor (((cast_sbox1[t shr 24] - cast_sbox2[(t shr 16) and $FF]) +
cast_sbox3[(t shr 8) and $FF]) xor cast_sbox4[t and $FF]);
t := LRot32(Data.xKey[3] + l, Data.xKey[3 + 16]);
r := r xor (((cast_sbox1[t shr 24] xor cast_sbox2[(t shr 16) and $FF]) -
cast_sbox3[(t shr 8) and $FF]) + cast_sbox4[t and $FF]);
t := LRot32(Data.xKey[2] - r, Data.xKey[2 + 16]);
l := l xor (((cast_sbox1[t shr 24] + cast_sbox2[(t shr 16) and $FF]) xor
cast_sbox3[(t shr 8) and $FF]) - cast_sbox4[t and $FF]);
t := LRot32(Data.xKey[1] xor l, Data.xKey[1 + 16]);
r := r xor (((cast_sbox1[t shr 24] - cast_sbox2[(t shr 16) and $FF]) +
cast_sbox3[(t shr 8) and $FF]) xor cast_sbox4[t and $FF]);
t := LRot32(Data.xKey[0] + r, Data.xKey[0 + 16]);
l := l xor (((cast_sbox1[t shr 24] xor cast_sbox2[(t shr 16) and $FF]) -
cast_sbox3[(t shr 8) and $FF]) + cast_sbox4[t and $FF]);
l := (l shr 24) or ((l shr 8) and $FF00) or ((l shl 8) and $FF0000) or (l shl 24);
r := (r shr 24) or ((r shr 8) and $FF00) or ((r shl 8) and $FF0000) or (r shl 24);
Move(l, OutData^, Sizeof(l));
Move(r, pointer(integer(OutData) + 4)^, Sizeof(r));
end;
procedure Cast128EncryptCBC;
begin
XorBlock(InData, @Data.LastBlock, OutData, 8);
Cast128EncryptECB(Data, OutData, OutData);
Move(OutData^, Data.LastBlock, 8);
end;
procedure Cast128DecryptCBC;
var
TempBlock: array[0..7] of byte;
begin
Move(InData^, TempBlock, 8);
Cast128DecryptECB(Data, InData, OutData);
XorBlock(OutData, @Data.LastBlock, OutData, 8);
Move(TempBlock, Data.LastBlock, 8);
end;
procedure Cast128EncryptCFB;
var
i: integer;
TempBlock: array[0..7] of byte;
begin
for i := 0 to Len - 1 do
begin
Cast128EncryptECB(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 Cast128DecryptCFB;
var
i: integer;
TempBlock: array[0..7] of byte;
b: byte;
begin
for i := 0 to Len - 1 do
begin
b := PByteArray(InData)[i];
Cast128EncryptECB(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 Cast128EncryptOFB;
begin
Cast128EncryptECB(Data, @Data.LastBlock, @Data.LastBlock);
XorBlock(@Data.LastBlock, InData, OutData, 8);
end;
procedure Cast128DecryptOFB;
begin
Cast128EncryptECB(Data, @Data.LastBlock, @Data.LastBlock);
XorBlock(@Data.LastBlock, InData, OutData, 8);
end;
procedure Cast128EncryptOFBC;
var
i: integer;
TempBlock: array[0..7] of byte;
begin
for i := 0 to Len - 1 do
begin
Cast128EncryptECB(Data, @Data.LastBlock, @TempBlock);
PByteArray(OutData)[i] := PByteArray(InData)[i] xor TempBlock[0];
IncBlock(@Data.LastBlock, 8);
end;
end;
procedure Cast128DecryptOFBC;
var
i: integer;
TempBlock: array[0..7] of byte;
begin
for i := 0 to Len - 1 do
begin
Cast128EncryptECB(Data, @Data.LastBlock, @TempBlock);
PByteArray(OutData)[i] := PByteArray(InData)[i] xor TempBlock[0];
IncBlock(@Data.LastBlock, 8);
end;
end;
procedure Cast128Reset;
begin
Move(Data.InitBlock, Data.LastBlock, 8);
end;
end.
//***********以下保存为tools.pas
unit Tools;
interface
uses
Sysutils;
type
{$IFDEF VER120}
dword = longword;
{$ELSE}
dword = longint;
{$ENDIF}
function LRot16(X: word; c: integer): word; assembler;
function RRot16(X: word; c: integer): word; assembler;
function LRot32(X: dword; c: integer): dword; assembler;
function RRot32(X: dword; c: integer): dword; assembler;
procedure XorBlock(I1, I2, O1: PByteArray; Len: integer);
procedure IncBlock(P: PByteArray; Len: integer);
implementation
function LRot16(X: word; c: integer): word; assembler;
asm
mov ecx,&c
mov ax,&X
rol ax,cl
mov &Result,ax
end;
function RRot16(X: word; c: integer): word; assembler;
asm
mov ecx,&c
mov ax,&X
ror ax,cl
mov &Result,ax
end;
function LRot32(X: dword; c: integer): dword; register; assembler;
asm
mov ecx, edx
rol eax, cl
end;
function RRot32(X: dword; c: integer): dword; register; assembler;
asm
mov ecx, edx
ror eax, cl
end;
procedure XorBlock(I1, I2, O1: PByteArray; Len: integer);
var
i: integer;
begin
for i := 0 to Len - 1 do
O1[i] := I1[i] xor I2[i];
end;
procedure IncBlock(P: PByteArray; Len: integer);
begin
Inc(P[Len - 1]);
if (P[Len - 1] = 0) and (Len > 1) then
IncBlock(P, Len - 1);
end;
end.
//*******以下保存为Unitmm.pas
unit Unitmm;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons, ExtCtrls, DBCtrls,
Registry, shellapi;
const
IV: array[0..7] of byte = ($11, $22, $33, $44, $55, $66, $77, $88);
MyPwdFile = 'teleme.pwd';
MyRegKey = 'teleme';
type
Tmmform = class(TForm)
BitBtn2: TBitBtn;
Button3: TButton;
Button4: TButton;
Button5: TButton;
Button6: TButton;
procedure BitBtn2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
passwd: array[0..100] of byte;
end;
var
mmform: Tmmform;
implementation
uses Cast128;
{$R *.DFM}
procedure Tmmform.BitBtn2Click(Sender: TObject);
begin
close;
end;
procedure Tmmform.Button3Click(Sender: TObject);
var
i: integer;
stream: tfilestream;
str: string;
pass: boolean;
Key: array[0..7] of byte;
KeyData: TCAST128Data;
temkey: array[0..100] of byte;
NewString: string;
ClickedOK: Boolean;
begin
stream := tfilestream.Create(MyPwdFile, fmopenread);
try
for i := 0 to 100 do
stream.Read(passwd[i], sizeof(byte));
finally
stream.free;
end;
//以上是先取得未经解密的数据
NewString := '请输入密码';
ClickedOK := InputQuery('请输入密码', '密码', NewString);
if ClickedOK then
begin
pass := true;
key[0] := $11;
key[1] := $22;
key[2] := $33;
key[3] := $44;
key[4] := $55;
key[5] := $66;
key[6] := $77;
key[7] := $88;
for i := 0 to 100 do
temkey[i] := passwd[i];
str := NewString;
for i := 1 to length(str) do
begin
passwd[i] := ord(str[i]);
if i < 8 then
key[i - 1] := ord(str[i]);
end;
CAST128Init(KeyData, @Key, Sizeof(Key), @IV);
for i := 1 to (101 div 8) do
CAST128DecryptCBC(KeyData, @temkey[(i - 1) * 8], @temkey[(i - 1) * 8]);
CAST128Reset(KeyData);
CAST128Burn(KeyData); //解密
for i := 1 to temkey[0] do
if ((temkey[i] <> passwd[i]) or (integer(temkey[0]) <> length(NewString))) then
pass := false;
if pass then
Showmessage('通过验证')
else
showmessage('很掺');
end;
end;
procedure Tmmform.Button4Click(Sender: TObject);
const
IV: array[0..7] of byte = ($11, $22, $33, $44, $55, $66, $77, $88);
var
Data: array[0..100] of byte;
i: integer;
KeyData: TCAST128Data;
str: string;
stream: tfilestream;
Key: array[0..7] of byte;
NewString: string;
ClickedOK: Boolean;
begin
NewString := '请输入设定密码';
ClickedOK := InputQuery('请输入密码', '密码', NewString);
if ClickedOK then
begin
key[0] := $11;
key[1] := $22;
key[2] := $33;
key[3] := $44;
key[4] := $55;
key[5] := $66;
key[6] := $77;
key[7] := $88;
data[0] := length(NewString);
str := NewString;
for i := 1 to data[0] do
begin
data[i] := ord(str[i]);
if i < 8 then
key[i - 1] := ord(str[i])
end;
CAST128Init(KeyData, @Key, Sizeof(Key), @IV);
for i := 1 to (101 div 8) do
CAST128EncryptCBC(KeyData, @Data[(i - 1) * 8], @Data[(i - 1) * 8]);
CAST128Reset(KeyData);
//保存密码
stream := tfilestream.Create(MyPwdFile, fmopenwrite or fmcreate);
try
for i := 0 to 100 do
stream.Write(data[i], sizeof(byte));
finally
stream.free;
end;
end;
end;
procedure Tmmform.Button5Click(Sender: TObject);
var
Reg: TRegistry;
i: integer;
str: string;
NewString: string;
ClickedOK: Boolean;
pass: boolean;
Key: array[0..7] of byte;
KeyData: TCAST128Data;
temkey: array[0..100] of byte;
begin
Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_CURRENT_CONFIG;
if Reg.OpenKey(MyRegKey + '\password', false) then
begin
reg.readBinaryData('', passwd, 101);
reg.closekey
end
finally
reg.free;
end;
//以上是先取得未经解密的数据
NewString := '请输入密码';
ClickedOK := InputQuery('请输入密码', '密码', NewString);
if ClickedOK then
begin
pass := true;
key[0] := $11;
key[1] := $22;
key[2] := $33;
key[3] := $44;
key[4] := $55;
key[5] := $66;
key[6] := $77;
key[7] := $88;
for i := 0 to 100 do
temkey[i] := passwd[i];
str := NewString;
for i := 1 to length(str) do
begin
passwd[i] := ord(str[i]);
if i < 8 then
key[i - 1] := ord(str[i]);
end;
CAST128Init(KeyData, @Key, Sizeof(Key), @IV);
for i := 1 to (101 div 8) do
CAST128DecryptCBC(KeyData, @temkey[(i - 1) * 8], @temkey[(i - 1) * 8]);
CAST128Reset(KeyData);
CAST128Burn(KeyData); //解密
for i := 1 to temkey[0] do
if ((temkey[i] <> passwd[i]) or (integer(temkey[0]) <> length(NewString))) then
pass := false;
if pass then
Showmessage('通过验证')
else
showmessage('很掺');
end;
end;
procedure Tmmform.Button6Click(Sender: TObject);
const
IV: array[0..7] of byte = ($11, $22, $33, $44, $55, $66, $77, $88);
var
Data: array[0..100] of byte;
i: integer;
Reg: TRegistry;
KeyData: TCAST128Data;
str: string;
Key: array[0..7] of byte;
NewString: string;
ClickedOK: Boolean;
begin
NewString := '请输入设定密码';
ClickedOK := InputQuery('请输入密码', '密码', NewString);
if ClickedOK then
begin
key[0] := $11;
key[1] := $22;
key[2] := $33;
key[3] := $44;
key[4] := $55;
key[5] := $66;
key[6] := $77;
key[7] := $88;
data[0] := length(NewString);
str := NewString;
for i := 1 to data[0] do
begin
data[i] := ord(str[i]);
if i < 8 then
key[i - 1] := ord(str[i])
end;
CAST128Init(KeyData, @Key, Sizeof(Key), @IV);
for i := 1 to (101 div 8) do
CAST128EncryptCBC(KeyData, @Data[(i - 1) * 8], @Data[(i - 1) * 8]);
CAST128Reset(KeyData);
//保存密码
try
Reg := TRegistry.Create;
Reg.RootKey := HKEY_CURRENT_CONFIG;
if Reg.OpenKey(MyRegKey + '\password', true) then
begin
reg.WriteBinaryData('', Data, 101);
reg.closekey;
end;
finally
reg.free;
end;
end;
end;
end.
//********以下保存为Unitmm.dfm
object mmform: Tmmform
Left = 270
Top = 159
BorderIcons = [biSystemMenu, biMinimize]
BorderStyle = bsSingle
Caption = '使用128位加密算法'
ClientHeight = 112
ClientWidth = 202
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
Position = poScreenCenter
Scaled = False
PixelsPerInch = 96
TextHeight = 13
object BitBtn2: TBitBtn
Left = 65
Top = 79
Width = 75
Height = 25
Cancel = True
Caption = '退出'
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = '宋体'
Font.Style = []
ParentFont = False
TabOrder = 0
OnClick = BitBtn2Click
NumGlyphs = 2
end
object Button3: TButton
Left = 11
Top = 43
Width = 75
Height = 25
Caption = '文件验证'
TabOrder = 1
OnClick = Button3Click
end
object Button4: TButton
Left = 11
Top = 6
Width = 75
Height = 25
Caption = '文件修改'
TabOrder = 2
OnClick = Button4Click
end
object Button5: TButton
Left = 101
Top = 43
Width = 75
Height = 25
Caption = '注册表验证'
TabOrder = 3
OnClick = Button5Click
end
object Button6: TButton
Left = 101
Top = 6
Width = 75
Height = 25
Caption = '注册表修改'
TabOrder = 4
OnClick = Button6Click
end
end
//**************以下保存为yj.dpr
program yj;
uses
Forms,
dialogs,
Unitmm in 'Unitmm.pas' {mmform},
Tools in 'Tools.pas',
Cast128 in 'Cast128.pas';
{$R *.RES}
begin
Application.Initialize;
Application.Title := '使用128位密码';
Application.CreateForm(Tmmform, mmform);
Application.Run;
end.
----
忙，忙，忙。
忙，忙，忙。
忙，忙，忙。
唉
再忙也得告诉我
|
|