lbcipher.pas

java,delphi,C#通用des算法delphi实现 需要TurboPower LockBox

       Dec (I, 2);
     until I < 1;
     Block[0] := Block[0] xor Context.PBox[0];
  end;
end;
{ -------------------------------------------------------------------------- }
procedure EncryptBFCBC(const Context : TBFContext; const Prev : TBFBlock;
  var Block : TBFBlock; Encrypt : Boolean);
begin
  if Encrypt then begin
    XorMem(Block, Prev, SizeOf(Block));
    EncryptBF(Context, Block, Encrypt);
  end else begin
    EncryptBF(Context, Block, Encrypt);
    XorMem(Block, Prev, SizeOf(Block));
  end;
end;
{ -------------------------------------------------------------------------- }
procedure InitEncryptLSC(const Key; KeySize : Integer; var Context : TLSCContext);
var
  R, I, A   : LongInt;
  X         : Byte;
begin
  {initialize SBox}
  for I := 0 to 255 do
    Context.SBox[I] := I;

  A := 0;
  for R := 0 to 2 do  {3 rounds - "A" accumulates}
    for I := 0 to 255 do begin
      A := A + Context.SBox[I] + TByteArray(Key)[I mod KeySize];     {!!.01}
      X := Context.SBox[I];
      Context.SBox[I] := Context.SBox[Byte(A)];
      Context.SBox[Byte(A)] := X;
    end;

  Context.Index := 0;
  Context.Accumulator := A;
end;
{ -------------------------------------------------------------------------- }
procedure EncryptLSC(var Context : TLSCContext; var Buf; BufSize : LongInt);
var
  L, Y, X   : LongInt;
  I, A      : LongInt;
begin
  I := Context.Index;
  A := Context.Accumulator;

  for L := 0 to BufSize - 1 do begin
    I := I + 1;

    X := Context.SBox[Byte(I)];
    Y := Context.SBox[Byte(X)] + X;
    Context.SBox[Byte(I)] := Context.SBox[Byte(Y)];
    Context.SBox[Byte(Y)] := X;

    A := A + Context.SBox[Byte(Byte(Y shr 8) + Byte(Y))];
    TByteArray(Buf)[L] := TByteArray(Buf)[L] xor Byte(A);            {!!.01}
  end;

  Context.Index := I;
  Context.Accumulator := A;
end;
{ -------------------------------------------------------------------------- }
procedure InitEncryptRNG32(Key : LongInt; var Context : TRNG32Context);
begin
  LongInt(Context) := Key;
end;
{ -------------------------------------------------------------------------- }
procedure EncryptRNG32(var Context : TRNG32Context; var Buf; BufSize : LongInt);
var
  I     : LongInt;
begin
  for I := 0 to BufSize - 1 do
    TByteArray(Buf)[I] := TByteArray(Buf)[I] xor                     {!!.01}
                            Random32Byte(LongInt(Context));
end;
{ -------------------------------------------------------------------------- }
procedure InitEncryptRNG64(KeyHi, KeyLo : LongInt; var Context : TRNG64Context);
begin
  TInt64(Context).Lo := KeyLo;
  TInt64(Context).Hi := KeyHi;
end;
{ -------------------------------------------------------------------------- }
procedure EncryptRNG64(var Context : TRNG64Context; var Buf; BufSize : LongInt);
var
  I : Integer;
begin
  for I := 0 to BufSize - 1 do
    TByteArray(Buf)[I] := TByteArray(Buf)[I] xor                     {!!.01}
                            Random64Byte(TInt64(Context));
end;
{ -------------------------------------------------------------------------- }
procedure GenerateRandomKey(var Key; KeySize : Integer);
var
  I     : Integer;
begin
  Randomize;
  for I := 0 to KeySize - 1 do
    TByteArray(Key)[I] := System.Random(256);                        {!!.01}
end;
{ -------------------------------------------------------------------------- }
procedure GenerateLMDKey(var Key; KeySize : Integer; const Str : string);
begin
  HashLMD(Key, KeySize, Str[1], Length(Str));
