deccipher.pas

cipher 5.1。一个几乎包含了所有常见的加密算法的控件

    S.Free;
  end;
end;

procedure TDECCipher.EncodeFile(const Source, Dest: String; const Progress: IDECProgress);
begin
  DoCodeFile(Source, Dest, Context.BlockSize, Encode, Progress);
end;

procedure TDECCipher.DecodeFile(const Source, Dest: String; const Progress: IDECProgress);
begin
  DoCodeFile(Source, Dest, Context.BlockSize, Decode, Progress);
end;

procedure TDECCipher.EncodeStream(const Source, Dest: TStream; const DataSize: Int64; const Progress: IDECProgress);
begin
  DoCodeStream(Source, Dest, DataSize, Context.BlockSize, Encode, Progress);
end;

procedure TDECCipher.DecodeStream(const Source, Dest: TStream; const DataSize: Int64; const Progress: IDECProgress);
begin
  DoCodeStream(Source, Dest, DataSize, Context.BlockSize, Decode, Progress);
end;

function TDECCipher.CalcMAC(Format: TDECFormatClass): Binary;
begin
  Done;
  if FMode in [cmECBx] then raise EDECException.Create(sInvalidMACMode)
    else Result := ValidFormat(Format).Encode(FBuffer^, FBufferSize);
end;

// .TCipher_Null
class function TCipher_Null.Context: TCipherContext;
begin
  Result.KeySize := 0;
  Result.BlockSize := 1;
  Result.BufferSize := 32;
  Result.UserSize := 0;
  Result.UserSave := False;
end;

procedure TCipher_Null.DoInit(const Key; Size: Integer);
begin
end;

procedure TCipher_Null.DoEncode(Source, Dest: Pointer; Size: Integer);
begin
  if Source <> Dest then Move(Source^, Dest^, Size);
end;

procedure TCipher_Null.DoDecode(Source, Dest: Pointer; Size: Integer);
begin
  if Source <> Dest then Move(Source^, Dest^, Size);
end;

// .TCipher_Blowfish

{$IFDEF UseASM}
  {$IFDEF 486GE}
    {$DEFINE Blowfish_asm}
  {$ENDIF}
{$ENDIF}

type
  PBlowfish = ^TBlowfish;
  TBlowfish = array[0..3, 0..255] of LongWord;

class function TCipher_Blowfish.Context: TCipherContext;
begin
  Result.KeySize := 56;
  Result.BufferSize := 8;
  Result.BlockSize := 8;
  Result.UserSize := SizeOf(Blowfish_Data) + SizeOf(Blowfish_Key);
  Result.UserSave := False;
end;

procedure TCipher_Blowfish.DoInit(const Key; Size: Integer);
var
  I,J: Integer;
  B: array[0..1] of LongWord;
  K: PByteArray;
  P: PLongArray;
  S: PBlowfish;
begin
  K := @Key;
  S := FUser;
  P := Pointer(PChar(FUser) + SizeOf(Blowfish_Data));
  Move(Blowfish_Data, S^, SizeOf(Blowfish_Data));
  Move(Blowfish_Key, P^, Sizeof(Blowfish_Key));
  J := 0;
  if Size > 0 then
    for I := 0 to 17 do
    begin
      P[I] := P[I] xor (K[(J + 0) mod Size] shl 24 +
                        K[(J + 1) mod Size] shl 16 +
                        K[(J + 2) mod Size] shl  8 +
                        K[(J + 3) mod Size] shl  0);
      J := (J + 4) mod Size;
    end;
  FillChar(B, SizeOf(B), 0);
  for I := 0 to 8 do
  begin
    DoEncode(@B, @B, SizeOf(B));
    P[I * 2 + 0] := SwapLong(B[0]);
    P[I * 2 + 1] := SwapLong(B[1]);
  end;
  for I := 0 to 3 do
    for J := 0 to 127 do
    begin
      DoEncode(@B, @B, SizeOf(B));
      S[I, J * 2 + 0] := SwapLong(B[0]);
      S[I, J * 2 + 1] := SwapLong(B[1]);
    end;
  FillChar(B, SizeOf(B), 0);
