{*******************************************************}
{                                                       }
{       Delphi Supplemental Components                  }
{       ZLIB Data Compression Interface Unit            }
{                                                       }
{       Copyright (c) 1997 Borland International        }
{                                                       }
{       Copyright (c) 2007-2008 Shenturk                }
{       Create: 04.06.2008                              }
{                                                       }
{*******************************************************}

unit WinZlib;

{$WARNINGS OFF}

interface

uses
  Windows, SysUtils, Classes;

type
  PLOCAL_FILE_HEADER = ^LOCAL_FILE_HEADER;
  LOCAL_FILE_HEADER = packed record
    dwSignature  : Cardinal;
    wVersion     : Word;
    wPurposeFlag : Word;
    wMethod      : Word;
    wTime        : Word;
    wDate        : Word;
    dwCRC32      : Cardinal;
    dwCompSize   : Cardinal;
    dwUnCompSize : Cardinal;
    wNameLength  : Word;
    wExtraLength : Word;
  end;

  PFILE_HEADER = ^FILE_HEADER;
  FILE_HEADER = packed record
    dwSignature      : Cardinal;
    wVersionMadeBy   : Word;
    wVersionExtract  : Word;
    wPurposeFlag     : Word;
    wMethod          : Word;
    wTime            : Word;
    wDate            : Word;
    dwCRC32          : Cardinal;
    dwCompSize       : Cardinal;
    dwUnCompSize     : Cardinal;
    wNameLength      : Word;
    wExtraLength     : Word;
    wCommentLength   : Word;
    wDiskNumberStart : Word;
    wIntAttribute    : Word;
    dwExtAttribute   : Cardinal;
    dwRelativeOffset : Cardinal;
  end;

  PCENTRAL_DIR = ^CENTRAL_DIR;
  CENTRAL_DIR = packed record
    dwSignature           : Cardinal;
    wNumberOfDisk         : Word;
    wNumberDiskCentralDir : Word;
    wTotalFileOnDisk      : Word;
    wTotalFileOnDir       : Word;
    dwSizeOfCentralDir    : Cardinal;
    dwOffsetCentralDir    : Cardinal;
    wCommentLength        : Word;
  end;

  PDATA_DESCRIPTOR = ^DATA_DESCRIPTOR;
  DATA_DESCRIPTOR = packed record
    dwCRC32      : Cardinal;
    dwCompSize   : Cardinal;
    dwUnCompSize : Cardinal;
  end;

type

  { TArchiveItemList }
  TArchiveItemList = class(TStringList)
  end;

  TArchive = class;

  { TArchiveItem }
  TArchiveItem = class(TObject)
  private
    FFileName: string;
    FFileHeader: FILE_HEADER;
    FMemory: TMemoryStream;
    FArchive: TArchive;
    function GetIsDirectory: Boolean;
  public
    constructor Create(Archive: TArchive);
    destructor Destroy; override;
    procedure ExtractToFile(const ToFolder: string);
    procedure ExtractToStream(Dest: TStream);
    property Memory: TMemoryStream read FMemory;
    property FileName: string read FFileName;
    property IsDirectory: Boolean read GetIsDirectory;
  end;

  { TArchive }
  TArchive = class(TObject)
  private
    FFileName: string;
    FToFolder: string;
    FList: TStringList;
    FStream: TStream;
    procedure AllocateList;
    procedure DestroyList;
    procedure PrepareList;
    function GetItem(Index: Integer): TArchiveItem;
    function GetName(const S: string): TArchiveItem;
  public
    constructor Create;
    destructor Destroy; override;
    function OpenArchive: Boolean;
    procedure CloseArchive;
    procedure LoadFromFile(const FileName: string);
    procedure LoadFromResource(const ResName: string; ResType: PChar);
    function FileExists(const FileName: string): Boolean;
    function ExtractToFile(const FileName: string): Boolean;
    function ExtractToStream(const FileName: string; Dest: TStream): Boolean;
    function ExtractFiles: Boolean;
    property ToFolder: string read FToFolder write FToFolder;
    property Items[Index: Integer]: TArchiveItem read GetItem;
    property Names[const S: string]: TArchiveItem read GetName;
    property Stream: TStream read FStream;
  end;

