/// ZIP/LZ77 Deflate/Inflate Compression in pure pascal
// - this unit is a part of the freeware Synopse framework,
// licensed in the LGPL v3; version 1.18
unit PasZip;

{
    This file is part of Synopse framework.

    Synopse framework. Copyright (c) Arnaud Bouchez
      Synopse Informatique - https://synopse.info

    This library is free software; you can redistribute it and/or modify it
    under the terms of the GNU Lesser General Public License as published by
    the Free Software Foundation; either version 3 of the License, or (at
    your option) any later version.

    This library is distributed in the hope that it will be useful, but
    WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
    GNU Lesser General Public License for more details.

    You should have received a copy of the GNU Lesser General Public License
    along with this library. If not, see <http://www.gnu.org/licenses/>.



    PasZip.pas from madZip.pas  - original version: 0.1b, date: 2003-06-09
     clearly inspired from fpc's RTL paszlib
   ------------------------------------------------------------------------
          compression stuff compatible with LZ77 Deflate/Inflate

   Improvements by A.Bouchez on 2006-2010 - http://bouchez.info
   - CRC32 table can be generated by code (save 1KB in executable)
   - Inflate made 50% faster than MadLib's original by tuned Move() usage
    and some critical part rewrite
   - .zip reading from file, resource or direct memory - Windows only
   - .zip write into a file (new .zip creation, not update) - Windows only

   This unit is a cut-down stand-alone zip reader/writer, to be used e.g.
   in installers or size-critical projects. Consider mormot.core.zip.pas from
   mORMot 2 for more features, and better performance (thanks to libdeflate).

}

{$WARNINGS OFF}
{$Q-,R-}  // Turn range checking and overflow checking off

{ $D-,L-}

{$I Synopse.inc}

interface

uses
{$ifdef MSWINDOWS}
  Windows,
{$else}
  Types,
{$endif MSWINDOWS}
  SysUtils;

type
{$ifdef HASCODEPAGE}
  RawByteZip = RawByteString;
  TZipName = type AnsiString(437);
{$else}
  RawByteZip = AnsiString;
  TZipName = AnsiString;
{$endif HASCODEPAGE}

{$ifdef DELPHI5OROLDER}
  PCardinal = ^cardinal;
{$endif DELPHI5OROLDER}

/// compress memory using the ZLib DEFLATE algorithm
function CompressMem(src, dst: pointer; srcLen, dstLen: integer): integer;

/// uncompress memory using the ZLib INFLATE algorithm
function UnCompressMem(src, dst: pointer; srcLen, dstLen: integer): integer;

/// compress memory using the ZLib DEFLATE algorithm with a crc32 checksum
function CompressString(const data: RawByteZip; failIfGrow: boolean = false): RawByteZip;

/// uncompress memory using the ZLib INFLATE algorithm, checking crc32 checksum
function UncompressString(const data: RawByteZip): RawByteZip;

/// create a void .zip file
procedure CreateVoidZip(const aFileName: TFileName);

{$ifdef MSWINDOWS} { use Windows MapFile }

function CompressFile(const srcFile, dstFile: TFileName; failIfGrow: boolean = false): boolean;

function UncompressFile(const srcFile, dstFile: TFileName;
  lastWriteTime: int64 = 0; attr: dword = 0): boolean;

function GetCompressedFileInfo(const comprFile: TFileName; var size: int64;
  var crc32: dword): boolean;

function GetUncompressedFileInfo(const uncomprFile: TFileName; var size: int64;
  var crc32: dword): boolean;

function IsCompressedFileEqual(const uncomprFile, comprFile: TFileName): boolean;

/// You can create a "zip" compatible archive by calling the "Zip" function.
// - The first parameter is the full file path of the new zip archive.
// - The second parameter must be an array of the files you want to have zipped
//   into the archive (full file path again, please).
// - The third array (only file names, please) allows you to store the files into
//   the zip under a different name.
// - Generally the resulting zip archive should not contain any directory structure:
//  all zipped files are directly stored in the archive's root, if NoSubDirectories
//  is set to TRUE.
function Zip(const zip: TFileName; const files, zipAs: array of TFileName;
  NoSubDirectories: boolean = false): boolean;

{$endif MSWINDOWS}

/// create a compatible .gz file (returns file size)
function GzCompress(src: pointer; srcLen: integer; const fName: TFileName): cardinal;

/// calculate the CRC32 hash of a specified memory buffer
function UpdateCrc32(aCRC32: cardinal; inBuf: pointer; inLen: integer): cardinal;


{$DEFINE DYNAMIC_CRC_TABLE}
{ if defined, the crc32Tab[] is created on staturp: save 1KB of code size }

type
  TCRC32Tab = array[0..255] of cardinal;

/// the static buffer used for fast CRC32 hashing
{$ifdef DYNAMIC_CRC_TABLE}
var
  crc32Tab: TCRC32Tab;
{$else}

const
  crc32Tab: TCRC32Tab = ($00000000, $77073096, $ee0e612c,
    $990951ba, $076dc419, $706af48f, $e963a535, $9e6495a3, $0edb8832, $79dcb8a4,
    $e0d5e91e, $97d2d988, $09b64c2b, $7eb17cbd, $e7b82d07, $90bf1d91, $1db71064,
    $6ab020f2, $f3b97148, $84be41de, $1adad47d, $6ddde4eb, $f4d4b551, $83d385c7,
    $136c9856, $646ba8c0, $fd62f97a, $8a65c9ec, $14015c4f, $63066cd9, $fa0f3d63,
    $8d080df5, $3b6e20c8, $4c69105e, $d56041e4, $a2677172, $3c03e4d1, $4b04d447,
    $d20d85fd, $a50ab56b, $35b5a8fa, $42b2986c, $dbbbc9d6, $acbcf940, $32d86ce3,
    $45df5c75, $dcd60dcf, $abd13d59, $26d930ac, $51de003a, $c8d75180, $bfd06116,
    $21b4f4b5, $56b3c423, $cfba9599, $b8bda50f, $2802b89e, $5f058808, $c60cd9b2,
    $b10be924, $2f6f7c87, $58684c11, $c1611dab, $b6662d3d, $76dc4190, $01db7106,
    $98d220bc, $efd5102a, $71b18589, $06b6b51f, $9fbfe4a5, $e8b8d433, $7807c9a2,
    $0f00f934, $9609a88e, $e10e9818, $7f6a0dbb, $086d3d2d, $91646c97, $e6635c01,
    $6b6b51f4, $1c6c6162, $856530d8, $f262004e, $6c0695ed, $1b01a57b, $8208f4c1,
    $f50fc457, $65b0d9c6, $12b7e950, $8bbeb8ea, $fcb9887c, $62dd1ddf, $15da2d49,
    $8cd37cf3, $fbd44c65, $4db26158, $3ab551ce, $a3bc0074, $d4bb30e2, $4adfa541,
    $3dd895d7, $a4d1c46d, $d3d6f4fb, $4369e96a, $346ed9fc, $ad678846, $da60b8d0,
    $44042d73, $33031de5, $aa0a4c5f, $dd0d7cc9, $5005713c, $270241aa, $be0b1010,
    $c90c2086, $5768b525, $206f85b3, $b966d409, $ce61e49f, $5edef90e, $29d9c998,
    $b0d09822, $c7d7a8b4, $59b33d17, $2eb40d81, $b7bd5c3b, $c0ba6cad, $edb88320,
    $9abfb3b6, $03b6e20c, $74b1d29a, $ead54739, $9dd277af, $04db2615, $73dc1683,
    $e3630b12, $94643b84, $0d6d6a3e, $7a6a5aa8, $e40ecf0b, $9309ff9d, $0a00ae27,
    $7d079eb1, $f00f9344, $8708a3d2, $1e01f268, $6906c2fe, $f762575d, $806567cb,
    $196c3671, $6e6b06e7, $fed41b76, $89d32be0, $10da7a5a, $67dd4acc, $f9b9df6f,
    $8ebeeff9, $17b7be43, $60b08ed5, $d6d6a3e8, $a1d1937e, $38d8c2c4, $4fdff252,
    $d1bb67f1, $a6bc5767, $3fb506dd, $48b2364b, $d80d2bda, $af0a1b4c, $36034af6,
    $41047a60, $df60efc3, $a867df55, $316e8eef, $4669be79, $cb61b38c, $bc66831a,
    $256fd2a0, $5268e236, $cc0c7795, $bb0b4703, $220216b9, $5505262f, $c5ba3bbe,
    $b2bd0b28, $2bb45a92, $5cb36a04, $c2d7ffa7, $b5d0cf31, $2cd99e8b, $5bdeae1d,
    $9b64c2b0, $ec63f226, $756aa39c, $026d930a, $9c0906a9, $eb0e363f, $72076785,
    $05005713, $95bf4a82, $e2b87a14, $7bb12bae, $0cb61b38, $92d28e9b, $e5d5be0d,
    $7cdcefb7, $0bdbdf21, $86d3d2d4, $f1d4e242, $68ddb3f8, $1fda836e, $81be16cd,
    $f6b9265b, $6fb077e1, $18b74777, $88085ae6, $ff0f6a70, $66063bca, $11010b5c,
    $8f659eff, $f862ae69, $616bffd3, $166ccf45, $a00ae278, $d70dd2ee, $4e048354,
    $3903b3c2, $a7672661, $d06016f7, $4969474d, $3e6e77db, $aed16a4a, $d9d65adc,
    $40df0b66, $37d83bf0, $a9bcae53, $debb9ec5, $47b2cf7f, $30b5ffe9, $bdbdf21c,
    $cabac28a, $53b39330, $24b4a3a6, $bad03605, $cdd70693, $54de5729, $23d967bf,
    $b3667a2e, $c4614ab8, $5d681b02, $2a6f2b94, $b40bbe37, $c30c8ea1, $5a05df1b,
    $2d02ef8d);
{$endif DYNAMIC_CRC_TABLE}

{$ifdef MSWINDOWS}

type
  /// generic file information structure, as used in .zip file format
  // - used in any header, contains info about following block
  TFileInfo = packed record
    neededVersion: word;       // $14
    flags: word;               // 0
    zzipMethod: word;          // 8 (deflate)
    zlastModTime: word;        // dos format
    zlastModDate: word;        // dos format
    zcrc32: dword;
    zzipSize: dword;
    zfullSize: dword;
    nameLen: word;             // length(name)
    extraLen: word;            // 0
  end;
  PFileInfo = ^TFileInfo;

  /// internal file information structure, as used in .zip file format
  // - used locally inside the file stream, followed by the name and then the data
  TLocalFileHeader = packed record
    signature: dword;          // $04034b50
    fileInfo: TFileInfo;
  end;

  /// directory file information structure, as used in .zip file format
  // - used at the end of the zip file to recap all entries
  TFileHeader = packed record
    signature: dword;          // $02014b50
    madeBy: word;              // $14
    fileInfo: TFileInfo;
    commentLen: word;          // 0
    firstDiskNo: word;         // 0
    intFileAttr: word;         // 0 = binary; 1 = text
    extFileAttr: dword;        // dos file attributes
    localHeadOff: dword;       // @TLocalFileHeader
  end;

  /// last header structure, as used in .zip file format
  // - this header ends the file and is used to find the TFileHeader entries
  TLastHeader = packed record
    signature: dword;          // $06054b50
    thisDisk: word;            // 0
    headerDisk: word;          // 0
    thisFiles: word;           // 1
    totalFiles: word;          // 1
    headerSize: dword;         // sizeOf(TFileHeaders + names)
    headerOffset: dword;       // @TFileHeader
    commentLen: word;          // 0
  end;

type
  /// stores an entry of a file inside a .zip archive
  TZipEntry = packed record
    /// the information of this file, as stored in the .zip archive
    info: PFileInfo;
    /// points to the compressed data in the .zip archive, mapped in memory
    data: PAnsiChar;
    /// ASCIIZ name of the file inside the .zip archive
    // - not a string, but a fixed-length array of char
    Name: array[0..127 - SizeOf(pointer)*2] of AnsiChar;
  end;

  /// read-only access to a .zip archive file
  // - can open directly a specified .zip file (will be memory mapped for fast access)
  // - can open a .zip archive file content from a resource (embedded in the executable)
  // - can open a .zip archive file content from memory
  TZipRead = class
  private
    file_, map: THandle; // we use a memory mapped file to access the zip content
    buf: PByteArray;
    fZipStartOffset: cardinal;
    fShowMessageBoxOnError: boolean;
    procedure UnMap;
  public
    /// the number of files inside a .zip archive
    Count: integer;
    /// the files inside the .zip archive
    Entry: array of TZipEntry;

    /// open a .zip archive file as Read Only
    constructor Create(const aFileName: TFileName; ZipStartOffset: cardinal = 0;
      Size: cardinal = 0; ShowMessageBoxOnError: boolean = true); overload;
    /// open a .zip archive file directly from a resource
    constructor Create(Instance: THandle; const ResName: string; ResType: PChar); overload;
    /// open a .zip archive file directly from memory
    constructor Create(BufZip: pByteArray; Size: cardinal); overload;
    /// release associated memory
    destructor Destroy; override;

    /// get the index of a file inside the .zip archive
    function NameToIndex(const aZipName: TZipName): integer;
    /// uncompress a file stored inside the .zip archive into a destination folder
    function UnZipFile(aIndex: integer; DestPath: TFileName; ForceWriteFlush:
      boolean): boolean;
    /// uncompress a file stored inside the .zip archive into memory
    function UnZip(aIndex: integer): RawByteZip; overload;
    /// read the file from the supplied folder, and check its content according
    // to the crc32 stored inside the .zip archive header (no decompression is made)
    function CheckFile(aIndex: integer; DestPath: TFileName): boolean;
    /// get any initial .exe file
    function GetInitialExeContent: RawByteZip;
    /// the starting offset of the .zip content, after the initial .exe, if any
    // - can be used to copy the initial .exe file
    property ZipStartOffset: cardinal read fZipStartOffset;
  end;

  /// write-only access for creating a .zip archive file
  // - not to be used to update a .zip file, but to create a new one
  // - update can be done manualy by using a TZipRead instance and the
  // AddFromZip() method
  TZipWrite = class
  protected
    fAppendOffset: cardinal;
    fFileName: TFileName;
    fMagic: cardinal;
  public
    /// the associated file handle
    Handle: THandle;
    /// the total number of entries
    Count: integer;
    /// the resulting file entries
    Entry: array of record
      /// the file name
      name: TZipName;
      /// the corresponding file header
      fhr: TFileHeader;
    end;
    /// initialize the .zip file
    constructor Create(const aFileName: TFileName); overload;
    /// compress (using the deflate method) a memory buffer, and add it to the zip file
    // - by default, the 1st of January, 2010 is used if not date is supplied
    procedure AddDeflated(const aZipName: TZipName;
      Buf: pointer; Size: integer; CompressLevel: integer = 6;
      FileAge: integer = 1 + 1 shl 5 + 30 shl 9); overload;
    /// compress (using the deflate method) a file, and add it to the zip file
    procedure AddDeflated(const aFileName: TFileName; RemovePath: boolean = true;
      CompressLevel: integer = 6); overload;
    /// add a memory buffer to the zip file, without compression
    // - content is stored, not deflated
    // (in that case, no deflate code is added to the executable)
    // - by default, the 1st of January, 2010 is used if not date is supplied
    procedure AddStored(const aZipName: TZipName; Buf: pointer; Size: integer;
      FileAge: integer = 1 + 1 shl 5 + 30 shl 9);
    /// add a file from an already compressed zip entry
    procedure AddFromZip(const ZipEntry: TZipEntry);
    /// append a file content into the destination file
    // - useful to add the initial Setup.exe file, e.g.
    procedure Append(const Content: RawByteZip);
    /// release associated memory, and close destination file
    destructor Destroy; override;
  end;

{$endif MSWINDOWS}


implementation

{$ifndef FPC}
type
  PtrUInt = {$ifdef CPU64}NativeUInt{$else}cardinal{$endif};
  PtrInt  = {$ifdef CPU64}NativeInt {$else}integer {$endif};
{$endif FPC}

// special tuned Move() routine, including data overlap bug correction
{$ifdef PUREPASCAL}
procedure MoveWithOverlap(Src: PByte; Dst: PByte; Count: PtrUInt);
  {$ifdef HASINLINE}inline;{$endif}
begin // should be fast enough in practice, especially inlined
  dec(PtrUInt(Src), PtrUInt(Dst));
  inc(Count, PtrUInt(Dst));
  repeat
    Dst^ := PByteArray(Src)[PtrUInt(Dst)];
    inc(Dst);
  until PtrUInt(Dst) = Count;
end;
{$else}
procedure MoveWithOverlap(Src: PByte; Dst: PByte; Count: integer);
  {$ifdef FPC} nostackframe; assembler; {$endif}
asm // eax=source edx=dest ecx=count
        push    edx
        sub     edx, eax
        cmp     edx, ecx // avoid move error if dest and source overlaps
        pop     edx     // restore original edx=dest
        ja      System.Move // call FastMove() routine for normal code
        or      ecx, ecx
        jz      @exit
        push    edi
        mov     edi, edx // restore original edi=dest
@overlap: // byte by byte slower but accurate move routine
        mov     dl, [eax]
        inc     eax
        mov     [edi], dl
        inc     edi
        dec     ecx
        jnz     @overlap
        pop     edi
@exit:
end;
{$endif PUREPASCAL}

//----------------- general library stuff

const
  CMemLevel = 8;
  CWindowBits = 15;

type
  TPInt64 = ^int64;
  TPCardinal = ^cardinal;
  TPWord = ^word;
  TAByte = array[0..maxInt - 1] of byte;
  TPAByte = ^TAByte;
  TAWord = array[0..maxInt shr 1 - 1] of word;
  TPAWord = ^TAWord;
  TAInteger = array[0..maxInt shr 2 - 1] of integer;
  TPAInteger = ^TAInteger;
  TACardinal = array[0..maxInt shr 2 - 1] of cardinal;
  TPACardinal = ^TACardinal;
  TAInt64 = array[0..maxInt shr 3 - 1] of int64;
  TPAInt64 = ^TAInt64;
  PInflateHuft = ^TInflateHuft;
  TInflateHuft = packed record
    Exop,           // number of extra bits or operation
    Bits: Byte;     // number of bits in this code or subcode
    Base: Cardinal; // literal, Length base, or distance base or table offset
  end;
  THuftFields = array[0..(MaxInt div SizeOf(TInflateHuft)) - 1] of TInflateHuft;
  PHuftField = ^THuftFields;
  PPInflateHuft = ^PInflateHuft;
  TInflateCodesMode = ( // waiting for "I:"=input, "O:"=output, "X:"=nothing
    icmStart,    // X: set up for Len
    icmLen,      // I: get length/literal/eob next
    icmLenNext,  // I: getting length extra (have base)
    icmDistance, // I: get distance next
    icmDistExt,  // I: getting distance extra
    icmCopy,     // O: copying bytes in window, waiting for space
    icmLit,      // O: got literal, waiting for output space
    icmWash,     // O: got eob, possibly still output waiting
    icmZEnd,     // X: got eob and all data flushed
    icmBadCode   // X: got error
  );

  // inflate codes private state
  TInflateCodesState = record
    Mode: TInflateCodesMode;    // current inflate codes mode
    // mode dependent information
    Len: Cardinal;
    Sub: record                // submode
      case Byte of
        0:(Code: record        // if Len or Distance, where in tree
           Tree: PInflateHuft; // pointer into tree
           need: Cardinal;     // bits needed
        end);
        1:(lit: Cardinal);     // if icmLit, literal
        2:(copy: record        // if EXT or icmCopy, where and how much
           get: Cardinal;      // bits to get for extra
           Distance: Cardinal; // distance back to copy from
        end);
    end;
    // mode independent information
    LiteralTreeBits: Byte;      // LiteralTree bits decoded per branch
    DistanceTreeBits: Byte;     // DistanceTree bits decoder per branch
    LiteralTree: PInflateHuft;  // literal/length/eob tree
    DistanceTree: PInflateHuft; // distance tree
  end;
  PInflateCodesState = ^TInflateCodesState;

  TInflateBlockMode = (
    ibmZType,     // get type bits (3, including end bit)
    ibmLens,      // get lengths for stored
    ibmStored,    // processing stored block
    ibmTable,     // get table lengths
    ibmBitTree,   // get bit lengths tree for a dynamic block
    ibmDistTree,  // get length, distance trees for a dynamic block
    ibmCodes,     // processing fixed or dynamic block
    ibmDry,       // output remaining window bytes
    ibmBlockDone, // finished last block, done
    ibmBlockBad   // got a data error -> stuck here
  );

  // inflate blocks semi-private state
  TInflateBlocksState = record
    Mode: TInflateBlockMode; // current inflate block mode
    // mode dependent information
    Sub: record                       // submode
      case Byte of
        0: (left: Cardinal);          // if ibmStored, bytes left to copy
        1: (Trees: record             // if DistanceTree, decoding info for trees
            Table: Cardinal;          // table lengths (14 Bits)
            Index: Cardinal;          // index into blens (or BitOrder)
            blens: TPACardinal;       // bit lengths of codes
            BB: Cardinal;             // bit length tree depth
            TB: PInflateHuft;         // bit length decoding tree
          end);
        2: (decode: record            // if ibmCodes, current state
            TL: PInflateHuft;
            TD: PInflateHuft;         // trees to free
            codes: PInflateCodesState;
          end);
    end;
    Last: boolean;                     // True if this block is the last block
    // mode independent information
    bitk: Cardinal;                    // bits in bit buffer
    bitb: Cardinal;                    // bit buffer
    hufts: PHuftField;                 // single allocation for tree space
    window: PByte;                     // sliding window
    zend: PByte;                       // one byte after sliding window
    read: PByte;                       // window read pointer
    write: PByte;                      // window write pointer
  end;
  PInflateBlocksState = ^TInflateBlocksState;

  // The application must update NextInput and AvailableInput when AvailableInput has dropped to zero. It must update
  // NextOutput and AvailableOutput when AvailableOutput has dropped to zero. All other fields are set by the
  // compression library and must not be updated by the application.
  //
  // The fields TotalInput and TotalOutput can be used for statistics or progress reports. After compression, TotalInput
  // holds the total size of the uncompressed data and may be saved for use in the decompressor
  // (particularly if the decompressor wants to decompress everything in a single step).
  PZState = ^TZState;
  TZState = record
    NextInput: PByte;           // next input byte
    AvailableInput: Cardinal;   // number of bytes available at NextInput
    TotalInput: Cardinal;       // total number of input bytes read so far
    NextOutput: PByte;          // next output byte should be put there
    AvailableOutput: Cardinal;  // remaining free space at NextOutput
    TotalOutput: Cardinal;      // total number of bytes output so far
    State: PInflateBlocksState; // not visible by applications
  end;

const
  // Return codes for the compression/decompression functions. Negative
  // values are errors, positive values are used for special but normal events.
  Z_OK = 0;
  Z_STREAM_END = 1;
  Z_STREAM_ERROR = -2;
  Z_DATA_ERROR = -3;
  Z_MEM_ERROR = -4;
  Z_BUF_ERROR = -5;

  // three kinds of block type
  STORED_BLOCK = 0;
  STATIC_TREES = 1;
  DYN_TREES = 2;

  // minimum and maximum match lengths
  MIN_MATCH = 3;
  MAX_MATCH = 258;


//----------------- deflation support

const
  LENGTH_CODES = 29;         // number of length codes, not counting the special END_BLOCK code
  LITERALS = 256;            // number of literal bytes 0..255
  L_CODES = (LITERALS + 1 + LENGTH_CODES);
                             // number of literal or length codes, including the END_BLOCK code
  D_CODES = 30;              // number of distance codes
  BL_CODES = 19;             // number of codes used to transfer the bit lengths
  HEAP_SIZE = (2 * L_CODES + 1); // maximum heap size
  MAX_BITS = 15;             // all codes must not exceed MAX_BITS bits

