lbcipher.pas

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

    shr  eax, 16
    mov  bh, al
    mov  bl, ah
    mov  [ecx], ebx
    pop  ebx
  end;

  procedure JoinBlock(const L, R : LongInt;  var Block : TDESBlock); register;
  asm
    push ebx
    mov  bh, al
    mov  bl, ah
    rol  ebx, 16
    shr  eax, 16
    mov  bh, al
    mov  bl, ah
    mov  [ecx+4], ebx
    mov  bh, dl
    mov  bl, dh
    rol  ebx, 16
    shr  edx, 16
    mov  bh, dl
    mov  bl, dh
    mov  [ecx], ebx
    pop  ebx
  end;

  procedure IPerm(var L, R : DWord);                                   
  var
    Work : DWord;                                                      
  begin
    Work := ((L shr 4) xor R) and $0F0F0F0F;
    R := R xor Work;
    L := L xor Work shl 4;

    Work := ((L shr 16) xor R) and $0000FFFF;
    R := R xor Work;
    L := L xor Work shl 16;

    Work := ((R shr 2) xor L) and $33333333;
    L := L xor Work;
    R := R xor Work shl 2;

    Work := ((R shr 8) xor L) and $00FF00FF;
    L := L xor Work;
    R := R xor Work shl 8;

    R := (R shl 1) or (R shr 31);
    Work := (L xor R) and $AAAAAAAA;
    L := L xor Work;
    R := R xor Work;
    L := (L shl 1) or (L shr 31);
  end;

  procedure FPerm(var L, R : DWord);                                   
  var
    Work : DWord;                                                      
  begin
    L := L;

    R := (R shl 31) or (R shr 1);
    Work := (L xor R) and $AAAAAAAA;
    L := L xor Work;
    R := R xor Work;
    L := (L shr 1) or (L shl 31);

    Work := ((L shr 8) xor R) and $00FF00FF;
    R := R xor Work;
    L := L xor Work shl 8;

    Work := ((L shr 2) xor R) and $33333333;
    R := R xor Work;
    L := L xor Work shl 2;

    Work := ((R shr 16) xor L) and $0000FFFF;
    L := L xor Work;
    R := R xor Work shl 16;

    Work := ((R shr 4) xor L) and $0F0F0F0F;
    L := L xor Work;
    R := R xor Work shl 4;
  end;

begin
  SplitBlock(Block, L, R);
  IPerm(L, R);

  CPtr := @Context;
  for I := 0 to 7 do begin
    Work := (((R shr 4) or (R shl 28)) xor CPtr^);
    Inc(CPtr);
    L := L xor SPBox[6, Work and $3F];
    L := L xor SPBox[4, Work shr 8 and $3F];
    L := L xor SPBox[2, Work shr 16 and $3F];
    L := L xor SPBox[0, Work shr 24 and $3F];

    Work := (R xor CPtr^);
    Inc(CPtr);
    L := L xor SPBox[7, Work and $3F];
    L := L xor SPBox[5, Work shr 8 and $3F];
    L := L xor SPBox[3, Work shr 16 and $3F];
    L := L xor SPBox[1, Work shr 24 and $3F];

    Work := (((L shr 4) or (L shl 28)) xor CPtr^);
    Inc(CPtr);
    R := R xor SPBox[6, Work and $3F];
    R := R xor SPBox[4, Work shr 8 and $3F];
    R := R xor SPBox[2, Work shr 16 and $3F];
    R := R xor SPBox[0, Work shr 24 and $3F];

    Work := (L xor CPtr^);
    Inc(CPtr);
    R := R xor SPBox[7, Work and $3F];
    R := R xor SPBox[5, Work shr 8 and $3F];
    R := R xor SPBox[3, Work shr 16 and $3F];
    R := R xor SPBox[1, Work shr 24 and $3F];
  end;

  FPerm(L, R);
  JoinBlock(L, R, Block);
end;
{ -------------------------------------------------------------------------- }
procedure EncryptDESCBC(const Context : TDESContext;  const Prev : TDESBlock;  var Block : TDESBlock);
begin
  if Context.Encrypt then begin
    XorMem(Block, Prev, SizeOf(Block));
    EncryptDES(Context, Block);
  end else begin
    EncryptDES(Context, Block);
    XorMem(Block, Prev, SizeOf(Block));
  end;
end;
{ -------------------------------------------------------------------------- }
procedure InitEncryptTripleDES(const Key : TKey128;  var Context : TTripleDESContext; Encrypt : Boolean);
var
  KeyArray : array [0..1] of TKey64;