type
  TAlloc = function (AppData: Pointer; Items, Size: Integer): Pointer;
  TFree = procedure (AppData, Block: Pointer);

  // Internal structure.  Ignore.
  PZStreamRec = ^TZStreamRec;
  TZStreamRec = packed record
    next_in: PChar;       // next input byte
    avail_in: Integer;    // number of bytes available at next_in
    total_in: Integer;    // total nb of input bytes read so far

    next_out: PChar;      // next output byte should be put here
    avail_out: Integer;   // remaining free space at next_out
    total_out: Integer;   // total nb of bytes output so far

    msg: PChar;           // last error message, NULL if no error
    internal: Pointer;    // not visible by applications

    zalloc: TAlloc;       // used to allocate the internal state
    zfree: TFree;         // used to free the internal state
    AppData: Pointer;     // private data object passed to zalloc and zfree

    data_type: Integer;   //  best guess about the data type: ascii or binary
    adler: Integer;       // adler32 value of the uncompressed data
    reserved: Integer;    // reserved for future use
  end;

  // Abstract ancestor class
  TCustomZlibStream = class(TStream)
  private
    FStrm: TStream;
    FStrmPos: Integer;
    FOnProgress: TNotifyEvent;
    FZRec: TZStreamRec;
    FBuffer: array [Word] of Char;
  protected
    procedure Progress(Sender: TObject); dynamic;
    property OnProgress: TNotifyEvent read FOnProgress write FOnProgress;
    constructor Create(Strm: TStream);
  end;

{ TCompressionStream compresses data on the fly as data is written to it, and
  stores the compressed data to another stream.

  TCompressionStream is write-only and strictly sequential. Reading from the
  stream will raise an exception. Using Seek to move the stream pointer
  will raise an exception.

  Output data is cached internally, written to the output stream only when
  the internal output buffer is full.  All pending output data is flushed
  when the stream is destroyed.

  The Position property returns the number of uncompressed bytes of
  data that have been written to the stream so far.

  CompressionRate returns the on-the-fly percentage by which the original
  data has been compressed:  (1 - (CompressedBytes / UncompressedBytes)) * 100
  If raw data size = 100 and compressed data size = 25, the CompressionRate
  is 75%

  The OnProgress event is called each time the output buffer is filled and
  written to the output stream.  This is useful for updating a progress
  indicator when you are writing a large chunk of data to the compression
  stream in a single call.}


  TCompressionLevel = (clNone, clFastest, clDefault, clMax);

  TCompressionStream = class(TCustomZlibStream)
  private
    function GetCompressionRate: Single;
  public
    constructor Create(CompressionLevel: TCompressionLevel; Dest: TStream);
    destructor Destroy; override;
    function Read(var Buffer; Count: Longint): Longint; override;
    function Write(const Buffer; Count: Longint): Longint; override;
    function Seek(Offset: Longint; Origin: Word): Longint; override;
    property CompressionRate: Single read GetCompressionRate;
    property OnProgress;
  end;

{ TDecompressionStream decompresses data on the fly as data is read from it.

  Compressed data comes from a separate source stream.  TDecompressionStream
  is read-only and unidirectional; you can seek forward in the stream, but not
  backwards.  The special case of setting the stream position to zero is
  allowed.  Seeking forward decompresses data until the requested position in
  the uncompressed data has been reached.  Seeking backwards, seeking relative
  to the end of the stream, requesting the size of the stream, and writing to
  the stream will raise an exception.

  The Position property returns the number of bytes of uncompressed data that
  have been read from the stream so far.

  The OnProgress event is called each time the internal input buffer of
  compressed data is exhausted and the next block is read from the input stream.
  This is useful for updating a progress indicator when you are reading a
  large chunk of data from the decompression stream in a single call.}

  TDecompressionStream = class(TCustomZlibStream)
  public
    constructor Create(Source: TStream);
    destructor Destroy; override;
    function Read(var Buffer; Count: Longint): Longint; override;
    function Write(const Buffer; Count: Longint): Longint; override;
    function Seek(Offset: Longint; Origin: Word): Longint; override;
    property OnProgress;
  end;

{ CompressBuf compresses data, buffer to buffer, in one call.
   In: InBuf = ptr to compressed data
       InBytes = number of bytes in InBuf
  Out: OutBuf = ptr to newly allocated buffer containing decompressed data
       OutBytes = number of bytes in OutBuf   }
procedure CompressBuf(const InBuf: Pointer; InBytes: Integer;
                      out OutBuf: Pointer; out OutBytes: Integer);


{ DecompressBuf decompresses data, buffer to buffer, in one call.
   In: InBuf = ptr to compressed data
       InBytes = number of bytes in InBuf
       OutEstimate = zero, or est. size of the decompressed data
  Out: OutBuf = ptr to newly allocated buffer containing decompressed data
       OutBytes = number of bytes in OutBuf   }
procedure DecompressBuf(const InBuf: Pointer; InBytes: Integer;
 OutEstimate: Integer; out OutBuf: Pointer; out OutBytes: Integer);

const
  zlib_Version = '1.0.4';

type
  EZlibError = class(Exception);
  ECompressionError = class(EZlibError);
  EDecompressionError = class(EZlibError);
  