type
  // data structure describing a single value and its code string
  PTreeEntry = ^TTreeEntry;
  TTreeEntry = record
    fc: record
      case Byte of
        0:
          (Frequency: word); // frequency count
        1:
          (Code: word); // bit string
    end;
    dl: record
      case Byte of
        0:
          (dad: word);  // father node in Huffman tree
        1:
          (Len: word);  // length of bit string
    end;
  end;
  TLiteralTree = array[0..HEAP_SIZE - 1] of TTreeEntry; // literal and length tree
  TDistanceTree = array[0..2 * D_CODES] of TTreeEntry;  // distance tree
  THuffmanTree = array[0..2 * BL_CODES] of TTreeEntry;  // Huffman tree for bit lengths
  PTree = ^TTree;
  TTree = array[0..(MaxInt div SizeOf(TTreeEntry)) - 1] of TTreeEntry; // generic tree type

  PStaticTreeDescriptor = ^TStaticTreeDescriptor;
  TStaticTreeDescriptor = record
    StaticTree: PTree;        // static tree or nil
    ExtraBits: TPAInteger; // extra bits for each code or nil
    ExtraBase: integer;       // base index for ExtraBits
    Elements: integer;        // max number of elements in the tree
    MaxLength: integer;       // max bit length for the codes
  end;

  PTreeDescriptor = ^TTreeDescriptor;
  TTreeDescriptor = record
    DynamicTree: PTree;
    MaxCode: integer;                        // largest code with non zero frequency
    StaticDescriptor: PStaticTreeDescriptor; // the corresponding static tree
  end;

  PDeflateState = ^TDeflateState;
  TDeflateState = record
    ZState: PZState;            // pointer back to this zlib stream
    PendingBuffer: TPAByte;  // output still pending
    PendingBufferSize: integer;
    PendingOutput: PByte;       // next pending byte to output to the stream
    Pending: integer;           // nb of bytes in the pending buffer
    WindowSize: Cardinal;       // LZ77 window size (32K by default)
    WindowBits: Cardinal;       // log2(WindowSize) (8..16)
    WindowMask: Cardinal;       // WindowSize - 1

    // Sliding window. Input bytes are read into the second half of the window,
    // and move to the first half later to keep a dictionary of at least WSize
    // bytes. With this organization, matches are limited to a distance of
    // WSize - MAX_MATCH bytes, but this ensures that IO is always
    // performed with a length multiple of the block Size. Also, it limits
    // the window Size to 64K, which is quite useful on MSDOS.
    // To do: use the user input buffer as sliding window.
    Window: TPAByte;

    // Actual size of Window: 2 * WSize, except when the user input buffer
    // is directly used as sliding window.
    CurrentWindowSize: integer;

    // Link to older string with same hash index. to limit the size of this
    // array to 64K, this link is maintained only for the last 32K strings.
    // An index in this array is thus a window index modulo 32K.
    Previous: TPAWord;
    Head: TPAWord;           // heads of the hash chains or nil
    InsertHash: Cardinal;       // hash index of string to be inserted
    HashSize: Cardinal;         // number of elements in hash table
    HashBits: Cardinal;         // log2(HashSize)
    HashMask: Cardinal;         // HashSize - 1

    // Number of bits by which InsertHash must be shifted at each input step.
    // It must be such that after MIN_MATCH steps, the oldest byte no longer
    // takes part in the hash key, that is:
    // HashShift * MIN_MATCH >= HashBits
    HashShift: Cardinal;

    // Window position at the beginning of the current output block. Gets
    // negative when the window is moved backwards.
    BlockStart: integer;
    MatchLength: Cardinal;      // length of best match
    PreviousMatch: Cardinal;    // previous match
    MatchAvailable: boolean;    // set if previous match exists
    StringStart: Cardinal;      // start of string to insert
    MatchStart: Cardinal;       // start of matching string
    Lookahead: Cardinal;        // number of valid bytes ahead in window

    // Length of the best match at previous step. Matches not greater than this
    // are discarded. This is used in the lazy match evaluation.
    PreviousLength: Cardinal;
    LiteralTree: TLiteralTree;  // literal and length tree
    DistanceTree: TDistanceTree; // distance tree
    BitLengthTree: THuffmanTree; // Huffman tree for bit lengths

    LiteralDescriptor: TTreeDescriptor; // Descriptor for literal tree
    DistanceDescriptor: TTreeDescriptor; // Descriptor for distance tree
    BitLengthDescriptor: TTreeDescriptor; // Descriptor for bit length tree

    BitLengthCounts: array[0..MAX_BITS] of word; // number of codes at each bit length for an optimal tree

    Heap: array[0..2 * L_CODES] of integer; // heap used to build the Huffman trees
    HeapLength: integer;        // number of elements in the heap
    HeapMaximum: integer;       // element of largest frequency
    // The sons of Heap[N] are Heap[2 * N] and Heap[2 * N + 1]. Heap[0] is not used.
    // The same heap array is used to build all trees.

    Depth: array[0..2 * L_CODES] of Byte; // depth of each subtree used as tie breaker for trees of equal frequency

    LiteralBuffer: TPAByte;       // buffer for literals or lengths

    // Size of match buffer for literals/lengths. There are 4 reasons for limiting LiteralBufferSize to 64K:
    //  - frequencies can be kept in 16 bit counters
    //  - If compression is not successful for the first block, all input
    //    data is still in the window so we can still emit a stored block even
    //    when input comes from standard input. This can also be done for
    //    all blocks if LiteralBufferSize is not greater than 32K.
    //  - if compression is not successful for a file smaller than 64K, we can
    //    even emit a stored file instead of a stored block (saving 5 bytes).
    //    This is applicable only for zip (not gzip or zlib).
    //  - creating new Huffman trees less frequently may not provide fast
    //    adaptation to changes in the input data statistics. (Take for
    //    example a binary file with poorly compressible code followed by
    //    a highly compressible string table.) Smaller buffer sizes give
    //    fast adaptation but have of course the overhead of transmitting
    //    trees more frequently.
    //  - I can't count above 4
    LiteralBufferSize: Cardinal;
    LastLiteral: Cardinal;      // running index in LiteralBuffer

    // Buffer for distances. To simplify the code, DistanceBuffer and LiteralBuffer have
    // the same number of elements. To use different lengths, an extra flag array would be necessary.
    DistanceBuffer: TPAWord;
    OptimalLength: integer;     // bit length of current block with optimal trees
    StaticLength: integer;      // bit length of current block with static trees
    CompressedLength: integer;  // total bit length of compressed file
    Matches: Cardinal;          // number of string matches in current block
    LastEOBLength: integer;     // bit length of EOB code for last block
    BitsBuffer: word;           // Output buffer. Bits are inserted starting at the bottom (least significant bits).
    ValidBits: integer;         // Number of valid bits in BitsBuffer. All Bits above the last valid bit are always zero.
  end;

//----------------- Huffmann trees

const
  DIST_CODE_LEN = 512; // see definition of array dist_code below

  // The static literal tree. Since the bit lengths are imposed, there is no need for the L_CODES Extra codes used
  // during heap construction. However the codes 286 and 287 are needed to build a canonical tree (see TreeInit below).
  StaticLiteralTree: array[0..L_CODES + 1] of TTreeEntry = (
    (fc: (Frequency:  12); dl: (Len: 8)), (fc: (Frequency: 140); dl: (Len: 8)), (fc: (Frequency:  76); dl: (Len: 8)),
    (fc: (Frequency: 204); dl: (Len: 8)), (fc: (Frequency:  44); dl: (Len: 8)), (fc: (Frequency: 172); dl: (Len: 8)),
    (fc: (Frequency: 108); dl: (Len: 8)), (fc: (Frequency: 236); dl: (Len: 8)), (fc: (Frequency:  28); dl: (Len: 8)),
    (fc: (Frequency: 156); dl: (Len: 8)), (fc: (Frequency:  92); dl: (Len: 8)), (fc: (Frequency: 220); dl: (Len: 8)),
    (fc: (Frequency:  60); dl: (Len: 8)), (fc: (Frequency: 188); dl: (Len: 8)), (fc: (Frequency: 124); dl: (Len: 8)),
    (fc: (Frequency: 252); dl: (Len: 8)), (fc: (Frequency:   2); dl: (Len: 8)), (fc: (Frequency: 130); dl: (Len: 8)),
    (fc: (Frequency:  66); dl: (Len: 8)), (fc: (Frequency: 194); dl: (Len: 8)), (fc: (Frequency:  34); dl: (Len: 8)),
    (fc: (Frequency: 162); dl: (Len: 8)), (fc: (Frequency:  98); dl: (Len: 8)), (fc: (Frequency: 226); dl: (Len: 8)),
    (fc: (Frequency:  18); dl: (Len: 8)), (fc: (Frequency: 146); dl: (Len: 8)), (fc: (Frequency:  82); dl: (Len: 8)),
    (fc: (Frequency: 210); dl: (Len: 8)), (fc: (Frequency:  50); dl: (Len: 8)), (fc: (Frequency: 178); dl: (Len: 8)),
    (fc: (Frequency: 114); dl: (Len: 8)), (fc: (Frequency: 242); dl: (Len: 8)), (fc: (Frequency:  10); dl: (Len: 8)),
    (fc: (Frequency: 138); dl: (Len: 8)), (fc: (Frequency:  74); dl: (Len: 8)), (fc: (Frequency: 202); dl: (Len: 8)),
    (fc: (Frequency:  42); dl: (Len: 8)), (fc: (Frequency: 170); dl: (Len: 8)), (fc: (Frequency: 106); dl: (Len: 8)),
    (fc: (Frequency: 234); dl: (Len: 8)), (fc: (Frequency:  26); dl: (Len: 8)), (fc: (Frequency: 154); dl: (Len: 8)),
    (fc: (Frequency:  90); dl: (Len: 8)), (fc: (Frequency: 218); dl: (Len: 8)), (fc: (Frequency:  58); dl: (Len: 8)),
    (fc: (Frequency: 186); dl: (Len: 8)), (fc: (Frequency: 122); dl: (Len: 8)), (fc: (Frequency: 250); dl: (Len: 8)),
    (fc: (Frequency:   6); dl: (Len: 8)), (fc: (Frequency: 134); dl: (Len: 8)), (fc: (Frequency:  70); dl: (Len: 8)),
    (fc: (Frequency: 198); dl: (Len: 8)), (fc: (Frequency:  38); dl: (Len: 8)), (fc: (Frequency: 166); dl: (Len: 8)),
    (fc: (Frequency: 102); dl: (Len: 8)), (fc: (Frequency: 230); dl: (Len: 8)), (fc: (Frequency:  22); dl: (Len: 8)),
    (fc: (Frequency: 150); dl: (Len: 8)), (fc: (Frequency:  86); dl: (Len: 8)), (fc: (Frequency: 214); dl: (Len: 8)),
    (fc: (Frequency:  54); dl: (Len: 8)), (fc: (Frequency: 182); dl: (Len: 8)), (fc: (Frequency: 118); dl: (Len: 8)),
    (fc: (Frequency: 246); dl: (Len: 8)), (fc: (Frequency:  14); dl: (Len: 8)), (fc: (Frequency: 142); dl: (Len: 8)),
    (fc: (Frequency:  78); dl: (Len: 8)), (fc: (Frequency: 206); dl: (Len: 8)), (fc: (Frequency:  46); dl: (Len: 8)),
    (fc: (Frequency: 174); dl: (Len: 8)), (fc: (Frequency: 110); dl: (Len: 8)), (fc: (Frequency: 238); dl: (Len: 8)),
    (fc: (Frequency:  30); dl: (Len: 8)), (fc: (Frequency: 158); dl: (Len: 8)), (fc: (Frequency:  94); dl: (Len: 8)),
    (fc: (Frequency: 222); dl: (Len: 8)), (fc: (Frequency:  62); dl: (Len: 8)), (fc: (Frequency: 190); dl: (Len: 8)),
    (fc: (Frequency: 126); dl: (Len: 8)), (fc: (Frequency: 254); dl: (Len: 8)), (fc: (Frequency:   1); dl: (Len: 8)),
    (fc: (Frequency: 129); dl: (Len: 8)), (fc: (Frequency:  65); dl: (Len: 8)), (fc: (Frequency: 193); dl: (Len: 8)),
    (fc: (Frequency:  33); dl: (Len: 8)), (fc: (Frequency: 161); dl: (Len: 8)), (fc: (Frequency:  97); dl: (Len: 8)),
    (fc: (Frequency: 225); dl: (Len: 8)), (fc: (Frequency:  17); dl: (Len: 8)), (fc: (Frequency: 145); dl: (Len: 8)),
    (fc: (Frequency:  81); dl: (Len: 8)), (fc: (Frequency: 209); dl: (Len: 8)), (fc: (Frequency:  49); dl: (Len: 8)),
    (fc: (Frequency: 177); dl: (Len: 8)), (fc: (Frequency: 113); dl: (Len: 8)), (fc: (Frequency: 241); dl: (Len: 8)),
    (fc: (Frequency:   9); dl: (Len: 8)), (fc: (Frequency: 137); dl: (Len: 8)), (fc: (Frequency:  73); dl: (Len: 8)),
    (fc: (Frequency: 201); dl: (Len: 8)), (fc: (Frequency:  41); dl: (Len: 8)), (fc: (Frequency: 169); dl: (Len: 8)),
    (fc: (Frequency: 105); dl: (Len: 8)), (fc: (Frequency: 233); dl: (Len: 8)), (fc: (Frequency:  25); dl: (Len: 8)),
    (fc: (Frequency: 153); dl: (Len: 8)), (fc: (Frequency:  89); dl: (Len: 8)), (fc: (Frequency: 217); dl: (Len: 8)),
    (fc: (Frequency:  57); dl: (Len: 8)), (fc: (Frequency: 185); dl: (Len: 8)), (fc: (Frequency: 121); dl: (Len: 8)),
    (fc: (Frequency: 249); dl: (Len: 8)), (fc: (Frequency:   5); dl: (Len: 8)), (fc: (Frequency: 133); dl: (Len: 8)),
    (fc: (Frequency:  69); dl: (Len: 8)), (fc: (Frequency: 197); dl: (Len: 8)), (fc: (Frequency:  37); dl: (Len: 8)),
    (fc: (Frequency: 165); dl: (Len: 8)), (fc: (Frequency: 101); dl: (Len: 8)), (fc: (Frequency: 229); dl: (Len: 8)),
    (fc: (Frequency:  21); dl: (Len: 8)), (fc: (Frequency: 149); dl: (Len: 8)), (fc: (Frequency:  85); dl: (Len: 8)),
    (fc: (Frequency: 213); dl: (Len: 8)), (fc: (Frequency:  53); dl: (Len: 8)), (fc: (Frequency: 181); dl: (Len: 8)),
    (fc: (Frequency: 117); dl: (Len: 8)), (fc: (Frequency: 245); dl: (Len: 8)), (fc: (Frequency:  13); dl: (Len: 8)),
    (fc: (Frequency: 141); dl: (Len: 8)), (fc: (Frequency:  77); dl: (Len: 8)), (fc: (Frequency: 205); dl: (Len: 8)),
    (fc: (Frequency:  45); dl: (Len: 8)), (fc: (Frequency: 173); dl: (Len: 8)), (fc: (Frequency: 109); dl: (Len: 8)),
    (fc: (Frequency: 237); dl: (Len: 8)), (fc: (Frequency:  29); dl: (Len: 8)), (fc: (Frequency: 157); dl: (Len: 8)),
    (fc: (Frequency:  93); dl: (Len: 8)), (fc: (Frequency: 221); dl: (Len: 8)), (fc: (Frequency:  61); dl: (Len: 8)),
    (fc: (Frequency: 189); dl: (Len: 8)), (fc: (Frequency: 125); dl: (Len: 8)), (fc: (Frequency: 253); dl: (Len: 8)),
    (fc: (Frequency:  19); dl: (Len: 9)), (fc: (Frequency: 275); dl: (Len: 9)), (fc: (Frequency: 147); dl: (Len: 9)),
    (fc: (Frequency: 403); dl: (Len: 9)), (fc: (Frequency:  83); dl: (Len: 9)), (fc: (Frequency: 339); dl: (Len: 9)),
    (fc: (Frequency: 211); dl: (Len: 9)), (fc: (Frequency: 467); dl: (Len: 9)), (fc: (Frequency:  51); dl: (Len: 9)),
    (fc: (Frequency: 307); dl: (Len: 9)), (fc: (Frequency: 179); dl: (Len: 9)), (fc: (Frequency: 435); dl: (Len: 9)),
    (fc: (Frequency: 115); dl: (Len: 9)), (fc: (Frequency: 371); dl: (Len: 9)), (fc: (Frequency: 243); dl: (Len: 9)),
    (fc: (Frequency: 499); dl: (Len: 9)), (fc: (Frequency:  11); dl: (Len: 9)), (fc: (Frequency: 267); dl: (Len: 9)),
    (fc: (Frequency: 139); dl: (Len: 9)), (fc: (Frequency: 395); dl: (Len: 9)), (fc: (Frequency:  75); dl: (Len: 9)),
    (fc: (Frequency: 331); dl: (Len: 9)), (fc: (Frequency: 203); dl: (Len: 9)), (fc: (Frequency: 459); dl: (Len: 9)),
    (fc: (Frequency:  43); dl: (Len: 9)), (fc: (Frequency: 299); dl: (Len: 9)), (fc: (Frequency: 171); dl: (Len: 9)),
    (fc: (Frequency: 427); dl: (Len: 9)), (fc: (Frequency: 107); dl: (Len: 9)), (fc: (Frequency: 363); dl: (Len: 9)),
    (fc: (Frequency: 235); dl: (Len: 9)), (fc: (Frequency: 491); dl: (Len: 9)), (fc: (Frequency:  27); dl: (Len: 9)),
    (fc: (Frequency: 283); dl: (Len: 9)), (fc: (Frequency: 155); dl: (Len: 9)), (fc: (Frequency: 411); dl: (Len: 9)),
    (fc: (Frequency:  91); dl: (Len: 9)), (fc: (Frequency: 347); dl: (Len: 9)), (fc: (Frequency: 219); dl: (Len: 9)),
    (fc: (Frequency: 475); dl: (Len: 9)), (fc: (Frequency:  59); dl: (Len: 9)), (fc: (Frequency: 315); dl: (Len: 9)),
    (fc: (Frequency: 187); dl: (Len: 9)), (fc: (Frequency: 443); dl: (Len: 9)), (fc: (Frequency: 123); dl: (Len: 9)),
    (fc: (Frequency: 379); dl: (Len: 9)), (fc: (Frequency: 251); dl: (Len: 9)), (fc: (Frequency: 507); dl: (Len: 9)),
    (fc: (Frequency:   7); dl: (Len: 9)), (fc: (Frequency: 263); dl: (Len: 9)), (fc: (Frequency: 135); dl: (Len: 9)),
    (fc: (Frequency: 391); dl: (Len: 9)), (fc: (Frequency:  71); dl: (Len: 9)), (fc: (Frequency: 327); dl: (Len: 9)),
    (fc: (Frequency: 199); dl: (Len: 9)), (fc: (Frequency: 455); dl: (Len: 9)), (fc: (Frequency:  39); dl: (Len: 9)),
    (fc: (Frequency: 295); dl: (Len: 9)), (fc: (Frequency: 167); dl: (Len: 9)), (fc: (Frequency: 423); dl: (Len: 9)),
    (fc: (Frequency: 103); dl: (Len: 9)), (fc: (Frequency: 359); dl: (Len: 9)), (fc: (Frequency: 231); dl: (Len: 9)),
    (fc: (Frequency: 487); dl: (Len: 9)), (fc: (Frequency:  23); dl: (Len: 9)), (fc: (Frequency: 279); dl: (Len: 9)),
    (fc: (Frequency: 151); dl: (Len: 9)), (fc: (Frequency: 407); dl: (Len: 9)), (fc: (Frequency:  87); dl: (Len: 9)),
    (fc: (Frequency: 343); dl: (Len: 9)), (fc: (Frequency: 215); dl: (Len: 9)), (fc: (Frequency: 471); dl: (Len: 9)),
    (fc: (Frequency:  55); dl: (Len: 9)), (fc: (Frequency: 311); dl: (Len: 9)), (fc: (Frequency: 183); dl: (Len: 9)),
    (fc: (Frequency: 439); dl: (Len: 9)), (fc: (Frequency: 119); dl: (Len: 9)), (fc: (Frequency: 375); dl: (Len: 9)),
    (fc: (Frequency: 247); dl: (Len: 9)), (fc: (Frequency: 503); dl: (Len: 9)), (fc: (Frequency:  15); dl: (Len: 9)),
    (fc: (Frequency: 271); dl: (Len: 9)), (fc: (Frequency: 143); dl: (Len: 9)), (fc: (Frequency: 399); dl: (Len: 9)),
    (fc: (Frequency:  79); dl: (Len: 9)), (fc: (Frequency: 335); dl: (Len: 9)), (fc: (Frequency: 207); dl: (Len: 9)),
    (fc: (Frequency: 463); dl: (Len: 9)), (fc: (Frequency:  47); dl: (Len: 9)), (fc: (Frequency: 303); dl: (Len: 9)),
    (fc: (Frequency: 175); dl: (Len: 9)), (fc: (Frequency: 431); dl: (Len: 9)), (fc: (Frequency: 111); dl: (Len: 9)),
    (fc: (Frequency: 367); dl: (Len: 9)), (fc: (Frequency: 239); dl: (Len: 9)), (fc: (Frequency: 495); dl: (Len: 9)),
    (fc: (Frequency:  31); dl: (Len: 9)), (fc: (Frequency: 287); dl: (Len: 9)), (fc: (Frequency: 159); dl: (Len: 9)),
    (fc: (Frequency: 415); dl: (Len: 9)), (fc: (Frequency:  95); dl: (Len: 9)), (fc: (Frequency: 351); dl: (Len: 9)),
    (fc: (Frequency: 223); dl: (Len: 9)), (fc: (Frequency: 479); dl: (Len: 9)), (fc: (Frequency:  63); dl: (Len: 9)),
    (fc: (Frequency: 319); dl: (Len: 9)), (fc: (Frequency: 191); dl: (Len: 9)), (fc: (Frequency: 447); dl: (Len: 9)),
    (fc: (Frequency: 127); dl: (Len: 9)), (fc: (Frequency: 383); dl: (Len: 9)), (fc: (Frequency: 255); dl: (Len: 9)),
    (fc: (Frequency: 511); dl: (Len: 9)), (fc: (Frequency:   0); dl: (Len: 7)), (fc: (Frequency:  64); dl: (Len: 7)),
    (fc: (Frequency:  32); dl: (Len: 7)), (fc: (Frequency:  96); dl: (Len: 7)), (fc: (Frequency:  16); dl: (Len: 7)),
    (fc: (Frequency:  80); dl: (Len: 7)), (fc: (Frequency:  48); dl: (Len: 7)), (fc: (Frequency: 112); dl: (Len: 7)),
    (fc: (Frequency:   8); dl: (Len: 7)), (fc: (Frequency:  72); dl: (Len: 7)), (fc: (Frequency:  40); dl: (Len: 7)),
    (fc: (Frequency: 104); dl: (Len: 7)), (fc: (Frequency:  24); dl: (Len: 7)), (fc: (Frequency:  88); dl: (Len: 7)),
    (fc: (Frequency:  56); dl: (Len: 7)), (fc: (Frequency: 120); dl: (Len: 7)), (fc: (Frequency:   4); dl: (Len: 7)),
    (fc: (Frequency:  68); dl: (Len: 7)), (fc: (Frequency:  36); dl: (Len: 7)), (fc: (Frequency: 100); dl: (Len: 7)),
    (fc: (Frequency:  20); dl: (Len: 7)), (fc: (Frequency:  84); dl: (Len: 7)), (fc: (Frequency:  52); dl: (Len: 7)),
    (fc: (Frequency: 116); dl: (Len: 7)), (fc: (Frequency:   3); dl: (Len: 8)), (fc: (Frequency: 131); dl: (Len: 8)),
    (fc: (Frequency:  67); dl: (Len: 8)), (fc: (Frequency: 195); dl: (Len: 8)), (fc: (Frequency:  35); dl: (Len: 8)),
    (fc: (Frequency: 163); dl: (Len: 8)), (fc: (Frequency:  99); dl: (Len: 8)), (fc: (Frequency: 227); dl: (Len: 8))
  );

  // The static distance tree. (Actually a trivial tree since all lens use 5 Bits.)
  StaticDescriptorTree: array[0..D_CODES - 1] of TTreeEntry = (
    (fc: (Frequency:  0); dl: (Len: 5)), (fc: (Frequency: 16); dl: (Len: 5)), (fc: (Frequency:  8); dl: (Len: 5)),
    (fc: (Frequency: 24); dl: (Len: 5)), (fc: (Frequency:  4); dl: (Len: 5)), (fc: (Frequency: 20); dl: (Len: 5)),
    (fc: (Frequency: 12); dl: (Len: 5)), (fc: (Frequency: 28); dl: (Len: 5)), (fc: (Frequency:  2); dl: (Len: 5)),
    (fc: (Frequency: 18); dl: (Len: 5)), (fc: (Frequency: 10); dl: (Len: 5)), (fc: (Frequency: 26); dl: (Len: 5)),
    (fc: (Frequency:  6); dl: (Len: 5)), (fc: (Frequency: 22); dl: (Len: 5)), (fc: (Frequency: 14); dl: (Len: 5)),
    (fc: (Frequency: 30); dl: (Len: 5)), (fc: (Frequency:  1); dl: (Len: 5)), (fc: (Frequency: 17); dl: (Len: 5)),
    (fc: (Frequency:  9); dl: (Len: 5)), (fc: (Frequency: 25); dl: (Len: 5)), (fc: (Frequency:  5); dl: (Len: 5)),
    (fc: (Frequency: 21); dl: (Len: 5)), (fc: (Frequency: 13); dl: (Len: 5)), (fc: (Frequency: 29); dl: (Len: 5)),
    (fc: (Frequency:  3); dl: (Len: 5)), (fc: (Frequency: 19); dl: (Len: 5)), (fc: (Frequency: 11); dl: (Len: 5)),
    (fc: (Frequency: 27); dl: (Len: 5)), (fc: (Frequency:  7); dl: (Len: 5)), (fc: (Frequency: 23); dl: (Len: 5))
  );

  // Distance codes. The first 256 values correspond to the distances 3 .. 258, the last 256 values correspond to the
  // top 8 Bits of the 15 bit distances.
  DistanceCode: array[0..DIST_CODE_LEN - 1] of Byte = (
     0,  1,  2,  3,  4,  4,  5,  5,  6,  6,  6,  6,  7,  7,  7,  7,  8,  8,  8,  8,
     8,  8,  8,  8,  9,  9,  9,  9,  9,  9,  9,  9, 10, 10, 10, 10, 10, 10, 10, 10,
    10, 10, 10, 10, 10, 10, 10, 10, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11,
    11, 11, 11, 11, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12,
    12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 13, 13, 13, 13,
    13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13,
    13, 13, 13, 13, 13, 13, 13, 13, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,  0,  0, 16, 17,
    18, 18, 19, 19, 20, 20, 20, 20, 21, 21, 21, 21, 22, 22, 22, 22, 22, 22, 22, 22,
    23, 23, 23, 23, 23, 23, 23, 23, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24,
    24, 24, 24, 24, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25,
    26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26,
    26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 27, 27, 27, 27, 27, 27, 27, 27,
    27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27,
    27, 27, 27, 27, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28,
    28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28,
    28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28,
    28, 28, 28, 28, 28, 28, 28, 28, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29,
    29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29,
    29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29,
    29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29
  );

  // length code for each normalized match length (0 = MIN_MATCH)
  LengthCode: array[0..MAX_MATCH - MIN_MATCH] of Byte = (
     0,  1,  2,  3,  4,  5,  6,  7,  8,  8,  9,  9, 10, 10, 11, 11, 12, 12, 12, 12,
    13, 13, 13, 13, 14, 14, 14, 14, 15, 15, 15, 15, 16, 16, 16, 16, 16, 16, 16, 16,
    17, 17, 17, 17, 17, 17, 17, 17, 18, 18, 18, 18, 18, 18, 18, 18, 19, 19, 19, 19,
    19, 19, 19, 19, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20,
    21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 22, 22, 22, 22,
    22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 23, 23, 23, 23, 23, 23, 23, 23,
    23, 23, 23, 23, 23, 23, 23, 23, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24,
    24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24,
    25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25,
    25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 26, 26, 26, 26, 26, 26, 26, 26,
    26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26,
    26, 26, 26, 26, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27,
    27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 28
  );

  // first normalized length for each code (0 = MIN_MATCH)
  BaseLength: array[0..LENGTH_CODES - 1] of byte = (
    0, 1, 2, 3, 4, 5, 6, 7, 8, 10, 12, 14, 16, 20, 24, 28, 32, 40, 48, 56,
    64, 80, 96, 112, 128, 160, 192, 224, 0
  );

  // first normalized distance for each code (0 = distance of 1)
  BaseDistance: array[0..D_CODES - 1] of integer = (
       0,     1,     2,     3,     4,     6,     8,    12,    16,    24,
      32,    48,    64,    96,   128,   192,   256,   384,   512,   768,
    1024,  1536,  2048,  3072,  4096,  6144,  8192, 12288, 16384, 24576
  );

  MIN_LOOKAHEAD = (MAX_MATCH + MIN_MATCH + 1);
  MAX_BL_BITS = 7;  // bit length codes must not exceed MAX_BL_BITS bits
  END_BLOCK = 256;  // end of block literal code
  REP_3_6 = 16;     // repeat previous bit length 3-6 times (2 Bits of repeat count)
  REPZ_3_10 = 17;   // repeat a zero length 3-10 times  (3 Bits of repeat count)
  REPZ_11_138 = 18; // repeat a zero length 11-138 times  (7 Bits of repeat count)

  // extra bits for each length code
  ExtraLengthBits: array[0..LENGTH_CODES - 1] of integer = (
    0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3,
    4, 4, 4, 4, 5, 5, 5, 5, 0
  );

  // extra bits for each distance code
  ExtraDistanceBits: array[0..D_CODES - 1] of integer = (
    0, 0, 0, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 5, 6, 6, 7, 7, 8, 8,
    9, 9, 10 ,10, 11, 11, 12, 12, 13, 13
  );

  // extra bits for each bit length code
  ExtraBitLengthBits: array[0..BL_CODES - 1] of integer = (
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 3, 7
  );

  // The lengths of the bit length codes are sent in order of decreasing probability,
  // to avoid transmitting the lengths for unused bit length codes.
  BitLengthOrder: array[0..BL_CODES - 1] of Byte = (
    16, 17, 18, 0, 8, 7, 9, 6, 10, 5, 11, 4, 12, 3, 13, 2, 14, 1, 15
  );

  // Number of bits used within BitsBuffer. (BitsBuffer might be implemented on more than 16 bits on some systems.)
  BufferSize = 16;

  StaticLiteralDescriptor: TStaticTreeDescriptor = (
    StaticTree: @StaticLiteralTree;  // pointer to array of TTreeEntry
    ExtraBits: @ExtraLengthBits;     // pointer to array of integer
    ExtraBase: LITERALS + 1;
    Elements: L_CODES;
    MaxLength: MAX_BITS
  );

  StaticDistanceDescriptor: TStaticTreeDescriptor = (
    StaticTree: @StaticDescriptorTree;
    ExtraBits: @ExtraDistanceBits;
    ExtraBase: 0;
    Elements: D_CODES;
    MaxLength: MAX_BITS
  );

  StaticBitLengthDescriptor: TStaticTreeDescriptor = (
    StaticTree: nil;
    ExtraBits: @ExtraBitLengthBits;
    ExtraBase: 0;
    Elements: BL_CODES;
    MaxLength: MAX_BL_BITS
  );


