deccipher.pas

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

      XORBuffers(D[I], FFeedback[0], Size, FFeedback[0]);
      FBufferIndex := Size;
    end;
  end;

  procedure EncodeCBCx(S,D: PByteArray; Size: Integer);
  var
    F: PByteArray;
    I: Integer;
  begin
    Dec(Size, FBufferSize);
    F := FFeedback;
    I := 0;
    while I <= Size do
    begin
      XORBuffers(S[I], F[0], FBufferSize, D[I]);
      F := @D[I];
      DoEncode(F, F, FBufferSize);
      Inc(I, FBufferSize);
    end;
    if F <> FFeedback then
      Move(F[0], FFeedback[0], FBufferSize);
    Dec(Size, I - FBufferSize);
    if Size > 0 then
    begin  // padding
      EncodeCFB8(@S[I], @D[I], Size);
      FState := csPadded;
    end else FState := csEncode;
  end;

  procedure EncodeCTSx(S,D: PByteArray; Size: Integer);
  var
    I: Integer;
  begin
    Dec(Size, FBufferSize);
    I := 0;
    while I <= Size do
    begin
      XORBuffers(S[I], FFeedback[0], FBufferSize, D[I]);
      DoEncode(@D[I], @D[I], FBufferSize);
      XORBuffers(D[I], FFeedback[0], FBufferSize, FFeedback[0]);
      Inc(I, FBufferSize);
     end;
     Dec(Size, I - FBufferSize);
     if Size > 0 then
     begin // padding
       EncodeCFS8(@S[I], @D[I], Size);
       FState := csPadded;
     end else FState := csEncode;
  end;

begin
  CheckState([csInitialized, csEncode, csDone]);
  case FMode of
    cmECBx: EncodeECBx(@Source, @Dest, DataSize);
    cmCBCx: EncodeCBCx(@Source, @Dest, DataSize);
    cmCTSx: EncodeCTSx(@Source, @Dest, DataSize);
    cmCFB8: EncodeCFB8(@Source, @Dest, DataSize);
    cmCFBx: EncodeCFBx(@Source, @Dest, DataSize);
    cmOFB8: EncodeOFB8(@Source, @Dest, DataSize);
    cmOFBx: EncodeOFBx(@Source, @Dest, DataSize);
    cmCFS8: EncodeCFS8(@Source, @Dest, DataSize);
    cmCFSx: EncodeCFSx(@Source, @Dest, DataSize);
  end;
end;