end;
{ -------------------------------------------------------------------------- }
procedure GenerateMD5Key(var Key : TKey128; const Str : string);
var
  D : TMD5Digest;
begin
  HashMD5(D, Str[1], Length(Str));
  Key := TKey128(D);
end;
{ -------------------------------------------------------------------------- }
function Ran0Prim(var Seed : LongInt; IA, IQ, IR : LongInt) : LongInt;
const
  IM = 2147483647;
  MA = 123459876;
var
  I, K : LongInt;
begin
  {XORing with mask avoids seeds of zero}
  I := Seed xor MA;
  K := I div IQ;
  I := (IA * (I - (K * IQ))) - (IR * K);
  if I < 0 then
    I := I + IM;
  Result := I xor MA;
  Seed := Result;
end;
{ -------------------------------------------------------------------------- }
function Ran01(var Seed : LongInt) : LongInt;
begin
  Result := Ran0Prim(Seed, 16807, 127773, 2836);
end;
{ -------------------------------------------------------------------------- }
function Ran02(var Seed : LongInt) : LongInt;
begin
  Result := Ran0Prim(Seed, 48271, 44488, 3399);
end;
{ -------------------------------------------------------------------------- }
function Ran03(var Seed : LongInt) : LongInt;
begin
  Result := Ran0Prim(Seed, 69621, 30845, 23902);
end;
{ -------------------------------------------------------------------------- }
function Random32Byte(var Seed : LongInt) : Byte;
var
  L : LongInt;
  R : TLongIntRec;
begin
  L := Ran01(Seed);
  R := TLongIntRec(L);
  Result := R.LoLo xor R.LoHi xor R.HiLo xor R.HiHi;
end;
{ -------------------------------------------------------------------------- }
function Random64(var Seed : TInt64) : LongInt;
begin
  Ran01(Seed.Lo);
  Ran01(Seed.Hi);
  Result := Seed.Lo xor Seed.Hi;
end;
{ -------------------------------------------------------------------------- }
function Random64Byte(var Seed : TInt64) : Byte;
var
  L : LongInt;
  R : TLongIntRec;
begin
  L := Random64(Seed);
  R := TLongIntRec(L);
  Result := R.LoLo xor R.LoHi xor R.HiLo xor R.HiHi;
end;
{ -------------------------------------------------------------------------- }
procedure  ShrinkDESKey(var Key : TKey64);
const
  SK1 : TKey64 = ($C4,$08,$B0,$54,$0B,$A1,$E0,$AE);
  SK2 : TKey64 = ($EF,$2C,$04,$1C,$E6,$38,$2F,$E6);
var
  I       : Integer;
  Work1   : TKey64;
  Work2   : TKey64;
  Context : TDESContext;