//----------------- Inflate support

const
  InflateMask: array[0..16] of Cardinal = (
    $0000, $0001, $0003, $0007, $000F, $001F, $003F, $007F,
    $00FF, $01FF, $03FF, $07FF, $0FFF, $1FFF, $3FFF, $7FFF, $FFFF);

function InflateFlush(var S: TInflateBlocksState; var Z: TZState; R: integer): integer;
// copies as much as possible from the sliding window to the output area
var
  N: Cardinal;
  P: PByte;
  Q: PByte;
begin
  // local copies of source and destination pointers
  P := Z.NextOutput;
  Q := S.Read;

  // compute number of bytes to copy as far as end of window
  if PtrUInt(Q) <= PtrUInt(S.Write) then
    N := PtrUInt(S.Write) - PtrUInt(Q)
  else
    N := PtrUInt(S.zend) - PtrUInt(Q);
  if N > Z.AvailableOutput then
    N := Z.AvailableOutput;
  if (N <> 0) and (R = Z_BUF_ERROR) then
    R := Z_OK;

  // update counters
  Dec(Z.AvailableOutput, N);
  Inc(Z.TotalOutput, N);

  // copy as far as end of Window
  Move(Q^, P^, N);
  Inc(P, N);
  Inc(Q, N);

  // see if more to copy at beginning of window
  if Q = S.zend then
  begin
    // wrap pointers
    Q := S.Window;
    if S.write = S.zend then
      S.write := S.Window;
    // compute bytes to copy
    N := PtrUInt(S.write) - PtrUInt(Q);
    if N > Z.AvailableOutput then
      N := Z.AvailableOutput;
    if (N <> 0) and (R = Z_BUF_ERROR) then
      R := Z_OK;
    // update counters
    Dec(Z.AvailableOutput, N);
    Inc(Z.TotalOutput, N);
    // copy
    Move(Q^, P^, N);
    Inc(P, N);
    Inc(Q, N);
  end;

  // update pointers
  Z.NextOutput := P;
  S.Read := Q;

  result := R;
end;

function InflateFast(LiteralBits, DistanceBits: Cardinal; TL, TD: PInflateHuft;
  var S: TInflateBlocksState; var Z: TZState): integer;
// Called with number of bytes left to write in window at least 258 (the maximum string length) and number of input
// bytes available at least ten. The ten bytes are six bytes for the longest length/distance pair plus four bytes for
// overloading the bit buffer.
var
  Temp: PInflateHuft;
  Extra: Cardinal;       // extra bits or operation
  BitsBuffer: Cardinal;
  K: Cardinal;           // bits in bit buffer
  P: PByte;              // input data pointer
  N: Cardinal;           // bytes available there
  Q: PByte;              // output window write pointer
  M: Cardinal;           // bytes to end of window or read pointer
  ml: Cardinal;          // mask for literal/length tree
  md: Cardinal;          // mask for distance tree
  C: Cardinal;           // bytes to copy
  D: Cardinal;           // distance back to copy from
  R: PByte;              // copy source pointer
begin
  // load input, output, bit values
  P := Z.NextInput;
  N := Z.AvailableInput;
  BitsBuffer := S.bitb;
  K := S.bitk;
  Q := S.write;
  if PtrUInt(Q) < PtrUInt(S.Read) then
    M := PtrUInt(S.read) - PtrUInt(Q) - 1
  else
    M := PtrUInt(S.zend) - PtrUInt(Q);
  // initialize masks
  ml := InflateMask[LiteralBits];
  md := InflateMask[DistanceBits];

  // do until not enough input or output space for fast loop,
  // assume called with (M >= 258) and (N >= 10)
  repeat
    // get literal/length Code
    while K < 20 do
    begin
      Dec(N);
      BitsBuffer := BitsBuffer or (cardinal(P^) shl K);
      Inc(K, 8);
      Inc(P);
    end;

    Temp := @PHuftField(TL)[BitsBuffer and ml];

    Extra := Temp.exop;
    if Extra = 0 then
    begin
      BitsBuffer := BitsBuffer shr Temp.Bits;
      Dec(K, Temp.Bits);
      Q^ := Temp.Base;
      Inc(Q);
      Dec(M);
      if (M >= 258) and (N >= 10) then
        continue
      else
        break;
    end;

    repeat
      BitsBuffer := BitsBuffer shr Temp.Bits;
      Dec(K, Temp.Bits);

      if (Extra and 16) <> 0 then
      begin
        // get extra bits for length
        Extra := Extra and 15;
        C := Temp.Base + (BitsBuffer and InflateMask[Extra]);
        BitsBuffer := BitsBuffer shr Extra;
        Dec(K, Extra);
        // decode distance base of block to copy
        while K < 15 do
        begin
          Dec(N);
          BitsBuffer := BitsBuffer or (Cardinal(P^) shl K);
          Inc(P);
          Inc(K, 8);
        end;

        Temp := @PHuftField(TD)[BitsBuffer and md];
        Extra := Temp.exop;
        repeat
          BitsBuffer := BitsBuffer shr Temp.Bits;
          Dec(K, Temp.Bits);
          if (Extra and 16) <> 0 then
          begin
            // get extra bits to add to distance base
            Extra := Extra and 15;
            while K < Extra do
            begin
              Dec(N);
              BitsBuffer := BitsBuffer or (Cardinal(P^) shl K);
              Inc(P);
              Inc(K, 8);
            end;
            D := Temp.Base + (BitsBuffer and InflateMask[Extra]);
            BitsBuffer := BitsBuffer shr Extra;
            Dec(K, Extra);
            // do the copy
            Dec(M, C);
            // offset before Dest
            if (PtrUInt(Q) - PtrUInt(S.Window)) >= D then
            begin
              // copy without extra
              R := Q;
              Dec(R, D);
            end
            else
            begin
              // offset after destination,
              // bytes from offset to end
              Extra := D - (PtrUInt(Q) - PtrUInt(S.Window));
              R := S.zend;
              // pointer to offset
              Dec(R, Extra);
              if C > Extra then
              begin
                // copy to end of window
                Dec(C, Extra);
                MoveWithOverlap(R, Q, Extra);
                inc(Q, Extra);
                // copy rest from start of window
                R := S.Window;
              end;
            end;
            // copy all or what's left
            Extra := C; // optimize generated code
            MoveWithOverlap(R, Q, Extra);
            inc(Q,Extra);
            Break;
          end
          else if (Extra and 64) = 0 then
          begin
            Inc(Temp, Temp.Base + (BitsBuffer and InflateMask[Extra]));
            Extra := Temp.exop;
          end
          else
          begin
            C := Z.AvailableInput - N;
            if (K shr 3) < C then
              C := K shr 3;
            Inc(N, C);
            Dec(P, C);
            Dec(K, C shl 3);
            S.bitb := BitsBuffer;
            S.bitk := K;
            Z.AvailableInput := N;
            Inc(Z.TotalInput, PtrUInt(P) - PtrUInt(Z.NextInput));
            Z.NextInput := P;
            S.write := Q;
            result := Z_DATA_ERROR;
            exit;
          end;
        until False;
        Break;
      end;

      if (Extra and 64) = 0 then
      begin
        Inc(Temp, Temp.Base + (BitsBuffer and InflateMask[Extra]));
        Extra := Temp.exop;
        if Extra = 0 then
        begin
          BitsBuffer := BitsBuffer shr Temp.Bits;
          Dec(K, Temp.Bits);
          Q^ := Temp.Base;
          Inc(Q);
          Dec(M);
          Break;
        end;
      end
      else if (Extra and 32) <> 0 then
      begin
        C := Z.AvailableInput - N;
        if (K shr 3) < C then
          C := K shr 3;
        Inc(N, C);
        Dec(P, C);
        Dec(K, C shl 3);
        S.bitb := BitsBuffer;
        S.bitk := K;
        Z.AvailableInput := N;
        Inc(Z.TotalInput, PtrUInt(P) - PtrUInt(Z.NextInput));
        Z.NextInput := P;
        S.write := Q;
        result := Z_STREAM_END;
        exit;
      end
      else
      begin
        C := Z.AvailableInput - N;
        if (K shr 3) < C then
          C := K shr 3;
        Inc(N, C);
        Dec(P, C);
        Dec(K, C shl 3);
        S.bitb := BitsBuffer;
        S.bitk := K;
        Z.AvailableInput := N;
        Inc(Z.TotalInput, PtrUInt(P) - PtrUInt(Z.NextInput));
        Z.NextInput := P;
        S.write := Q;
        result := Z_DATA_ERROR;
        exit;
      end;
    until False;
    if (M < 258) or (N < 10) then
      break;
  until false;

  // not enough input or output -> restore pointers and return
  C := Z.AvailableInput - N;
  if (K shr 3) < C then
    C := K shr 3;
  Inc(N, C);
  Dec(P, C);
  Dec(K, C shl 3);
  S.bitb := BitsBuffer;
  S.bitk := K;
  Z.AvailableInput := N;
  Inc(Z.TotalInput, PtrUInt(P) - PtrUInt(Z.NextInput));
  Z.NextInput := P;
  S.write := Q;
  result := Z_OK;
end;

function InflateCodesNew(LiteralBits: Cardinal; DistanceBits: Cardinal; TL, TD:
  PInflateHuft; var Z: TZState): PInflateCodesState;
begin
  GetMem(result, SizeOf(TInflateCodesState));
  result.Mode := icmStart;
  result.LiteralTreeBits := LiteralBits;
  result.DistanceTreeBits := DistanceBits;
  result.LiteralTree := TL;
  result.DistanceTree := TD;
end;

function InflateCodes(var S: TInflateBlocksState; var Z: TZState; R: integer): integer;
var
  J: Cardinal;          // temporary storage
  Temp: PInflateHuft;
  Extra: Cardinal;      // extra bits or operation
  BitsBuffer: Cardinal;
  K: Cardinal;          // bits in bit buffer
  P: PByte;             // input data pointer
  N: Cardinal;          // bytes available there
  Q: PByte;             // output window write pointer
  M: Cardinal;          // bytes to end of window or read pointer
  F: PByte;             // pointer to copy strings from
  C: PInflateCodesState;
