JarUnPacker/prereq/fwzip/FWZipStream.pas

////////////////////////////////////////////////////////////////////////////////
//
//  ****************************************************************************
//  * Project   : FWZip
//  * Unit Name : FWZipStream
//  * Purpose   : Вспомогательные стримы для поддержки шифрования на лету,
//  *           : и усеченного заголовка ZLib
//  * Author    : Александр (Rouse_) Багель
//  * Copyright : © Fangorn Wizards Lab 1998 - 2015.
//  * Version   : 1.0.11
//  * Home Page : http://rouse.drkb.ru
//  * Home Blog : http://alexander-bagel.blogspot.ru
//  ****************************************************************************
//  * Stable Release : http://rouse.drkb.ru/components.php#fwzip
//  * Latest Source  : https://github.com/AlexanderBagel/FWZip
//  ****************************************************************************
//
//  Используемые источники:
//  ftp://ftp.info-zip.org/pub/infozip/doc/appnote-iz-latest.zip
//  http://zlib.net/zlib-1.2.5.tar.gz
//  http://www.base2ti.com/
//
//
//  Описание идеи модуля:
//  При помещении в архив сжатого блока данных методом Deflate у него
//  отрезается двухбайтный заголовок в котором указаны параметры сжатия.
//  Т.е. в архив помещаются сами данные в чистом виде.
//  Для распаковки необходимо данный заголовок восстановить.
//  Данный класс позволяет добавить данный заголовок "на лету"
//  абсолютно прозрачно для внешнего кода.
//  Сам заголовок генерируется в конструкторе и подставляется в методе Read.
//  Так-же класс, выступая посредником между двумя стримами,
//  позволяет производить шифрование и дешифровку передаваемых данных.
//  Шифрование производится в методе Write, в этот момент класс является
//  посредником между TCompressionStream и результирующим стримом.
//  Дешифрование осуществляется в методе Read, в этот момент класс является
//  посредником между стримом со сжатыми и
//  пошифрованными данными и TDecompressionStream.
//

unit FWZipStream;
{$mode delphi}
{$codepage UTF8}

interface

{$I fwzip.inc}

uses
  Classes,
  FWZipConsts,
  FWZipCrypt,
  FWZipCrc32,
  FWZipZLib;

type
  TFWZipItemStream = class(TStream)
  private
    FOwner: TStream;
    FCryptor: TFWZipCryptor;
    FDecryptor: TFWZipDecryptor;
    FSize, FStart, FPosition: Int64;
    {$IFDEF USE_AUTOGENERATED_ZLIB_HEADER}
    FHeader: Word;
    {$ENDIF}
  protected
    function GetSize: Int64; override;
  public
    constructor Create(AOwner: TStream; Cryptor: TFWZipCryptor;
      Decryptor: TFWZipDecryptor; CompressLevel: Byte; ASize: Int64);
    function Seek(Offset: Longint; Origin: Word): Longint; overload; override;
    function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; overload; override;
    function Read(var Buffer; Count: Longint): Longint; override;
    function Write(const Buffer; Count: Longint): Longint; override;
  end;

implementation

{ TFWZipItemStream }

constructor TFWZipItemStream.Create(AOwner: TStream; Cryptor: TFWZipCryptor;
  Decryptor: TFWZipDecryptor; CompressLevel: Byte; ASize: Int64);
begin
  inherited Create;
  FOwner := AOwner;
  FCryptor := Cryptor;
  FDecryptor := Decryptor;

  FSize := ASize;
  FStart := AOwner.Position;
  FPosition := 0;

  // Rouse_ 30.10.2013
  // Устаревший код
  {$IFDEF USE_AUTOGENERATED_ZLIB_HEADER}

  // Rouse_ 17.03.2011
  // Размерчик все-же нужно править увеличикая на размер заголовка
  Inc(FSize, 2);
  // Восстанавливаем пропущенный заголовок ZLib стрима
  // см. deflate.c - int ZEXPORT deflate (strm, flush)

  // uInt header = (Z_DEFLATED + ((s->w_bits-8)<<4)) << 8;
  FHeader := (Z_DEFLATED + (7 {32k Window size} shl 4)) shl 8;

  // if (s->strategy >= Z_HUFFMAN_ONLY || s->level < 2)
  //     level_flags = 0;
  // else if (s->level < 6)
  //     level_flags = 1;
  // else if (s->level == 6)
  //     level_flags = 2;
  // else
  //     level_flags = 3;
  //
  // сам CompressLevel (level_flags)
  // берется из уже заполненного GeneralPurposeBitFlag
  // здесь мы из битовой маски восстанавливаем оригинальные значения

  case CompressLevel of
    PBF_COMPRESS_SUPERFAST:
      CompressLevel := 0;
    PBF_COMPRESS_FAST:
      CompressLevel := 1;
    PBF_COMPRESS_NORMAL:
      CompressLevel := 2;
    PBF_COMPRESS_MAXIMUM:
      CompressLevel := 3;
  end;

  // header |= (level_flags << 6);
  FHeader := FHeader or (CompressLevel shl 6);

  // if (s->strstart != 0) header |= PRESET_DICT;
  // словарь не используется - оставляем без изменений

  // header += 31 - (header % 31);
  Inc(FHeader, 31 - (FHeader mod 31));

  // putShortMSB(s, header);
  FHeader := (FHeader shr 8) + (FHeader and $FF) shl 8;
  {$ENDIF}