const
  Z_NO_FLUSH      = 0;
  Z_PARTIAL_FLUSH = 1;
  Z_SYNC_FLUSH    = 2;
  Z_FULL_FLUSH    = 3;
  Z_FINISH        = 4;

  Z_OK            = 0;
  Z_STREAM_END    = 1;
  Z_NEED_DICT     = 2;
  Z_ERRNO         = (-1);
  Z_STREAM_ERROR  = (-2);
  Z_DATA_ERROR    = (-3);
  Z_MEM_ERROR     = (-4);
  Z_BUF_ERROR     = (-5);
  Z_VERSION_ERROR = (-6);

  Z_NO_COMPRESSION       =   0;
  Z_BEST_SPEED           =   1;
  Z_BEST_COMPRESSION     =   9;
  Z_DEFAULT_COMPRESSION  = (-1);

  Z_FILTERED            = 1;
  Z_HUFFMAN_ONLY        = 2;
  Z_DEFAULT_STRATEGY    = 0;

  Z_BINARY   = 0;
  Z_ASCII    = 1;
  Z_UNKNOWN  = 2;

  Z_DEFLATED = 8;


{$L zlib\deflate.obj}
{$L zlib\inflate.obj}
{$L zlib\inftrees.obj}
{$L zlib\trees.obj}
{$L zlib\adler32.obj}
{$L zlib\infblock.obj}
{$L zlib\infcodes.obj}
{$L zlib\infutil.obj}
{$L zlib\inffast.obj}

procedure _tr_init; external;
procedure _tr_tally; external;
procedure _tr_flush_block; external;
procedure _tr_align; external;
procedure _tr_stored_block; external;
procedure adler32; external;
procedure inflate_blocks_new; external;
procedure inflate_blocks; external;
procedure inflate_blocks_reset; external;
procedure inflate_blocks_free; external;
procedure inflate_set_dictionary; external;
procedure inflate_trees_bits; external;
procedure inflate_trees_dynamic; external;
procedure inflate_trees_fixed; external;
procedure inflate_trees_free; external;
procedure inflate_codes_new; external;
procedure inflate_codes; external;
procedure inflate_codes_free; external;
procedure _inflate_mask; external;
procedure inflate_flush; external;
procedure inflate_fast; external;

// deflate compresses data
function deflateInit_(var strm: TZStreamRec; level: Integer; version: PChar;
  recsize: Integer): Integer; external;
function deflate(var strm: TZStreamRec; flush: Integer): Integer; external;
function deflateEnd(var strm: TZStreamRec): Integer; external;

// inflate decompresses data
function inflateInit_(var strm: TZStreamRec; version: PChar;
  recsize: Integer): Integer; external;

function inflateInit2_(var strm: TZStreamRec; windowBits: Integer; version: PChar;
  recsize: Integer): Integer; external;

function inflateInit2(var strm: TZStreamRec; windowBits: Integer): Integer;

//inflateInit2_(z, w, version, stream_size)
function inflate(var strm: TZStreamRec; flush: Integer): Integer; external;
function inflateEnd(var strm: TZStreamRec): Integer; external;
function inflateReset(var strm: TZStreamRec): Integer; external;

function CCheck(code: Integer): Integer;
function DCheck(code: Integer): Integer;
function zlibAllocMem(AppData: Pointer; Items, Size: Integer): Pointer;
procedure zlibFreeMem(AppData, Block: Pointer);
procedure _memset(P: Pointer; B: Byte; count: Integer); cdecl;
procedure _memcpy(dest, source: Pointer; count: Integer); cdecl;

implementation

uses
  Math;
  
resourcestring
 sTargetBufferTooSmall = 'ZLib error: target buffer may be too small';
 sInvalidStreamOp = 'Invalid stream operation';
 sError = 'Error';

function inflateInit2(var strm: TZStreamRec; windowBits: Integer): Integer;
begin
  Result := inflateInit2_(strm, windowBits, zlib_version, sizeof(TZStreamRec));
end;

procedure _memset(P: Pointer; B: Byte; count: Integer);cdecl;
begin
  FillChar(P^, count, B);
end;

procedure _memcpy(dest, source: Pointer; count: Integer);cdecl;
begin
  Move(source^, dest^, count);
end;

function zlibAllocMem(AppData: Pointer; Items, Size: Integer): Pointer;
begin
  GetMem(Result, Items*Size);
end;

procedure zlibFreeMem(AppData, Block: Pointer);
begin
  FreeMem(Block);
end;

function zlibCheck(code: Integer): Integer;
begin
  Result := code;
  if code < 0 then
    raise EZlibError.Create('error');    //!!
end;

function CCheck(code: Integer): Integer;
begin
  Result := code;
  if code < 0 then
    raise ECompressionError.Create('error'); //!!
end;

function DCheck(code: Integer): Integer;
begin
  Result := code;
  if code < 0 then
    raise EDecompressionError.Create('error');  //!!
end;

{ CompressBuf }
procedure CompressBuf(const InBuf: Pointer; InBytes: Integer;
  out OutBuf: Pointer; out OutBytes: Integer);
var
  strm: TZStreamRec;
  P: Pointer;