begin
  C := S.sub.decode.codes;  // codes state

  // copy input/output information to locals
  P := Z.NextInput;
  N := Z.AvailableInput;
  BitsBuffer := S.bitb;
  K := S.bitk;
  Q := S.write;
  if PtrUInt(Q) < PtrUInt(S.read) then
    M := PtrUInt(S.read) - PtrUInt(Q) - 1
  else
    M := PtrUInt(S.zend) - PtrUInt(Q);

  // process input and output based on current state
  while True do
  begin
    case C.Mode of
      icmStart:
        begin
          if (M >= 258) and (N >= 10) then
          begin
            S.bitb := BitsBuffer;
            S.bitk := K;
            Z.AvailableInput := N;
            Inc(Z.TotalInput, PtrUInt(P) - PtrUInt(Z.NextInput));
            Z.NextInput := P;
            S.write := Q;

            R := InflateFast(C.LiteralTreeBits, C.DistanceTreeBits, C.LiteralTree,
              C.DistanceTree, S, Z);
            P := Z.NextInput;
            N := Z.AvailableInput;
            BitsBuffer := S.bitb;
            K := S.bitk;
            Q := S.write;
            if PtrUInt(Q) < PtrUInt(S.read) then
              M := PtrUInt(S.read) - PtrUInt(Q) - 1
            else
              M := PtrUInt(S.zend) - PtrUInt(Q);
            if R <> Z_OK then
            begin
              if R = Z_STREAM_END then
                C.mode := icmWash
              else
                C.mode := icmBadCode;
              Continue;
            end;
          end;
          C.sub.Code.need := C.LiteralTreeBits;
          C.sub.Code.Tree := C.LiteralTree;
          C.mode := icmLen;
        end;
      icmLen: // I: get length/literal/eob next
        begin
          J := C.sub.Code.need;
          while K < J do
          begin
            if N <> 0 then
              R := Z_OK
            else
            begin
              S.bitb := BitsBuffer;
              S.bitk := K;
              Z.AvailableInput := N;
              Inc(Z.TotalInput, PtrUInt(P) - PtrUInt(Z.NextInput));
              Z.NextInput := P;
              S.write := Q;
              result := InflateFlush(S, Z, R);
              exit;
            end;
            Dec(N);
            BitsBuffer := BitsBuffer or (Cardinal(P^) shl K);
            Inc(P);
            Inc(K, 8);
          end;
          Temp := C.sub.Code.Tree;
          Inc(Temp, Cardinal(BitsBuffer) and InflateMask[J]);
          BitsBuffer := BitsBuffer shr Temp.Bits;
          Dec(K, Temp.Bits);

          Extra := Temp.exop;
          // literal
          if Extra = 0 then
          begin
            C.sub.lit := Temp.Base;
            C.mode := icmLit;
            Continue;
          end;
          // length
          if (Extra and 16) <> 0 then
          begin
            C.sub.copy.get := Extra and 15;
            C.Len := Temp.Base;
            C.mode := icmLenNext;
            Continue;
          end;
          // next table
          if (Extra and 64) = 0 then
          begin
            C.sub.Code.need := Extra;
            C.sub.Code.Tree := @PHuftField(Temp)[Temp.Base];
            Continue;
          end;
          // end of block
          if (Extra and 32) <> 0 then
          begin
            C.mode := icmWash;
            Continue;
          end;
          // invalid code
          C.mode := icmBadCode;
          R := Z_DATA_ERROR;
          S.bitb := BitsBuffer;
          S.bitk := K;
          Z.AvailableInput := N;
          Inc(Z.TotalInput, PtrUInt(P) - PtrUInt(Z.NextInput));
          Z.NextInput := P;
          S.write := Q;
          result := InflateFlush(S, Z, R);
          exit;
        end;
      icmLenNext: // I: getting length extra (have base)
        begin
          J := C.sub.copy.get;
          while K < J do
          begin
            if N <> 0 then
              R := Z_OK
            else
            begin
              S.bitb := BitsBuffer;
              S.bitk := K;
              Z.AvailableInput := N;
              Inc(Z.TotalInput, PtrUInt(P) - PtrUInt(Z.NextInput));
              Z.NextInput := P;
              S.write := Q;
              result := InflateFlush(S, Z, R);
              exit;
            end;
            Dec(N);
            BitsBuffer := BitsBuffer or (Cardinal(P^) shl K);
            Inc(P);
            Inc(K, 8);
          end;
          Inc(C.Len, Cardinal(BitsBuffer and InflateMask[J]));
          BitsBuffer := BitsBuffer shr J;
          Dec(K, J);
          C.sub.Code.need := C.DistanceTreeBits;
          C.sub.Code.Tree := C.DistanceTree;
          C.mode := icmDistance;
        end;
      icmDistance: // I: get distance next
        begin
          J := C.sub.Code.need;
          while K < J do
          begin
            if N <> 0 then
              R := Z_OK
            else
            begin
              S.bitb := BitsBuffer;
              S.bitk := K;
              Z.AvailableInput := N;
              Inc(Z.TotalInput, PtrUInt(P) - PtrUInt(Z.NextInput));
              Z.NextInput := P;
              S.write := Q;
              result := InflateFlush(S, Z, R);
              exit;
            end;
            Dec(N);
            BitsBuffer := BitsBuffer or (PtrUInt(P^) shl K);
            Inc(P);
            Inc(K, 8);
          end;
          Temp := @PHuftField(C.sub.Code.Tree)[BitsBuffer and InflateMask[J]];
          BitsBuffer := BitsBuffer shr Temp.Bits;
          Dec(K, Temp.Bits);

          Extra := Temp.exop;
          // distance
          if (Extra and 16) <> 0 then
          begin
            C.sub.copy.get := Extra and 15;
            C.sub.copy.Distance := Temp.Base;
            C.mode := icmDistExt;
            Continue;
          end;
          // next table
          if (Extra and 64) = 0 then
          begin
            C.sub.Code.need := Extra;
            C.sub.Code.Tree := @PHuftField(Temp)[Temp.Base];
            Continue;
          end;
          // invalid code
          C.mode := icmBadCode;
          R := Z_DATA_ERROR;
          S.bitb := BitsBuffer;
          S.bitk := K;
          Z.AvailableInput := N;
          Inc(Z.TotalInput, PtrUInt(P) - PtrUInt(Z.NextInput));
          Z.NextInput := P;
          S.write := Q;
          result := InflateFlush(S, Z, R);
          exit;
        end;
      icmDistExt: // I: getting distance extra
        begin
          J := C.sub.copy.get;
          while K < J do
          begin
            if N <> 0 then
              R := Z_OK
            else
            begin
              S.bitb := BitsBuffer;
              S.bitk := K;
              Z.AvailableInput := N;
              Inc(Z.TotalInput, PtrUInt(P) - PtrUInt(Z.NextInput));
              Z.NextInput := P;
              S.write := Q;
              result := InflateFlush(S, Z, R);
              exit;
            end;
            Dec(N);
            BitsBuffer := BitsBuffer or (Cardinal(P^) shl K);
            Inc(P);
            Inc(K, 8);
          end;
          Inc(C.sub.copy.Distance, Cardinal(BitsBuffer) and InflateMask[J]);
          BitsBuffer := BitsBuffer shr J;
          Dec(K, J);
          C.mode := icmCopy;
        end;
      icmCopy: // O: copying bytes in window, waiting for space
        begin
          F := Q;
          Dec(F, C.sub.copy.Distance);
          if (PtrUInt(Q) - PtrUInt(S.Window)) < C.sub.copy.Distance then
          begin
            F := S.zend;
            Dec(F, C.sub.copy.Distance - (PtrUInt(Q) - PtrUInt(S.Window)));
          end;

          while C.Len <> 0 do
          begin
            if M = 0 then
            begin
              if (Q = S.zend) and (S.read <> S.Window) then
              begin
                Q := S.Window;
                if PtrUInt(Q) < PtrUInt(S.read) then
                  M := PtrUInt(S.read) - PtrUInt(Q) - 1
                else
                  M := PtrUInt(S.zend) - PtrUInt(Q);
              end;
              if M = 0 then
              begin
                S.write := Q;
                R := InflateFlush(S, Z, R);
                Q := S.write;
                if PtrUInt(Q) < PtrUInt(S.read) then
                  M := PtrUInt(S.read) - PtrUInt(Q) - 1
                else
                  M := PtrUInt(S.zend) - PtrUInt(Q);
                if (Q = S.zend) and (S.read <> S.Window) then
                begin
                  Q := S.Window;
                  if PtrUInt(Q) < PtrUInt(S.read) then
                    M := PtrUInt(S.read) - PtrUInt(Q) - 1
                  else
                    M := PtrUInt(S.zend) - PtrUInt(Q);
                end;
                if M = 0 then
                begin
                  S.bitb := BitsBuffer;
                  S.bitk := K;
                  Z.AvailableInput := N;
                  Inc(Z.TotalInput, PtrUInt(P) - PtrUInt(Z.NextInput));
                  Z.NextInput := P;
                  S.write := Q;
                  result := InflateFlush(S, Z, R);
                  exit;
                end;
              end;
            end;
            R := Z_OK;
            Q^ := F^;
            Inc(Q);
            Inc(F);
            Dec(M);
            if (F = S.zend) then
              F := S.Window;
            Dec(C.Len);
          end;
          C.mode := icmStart;
        end;
      icmLit: // O: got literal, waiting for output space
        begin
          if M = 0 then
          begin
            if (Q = S.zend) and (S.read <> S.Window) then
            begin
              Q := S.Window;
              if PtrUInt(Q) < PtrUInt(S.read) then
                M := PtrUInt(S.read) - PtrUInt(Q) - 1
              else
                M := PtrUInt(S.zend) - PtrUInt(Q);
            end;
            if M = 0 then
            begin
              S.write := Q;
              R := InflateFlush(S, Z, R);
              Q := S.write;
              if PtrUInt(Q) < PtrUInt(S.read) then
                M := PtrUInt(S.read) - PtrUInt(Q) - 1
              else
                M := PtrUInt(S.zend) - PtrUInt(Q);
              if (Q = S.zend) and (S.read <> S.Window) then
              begin
                Q := S.Window;
                if PtrUInt(Q) < PtrUInt(S.read) then
                  M := PtrUInt(S.read) - PtrUInt(Q) - 1
                else
                  M := PtrUInt(S.zend) - PtrUInt(Q);
              end;
              if M = 0 then
              begin
                S.bitb := BitsBuffer;
                S.bitk := K;
                Z.AvailableInput := N;
                Inc(Z.TotalInput, PtrUInt(P) - PtrUInt(Z.NextInput));
                Z.NextInput := P;
                S.write := Q;
                result := InflateFlush(S, Z, R);
                exit;
              end;
            end;
          end;
          R := Z_OK;
          Q^ := C.sub.lit;
          Inc(Q);
          Dec(M);
          C.mode := icmStart;
        end;
      icmWash: // O: got eob, possibly More output
        begin
          // return unused byte, if any
          if K > 7 then
          begin
            Dec(K, 8);
            Inc(N);
            Dec(P);
            // can always return one
          end;
          S.write := Q;
          R := InflateFlush(S, Z, R);
          Q := S.write;
          if PtrUInt(Q) < PtrUInt(S.read) then
            M := PtrUInt(S.read) - PtrUInt(Q) - 1
          else
            M := PtrUInt(S.zend) - PtrUInt(Q);
          if S.read <> S.write then
          begin
            S.bitb := BitsBuffer;
            S.bitk := K;
            Z.AvailableInput := N;
            Inc(Z.TotalInput, PtrUInt(P) - PtrUInt(Z.NextInput));
            Z.NextInput := P;
            S.write := Q;
            result := InflateFlush(S, Z, R);
            exit;
          end;
          C.mode := icmZEnd;
        end;
      icmZEnd:
        begin
          R := Z_STREAM_END;
          S.bitb := BitsBuffer;
          S.bitk := K;
          Z.AvailableInput := N;
          Inc(Z.TotalInput, PtrUInt(P) - PtrUInt(Z.NextInput));
          Z.NextInput := P;
          S.write := Q;
          result := InflateFlush(S, Z, R);
          exit;
        end;
      icmBadCode: // X: got error
        begin
          R := Z_DATA_ERROR;
          S.bitb := BitsBuffer;
          S.bitk := K;
          Z.AvailableInput := N;
          Inc(Z.TotalInput, PtrUInt(P) - PtrUInt(Z.NextInput));
          Z.NextInput := P;
          S.write := Q;
          result := InflateFlush(S, Z, R);
          exit;
        end;
    else
      begin
        R := Z_STREAM_ERROR;
        S.bitb := BitsBuffer;
        S.bitk := K;
        Z.AvailableInput := N;
        Inc(Z.TotalInput, PtrUInt(P) - PtrUInt(Z.NextInput));
        Z.NextInput := P;
        S.write := Q;
        result := InflateFlush(S, Z, R);
        exit;
      end;
    end;
  end;
end;

type
  TDeflateLengths = array[0..30] of Cardinal;
  TDeflateWorkArea = array[0..287] of Cardinal;

const
  // Maximum Size of dynamic tree. The maximum found in an integer but non-exhaustive search was 1004 huft structures
  // (850 for length/literals and 154 for distances, the latter actually the result of an exhaustive search).
  // The actual maximum is not known, but the value below is more than safe.
  MANY = 1440;

  // Tables for deflate from PKZIP'S appnote.txt
  // copy lengths for literal codes 257..285 (actually lengths - 2; also see note #13 above about 258)
  CopyLengths: TDeflateLengths = (3, 4, 5, 6, 7, 8, 9, 10, 11, 13, 15,
    17, 19, 23, 27, 31, 35, 43, 51, 59, 67, 83, 99, 115, 131, 163, 195,
    227, 258, 0, 0);
  INVALID_CODE = 112;
  // extra bits for literal codes 257..285
  CopyLiteralExtra: TDeflateLengths = (0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1,
    1, 2, 2, 2, 2, 3, 3, 3, 3, 4, 4, 4, 4, 5, 5, 5, 5, 0, INVALID_CODE, INVALID_CODE);

  // copy offsets for distance codes 0..29
  CopyOffsets: TDeflateLengths = (1, 2, 3, 4, 5, 7, 9, 13, 17, 25, 33,
    49, 65, 97, 129, 193, 257, 385, 513, 769, 1025, 1537, 2049, 3073, 4097, 6145,
    8193, 12289, 16385, 24577, 0);

  // extra bits for distance codes
  CopyExtra: TDeflateLengths = (0, 0, 0, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5,
    5, 6, 6, 7, 7, 8, 8, 9, 9, 10, 10, 11, 11, 12, 12, 13, 13, 0);

  // Huffman code decoding is performed using a multi-Level table lookup.
  // Fastest way to decode is to simply build a lookup table whose
  // size is determined by the longest code. However, the time it takes
  // to build this table can also be a factor if the data being decoded
  // is not very integer. The most common codes are necessarily the
  // shortest codes so those codes dominate the decoding time and hence
  // the speed. The idea is you can have a shorter table that decodes the
  // shorter, More probable codes, and then point to subsidiary tables for
  // the longer codes. The time it costs to decode the longer codes is
  // then traded against the time it takes to make longer tables.
  //
  // This results of this trade are in the variables LiteralTreeBits and DistanceTreeBits
  // below. LiteralTreeBits is the number of bits the first level table for literal/
  // length codes can decode in one step, and DistanceTreeBits is the same thing for
  // the distance codes. Subsequent tables are also less than or equal to those sizes.
  // These values may be adjusted either when all of the
  // codes are shorter than that, in which case the longest code length in
  // bits is used, or when the shortest code is *longer* than the requested
  // table size, in which case the length of the shortest code in bits is used.
  //
  // There are two different values for the two tables, since they code a
  // different number of possibilities each. The literal/length table
  // codes 286 possible values, or in a flat code, a little over eight
  // bits. The distance table codes 30 possible values, or a little less
  // than five bits, flat. The optimum values for speed end up being
  // about one bit more than those, so LiteralTreeBits is 8 + 1 and DistanceTreeBits is 5 + 1.
  // The optimum values may differ though from machine to machine, and possibly even between compilers.

const
  // maximum bit length of any code,
  // If BMAX needs to be larger than 16, then H and X[] should be Cardinal.
  BMAX = 15;

function BuildHuffmanTables(const B: TACardinal; N, S: Cardinal; const D,
  Extra: TDeflateLengths; Temp: PPInflateHuft; var M: Cardinal; HP: PHuftField;
  var HN: Cardinal; var V: TDeflateWorkArea): integer;

// Given a list of code lengths and a maximum table size, make a set of tables to decode that set of codes. Returns Z_OK
// on success, Z_BUF_ERROR if the given code set is incomplete (the tables are still built in this case), Z_DATA_ERROR
// if the input is invalid (an over-subscribed set of lengths), or Z_MEM_ERROR if not enough memory.
//
// Input parameters:
// B contains the code lenths in bits (all assumed <= BMAX)
// N is the number of codes (<= NMAX)
// S is the number of simple valued codes (0..S - 1)
// D contains a list of base values for non-simple codes
// Extra carries a list of extra bits for non-simple codes
//
// Output parameters:
// Temp points to the starting table
// M receives the maxium lookup bits (actual space for trees)
// HP receives the Huffman tables
// while HN decribes how many of HP is actually used
// finally V is a working area which receives values in order of bit length

var
  A: Cardinal;                     // counter for codes of length K
  F: Cardinal;                     // I repeats in table every F entries
  G: integer;                      // maximum code Length
  H: integer;                      // table Level
  I: Cardinal;                     // counter, current code
  J: Cardinal;                     // counter
  K: integer;                      // number of bits in current code
  L: integer;			                 // bits per table (returned in M)
  Mask: Cardinal;                  // (1 shl W) - 1, to avoid cc - O bug on HP
  P: TPCardinal;                   // pointer into C[], B[], or V[]
  Q: PInflateHuft;                 // points to current table
  R: TInflateHuft;                 // table entry for structure assignment
  XP: TPCardinal;                  // pointer into X
  Y: integer;                      // number of dummy codes added
  Z: Cardinal;                     // number of entries in current table
  W: integer;                      // bits before this table = (L * H)
  C: array[0..BMAX] of Cardinal;   // bit length count table
  U: array[0..BMAX - 1] of PInflateHuft; // table stack
  X: array[0..BMAX] of Cardinal;   // bit offsets, then code stack
begin
  // generate counts for each bit length
  FillChar(C, SizeOf(C), 0);

  // assume all entries <= BMAX
  for I := 0 to N - 1 do
    Inc(C[B[I]]);

  // nil input -> all zero length codes
  if C[0] = N then
  begin
    Temp^ := nil;
    M := 0;
    result := Z_OK;
    exit;
  end;

  // find minimum and maximum length, bound [M] by those
  L := M;
  for J := 1 to BMAX do
    if C[J] <> 0 then
      Break;
  // minimum code Length
  K := J;
  if Cardinal(L) < J then
    L := J;
  for I := BMAX downto 1 do
    if C[I] <> 0 then
      Break;
  // maximum code length
  G := I;
  if Cardinal(L) > I then
    L := I;
  M := L;

  // adjust last length count to fill out codes if needed
  Y := 1 shl J;
  while J < I do
  begin
    Dec(Y, C[J]);
    if Y < 0 then
    begin
      // bad input: more codes than bits
      result := Z_DATA_ERROR;
      exit;
    end;
    Inc(J);
    Y := Y shl 1;
  end;
  Dec(Y, C[I]);
  if Y < 0 then
  begin
    // bad input: more codes than bits
    result := Z_DATA_ERROR;
    exit;
  end;
  Inc(C[I], Y);

  // generate starting offsets into the value table for each length
  X[1] := 0;
  J := 0;
  for I := 1 to G - 1 do
  begin
    inc(J, C[I]);
    X[I + 1] := J;
  end;

  // make a table of values in order of bit lengths
  for I := 0 to N - 1 do begin
    J := B[I];
    if J <> 0 then begin
      V[X[J]] := I;
      Inc(X[J]);
    end;
  end;
  // set N to Length of V
  N := X[G];

  // generate the Huffman codes and for each make the table entries
  I := 0;
  // first Huffman code is zero
  X[0] := 0;
  // grab values in bit order
  P := @V;
  // no tables yet -> Level - 1
  H := -1;
  // bits decoded = (L * H)
  W := -L;

  U[0] := nil;
  Q := nil;
  Z := 0;

  // go through the bit lengths (K already is bits in shortest code)
  while K <= G do begin
    A := C[K];
    while A <> 0 do begin
      Dec(A);
      // here I is the Huffman code of length K bits for value P^
      // make tables up to required level
      while K > W + L do begin
        Inc(H);
        // add bits already decoded, previous table always L Bits
        Inc(W, L);
        // compute minimum size table less than or equal to L bits
        Z := G - W;
        if Z > Cardinal(L) then
          Z := L;

        // try a K - W bit table
        J := K - W;
        F := 1 shl J;
        // too few codes for K - W bit table
        if F > A + 1 then begin
          // deduct codes from patterns left
          Dec(F, A + 1);
          XP := @C[K];
          if J < Z then begin
            Inc(J);
            while J < Z do begin
              // try smaller tables up to Z bits
              F := F shl 1;
              Inc(XP);
              // enough codes to use up J Bits
              if F <= XP^ then
                Break;
              // else deduct codes from patterns
              Dec(F, XP^);
              Inc(J);
            end;
          end;
        end;

        // table entries for J-bit table
        Z := 1 shl J;
        // allocate new table (note: doesn't matter for fixed)
        if HN + Z > MANY then begin
          result := Z_MEM_ERROR;
          exit;
        end;

        Q := @HP[HN];
        U[H] := Q;
        Inc(HN, Z);

        // connect to last table, if there is one
        if H <> 0 then begin
          // save pattern for backing up
          X[H] := I;
          // bits to dump before this table
          R.Bits := L;
          // bits in this table
          R.exop := J;
          J := I shr (W - L);
          R.Base := (PtrUInt(Q) - PtrUInt(U[H - 1])) div SizeOf(Q^) - J;
          // connect to last table
          PHuftField(U[H - 1])[J] := R;
        end
        else
          // first table is returned result
          Temp^ := Q;
      end;

      // set up table entry in R
      R.Bits := Byte(K - W);

      // out of values -> invalid code
      if PtrUInt(P) >= PtrUInt(@V[N]) then
        R.exop := 128 + 64
      else if P^ < S then begin
          // 256 is end-of-block code
        if P^ < 256 then
          R.exop := 0
        else
          R.exop := 32 + 64;
          // simple code is just the value
        R.Base := P^;
        Inc(P);
      end
      else begin
          // non-simple -> look up in lists
        R.exop := Byte(Extra[P^ - S] + 16 + 64);
        R.Base := D[P^ - S];
        Inc(P);
      end;

      // fill xode-like entries with R
      F := 1 shl (K - W);
      J := I shr W;
      while J < Z do begin
        PHuftField(Q)[J] := R;
        Inc(J, F);
      end;

      // backwards increment the K-bit code I
      J := 1 shl (K - 1);
      while (I and J) <> 0 do begin
        I := I xor J;
        J := J shr 1
      end;
      I := I xor J;

      // backup over finished tables
      // needed on HP, cc -O bug
      Mask := (1 shl W) - 1;
      while (I and Mask) <> X[H] do begin
        // don't need to update Q
        Dec(H);
        Dec(W, L);
        Mask := (1 shl W) - 1;
      end;
    end;
    Inc(K);
  end;

  // Return Z_BUF_ERROR if we were given an incomplete table
  if (Y <> 0) and (G <> 1) then
    result := Z_BUF_ERROR
  else
    result := Z_OK;
end;

function InflateTreesBits(var C: TACardinal; var BB: Cardinal; var TB:
  PInflateHuft; HP: PHuftField; var Z: TZState): integer;
// C holds 19 code lengths
// BB - bits tree desired/actual depth
// TB - bits tree result
// HP - space for trees
// Z - for messages
var
  R: integer;
  HN: Cardinal;            // hufts used in space
  V: TDeflateWorkArea;     // work area for BuildHuffmanTables
begin
  HN := 0;
  R := BuildHuffmanTables(C, 19, 19, CopyLengths, CopyLiteralExtra, @TB, BB, HP, HN, V);
  if (R = Z_BUF_ERROR) or (BB = 0) then
    R := Z_DATA_ERROR;
  result := R;
end;

function InflateTreesDynamic(NL: Cardinal; ND: Cardinal; var C: TACardinal;
  var LiteralBits: Cardinal; var DistanceBits: Cardinal; var TL: PInflateHuft;
  var TD: PInflateHuft; HP: PHuftField; var Z: TZState): integer;
// NL - number of literal/length codes
// ND - number of distance codes
// C - code lengths
// LiteralBits - literal desired/actual bit depth
// DistanceBits - distance desired/actual bit depth
// TL - literal/length tree result
// TD - distance tree result
// HP - space for trees
// Z - for messages
var
  R: integer;
  HN: Cardinal;          // hufts used in space
  V: TDeflateWorkArea;   // work area for BuildHuffmanTables
begin
  HN := 0;
  // allocate work area
  result := Z_OK;
  // build literal/length tree
  R := BuildHuffmanTables(C, NL, 257, CopyLengths, CopyLiteralExtra, @TL,
    LiteralBits, HP, HN, V);
  if (R <> Z_OK) or (LiteralBits = 0) then begin
    result := R;
    exit;
  end;
  // build distance tree
  R := BuildHuffmanTables(TPACardinal(@C[NL])^, ND, 0, CopyOffsets, CopyExtra, @TD,
    DistanceBits, HP, HN, V);
  if (R <> Z_OK) or ((DistanceBits = 0) and (NL > 257)) then begin
    if R = Z_BUF_ERROR then
      R := Z_DATA_ERROR
    else if R <> Z_MEM_ERROR then
      R := Z_DATA_ERROR;
    result := R;
  end;
end;

const
  // number of hufts used by fixed tables
  FIXEDH = 544;

var
  // build fixed tables only once -> keep them here
  FixedBuild: boolean;
  FixedTablesMemory: array[0..FIXEDH - 1] of TInflateHuft;
  FixedLiteralBits: Cardinal;
  FixedDistanceBits: Cardinal;
  FixedLiteralTable: array[0..288 - 1] of TInflateHuft;
  FixedDistanceTable: array[0..32 - 1] of TInflateHuft;

function InflateTreesFixed(var LiteralBits: Cardinal; var DistanceBits: Cardinal;
  var TL, TD: PInflateHuft; var Z: TZState): integer;
var
  K: integer;             // temporary variable
  C: TDeflateWorkArea;    // length list for BuildHuffmanTables
  V: TDeflateWorkArea;    // work area for BuildHuffmanTables
  F: Cardinal;            // number of hufts used in FixedTablesMemory
begin
  // build fixed tables if not already (multiple overlapped executions ok)
  if not FixedBuild then begin
    F := 0;
    // literal table
    for K := 0 to 143 do
      C[K] := 8;
    for K := 144 to 255 do
      C[K] := 9;
    for K := 256 to 279 do
      C[K] := 7;
    for K := 280 to 287 do
      C[K] := 8;
    FixedLiteralBits := 9;
    BuildHuffmanTables(TPACardinal(@C)^, 288, 257, CopyLengths, CopyLiteralExtra, @FixedLiteralTable,
      FixedLiteralBits, @FixedTablesMemory, F, V);
    // distance table
    for K := 0 to 29 do
      C[K] := 5;
    FixedDistanceBits := 5;
    BuildHuffmanTables(TPACardinal(@C)^, 30, 0, CopyOffsets, CopyExtra, @FixedDistanceTable,
      FixedDistanceBits, @FixedTablesMemory, F, V);
    FixedBuild := True;
  end;
  LiteralBits := FixedLiteralBits;
  DistanceBits := FixedDistanceBits;
  TL := @FixedLiteralTable;
  TD := @FixedDistanceTable;
  result := Z_OK;
end;


// tables for Deflate from PKZIP'S appnote.txt.
const
  // order of the bit length code lengths
  BitOrder: array[0..18] of byte = (16, 17, 18, 0, 8, 7, 9, 6, 10, 5, 11, 4, 12,
    3, 13, 2, 14, 1, 15);

// Notes beyond the 1.93a appnote.txt:
// 1. Distance pointers never point before the beginning of the output stream.
// 2. Distance pointers can point back across blocks, up to 32k away.
// 3. There is an implied maximum of 7 Bits for the bit Length table and 15 Bits for the actual data.
// 4. if only one Code exists, then it is encoded using one bit. (zero would be more efficient, but perhaps a little
//    confusing.) If two codes exist, they are coded using one bit each (0 and 1).
// 5. There is no way of sending zero distance codes -> a dummy must be sent if there are none. (History: a pre 2.0
//    Version of PKZIP would store blocks with no distance codes, but this was discovered to be
//    too harsh a criterion.) Valid only for 1.93a. 2.04c does allow zero distance codes, which is sent as one Code of
//    zero Bits in length.
// 6. There are up to 286 literal/Length codes. Code 256 represents the end-of-block. Note however that the static
//    length Tree defines 288 codes just to fill out the Huffman codes. Codes 286 and 287 cannot be used though, since
//    there is no length base or extra bits defined for them. Similarily, there are up to 30 distance codes. However,
//    static trees defines 32 codes (all 5 Bits) to fill out the Huffman codes, but the last two had better not show up
//    in the data.
// 7. Unzip can check dynamic Huffman blocks for complete code sets. The exception is that a single code would not be
//    complete (see #4).
// 8. The five Bits following the block type is really the number of literal codes sent minus 257.
// 9. Length codes 8, 16, 16 are interpreted as 13 Length codes of 8 bits (1 + 6 + 6). Therefore, to output three times
//    the length, you output three codes (1 + 1 + 1), whereas to output four times the same length,
//    you only need two codes (1+3).  Hmm.
// 10. In the tree reconstruction algorithm, Code = Code + Increment only if BitLength(I) is not zero (pretty obvious).
// 11. Correction: 4 Bits: # of Bit Length codes - 4 (4 - 19)
// 12. Note: length code 284 can represent 227 - 258, but length code 285 really is 258. The last length deserves its
//     own, short code since it gets used a lot in very redundant files. The length 258 is special since 258 - 3 (the
//     min match length) is 255.
// 13. The literal/length and distance code bit lengths are read as a single stream of lengths.  It is possible (and
//     advantageous) for a repeat code (16, 17, or 18) to go across the boundary between the two sets of lengths.