end;

procedure TCipher_Blowfish.DoEncode(Source, Dest: Pointer; Size: Integer);
{$IFDEF Blowfish_asm}  // specialy for CPU >= 486
// Source = EDX, Dest=ECX, Size on Stack
asm
        PUSH   EDI
        PUSH   ESI
        PUSH   EBX
        PUSH   EBP
        PUSH   ECX
        MOV    ESI,[EAX].TCipher_Blowfish.FUser
        MOV    EBX,[EDX + 0]     // A
        MOV    EBP,[EDX + 4]     // B
        BSWAP  EBX               // CPU >= 486
        BSWAP  EBP
        XOR    EBX,[ESI + 4 * 256 * 4]
        XOR    EDI,EDI
@@1:    MOV    EAX,EBX
        SHR    EBX,16
        MOVZX  ECX,BH
        AND    EBX,0FFh
        MOV    ECX,[ESI + ECX * 4 + 1024 * 0]
        MOV    EBX,[ESI + EBX * 4 + 1024 * 1]
        MOVZX  EDX,AH
        ADD    EBX,ECX
        MOVZX  ECX,AL
        MOV    EDX,[ESI + EDX * 4 + 1024 * 2]
        MOV    ECX,[ESI + ECX * 4 + 1024 * 3]
        XOR    EBX,EDX
        XOR    EBP,[ESI + 4 * 256 * 4 + 4 + EDI * 4]
        ADD    EBX,ECX
        INC    EDI
        XOR    EBX,EBP
        TEST   EDI,010h
        MOV    EBP,EAX
        JZ     @@1
        POP    EAX
        XOR    EBP,[ESI + 4 * 256 * 4 + 17 * 4]
        BSWAP  EBX
        BSWAP  EBP
        MOV    [EAX + 4],EBX
        MOV    [EAX + 0],EBP
        POP    EBP
        POP    EBX
        POP    ESI
        POP    EDI
end;
{$ELSE}
var
  I,A,B: LongWord;
  P: PLongArray;
  D: PBlowfish;
begin
  Assert(Size = Context.BlockSize);

  D := FUser;
  P := Pointer(PChar(FUser) + SizeOf(Blowfish_Data));
  A := SwapLong(PLongArray(Source)[0]) xor P[0]; P := @P[1];
  B := SwapLong(PLongArray(Source)[1]);
  for I := 0 to 7 do
  begin
    B := B xor P[0] xor (D[0, A shr 24        ] +
                         D[1, A shr 16 and $FF] xor
                         D[2, A shr  8 and $FF] +
                         D[3, A        and $FF]);

    A := A xor P[1] xor (D[0, B shr 24        ] +
                         D[1, B shr 16 and $FF] xor
                         D[2, B shr  8 and $FF] +
                         D[3, B        and $FF]);
    P := @P[2];
  end;
  PLongArray(Dest)[0] := SwapLong(B xor P[0]);
  PLongArray(Dest)[1] := SwapLong(A);
end;
{$ENDIF}

procedure TCipher_Blowfish.DoDecode(Source, Dest: Pointer; Size: Integer);
{$IFDEF Blowfish_asm}
asm
        PUSH   EDI
        PUSH   ESI
        PUSH   EBX
        PUSH   EBP
        PUSH   ECX
        MOV    ESI,[EAX].TCipher_Blowfish.FUser
        MOV    EBX,[EDX + 0]     // A
        MOV    EBP,[EDX + 4]     // B
        BSWAP  EBX
        BSWAP  EBP
        XOR    EBX,[ESI + 4 * 256 * 4 + 17 * 4]
        MOV    EDI,16