end;

function TFWZipItemStream.GetSize: Int64;
begin
  Result := FSize;
end;

function TFWZipItemStream.Read(var Buffer; Count: Integer): Longint;
var
  P: PByte;
  DecryptBuff: Pointer;
begin
  // Rouse_ 30.10.2013
  // Устаревший код
  {$IFDEF USE_AUTOGENERATED_ZLIB_HEADER}
  if FPosition = 0 then
  begin
    // если зачитываются данные с самого начала
    // необходимо перед ними разместить заголовок ZLib
    P := @FHeader;
    Move(P^, Buffer, 2);
    FOwner.Position := FStart;
    P := @Buffer;
    Inc(P, 2);
    if Count > Size then
      Count := Size;
    FOwner.Position := FStart;
    if FDecryptor <> nil then
    begin
      // в случае если файл зашифрован, производим расшифровку блока
      GetMem(DecryptBuff, Count - 2);
      try
        Result := FOwner.Read(DecryptBuff^, Count - 2);
        FDecryptor.DecryptBuffer(DecryptBuff, Result);
        Move(DecryptBuff^, P^, Result);
      finally
        FreeMem(DecryptBuff);
      end;
    end
    else
      Result := FOwner.Read(P^, Count - 2);
    Inc(Result, 2);
    Inc(FPosition, Result);
  end
  else
  begin
    FOwner.Position := FStart + Position - 2;
  {$ELSE}
  begin
    FOwner.Position := FStart + Position;
  {$ENDIF}
    if Count > Size - Position then
      Count := Size - Position;
    if FDecryptor <> nil then
    begin
      // в случае если файл зашифрован, производим расшифровку блока
      GetMem(DecryptBuff, Count);
      try
        Result := FOwner.Read(DecryptBuff^, Count);
        FDecryptor.DecryptBuffer(DecryptBuff, Result);
        P := @Buffer;
        Move(DecryptBuff^, P^, Result);
      finally
        FreeMem(DecryptBuff);
      end;
    end
    else
      Result := FOwner.Read(Buffer, Count);
    Inc(FPosition, Result);
  end;
end;

function TFWZipItemStream.Seek(Offset: Integer; Origin: Word): Longint;
begin
  Result := Seek(Int64(Offset), TSeekOrigin(Origin));
end;

function TFWZipItemStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
begin
  case Origin of
    soBeginning: FPosition := Offset;
    soCurrent: Inc(FPosition, Offset);
    soEnd: FPosition := Size + Offset;
  end;
  Result := FPosition;
end;

function TFWZipItemStream.Write(const Buffer; Count: Integer): Longint;
var
  EncryptBuffer: PByte;
begin
  if FCryptor = nil then
    Result := FOwner.Write(Buffer, Count)
  else
  begin
    // криптуем буфер
    GetMem(EncryptBuffer, Count);
    try
      Move(Buffer, EncryptBuffer^, Count);

      // Rouse_ 31.10.2013
      // Устаревший код
      {$IFDEF USE_AUTOGENERATED_ZLIB_HEADER}
      // Шифровать блок нужно пропустив двубайтный заголовок ZLib
      if FPosition = 0 then
      begin
        Inc(EncryptBuffer, 2);
        FCryptor.EncryptBuffer(EncryptBuffer, Count - 2);
        Dec(EncryptBuffer, 2);
      end
      else
      {$ENDIF}
        FCryptor.EncryptBuffer(EncryptBuffer, Count);
      Result := FOwner.Write(EncryptBuffer^, Count);
    finally
      FreeMem(EncryptBuffer);
    end;
  end;
  Inc(FPosition, Result);
end;

end.