begin
  Move(Key, KeyArray, SizeOf(KeyArray));                             {!!.01}
  if Encrypt then begin
    InitEncryptDES(KeyArray[0], Context[0], True);
    InitEncryptDES(KeyArray[1], Context[1], False);
  end else begin
    InitEncryptDES(KeyArray[0], Context[0], False);
    InitEncryptDES(KeyArray[1], Context[1], True);
  end;
end;
{ -------------------------------------------------------------------------- }
procedure EncryptTripleDES(const Context : TTripleDESContext;  var Block : TDESBlock);
begin
  EncryptDES(Context[0], Block);
  EncryptDES(Context[1], Block);
  EncryptDES(Context[0], Block);
end;
{ -------------------------------------------------------------------------- }
procedure EncryptTripleDESCBC(const Context : TTripleDESContext;  const Prev : TDESBlock; var Block : TDESBlock);
begin
  if Context[0].Encrypt then begin
    XorMem(Block, Prev, SizeOf(Block));
    EncryptDES(Context[0], Block);
    EncryptDES(Context[1], Block);
    EncryptDES(Context[0], Block);
  end else begin
    EncryptDES(Context[0], Block);
    EncryptDES(Context[1], Block);
    EncryptDES(Context[0], Block);
    XorMem(Block, Prev, SizeOf(Block));
  end;
end;
{ -------------------------------------------------------------------------- }
{!!.01}
procedure InitEncryptTripleDES3Key(const Key1, Key2, Key3 : TKey64;
            var Context : TTripleDESContext3Key; Encrypt : Boolean);
begin
  if Encrypt then begin
    InitEncryptDES(Key1, Context[0], True);
    InitEncryptDES(Key2, Context[1], False);
    InitEncryptDES(Key3, Context[2], True);
  end else begin
    InitEncryptDES(Key1, Context[2], False);
    InitEncryptDES(Key2, Context[1], True);
    InitEncryptDES(Key3, Context[0], False);
  end;
end;
{ -------------------------------------------------------------------------- }
{!!.01}
procedure EncryptTripleDES3Key(const Context : TTripleDESContext3Key;
            var Block : TDESBlock);
begin
  EncryptDES(Context[2], Block);
  EncryptDES(Context[1], Block);
  EncryptDES(Context[0], Block);
end;
{ -------------------------------------------------------------------------- }
{!!.01}
procedure EncryptTripleDESCBC3Key(const Context : TTripleDESContext3Key;
            const Prev : TDESBlock; var Block : TDESBlock);
begin
  if Context[0].Encrypt then begin
    XorMem(Block, Prev, SizeOf(Block));
    EncryptDES(Context[0], Block);
    EncryptDES(Context[1], Block);
    EncryptDES(Context[2], Block);
  end else begin
    EncryptDES(Context[0], Block);
    EncryptDES(Context[1], Block);
    EncryptDES(Context[2], Block);
    XorMem(Block, Prev, SizeOf(Block));
  end;
end;
{ -------------------------------------------------------------------------- }
procedure EncryptLQC(const Key : TKey128; var Block : TLQCBlock; Encrypt : Boolean);
const
  CKeyBox : array [False..True, 0..3, 0..2] of LongInt =
    (((0, 3, 1), (2, 1, 3), (1, 0, 2), (3, 2, 0)),
     ((3, 2, 0), (1, 0, 2), (2, 1, 3), (0, 3, 1)));
var
  KeyInts : array [0..3] of Longint;                                 {!!.01}
  Blocks  : array [0..1] of Longint;                                 {!!.01}
  Work    : LongInt;
  Right   : LongInt;
  Left    : LongInt;
  R       : LongInt;
  AA, BB  : LongInt;
  CC, DD  : LongInt;
begin
  Move(Key, KeyInts, SizeOf(KeyInts));                               {!!.01}
  Move(Block, Blocks, SizeOf(Blocks));                               {!!.01}
  Right := Blocks[0];
  Left := Blocks[1];

  for R := 0 to 3 do begin
    {transform the right side}
    AA := Right;
    BB := KeyInts[CKeyBox[Encrypt, R, 0]];
    CC := KeyInts[CKeyBox[Encrypt, R, 1]];
    DD := KeyInts[CKeyBox[Encrypt, R, 2]];

    {commented code does not affect results - removed for speed}
    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);

    Work := Left xor DD;
    Left := Right;
    Right := Work;
  end;

  Blocks[0] := Left;
  Blocks[1] := Right;
  Move(Blocks, Block, SizeOf(Block));                                {!!.01}