@@1:    MOV    EAX,EBX
        SHR    EBX,16
        MOVZX  ECX,BH
        MOVZX  EDX,BL
        MOV    EBX,[ESI + ECX * 4 + 1024 * 0]
        MOV    EDX,[ESI + EDX * 4 + 1024 * 1]
        MOVZX  ECX,AH
        LEA    EBX,[EBX + EDX]
        MOVZX  EDX,AL
        MOV    ECX,[ESI + ECX * 4 + 1024 * 2]
        MOV    EDX,[ESI + EDX * 4 + 1024 * 3]
        XOR    EBX,ECX
        XOR    EBP,[ESI + 4 * 256 * 4 + EDI * 4]
        LEA    EBX,[EBX + EDX]
        XOR    EBX,EBP
        DEC    EDI
        MOV    EBP,EAX
        JNZ    @@1
        POP    EAX
        XOR    EBP,[ESI + 4 * 256 * 4]
        BSWAP  EBX
        BSWAP  EBP
        MOV    [EAX + 0],EBP
        MOV    [EAX + 4],EBX
        POP    EBP
        POP    EBX
        POP    ESI
        POP    EDI
end;
{$ELSE}
var
  I,A,B: LongWord;
  P: PLongArray;
  D: PBlowfish;
begin
  Assert(Size = Context.BlockSize);

  D := FUser;
  P := Pointer(PChar(FUser) + SizeOf(Blowfish_Data) + SizeOf(Blowfish_Key) - SizeOf(Integer));
  A := SwapLong(PLongArray(Source)[0]) xor P[0];
  B := SwapLong(PLongArray(Source)[1]);
  for I := 0 to 7 do
  begin
    Dec(PLongWord(P), 2);
    B := B xor P[1] xor (D[0, A shr 24        ] +
                         D[1, A shr 16 and $FF] xor
                         D[2, A shr  8 and $FF] +
                         D[3, A        and $FF]);
    A := A xor P[0] xor (D[0, B shr 24        ] +
                         D[1, B shr 16 and $FF] xor
                         D[2, B shr  8 and $FF] +
                         D[3, B        and $FF]);
  end;
  Dec(PLongWord(P));
  PLongArray(Dest)[0] := SwapLong(B xor P[0]);
  PLongArray(Dest)[1] := SwapLong(A);
end;
{$ENDIF}

// .TCipher_Twofish
type
  PTwofishBox = ^TTwofishBox;
  TTwofishBox = array[0..3, 0..255] of Longword;

  TLongRec = record
               case Integer of
                 0: (L: Longword);
                 1: (A,B,C,D: Byte);
             end;

class function TCipher_Twofish.Context: TCipherContext;
begin
  Result.KeySize := 32;
  Result.BufferSize := 16;
  Result.BlockSize := 16;
  Result.UserSize := 4256;
  Result.UserSave := False;
end;