procedure InflateBlockReset(var S: TInflateBlocksState; var Z: TZState);
begin
  if (S.mode = ibmBitTree) or (S.mode = ibmDistTree) then
    FreeMem(S.sub.trees.blens);
  if S.mode = ibmCodes then
    FreeMem(S.sub.decode.codes);

  S.mode := ibmZType;
  S.bitk := 0;
  S.bitb := 0;

  S.write := S.Window;
  S.read := S.Window;
end;

function InflateBlocksNew(var Z: TZState; W: Cardinal): PInflateBlocksState;
// W is the window size
var
  S: PInflateBlocksState;
begin
  GetMem(S, SizeOf(TInflateBlocksState));
  if S = nil then
    result := S
  else
  try
    GetMem(S.hufts, SizeOf(TInflateHuft) * MANY);
    GetMem(S.Window, W);
    S.zend := S.Window;
    Inc(S.zend, W);
    S.mode := ibmZType;
    InflateBlockReset(S^, Z);
    result := S;
  except
    if Assigned(S.Window) then
      FreeMem(S.Window);
    if Assigned(S.hufts) then
      FreeMem(S.hufts);
    FreeMem(S);
    raise;
  end;
end;

function InflateBlocks(var S: TInflateBlocksState; var Z: TZState; R: integer): integer;
// R contains the initial return code
var
  Temp: Cardinal;
  B: Cardinal;    // bit buffer
  K: Cardinal;    // bits in bit buffer
  P: PByte;       // input data pointer
  N: Cardinal;    // bytes available there
  Q: PByte;       // output Window write pointer
  M: Cardinal;    // bytes to end of window or read pointer
  // fixed code blocks
  LiteralBits, DistanceBits: Cardinal;
  TL, TD: PInflateHuft;
  H: PInflateHuft;
  I, J, C: Cardinal;
  CodeState: PInflateCodesState;

  function UpdatePointers: integer;
  begin
    S.bitb := B;
    S.bitk := K;
    Z.AvailableInput := N;
    Inc(Z.TotalInput, PtrUInt(P) - PtrUInt(Z.NextInput));
    Z.NextInput := P;
    S.write := Q;
    result := InflateFlush(S, Z, R);
  end;

begin
  // copy input/output information to locals
  P := Z.NextInput;
  N := Z.AvailableInput;
  B := S.bitb;
  K := S.bitk;
  Q := S.write;
  if PtrUInt(Q) < PtrUInt(S.read) then
    M := PtrUInt(S.read) - PtrUInt(Q) - 1
  else
    M := PtrUInt(S.zend) - PtrUInt(Q);
  // decompress an inflated block
  // process input based on current state
  while True do begin
    case S.mode of
      ibmZType:
        begin
          while K < 3 do begin
            if N <> 0 then
              R := Z_OK
            else begin
              result := UpdatePointers;
              exit;
            end;
            Dec(N);
            B := B or (Cardinal(P^) shl K);
            Inc(P);
            Inc(K, 8);
          end;

          Temp := B and 7;
          S.last := boolean(Temp and 1);
          case Temp shr 1 of
            0: // stored
              begin
                B := B shr 3;
                Dec(K, 3);
                // go to byte boundary
                Temp := K and 7;
                B := B shr Temp;
                Dec(K, Temp);
                // get length of stored block
                S.mode := ibmLens;
              end;
            1: // fixed
              begin
                InflateTreesFixed(LiteralBits, DistanceBits, TL, TD, Z);
                S.sub.decode.codes := InflateCodesNew(LiteralBits, DistanceBits,
                  TL, TD, Z);
                if S.sub.decode.codes = nil then begin
                  R := Z_MEM_ERROR;
                  result := UpdatePointers;
                  exit;
                end;
                B := B shr 3;
                Dec(K, 3);
                S.mode := ibmCodes;
              end;
            2: // dynamic
              begin
                B := B shr 3;
                Dec(K, 3);
                S.mode := ibmTable;
              end;
            3: // illegal
              begin
                B := B shr 3;
                Dec(K, 3);
                S.mode := ibmBlockBad;
                R := Z_DATA_ERROR;
                result := UpdatePointers;
                exit;
              end;
          end;
        end;
      ibmLens:
        begin
          while K < 32 do begin
            if N <> 0 then
              R := Z_OK
            else begin
              result := UpdatePointers;
              exit;
            end;
            Dec(N);
            B := B or (Cardinal(P^) shl K);
            Inc(P);
            Inc(K, 8);
          end;

          if (((not B) shr 16) and $FFFF) <> (B and $FFFF) then begin
            S.mode := ibmBlockBad;
            R := Z_DATA_ERROR;
            result := UpdatePointers;
            exit;
          end;
          S.sub.left := B and $FFFF;
          K := 0;
          B := 0;
          if S.sub.left <> 0 then
            S.mode := ibmStored
          else if S.last then
            S.mode := ibmDry
          else
            S.mode := ibmZType;
        end;
      ibmStored:
        begin
          if N = 0 then begin
            result := UpdatePointers;
            exit;
          end;

          if M = 0 then begin
            if (Q = S.zend) and (S.read <> S.Window) then begin
              Q := S.Window;
              if PtrUInt(Q) < PtrUInt(S.read) then
                M := PtrUInt(S.read) - PtrUInt(Q) - 1
              else
                M := PtrUInt(S.zend) - PtrUInt(Q);
            end;

            if M = 0 then begin
              S.write := Q;
              R := InflateFlush(S, Z, R);
              Q := S.write;
              if PtrUInt(Q) < PtrUInt(S.read) then
                M := PtrUInt(S.read) - PtrUInt(Q) - 1
              else
                M := PtrUInt(S.zend) - PtrUInt(Q);
              if (Q = S.zend) and (S.read <> S.Window) then begin
                Q := S.Window;
                if PtrUInt(Q) < PtrUInt(S.read) then
                  M := PtrUInt(S.read) - PtrUInt(Q) - 1
                else
                  M := PtrUInt(S.zend) - PtrUInt(Q);
              end;

              if M = 0 then begin
                result := UpdatePointers;
                exit;
              end;
            end;
          end;
          R := Z_OK;

          Temp := S.sub.left;
          if Temp > N then
            Temp := N;
          if Temp > M then
            Temp := M;
          Move(P^, Q^, Temp);
          Inc(P, Temp);
          Dec(N, Temp);
          Inc(Q, Temp);
          Dec(M, Temp);
          Dec(S.sub.left, Temp);
          if S.sub.left = 0 then begin
            if S.last then
              S.mode := ibmDry
            else
              S.mode := ibmZType;
          end;
        end;
      ibmTable:
        begin
          while K < 14 do begin
            if N <> 0 then
              R := Z_OK
            else begin
              result := UpdatePointers;
              exit;
            end;
            Dec(N);
            B := B or (Cardinal(P^) shl K);
            Inc(P);
            Inc(K, 8);
          end;

          Temp := B and $3FFF;
          S.sub.trees.table := Temp;
          if ((Temp and $1F) > 29) or (((Temp shr 5) and $1F) > 29) then begin
            S.mode := ibmBlockBad;
            R := Z_DATA_ERROR;
            result := UpdatePointers;
            exit;
          end;
          Temp := 258 + (Temp and $1F) + ((Temp shr 5) and $1F);
          GetMem(S.sub.trees.blens, Temp * SizeOf(Cardinal));
          B := B shr 14;
          Dec(K, 14);

          S.sub.trees.Index := 0;
          S.mode := ibmBitTree;
        end;
      ibmBitTree:
        begin
          while (S.sub.trees.Index < 4 + (S.sub.trees.table shr 10)) do begin
            while K < 3 do begin
              if N <> 0 then
                R := Z_OK
              else begin
                result := UpdatePointers;
                exit;
              end;
              Dec(N);
              B := B or (Cardinal(P^) shl K);
              Inc(P);
              Inc(K, 8);
            end;

            S.sub.trees.blens[BitOrder[S.sub.trees.Index]] := B and 7;
            Inc(S.sub.trees.Index);
            B := B shr 3;
            Dec(K, 3);
          end;
          while S.sub.trees.Index < 19 do begin
            S.sub.trees.blens[BitOrder[S.sub.trees.Index]] := 0;
            Inc(S.sub.trees.Index);
          end;
          S.sub.trees.BB := 7;
          Temp := InflateTreesBits(S.sub.trees.blens^, S.sub.trees.BB, S.sub.trees.TB,
            S.hufts, Z);
          if Temp <> Z_OK then begin
            FreeMem(S.sub.trees.blens);
            R := Temp;
            if R = Z_DATA_ERROR then
              S.mode := ibmBlockBad;
            result := UpdatePointers;
            exit;
          end;
          S.sub.trees.Index := 0;
          S.mode := ibmDistTree;
        end;
      ibmDistTree:
        begin
          while True do begin
            Temp := S.sub.trees.table;
            if not (S.sub.trees.Index < 258 + (Temp and $1F) + ((Temp shr 5) and $1F)) then
              Break;
            Temp := S.sub.trees.BB;
            while K < Temp do begin
              if N <> 0 then
                R := Z_OK
              else begin
                result := UpdatePointers;
                exit;
              end;
              Dec(N);
              B := B or (Cardinal(P^) shl K);
              Inc(P);
              Inc(K, 8);
            end;

            H := S.sub.trees.TB;
            Inc(H, B and InflateMask[Temp]);
            Temp := H^.Bits;
            C := H^.Base;

            if C < 16 then begin
              B := B shr Temp;
              Dec(K, Temp);
              S.sub.trees.blens^[S.sub.trees.Index] := C;
              Inc(S.sub.trees.Index);
            end
            else begin
              // C = 16..18
              if C = 18 then begin
                I := 7;
                J := 11;
              end
              else begin
                I := C - 14;
                J := 3;
              end;

              while K < Temp + I do begin
                if N <> 0 then
                  R := Z_OK
                else begin
                  result := UpdatePointers;
                  exit;
                end;
                Dec(N);
                B := B or (Cardinal(P^) shl K);
                Inc(P);
                Inc(K, 8);
              end;

              B := B shr Temp;
              Dec(K, Temp);

              Inc(J, Cardinal(B) and InflateMask[I]);
              B := B shr I;
              Dec(K, I);

              I := S.sub.trees.Index;
              Temp := S.sub.trees.table;
              if (I + J > 258 + (Temp and $1F) + ((Temp shr 5) and $1F)) or
                 ((C = 16) and (I < 1)) then begin
                FreeMem(S.sub.trees.blens);
                S.mode := ibmBlockBad;
                R := Z_DATA_ERROR;
                result := UpdatePointers;
                exit;
              end;

              if C = 16 then
                C := S.sub.trees.blens[I - 1]
              else
                C := 0;
              repeat
                S.sub.trees.blens[I] := C;
                Inc(I);
                Dec(J);
              until J = 0;
              S.sub.trees.Index := I;
            end;
          end; // while

          S.sub.trees.TB := nil;
          LiteralBits := 9;
          DistanceBits := 6;
          Temp := S.sub.trees.table;
          Temp := InflateTreesDynamic(257 + (Temp and $1F), 1 + ((Temp shr 5) and $1F),
            S.sub.trees.blens^, LiteralBits, DistanceBits, TL, TD, S.hufts, Z);
          FreeMem(S.sub.trees.blens);
          if Temp <> Z_OK then begin
            if integer(Temp) = Z_DATA_ERROR then
              S.mode := ibmBlockBad;
            R := Temp;
            result := UpdatePointers;
            exit;
          end;
          CodeState := InflateCodesNew(LiteralBits, DistanceBits, TL, TD, Z);
          if CodeState = nil then begin
            R := Z_MEM_ERROR;
            result := UpdatePointers;
            exit;
          end;
          S.sub.decode.codes := CodeState;
          S.mode := ibmCodes;
        end;
      ibmCodes:
        begin
          // update pointers
          S.bitb := B;
          S.bitk := K;
          Z.AvailableInput := N;
          Inc(Z.TotalInput, PtrUInt(P) - PtrUInt(Z.NextInput));
          Z.NextInput := P;
          S.write := Q;
          R := InflateCodes(S, Z, R);

          if R <> Z_STREAM_END then begin
            result := InflateFlush(S, Z, R);
            exit;
          end;
          R := Z_OK;
          Freemem(S.sub.decode.codes);
          // load local pointers
          P := Z.NextInput;
          N := Z.AvailableInput;
          B := S.bitb;
          K := S.bitk;
          Q := S.write;
          if PtrUInt(Q) < PtrUInt(S.read) then
            M := PtrUInt(S.read) - PtrUInt(Q) - 1
          else
            M := PtrUInt(S.zend) - PtrUInt(Q);
          if not S.last then begin
            S.mode := ibmZType;
            Continue;
          end;
          S.mode := ibmDry;
        end;
      ibmDry:
        begin
          S.write := Q;
          R := InflateFlush(S, Z, R);
          Q := S.write;
          if S.read <> S.write then begin
            result := UpdatePointers;
            exit;
          end;
          S.mode := ibmBlockDone;
        end;
      ibmBlockDone:
        begin
          R := Z_STREAM_END;
          result := UpdatePointers;
          exit;
        end;
      ibmBlockBad:
        begin
          R := Z_DATA_ERROR;
          result := UpdatePointers;
          exit;
        end;
    else
      R := Z_STREAM_ERROR;
      result := UpdatePointers;
      exit;
    end; // case S.mode of
  end;
end;