begin
  FillChar(strm, sizeof(strm), 0);
  strm.zalloc := zlibAllocMem;
  strm.zfree := zlibFreeMem;
  OutBytes := ((InBytes + (InBytes div 10) + 12) + 255) and not 255;
  GetMem(OutBuf, OutBytes);
  try
    strm.next_in := InBuf;
    strm.avail_in := InBytes;
    strm.next_out := OutBuf;
    strm.avail_out := OutBytes;
    CCheck(deflateInit_(strm, Z_BEST_COMPRESSION, zlib_version, sizeof(strm)));
    try
      while CCheck(deflate(strm, Z_FINISH)) <> Z_STREAM_END do
      begin
        P := OutBuf;
        Inc(OutBytes, 256);
        ReallocMem(OutBuf, OutBytes);
        strm.next_out := PChar(Integer(OutBuf) + (Integer(strm.next_out) - Integer(P)));
        strm.avail_out := 256;
      end;
    finally
      CCheck(deflateEnd(strm));
    end;
    ReallocMem(OutBuf, strm.total_out);
    OutBytes := strm.total_out;
  except
    FreeMem(OutBuf);
    raise
  end;
end;

{ DecompressBuf }
procedure DecompressBuf(const InBuf: Pointer; InBytes: Integer;
  OutEstimate: Integer; out OutBuf: Pointer; out OutBytes: Integer);
var
  strm: TZStreamRec;
  P: Pointer;
  BufInc: Integer;
begin
  FillChar(strm, sizeof(strm), 0);
  strm.zalloc := zlibAllocMem;
  strm.zfree := zlibFreeMem;
  BufInc := (InBytes + 255) and not 255;
  if OutEstimate = 0 then
    OutBytes := BufInc
  else
    OutBytes := OutEstimate;
  GetMem(OutBuf, OutBytes);
  try
    strm.next_in := InBuf;
    strm.avail_in := InBytes;
    strm.next_out := OutBuf;
    strm.avail_out := OutBytes;
    DCheck(inflateInit_(strm, zlib_version, sizeof(strm)));
    try
      while DCheck(inflate(strm, Z_FINISH)) <> Z_STREAM_END do
      begin
        P := OutBuf;
        Inc(OutBytes, BufInc);
        ReallocMem(OutBuf, OutBytes);
        strm.next_out := PChar(Integer(OutBuf) + (Integer(strm.next_out) - Integer(P)));
        strm.avail_out := BufInc;
      end;
    finally
      DCheck(inflateEnd(strm));
    end;
    ReallocMem(OutBuf, strm.total_out);
    OutBytes := strm.total_out;
  except
    FreeMem(OutBuf);
    raise
  end;
end;

{ ResourceExists }
function ResourceExists(const Resource: string; ResType: PChar): Boolean;
begin
  Result := FindResource(MainInstance, PChar(Resource), ResType) <> 0;
end;

{ LoadFromResource }
procedure LoadFromResource(const ResType, Resource: WideString; Stream: TStream);
var
  hResInfo: HRSRC;
  hResData: HGLOBAL;
  dwResSize: Cardinal;
  PResData: PChar;
  dwTotal, dwSize: DWORD;
  szBuffer: array[0..16383] of Char;
begin

  hResInfo := FindResourceW(MainInstance, PWideChar(Resource), PWideChar(ResType));
  if hResInfo <> 0 then
  begin
    hResData := LoadResource(MainInstance, hResInfo);
    if hResData <> 0 then
    begin
      PResData := LockResource(hResData);
      if Assigned(PResData) then
      begin
        dwResSize := SizeOfResource(MainInstance, hResInfo);
        if Assigned(Stream) then
        begin
          dwTotal := 0;
          repeat
            FillChar(szBuffer, SizeOf(szBuffer), 0);
            dwSize := SizeOf(szBuffer);
            if dwTotal + dwSize > dwResSize then
              dwSize := dwResSize - dwTotal;
            System.Move(Pointer(PResData + dwTotal)^, szBuffer, dwSize);
            Stream.Write(szBuffer, dwSize);
            Inc(dwTotal, dwSize);
          until (dwTotal = dwResSize);
          Stream.Seek(0, soFromBeginning);
        end;
        UnlockResource(hResData);
      end;
      FreeResource(hResData);
    end;
  end;

end;

{ TranslateChar }
function TranslateChar(const Str: string; FromChar, ToChar: Char): string;
var
  I: Integer;
begin
  Result := Str;
  for I := 1 to Length(Result) do
    if Result[I] = FromChar then
      Result[I] := ToChar;
end;