procedure TCipher_Twofish.DoInit(const Key; Size: Integer);
var
  BoxKey: array[0..3] of TLongRec;
  SubKey: PLongArray;
  Box: PTwofishBox;

  procedure SetupKey;

    function Encode(K0, K1: Integer): Integer;
    var
      R, I, J, G2, G3: Integer;
      B: byte;
    begin
      R := 0;
      for I := 0 to 1 do
      begin
        if I <> 0 then R := R xor K0 else R := R xor K1;
        for J := 0 to 3 do
        begin
          B := R shr 24;
          if B and $80 <> 0 then G2 := (B shl 1 xor $014D) and $FF
            else G2 := B shl 1 and $FF;
          if B and 1 <> 0 then G3 := (B shr 1 and $7F) xor $014D shr 1 xor G2
            else G3 := (B shr 1 and $7F) xor G2;
          R := R shl 8 xor G3 shl 24 xor G2 shl 16 xor G3 shl 8 xor B;
        end;
      end;
      Result := R;
    end;

    function F32(X: Integer; K: array of Integer): Integer;
    var
      A, B, C, D: LongWord;
    begin
      A := X        and $FF;
      B := X shr  8 and $FF;
      C := X shr 16 and $FF;
      D := X shr 24;
      if Size = 32 then
      begin
        A := Twofish_8x8[1, A] xor K[3]        and $FF;
        B := Twofish_8x8[0, B] xor K[3] shr  8 and $FF;
        C := Twofish_8x8[0, C] xor K[3] shr 16 and $FF;
        D := Twofish_8x8[1, D] xor K[3] shr 24;
      end;
      if Size >= 24 then
      begin
        A := Twofish_8x8[1, A] xor K[2]        and $FF;
        B := Twofish_8x8[1, B] xor K[2] shr  8 and $FF;
        C := Twofish_8x8[0, C] xor K[2] shr 16 and $FF;
        D := Twofish_8x8[0, D] xor K[2] shr 24;
      end;
      A := Twofish_8x8[0, A] xor K[1]        and $FF;
      B := Twofish_8x8[1, B] xor K[1] shr  8 and $FF;
      C := Twofish_8x8[0, C] xor K[1] shr 16 and $FF;
      D := Twofish_8x8[1, D] xor K[1] shr 24;

      A := Twofish_8x8[0, A] xor K[0]        and $FF;
      B := Twofish_8x8[0, B] xor K[0] shr  8 and $FF;
      C := Twofish_8x8[1, C] xor K[0] shr 16 and $FF;
      D := Twofish_8x8[1, D] xor K[0] shr 24;

      Result := Twofish_Data[0, A] xor Twofish_Data[1, B] xor
                Twofish_Data[2, C] xor Twofish_Data[3, D];
    end;

  var
    I,J,A,B: Integer;
    E,O: array[0..3] of Integer;
    K: array[0..7] of Integer;
  begin
    FillChar(K, SizeOf(K), 0);
    Move(Key, K, Size);
    if Size <= 16 then Size := 16 else
      if Size <= 24 then Size := 24
        else Size := 32;
    J := Size shr 3 - 1;
    for I := 0 to J do
    begin
      E[I] := K[I shl 1];
      O[I] := K[I shl 1 + 1];
      BoxKey[J].L := Encode(E[I], O[I]);
      Dec(J);
    end;
    J := 0;
    for I := 0 to 19 do
    begin
      A := F32(J, E);
      B := F32(J + $01010101, O);
      B := B shl 8 or B shr 24;
      SubKey[I shl 1] := A + B;
      B := A + B shl 1;     // here buggy instead shr 1 it's correct shl 1
      SubKey[I shl 1 + 1] := B shl 9 or B shr 23;
      Inc(J, $02020202);
    end;
  end;

  procedure DoXOR(D, S: PLongArray; Value: LongWord);
  var
    I: LongWord;
  begin
    Value := (Value and $FF) * $01010101;
    for I := 0 to 63 do D[I] := S[I] xor Value;
  end;

  procedure SetupBox128;
  var
    L: array[0..255] of Byte;
    A,I: Integer;
  begin
    DoXOR(@L, @Twofish_8x8[0], BoxKey[1].L);
    A := BoxKey[0].A;
    for I := 0 to 255 do
      Box[0, I] := Twofish_Data[0, Twofish_8x8[0, L[I]] xor A];
    DoXOR(@L, @Twofish_8x8[1], BoxKey[1].L shr 8);
    A := BoxKey[0].B;
    for I := 0 to 255 do
      Box[1, I] := Twofish_Data[1, Twofish_8x8[0, L[I]] xor A];
    DoXOR(@L, @Twofish_8x8[0], BoxKey[1].L shr 16);
    A := BoxKey[0].C;
    for I := 0 to 255 do
      Box[2, I] := Twofish_Data[2, Twofish_8x8[1, L[I]] xor A];
    DoXOR(@L, @Twofish_8x8[1], BoxKey[1].L shr 24);
    A := BoxKey[0].D;
    for I := 0 to 255 do
      Box[3, I] := Twofish_Data[3, Twofish_8x8[1, L[I]] xor A];
  end;

  procedure SetupBox192;
  var
    L: array[0..255] of Byte;
    A,B,I: Integer;
  begin
    DoXOR(@L, @Twofish_8x8[1], BoxKey[2].L);