procedure TDECCipher.Decode(const Source; var Dest; DataSize: Integer);

  procedure DecodeECBx(S,D: PByteArray; Size: Integer);
  var
    I: Integer;
  begin
    if Context.BlockSize = 1 then
    begin
      DoDecode(S, D, Size);
      FState := csDecode;
    end else
    begin
      Dec(Size, FBufferSize);
      I := 0;
      while I <= Size do
      begin
        DoDecode(@S[I], @D[I], FBufferSize);
        Inc(I, FBufferSize);
      end;
      Dec(Size, I - FBufferSize);
      if Size > 0 then
        if Size mod Context.BlockSize = 0 then
        begin
          DoDecode(@S[I], @D[I], Size);
          FState := csDecode;
        end else
        begin
          FState := csPadded;
          InvalidMessageLength(Self);
        end;
    end;
  end;

  procedure DecodeCFB8(S,D: PByteArray; Size: Integer);
  // CFB-8
  var
    I: Integer;
  begin
    I := 0;
    while I < Size do
    begin
      DoEncode(FFeedback, FBuffer, FBufferSize);
      Move(FFeedback[1], FFeedback[0], FBufferSize -1);
      FFeedback[FBufferSize -1] := S[I];
      D[I] := S[I] xor FBuffer[0];
      Inc(I);
    end;
    FState := csDecode;
  end;

  procedure DecodeOFB8(S,D: PByteArray; Size: Integer);
  // same as EncodeOFB
  var
    I: Integer;
  begin
    I := 0;
    while I < Size do
    begin
      DoEncode(FFeedback, FBuffer, FBufferSize);
      Move(FFeedback[1], FFeedback[0], FBufferSize -1);
      FFeedback[FBufferSize -1] := FBuffer[0];
      D[I] := S[I] xor FBuffer[0];
      Inc(I);
    end;
    FState := csDecode;
  end;

  procedure DecodeCFS8(S,D: PByteArray; Size: Integer);
  var
    I: Integer;
  begin
    I := 0;
    while I < Size do
    begin
      DoEncode(FFeedback, FBuffer, FBufferSize);
      Move(FFeedback[1], FFeedback[0], FBufferSize -1);
      FFeedback[FBufferSize -1] := FFeedback[FBufferSize -1] xor S[I];
      D[I] := S[I] xor FBuffer[0];
      Inc(I);
    end;
    FState := csDecode;
  end;

  procedure DecodeCFBx(S,D: PByteArray; Size: Integer);
  // CFB-BlockSize
  var
    I: Integer;
    F: PByteArray;
  begin
    FState := csDecode;
    if FBufferIndex > 0 then
    begin // remain bytes of last decode
      I := FBufferSize - FBufferIndex;
      if I > Size then I := Size;
      Move(S[0], FFeedback[FBufferIndex], I);
      XORBuffers(S[0], FBuffer[FBufferIndex], I, D[0]);
      Inc(FBufferIndex, I);
      if FBufferIndex < FBufferSize then Exit;
      Dec(Size, I);
      S := @S[I];
      D := @D[I];
      FBufferIndex := 0
    end;
  // process chunks of FBufferSize bytes
    Dec(Size, FBufferSize);
    I := 0;
    if S <> D then
    begin
      F := FFeedback;
      while I < Size do
      begin
        DoEncode(F, FBuffer, FBufferSize);
        XORBuffers(S[I], FBuffer[0], FBufferSize, D[I]);
        F := @S[I];
        Inc(I, FBufferSize);
      end;
      if F <> FFeedback then
        Move(F^, FFeedback^, FBufferSize);
    end else
      while I < Size do
      begin
        DoEncode(FFeedback, FBuffer, FBufferSize);
        Move(S[I], FFeedback[0], FBufferSize);
        XORBuffers(S[I], FBuffer[0], FBufferSize, D[I]);
        Inc(I, FBufferSize);
      end;
    Dec(Size, I - FBufferSize);
    if Size > 0 then
    begin // remain bytes
      DoEncode(FFeedback, FBuffer, FBufferSize);
      Move(S[I], FFeedback[0], Size);
      XORBuffers(S[I], FBuffer[0], Size, D[I]);
      FBufferIndex := Size;
    end;
  end;

  procedure DecodeOFBx(S,D: PByteArray; Size: Integer);
  // OFB-BlockSize, same as EncodeOFBx
  var
    I: Integer;
  begin
    FState := csDecode;
    if FBufferIndex > 0 then
    begin
      I := FBufferSize - FBufferIndex;
      if I > Size then I := Size;
      XORBuffers(S[0], FFeedback[FBufferIndex], I, D[0]);
      Inc(FBufferIndex, I);
      if FBufferIndex < FBufferSize then Exit;
      Dec(Size, I);
      S := @S[I];
      D := @D[I];
      FBufferIndex := 0
    end;
    Dec(Size, FBufferSize);
    I := 0;
    while I < Size do
    begin
      DoEncode(FFeedback, FFeedback, FBufferSize);
      XORBuffers(S[I], FFeedback[0], FBufferSize, D[I]);
      Inc(I, FBufferSize);
    end;
    Dec(Size, I - FBufferSize);
    if Size > 0 then
    begin
      DoEncode(FFeedback, FFeedback, FBufferSize);
      XORBuffers(S[I], FFeedback[0], Size, D[I]);
      FBufferIndex := Size;
    end;
  end;

  procedure DecodeCFSx(S,D: PByteArray; Size: Integer);
  // CFS-BlockSize
  var
    I: Integer;
  begin
    FState := csDecode;
    if FBufferIndex > 0 then
    begin // remain bytes of last decode
      I := FBufferSize - FBufferIndex;
      if I > Size then I := Size;
      XORBuffers(S[0], FFeedback[FBufferIndex], I, FFeedback[FBufferIndex]);
      XORBuffers(S[0], FBuffer[FBufferIndex], I, D[0]);
      Inc(FBufferIndex, I);
      if FBufferIndex < FBufferSize then Exit;
      Dec(Size, I);
      S := @S[I];
      D := @D[I];
      FBufferIndex := 0
    end;
  // process chunks of FBufferSize bytes
    Dec(Size, FBufferSize);
    I := 0;
    while I < Size do
    begin
      DoEncode(FFeedback, FBuffer, FBufferSize);
      XORBuffers(S[I], FFeedback[0], FBufferSize, FFeedback[0]);
      XORBuffers(S[I], FBuffer[0], FBufferSize, D[I]);
      Inc(I, FBufferSize);
    end;
    Dec(Size, I - FBufferSize);
    if Size > 0 then
    begin // remain bytes
      DoEncode(FFeedback, FBuffer, FBufferSize);
      XORBuffers(S[I], FFeedback[0], Size, FFeedback[0]);
      XORBuffers(S[I], FBuffer[0], Size, D[I]);
      FBufferIndex := Size;
    end;
  end;

  procedure DecodeCBCx(S,D: PByteArray; Size: Integer);
  var
    I: Integer;
    F,B,T: PByteArray;
  begin
    Dec(Size, FBufferSize);
    F := FFeedback;
    I := 0;
    if S = D then
    begin
      B := FBuffer;
      while I <= Size do
      begin
        Move(S[I], B[0], FBufferSize);
        DoDecode(@S[I], @S[I], FBufferSize);
        XORBuffers(S[I], F[0], FBufferSize, S[I]);
        T := F;
        F := B;
        B := T;
        Inc(I, FBufferSize);
      end;
    end else
      while I <= Size do
      begin
        DoDecode(@S[I], @D[I], FBufferSize);
        XORBuffers(F[0], D[I], FBufferSize, D[I]);
        F := @S[I];
        Inc(I, FBufferSize);
      end;
    if F <> FFeedback then
      Move(F[0], FFeedback[0], FBufferSize);
    Dec(Size, I - FBufferSize);
    if Size > 0 then
    begin
      DecodeCFB8(@S[I], @D[I], Size);
      FState := csPadded;
    end else FState := csDecode;
  end;

  procedure DecodeCTSx(S,D: PByteArray; Size: Integer);
  var
    I: Integer;
    F,B,T: PByteArray;
  begin
    Dec(Size, FBufferSize);
    F := FFeedback;
    B := FBuffer;
    I := 0;
    while I <= Size do
    begin
      XORBuffers(S[I], F[0], FBufferSize, B[0]);
      DoDecode(@S[I], @D[I], FBufferSize);
      XORBuffers(D[I], F[0], FBufferSize, D[I]);
      T := B;
      B := F;
      F := T;
      Inc(I, FBufferSize);
    end;
    if F <> FFeedback then
      Move(F[0], FFeedback[0], FBufferSize);
    Dec(Size, I - FBufferSize);
    if Size > 0 then
    begin
      DecodeCFS8(@S[I], @D[I], Size);
      FState := csPadded;
    end else FState := csDecode;
  end;