{ UnixPathToDosPath }
function UnixPathToDosPath(const Path: string): string;
begin
  Result := TranslateChar(Path, '/', '\');
end;

{ DosPathToUnixPath }
function DosPathToUnixPath(const Path: string): string;
begin
  Result := TranslateChar(Path, '\', '/');
end;

{ TArchive }

procedure TArchive.AllocateList;
begin
  FList := TStringList.Create;
  PrepareList;
end;

procedure TArchive.CloseArchive;
begin
  DestroyList;
  if Assigned(FStream) then FreeAndNil(FStream);
end;

constructor TArchive.Create;
begin
  inherited Create;
end;

destructor TArchive.Destroy;
begin
  CloseArchive;
  inherited Destroy;
end;

procedure TArchive.DestroyList;
var
  I: Integer;
  Item: TArchiveItem;
begin
  if Assigned(FList) then
  begin
    for I := 0 to FList.Count - 1 do
    begin
      Item := FList.Objects[I] as TArchiveItem;
      FreeAndNil(Item);
    end;
    FreeAndNil(FList);
  end;
end;

function TArchive.ExtractFiles: Boolean;
var
  I: Integer;
  Item: TArchiveItem;
begin
  Result := True;
  if Assigned(FList) then
  begin
    for I := 0 to FList.Count - 1 do
    begin
      Item := FList.Objects[I] as TArchiveItem;
      Item.ExtractToFile(ToFolder);
    end;
  end;
end;

function TArchive.ExtractToFile(const FileName: string): Boolean;
var
  Index: Integer;
  Item: TArchiveItem;
begin
  Result := False;
  Index := FList.IndexOf(FileName);
  if Index >= 0 then
  begin
    Item := FList.Objects[Index] as TArchiveItem;
    Item.ExtractToFile(ToFolder);
    Result := True;
  end;
end;

function TArchive.ExtractToStream(const FileName: string;
  Dest: TStream): Boolean;
var
  Index: Integer;
  Item: TArchiveItem;
begin
  Result := False;
  Index := FList.IndexOf(FileName);
  if Index >= 0 then
  begin
    Item := FList.Objects[Index] as TArchiveItem;
    Item.ExtractToStream(Dest);
    Result := True;
  end;
end;

function TArchive.FileExists(const FileName: string): Boolean;
begin
  Result := FList.IndexOf(FileName) <> -1;
end;

function TArchive.GetItem(Index: Integer): TArchiveItem;
begin
  Result := nil;
  if Assigned(FList) and ((Index >= 0 ) or (Index < FList.Count)) then
   Result := FList.Objects[Index] as TArchiveItem;
end;

function TArchive.GetName(const S: string): TArchiveItem;
begin
  Result := nil;
  if Assigned(FList) then
    Result := GetItem(FList.IndexOf(S));
end;

procedure TArchive.LoadFromFile(const FileName: string);
begin
  CloseArchive;
  FFileName := FileName;
  if SysUtils.FileExists(FFileName) then
  begin
    FStream := TFileStream.Create(FFileName, fmOpenRead, fmShareExclusive);
    OpenArchive;
  end;
end;

procedure TArchive.LoadFromResource(const ResName: string; ResType: PChar);
begin
  CloseArchive;
  FFileName := ResName;
  if ResourceExists(ResName, ResType) then
  begin
    FStream := TResourceStream.Create(MainInstance, ResName, ResType);
    OpenArchive;
  end;
end;

function TArchive.OpenArchive: Boolean;
begin
  Result := FStream <> nil;
  if Result then AllocateList;
end;

procedure TArchive.PrepareList;
var
  pDir: PCENTRAL_DIR;
  P, D: PChar;
  F: PFILE_HEADER;
  Item: TArchiveItem;
  szBuffer: array[0..4095] of Char;
  dwRead: DWORD;
  pdwSign: PDWORD;
  nScan: Integer;
  nIndex: Integer;
  strName: array[0..MAX_PATH] of Char;
begin
  FillChar(szBuffer, SizeOf(szBuffer), 0);
  FStream.Seek(-SizeOf(CENTRAL_DIR), soFromEnd);
  dwRead := FStream.Read(szBuffer, SizeOf(CENTRAL_DIR));
  if dwRead = SizeOf(CENTRAL_DIR) then
  begin
    pDir := nil;
    for nScan := 4 to dwRead do
    begin
      pdwSign := PDWORD(szBuffer + dwRead - nScan);
      if pdwSign^ = $06054B50 then
      begin
        pDir := PCENTRAL_DIR(pdwSign);
        Break;
      end;
    end;
    if pDir <> nil then
    begin
      FStream.Seek(pDir^.dwOffsetCentralDir, soFromBeginning);
      D := AllocMem(pDir^.dwSizeOfCentralDir);
      try
        if FStream.Read(D^, pDir^.dwSizeOfCentralDir) = pDir^.dwSizeOfCentralDir then
        begin
          nIndex := 0;
          P := D;
          while nIndex < pDir^.wTotalFileOnDir do
          begin
            if P = nil then Break;
            F := PFILE_HEADER(P);
            if F^.dwSignature = $02014B50 then
            begin
              Inc(P, SizeOf(FILE_HEADER));
              FillChar(strName, SizeOf(strName), 0);
              System.Move(P^, strName, F^.wNameLength);
              Inc(P, F^.wNameLength);
              if F^.wExtraLength > 0 then Inc(P, F^.wExtraLength);
              if F^.wCommentLength > 0 then Inc(P, F^.wCommentLength);
              Item := TArchiveItem.Create(Self);
              Item.FFileName := strName;
              Item.FFileName := '/' + Item.FFileName;
              System.Move(F^, Item.FFileHeader, SizeOf(FILE_HEADER));
              Item.ExtractToStream(Item.FMemory);
              FList.AddObject(Item.FFileName, Item);
              Inc(nIndex);
            end
            else begin
              { Error on File Header. }
              Break;
            end;
          end;
        end
        else begin
          { Error File Read. }
        end;
      finally
        FreeMem(D);
      end;
    end
    else begin
      { Read Error }
    end;
  end
  else begin
    { Read Error }
  end;
end;

{ TArchiveItem }

constructor TArchiveItem.Create(Archive: TArchive);
begin
  inherited Create;
  FArchive := Archive;
  FMemory := TMemoryStream.Create;
end;

destructor TArchiveItem.Destroy;
begin
  FMemory.Free;
  inherited Destroy;
end;

procedure TArchiveItem.ExtractToFile(const ToFolder: string);
const
  MAX_WBITS = 15;
  BUFFER_IN_SIZE  = ( 64*1024);
  BUFFER_OUT_SIZE = (128*1024);
var
  Stream: TZStreamRec;
  nRead, nWrite: DWORD;
  nCompressed, nUncompressed: DWORD;
  BufferIn, BufferOut: PChar;
  nInflate: Integer;
var
  hFile: THandle;
  strPath: string;
  H: LOCAL_FILE_HEADER;
  dwTotal, dwSize, dwRead, dwWrite: DWORD;
  szBuffer: array[0..16383] of Char;
  F: PFILE_HEADER;
begin
  F := @FFileHeader;
  strPath := ToFolder + UnixPathToDosPath(FFileName);
  if F^.dwExtAttribute and FILE_ATTRIBUTE_DIRECTORY <> 0 then
    ForceDirectories(strPath)
  else begin
    hFile := CreateFile(PChar(strPath),
      GENERIC_READ or GENERIC_WRITE,
      0, nil,
      CREATE_ALWAYS,
      FILE_ATTRIBUTE_NORMAL, 0);
    if hFile <> INVALID_HANDLE_VALUE then
    begin
      FArchive.Stream.Seek(F^.dwRelativeOffset, soFromBeginning);
      FArchive.Stream.Read(H, SizeOf(H));
      FArchive.Stream.Seek(H.wNameLength + H.wExtraLength, soFromCurrent);
      dwTotal := 0;
      if F^.wMethod = Z_NO_COMPRESSION then
      begin
        repeat
          FillChar(szBuffer, SizeOf(szBuffer), 0);
          dwSize := SizeOf(szBuffer);
          if dwTotal + dwSize > H.dwCompSize then
            dwSize := H.dwCompSize - dwTotal;
          dwRead := FArchive.Stream.Read(szBuffer, dwSize);
          WriteFile(hFile, szBuffer, dwRead, dwWrite, nil);
          Inc(dwTotal, dwSize);
        until (dwRead = 0) or (dwWrite <> dwRead);
      end
      else if F^.wMethod = Z_DEFLATED then
      begin

        FillChar(Stream, sizeof(TZStreamRec), 0);
        BufferIn := AllocMem(BUFFER_IN_SIZE);
        BufferOut := AllocMem(BUFFER_OUT_SIZE);
        nCompressed := 0;
        nUncompressed := 0;
        Stream.zalloc := zlibAllocMem;
        Stream.zfree := zlibFreeMem;
        Stream.next_in := BufferIn;
        Stream.avail_in := 0;

        try
          DCheck(InflateInit2(Stream, -MAX_WBITS));
          try
            while (nCompressed < F^.dwCompSize) or (nUncompressed < F^.dwUnCompSize) do
            begin
              if Stream.avail_in = 0 then
              begin
                Stream.avail_in := Min(F^.dwCompSize - nCompressed, BUFFER_IN_SIZE);
                Stream.next_in := BufferIn;
                nRead := FArchive.Stream.Read(BufferIn^, Stream.avail_in);
                if Integer(nRead) <> Stream.avail_in then Break;
                Inc(nCompressed, nRead);
              end;
              Stream.avail_out := BUFFER_OUT_SIZE;
              Stream.next_out	:= BufferOut;
              nInflate := Inflate(Stream, Z_SYNC_FLUSH);
              if (nInflate = Z_OK) or (nInflate = Z_STREAM_END) then
              begin
                if Stream.avail_out < BUFFER_OUT_SIZE then
                begin
                  nWrite := BUFFER_OUT_SIZE - Stream.avail_out;
                  WriteFile(hFile, BufferOut^, nWrite, nWrite, nil);
                  if (Integer(nWrite) <> BUFFER_OUT_SIZE - Stream.avail_out) then Break;
                  Inc(nUncompressed, nWrite);
                end;
              end
              else Break;
            end;
          finally
            InflateEnd(Stream);
            FreeMem(BufferIn);
            FreeMem(BufferOut);
          end;
        except
          raise;
        end;
      end;
      CloseHandle(hFile);
    end;
  end;
end;

procedure TArchiveItem.ExtractToStream(Dest: TStream);
const
  MAX_WBITS = 15;
  BUFFER_IN_SIZE  = ( 64*1024);
  BUFFER_OUT_SIZE = (128*1024);
var
  Stream: TZStreamRec;
  nRead, nWrite: DWORD;
  nCompressed, nUncompressed: DWORD;
  BufferIn, BufferOut: PChar;
  nInflate: Integer;
var
  H: LOCAL_FILE_HEADER;
  dwTotal, dwSize, dwRead, dwWrite: DWORD;
  szBuffer: array[0..16383] of Char;
  F: PFILE_HEADER;
begin
  F := @FFileHeader;
  if F^.dwExtAttribute and FILE_ATTRIBUTE_DIRECTORY <> 0 then
    
  else begin
    FArchive.Stream.Seek(F^.dwRelativeOffset, soFromBeginning);
    FArchive.Stream.Read(H, SizeOf(H));
    FArchive.Stream.Seek(H.wNameLength + H.wExtraLength, soFromCurrent);
    dwTotal := 0;
    if F^.wMethod = Z_NO_COMPRESSION then
    begin
      repeat
        FillChar(szBuffer, SizeOf(szBuffer), 0);
        dwSize := SizeOf(szBuffer);
        if dwTotal + dwSize > H.dwCompSize then
          dwSize := H.dwCompSize - dwTotal;
        dwRead := FArchive.Stream.Read(szBuffer, dwSize);
        dwWrite := Dest.Write(szBuffer, dwRead);
        Inc(dwTotal, dwSize);
      until (dwRead = 0) or (dwWrite <> dwRead);
    end
    else if F^.wMethod = Z_DEFLATED then
    begin

      FillChar(Stream, sizeof(TZStreamRec), 0);
      BufferIn := AllocMem(BUFFER_IN_SIZE);
      BufferOut := AllocMem(BUFFER_OUT_SIZE);
      nCompressed := 0;
      nUncompressed := 0;
      Stream.zalloc := zlibAllocMem;
      Stream.zfree := zlibFreeMem;
      Stream.next_in := BufferIn;
      Stream.avail_in := 0;

      try
        DCheck(InflateInit2(Stream, -MAX_WBITS));
        try
          while (nCompressed < F^.dwCompSize) or (nUncompressed < F^.dwUnCompSize) do
          begin
            if Stream.avail_in = 0 then
            begin
              Stream.avail_in := Min(F^.dwCompSize - nCompressed, BUFFER_IN_SIZE);
              Stream.next_in := BufferIn;
              nRead := FArchive.Stream.Read(BufferIn^, Stream.avail_in);
              if Integer(nRead) <> Stream.avail_in then Break;
              Inc(nCompressed, nRead);
            end;
            Stream.avail_out := BUFFER_OUT_SIZE;
            Stream.next_out	:= BufferOut;
            nInflate := Inflate(Stream, Z_SYNC_FLUSH);
            if (nInflate = Z_OK) or (nInflate = Z_STREAM_END) then
            begin
              if Stream.avail_out < BUFFER_OUT_SIZE then
              begin
                nWrite := BUFFER_OUT_SIZE - Stream.avail_out;
                nWrite := Dest.Write(BufferOut^, nWrite);
                if (Integer(nWrite) <> BUFFER_OUT_SIZE - Stream.avail_out) then Break;
                Inc(nUncompressed, nWrite);
              end;
            end
            else Break;
          end;
        finally
          InflateEnd(Stream);
          FreeMem(BufferIn);
          FreeMem(BufferOut);
        end;
      except
        raise;
      end;
    end;
  end;
end;

function TArchiveItem.GetIsDirectory: Boolean;
begin
  Result := FFileHeader.dwExtAttribute and FILE_ATTRIBUTE_DIRECTORY <> 0;
end;

// TCustomZlibStream

constructor TCustomZLibStream.Create(Strm: TStream);
begin
  inherited Create;
  FStrm := Strm;
  FStrmPos := Strm.Position;
  FZRec.zalloc := zlibAllocMem;
  FZRec.zfree := zlibFreeMem;
end;

procedure TCustomZLibStream.Progress(Sender: TObject);
begin
  if Assigned(FOnProgress) then FOnProgress(Sender);
end;


// TCompressionStream

constructor TCompressionStream.Create(CompressionLevel: TCompressionLevel;
  Dest: TStream);
const
  Levels: array [TCompressionLevel] of ShortInt =
    (Z_NO_COMPRESSION, Z_BEST_SPEED, Z_DEFAULT_COMPRESSION, Z_BEST_COMPRESSION);
begin
  inherited Create(Dest);
  FZRec.next_out := FBuffer;
  FZRec.avail_out := sizeof(FBuffer);
  CCheck(deflateInit_(FZRec, Levels[CompressionLevel], zlib_version, sizeof(FZRec)));
end;

destructor TCompressionStream.Destroy;
begin
  FZRec.next_in := nil;
  FZRec.avail_in := 0;
  try
    if FStrm.Position <> FStrmPos then FStrm.Position := FStrmPos;
    while (CCheck(deflate(FZRec, Z_FINISH)) <> Z_STREAM_END)
      and (FZRec.avail_out = 0) do
    begin
      FStrm.WriteBuffer(FBuffer, sizeof(FBuffer));
      FZRec.next_out := FBuffer;
      FZRec.avail_out := sizeof(FBuffer);
    end;
    if FZRec.avail_out < sizeof(FBuffer) then
      FStrm.WriteBuffer(FBuffer, sizeof(FBuffer) - FZRec.avail_out);
  finally
    deflateEnd(FZRec);
  end;
  inherited Destroy;
end;

function TCompressionStream.Read(var Buffer; Count: Longint): Longint;
begin
  raise ECompressionError.CreateRes(@sInvalidStreamOp);
end;

function TCompressionStream.Write(const Buffer; Count: Longint): Longint;
begin
  FZRec.next_in := @Buffer;
  FZRec.avail_in := Count;
  if FStrm.Position <> FStrmPos then FStrm.Position := FStrmPos;
  while (FZRec.avail_in > 0) do
  begin
    CCheck(deflate(FZRec, 0));
    if FZRec.avail_out = 0 then
    begin
      FStrm.WriteBuffer(FBuffer, sizeof(FBuffer));
      FZRec.next_out := FBuffer;
      FZRec.avail_out := sizeof(FBuffer);
      FStrmPos := FStrm.Position;
      Progress(Self);
    end;
  end;
  Result := Count;
end;

function TCompressionStream.Seek(Offset: Longint; Origin: Word): Longint;
begin
  if (Offset = 0) and (Origin = soFromCurrent) then
    Result := FZRec.total_in
  else
    raise ECompressionError.CreateRes(@sInvalidStreamOp);
end;

function TCompressionStream.GetCompressionRate: Single;
begin
  if FZRec.total_in = 0 then
    Result := 0
  else
    Result := (1.0 - (FZRec.total_out / FZRec.total_in)) * 100.0;
end;


// TDecompressionStream

constructor TDecompressionStream.Create(Source: TStream);
begin
  inherited Create(Source);
  FZRec.next_in := FBuffer;
  FZRec.avail_in := 0;
  DCheck(inflateInit_(FZRec, zlib_version, sizeof(FZRec)));
end;

destructor TDecompressionStream.Destroy;
begin
  FStrm.Seek(-FZRec.avail_in, 1);
  inflateEnd(FZRec);
  inherited Destroy;
end;

function TDecompressionStream.Read(var Buffer; Count: Longint): Longint;
begin
  FZRec.next_out := @Buffer;
  FZRec.avail_out := Count;
  if FStrm.Position <> FStrmPos then FStrm.Position := FStrmPos;
  while (FZRec.avail_out > 0) do
  begin
    if FZRec.avail_in = 0 then
    begin
      FZRec.avail_in := FStrm.Read(FBuffer, sizeof(FBuffer));
      if FZRec.avail_in = 0 then
      begin
        Result := Count - FZRec.avail_out;
        Exit;
      end;
	  FZRec.next_in := FBuffer;
      FStrmPos := FStrm.Position;
      Progress(Self);
    end;
    CCheck(inflate(FZRec, 0));
  end;
  Result := Count;
end;

function TDecompressionStream.Write(const Buffer; Count: Longint): Longint;
begin
  raise EDecompressionError.CreateRes(@sInvalidStreamOp);
end;

function TDecompressionStream.Seek(Offset: Longint; Origin: Word): Longint;
var
  I: Integer;
  Buf: array [0..4095] of Char;
begin
  if (Offset = 0) and (Origin = soFromBeginning) then
  begin
    DCheck(inflateReset(FZRec));
    FZRec.next_in := FBuffer;
    FZRec.avail_in := 0;
    FStrm.Position := 0;
    FStrmPos := 0;
  end
  else if ( (Offset >= 0) and (Origin = soFromCurrent)) or
          ( ((Offset - FZRec.total_out) > 0) and (Origin = soFromBeginning)) then
  begin
    if Origin = soFromBeginning then Dec(Offset, FZRec.total_out);
    if Offset > 0 then
    begin
      for I := 1 to Offset div sizeof(Buf) do
        ReadBuffer(Buf, sizeof(Buf));
      ReadBuffer(Buf, Offset mod sizeof(Buf));
    end;
  end
  else
    raise EDecompressionError.CreateRes(@sInvalidStreamOp);
  Result := FZRec.total_out;
end;

end.