function CompressMem(src, dst: pointer; srcLen, dstLen: integer): integer;

  function LongestMatch(var S: TDeflateState; CurrentMatch: Cardinal): Cardinal;
  // Sets MatchStart to the longest match starting at the given string and returns its length. Matches shorter or equal to
  // PreviousLength are discarded, in which case the result is equal to PreviousLength and MatchStart is garbage.
  // CurrentMatch is the head of the hash chain for the current string (StringStart) and its distance is <= MaxDistance,
  // and PreviousLength >= 1.
  // The match length will not be greater than S.Lookahead.

    function ScanFast(Scan, Match, StrEnd: PByte): integer;
    // faster routine by AB
    begin
      inc(Scan, 2);
      inc(Match);
      // We check for insufficient lookahead only every 8th comparison,
      // the 256th check will be made at StringStart + 258.
      repeat
        Inc(Scan);
        Inc(Match);
        if (Scan^ <> Match^) then
          Break;
        Inc(Scan);
        Inc(Match);
        if (Scan^ <> Match^) then
          Break;
        Inc(Scan);
        Inc(Match);
        if (Scan^ <> Match^) then
          Break;
        Inc(Scan);
        Inc(Match);
        if (Scan^ <> Match^) then
          Break;
        Inc(Scan);
        Inc(Match);
        if (Scan^ <> Match^) then
          Break;
        Inc(Scan);
        Inc(Match);
        if (Scan^ <> Match^) then
          Break;
        Inc(Scan);
        Inc(Match);
        if (Scan^ <> Match^) then
          Break;
        Inc(Scan);
        Inc(Match);
        if (Scan^ <> Match^) then
          Break;
      until (PtrUInt(Scan) >= PtrUInt(StrEnd));
      result := MAX_MATCH - integer(PtrUInt(StrEnd) - PtrUInt(Scan));
    end;

  const
    CGoodLen = 4;
    CNiceLen = 16;
    CMaxChain = 8;
  var
    ChainLength: Cardinal; // max hash chain length
    Scan: PByte;           // current string
    Match: PByte;          // matched string
    Len: Cardinal;         // length of current match
    BestLen: Cardinal;     // best match length so far
    NiceMatch: Cardinal;
    Limit: Cardinal;
    Previous: TPAWord;
    WMask: Cardinal;
    StrEnd: PByte;
    ScanEnd1: Byte;
    ScanEnd: Byte;
    MaxDistance: Cardinal;
  begin
    ChainLength := CMaxChain;
    Scan := @S.Window[S.StringStart];
    BestLen := S.PreviousLength;
    NiceMatch := CNiceLen;
    MaxDistance := S.WindowSize - MIN_LOOKAHEAD;

    // In order to simplify the code, match distances are limited to MaxDistance instead of WSize.
    if S.StringStart > MaxDistance then
      Limit := S.StringStart - MaxDistance
    else
      Limit := 0;

    // Stop when CurrentMatch becomes <= Limit. To simplify the Code we prevent matches with the string of window index 0.
    Previous := S.Previous;
    WMask := S.WindowMask;

    StrEnd := @S.Window[S.StringStart + MAX_MATCH];
    ScanEnd1 := TPAByte(Scan)[BestLen - 1];
    ScanEnd := TPAByte(Scan)[BestLen];

    // The code is optimized for HashBits >= 8 and MAX_MATCH - 2 multiple of 16.
    // It is easy to get rid of this optimization if necessary.
    // Do not waste too much time if we already have a good Match.
    if S.PreviousLength >= CGoodLen then
      ChainLength := ChainLength shr 2;

    // Do not look for matches beyond the end of the input. This is necessary to make Deflate deterministic.
    if NiceMatch > S.Lookahead then
      NiceMatch := S.Lookahead;

    repeat
      Match := @S.Window[CurrentMatch];
      // Skip to next match if the match length cannot increase or if the match length is less than 2.
      if (TPAByte(Match)[BestLen] = ScanEnd) and
         (TPAByte(Match)[BestLen - 1] = ScanEnd1) and (Match^ = Scan^) then begin
        Inc(Match);
        if Match^ = TPAByte(Scan)[1] then begin
          // The Check at BestLen - 1 can be removed because it will be made again later (this heuristic is not always a win).
          // It is not necessary to compare Scan[2] and Match[2] since they are always equal when the other bytes match,
          // given that the hash keys are equal and that HashBits >= 8.
          Len := ScanFast(Scan, Match, StrEnd); // faster routine by AB
          Scan := StrEnd;
          Dec(Scan, MAX_MATCH);
          if Len > BestLen then begin
            S.MatchStart := CurrentMatch;
            BestLen := Len;
            if Len >= NiceMatch then
              Break;
            ScanEnd1 := TPAByte(Scan)[BestLen - 1];
            ScanEnd := TPAByte(Scan)[BestLen];
          end;
        end;
      end;
      CurrentMatch := Previous[CurrentMatch and WMask];
      Dec(ChainLength);
    until (CurrentMatch <= Limit) or (ChainLength = 0);

    if BestLen <= S.Lookahead then
      result := BestLen
    else
      result := S.Lookahead;
  end;

  procedure FillWindow(var S: TDeflateState);
  // Fills the window when the lookahead becomes insufficient, updates StringStart and Lookahead.
  // Lookahead must be less than MIN_LOOKAHEAD.
  // StringStart will be <= CurrentWindowSize - MIN_LOOKAHEAD on exit.
  // On exit at least one byte has been read, or AvailableInput = 0. Reads are performed for at least two bytes (required
  // for the zip translate_eol option -> not supported here).

    function ReadBuffer(ZState: PZState; Buffer: PByte; Size: Cardinal): integer;
    // Reads a new buffer from the current input stream, updates the Adler32 and total number of bytes read.  All Deflate
    // input goes through this function so some applications may wish to modify it to avoid allocating a large
    // ZState.NextInput buffer and copying from it (see also FlushPending).
    var
      Len: Cardinal;
    begin
      Len := ZState.AvailableInput;
      if Len > Size then
        Len := Size;
      if Len = 0 then begin
        result := 0;
        exit;
      end;
      Dec(ZState.AvailableInput, Len);
      Move(ZState.NextInput^, Buffer^, Len);
      Inc(ZState.NextInput, Len);
      Inc(ZState.TotalInput, Len);
      result := Len;
    end;

  var
    N, M: Cardinal;
    P: TPWord;
    More: Cardinal; // amount of free space at the end of the window
  begin
    repeat
      More := S.CurrentWindowSize - integer(S.Lookahead) - integer(S.StringStart);
      if (More = 0) and (S.StringStart = 0) and (S.Lookahead = 0) then
        More := S.WindowSize
      else if More = Cardinal(-1) then begin
        // Very unlikely, but sometimes possible if StringStart = 0 and Lookahead = 1 (input done one byte at time)
        Dec(More);
        // If the Window is almost full and there is insufficient lookahead,
        // move the upper half to the lower one to make room in the upper half.
      end
      else if S.StringStart >= S.WindowSize + (S.WindowSize - MIN_LOOKAHEAD) then begin
        Move(S.Window[S.WindowSize], S.Window^, S.WindowSize);
        Dec(S.MatchStart, S.WindowSize);
        Dec(S.StringStart, S.WindowSize);
          // we now have StringStart >= MaxDistance
        Dec(S.BlockStart, integer(S.WindowSize));

          // Slide the hash table (could be avoided with 32 bit values at the expense of memory usage). We slide even when
          // Level = 0 to keep the hash table consistent if we switch back to Level > 0 later. (Using Level 0 permanently
          // is not an optimal usage of zlib, so we don't care about this pathological case.)
        P := @S.Head[S.HashSize];
        for N := 1 to S.HashSize do begin
          Dec(P);
          M := P^;
          if M >= S.WindowSize then
            P^ := M - S.WindowSize
          else
            P^ := 0;
        end;
        P := @S.Previous[S.WindowSize];
        for N := 1 to S.WindowSize do begin
          Dec(P);
          M := P^;
          if M >= S.WindowSize then
            P^ := M - S.WindowSize
          else
            P^ := 0;
            // if N is not on any hash chain Previous[N] is garbage but its value will never be used
        end;
        Inc(More, S.WindowSize);
      end;

      if S.ZState.AvailableInput = 0 then
        exit;

      // If there was no sliding:
      //    StringStart <= S.WindowSize + MaxDistance - 1 and Lookahead <= MIN_LOOKAHEAD - 1 and
      //    More = CurrentWindowSize - Lookahead - StringStart
      // => More >= CurrentWindowSize - (MIN_LOOKAHEAD - 1 + S.WindowSize + MaxDistance - 1)
      // => More >= CurrentWindowSize - 2 * S.WindowSize + 2
      // In the BIG_MEM or MMAP case (not yet supported),
      //    CurrentWindowSize = input_size + MIN_LOOKAHEAD  and
      //    StringStart + S.Lookahead <= input_size => More >= MIN_LOOKAHEAD.
      // Otherwise, CurrentWindowSize = 2 * S.WindowSize so More >= 2.
      // If there was sliding More >= S.WindowSize. So in all cases More >= 2.
      N := ReadBuffer(S.ZState, @S.Window[S.StringStart + S.Lookahead], More);
      Inc(S.Lookahead, N);

      // Initialize the hash Value now that we have some input:
      if S.Lookahead >= MIN_MATCH then begin
        S.InsertHash := S.Window[S.StringStart];
        S.InsertHash := ((S.InsertHash shl S.HashShift) xor S.Window[S.StringStart
          + 1]) and S.HashMask;
      end;
      // If the whole input has less than MIN_MATCH bytes, InsertHash is garbage,
      // but this is not important since only literal bytes will be emitted.
    until (S.Lookahead >= MIN_LOOKAHEAD) or (S.ZState.AvailableInput = 0);
  end;

  procedure InitializeBlock(var S: TDeflateState);
  var
    N: integer;
  begin
    // initialize the trees
    for N := 0 to L_CODES - 1 do
      S.LiteralTree[N].fc.Frequency := 0;
    for N := 0 to D_CODES - 1 do
      S.DistanceTree[N].fc.Frequency := 0;
    for N := 0 to BL_CODES - 1 do
      S.BitLengthTree[N].fc.Frequency := 0;
    S.LiteralTree[END_BLOCK].fc.Frequency := 1;
    S.StaticLength := 0;
    S.OptimalLength := 0;
    S.Matches := 0;
    S.LastLiteral := 0;
  end;

  procedure FlushBlockOnly(var S: TDeflateState; EOF: boolean);
  // Flushs the current block with given end-of-file flag.
  // StringStart must be set to the end of the current match.

    procedure FlushPending(var ZState: TZState);
    // Flushs as much pending output as possible. All Deflate output goes through this function so some applications may
    // wish to modify it to avoid allocating a large ZState.NextOutput buffer and copying into it
    // (see also ReadBuffer).

    var
      Len: Cardinal;
      S: PDeflateState;
    begin
      S := PDeflateState(ZState.State);
      Len := S.Pending;

      if Len > ZState.AvailableOutput then
        Len := ZState.AvailableOutput;
      if Len > 0 then begin
        Move(S.PendingOutput^, ZState.NextOutput^, Len);
        Inc(ZState.NextOutput, Len);
        Inc(S.PendingOutput, Len);
        Inc(ZState.TotalOutput, Len);
        Dec(ZState.AvailableOutput, Len);
        Dec(S.Pending, Len);
        if S.Pending = 0 then
          S.PendingOutput := PByte(S.PendingBuffer);
      end;
    end;

    function TreeFlushBlock(var S: TDeflateState; Buffer: PByte; StoredLength:
      integer; EOF: boolean): integer;
    // Determines the best encoding for the current block: dynamic trees, static trees or store, and outputs the encoded
    // block. Buffer contains the input block (or nil if too old), StoredLength the length of this block and EOF if this
    // is the last block.
    // Returns the total compressed length so far.

      procedure BuildTree(var S: TDeflateState; var Descriptor: TTreeDescriptor);
      // Constructs a Huffman tree and assigns the code bit strings and lengths.
      // Updates the total bit length for the current block. The field Frequency must be set for all tree elements on entry.
      // result: the fields Len and Code are set to the optimal bit length and corresponding Code. The length OptimalLength
      // is updated; StaticLength is also updated if STree is not nil. The field MaxCode is set.

        procedure GenerateCodes(Tree: PTree; MaxCode: integer; const
          BitLengthCounts: array of word);
        // Generates the codes for a given tree and bit counts (which need not be optimal).
        // The array BitLengthCounts contains the bit length statistics for the given tree and the field Len is set for all
        // Tree elements. MaxCode is the largest code with non zero frequency and BitLengthCounts are the number of codes at
        // each bit length.
        // On exit the field code is set for all tree elements of non zero code length.

          function BitReverse(Code: word; Len: integer): word;
          // Reverses the first Len bits of Code, using straightforward code (a faster
          // imMethod would use a table)
          begin
            result := 0;
            repeat
              result := result or (Code and 1);
              Code := Code shr 1;
              result := result shl 1;
              Dec(Len);
            until Len <= 0;
            result := result shr 1;
          end;

        var
          NextCode: array[0..MAX_BITS] of word; // next code value for each bit length
          Code: word;      // running code value
          Bits: integer;   // bit Index
          N: integer;      // code Index
          Len: integer;
        begin
          Code := 0;
          // The distribution counts are first used to generate the code values without bit reversal.
          for Bits := 1 to MAX_BITS do begin
            Code := (Code + BitLengthCounts[Bits - 1]) shl 1;
            NextCode[Bits] := Code;
          end;
          // Check that the bit counts in BitLengthCounts are consistent. The last code must be all ones.
          for N := 0 to MaxCode do begin
            Len := Tree[N].dl.Len;
            if Len = 0 then
              Continue;
            Tree[N].fc.Code := BitReverse(NextCode[Len], Len);
            Inc(NextCode[Len]);
          end;
        end;

        procedure RestoreHeap(var S: TDeflateState; const Tree: TTree; K: integer);
        // Restores the heap property by moving down tree starting at node K,
        // exchanging a Node with the smallest of its two sons if necessary, stopping
        // when the heap property is re-established (each father smaller than its two sons).
        var
          V, J: integer;
        begin
          V := S.Heap[K];
          J := K shl 1;  // left son of K
          while J <= S.HeapLength do begin
            // set J to the smallest of the two sons:
            if (J < S.HeapLength) and
               ((Tree[S.Heap[J + 1]].fc.Frequency < Tree[S.Heap[J]].fc.Frequency) or
               ((Tree[S.Heap[J + 1]].fc.Frequency = Tree[S.Heap[J]].fc.Frequency) and
                (S.Depth[S.Heap[J + 1]] <= S.Depth[S.Heap[J]]))) then
              Inc(J);

            // exit if V is smaller than both sons
            if ((Tree[V].fc.Frequency < Tree[S.Heap[J]].fc.Frequency) or
               ((Tree[V].fc.Frequency = Tree[S.Heap[J]].fc.Frequency) and
                (S.Depth[V] <= S.Depth[S.Heap[J]])))
              then
              Break;

            // exchange V with the smallest son
            S.Heap[K] := S.Heap[J];
            K := J;

            // and xontinue down the tree, setting J to the left son of K
            J := J shl 1;
          end;
          S.Heap[K] := V;
        end;

        procedure GenerateBitLengths(var S: TDeflateState; var Descriptor:
          TTreeDescriptor);
        // Computes the optimal bit lengths for a tree and update the total bit length for the current block.
        // The fields Frequency and dad are set, Heap[HeapMaximum] and above are the tree nodes sorted by increasing frequency.
        // result: The field Len is set to the optimal bit length, the array BitLengthCounts contains the frequencies for each
        // bit length. The length OptimalLength is updated. StaticLength is also updated if STree is not nil.
        var
          Tree: PTree;
          MaxCode: integer;
          STree: PTree;
          Extra: TPAInteger;
          Base: integer;
          MaxLength: integer;
          H: integer;          // heap Index
          N, M: integer;       // iterate over the tree elements
          Bits: word;          // bit length
          ExtraBits: integer;
          F: word;             // frequency
          Overflow: integer;   // number of elements with bit length too large
        begin
          Tree := Descriptor.DynamicTree;
          MaxCode := Descriptor.MaxCode;
          STree := Descriptor.StaticDescriptor.StaticTree;
          Extra := Descriptor.StaticDescriptor.ExtraBits;
          Base := Descriptor.StaticDescriptor.ExtraBase;
          MaxLength := Descriptor.StaticDescriptor.MaxLength;
          Overflow := 0;

          FillChar(S.BitLengthCounts, SizeOf(S.BitLengthCounts), 0);

          // in a first pass, compute the optimal bit lengths (which may overflow in the case of the bit length tree)
          Tree[S.Heap[S.HeapMaximum]].dl.Len := 0; // root of the heap

          for H := S.HeapMaximum + 1 to HEAP_SIZE - 1 do begin
            N := S.Heap[H];
            Bits := Tree[Tree[N].dl.Dad].dl.Len + 1;
            if Bits > MaxLength then begin
              Bits := MaxLength;
              Inc(Overflow);
            end;
            Tree[N].dl.Len := Bits;

            // overwrite Tree[N].dl.Dad which is no longer needed
            if N > MaxCode then
              Continue; // not a leaf node

            Inc(S.BitLengthCounts[Bits]);
            ExtraBits := 0;
            if N >= Base then
              ExtraBits := Extra[N - Base];
            F := Tree[N].fc.Frequency;
            Inc(S.OptimalLength, integer(F) * (Bits + ExtraBits));
            if Assigned(STree) then
              Inc(S.StaticLength, integer(F) * (STree[N].dl.Len + ExtraBits));
          end;
          // This happens for example on obj2 and pic of the Calgary corpus
          if Overflow = 0 then
            exit;

          // find the first bit length which could increase
          repeat
            Bits := MaxLength - 1;
            while (S.BitLengthCounts[Bits] = 0) do
              Dec(Bits);
            // move one leaf down the tree
            Dec(S.BitLengthCounts[Bits]);
            // move one overflow item as its brother
            Inc(S.BitLengthCounts[Bits + 1], 2);
            // The brother of the overflow item also movels one step up,
            // but this does not affect BitLengthCounts[MaxLength]
            Dec(S.BitLengthCounts[MaxLength]);
            Dec(Overflow, 2);
          until (Overflow <= 0);

          // Now recompute all bit lengths, scanning in increasing frequency.
          // H is still equal to HEAP_SIZE. (It is simpler to reconstruct all
          // lengths instead of fixing only the wrong ones. This idea is taken
          // from 'ar' written by Haruhiko Okumura.)
          H := HEAP_SIZE;
          for Bits := MaxLength downto 1 do begin
            N := S.BitLengthCounts[Bits];
            while (N <> 0) do begin
              Dec(H);
              M := S.Heap[H];
              if M > MaxCode then
                Continue;
              if Tree[M].dl.Len <> Bits then begin
                Inc(S.OptimalLength, (Bits - Tree[M].dl.Len) * Tree[M].fc.Frequency);
                Tree[M].dl.Len := word(Bits);
              end;
              Dec(N);
            end;
          end;
        end;

      var
        Tree: PTree;
        STree: PTree;
        Elements: integer;
        N, M: integer;    // iterate over heap elements
        MaxCode: integer; // largest code with non zero frequency
        Node: integer;    // new node being created

      begin
        Tree := Descriptor.DynamicTree;
        STree := Descriptor.StaticDescriptor.StaticTree;
        Elements := Descriptor.StaticDescriptor.Elements;
        MaxCode := -1;

        // Construct the initial Heap, with least frequent element in Heap[SMALLEST].
        // The sons of Heap[N] are Heap[2 * N] and Heap[2 * N + 1]. Heap[0] is not used.
        S.HeapLength := 0;
        S.HeapMaximum := HEAP_SIZE;

        for N := 0 to Elements - 1 do begin
          if Tree[N].fc.Frequency = 0 then
            Tree[N].dl.Len := 0
          else begin
            MaxCode := N;
            Inc(S.HeapLength);
            S.Heap[S.HeapLength] := N;
            S.Depth[N] := 0;
          end;
        end;

        // The pkzip format requires that at least one distance code exists and that at least one bit
        // should be sent even if there is only one possible code. So to avoid special checks later on we force at least
        // two codes of non zero frequency.
        while S.HeapLength < 2 do begin
          Inc(S.HeapLength);
          if MaxCode < 2 then begin
            Inc(MaxCode);
            S.Heap[S.HeapLength] := MaxCode;
            Node := MaxCode;
          end
          else begin
            S.Heap[S.HeapLength] := 0;
            Node := 0;
          end;
          Tree[Node].fc.Frequency := 1;
          S.Depth[Node] := 0;
          Dec(S.OptimalLength);
          if (STree <> nil) then
            Dec(S.StaticLength, STree[Node].dl.Len);
          // Node is 0 or 1 so it does not have extra bits
        end;
        Descriptor.MaxCode := MaxCode;

        // The elements Heap[HeapLength / 2 + 1 .. HeapLength] are leaves of the Tree,
        // establish sub-heaps of increasing lengths.
        for N := S.HeapLength shr 1 downto 1 do
          RestoreHeap(S, Tree^, N);

        // construct the Huffman tree by repeatedly combining the least two frequent nodes
        Node := Elements; // next internal node of the tree
        repeat
          N := S.Heap[1];
          S.Heap[1] := S.Heap[S.HeapLength];
          Dec(S.HeapLength);
          RestoreHeap(S, Tree^, 1);

          // M := node of next least frequency
          M := S.Heap[1];
          Dec(S.HeapMaximum);
          // keep the nodes sorted by frequency
          S.Heap[S.HeapMaximum] := N;
          Dec(S.HeapMaximum);
          S.Heap[S.HeapMaximum] := M;

          // create a new node father of N and M
          Tree[Node].fc.Frequency := Tree[N].fc.Frequency + Tree[M].fc.Frequency;
          // maximum
          if (S.Depth[N] >= S.Depth[M]) then
            S.Depth[Node] := Byte(S.Depth[N] + 1)
          else
            S.Depth[Node] := Byte(S.Depth[M] + 1);

          Tree[M].dl.Dad := word(Node);
          Tree[N].dl.Dad := word(Node);
          // and insert the new node in the heap
          S.Heap[1] := Node;
          Inc(Node);
          RestoreHeap(S, Tree^, 1);
        until S.HeapLength < 2;

        Dec(S.HeapMaximum);
        S.Heap[S.HeapMaximum] := S.Heap[1];

        // At this point the fields Frequency and dad are set.
        // We can now generate the bit lengths.
        GenerateBitLengths(S, Descriptor);

        // The field Len is now set, we can generate the bit codes
        GenerateCodes(Tree, MaxCode, S.BitLengthCounts);
      end;

      procedure BitsWindup(var S: TDeflateState);
      // flushs the bit buffer and aligns the output on a byte boundary
      begin
        if S.ValidBits > 8 then begin
          S.PendingBuffer[S.Pending] := Byte(S.BitsBuffer and $FF);
          Inc(S.Pending);
          S.PendingBuffer[S.Pending] := Byte(word(S.BitsBuffer) shr 8);
          Inc(S.Pending);
        end
        else if S.ValidBits > 0 then begin
          S.PendingBuffer[S.Pending] := Byte(S.BitsBuffer);
          Inc(S.Pending);
        end;
        S.BitsBuffer := 0;
        S.ValidBits := 0;
      end;

      procedure SendBits(var S: TDeflateState; Value: word; Length: integer);
      // Value contains what is to be sent
      // Length is the number of bits to send
      begin
        // If there's not enough room in BitsBuffer use (valid) bits from BitsBuffer and
        // (16 - ValidBits) bits from Value, leaving (width - (16 - ValidBits)) unused bits in Value.
        if (S.ValidBits > integer(BufferSize) - Length) then begin
          S.BitsBuffer := S.BitsBuffer or (Value shl S.ValidBits);
          S.PendingBuffer[S.Pending] := S.BitsBuffer and $FF;
          Inc(S.Pending);
          S.PendingBuffer[S.Pending] := S.BitsBuffer shr 8;
          Inc(S.Pending);
          S.BitsBuffer := Value shr (BufferSize - S.ValidBits);
          Inc(S.ValidBits, Length - BufferSize);
        end
        else begin
          S.BitsBuffer := S.BitsBuffer or (Value shl S.ValidBits);
          Inc(S.ValidBits, Length);
        end;
      end;

      procedure SendAllTrees(var S: TDeflateState; lcodes, dcodes, blcodes: integer);
      // Sends the header for a block using dynamic Huffman trees: the counts, the
      // lengths of the bit length codes, the literal tree and the distance tree.
      // lcodes must be >= 257, dcodes >= 1 and blcodes >= 4

        procedure SendTree(var S: TDeflateState; const Tree: array of TTreeEntry;
          MaxCode: integer);
        // Sends the given tree in compressed form using the codes in BitLengthTree.
        // MaxCode is the tree's largest code of non zero frequency.
        var
          N: integer;           // iterates over all tree elements
          PreviousLen: integer; // last emitted length
          CurrentLen: integer;  // length of current code
          NextLen: integer;     // length of next code
          Count: integer;       // repeat count of the current code
          MaxCount: integer;    // max repeat count
          MinCount: integer;    // min repeat count
        begin
          PreviousLen := -1;
          NextLen := Tree[0].dl.Len;
          Count := 0;
          MaxCount := 7;
          MinCount := 4;
          // guard is already set
          if NextLen = 0 then begin
            MaxCount := 138;
            MinCount := 3;
          end;
          for N := 0 to MaxCode do begin
            CurrentLen := NextLen;
            NextLen := Tree[N + 1].dl.Len;
            Inc(Count);
            if (Count < MaxCount) and (CurrentLen = NextLen) then
              Continue
            else if Count < MinCount then begin
              repeat
                SendBits(S, S.BitLengthTree[CurrentLen].fc.Code, S.BitLengthTree[CurrentLen].dl.Len);
                Dec(Count);
              until (Count = 0);
            end
            else if CurrentLen <> 0 then begin
              if CurrentLen <> PreviousLen then begin
                SendBits(S, S.BitLengthTree[CurrentLen].fc.Code, S.BitLengthTree[CurrentLen].dl.Len);
                Dec(Count);
              end;
              SendBits(S, S.BitLengthTree[REP_3_6].fc.Code, S.BitLengthTree[REP_3_6].dl.Len);
              SendBits(S, Count - 3, 2);
            end
            else if Count <= 10 then begin
              SendBits(S, S.BitLengthTree[REPZ_3_10].fc.Code, S.BitLengthTree[REPZ_3_10].dl.Len);
              SendBits(S, Count - 3, 3);
            end
            else begin
              SendBits(S, S.BitLengthTree[REPZ_11_138].fc.Code, S.BitLengthTree[REPZ_11_138].dl.Len);
              SendBits(S, Count - 11, 7);
            end;
            Count := 0;
            PreviousLen := CurrentLen;
            if NextLen = 0 then begin
              MaxCount := 138;
              MinCount := 3;
            end
            else if CurrentLen = NextLen then begin
              MaxCount := 6;
              MinCount := 3;
            end
            else begin
              MaxCount := 7;
              MinCount := 4;
            end;
          end;
        end;

      var
        Rank: integer;
      begin
        SendBits(S, lcodes - 257, 5); // not +255 as stated in appnote.txt
        SendBits(S, dcodes - 1, 5);
        SendBits(S, blcodes - 4, 4); // not -3 as stated in appnote.txt
        for Rank := 0 to blcodes - 1 do
          SendBits(S, S.BitLengthTree[BitLengthOrder[Rank]].dl.Len, 3);
        SendTree(S, S.LiteralTree, lcodes - 1);
        SendTree(S, S.DistanceTree, dcodes - 1);
      end;

      function BuildBitLengthTree(var S: TDeflateState): integer;
      // Constructs the Huffman tree for the bit lengths and returns the Index in BitLengthOrder
      // of the last bit length code to send.

        procedure ScanTree(var S: TDeflateState; var Tree: array of TTreeEntry;
          MaxCode: integer);
        // Scans a given tree to determine the frequencies of the codes in the bit length tree.
        // MaxCode is the tree's largest code of non zero frequency.
        var
          N: integer;           // iterates over all tree elements
          PreviousLen: integer; // last emitted length
          CurrentLen: integer;  // Length of current code
          NextLen: integer;     // length of next code
          Count: integer;       // repeat count of the current xode
          MaxCount: integer;    // max repeat count
          MinCount: integer;    // min repeat count
        begin
          PreviousLen := -1;
          NextLen := Tree[0].dl.Len;
          Count := 0;
          MaxCount := 7;
          MinCount := 4;

          if NextLen = 0 then begin
            MaxCount := 138;
            MinCount := 3;
          end;
          Tree[MaxCode + 1].dl.Len := word($FFFF); // guard

          for N := 0 to MaxCode do begin
            CurrentLen := NextLen;
            NextLen := Tree[N + 1].dl.Len;
            Inc(Count);
            if (Count < MaxCount) and (CurrentLen = NextLen) then
              Continue
            else if (Count < MinCount) then
              Inc(S.BitLengthTree[CurrentLen].fc.Frequency, Count)
            else if CurrentLen <> 0 then begin
              if (CurrentLen <> PreviousLen) then
                Inc(S.BitLengthTree[CurrentLen].fc.Frequency);
              Inc(S.BitLengthTree[REP_3_6].fc.Frequency);
            end
            else if (Count <= 10) then
              Inc(S.BitLengthTree[REPZ_3_10].fc.Frequency)
            else
              Inc(S.BitLengthTree[REPZ_11_138].fc.Frequency);
            Count := 0;
            PreviousLen := CurrentLen;
            if NextLen = 0 then begin
              MaxCount := 138;
              MinCount := 3;
            end
            else if CurrentLen = NextLen then begin
              MaxCount := 6;
              MinCount := 3;
            end
            else begin
              MaxCount := 7;
              MinCount := 4;
            end;
          end;
        end;

      begin
        // determine the bit length frequencies for literal and distance trees
        ScanTree(S, S.LiteralTree, S.LiteralDescriptor.MaxCode);
        ScanTree(S, S.DistanceTree, S.DistanceDescriptor.MaxCode);

        // build the bit length tree
        BuildTree(S, S.BitLengthDescriptor);
        // OptimalLength now includes the length of the tree representations, except
        // the lengths of the bit lengths codes and the 5 + 5 + 4 (= 14) bits for the counts.

        // Determine the number of bit length codes to send. The pkzip format requires that at least 4 bit length codes
        // be sent. (appnote.txt says 3 but the actual value used is 4.)
        for result := BL_CODES - 1 downto 3 do
          if S.BitLengthTree[BitLengthOrder[result]].dl.Len <> 0 then
            Break;

        // update OptimalLength to include the bit length tree and counts
        Inc(S.OptimalLength, 3 * (result + 1) + 14);
      end;

      procedure TreeStroredBlock(var S: TDeflateState; Buffer: PByte;
        StoredLength: integer; EOF: boolean);
      // sends a stored block
      // Buffer contains the input data, Len the buffer length and EOF is True if this is the last block for a file.

        procedure CopyBlock(var S: TDeflateState; Buffer: PByte; Len: Cardinal;
          Header: boolean);
        // copies a stored block, storing first the length and its one's complement if requested
        // Buffer contains the input data, Len the buffer length and Header is True if the block Header must be written too.
        begin
          BitsWindup(S);        // align on byte boundary
          S.LastEOBLength := 8; // enough lookahead for Inflate

          if Header then begin
            S.PendingBuffer[S.Pending] := Byte(word(Len) and $FF);
            Inc(S.Pending);
            S.PendingBuffer[S.Pending] := Byte(word(Len) shr 8);
            Inc(S.Pending);
            S.PendingBuffer[S.Pending] := Byte(word(not Len) and $FF);
            Inc(S.Pending);
            S.PendingBuffer[S.Pending] := Byte(word(not Len) shr 8);
            Inc(S.Pending);
          end;

          while Len > 0 do begin
            Dec(Len);
            S.PendingBuffer[S.Pending] := Buffer^;
            Inc(Buffer);
            Inc(S.Pending);
          end;
        end;

      begin
        SendBits(S, (STORED_BLOCK shl 1) + Ord(EOF), 3);  // send block type
        S.CompressedLength := (S.CompressedLength + 10) and integer(not 7);
        Inc(S.CompressedLength, (StoredLength + 4) shl 3);

        // copy with header
        CopyBlock(S, Buffer, Cardinal(StoredLength), True);
      end;

      procedure CompressBlock(var S: TDeflateState; const LiteralTree,
        DistanceTree: array of TTreeEntry);
      // sends the block data compressed using the given Huffman trees
      var
        Distance: Cardinal; // distance of matched string
        lc: integer;        // match length or unmatched char (if Distance = 0)
        I: Cardinal;
        Code: Cardinal;     // the code to send
        Extra: integer;     // number of extra bits to send

      begin
        I := 0;
        if S.LastLiteral <> 0 then
          repeat
            Distance := S.DistanceBuffer[I];
            lc := S.LiteralBuffer[I];
            Inc(I);
            if Distance = 0 then begin
              // send a literal byte
              SendBits(S, LiteralTree[lc].fc.Code, LiteralTree[lc].dl.Len);
            end
            else begin
              // Here, lc is the match length - MIN_MATCH
              Code := LengthCode[lc];
              // send the length code
              SendBits(S, LiteralTree[Code + LITERALS + 1].fc.Code,
                LiteralTree[Code + LITERALS + 1].dl.Len);
              Extra := ExtraLengthBits[Code];
              if Extra <> 0 then begin
                Dec(lc, BaseLength[Code]);
                // send the extra length bits
                SendBits(S, lc, Extra);
              end;
              Dec(Distance); // Distance is now the match distance - 1
              if Distance < 256 then
                Code := DistanceCode[Distance]
              else
                Code := DistanceCode[256 + (Distance shr 7)];

              // send the distance code
              SendBits(S, DistanceTree[Code].fc.Code, DistanceTree[Code].dl.Len);
              Extra := ExtraDistanceBits[Code];
              if Extra <> 0 then begin
                Dec(Distance, BaseDistance[Code]);
                SendBits(S, Distance, Extra);   // send the extra distance bits
              end;
            end; // literal or match pair?

          // Check that the overlay between PendingBuffer and DistanceBuffer + LiteralBuffer is ok
          until I >= S.LastLiteral;

        SendBits(S, LiteralTree[END_BLOCK].fc.Code, LiteralTree[END_BLOCK].dl.Len);
        S.LastEOBLength := LiteralTree[END_BLOCK].dl.Len;
      end;

    var
      OptimalByteLength, StaticByteLength: integer; // OptimalLength and StaticLength in bytes
      MacBLIndex: integer;  // index of last bit length code of non zero frequency
    begin
      // construct the literal and distance trees
      // After this, OptimalLength and StaticLength are the total bit lengths of
      // the compressed block data, excluding the tree representations.
      BuildTree(S, S.LiteralDescriptor);
      BuildTree(S, S.DistanceDescriptor);

      // Build the bit length tree for the above two trees and get the index
      // in BitLengthOrder of the last bit length code to send.
      MacBLIndex := BuildBitLengthTree(S);

      // determine the best encoding, compute first the block length in bytes
      OptimalByteLength := (S.OptimalLength + 10) shr 3;
      StaticByteLength := (S.StaticLength + 10) shr 3;
      if StaticByteLength <= OptimalByteLength then
        OptimalByteLength := StaticByteLength;

      // if compression failed and this is the first and last block,
      // and if the .zip file can be seeked (to rewrite the local header),
      // the whole file is transformed into a stored file.
      // (4 are the two words for the lengths)
      if (StoredLength + 4 <= OptimalByteLength) and Assigned(Buffer) then begin
        // The test Buffer <> nil is only necessary if LiteralBufferSize > WSize.
        // Otherwise we can't have processed more than WSize input bytes since
        // the last block dlush, because compression would have been successful.
        // if LiteralBufferSize <= WSize, it is never too late to transform a block into a stored block.
        TreeStroredBlock(S, Buffer, StoredLength, EOF);
      end
      else if StaticByteLength = OptimalByteLength then begin
        // force static trees
        SendBits(S, (STATIC_TREES shl 1) + Ord(EOF), 3);
        CompressBlock(S, StaticLiteralTree, StaticDescriptorTree);
        Inc(S.CompressedLength, 3 + S.StaticLength);
      end
      else begin
        SendBits(S, (DYN_TREES shl 1) + Ord(EOF), 3);
        SendAllTrees(S, S.LiteralDescriptor.MaxCode + 1,
          S.DistanceDescriptor.MaxCode + 1, MacBLIndex + 1);
        CompressBlock(S, S.LiteralTree, S.DistanceTree);
        Inc(S.CompressedLength, 3 + S.OptimalLength);
      end;
      InitializeBlock(S);

      if EOF then begin
        BitsWindup(S);
        // align on byte boundary
        Inc(S.CompressedLength, 7);
      end;

      result := S.CompressedLength shr 3;
    end;

  begin
    if S.BlockStart >= 0 then
      TreeFlushBlock(S, @S.Window[Cardinal(S.BlockStart)],
        integer(S.StringStart) - S.BlockStart, EOF)
    else
      TreeFlushBlock(S, nil, integer(S.StringStart) - S.BlockStart, EOF);
    S.BlockStart := S.StringStart;
    FlushPending(S.ZState^);
  end;

  function TreeTally(var S: TDeflateState; Distance: Cardinal; lc: Cardinal): boolean;
  // Saves the match info and tallies the frequency counts. Returns True if the current block must be flushed.
  // Distance is the distance of the matched string and lc either match length minus MIN_MATCH or the unmatch character
  // (if Distance = 0).
  var
    Code: word;
  begin
    S.DistanceBuffer[S.LastLiteral] := word(Distance);
    S.LiteralBuffer[S.LastLiteral] := Byte(lc);
    Inc(S.LastLiteral);
    if (Distance = 0) then begin
      // lc is the unmatched char
      Inc(S.LiteralTree[lc].fc.Frequency);
    end
    else begin
      Inc(S.Matches);
      // here, lc is the match length - MIN_MATCH
      Dec(Distance);
      if Distance < 256 then
        Code := DistanceCode[Distance]
      else
        Code := DistanceCode[256 + (Distance shr 7)];
      Inc(S.LiteralTree[LengthCode[lc] + LITERALS + 1].fc.Frequency);
      Inc(S.DistanceTree[Code].fc.Frequency);
    end;

    result := (S.LastLiteral = S.LiteralBufferSize - 1);
    // We avoid equality with LiteralBufferSize because stored blocks are restricted to 64K - 1 bytes.
  end;

  procedure InsertString(var S: TDeflateState; Str: Cardinal; var MatchHead: Cardinal);
  // Inserts Str into the dictionary and sets MatchHead to the previous head of the hash chain (the most recent string
  // with same hash key). All calls to to InsertString are made with consecutive input characters and the first MIN_MATCH
  // bytes of Str are valid (except for the last MIN_MATCH - 1 bytes of the input file).
  // Returns the previous length of the hash chain.
  begin
    S.InsertHash := ((S.InsertHash shl S.HashShift) xor (S.Window[(Str) + (MIN_MATCH - 1)]))
      and S.HashMask;
    MatchHead := S.Head[S.InsertHash];
    S.Previous[(Str) and S.WindowMask] := MatchHead;
    S.Head[S.InsertHash] := word(Str);
  end;