begin
  CheckState([csInitialized, csDecode, csDone]);
  case FMode of
    cmECBx: DecodeECBx(@Source, @Dest, DataSize);
    cmCBCx: DecodeCBCx(@Source, @Dest, DataSize);
    cmCTSx: DecodeCTSx(@Source, @Dest, DataSize);
    cmCFB8: DecodeCFB8(@Source, @Dest, DataSize);
    cmCFBx: DecodeCFBx(@Source, @Dest, DataSize);
    cmOFB8: DecodeOFB8(@Source, @Dest, DataSize);
    cmOFBx: DecodeOFBx(@Source, @Dest, DataSize);
    cmCFS8: DecodeCFS8(@Source, @Dest, DataSize);
    cmCFSx: DecodeCFSx(@Source, @Dest, DataSize);
  end;
end;

function TDECCipher.EncodeBinary(const Source: Binary; Format: TDECFormatClass): Binary;
begin
  SetLength(Result, Length(Source));
  Encode(Source[1], Result[1], Length(Source));
  Result := ValidFormat(Format).Encode(Result);
end;

function TDECCipher.DecodeBinary(const Source: Binary; Format: TDECFormatClass): Binary;
begin
  Result := ValidFormat(Format).Decode(Source);
  Decode(Result[1], Result[1], Length(Result));
end;

procedure DoCodeStream(Source,Dest: TStream; Size: Int64; BlockSize: Integer; const Proc: TDECCipherCodeEvent; const Progress: IDECProgress);
var
  Buffer: Binary;
  BufferSize,Bytes: Integer;
  Min,Max,Pos: Int64;
begin
  Pos := Source.Position;
  if Size < 0 then Size := Source.Size - Pos;
  Min := Pos;
  Max := Pos + Size;
  if Size > 0 then
  try
    if StreamBufferSize <= 0 then StreamBufferSize := 8192;
    BufferSize := StreamBufferSize mod BlockSize;
    if BufferSize = 0 then BufferSize := StreamBufferSize
      else BufferSize := StreamBufferSize + BlockSize - BufferSize;
    if Size > BufferSize then SetLength(Buffer, BufferSize)
      else SetLength(Buffer, Size);
    while Size > 0 do
    begin
      if Assigned(Progress) then Progress.Process(Min, Max, Pos);
      Bytes := BufferSize;
      if Bytes > Size then Bytes := Size;
      Source.ReadBuffer(Buffer[1], Bytes);
      Proc(Buffer[1], Buffer[1], Bytes);
      Dest.WriteBuffer(Buffer[1], Bytes);
      Dec(Size, Bytes);
      Inc(Pos, Bytes);
    end;
  finally
    ProtectBinary(Buffer);
    if Assigned(Progress) then Progress.Process(Min, Max, Max);
  end;
end;

procedure DoCodeFile(const Source,Dest: String; BlockSize: Integer; const Proc: TDECCipherCodeEvent; const Progress: IDECProgress);
var
  S,D: TStream;
begin
  S := TFileStream.Create(Source, fmOpenRead or fmShareDenyNone);
  try
    D := TFileStream.Create(Dest, fmCreate);
    try
      DoCodeStream(S, D, S.Size, BlockSize, Proc, Progress);
    finally
      D.Free;
    end;
  finally