begin
  {step #1 zero the parity bits - 8, 16, 24, ..., 64}
  for I := 0 to 7 do
    Work1[I] := Key[I] and $FE;

  {step #2 encrypt output of #1 with SK1 and xor with output of #1}
  InitEncryptDES(SK1, Context, True);
  Work2 := Work1; {make copy}
  EncryptDES(Context, TDESBlock(Work2));
  for I := 0 to 7 do
    Work1[I] := Work1[I] xor Work2[I];

  {step #3 zero bits 1,2,3,4,8,16,17,18,19,20,24,32,33,34,35,36,40,48,49,50,51,52,56,64}
  TInt64(Work1).Lo := TInt64(Work1).Lo and $F101F101;
  TInt64(Work1).Hi := TInt64(Work1).Hi and $F101F101;

  {step #4 encrypt output of #3 with SK2}
  InitEncryptDES(SK2, Context, True);
  EncryptDES(Context, TDESBlock(Work1));

  Key := Work1;
end;
{ -------------------------------------------------------------------------- }
procedure Mix128(var X : T128Bit);
var
  AA, BB, CC, DD : LongInt;
begin
  AA := X[0];  BB := X[1];  CC := X[2];  DD := X[3];

  AA := AA + DD;  DD := DD + AA;  AA := AA xor (AA shr 7);
  BB := BB + AA;  AA := AA + BB;  BB := BB xor (BB shl 13);
  CC := CC + BB;  BB := BB + CC;  CC := CC xor (CC shr 17);
  DD := DD + CC;  CC := CC + DD;  DD := DD xor (DD shl 9);
  AA := AA + DD;  DD := DD + AA;  AA := AA xor (AA shr 3);
  BB := BB + AA;  AA := AA + BB;  BB := BB xor (BB shl 7);
  CC := CC + BB;  BB := BB + CC;  CC := CC xor (DD shr 15);
  DD := DD + CC;  CC := CC + DD;  DD := DD xor (DD shl 11);

  X[0] := AA;  X[1] := BB;  X[2] := CC;  X[3] := DD;
end;
{ -------------------------------------------------------------------------- }
procedure HashELF(var Digest : LongInt; const Buf;  BufSize : LongInt);
var
  I, X  : LongInt;
begin
  Digest := 0;
  for I := 0 to BufSize - 1 do begin
    Digest := (Digest shl 4) + TByteArray(Buf)[I];                   {!!.01}
    X := Digest and $F0000000;
    if (X <> 0) then
      Digest := Digest xor (X shr 24);
    Digest := Digest and (not X);
  end;
end;
{ -------------------------------------------------------------------------- }
procedure StringHashELF(var Digest : LongInt; const Str : string);
begin
  HashELF(Digest, Str[1], Length(Str));
end;
{ -------------------------------------------------------------------------- }
function RolX(I, C : DWord) : DWord; register;
asm
  mov  ecx, edx         {get count to cl}
  rol  eax, cl          {rotate eax by cl}
end;
{ -------------------------------------------------------------------------- }
procedure Transform(var Buffer : array of DWord;  const InBuf : array of DWord);
const
  S11 = 7;
  S12 = 12;
  S13 = 17;
  S14 = 22;
  S21 = 5;
  S22 = 9;
  S23 = 14;
  S24 = 20;
  S31 = 4;
  S32 = 11;
  S33 = 16;
  S34 = 23;
  S41 = 6;
  S42 = 10;
  S43 = 15;
  S44 = 21;
var
  Buf : array [0..3] of DWord;                                       {!!.01}
  InA : array [0..15] of DWord;                                      {!!.01}
var
  A   : DWord;
  B   : DWord;
  C   : DWord;
  D   : DWord;

  procedure FF(var A : DWord;  B, C, D, X, S, AC : DWord);
  begin
    A := RolX(A + ((B and C) or (not B and D)) + X + AC, S) + B;
  end;

  procedure GG(var A : DWord;  B, C, D, X, S, AC : DWord);
  begin
    A := RolX(A + ((B and D) or (C and not D)) + X + AC, S) + B;
  end;

  procedure HH(var A : DWord;  B, C, D, X, S, AC : DWord);
  begin
    A := RolX(A + (B xor C xor D) + X + AC, S) + B;
  end;

  procedure II(var A : DWord;  B, C, D, X, S, AC : DWord);
  begin
    A := RolX(A + (C xor (B or not D)) + X + AC, S) + B;
  end;

begin
  Move(Buffer, Buf, SizeOf(Buf));                                    {!!.01}
  Move(InBuf, InA, SizeOf(InA));                                     {!!.01}
  A := Buf [0];
  B := Buf [1];
  C := Buf [2];
  D := Buf [3];


  {round 1}
  FF(A, B, C, D, InA [ 0], S11, $D76AA478);  { 1 }
  FF(D, A, B, C, InA [ 1], S12, $E8C7B756);  { 2 }
  FF(C, D, A, B, InA [ 2], S13, $242070DB);  { 3 }
  FF(B, C, D, A, InA [ 3], S14, $C1BDCEEE);  { 4 }
  FF(A, B, C, D, InA [ 4], S11, $F57C0FAF);  { 5 }
  FF(D, A, B, C, InA [ 5], S12, $4787C62A);  { 6 }
  FF(C, D, A, B, InA [ 6], S13, $A8304613);  { 7 }
  FF(B, C, D, A, InA [ 7], S14, $FD469501);  { 8 }
  FF(A, B, C, D, InA [ 8], S11, $698098D8);  { 9 }
  FF(D, A, B, C, InA [ 9], S12, $8B44F7AF);  { 10 }
  FF(C, D, A, B, InA [10], S13, $FFFF5BB1);  { 11 }
  FF(B, C, D, A, InA [11], S14, $895CD7BE);  { 12 }
  FF(A, B, C, D, InA [12], S11, $6B901122);  { 13 }
  FF(D, A, B, C, InA [13], S12, $FD987193);  { 14 }
  FF(C, D, A, B, InA [14], S13, $A679438E);  { 15 }
  FF(B, C, D, A, InA [15], S14, $49B40821);  { 16 }

  {round 2}
  GG(A, B, C, D, InA [ 1], S21, $F61E2562);  { 17 }
  GG(D, A, B, C, InA [ 6], S22, $C040B340);  { 18 }
  GG(C, D, A, B, InA [11], S23, $265E5A51);  { 19 }
  GG(B, C, D, A, InA [ 0], S24, $E9B6C7AA);  { 20 }
  GG(A, B, C, D, InA [ 5], S21, $D62F105D);  { 21 }
  GG(D, A, B, C, InA [10], S22, $02441453);  { 22 }
  GG(C, D, A, B, InA [15], S23, $D8A1E681);  { 23 }
  GG(B, C, D, A, InA [ 4], S24, $E7D3FBC8);  { 24 }
  GG(A, B, C, D, InA [ 9], S21, $21E1CDE6);  { 25 }
  GG(D, A, B, C, InA [14], S22, $C33707D6);  { 26 }
  GG(C, D, A, B, InA [ 3], S23, $F4D50D87);  { 27 }
  GG(B, C, D, A, InA [ 8], S24, $455A14ED);  { 28 }
  GG(A, B, C, D, InA [13], S21, $A9E3E905);  { 29 }
  GG(D, A, B, C, InA [ 2], S22, $FCEFA3F8);  { 30 }
  GG(C, D, A, B, InA [ 7], S23, $676F02D9);  { 31 }
  GG(B, C, D, A, InA [12], S24, $8D2A4C8A);  { 32 }

  {round 3}
  HH(A, B, C, D, InA [ 5], S31, $FFFA3942);  { 33 }
  HH(D, A, B, C, InA [ 8], S32, $8771F681);  { 34 }
  HH(C, D, A, B, InA [11], S33, $6D9D6122);  { 35 }
  HH(B, C, D, A, InA [14], S34, $FDE5380C);  { 36 }
  HH(A, B, C, D, InA [ 1], S31, $A4BEEA44);  { 37 }
  HH(D, A, B, C, InA [ 4], S32, $4BDECFA9);  { 38 }
  HH(C, D, A, B, InA [ 7], S33, $F6BB4B60);  { 39 }
  HH(B, C, D, A, InA [10], S34, $BEBFBC70);  { 40 }
  HH(A, B, C, D, InA [13], S31, $289B7EC6);  { 41 }
  HH(D, A, B, C, InA [ 0], S32, $EAA127FA);  { 42 }
  HH(C, D, A, B, InA [ 3], S33, $D4EF3085);  { 43 }
  HH(B, C, D, A, InA [ 6], S34,  $4881D05);  { 44 }
  HH(A, B, C, D, InA [ 9], S31, $D9D4D039);  { 45 }
  HH(D, A, B, C, InA [12], S32, $E6DB99E5);  { 46 }
  HH(C, D, A, B, InA [15], S33, $1FA27CF8);  { 47 }
  HH(B, C, D, A, InA [ 2], S34, $C4AC5665);  { 48 }

  {round 4}
  II(A, B, C, D, InA [ 0], S41, $F4292244);  { 49 }