const
  CMaxInsertLen = 5;
var
  Z: TZState;
  Overlay: TPAWord;
  // We overlay PendingBuffer and DistanceBuffer + LiteralBuffer. This works since the average
  // output size for (length, distance) codes is <= 24 Bits.
  HashHead: Cardinal;  // head of the hash chain
  BlockFlush: boolean; // set if current block must be flushed
  S: TDeflateState;
begin
  result := 0;
  FillChar(Z, sizeOf(Z), 0);
  Z.NextInput := src;
  Z.AvailableInput := srcLen;
  Z.NextOutput := dst;
  Z.AvailableOutput := dstLen;
  Z.TotalInput := Z.TotalOutput;
  FillChar(S, SizeOf(TDeflateState), 0);
  try
    Z.State := @S;
    S.ZState := @Z;
    S.WindowSize := 1 shl CWindowBits;
    S.WindowMask := S.WindowSize - 1;
    S.HashBits := CMemLevel + 7;
    S.HashSize := 1 shl S.HashBits;
    S.HashMask := S.HashSize - 1;
    S.HashShift := (S.HashBits + MIN_MATCH - 1) div MIN_MATCH;
    GetMem(S.Window, S.WindowSize * (2 * SizeOf(Byte)));
    GetMem(S.Previous, S.WindowSize * SizeOf(word));
    GetMem(S.Head, S.HashSize * SizeOf(word));
    S.LiteralBufferSize := 1 shl (CMemLevel + 6); // 16K elements by default
    GetMem(Overlay, S.LiteralBufferSize * (SizeOf(word) + 2));
    S.PendingBuffer := TPAByte(Overlay);
    S.PendingBufferSize := S.LiteralBufferSize * (SizeOf(word) + 2);
    S.DistanceBuffer := @Overlay[S.LiteralBufferSize shr 1];
    S.LiteralBuffer := @S.PendingBuffer[(1 + SizeOf(word)) * S.LiteralBufferSize];
    S.PendingOutput := PByte(S.PendingBuffer);
    S.LiteralDescriptor.DynamicTree := @S.LiteralTree;
    S.LiteralDescriptor.StaticDescriptor := @StaticLiteralDescriptor;
    S.DistanceDescriptor.DynamicTree := @S.DistanceTree;
    S.DistanceDescriptor.StaticDescriptor := @StaticDistanceDescriptor;
    S.BitLengthDescriptor.DynamicTree := @S.BitLengthTree;
    S.BitLengthDescriptor.StaticDescriptor := @StaticBitLengthDescriptor;
    S.LastEOBLength := 8; // enough Lookahead for Inflate
    InitializeBlock(S);
    S.CurrentWindowSize := 2 * S.WindowSize;
    S.Head[S.HashSize - 1] := 0;
    FillChar(S.Head^, (S.HashSize - 1) * SizeOf(S.Head[0]), 0);
    S.PreviousLength := MIN_MATCH - 1;
    S.MatchLength := MIN_MATCH - 1;

    HashHead := 0;
    while true do begin
      // Make sure that we always have enough lookahead, except at the end of the input file. We need MAX_MATCH bytes
      // for the next match plus MIN_MATCH bytes to insert the string following the next match.
      if S.Lookahead < MIN_LOOKAHEAD then begin
        FillWindow(S);

        // flush the current block
        if S.Lookahead = 0 then begin
          FlushBlockOnly(S, true);
          if Z.AvailableOutput <> 0 then
            result := Z.TotalOutput;
          break;
        end;
      end;

      // Insert the string Window[StringStart .. StringStart + 2] in the
      // dictionary and set HashHead to the head of the hash chain.
      if S.Lookahead >= MIN_MATCH then
        InsertString(S, S.StringStart, HashHead);

      // Find the longest match, discarding those <= PreviousLength.
      // At this point we have always MatchLength < MIN_MATCH.
      if (HashHead <> 0) and (S.StringStart - HashHead <= (S.WindowSize - MIN_LOOKAHEAD)) then
        S.MatchLength := LongestMatch(S, HashHead);
      if S.MatchLength >= MIN_MATCH then begin
        BlockFlush := TreeTally(S, S.StringStart - S.MatchStart, S.MatchLength - MIN_MATCH);
        Dec(S.Lookahead, S.MatchLength);

        // Insert new strings in the hash table only if the match length
        // is not too large. This saves time but degrades compression.
        if (S.MatchLength <= CMaxInsertLen) and (S.Lookahead >= MIN_MATCH) then begin
          // string at StringStart already in hash table
          Dec(S.MatchLength);
          repeat
            Inc(S.StringStart);
            InsertString(S, S.StringStart, HashHead);
            // StringStart never exceeds WSize - MAX_MATCH, so there are always MIN_MATCH bytes ahead.
            Dec(S.MatchLength);
          until S.MatchLength = 0;
          Inc(S.StringStart);
        end
        else begin
          Inc(S.StringStart, S.MatchLength);
          S.MatchLength := 0;
          S.InsertHash := S.Window[S.StringStart];
          S.InsertHash := ((S.InsertHash shl S.HashShift) xor
            S.Window[S.StringStart + 1]) and S.HashMask;
          // if Lookahead < MIN_MATCH, InsertHash is garbage, but it does not
          // matter since it will be recomputed at next Deflate call.
        end;
      end
      else begin
        // no match, output a literal byte
        BlockFlush := TreeTally(S, 0, S.Window[S.StringStart]);
        Dec(S.Lookahead);
        Inc(S.StringStart);
      end;
      if BlockFlush then begin
        FlushBlockOnly(S, False);
        if S.ZState.AvailableOutput = 0 then
          break;
      end;
    end;
  except
    result := 0;
  end;
  FreeMem(S.PendingBuffer);
  FreeMem(S.Head);
  FreeMem(S.Previous);
  FreeMem(S.Window);
end;

function UncompressMem(src, dst: pointer; srcLen, dstLen: integer): integer;
var
  Z: TZState;
begin
  result := 0;
  FillChar(Z, sizeOf(Z), 0);
  try
    Z.NextInput := src;
    Z.AvailableInput := srcLen;
    Z.NextOutput := dst;
    Z.AvailableOutput := dstLen;
    Z.State := InflateBlocksNew(Z, 1 shl CWindowBits);
    InflateBlockReset(Z.State^, Z);
    if InflateBlocks(Z.State^, Z, Z_BUF_ERROR) in [Z_OK, Z_STREAM_END] then
      result := Z.TotalOutput;
    InflateBlockReset(Z.State^, Z);
  except
    result := 0;
  end;
  FreeMem(Z.State.Window);
  FreeMem(Z.State.hufts);
  FreeMem(Z.State);
end;

{$ifdef CPUARM} // circumvent FPC issue on ARM
function ToByte(value: cardinal): cardinal; inline;
begin
  result := value and $ff;
end;
{$else}
type ToByte = byte;
{$endif CPUARM}

function UpdateCrc32(aCRC32: cardinal; inBuf: pointer; inLen: integer): cardinal;
var
  i: integer;
  table: {$ifdef CPUX86}TCRC32Tab absolute crc32Tab{$else}^TCRC32Tab{$endif};
begin
  result := aCRC32;
  {$ifndef CPUX86}table := @crc32Tab;{$endif}
  for i := 0 to (inLen shr 2) - 1 do begin
    result := table[ToByte(result xor PByte(inBuf)^)] xor (result shr 8);
    inc(PByte(inBuf));
    result := table[ToByte(result xor PByte(inBuf)^)] xor (result shr 8);
    inc(PByte(inBuf));
    result := table[ToByte(result xor PByte(inBuf)^)] xor (result shr 8);
    inc(PByte(inBuf));
    result := table[ToByte(result xor PByte(inBuf)^)] xor (result shr 8);
    inc(PByte(inBuf));
  end;
  for i := 0 to (inLen and 3) - 1 do begin
    result := table[ToByte(result xor PByte(inBuf)^)] xor (result shr 8);
    inc(PByte(inBuf));
  end;
end;

function CompressString(const data: RawByteZip; failIfGrow: boolean = false): RawByteZip;
var
  i1: integer;
begin
  SetLength(result, 12 + length(data) * 11 div 10 + 12);
  pInt64(result)^ := length(data);
  TPACardinal(result)^[2] := not UpdateCrc32(dword(-1), pointer(data), length(data));
  i1 := CompressMem(pointer(data), PAnsiChar(PtrUInt(result) + 12), length(data),
    length(result) - 12);
  if (i1 > 0) and ((12 + i1 < length(data)) or (not failIfGrow)) then
    SetLength(result, 12 + i1)
  else
    result := '';
end;

function UncompressString(const data: RawByteZip): RawByteZip;
begin
  if Length(data) > 12 then begin
    SetLength(result, PCardinal(data)^);
    SetLength(result, UncompressMem(PAnsiChar(PtrUInt(data) + 12), pointer(result),
      length(data) - 12, length(result)));
    if (result <> '') and (TPACardinal(data)^[2] <>
        not UpdateCrc32(dword(-1), pointer(result), length(result))) then
      result := '';
  end
  else
    result := '';
end;

procedure CreateVoidZip(const aFileName: TFileName);
var
  H: THandle;
  lhr: TLastHeader;
begin
  fillchar(lhr, sizeof(lhr), 0);
  lhr.signature := $06054b50 + 1;
  dec(lhr.signature); // +1 to avoid finding it in the exe
  H := FileCreate(aFileName);
  if H < 0 then
    exit;
  FileWrite(H, lhr, sizeof(lhr));
  FileClose(H);
end;

{$ifdef MSWINDOWS}

function ValidHandle(Handle: THandle): boolean; {$ifdef HASINLINE}inline;{$endif}
begin
  result := PtrInt(Handle) > 0;
end;

type
  splitInt64 = packed record
    loCard, hiCard: cardinal
  end;

function CompressFile(const srcFile, dstFile: TFileName; failIfGrow: boolean): boolean;
var
  sf, df: THandle;
  sm, dm: THandle;
  sb, db: pointer;
  sl, dl: int64;
  err: dword;
begin
  result := false;
  err := 0;
  try
    sf := CreateFile(pointer(srcFile), GENERIC_READ, FILE_SHARE_READ or
      FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0);
    if ValidHandle(sf) then begin
      df := CreateFile(pointer(dstFile), GENERIC_READ or GENERIC_WRITE, 0, nil,
        CREATE_ALWAYS, 0, 0);
      if ValidHandle(df) then begin
        sm := CreateFileMapping(sf, nil, PAGE_READONLY, 0, 0, nil);
        if sm <> 0 then begin
          splitInt64(sl).loCard := GetFileSize(sf, @splitInt64(sl).hiCard);
          dl := 12 + sl * 11 div 10 + 12;
          dm := CreateFileMapping(df, nil, PAGE_READWRITE, splitInt64(dl).hiCard,
            splitInt64(dl).loCard, nil);
          if dm <> 0 then begin
            sb := MapViewOfFile(sm, FILE_MAP_READ, 0, 0, 0);
            if sb <> nil then begin
              db := MapViewOfFile(dm, FILE_MAP_ALL_ACCESS, 0, 0, 0);
              if db <> nil then begin
                pint64(db)^ := sl;
                dl := CompressMem(sb, pointer(PtrUInt(db) + 12), sl, dl - 12);
                result := (dl > 0) and ((dl + 12 < sl) or (not failIfGrow));
                if result then
                  PCardinal(PtrUInt(db) + 8)^ := not UpdateCrc32(dword(-1), sb, sl);
                UnmapViewOfFile(db);
              end
              else
                err := GetLastError;
              UnmapViewOfFile(sb);
            end
            else
              err := GetLastError;
            CloseHandle(dm);
          end
          else
            err := GetLastError;
          CloseHandle(sm);
        end
        else
          err := GetLastError;
        if result then begin
          inc(dl, 12);
          SetFilePointer(df, integer(splitInt64(dl).loCard), @splitInt64(dl).hiCard,
            FILE_BEGIN);
          SetEndOfFile(df);
        end;
        CloseHandle(df);
        if not result then
          Windows.DeleteFile(pointer(dstFile));
      end
      else
        err := GetLastError;
      CloseHandle(sf);
    end
    else
      err := GetLastError;
  except
    SetFileAttributes(pointer(dstFile), 0);
    Windows.DeleteFile(pointer(dstFile));
    err := ERROR_ACCESS_DENIED;
  end;
  if not result then
    SetLastError(err);
end;

function UncompressFile(const srcFile, dstFile: TFileName; lastWriteTime: int64;
  attr: dword): boolean;
var
  sf, df: THandle;
  sm, dm: THandle;
  sb, db: pointer;
  sl, dl: int64;
  err: dword;
begin
  result := false;
  err := 0;
  try
    sf := CreateFile(pointer(srcFile), GENERIC_READ, FILE_SHARE_READ or
      FILE_SHARE_WRITE, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL or
      FILE_FLAG_SEQUENTIAL_SCAN, 0);
    if ValidHandle(sf) then begin
      df := CreateFile(pointer(dstFile), GENERIC_READ or GENERIC_WRITE, 0, nil,
        CREATE_ALWAYS, attr or FILE_FLAG_SEQUENTIAL_SCAN, 0);
      if ValidHandle(df) then begin
        sm := CreateFileMapping(sf, nil, PAGE_READONLY, 0, 0, nil);
        if sm <> 0 then begin
          sb := MapViewOfFile(sm, FILE_MAP_READ, 0, 0, 0);
          if sb <> nil then begin
            dl := PInt64(sb)^;
            dm := CreateFileMapping(df, nil, PAGE_READWRITE, splitInt64(dl).hiCard,
              splitInt64(dl).loCard, nil);
            if dm <> 0 then begin
              db := MapViewOfFile(dm, FILE_MAP_ALL_ACCESS, 0, 0, 0);
              if db <> nil then begin
                splitInt64(sl).loCard := GetFileSize(sf, @splitInt64(sl).hiCard);
                dl := UncompressMem(pointer(PtrUInt(sb) + 12), db, sl - 12, dl);
                result := (dl > 0) and (PCardinal(PtrUInt(sb) + 8)^ =
                  not UpdateCrc32(dword(-1), db, dl));
                UnmapViewOfFile(db);
              end
              else
                err := GetLastError;
              CloseHandle(dm);
            end
            else
              err := GetLastError;
            UnmapViewOfFile(sb);
          end
          else
            err := GetLastError;
          CloseHandle(sm);
        end
        else
          err := GetLastError;
        if result then begin
          SetFilePointer(df, integer(splitInt64(dl).loCard), @splitInt64(dl).hiCard, FILE_BEGIN);
          SetEndOfFile(df);
        end;
        if result and (lastWriteTime <> 0) then
          SetFileTime(df, nil, nil, @lastWriteTime);
        CloseHandle(df);
        if result then begin
          if (attr <> 0) and (GetVersion and $80000000 = 0) then
            SetFileAttributes(pointer(dstFile), attr)
        end
        else
          Windows.DeleteFile(pointer(dstFile));
      end
      else
        err := GetLastError;
      CloseHandle(sf);
    end
    else
      err := GetLastError;
  except
    SetFileAttributes(pointer(dstFile), 0);
    Windows.DeleteFile(pointer(dstFile));
    err := ERROR_ACCESS_DENIED;
  end;
  if not result then
    SetLastError(err);
end;

function IsCompressedFileEqual(const uncomprFile, comprFile: TFileName): boolean;
var
  size1, size2: int64;
  crc1, crc2: dword;
begin
  result := GetCompressedFileInfo(comprFile, size1, crc1) and
            GetUncompressedFileInfo(uncomprFile, size2, crc2) and
            (size1 = size2) and
            (crc1 = crc2);
end;

function GetCompressedFileInfo(const comprFile: TFileName; var size: int64;
  var crc32: dword): boolean;
var
  file_: THandle;
  c1: dword;
begin
  result := false;
  crc32 := 0;
  file_ := CreateFile(pointer(comprFile), GENERIC_READ, FILE_SHARE_READ or
    FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0);
  if ValidHandle(file_) then begin
    result := ReadFile(file_, size, 8, c1, nil) and (c1 = 8) and ReadFile(file_,
      crc32, 4, c1, nil) and (c1 = 4);
    CloseHandle(file_);
  end;
end;

function GetUncompressedFileInfo(const uncomprFile: TFileName; var size: int64;
  var crc32: dword): boolean;
var
  file_, map: THandle;
  buf: pointer;
begin
  result := false;
  file_ := CreateFile(pointer(uncomprFile), GENERIC_READ, FILE_SHARE_READ or
    FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0);
  if ValidHandle(file_) then begin
    splitInt64(size).loCard := GetFileSize(file_, @splitInt64(size).hiCard);
    map := CreateFileMapping(file_, nil, PAGE_READONLY, 0, 0, nil);
    if map <> 0 then begin
      buf := MapViewOfFile(map, FILE_MAP_READ, 0, 0, 0);
      if buf <> nil then begin
        crc32 := not UpdateCrc32(dword(-1), buf, size);
        UnmapViewOfFile(buf);
        result := true;
      end;
      CloseHandle(map);
    end;
    CloseHandle(file_);
  end;
end;

{$endif MSWINDOWS}

function GzCompress(src: pointer; srcLen: integer; const fName: TFileName): cardinal;
const
  gzheader: array[0..2] of cardinal = ($88B1F, 0, 0);
var
  f: file;
  dest: pointer;
  destLen: cardinal;
  crc: cardinal;
begin
  result := 0;
  {$I-}
  assign(f, fName);
  rewrite(f, 1);
  if ioresult <> 0 then
    exit;
  try
    blockwrite(f, gzHeader, 10);
    destLen := 12 + (SrcLen * 11) div 10; // ensure enough space
    getmem(dest, destLen);
    try
      destLen := CompressMem(src, dest, srcLen, destLen);
      blockwrite(f, dest^, destLen);
      crc := not UpdateCrc32(dword(-1), src, srcLen);
      blockwrite(f, crc, 4);
      blockwrite(f, srcLen, 4);
    finally
      freemem(dest);
    end;
  finally
    close(f);
  end;
  {$I+}
  if ioresult <> 0 then
    exit;
  result := destLen + 18;
end;


{$ifdef MSWINDOWS}

function Zip(const zip: TFileName; const files, zipAs: array of TFileName;
  NoSubDirectories: boolean = false): boolean;
var
  i1, i2, i3: integer;
  dstFh, srcFh: THandle;
  ft: TFileTime;
  c1, size: dword;
  lfhr: TLocalFileHeader;
  srcBuf, dstBuf: pointer;
  zipRec: array of record
    name: TZipName;
    fhr: TFileHeader;
  end;
  lhr: TLastHeader;