end;
{ -------------------------------------------------------------------------- }
procedure EncryptLQCCBC(const Key : TKey128; const Prev : TLQCBlock; var Block : TLQCBlock; Encrypt : Boolean);
begin
  if Encrypt then begin
    XorMem(Block, Prev, SizeOf(Block));
    EncryptLQC(Key, Block, Encrypt);
  end else begin
    EncryptLQC(Key, Block, Encrypt);
    XorMem(Block, Prev, SizeOf(Block));
  end;
end;
{ -------------------------------------------------------------------------- }
procedure InitEncryptBF(Key : TKey128; var Context : TBFContext);
var
  I     : Integer;
  J     : Integer;
  K     : Integer;
  Data  : LongInt;
  Block : TBFBlock;
begin
  {initialize PArray}
  Move(bf_P, Context.PBox, SizeOf(Context.PBox));
  {initialize SBox}
  Move(bf_S, Context.SBox, SizeOf(Context.SBox));

  {update PArray with the key bits}
  J := 0;
  for I := 0 to (BFRounds+1) do begin
    Data := 0;
    for K := 0 to 3 do begin
      Data := (Data shl 8) or Key[J];
      Inc(J);
      if J >= SizeOf(Key) then
        J := 0;
    end;
    Context.PBox[I] := Context.PBox[I] xor Data;
  end;

  {encrypt an all-zero string using the Blowfish algorithm and}
  {replace the elements of the P-array with the output of this process}

  Block[0] := 0;
  Block[1] := 0;
  I := 0;
  repeat
    EncryptBF(Context, Block, True);
    Context.PBox[I] := Block[0];
    Context.PBox[I+1] := Block[1];
    Inc(I, 2);
  until I > BFRounds+1;

  {continue the process, replacing the elements of the four S-boxes in}
  {order, with the output of the continuously changing Blowfish algorithm}

  for J := 0 to 3 do begin
    I := 0;
    repeat
      EncryptBF(Context, Block, True);
      Context.SBox[J, I] := Block[0];
      Context.SBox[J, I+1] := Block[1];
      Inc(I, 2);
    until I > 255;
  end;

  {in total, 521 iterations are required to generate all required subkeys. }
end;
{ -------------------------------------------------------------------------- }
procedure EncryptBF(const Context : TBFContext;
  var Block : TBFBlock; Encrypt : Boolean);
var
  I : Integer;
  TmpBlock : TBFBlockEx;                                             {!!.01}
begin
  Move(Block, TmpBlock, SizeOf(TmpBlock));                           {!!.01}
  if Encrypt then begin
    Block[0] := Block[0] xor Context.PBox[0];

    {16 Rounds to go (8 double rounds to avoid swaps)}
    I := 1;
    repeat
      {first half round }
      Block[1] := Block[1] xor Context.PBox[I] xor (((
                  Context.SBox[0, TmpBlock.Xl[3]] + Context.SBox[1, TmpBlock.Xl[2]])
                  xor Context.SBox[2, TmpBlock.Xl[1]]) + Context.SBox[3, TmpBlock.Xl[0]]);
      {second half round }
      Block[0] := Block[0] xor Context.PBox[I+1] xor (((
                  Context.SBox[0, TmpBlock.Xr[3]] + Context.SBox[1, TmpBlock.Xr[2]])
                  xor Context.SBox[2, TmpBlock.Xr[1]]) + Context.SBox[3, TmpBlock.Xr[0]]);
      Inc(I, 2);
    until I > BFRounds;
    Block[1] := Block[1] xor Context.PBox[(BFRounds+1)];
  end else begin
    Block[1] := Block[1] xor Context.PBox[(BFRounds+1)];

    {16 Rounds to go (8 double rounds to avoid swaps)}
    I := BFRounds;
    repeat
      {first half round }
      Block[0] := Block[0] xor Context.PBox[I] xor (((
                  Context.SBox[0, TmpBlock.Xr[3]] + Context.SBox[1, TmpBlock.Xr[2]])
                  xor Context.SBox[2, TmpBlock.Xr[1]]) + Context.SBox[3, TmpBlock.Xr[0]]);
      {second half round }
      Block[1] := Block[1] xor Context.PBox[i-1] xor (((
                  Context.SBox[0, TmpBlock.Xl[3]] + Context.SBox[1, TmpBlock.Xl[2]])
                  xor Context.SBox[2, TmpBlock.Xl[1]]) + Context.SBox[3, TmpBlock.Xl[0]]);