begin
  dstFh := CreateFile(pointer(zip), GENERIC_WRITE, 0, nil, CREATE_ALWAYS, 0, 0);
  result := ValidHandle(dstFh);
  if result then begin
    SetLength(zipRec, Length(files));
    i2 := 0;
    for i1 := 0 to high(files) do
      with zipRec[i2] do begin
        if i1 >= length(zipAs) then begin
          name := TZipName(files[i1]);
          if NoSubDirectories then
            for i3 := Length(name) downto 1 do
              if name[i3] = '\' then begin
                Delete(name, 1, i3);
                break;
              end;
        end
        else
          name := TZipName(zipAs[i1]);
        srcFh := CreateFile(pointer(files[i1]), GENERIC_READ, FILE_SHARE_READ,
          nil, OPEN_EXISTING, 0, 0);
        if ValidHandle(srcFh) then begin
          size := GetFileSize(srcFh, nil);
          srcBuf := pointer(LocalAlloc(LPTR, size));
          if srcBuf <> nil then begin
            dstBuf := pointer(LocalAlloc(LPTR, size * 11 div 10 + 12));
            if dstBuf <> nil then begin
              if ReadFile(srcFh, srcBuf^, size, c1, nil) and (c1 = size) then begin
                with lfhr, fileInfo do begin
                  signature := $04034b50 + 1;
                  dec(signature); // +1 to avoid finding it in the exe
                  neededVersion := $14;
                  flags := 0;
                  zzipMethod := 8;
                  zcrc32 := not UpdateCrc32(dword(-1), srcBuf, size);
                  zzipSize := CompressMem(srcBuf, dstBuf, size, size * 11 div 10 + 12);
                  zfullSize := size;
                  nameLen := length(name);
                  extraLen := 0;
                  GetFileTime(srcFh, nil, nil, @ft);
                  FileTimeToLocalFileTime(ft, ft);
                  FileTimeToDosDateTime(ft, zlastModDate, zlastModTime);
                end;
                with fhr do begin
                  signature := $02014b50 + 1;
                  dec(signature); // +1 to avoid finding it
                  madeBy := $14;
                  fileInfo := lfhr.fileInfo;
                  commentLen := 0;
                  firstDiskNo := 0;
                  intFileAttr := 0;
                  extFileAttr := GetFileAttributes(pointer(files[i1]));
                  localHeadOff := SetFilePointer(dstFh, 0, nil, FILE_CURRENT);
                end;
                result :=
                  WriteFile(dstFh, lfhr, sizeOf(lfhr), c1, nil) and
                  (c1 = sizeOf(lfhr)) and
                  WriteFile(dstFh, pointer(name)^, length(name), c1, nil) and
                  (c1 = dword(length(name))) and
                  WriteFile(dstFh, dstBuf^, lfhr.fileInfo.zzipSize, c1, nil) and
                  (c1 = lfhr.fileInfo.zzipSize);
                inc(i2);
              end;
              LocalFree(PtrUInt(dstBuf));
            end;
            LocalFree(PtrUInt(srcBuf));
          end;
          CloseHandle(srcFh);
        end;
        if not result then
          break;
      end;
    result := result and (i2 > 0);
    if result then begin
      with lhr do begin
        signature := $06054b50 + 1;
        dec(signature); // +1 to avoid finding it
        thisDisk := 0;
        headerDisk := 0;
        thisFiles := i2;
        totalFiles := i2;
        headerSize := 0;
        headerOffset := SetFilePointer(dstFh, 0, nil, FILE_CURRENT);
        commentLen := 0;
      end;
      for i1 := 0 to i2 - 1 do
        with zipRec[i1] do begin
          inc(lhr.headerSize, sizeOf(TFileHeader) + length(name));
          if not (WriteFile(dstFh, fhr, sizeOf(fhr), c1, nil) and (c1 = sizeOf(fhr)) and
             WriteFile(dstFh, pointer(name)^, length(name), c1, nil) and
             (c1 = dword(length(name)))) then begin
            result := false;
            break;
          end;
        end;
      result := result and WriteFile(dstFh, lhr, sizeOf(lhr), c1, nil) and
        (c1 = sizeOf(lhr));
    end;
    CloseHandle(dstFh);
    if not result then
      Windows.DeleteFile(pointer(zip));
  end;
end;

{$endif MSWINDOWS}

{$ifdef DYNAMIC_CRC_TABLE}
{
  Generate a table for a byte-wise 32-bit CRC calculation on the polynomial:
  x^32+x^26+x^23+x^22+x^16+x^12+x^11+x^10+x^8+x^7+x^5+x^4+x^2+x+1.

  Polynomials over GF(2) are represented in binary, one bit per coefficient,
  with the lowest powers in the most significant bit.  Then adding polynomials
  is just exclusive-or, and multiplying a polynomial by x is a right shift by
  one.  If we call the above polynomial p, and represent a byte as the
  polynomial q, also with the lowest power in the most significant bit (so the
  byte 0xb1 is the polynomial x^7+x^3+x+1), then the CRC is (q*x^32) mod p,
  where a mod b means the remainder after dividing a by b.

  This calculation is done using the shift-register method of multiplying and
  taking the remainder.  The register is initialized to zero, and for each
  incoming bit, x^32 is added mod p to the register if the bit is a one (where
  x^32 mod p is p+x^32 = x^26+...+1), and the register is multiplied mod p by
  x (which is shifting right by one and adding x^32 mod p if the bit shifted
  out is a one).  We start with the highest power (least significant bit) of
  q and repeat for all eight bits of q.

  The table is simply the CRC of all possible eight bit values.  This is all
  the information needed to generate CRC's on data a byte at a time for all
  combinations of CRC register values and incoming bytes.
}
procedure InitCrc32Tab;
var
  i, n, crc: cardinal;
begin // this code is 49 bytes long, generating a 1KB table
  for i := 0 to 255 do begin
    crc := i;
    for n := 1 to 8 do
      if (crc and 1) <> 0 then
        // $edb88320 from polynomial p=(0,1,2,4,5,7,8,10,11,12,16,22,23,26)
        crc := (crc shr 1) xor $edb88320
      else
        crc := crc shr 1;
    CRC32Tab[i] := crc;
  end;
end;
{$endif}


{$ifdef MSWINDOWS}

{ TZipRead }

constructor TZipRead.Create(BufZip: pByteArray; Size: cardinal);
var
  lhr: ^TLastHeader;
  h: ^TFileHeader;
  lfhr: ^TLocalFileHeader;
  i, j, L: integer;
  p: PAnsiChar;
begin
  for i := 0 to 31 do begin // resources size may be rounded up to alignment
    lhr := @BufZip[Size - sizeof(lhr^)];
    if lhr^.signature + 1 = $06054b51 then // +1 to avoid finding it in the exe
      break;
    dec(Size);
    if Size <= sizeof(lhr^) then
      break;
  end;
  if lhr^.signature + 1 <> $06054b51 then begin // +1 to avoid finding it
    UnMap;
    MessageBox(0, 'ZIP format', nil, MB_SYSTEMMODAL or MB_ICONERROR);
    exit;
  end;
  if lhr^.headerOffset > Size then
    exit;
  SetLength(Entry, lhr^.totalFiles); // fill Entry[] with the Zip headers
  H := @BufZip[lhr^.headerOffset];
  for i := 1 to lhr^.totalFiles do begin
    if H^.signature + 1 <> $02014b51 then begin // +1 to avoid finding it
      UnMap;
      MessageBox(0, 'ZIP format', nil, MB_SYSTEMMODAL or MB_ICONERROR);
      exit;
    end;
    lfhr := @BufZip[H^.localHeadOff];
    with Entry[Count] do begin
      info := @lfhr^.fileInfo;
      p := PAnsiChar(lfhr) + sizeof(lfhr^);
      data := p + info^.NameLen + info^.extraLen; // data are still mapped in memory
      if info^.NameLen >= High(Name) - 1 then // avoid GPF with huge Name[]
        L := High(Name) - 1
      else
        L := info^.NameLen;
      j := 0;
      repeat
        if p^ = '/' then // normalize path delimiter
          Name[j] := '\'
        else
          Name[j] := p^;
        inc(j);
        inc(p);
      until j = L;
      Name[j] := #0; // make ASCIIZ
      inc(PByte(H), sizeof(H^) + info^.NameLen + H^.fileInfo.extraLen + H^.commentLen);
      if (info^.zZipMethod in [0, 8]) and (Name[j - 1] <> '\') then
        inc(Count); // known methods: stored + deflate
    end;
  end;
end;

constructor TZipRead.Create(Instance: THandle; const ResName: string; ResType: PChar);
// locked resources are memory map of the executable -> direct access is easy
var
  HResInfo: THandle;
  HGlobal: THandle;
begin
  HResInfo := FindResource(Instance, PChar(ResName), ResType);
  if HResInfo = 0 then
    exit;
  HGlobal := LoadResource(HInstance, HResInfo);
  if HGlobal <> 0 then
    // warning: resources size may be rounded up to alignment
    Create(LockResource(HGlobal), SizeofResource(HInstance, HResInfo));
end;

constructor TZipRead.Create(const aFileName: TFileName; ZipStartOffset, Size:
  cardinal; ShowMessageBoxOnError: boolean);
var
  i, ExeOffset: integer;
begin
  fShowMessageBoxOnError := ShowMessageBoxOnError;
  file_ := CreateFile(pointer(aFileName), GENERIC_READ, FILE_SHARE_READ, nil,
    OPEN_EXISTING, 0, 0);
  if not ValidHandle(file_) then
    exit; // file doesn't exist -> leave no Entry[] (Count=0)
  if Size = 0 then
    Size := GetFileSize(file_, nil);
  map := CreateFileMapping(file_, nil, PAGE_READONLY, 0, 0, nil);
  if map = 0 then begin
    Unmap;
    if ShowMessageBoxOnError then
      MessageBox(0, pointer(aFileName), 'No File', MB_SYSTEMMODAL or MB_ICONERROR);
    exit;
  end;
  Buf := MapViewOfFile(map, FILE_MAP_READ, 0, 0, 0);
  ExeOffset := -1;
  for i := ZipStartOffset to Size - 5 do
    if pCardinal(@buf[i])^ + 1 = $04034b51 then begin // +1 to avoid finding it in the exe
      ExeOffset := i;
      break;
    end;
  if ExeOffset < 0 then begin
    Unmap;
    if ShowMessageBoxOnError then
      MessageBox(0, 'No ZIP found', nil, MB_SYSTEMMODAL or MB_ICONERROR);
    exit;
  end;
  fZipStartOffset := ExeOffset;
  Create(@Buf[ExeOffset], integer(Size) - ExeOffset);
end;

procedure TZipRead.UnMap;
begin
  Count := 0;
  if ValidHandle(file_) then begin
    if map <> 0 then begin
      UnmapViewOfFile(Buf);
      CloseHandle(map);
    end;
    CloseHandle(file_);
    file_ := 0;
  end;
  Buf := nil;
end;

destructor TZipRead.Destroy;
begin
  UnMap;
  inherited;
end;

function StrICompAnsi(Str1, Str2: PAnsiChar): integer;
var
  C1, C2: AnsiChar;
begin
  if Str1 <> Str2 then
    if Str1 <> nil then
      if Str2 <> nil then begin
        repeat
          C1 := Str1^;
          C2 := Str2^;
          if C1 in ['a'..'z'] then
            dec(C1, 32);
          if C2 in ['a'..'z'] then
            dec(C2, 32);
          if (C1 <> C2) or (C1 = #0) then
            break;
          inc(Str1);
          inc(Str2);
        until false;
        result := ord(C1) - ord(C2);
      end
      else
        result := 1 // Str2=''
    else
      result := -1  // Str1=''
  else
    result := 0;    // Str1=Str2
end;

function TZipRead.NameToIndex(const aZipName: TZipName): integer;
begin
  if (self <> nil) and (aZipName <> '') then
    for result := 0 to Count - 1 do
      if StrICompAnsi(@Entry[result].Name, pointer(aZipName)) = 0 then
        exit;
  result := -1;
end;

function TZipRead.UnZip(aIndex: integer): RawByteZip;
var
  len: cardinal;
begin
  result := ''; // somewhat faster if memory is reallocated each time
  if cardinal(aIndex) >= cardinal(Count) then
    exit;
  with Entry[aIndex] do begin
    SetLength(result, info^.zfullSize);
    if info^.zZipMethod = 0 then begin // stored method
      len := info^.zfullsize;
      move(data^, pointer(result)^, len);
    end
    else // deflate method
      len := UnCompressMem(data, pointer(result), info^.zzipsize, info^.zfullsize);
    if (len <> info^.zfullsize) or
       (info^.zcrc32 <> not UpdateCrc32(dword(-1), pointer(result), info^.zfullSize)) then
      result := '';
  end;
end;

{$ifdef DELPHI5OROLDER}
function DirectoryExists(const Directory: string): boolean;
var
  Code: integer;
begin
  Code := GetFileAttributes(pointer(Directory));
  result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0);
end;
{$endif}

function ForceDirectories(const Dir: TFileName): boolean;
begin
  if (Length(Dir) < 3) or DirectoryExists(Dir) or (ExtractFileDir(Dir) = Dir)
    then // avoid 'x:\' problem.
    result := true
  else
    result := ForceDirectories(ExtractFileDir(Dir)) and CreateDir(Dir);
end;

function TZipRead.CheckFile(aIndex: integer; DestPath: TFileName): boolean;
var
  F, map: THandle;
  Buf: pointer;
  Size: cardinal;
begin
  result := false;
  if (cardinal(aIndex) >= cardinal(Count)) or (DestPath = '') then
    exit;
  if DestPath[length(DestPath)] <> '\' then
    DestPath := DestPath + '\';
  F := CreateFile(pointer(DestPath + Entry[aIndex].Name), GENERIC_READ,
    FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0);
  if ValidHandle(F) then
    with Entry[aIndex] do
    try
      Size := GetFileSize(F, nil);
      if Size <> info^.zFullSize then
        exit;
      if Size = 0 then
        result := true
      else begin
        map := CreateFileMapping(F, nil, PAGE_READONLY, 0, 0, nil);
        if map = 0 then
          exit;
        Buf := MapViewOfFile(map, FILE_MAP_READ, 0, 0, 0);
        if (Buf <> nil) and (info^.zcrc32 =
            not UpdateCrc32(dword(-1), Buf, info^.zfullSize)) then
          result := true;
        UnmapViewOfFile(Buf);
        CloseHandle(map);
      end;
    finally
      CloseHandle(F);
    end;
end;

function TZipRead.UnZipFile(aIndex: integer; DestPath: TFileName;
  ForceWriteFlush: boolean): boolean;
var
  n, f: TFileName;
  buf: pointer;
{$ifdef TRIMDIRECTORYNAME}
  i: integer;
{$endif}
  fFileSize, len: cardinal;
  H: THandle;
  fFileTime, dFileTime: TFileTime;
begin
  result := false;
  if (cardinal(aIndex) >= cardinal(Count)) or (DestPath = '') then
    exit;
  if DestPath[Length(DestPath)] = '\' then
    SetLength(DestPath, Length(DestPath) - 1);
  if not DirectoryExists(DestPath) then
    exit;
  if DestPath[length(DestPath)] <> '\' then
    DestPath := DestPath + '\';
  with Entry[aIndex] do begin
    DosDateTimeToFileTime(info^.zlastModDate, info^.zlastModTime, dFileTime);
    n := TFileName(Name);
{$ifdef TRIMDIRECTORYNAME}
    i := pos('\', n);
    if i > 0 then
      delete(n, 1, i); // trim directory name
{$endif}
    f := DestPath + n;
    H := FileOpen(f, fmOpenRead);
    if ValidHandle(H) then begin
      GetFileTime(H, nil, nil, @fFileTime);
      FileTimeToLocalFileTime(fFileTime, fFileTime);
      fFileSize := GetFileSize(H, nil);
      FileClose(H);
      if (Int64(dFileTime) = Int64(fFileTime)) and (info^.zfullsize = fFileSize)
        then begin
        result := true;
        exit; // good file is already there: don't overwrite for nothing
      end;
      while not Windows.DeleteFile(pointer(f)) do // delete wrong version
        MessageBox(0, pointer('File ' + UpperCase(n) + ' is still in use.'#13#13
          + 'Please Close it for update.'), nil, mb_iconerror);
    end;
    ForceDirectories(ExtractFileDir(f));
    H := FileCreate(f);
    if ValidHandle(H) then
    try
      if info^.zZipMethod = 0 then begin // stored method
        if info^.zcrc32 <> not UpdateCrc32(dword(-1), data, info^.zfullSize) then
          exit;
        FileWrite(H, data^, info^.zfullsize);
      end
      else begin // deflate method
        GetMem(buf, info^.zfullsize);
        try
          len := UnCompressMem(data, buf, info^.zzipsize, info^.zfullsize);
          if (len <> info^.zfullsize) or
             (info^.zcrc32 <> not UpdateCrc32(dword(-1), buf, info^.zfullSize)) then
            exit;
          FileWrite(H, buf^, info^.zfullsize);
        finally
          FreeMem(buf);
        end;
      end;
      if LocalFileTimeToFileTime(dFileTime, fFileTime) and
         SetFileTime(H, @fFileTime, @fFileTime, @fFileTime) then
        result := true;
      if ForceWriteFlush then
        FlushFileBuffers(H);
    finally
      FileClose(H);
    end;
  end;
end;

function TZipRead.GetInitialExeContent: RawByteZip;
begin
  if (self = nil) or (Buf = nil) or (Count = 0) or (ZipStartOffset = 0) then
    result := ''
  else
    SetString(result, PAnsiChar(Buf), ZipStartOffset);
end;


{ TZipWrite }

procedure TZipWrite.AddDeflated(const aZipName: TZipName; Buf: pointer; Size,
  CompressLevel, FileAge: integer);
var
  tmp: pointer;
  tmpsize: integer;
begin
  if (self = nil) or not ValidHandle(Handle) then
    exit;
  if Count >= length(Entry) then
    SetLength(Entry, length(Entry) + 20);
  with Entry[Count] do begin
    name := aZipName;
    with fhr, fileInfo do begin
      signature := $02014b50 + 1;
      dec(signature); // +1 to avoid finding it in the exe
      madeBy := $14;
      neededVersion := $14;
      nameLen := length(name);
      zcrc32 := not UpdateCrc32(dword(-1), Buf, Size);
      zfullSize := Size;
      zzipMethod := 8; // deflate
      PInteger(@zlastModTime)^ := FileAge;
      localHeadOff := SetFilePointer(Handle, 0, nil, FILE_CURRENT) - fAppendOffset;
      tmpsize := (Size * 11) div 10 + 12;
      Getmem(tmp, tmpSize);
      zzipSize := CompressMem(Buf, tmp, Size, tmpSize);
      FileWrite(Handle, fMagic, 4);
      FileWrite(Handle, fileInfo, sizeof(fileInfo));
      FileWrite(Handle, pointer(name)^, nameLen);
      FileWrite(Handle, tmp^, zzipSize); // write stored data
      Freemem(tmp);
    end;
  end;
  inc(Count);
end;

procedure TZipWrite.AddDeflated(const aFileName: TFileName; RemovePath: boolean;
  CompressLevel: integer);
var
  H: THandle;
  buf: pointer;
  Size: integer;
  Time: TFileTime;
  ZipName: TZipName;
  FileTime: LongRec;
begin
  H := FileOpen(aFileName, fmOpenRead or fmShareDenyNone);
  if ValidHandle(H) then
  try
    if RemovePath then
      ZipName := TZipName(ExtractFileName(aFileName))
    else
      ZipName := TZipName(aFileName);
    GetFileTime(H, nil, nil, @Time);
    FileTimeToLocalFileTime(Time, Time);
    FileTimeToDosDateTime(Time, FileTime.Hi, FileTime.Lo);
    Size := GetFileSize(H, nil);
    getmem(buf, Size);
    try
      FileRead(H, buf^, Size);
      AddDeflated(ZipName, buf, size, CompressLevel, integer(FileTime));
    finally
      freemem(buf);
    end;
  finally
    FileClose(H);
  end;
end;

procedure TZipWrite.AddFromZip(const ZipEntry: TZipEntry);
begin
  if (self = nil) or not ValidHandle(Handle) then
    exit;
  if Count >= length(Entry) then
    SetLength(Entry, length(Entry) + 20);
  with Entry[Count] do begin
    name := ZipEntry.Name;
    with fhr do begin
      signature := $02014b50 + 1;
      dec(signature); // +1 to avoid finding it in the exe
      madeBy := $14;
      fileInfo := ZipEntry.info^;
      fileInfo.nameLen := length(name);
      localHeadOff := SetFilePointer(Handle, 0, nil, FILE_CURRENT) - fAppendOffset;
      FileWrite(Handle, fMagic, 4);
      FileWrite(Handle, fileInfo, sizeof(fileInfo));
      FileWrite(Handle, pointer(name)^, fileInfo.nameLen);
      FileWrite(Handle, ZipEntry.data^, fileInfo.zzipSize);
    end;
  end;
  inc(Count);
end;

procedure TZipWrite.AddStored(const aZipName: TZipName; Buf: pointer; Size,
  FileAge: integer);
begin
  if (self = nil) or not ValidHandle(Handle) then
    exit;
  if Count >= length(Entry) then
    SetLength(Entry, length(Entry) + 20);
  with Entry[Count] do begin
    name := aZipName;
    with fhr, fileInfo do begin
      signature := $02014b50 + 1;
      dec(signature); // +1 to avoid finding it in the exe
      madeBy := $14;
      neededVersion := $14;
      nameLen := length(name);
      zcrc32 := not UpdateCrc32(dword(-1), Buf, Size);
      zfullSize := Size;
      zzipSize := Size;
      PInteger(@zlastModTime)^ := FileAge;
      localHeadOff := SetFilePointer(Handle, 0, nil, FILE_CURRENT) - fAppendOffset;
      FileWrite(Handle, fMagic, 4);
      FileWrite(Handle, fileInfo, sizeof(fileInfo));
      FileWrite(Handle, pointer(name)^, nameLen);
      FileWrite(Handle, Buf^, Size); // write stored data
    end;
  end;
  inc(Count);
end;

procedure TZipWrite.Append(const Content: RawByteZip);
begin
  if (self = nil) or not ValidHandle(Handle) or
    (fAppendOffset <> 0) then
    exit;
  fAppendOffset := length(Content);
  FileWrite(Handle, pointer(Content)^, fAppendOffset);
end;

constructor TZipWrite.Create(const aFileName: TFileName);
begin
  Handle := FileCreate(aFileName);
  fFileName := aFileName;
  fMagic := $04034b50 + 1; // +1 to avoid finding it in the exe
  dec(fMagic);
end;

destructor TZipWrite.Destroy;
var
  lhr: TLastHeader;
  i: integer;
begin
  fillchar(lhr, sizeof(lhr), 0);
  lhr.signature := $06054b50 + 1;
  dec(lhr.signature); // +1 to avoid finding it in the exe
  lhr.thisFiles := Count;
  lhr.totalFiles := Count;
  lhr.headerOffset := SetFilePointer(Handle, 0, nil, FILE_CURRENT) - fAppendOffset;
  for i := 0 to Count - 1 do
    with Entry[i] do begin
    //assert(fhr.fileInfo.nameLen=length(name));
      inc(lhr.headerSize, sizeof(TFileHeader) + fhr.fileInfo.nameLen);
      FileWrite(Handle, fhr, sizeof(fhr));
      FileWrite(Handle, pointer(Name)^, fhr.fileInfo.nameLen);
    end;
  FileWrite(Handle, lhr, sizeof(lhr));
  SetEndOfFile(Handle);
  FileClose(Handle);
{  with TZipRead.Create(fFileName) do
  try
    assert(Count=self.Count);
    for i := 0 to Count-1 do
      assert(Entry[i].Name=self.Entry[i].Name);
  finally
    Free;
  end;}
  inherited;
end;

{$endif MSWINDOWS}

initialization
{$ifdef DYNAMIC_CRC_TABLE}
  InitCrc32Tab;
{$endif DYNAMIC_CRC_TABLE}

end.