Browse Source

Fixed FreePascal 3.0.4 decompression bug

PascalCoin 6 years ago
parent
commit
5c8c15d46b

+ 11 - 1
src/core/UChunk.pas

@@ -23,7 +23,17 @@ unit UChunk;
 interface
 interface
 
 
 uses
 uses
-  Classes, SysUtils,  ZLib, {$IFDEF FPC} zStream, {$ENDIF}
+  Classes, SysUtils,
+  {$IFDEF FPC}
+    // NOTE:
+    // Due to FreePascal 3.0.4 (and earlier) bug, will not use internal "paszlib" package, use modified instead
+    // Updated on PascalCoin v4.0.2
+    {$IFDEF VER3_2}
+      zStream, // <- Not used in current FreePascal v3.0.4 caused by a bug: https://bugs.freepascal.org/view.php?id=34422
+    {$ELSE}
+      paszlib_zStream,
+    {$ENDIF}
+  {$ENDIF}
   UAccounts, ULog, UConst, UCrypto;
   UAccounts, ULog, UConst, UCrypto;
 
 
 type
 type

+ 12 - 0
src/libraries/paszlib/README.txt

@@ -0,0 +1,12 @@
+About paszlib units
+
+On October 2018 a bug on decompress ZLIB functions was found on PascalCoin core
+After some tests, the bug was related to a bug on FreePascal paszlib package (Latest release version was FreePascal 3.0.4)
+
+After notified at FreePascal bugtracker ( https://bugs.freepascal.org/view.php?id=34422 ) the solution was to wait until next FreePascal release
+
+In order to solve, the solution applyed for PascalCoin core was to download fixed FreePascal paszlib package and include in PascalCoin core while using FreePascal 3.0.4 compiler
+
+In future, once FreePascal releases a new FreePascal version with bug fixed, those manually added files will not be needed
+
+Added on PascalCoin core on 2018-12-12  (Available for PascalCoin version 4.0.2)

+ 111 - 0
src/libraries/paszlib/paszlib_adler.pas

@@ -0,0 +1,111 @@
+unit paszlib_adler;
+
+{
+  adler32.c -- compute the Adler-32 checksum of a data stream
+  Copyright (C) 1995-1998 Mark Adler
+
+  Pascal tranlastion
+  Copyright (C) 1998 by Jacques Nomssi Nzali
+  For conditions of distribution and use, see copyright notice in readme.txt
+}
+
+interface
+
+{$I paszlib_zconf.inc}
+
+function adler32(adler : cardinal; buf : Pbyte; len : cardinal) : cardinal;
+
+{    Update a running Adler-32 checksum with the bytes buf[0..len-1] and
+   return the updated checksum. If buf is NIL, this function returns
+   the required initial value for the checksum.
+   An Adler-32 checksum is almost as reliable as a CRC32 but can be computed
+   much faster. Usage example:
+
+   var
+     adler : cardinal;
+   begin
+     adler := adler32(0, nil, 0);
+
+     while (read_buffer(buffer, length) <> EOF) do
+       adler := adler32(adler, buffer, length);
+
+     if (adler <> original_adler) then
+       error();
+   end;
+}
+
+implementation
+
+const
+  BASE = cardinal(65521); { largest prime smaller than 65536 }
+  {NMAX = 5552; original code with unsigned 32 bit integer }
+  { NMAX is the largest n such that 255n(n+1)/2 + (n+1)(BASE-1) <= 2^32-1 }
+  NMAX = 3854;        { code with signed 32 bit integer }
+  { NMAX is the largest n such that 255n(n+1)/2 + (n+1)(BASE-1) <= 2^31-1 }
+  { The penalty is the time loss in the extra MOD-calls. }
+
+
+{ ========================================================================= }
+
+function adler32(adler : cardinal; buf : Pbyte; len : cardinal) : cardinal;
+var
+  s1, s2 : cardinal;
+  k : integer;
+begin
+  s1 := adler and $ffff;
+  s2 := (adler shr 16) and $ffff;
+
+  if not Assigned(buf) then
+  begin
+    adler32 := cardinal(1);
+    exit;
+  end;
+
+  while (len > 0) do
+  begin
+    if len < NMAX then
+      k := len
+    else
+      k := NMAX;
+    Dec(len, k);
+    {
+    while (k >= 16) do
+    begin
+      DO16(buf);
+      Inc(buf, 16);
+      Dec(k, 16);
+    end;
+    if (k <> 0) then
+    repeat
+      Inc(s1, buf^);
+      Inc(puf);
+      Inc(s2, s1);
+      Dec(k);
+    until (k = 0);
+    }
+    while (k > 0) do
+    begin
+      Inc(s1, buf^);
+      Inc(s2, s1);
+      Inc(buf);
+      Dec(k);
+    end;
+    s1 := s1 mod BASE;
+    s2 := s2 mod BASE;
+  end;
+  adler32 := (s2 shl 16) or s1;
+end;
+
+{
+#define DO1(buf,i)
+  begin
+    Inc(s1, buf[i]);
+    Inc(s2, s1);
+  end;
+#define DO2(buf,i)  DO1(buf,i); DO1(buf,i+1);
+#define DO4(buf,i)  DO2(buf,i); DO2(buf,i+2);
+#define DO8(buf,i)  DO4(buf,i); DO4(buf,i+4);
+#define DO16(buf)   DO8(buf,0); DO8(buf,8);
+}
+end.
+

+ 1226 - 0
src/libraries/paszlib/paszlib_gzio.pas

@@ -0,0 +1,1226 @@
+unit paszlib_gzio;
+
+{
+  Pascal unit based on gzio.c -- IO on .gz files
+  Copyright (C) 1995-1998 Jean-loup Gailly.
+
+  Define NO_DEFLATE to compile this file without the compression code
+
+  Pascal tranlastion based on code contributed by Francisco Javier Crespo
+  Copyright (C) 1998 by Jacques Nomssi Nzali
+  For conditions of distribution and use, see copyright notice in readme.txt
+}
+
+interface
+{$mode objfpc}
+{$I paszlib_zconf.inc}
+
+uses
+  {$ifdef UNIX}
+  baseunix,
+  {$else}
+  dos,
+  {$endif}
+  paszlib_zbase, crc, paszlib_zdeflate, paszlib_zinflate;
+
+type gzFile = pointer;
+type z_off_t = int64;
+
+function gzopen  (path:string; mode:string) : gzFile;
+function gzread  (f:gzFile; buf:pointer; len:cardinal) : integer;
+function gzgetc  (f:gzfile) : integer;
+function gzgets  (f:gzfile; buf:Pchar; len:integer) : Pchar;
+
+{$ifndef NO_DEFLATE}
+function gzwrite (f:gzFile; buf:pointer; len:cardinal) : integer;
+function gzputc  (f:gzfile; c:char) : integer;
+function gzputs  (f:gzfile; s:Pchar) : integer;
+function gzflush (f:gzFile; flush:integer)           : integer;
+  {$ifdef GZ_FORMAT_STRING}
+  function gzprintf (zfile : gzFile;
+                     const format : string;
+                     a : array of integer);    { doesn't compile }
+  {$endif}
+{$endif}
+
+function gzseek  (f:gzfile; offset:z_off_t; whence:integer) : z_off_t;
+function gztell  (f:gzfile) : z_off_t;
+function gzclose (f:gzFile)                      : integer;
+function gzerror (f:gzFile; var errnum:smallint)      : string;
+function gzsetparams (f:gzfile; level:integer; strategy:integer) : integer;
+function gzrewind (f:gzFile) : integer;
+function gzeof (f:gzfile) : boolean;
+
+const
+  SEEK_SET {: z_off_t} = 0; { seek from beginning of file }
+  SEEK_CUR {: z_off_t} = 1; { seek from current position }
+  SEEK_END {: z_off_t} = 2;
+
+implementation
+
+const
+  Z_EOF = -1;         { same value as in STDIO.H }
+  Z_BUFSIZE = 16384;
+  { Z_PRINTF_BUFSIZE = 4096; }
+
+
+  gz_magic : array[0..1] of byte = ($1F, $8B); { gzip magic header }
+
+  { gzip flag byte }
+
+  ASCII_FLAG  = $01; { bit 0 set: file probably ascii text }
+  HEAD_CRC    = $02; { bit 1 set: header CRC present }
+  EXTRA_FIELD = $04; { bit 2 set: extra field present }
+  ORIG_NAME   = $08; { bit 3 set: original file name present }
+  COMMENT     = $10; { bit 4 set: file comment present }
+  RESERVED    = $E0; { bits 5..7: reserved }
+
+type gz_stream = record
+  stream      : z_stream;
+  z_err       : integer;      { error code for last stream operation }
+  z_eof       : boolean;  { set if end of input file }
+  gzfile      : file;     { .gz file }
+  inbuf       : Pbyte;   { input buffer }
+  outbuf      : Pbyte;   { output buffer }
+  crc         : cardinal;    { crc32 of uncompressed data }
+  msg,                    { error message - limit 79 chars }
+  path        : string[79];   { path name for debugging only - limit 79 chars }
+  transparent : boolean;  { true if input file is not a .gz file }
+  mode        : char;     { 'w' or 'r' }
+  startpos    : longint;     { start of compressed data in file (header skipped) }
+end;
+
+type gz_streamp = ^gz_stream;
+
+function destroy (var s:gz_streamp) : integer; forward;
+procedure check_header(s:gz_streamp); forward;
+
+
+{ GZOPEN ====================================================================
+
+  Opens a gzip (.gz) file for reading or writing. As Pascal does not use
+  file descriptors, the code has been changed to accept only path names.
+
+  The mode parameter defaults to BINARY read or write operations ('r' or 'w')
+  but can also include a compression level ('w9') or a strategy: Z_FILTERED
+  as in 'w6f' or Z_HUFFMAN_ONLY as in 'w1h'. (See the description of
+  deflateInit2 for more information about the strategy parameter.)
+
+  gzopen can be used to open a file which is not in gzip format; in this
+  case, gzread will directly read from the file without decompression.
+
+  gzopen returns nil if the file could not be opened (non-zero IOResult)
+  or if there was insufficient memory to allocate the (de)compression state
+  (zlib error is Z_MEM_ERROR).
+
+============================================================================}
+
+function gzopen (path:string; mode:string) : gzFile;
+
+var
+
+  i        : cardinal;
+  err      : integer;
+  level    : integer;        { compression level }
+  strategy : integer;        { compression strategy }
+  s        : gz_streamp;
+{$ifdef UNIX}
+  info:      stat;
+{$else}
+  attr:      word;
+{$endif}
+
+{$IFNDEF NO_DEFLATE}
+  gzheader : array [0..9] of byte;
+{$ENDIF}
+  doseek,
+  exists,
+  writing : boolean;
+  old_file_mode: byte;
+begin
+
+  if (path='') or (mode='') then begin
+    gzopen := nil;
+    exit;
+  end;
+
+  GetMem (s,sizeof(gz_stream));
+  if not Assigned (s) then begin
+    gzopen := nil;
+    exit;
+  end;
+
+  level := Z_DEFAULT_COMPRESSION;
+  strategy := Z_DEFAULT_STRATEGY;
+
+  s^.stream.next_in := nil;
+  s^.stream.next_out := nil;
+  s^.stream.avail_in := 0;
+  s^.stream.avail_out := 0;
+  s^.z_err := Z_OK;
+  s^.z_eof := false;
+  s^.inbuf := nil;
+  s^.outbuf := nil;
+  s^.crc := crc32(0, nil, 0);
+  s^.msg := '';
+  s^.transparent := false;
+
+  s^.path := path; { limit to 255 chars }
+
+  s^.mode := #0;
+  for i:=1 to Length(mode) do begin
+    case mode[i] of
+      'r'      : s^.mode := 'r';
+      'w'      : s^.mode := 'w';
+      'a'      : s^.mode := 'a';
+      '0'..'9' : level := Ord(mode[i])-Ord('0');
+      'f'      : strategy := Z_FILTERED;
+      'h'      : strategy := Z_HUFFMAN_ONLY;
+    end;
+  end;
+  if s^.mode=#0 then begin
+    destroy(s);
+    gzopen := nil;
+    exit;
+  end;
+
+  writing:=( s^.mode='a') or (s^.mode='w');
+
+  if writing then begin
+{$IFDEF NO_DEFLATE}
+    err := Z_STREAM_ERROR;
+{$ELSE}
+    err := deflateInit2 (s^.stream, level, Z_DEFLATED, -MAX_WBITS,
+                         DEF_MEM_LEVEL, strategy);
+        { windowBits is passed < 0 to suppress zlib header }
+
+    GetMem (s^.outbuf, Z_BUFSIZE);
+    s^.stream.next_out := s^.outbuf;
+{$ENDIF}
+    if (err <> Z_OK) or (s^.outbuf = nil) then begin
+      destroy(s);
+      gzopen := gzFile(nil);
+      exit;
+    end;
+  end
+
+  else begin
+    GetMem (s^.inbuf, Z_BUFSIZE);
+    s^.stream.next_in := s^.inbuf;
+
+    err := inflateInit2_ (s^.stream, -MAX_WBITS, ZLIB_VERSION, sizeof(z_stream));
+        { windowBits is passed < 0 to tell that there is no zlib header }
+
+    if (err <> Z_OK) or (s^.inbuf = nil) then begin
+      destroy(s);
+      gzopen := gzFile(nil);
+      exit;
+    end;
+  end;
+
+  s^.stream.avail_out := Z_BUFSIZE;
+
+  {$PUSH} {$I-}
+  Assign (s^.gzfile, path);
+  {$ifdef unix}
+    exists:=not (fpstat(path,info)<0);
+  {$else}
+    GetFAttr(s^.gzfile, Attr);
+    exists:=(DosError= 0);
+  {$endif}
+
+  doseek:=false;
+  if ((s^.mode='a') and not exists) or (s^.mode='w') then
+    begin
+    ReWrite (s^.gzfile,1)
+    end
+  else
+    begin
+      old_file_mode := FileMode;
+      FileMode := 0;
+      Reset (s^.gzfile,1);
+      FileMode := old_file_mode;
+      if s^.mode='a' then
+        doseek:=true;      // seek AFTER I/O check.
+    end;
+
+  {$POP}
+  if (IOResult <> 0) then begin
+    destroy(s);
+    gzopen := gzFile(nil);
+    exit;
+  end;
+  // append binary file.
+  if doseek then
+     seek(s^.gzfile,filesize(s^.gzfile));
+
+  if s^.mode='a' then
+    s^.mode:='w';   // difference append<->write doesn't matter anymore
+  if writing then begin { Write a very simple .gz header }
+{$IFNDEF NO_DEFLATE}
+    gzheader [0] := gz_magic [0];
+    gzheader [1] := gz_magic [1];
+    gzheader [2] := Z_DEFLATED;   { method }
+    gzheader [3] := 0;            { flags }
+    gzheader [4] := 0;            { time[0] }
+    gzheader [5] := 0;            { time[1] }
+    gzheader [6] := 0;            { time[2] }
+    gzheader [7] := 0;            { time[3] }
+    gzheader [8] := 0;            { xflags }
+    gzheader [9] := 0;            { OS code = MS-DOS }
+    blockwrite (s^.gzfile, gzheader, 10);
+    s^.startpos := longint(10);
+{$ENDIF}
+  end
+  else begin
+    check_header(s); { skip the .gz header }
+    s^.startpos := FilePos(s^.gzfile) - s^.stream.avail_in;
+  end;
+
+  gzopen := gzFile(s);
+end;
+
+
+{ GZSETPARAMS ===============================================================
+
+  Update the compression level and strategy.
+
+============================================================================}
+
+function gzsetparams (f:gzfile; level:integer; strategy:integer) : integer;
+
+var
+
+  s : gz_streamp;
+  written: integer;
+
+begin
+
+  s := gz_streamp(f);
+
+  if (s = nil) or (s^.mode <> 'w') then begin
+    gzsetparams := Z_STREAM_ERROR;
+    exit;
+  end;
+
+  { Make room to allow flushing }
+  if (s^.stream.avail_out = 0) then begin
+    s^.stream.next_out := s^.outbuf;
+    blockwrite(s^.gzfile, s^.outbuf^, Z_BUFSIZE, written);
+    if (written <> Z_BUFSIZE) then s^.z_err := Z_ERRNO;
+    s^.stream.avail_out := Z_BUFSIZE;
+  end;
+
+  gzsetparams := deflateParams (s^.stream, level, strategy);
+end;
+
+
+{ GET_BYTE ==================================================================
+
+  Read a byte from a gz_stream. Updates next_in and avail_in.
+  Returns EOF for end of file.
+  IN assertion: the stream s has been sucessfully opened for reading.
+
+============================================================================}
+
+function get_byte (s:gz_streamp) : integer;
+
+begin
+  if s^.z_eof then begin
+    get_byte := Z_EOF;
+    exit;
+  end;
+
+  if s^.stream.avail_in=0 then begin
+    {$push}{$I-}
+    blockread (s^.gzfile, s^.inbuf^, Z_BUFSIZE, s^.stream.avail_in);
+    {$pop}
+    if s^.stream.avail_in=0 then begin
+      s^.z_eof := true;
+      if (IOResult <> 0) then s^.z_err := Z_ERRNO;
+      get_byte := Z_EOF;
+      exit;
+    end;
+    s^.stream.next_in := s^.inbuf;
+  end;
+
+  Dec(s^.stream.avail_in);
+  get_byte := s^.stream.next_in^;
+  Inc(s^.stream.next_in);
+end;
+
+
+{ GETLONG ===================================================================
+
+   Reads a Longint in LSB order from the given gz_stream.
+
+============================================================================}
+{
+function getLong (s:gz_streamp) : cardinal;
+var
+  x  : array [0..3] of byte;
+  i  : byte;
+  c  : integer;
+  n1 : longint;
+  n2 : longint;
+begin
+
+  for i:=0 to 3 do begin
+    c := get_byte(s);
+    if (c = Z_EOF) then s^.z_err := Z_DATA_ERROR;
+    x[i] := (c and $FF)
+  end;
+  n1 := (ush(x[3] shl 8)) or x[2];
+  n2 := (ush(x[1] shl 8)) or x[0];
+  getlong := (n1 shl 16) or n2;
+end;
+}
+function getLong(s : gz_streamp) : cardinal;
+var
+  x : packed array [0..3] of byte;
+  c : integer;
+begin
+  { x := cardinal(get_byte(s));  - you can't do this with TP, no unsigned longint }
+{$ifdef ENDIAN_BIG}
+  x[3] := Byte(get_byte(s));
+  x[2] := Byte(get_byte(s));
+  x[1] := Byte(get_byte(s));
+  c := get_byte(s);
+  x[0] := Byte(c);
+{$else}
+  x[0] := Byte(get_byte(s));
+  x[1] := Byte(get_byte(s));
+  x[2] := Byte(get_byte(s));
+  c := get_byte(s);
+  x[3] := Byte(c);
+{$endif}
+  if (c = Z_EOF) then
+    s^.z_err := Z_DATA_ERROR;
+  GetLong := cardinal(x);
+end;
+
+
+{ CHECK_HEADER ==============================================================
+
+  Check the gzip header of a gz_stream opened for reading.
+  Set the stream mode to transparent if the gzip magic header is not present.
+  Set s^.err  to Z_DATA_ERROR if the magic header is present but the rest of
+  the header is incorrect.
+
+  IN assertion: the stream s has already been created sucessfully;
+  s^.stream.avail_in is zero for the first time, but may be non-zero
+  for concatenated .gz files
+
+============================================================================}
+
+procedure check_header (s:gz_streamp);
+
+var
+
+  method : integer;  { method byte }
+  flags  : integer;  { flags byte }
+  len    : cardinal;
+  c      : integer;
+
+begin
+
+  { Check the gzip magic header }
+  for len := 0 to 1 do begin
+    c := get_byte(s);
+    if (c <> gz_magic[len]) then begin
+      if (len <> 0) then begin
+        Inc(s^.stream.avail_in);
+        Dec(s^.stream.next_in);
+      end;
+      if (c <> Z_EOF) then begin
+        Inc(s^.stream.avail_in);
+        Dec(s^.stream.next_in);
+	s^.transparent := TRUE;
+      end;
+      if (s^.stream.avail_in <> 0) then s^.z_err := Z_OK
+      else s^.z_err := Z_STREAM_END;
+      exit;
+    end;
+  end;
+
+  method := get_byte(s);
+  flags := get_byte(s);
+  if (method <> Z_DEFLATED) or ((flags and RESERVED) <> 0) then begin
+    s^.z_err := Z_DATA_ERROR;
+    exit;
+  end;
+
+  for len := 0 to 5 do get_byte(s); { Discard time, xflags and OS code }
+
+  if ((flags and EXTRA_FIELD) <> 0) then begin { skip the extra field }
+    len := cardinal(get_byte(s));
+    len := len + (cardinal(get_byte(s)) shl 8);
+    { len is garbage if EOF but the loop below will quit anyway }
+    while (len <> 0) and (get_byte(s) <> Z_EOF) do Dec(len);
+  end;
+
+  if ((flags and ORIG_NAME) <> 0) then begin { skip the original file name }
+    repeat
+      c := get_byte(s);
+    until (c = 0) or (c = Z_EOF);
+  end;
+
+  if ((flags and COMMENT) <> 0) then begin { skip the .gz file comment }
+    repeat
+      c := get_byte(s);
+    until (c = 0) or (c = Z_EOF);
+  end;
+
+  if ((flags and HEAD_CRC) <> 0) then begin { skip the header crc }
+    get_byte(s);
+    get_byte(s);
+  end;
+
+  if (s^.z_eof = true) then
+    s^.z_err := Z_DATA_ERROR
+  else
+    s^.z_err := Z_OK;
+
+end;
+
+
+{ DESTROY ===================================================================
+
+  Cleanup then free the given gz_stream. Return a zlib error code.
+  Try freeing in the reverse order of allocations.
+
+============================================================================}
+
+function destroy (var s:gz_streamp) : integer;
+
+begin
+
+  destroy := Z_OK;
+
+  if not Assigned (s) then begin
+    destroy := Z_STREAM_ERROR;
+    exit;
+  end;
+
+  if (s^.stream.state <> nil) then begin
+    if (s^.mode = 'w') then begin
+{$IFDEF NO_DEFLATE}
+      destroy := Z_STREAM_ERROR;
+{$ELSE}
+      destroy := deflateEnd(s^.stream);
+{$ENDIF}
+    end
+    else if (s^.mode = 'r') then begin
+      destroy := inflateEnd(s^.stream);
+    end;
+  end;
+
+  if s^.path <> '' then begin
+    {$push}{$I-}
+    close(s^.gzfile);
+    {$pop}
+    if (IOResult <> 0) then destroy := Z_ERRNO;
+  end;
+
+  if (s^.z_err < 0) then destroy := s^.z_err;
+
+  if Assigned (s^.inbuf) then
+    FreeMem(s^.inbuf, Z_BUFSIZE);
+  if Assigned (s^.outbuf) then
+    FreeMem(s^.outbuf, Z_BUFSIZE);
+  FreeMem(s, sizeof(gz_stream));
+
+end;
+
+
+{ GZREAD ====================================================================
+
+  Reads the given number of uncompressed bytes from the compressed file.
+  If the input file was not in gzip format, gzread copies the given number
+  of bytes into the buffer.
+
+  gzread returns the number of uncompressed bytes actually read
+  (0 for end of file, -1 for error).
+
+============================================================================}
+
+function gzread (f:gzFile; buf:pointer; len:cardinal) : integer;
+
+var
+
+  s         : gz_streamp;
+  start     : Pbyte;
+  n         : cardinal;
+  crclen    : cardinal;  { Buffer length to update CRC32 }
+  filecrc   : cardinal; { CRC32 stored in GZIP'ed file }
+  filelen   : cardinal; { Total lenght of uncompressed file }
+  bytes     : integer;  { bytes actually read in I/O blockread }
+  total_in  : Qword;
+  total_out : Qword;
+{$ifndef pointer_arith}
+  next_out  : Pbyte;
+{$endif}
+
+begin
+
+  s := gz_streamp(f);
+  start := Pbyte(buf); { starting point for crc computation }
+
+  if (s = nil) or (s^.mode <> 'r') then begin
+    gzread := Z_STREAM_ERROR;
+    exit;
+  end;
+
+  if (s^.z_err = Z_DATA_ERROR) or (s^.z_err = Z_ERRNO) then begin
+    gzread := -1;
+    exit;
+  end;
+
+  if (s^.z_err = Z_STREAM_END) then begin
+    gzread := 0;  { EOF }
+    exit;
+  end;
+
+  s^.stream.next_out := Pbyte(buf);
+  s^.stream.avail_out := len;
+
+  while (s^.stream.avail_out <> 0) do begin
+
+    if (s^.transparent = true) then begin
+      { Copy first the lookahead bytes: }
+      n := s^.stream.avail_in;
+      if (n > s^.stream.avail_out) then n := s^.stream.avail_out;
+      if (n > 0) then begin
+        move(s^.stream.next_in^,s^.stream.next_out^,n);
+        inc (s^.stream.next_out, n);
+        inc (s^.stream.next_in, n);
+        dec (s^.stream.avail_out, n);
+        dec (s^.stream.avail_in, n);
+      end;
+      if (s^.stream.avail_out > 0) then begin
+        blockread (s^.gzfile, s^.stream.next_out^, s^.stream.avail_out, bytes);
+        dec (s^.stream.avail_out, cardinal(bytes));
+      end;
+      dec (len, s^.stream.avail_out);
+      inc (s^.stream.total_in, cardinal(len));
+      inc (s^.stream.total_out, cardinal(len));
+      gzread := integer(len);
+      exit;
+    end; { IF transparent }
+
+    if (s^.stream.avail_in = 0) and (s^.z_eof = false) then begin
+      {$push}{$I-}
+      blockread (s^.gzfile, s^.inbuf^, Z_BUFSIZE, s^.stream.avail_in);
+      {$pop}
+      if (s^.stream.avail_in = 0) then begin
+        s^.z_eof := true;
+	if (IOResult <> 0) then begin
+	  s^.z_err := Z_ERRNO;
+	  break;
+        end;
+      end;
+      s^.stream.next_in := s^.inbuf;
+    end;
+
+    s^.z_err := inflate(s^.stream, Z_NO_FLUSH);
+
+    if (s^.z_err = Z_STREAM_END) then begin
+    {$ifdef pointer_arith}
+      crclen := 0;
+      crclen:=s^.stream.next_out-start;
+    {$else}
+      next_out := s^.stream.next_out;
+      while (next_out <> start ) do begin
+        dec (next_out);
+        inc (crclen);   { Hack because Pascal cannot substract pointers }
+      end;
+    {$endif}
+      { Check CRC and original size }
+      s^.crc := crc32(s^.crc, start, crclen);
+      start := s^.stream.next_out;
+
+      filecrc := getLong (s);
+      filelen := getLong (s);
+
+      if (s^.crc <> filecrc) or (s^.stream.total_out <> filelen)
+        then s^.z_err := Z_DATA_ERROR
+	else begin
+	  { Check for concatenated .gz files: }
+	  check_header(s);
+	  if (s^.z_err = Z_OK) then begin
+            total_in := s^.stream.total_in;
+            total_out := s^.stream.total_out;
+
+	    inflateReset (s^.stream);
+	    s^.stream.total_in := total_in;
+	    s^.stream.total_out := total_out;
+	    s^.crc := crc32 (0, nil, 0);
+	  end;
+      end; {IF-THEN-ELSE}
+    end;
+
+    if (s^.z_err <> Z_OK) or (s^.z_eof = true) then break;
+
+  end; {WHILE}
+
+{$ifdef pointer_arith}
+  crclen:=s^.stream.next_out-start;
+{$else}
+  crclen := 0;
+  next_out := s^.stream.next_out;
+  while (next_out <> start ) do begin
+    dec (next_out);
+    inc (crclen);   { Hack because Pascal cannot substract pointers }
+  end;
+{$endif}
+  s^.crc := crc32 (s^.crc, start, crclen);
+  gzread := integer(len - s^.stream.avail_out);
+
+end;
+
+
+{ GZGETC ====================================================================
+
+  Reads one byte from the compressed file.
+  gzgetc returns this byte or -1 in case of end of file or error.
+
+============================================================================}
+
+function gzgetc (f:gzfile) : integer;
+
+var c:byte;
+
+begin
+
+  if (gzread (f,@c,1) = 1) then gzgetc := c else gzgetc := -1;
+
+end;
+
+
+{ GZGETS ====================================================================
+
+  Reads bytes from the compressed file until len-1 characters are read,
+  or a newline character is read and transferred to buf, or an end-of-file
+  condition is encountered. The string is then Null-terminated.
+
+  gzgets returns buf, or nil in case of error.
+  The current implementation is not optimized at all.
+
+============================================================================}
+
+function gzgets (f:gzfile; buf:Pchar; len:integer) : Pchar;
+
+var
+
+  b      : Pchar; { start of buffer }
+  bytes  : integer;   { number of bytes read by gzread }
+  gzchar : char;  { char read by gzread }
+
+begin
+
+    if (buf = nil) or (len <= 0) then begin
+      gzgets := nil;
+      exit;
+    end;
+
+    b := buf;
+    repeat
+      dec (len);
+      bytes := gzread (f, buf, 1);
+      gzchar := buf^;
+      inc (buf);
+    until (len = 0) or (bytes <> 1) or (gzchar = Chr(13));
+
+    buf^ := #0;
+    if (b = buf) and (len > 0) then gzgets := nil else gzgets := b;
+
+end;
+
+
+{$IFNDEF NO_DEFLATE}
+
+{ GZWRITE ===================================================================
+
+  Writes the given number of uncompressed bytes into the compressed file.
+  gzwrite returns the number of uncompressed bytes actually written
+  (0 in case of error).
+
+============================================================================}
+
+function gzwrite (f:gzfile; buf:pointer; len:cardinal) : integer;
+
+var
+
+  s : gz_streamp;
+  written : integer;
+
+begin
+
+    s := gz_streamp(f);
+
+    if (s = nil) or (s^.mode <> 'w') then begin
+      gzwrite := Z_STREAM_ERROR;
+      exit;
+    end;
+
+    s^.stream.next_in := Pbyte(buf);
+    s^.stream.avail_in := len;
+
+    while (s^.stream.avail_in <> 0) do begin
+
+      if (s^.stream.avail_out = 0) then begin
+        s^.stream.next_out := s^.outbuf;
+        blockwrite (s^.gzfile, s^.outbuf^, Z_BUFSIZE, written);
+        if (written <> Z_BUFSIZE) then begin
+          s^.z_err := Z_ERRNO;
+          break;
+        end;
+        s^.stream.avail_out := Z_BUFSIZE;
+      end;
+
+      s^.z_err := deflate(s^.stream, Z_NO_FLUSH);
+      if (s^.z_err <> Z_OK) then break;
+
+    end; {WHILE}
+
+    s^.crc := crc32(s^.crc, buf, len);
+    gzwrite := integer(len - s^.stream.avail_in);
+
+end;
+
+
+{ ===========================================================================
+   Converts, formats, and writes the args to the compressed file under
+   control of the format string, as in fprintf. gzprintf returns the number of
+   uncompressed bytes actually written (0 in case of error).
+}
+
+{$IFDEF GZ_FORMAT_STRING}
+function gzprintf (zfile : gzFile;
+                   const format : string;
+                   a : array of integer) : integer;
+var
+  buf : array[0..Z_PRINTF_BUFSIZE-1] of char;
+  len : integer;
+begin
+{$ifdef HAS_snprintf}
+    snprintf(buf, sizeof(buf), format, a1, a2, a3, a4, a5, a6, a7, a8,
+	     a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20);
+{$else}
+    sprintf(buf, format, a1, a2, a3, a4, a5, a6, a7, a8,
+	    a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20);
+{$endif}
+    len := strlen(buf); { old sprintf doesn't return the nb of bytes written }
+    if (len <= 0) return 0;
+
+    gzprintf := gzwrite(file, buf, len);
+end;
+{$ENDIF}
+
+
+{ GZPUTC ====================================================================
+
+  Writes c, converted to an unsigned char, into the compressed file.
+  gzputc returns the value that was written, or -1 in case of error.
+
+============================================================================}
+
+function gzputc (f:gzfile; c:char) : integer;
+begin
+  if (gzwrite (f,@c,1) = 1) then
+  {$IFDEF FPC}
+    gzputc := integer(ord(c))
+  {$ELSE}
+    gzputc := integer(c)
+  {$ENDIF}
+  else
+    gzputc := -1;
+end;
+
+
+{ GZPUTS ====================================================================
+
+  Writes the given null-terminated string to the compressed file, excluding
+  the terminating null character.
+  gzputs returns the number of characters written, or -1 in case of error.
+
+============================================================================}
+
+function gzputs (f:gzfile; s:Pchar) : integer;
+begin
+  gzputs := gzwrite (f, pointer(s), strlen(s));
+end;
+
+
+{ DO_FLUSH ==================================================================
+
+  Flushes all pending output into the compressed file.
+  The parameter flush is as in the zdeflate() function.
+
+============================================================================}
+
+function do_flush (f:gzfile; flush:integer) : integer;
+var
+  len     : cardinal;
+  done    : boolean;
+  s       : gz_streamp;
+  written : integer;
+begin
+  done := false;
+  s := gz_streamp(f);
+
+  if (s = nil) or (s^.mode <> 'w') then begin
+    do_flush := Z_STREAM_ERROR;
+    exit;
+  end;
+
+  s^.stream.avail_in := 0; { should be zero already anyway }
+
+  while true do begin
+
+    len := Z_BUFSIZE - s^.stream.avail_out;
+
+    if (len <> 0) then begin
+      {$push}{$I-}
+      blockwrite(s^.gzfile, s^.outbuf^, len, written);
+      {$pop}
+      if (written <> len) then begin
+        s^.z_err := Z_ERRNO;
+        do_flush := Z_ERRNO;
+        exit;
+      end;
+      s^.stream.next_out := s^.outbuf;
+      s^.stream.avail_out := Z_BUFSIZE;
+    end;
+
+    if (done = true) then break;
+    s^.z_err := deflate(s^.stream, flush);
+
+    { Ignore the second of two consecutive flushes: }
+    if (len = 0) and (s^.z_err = Z_BUF_ERROR) then s^.z_err := Z_OK;
+
+    { deflate has finished flushing only when it hasn't used up
+      all the available space in the output buffer: }
+
+    done := (s^.stream.avail_out <> 0) or (s^.z_err = Z_STREAM_END);
+    if (s^.z_err <> Z_OK) and (s^.z_err <> Z_STREAM_END) then break;
+
+  end; {WHILE}
+
+  if (s^.z_err = Z_STREAM_END) then do_flush:=Z_OK else do_flush:=s^.z_err;
+end;
+
+{ GZFLUSH ===================================================================
+
+  Flushes all pending output into the compressed file.
+  The parameter flush is as in the zdeflate() function.
+
+  The return value is the zlib error number (see function gzerror below).
+  gzflush returns Z_OK if the flush parameter is Z_FINISH and all output
+  could be flushed.
+
+  gzflush should be called only when strictly necessary because it can
+  degrade compression.
+
+============================================================================}
+
+function gzflush (f:gzfile; flush:integer) : integer;
+var
+  err : integer;
+  s   : gz_streamp;
+begin
+  s := gz_streamp(f);
+  err := do_flush (f, flush);
+
+  if (err <> 0) then begin
+    gzflush := err;
+    exit;
+  end;
+
+  if (s^.z_err = Z_STREAM_END) then gzflush := Z_OK else gzflush := s^.z_err;
+end;
+
+{$ENDIF} (* NO DEFLATE *)
+
+
+{ GZREWIND ==================================================================
+
+  Rewinds input file.
+
+============================================================================}
+
+function gzrewind (f:gzFile) : integer;
+var
+  s:gz_streamp;
+begin
+  s := gz_streamp(f);
+
+  if (s = nil) or (s^.mode <> 'r') then begin
+    gzrewind := -1;
+    exit;
+  end;
+
+  s^.z_err := Z_OK;
+  s^.z_eof := false;
+  s^.stream.avail_in := 0;
+  s^.stream.next_in := s^.inbuf;
+
+  if (s^.startpos = 0) then begin { not a compressed file }
+    {$push}{$I-}
+    seek (s^.gzfile, 0);
+    {$pop}
+    gzrewind := 0;
+    exit;
+  end;
+
+  inflateReset(s^.stream);
+  {$push}{$I-}
+  seek (s^.gzfile, s^.startpos);
+  {$pop}
+  gzrewind := integer(IOResult);
+  exit;
+end;
+
+
+{ GZSEEK ====================================================================
+
+  Sets the starting position for the next gzread or gzwrite on the given
+  compressed file. The offset represents a number of bytes from the beginning
+  of the uncompressed stream.
+
+  gzseek returns the resulting offset, or -1 in case of error.
+  SEEK_END is not implemented, returns error.
+  In this version of the library, gzseek can be extremely slow.
+
+============================================================================}
+
+function gzseek (f:gzfile; offset:z_off_t; whence:integer) : z_off_t;
+var
+  s : gz_streamp;
+  size : cardinal;
+begin
+  s := gz_streamp(f);
+
+  if (s = nil) or (whence = SEEK_END) or (s^.z_err = Z_ERRNO)
+  or (s^.z_err = Z_DATA_ERROR) then begin
+    gzseek := z_off_t(-1);
+    exit;
+  end;
+
+  if (s^.mode = 'w') then begin
+{$IFDEF NO_DEFLATE}
+    gzseek := z_off_t(-1);
+    exit;
+{$ELSE}
+    if (whence = SEEK_SET) then dec(offset, s^.stream.total_out);
+    if (offset < 0) then begin;
+      gzseek := z_off_t(-1);
+      exit;
+    end;
+
+    { At this point, offset is the number of zero bytes to write. }
+    if s^.inbuf=nil then begin
+      getmem(s^.inbuf,Z_BUFSIZE);
+      fillchar(s^.inbuf^,Z_BUFSIZE,0);
+    end;
+
+    while (offset > 0) do begin
+      size := Z_BUFSIZE;
+      if (offset < Z_BUFSIZE) then size := cardinal(offset);
+
+      size := gzwrite(f, s^.inbuf, size);
+      if (size = 0) then begin
+        gzseek := z_off_t(-1);
+        exit;
+      end;
+
+      dec (offset,size);
+    end;
+
+    gzseek := z_off_t(s^.stream.total_in);
+    exit;
+{$ENDIF}
+  end;
+  { Rest of function is for reading only }
+
+  { compute absolute position }
+  if (whence = SEEK_CUR) then inc (offset, s^.stream.total_out);
+  if (offset < 0) then begin
+    gzseek := z_off_t(-1);
+    exit;
+  end;
+
+  if (s^.transparent = true) then begin
+    s^.stream.avail_in := 0;
+    s^.stream.next_in := s^.inbuf;
+    {$push}{$I-}
+    seek (s^.gzfile, offset);
+    {$pop}
+    if (IOResult <> 0) then begin
+      gzseek := z_off_t(-1);
+      exit;
+    end;
+
+    s^.stream.total_in := offset;
+    s^.stream.total_out := offset;
+    gzseek := offset;
+    exit;
+  end;
+
+  { For a negative seek, rewind and use positive seek }
+  if (cardinal(offset) >= s^.stream.total_out)
+    then dec (offset, s^.stream.total_out)
+    else if (gzrewind(f) <> 0) then begin
+      gzseek := z_off_t(-1);
+      exit;
+  end;
+  { offset is now the number of bytes to skip. }
+
+  if (offset <> 0) and (s^.outbuf = nil)
+  then GetMem (s^.outbuf, Z_BUFSIZE);
+
+  while (offset > 0) do begin
+    size := Z_BUFSIZE;
+    if (offset < Z_BUFSIZE) then size := integer(offset);
+
+    size := gzread (f, s^.outbuf, size);
+    if (size <= 0) then begin
+      gzseek := z_off_t(-1);
+      exit;
+    end;
+    dec(offset, size);
+  end;
+
+  gzseek := z_off_t(s^.stream.total_out);
+end;
+
+
+{ GZTELL ====================================================================
+
+  Returns the starting position for the next gzread or gzwrite on the
+  given compressed file. This position represents a number of bytes in the
+  uncompressed data stream.
+
+============================================================================}
+
+function gztell (f:gzfile) : z_off_t;
+begin
+  gztell := gzseek (f, 0, SEEK_CUR);
+end;
+
+
+{ GZEOF =====================================================================
+
+  Returns TRUE when EOF has previously been detected reading the given
+  input stream, otherwise FALSE.
+
+============================================================================}
+
+function gzeof (f:gzfile) : boolean;
+var
+  s:gz_streamp;
+begin
+  s := gz_streamp(f);
+
+  if (s=nil) or (s^.mode<>'r') then
+    gzeof := false
+  else
+    gzeof := s^.z_eof;
+end;
+
+
+{ PUTLONG ===================================================================
+
+  Outputs a Longint in LSB order to the given file
+
+============================================================================}
+
+procedure putLong (var f:file; x:cardinal);
+var
+  n : integer;
+  c : byte;
+begin
+  for n:=0 to 3 do begin
+    c := x and $FF;
+    blockwrite (f, c, 1);
+    x := x shr 8;
+  end;
+end;
+
+
+{ GZCLOSE ===================================================================
+
+  Flushes all pending output if necessary, closes the compressed file
+  and deallocates all the (de)compression state.
+
+  The return value is the zlib error number (see function gzerror below).
+
+============================================================================}
+
+function gzclose (f:gzFile) : integer;
+var
+  err : integer;
+  s   : gz_streamp;
+begin
+  s := gz_streamp(f);
+  if (s = nil) then begin
+    gzclose := Z_STREAM_ERROR;
+    exit;
+  end;
+
+  if (s^.mode = 'w') then begin
+{$IFDEF NO_DEFLATE}
+    gzclose := Z_STREAM_ERROR;
+    exit;
+{$ELSE}
+  err := do_flush (f, Z_FINISH);
+    if (err <> Z_OK) then begin
+      gzclose := destroy (gz_streamp(f));
+      exit;
+    end;
+
+    putLong (s^.gzfile, s^.crc);
+    putLong (s^.gzfile, s^.stream.total_in and $FFFFFFFF);
+{$ENDIF}
+  end;
+
+  gzclose := destroy (gz_streamp(f));
+end;
+
+
+{ GZERROR ===================================================================
+
+  Returns the error message for the last error which occurred on the
+   given compressed file. errnum is set to zlib error number. If an
+   error occurred in the file system and not in the compression library,
+   errnum is set to Z_ERRNO and the application may consult errno
+   to get the exact error code.
+
+============================================================================}
+
+function gzerror (f:gzfile; var errnum:smallint) : string;
+var
+ m : string;
+ s : gz_streamp;
+begin
+  s := gz_streamp(f);
+  if (s = nil) then begin
+    errnum := Z_STREAM_ERROR;
+    gzerror := zError(Z_STREAM_ERROR);
+    end;
+
+  errnum := s^.z_err;
+  if (errnum = Z_OK) then begin
+    gzerror := zError(Z_OK);
+    exit;
+  end;
+
+  m := s^.stream.msg;
+  if (errnum = Z_ERRNO) then m := '';
+  if (m = '') then m := zError(s^.z_err);
+
+  s^.msg := s^.path+': '+m;
+  gzerror := s^.msg;
+end;
+
+end.

+ 950 - 0
src/libraries/paszlib/paszlib_infblock.pas

@@ -0,0 +1,950 @@
+unit paszlib_infblock;
+
+{$goto on}
+
+{ infblock.h and
+  infblock.c -- interpret and process block types to last block
+  Copyright (C) 1995-1998 Mark Adler
+
+  Pascal tranlastion
+  Copyright (C) 1998 by Jacques Nomssi Nzali
+  For conditions of distribution and use, see copyright notice in readme.txt
+}
+
+interface
+
+{$I paszlib_zconf.inc}
+
+uses
+  paszlib_zbase;
+
+function inflate_blocks_new(var z : z_stream;
+                            c : check_func;  { check function }
+                            w : cardinal     { window size }
+                            ) : pInflate_blocks_state;
+
+function inflate_blocks (var s : inflate_blocks_state;
+                         var z : z_stream;
+                         r : integer             { initial return code }
+                         ) : integer;
+
+procedure inflate_blocks_reset (var s : inflate_blocks_state;
+                                var z : z_stream;
+                                c : Pcardinal); { check value on output }
+
+
+function inflate_blocks_free(s : pInflate_blocks_state;
+                             var z : z_stream) : integer;
+
+procedure inflate_set_dictionary(var s : inflate_blocks_state;
+                                 const d : array of byte;  { dictionary }
+                                 n : cardinal);         { dictionary length }
+
+function inflate_blocks_sync_point(var s : inflate_blocks_state) : integer;
+
+implementation
+
+uses
+  paszlib_infcodes, paszlib_inftrees, paszlib_infutil;
+
+{ Tables for deflate from PKZIP's appnote.txt. }
+Const
+  border : array [0..18] of word  { Order of the bit length code lengths }
+    = (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 define 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 inflate_blocks_reset (var s : inflate_blocks_state;
+                                var z : z_stream;
+                                c : Pcardinal); { check value on output }
+begin
+  if (c <> nil) then
+    c^ := s.check;
+  if (s.mode = BTREE) or (s.mode = DTREE) then
+    freemem(s.sub.trees.blens);
+  if (s.mode = CODES) then
+    inflate_codes_free(s.sub.decode.codes, z);
+
+  s.mode := ZTYPE;
+  s.bitk := 0;
+  s.bitb := 0;
+
+  s.write := s.window;
+  s.read := s.window;
+  if Assigned(s.checkfn) then
+  begin
+    s.check := s.checkfn(cardinal(0), nil, 0);
+    z.adler := s.check;
+  end;
+  {$IFDEF ZLIB_DEBUG}
+  Tracev('inflate:   blocks reset');
+  {$ENDIF}
+end;
+
+
+function inflate_blocks_new(var z : z_stream;
+                            c : check_func;  { check function }
+                            w : cardinal         { window size }
+                            ) : pInflate_blocks_state;
+var
+  s : pInflate_blocks_state;
+begin
+  new(s);
+  if (s = nil) then
+  begin
+    inflate_blocks_new := s;
+    exit;
+  end;
+  getmem(s^.hufts,sizeof(inflate_huft)*MANY);
+
+  if (s^.hufts = nil) then
+  begin
+    dispose(s);
+    inflate_blocks_new := nil;
+    exit;
+  end;
+
+  getmem(s^.window,w);
+  if (s^.window = nil) then
+  begin
+    freemem(s^.hufts);
+    dispose(s);
+    inflate_blocks_new := nil;
+    exit;
+  end;
+  s^.zend := s^.window;
+  Inc(s^.zend, w);
+  s^.checkfn := c;
+  s^.mode := ZTYPE;
+  {$IFDEF ZLIB_DEBUG}  
+  Tracev('inflate:   blocks allocated');
+  {$ENDIF}
+  inflate_blocks_reset(s^, z, nil);
+  inflate_blocks_new := s;
+end;
+
+
+function inflate_blocks (var s : inflate_blocks_state;
+                         var z : z_stream;
+                         r : integer) : integer;           { initial return code }
+label
+  start_btree, start_dtree,
+  start_blkdone, start_dry,
+  start_codes;
+
+var
+  t : cardinal;               { temporary storage }
+  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 }
+var
+  bl, bd : cardinal;
+  tl, td : pInflate_huft;
+var
+  h : pInflate_huft;
+  i, j, c : cardinal;
+var
+  cs : pInflate_codes_state;
+begin
+  { copy input/output information to locals }
+  p := z.next_in;
+  n := z.avail_in;
+  b := s.bitb;
+  k := s.bitk;
+  q := s.write;
+  if ptruint(q) < ptruint(s.read) then
+    m := cardinal(ptruint(s.read)-ptruint(q)-1)
+  else
+    m := cardinal(ptruint(s.zend)-ptruint(q));
+
+{ decompress an inflated block }
+
+
+  { process input based on current state }
+  while True do
+  Case s.mode of
+    ZTYPE:
+      begin
+        {NEEDBITS(3);}
+        while (k < 3) do
+        begin
+          {NEEDBYTE;}
+          if (n <> 0) then
+            r :=Z_OK
+          else
+          begin
+            {UPDATE}
+            s.bitb := b;
+            s.bitk := k;
+            z.avail_in := n;
+            Inc(z.total_in, ptruint(p)-ptruint(z.next_in));
+            z.next_in := p;
+            s.write := q;
+            inflate_blocks := inflate_flush(s,z,r);
+            exit;
+          end;
+          dec(n);
+          b := b or (cardinal(p^) shl k);
+          Inc(p);
+          Inc(k, 8);
+        end;
+
+        t := cardinal(b) and 7;
+        s.last := boolean(t and 1);
+        case (t shr 1) of
+          0:                         { stored }
+            begin
+              {$IFDEF ZLIB_DEBUG}
+              if s.last then
+                Tracev('inflate:     stored block (last)')
+              else
+                Tracev('inflate:     stored block');
+              {$ENDIF}
+              {DUMPBITS(3);}
+              b := b shr 3;
+              dec(k, 3);
+
+              t := k and 7;                  { go to byte boundary }
+              {DUMPBITS(t);}
+              b := b shr t;
+              dec(k, t);
+
+              s.mode := LENS;                { get length of stored block }
+            end;
+          1:                         { fixed }
+            begin
+              begin
+                {$IFDEF ZLIB_DEBUG}
+                if s.last then
+                  Tracev('inflate:     fixed codes blocks (last)')
+                else
+                  Tracev('inflate:     fixed codes blocks');
+                {$ENDIF}
+                inflate_trees_fixed(bl, bd, tl, td, z);
+                s.sub.decode.codes := inflate_codes_new(bl, bd, tl, td, z);
+                if (s.sub.decode.codes = nil) then
+                begin
+                  r := Z_MEM_ERROR;
+                  { update pointers and return }
+                  s.bitb := b;
+                  s.bitk := k;
+                  z.avail_in := n;
+                  Inc(z.total_in, ptruint(p) - ptruint(z.next_in));
+                  z.next_in := p;
+                  s.write := q;
+                  inflate_blocks := inflate_flush(s,z,r);
+                  exit;
+                end;
+              end;
+              {DUMPBITS(3);}
+              b := b shr 3;
+              dec(k, 3);
+
+              s.mode := CODES;
+            end;
+          2:                         { dynamic }
+            begin
+              {$IFDEF ZLIB_DEBUG}
+              if s.last then
+                Tracev('inflate:     dynamic codes block (last)')
+              else
+                Tracev('inflate:     dynamic codes block');
+              {$ENDIF}                
+              {DUMPBITS(3);}
+              b := b shr 3;
+              dec(k, 3);
+
+              s.mode := TABLE;
+            end;
+          3:
+            begin                   { illegal }
+              {DUMPBITS(3);}
+              b := b shr 3;
+              dec(k, 3);
+
+              s.mode := BLKBAD;
+              z.msg := 'invalid block type';
+              r := Z_DATA_ERROR;
+              { update pointers and return }
+              s.bitb := b;
+              s.bitk := k;
+              z.avail_in := n;
+              Inc(z.total_in, ptruint(p) - ptruint(z.next_in));
+              z.next_in := p;
+              s.write := q;
+              inflate_blocks := inflate_flush(s,z,r);
+              exit;
+            end;
+        end;
+      end;
+    LENS:
+      begin
+        {NEEDBITS(32);}
+        while (k < 32) do
+        begin
+          {NEEDBYTE;}
+          if (n <> 0) then
+            r :=Z_OK
+          else
+          begin
+            {UPDATE}
+            s.bitb := b;
+            s.bitk := k;
+            z.avail_in := n;
+            Inc(z.total_in, ptruint(p)-ptruint(z.next_in));
+            z.next_in := p;
+            s.write := q;
+            inflate_blocks := inflate_flush(s,z,r);
+            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 := BLKBAD;
+          z.msg := 'invalid stored block lengths';
+          r := Z_DATA_ERROR;
+          { update pointers and return }
+          s.bitb := b;
+          s.bitk := k;
+          z.avail_in := n;
+          Inc(z.total_in, ptruint(p) - ptruint(z.next_in));
+          z.next_in := p;
+          s.write := q;
+          inflate_blocks := inflate_flush(s,z,r);
+          exit;
+        end;
+        s.sub.left := cardinal(b) and $ffff;
+        k := 0;
+        b := 0;                      { dump bits }
+        {$IFDEF ZLIB_DEBUG}
+        Tracev('inflate:       stored length '+IntToStr(s.sub.left));
+        {$ENDIF}
+        if s.sub.left <> 0 then
+          s.mode := STORED
+        else
+          if s.last then
+            s.mode := DRY
+          else
+            s.mode := ZTYPE;
+      end;
+    STORED:
+      begin
+        if (n = 0) then
+        begin
+          { update pointers and return }
+          s.bitb := b;
+          s.bitk := k;
+          z.avail_in := n;
+          Inc(z.total_in, ptruint(p) - ptruint(z.next_in));
+          z.next_in := p;
+          s.write := q;
+          inflate_blocks := inflate_flush(s,z,r);
+          exit;
+        end;
+        {NEEDOUT}
+        if (m = 0) then
+        begin
+          {WRAP}
+          if (q = s.zend) and (s.read <> s.window) then
+          begin
+            q := s.window;
+            if ptruint(q) < ptruint(s.read) then
+              m := cardinal(ptruint(s.read)-ptruint(q)-1)
+            else
+              m := cardinal(ptruint(s.zend)-ptruint(q));
+          end;
+
+          if (m = 0) then
+          begin
+            {FLUSH}
+            s.write := q;
+            r := inflate_flush(s,z,r);
+            q := s.write;
+            if ptruint(q) < ptruint(s.read) then
+              m := cardinal(ptruint(s.read)-ptruint(q)-1)
+            else
+              m := cardinal(ptruint(s.zend)-ptruint(q));
+
+            {WRAP}
+            if (q = s.zend) and (s.read <> s.window) then
+            begin
+              q := s.window;
+              if ptruint(q) < ptruint(s.read) then
+                m := cardinal(ptruint(s.read)-ptruint(q)-1)
+              else
+                m := cardinal(ptruint(s.zend)-ptruint(q));
+            end;
+
+            if (m = 0) then
+            begin
+              {UPDATE}
+              s.bitb := b;
+              s.bitk := k;
+              z.avail_in := n;
+              Inc(z.total_in, ptruint(p)-ptruint(z.next_in));
+              z.next_in := p;
+              s.write := q;
+              inflate_blocks := inflate_flush(s,z,r);
+              exit;
+            end;
+          end;
+        end;
+        r := Z_OK;
+
+        t := s.sub.left;
+        if (t > n) then
+          t := n;
+        if (t > m) then
+          t := m;
+        move(p^,q^,t);
+        inc(p, t);  dec(n, t);
+        inc(q, t);  dec(m, t);
+        dec(s.sub.left, t);
+        if (s.sub.left = 0) then
+        begin
+          {$IFDEF ZLIB_DEBUG}
+          if (ptruint(q) >= ptruint(s.read)) then
+            Tracev('inflate:       stored end '+
+                IntToStr(z.total_out + ptruint(q) - ptruint(s.read)) + ' total out')
+          else
+            Tracev('inflate:       stored end '+
+                    IntToStr(z.total_out + ptruint(s.zend) - ptruint(s.read) +
+                    ptruint(q) - ptruint(s.window)) +  ' total out');
+          {$ENDIF}
+          if s.last then
+            s.mode := DRY
+          else
+            s.mode := ZTYPE;
+        end;
+      end;
+    TABLE:
+      begin
+        {NEEDBITS(14);}
+        while (k < 14) do
+        begin
+          {NEEDBYTE;}
+          if (n <> 0) then
+            r :=Z_OK
+          else
+          begin
+            {UPDATE}
+            s.bitb := b;
+            s.bitk := k;
+            z.avail_in := n;
+            Inc(z.total_in, ptruint(p)-ptruint(z.next_in));
+            z.next_in := p;
+            s.write := q;
+            inflate_blocks := inflate_flush(s,z,r);
+            exit;
+          end;
+          dec(n);
+          b := b or (cardinal(p^) shl k);
+          Inc(p);
+          Inc(k, 8);
+        end;
+
+        t := cardinal(b) and $3fff;
+        s.sub.trees.table := t;
+  {$ifndef PKZIP_BUG_WORKAROUND}
+        if ((t and $1f) > 29) or (((t shr 5) and $1f) > 29) then
+        begin
+          s.mode := BLKBAD;
+          z.msg := 'too many length or distance symbols';
+          r := Z_DATA_ERROR;
+          { update pointers and return }
+          s.bitb := b;
+          s.bitk := k;
+          z.avail_in := n;
+          Inc(z.total_in, ptruint(p) - ptruint(z.next_in));
+          z.next_in := p;
+          s.write := q;
+          inflate_blocks := inflate_flush(s,z,r);
+          exit;
+        end;
+  {$endif}
+        t := 258 + (t and $1f) + ((t shr 5) and $1f);
+        getmem(s.sub.trees.blens,t*sizeof(cardinal));
+        if (s.sub.trees.blens = nil) then
+        begin
+          r := Z_MEM_ERROR;
+          { update pointers and return }
+          s.bitb := b;
+          s.bitk := k;
+          z.avail_in := n;
+          Inc(z.total_in, ptruint(p) - ptruint(z.next_in));
+          z.next_in := p;
+          s.write := q;
+          inflate_blocks := inflate_flush(s,z,r);
+          exit;
+        end;
+        {DUMPBITS(14);}
+        b := b shr 14;
+        dec(k, 14);
+
+        s.sub.trees.index := 0;
+        {$IFDEF ZLIB_DEBUG}
+        Tracev('inflate:       table sizes ok');
+        {$ENDIF}
+        s.mode := BTREE;
+        { fall trough case is handled by the while }
+        { try GOTO for speed - Nomssi }
+        goto start_btree;
+      end;
+    BTREE:
+      begin
+        start_btree:
+        while (s.sub.trees.index < 4 + (s.sub.trees.table shr 10)) do
+        begin
+          {NEEDBITS(3);}
+          while (k < 3) do
+          begin
+            {NEEDBYTE;}
+            if (n <> 0) then
+              r :=Z_OK
+            else
+            begin
+              {UPDATE}
+              s.bitb := b;
+              s.bitk := k;
+              z.avail_in := n;
+              Inc(z.total_in, ptruint(p)-ptruint(z.next_in));
+              z.next_in := p;
+              s.write := q;
+              inflate_blocks := inflate_flush(s,z,r);
+              exit;
+            end;
+            dec(n);
+            b := b or (cardinal(p^) shl k);
+            Inc(p);
+            Inc(k, 8);
+          end;
+
+          s.sub.trees.blens^[border[s.sub.trees.index]] := cardinal(b) and 7;
+          Inc(s.sub.trees.index);
+          {DUMPBITS(3);}
+          b := b shr 3;
+          dec(k, 3);
+        end;
+        while (s.sub.trees.index < 19) do
+        begin
+          s.sub.trees.blens^[border[s.sub.trees.index]] := 0;
+          Inc(s.sub.trees.index);
+        end;
+        s.sub.trees.bb := 7;
+        t := inflate_trees_bits(s.sub.trees.blens^, s.sub.trees.bb,
+                                s.sub.trees.tb, s.hufts^, z);
+        if (t <> Z_OK) then
+        begin
+          freemem(s.sub.trees.blens);
+          r := t;
+          if (r = Z_DATA_ERROR) then
+            s.mode := BLKBAD;
+          { update pointers and return }
+          s.bitb := b;
+          s.bitk := k;
+          z.avail_in := n;
+          Inc(z.total_in, ptruint(p) - ptruint(z.next_in));
+          z.next_in := p;
+          s.write := q;
+          inflate_blocks := inflate_flush(s,z,r);
+          exit;
+        end;
+        s.sub.trees.index := 0;
+        {$IFDEF ZLIB_DEBUG}
+        Tracev('inflate:       bits tree ok');
+        {$ENDIF}
+        s.mode := DTREE;
+        { fall through again }
+        goto start_dtree;
+      end;
+    DTREE:
+      begin
+        start_dtree:
+        while TRUE do
+        begin
+          t := s.sub.trees.table;
+          if not (s.sub.trees.index < 258 +
+                                     (t and $1f) + ((t shr 5) and $1f)) then
+            break;
+          t := s.sub.trees.bb;
+          {NEEDBITS(t);}
+          while (k < t) do
+          begin
+            {NEEDBYTE;}
+            if (n <> 0) then
+              r :=Z_OK
+            else
+            begin
+              {UPDATE}
+              s.bitb := b;
+              s.bitk := k;
+              z.avail_in := n;
+              Inc(z.total_in, ptruint(p)-ptruint(z.next_in));
+              z.next_in := p;
+              s.write := q;
+              inflate_blocks := inflate_flush(s,z,r);
+              exit;
+            end;
+            dec(n);
+            b := b or (cardinal(p^) shl k);
+            Inc(p);
+            Inc(k, 8);
+          end;
+
+          h := s.sub.trees.tb;
+          Inc(h, cardinal(b) and inflate_mask[t]);
+          t := h^.Bits;
+          c := h^.Base;
+
+          if (c < 16) then
+          begin
+            {DUMPBITS(t);}
+            b := b shr t;
+            dec(k, t);
+
+            s.sub.trees.blens^[s.sub.trees.index] := c;
+            Inc(s.sub.trees.index);
+          end
+          else { c = 16..18 }
+          begin
+            if c = 18 then
+            begin
+              i := 7;
+              j := 11;
+            end
+            else
+            begin
+              i := c - 14;
+              j := 3;
+            end;
+            {NEEDBITS(t + i);}
+            while (k < t + i) do
+            begin
+              {NEEDBYTE;}
+              if (n <> 0) then
+                r :=Z_OK
+              else
+              begin
+                {UPDATE}
+                s.bitb := b;
+                s.bitk := k;
+                z.avail_in := n;
+                Inc(z.total_in, ptruint(p)-ptruint(z.next_in));
+                z.next_in := p;
+                s.write := q;
+                inflate_blocks := inflate_flush(s,z,r);
+                exit;
+              end;
+              dec(n);
+              b := b or (cardinal(p^) shl k);
+              Inc(p);
+              Inc(k, 8);
+            end;
+
+            {DUMPBITS(t);}
+            b := b shr t;
+            dec(k, t);
+
+            Inc(j, cardinal(b) and inflate_mask[i]);
+            {DUMPBITS(i);}
+            b := b shr i;
+            dec(k, i);
+
+            i := s.sub.trees.index;
+            t := s.sub.trees.table;
+            if (i + j > 258 + (t and $1f) + ((t shr 5) and $1f)) or
+               ((c = 16) and (i < 1)) then
+            begin
+              freemem(s.sub.trees.blens);
+              s.mode := BLKBAD;
+              z.msg := 'invalid bit length repeat';
+              r := Z_DATA_ERROR;
+              { update pointers and return }
+              s.bitb := b;
+              s.bitk := k;
+              z.avail_in := n;
+              Inc(z.total_in, ptruint(p) - ptruint(z.next_in));
+              z.next_in := p;
+              s.write := q;
+              inflate_blocks := inflate_flush(s,z,r);
+              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;
+        begin
+          bl := 9;         { must be <= 9 for lookahead assumptions }
+          bd := 6;         { must be <= 9 for lookahead assumptions }
+          t := s.sub.trees.table;
+          t := inflate_trees_dynamic(257 + (t and $1f),
+                  1 + ((t shr 5) and $1f),
+                  s.sub.trees.blens^, bl, bd, tl, td, s.hufts^, z);
+          freemem(s.sub.trees.blens);
+          if (t <> Z_OK) then
+          begin
+            if (t = cardinal(Z_DATA_ERROR)) then
+              s.mode := BLKBAD;
+            r := t;
+            { update pointers and return }
+            s.bitb := b;
+            s.bitk := k;
+            z.avail_in := n;
+            Inc(z.total_in, ptruint(p) - ptruint(z.next_in));
+            z.next_in := p;
+            s.write := q;
+            inflate_blocks := inflate_flush(s,z,r);
+            exit;
+          end;
+          {$IFDEF ZLIB_DEBUG}
+          Tracev('inflate:       trees ok');
+          {$ENDIF}          
+          { c renamed to cs }
+          cs := inflate_codes_new(bl, bd, tl, td, z);
+          if (cs = nil) then
+          begin
+            r := Z_MEM_ERROR;
+            { update pointers and return }
+            s.bitb := b;
+            s.bitk := k;
+            z.avail_in := n;
+            Inc(z.total_in, ptruint(p) - ptruint(z.next_in));
+            z.next_in := p;
+            s.write := q;
+            inflate_blocks := inflate_flush(s,z,r);
+            exit;
+          end;
+          s.sub.decode.codes := cs;
+        end;
+        s.mode := CODES;
+        { yet another falltrough }
+        goto start_codes;
+      end;
+    CODES:
+      begin
+        start_codes:
+        { update pointers }
+        s.bitb := b;
+        s.bitk := k;
+        z.avail_in := n;
+        Inc(z.total_in, ptruint(p) - ptruint(z.next_in));
+        z.next_in := p;
+        s.write := q;
+
+        r := inflate_codes(s, z, r);
+        if (r <> Z_STREAM_END) then
+        begin
+          inflate_blocks := inflate_flush(s, z, r);
+          exit;
+        end;
+        r := Z_OK;
+        inflate_codes_free(s.sub.decode.codes, z);
+        { load local pointers }
+        p := z.next_in;
+        n := z.avail_in;
+        b := s.bitb;
+        k := s.bitk;
+        q := s.write;
+        if ptruint(q) < ptruint(s.read) then
+          m := cardinal(ptruint(s.read)-ptruint(q)-1)
+        else
+          m := cardinal(ptruint(s.zend)-ptruint(q));
+        {$IFDEF ZLIB_DEBUG}
+        if (ptruint(q) >= ptruint(s.read)) then
+          Tracev('inflate:       codes end '+
+              IntToStr(z.total_out + ptruint(q) - ptruint(s.read)) + ' total out')
+        else
+          Tracev('inflate:       codes end '+
+                  IntToStr(z.total_out + ptruint(s.zend) - ptruint(s.read) +
+                  ptruint(q) - ptruint(s.window)) +  ' total out');
+        {$ENDIF}
+        if (not s.last) then
+        begin
+          s.mode := ZTYPE;
+          continue; { break for switch statement in C-code }
+        end;
+        {$ifndef patch112}
+        if (k > 7) then           { return unused byte, if any }
+        begin
+          {$IFDEF ZLIB_DEBUG}
+          Assert(k < 16, 'inflate_codes grabbed too many bytes');
+          {$ENDIF}
+          dec(k, 8);
+          inc(n);
+          dec(p);                    { can always return one }
+        end;
+        {$endif}
+        s.mode := DRY;
+        { another falltrough }
+        goto start_dry;
+      end;
+    DRY:
+      begin
+        start_dry:
+        {FLUSH}
+        s.write := q;
+        r := inflate_flush(s,z,r);
+        q := s.write;
+
+        { not needed anymore, we are done:
+        if ptruint(q) < ptruint(s.read) then
+          m := cardinal(ptruint(s.read)-ptruint(q)-1)
+        else
+          m := cardinal(ptruint(s.zend)-ptruint(q));
+        }
+
+        if (s.read <> s.write) then
+        begin
+          { update pointers and return }
+          s.bitb := b;
+          s.bitk := k;
+          z.avail_in := n;
+          Inc(z.total_in, ptruint(p) - ptruint(z.next_in));
+          z.next_in := p;
+          s.write := q;
+          inflate_blocks := inflate_flush(s,z,r);
+          exit;
+        end;
+        s.mode := BLKDONE;
+        goto start_blkdone;
+      end;
+    BLKDONE:
+      begin
+        start_blkdone:
+        r := Z_STREAM_END;
+        { update pointers and return }
+        s.bitb := b;
+        s.bitk := k;
+        z.avail_in := n;
+        Inc(z.total_in, ptruint(p) - ptruint(z.next_in));
+        z.next_in := p;
+        s.write := q;
+        inflate_blocks := inflate_flush(s,z,r);
+        exit;
+      end;
+    BLKBAD:
+      begin
+        r := Z_DATA_ERROR;
+        { update pointers and return }
+        s.bitb := b;
+        s.bitk := k;
+        z.avail_in := n;
+        Inc(z.total_in, ptruint(p) - ptruint(z.next_in));
+        z.next_in := p;
+        s.write := q;
+        inflate_blocks := inflate_flush(s,z,r);
+        exit;
+      end;
+    else
+    begin
+      r := Z_STREAM_ERROR;
+      { update pointers and return }
+      s.bitb := b;
+      s.bitk := k;
+      z.avail_in := n;
+      Inc(z.total_in, ptruint(p) - ptruint(z.next_in));
+      z.next_in := p;
+      s.write := q;
+      inflate_blocks := inflate_flush(s,z,r);
+      exit;
+    end;
+  end; { Case s.mode of }
+
+end;
+
+
+function inflate_blocks_free(s : pInflate_blocks_state;
+                             var z : z_stream) : integer;
+begin
+  inflate_blocks_reset(s^, z, nil);
+  freemem(s^.window);
+  freemem(s^.hufts);
+  dispose(s);
+  {$IFDEF ZLIB_DEBUG}
+  Trace('inflate:   blocks freed');
+  {$ENDIF}  
+  inflate_blocks_free := Z_OK;
+end;
+
+
+procedure inflate_set_dictionary(var s : inflate_blocks_state;
+                                 const d : array of byte; { dictionary }
+                                 n : cardinal);         { dictionary length }
+begin
+  move(d,s.window^,n);
+  s.write := s.window;
+  inc(s.write, n);
+  s.read := s.write;
+end;
+
+
+{ Returns true if inflate is currently at the end of a block generated
+  by Z_SYNC_FLUSH or Z_FULL_FLUSH.
+  IN assertion: s <> nil }
+
+function inflate_blocks_sync_point(var s : inflate_blocks_state) : integer;
+begin
+  inflate_blocks_sync_point := integer(s.mode = LENS);
+end;
+
+end.

+ 587 - 0
src/libraries/paszlib/paszlib_infcodes.pas

@@ -0,0 +1,587 @@
+unit paszlib_infcodes;
+
+{ infcodes.c -- process literals and length/distance pairs
+  Copyright (C) 1995-1998 Mark Adler
+
+  Pascal tranlastion
+  Copyright (C) 1998 by Jacques Nomssi Nzali
+  For conditions of distribution and use, see copyright notice in readme.txt
+}
+
+interface
+
+{$I paszlib_zconf.inc}
+
+uses
+  paszlib_zbase;
+
+function inflate_codes_new (bl : cardinal;
+                            bd : cardinal;
+                            tl : pInflate_huft;
+                            td : pInflate_huft;
+                            var z : z_stream): pInflate_codes_state;
+
+function inflate_codes(var s : inflate_blocks_state;
+                       var z : z_stream;
+                       r : integer) : integer;
+
+procedure inflate_codes_free(c : pInflate_codes_state;
+                             var z : z_stream);
+
+implementation
+
+uses
+  paszlib_infutil, paszlib_inffast;
+
+
+function inflate_codes_new (bl : cardinal;
+                            bd : cardinal;
+                            tl : pInflate_huft;
+                            td : pInflate_huft;
+                            var z : z_stream): pInflate_codes_state;
+var
+ c : pInflate_codes_state;
+begin
+  new(c);
+  if c<>nil then
+  begin
+    c^.mode := START;
+    c^.lbits := Byte(bl);
+    c^.dbits := Byte(bd);
+    c^.ltree := tl;
+    c^.dtree := td;
+    {$IFDEF ZLIB_DEBUG}
+    Tracev('inflate:       codes new');
+    {$ENDIF}
+  end;
+  inflate_codes_new := c;
+end;
+
+
+function inflate_codes(var s : inflate_blocks_state;
+                       var z : z_stream;
+                       r : integer) : integer;
+var
+  j : cardinal;               { temporary storage }
+  t : pInflate_huft;      { temporary pointer }
+  e : cardinal;               { extra bits or operation }
+  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 }
+  f : Pbyte;             { pointer to copy strings from }
+var
+  c : pInflate_codes_state;
+begin
+  c := s.sub.decode.codes;  { codes state }
+
+  { copy input/output information to locals }
+  p := z.next_in;
+  n := z.avail_in;
+  b := s.bitb;
+  k := s.bitk;
+  q := s.write;
+  if ptruint(q) < ptruint(s.read) then
+    m := cardinal(ptruint(s.read)-ptruint(q)-1)
+  else
+    m := cardinal(ptruint(s.zend)-ptruint(q));
+
+  { process input and output based on current state }
+  while True do
+  case (c^.mode) of
+    { waiting for "i:"=input, "o:"=output, "x:"=nothing }
+  START:         { x: set up for LEN }
+    begin
+{$ifndef SLOW}
+      if (m >= 258) and (n >= 10) then
+      begin
+        {UPDATE}
+        s.bitb := b;
+        s.bitk := k;
+        z.avail_in := n;
+        Inc(z.total_in, ptruint(p)-ptruint(z.next_in));
+        z.next_in := p;
+        s.write := q;
+
+        r := inflate_fast(c^.lbits, c^.dbits, c^.ltree, c^.dtree, s, z);
+        {LOAD}
+        p := z.next_in;
+        n := z.avail_in;
+        b := s.bitb;
+        k := s.bitk;
+        q := s.write;
+        if ptruint(q) < ptruint(s.read) then
+          m := cardinal(ptruint(s.read)-ptruint(q)-1)
+        else
+          m := cardinal(ptruint(s.zend)-ptruint(q));
+
+        if (r <> Z_OK) then
+        begin
+          if (r = Z_STREAM_END) then
+            c^.mode := WASH
+          else
+            c^.mode := BADCODE;
+          continue;    { break for switch-statement in C }
+        end;
+      end;
+{$endif} { not SLOW }
+      c^.sub.code.need := c^.lbits;
+      c^.sub.code.tree := c^.ltree;
+      c^.mode := LEN;  { falltrough }
+    end;
+  LEN:           { i: get length/literal/eob next }
+    begin
+      j := c^.sub.code.need;
+      {NEEDBITS(j);}
+      while (k < j) do
+      begin
+        {NEEDBYTE;}
+        if (n <> 0) then
+          r :=Z_OK
+        else
+        begin
+          {UPDATE}
+          s.bitb := b;
+          s.bitk := k;
+          z.avail_in := n;
+          Inc(z.total_in, ptruint(p)-ptruint(z.next_in));
+          z.next_in := p;
+          s.write := q;
+          inflate_codes := inflate_flush(s,z,r);
+
+          //if this is the last block, there are no bytes left in stream and the block end code follows, finish processing this block
+          if s.last then
+          begin
+            t := c^.sub.code.tree;
+            { update t (like as in following code), and check, if requested
+              bits are available }
+            Inc(t, cardinal(b) and inflate_mask[j]);
+            if k >= t^.bits then
+            { now, we can examine t^.exop value }
+              if t^.exop and 32 <> 0 then
+                break;
+          end;
+
+          exit;
+        end;
+        dec(n);
+        b := b or (cardinal(p^) shl k);
+        Inc(p);
+        Inc(k, 8);
+      end;
+      t := c^.sub.code.tree;
+      Inc(t, cardinal(b) and inflate_mask[j]);
+      {DUMPBITS(t^.bits);}
+      b := b shr t^.bits;
+      dec(k, t^.bits);
+
+      e := cardinal(t^.exop);
+      if (e = 0) then            { literal }
+      begin
+        c^.sub.lit := t^.base;
+       {$IFDEF ZLIB_DEBUG}
+        if (t^.base >= $20) and (t^.base < $7f) then
+          Tracevv('inflate:         literal '+char(t^.base))
+        else
+          Tracevv('inflate:         literal '+IntToStr(t^.base));
+        {$ENDIF}          
+        c^.mode := LIT;
+        continue;  { break switch statement }
+      end;
+      if (e and 16 <> 0) then            { length }
+      begin
+        c^.sub.copy.get := e and 15;
+        c^.len := t^.base;
+        c^.mode := LENEXT;
+        continue;         { break C-switch statement }
+      end;
+      if (e and 64 = 0) then             { next table }
+      begin
+        c^.sub.code.need := e;
+        c^.sub.code.tree := @huft_ptr(t)^[t^.base];
+        continue;         { break C-switch statement }
+      end;
+      if (e and 32 <> 0) then            { end of block }
+      begin
+        {$IFDEF ZLIB_DEBUG}
+        Tracevv('inflate:         end of block');
+        {$ENDIF}        
+        c^.mode := WASH;
+        continue;         { break C-switch statement }
+      end;
+      c^.mode := BADCODE;        { invalid code }
+      z.msg := 'invalid literal/length code';
+      r := Z_DATA_ERROR;
+      {UPDATE}
+      s.bitb := b;
+      s.bitk := k;
+      z.avail_in := n;
+      Inc(z.total_in, ptruint(p)-ptruint(z.next_in));
+      z.next_in := p;
+      s.write := q;
+      inflate_codes := inflate_flush(s,z,r);
+      exit;
+    end;
+  LENEXT:        { i: getting length extra (have base) }
+    begin
+      j := c^.sub.copy.get;
+      {NEEDBITS(j);}
+      while (k < j) do
+      begin
+        {NEEDBYTE;}
+        if (n <> 0) then
+          r :=Z_OK
+        else
+        begin
+          {UPDATE}
+          s.bitb := b;
+          s.bitk := k;
+          z.avail_in := n;
+          Inc(z.total_in, ptruint(p)-ptruint(z.next_in));
+          z.next_in := p;
+          s.write := q;
+          inflate_codes := inflate_flush(s,z,r);
+          exit;
+        end;
+        dec(n);
+        b := b or (cardinal(p^) shl k);
+        Inc(p);
+        Inc(k, 8);
+      end;
+      Inc(c^.len, cardinal(b and inflate_mask[j]));
+      {DUMPBITS(j);}
+      b := b shr j;
+      dec(k, j);
+
+      c^.sub.code.need := c^.dbits;
+      c^.sub.code.tree := c^.dtree;
+      {$IFDEF ZLIB_DEBUG}
+      Tracevv('inflate:         length '+IntToStr(c^.len));
+      {$ENDIF}
+      c^.mode := DIST;
+      { falltrough }
+    end;
+  DIST:          { i: get distance next }
+    begin
+      j := c^.sub.code.need;
+      {NEEDBITS(j);}
+      while (k < j) do
+      begin
+        {NEEDBYTE;}
+        if (n <> 0) then
+          r :=Z_OK
+        else
+        begin
+          {UPDATE}
+          s.bitb := b;
+          s.bitk := k;
+          z.avail_in := n;
+          Inc(z.total_in, ptruint(p)-ptruint(z.next_in));
+          z.next_in := p;
+          s.write := q;
+          inflate_codes := inflate_flush(s,z,r);
+          exit;
+        end;
+        dec(n);
+        b := b or (cardinal(p^) shl k);
+        Inc(p);
+        Inc(k, 8);
+      end;
+      t := @huft_ptr(c^.sub.code.tree)^[cardinal(b) and inflate_mask[j]];
+      {DUMPBITS(t^.bits);}
+      b := b shr t^.bits;
+      dec(k, t^.bits);
+
+      e := cardinal(t^.exop);
+      if (e and 16 <> 0) then            { distance }
+      begin
+        c^.sub.copy.get := e and 15;
+        c^.sub.copy.dist := t^.base;
+        c^.mode := DISTEXT;
+        continue;     { break C-switch statement }
+      end;
+      if (e and 64 = 0) then     { next table }
+      begin
+        c^.sub.code.need := e;
+        c^.sub.code.tree := @huft_ptr(t)^[t^.base];
+        continue;     { break C-switch statement }
+      end;
+      c^.mode := BADCODE;        { invalid code }
+      z.msg := 'invalid distance code';
+      r := Z_DATA_ERROR;
+      {UPDATE}
+      s.bitb := b;
+      s.bitk := k;
+      z.avail_in := n;
+      Inc(z.total_in, ptruint(p)-ptruint(z.next_in));
+      z.next_in := p;
+      s.write := q;
+      inflate_codes := inflate_flush(s,z,r);
+      exit;
+    end;
+  DISTEXT:       { i: getting distance extra }
+    begin
+      j := c^.sub.copy.get;
+      {NEEDBITS(j);}
+      while (k < j) do
+      begin
+        {NEEDBYTE;}
+        if (n <> 0) then
+          r :=Z_OK
+        else
+        begin
+          {UPDATE}
+          s.bitb := b;
+          s.bitk := k;
+          z.avail_in := n;
+          Inc(z.total_in, ptruint(p)-ptruint(z.next_in));
+          z.next_in := p;
+          s.write := q;
+          inflate_codes := inflate_flush(s,z,r);
+          exit;
+        end;
+        dec(n);
+        b := b or (cardinal(p^) shl k);
+        Inc(p);
+        Inc(k, 8);
+      end;
+      Inc(c^.sub.copy.dist, cardinal(b) and inflate_mask[j]);
+      {DUMPBITS(j);}
+      b := b shr j;
+      dec(k, j);
+      {$IFDEF ZLIB_DEBUG}
+      Tracevv('inflate:         distance '+ IntToStr(c^.sub.copy.dist));
+      {$ENDIF}
+      c^.mode := COPY;
+      { falltrough }
+    end;
+  COPY:          { o: copying bytes in window, waiting for space }
+    begin
+      f := q;
+      dec(f, c^.sub.copy.dist);
+      if (cardinal(ptruint(q) - ptruint(s.window)) < c^.sub.copy.dist) then
+      begin
+        f := s.zend;
+        dec(f, c^.sub.copy.dist - cardinal(ptruint(q) - ptruint(s.window)));
+      end;
+
+      while (c^.len <> 0) do
+      begin
+        {NEEDOUT}
+        if (m = 0) then
+        begin
+          {WRAP}
+          if (q = s.zend) and (s.read <> s.window) then
+          begin
+            q := s.window;
+            if ptruint(q) < ptruint(s.read) then
+              m := cardinal(ptruint(s.read)-ptruint(q)-1)
+            else
+              m := cardinal(ptruint(s.zend)-ptruint(q));
+          end;
+
+          if (m = 0) then
+          begin
+            {FLUSH}
+            s.write := q;
+            r := inflate_flush(s,z,r);
+            q := s.write;
+            if ptruint(q) < ptruint(s.read) then
+              m := cardinal(ptruint(s.read)-ptruint(q)-1)
+            else
+              m := cardinal(ptruint(s.zend)-ptruint(q));
+
+            {WRAP}
+            if (q = s.zend) and (s.read <> s.window) then
+            begin
+              q := s.window;
+              if ptruint(q) < ptruint(s.read) then
+                m := cardinal(ptruint(s.read)-ptruint(q)-1)
+              else
+                m := cardinal(ptruint(s.zend)-ptruint(q));
+            end;
+
+            if (m = 0) then
+            begin
+              {UPDATE}
+              s.bitb := b;
+              s.bitk := k;
+              z.avail_in := n;
+              Inc(z.total_in, ptruint(p)-ptruint(z.next_in));
+              z.next_in := p;
+              s.write := q;
+              inflate_codes := inflate_flush(s,z,r);
+              exit;
+            end;
+          end;
+        end;
+        r := Z_OK;
+
+        {OUTBYTE( *f++)}
+        q^ := f^;
+        Inc(q);
+        Inc(f);
+        dec(m);
+
+        if (f = s.zend) then
+          f := s.window;
+        dec(c^.len);
+      end;
+      c^.mode := START;
+      { C-switch break; not needed }
+    end;
+  LIT:           { o: got literal, waiting for output space }
+    begin
+      {NEEDOUT}
+      if (m = 0) then
+      begin
+        {WRAP}
+        if (q = s.zend) and (s.read <> s.window) then
+        begin
+          q := s.window;
+          if ptruint(q) < ptruint(s.read) then
+            m := cardinal(ptruint(s.read)-ptruint(q)-1)
+          else
+            m := cardinal(ptruint(s.zend)-ptruint(q));
+        end;
+
+        if (m = 0) then
+        begin
+          {FLUSH}
+          s.write := q;
+          r := inflate_flush(s,z,r);
+          q := s.write;
+          if ptruint(q) < ptruint(s.read) then
+            m := cardinal(ptruint(s.read)-ptruint(q)-1)
+          else
+            m := cardinal(ptruint(s.zend)-ptruint(q));
+
+          {WRAP}
+          if (q = s.zend) and (s.read <> s.window) then
+          begin
+            q := s.window;
+            if ptruint(q) < ptruint(s.read) then
+              m := cardinal(ptruint(s.read)-ptruint(q)-1)
+            else
+              m := cardinal(ptruint(s.zend)-ptruint(q));
+          end;
+
+          if (m = 0) then
+          begin
+            {UPDATE}
+            s.bitb := b;
+            s.bitk := k;
+            z.avail_in := n;
+            Inc(z.total_in, ptruint(p)-ptruint(z.next_in));
+            z.next_in := p;
+            s.write := q;
+            inflate_codes := inflate_flush(s,z,r);
+            exit;
+          end;
+        end;
+      end;
+      r := Z_OK;
+
+      {OUTBYTE(c^.sub.lit);}
+      q^ := c^.sub.lit;
+      Inc(q);
+      dec(m);
+
+      c^.mode := START;
+      {break;}
+    end;
+  WASH:          { o: got eob, possibly more output }
+    begin
+      {$ifdef patch112}
+      if (k > 7) then           { return unused byte, if any }
+      begin
+        {$IFDEF ZLIB_DEBUG}
+        Assert(k < 16, 'inflate_codes grabbed too many bytes');
+        {$ENDIF}
+        dec(k, 8);
+        Inc(n);
+        dec(p);                    { can always return one }
+      end;
+      {$endif}
+      {FLUSH}
+      s.write := q;
+      r := inflate_flush(s,z,r);
+      q := s.write;
+      if ptruint(q) < ptruint(s.read) then
+        m := cardinal(ptruint(s.read)-ptruint(q)-1)
+      else
+        m := cardinal(ptruint(s.zend)-ptruint(q));
+
+      if (s.read <> s.write) then
+      begin
+        {UPDATE}
+        s.bitb := b;
+        s.bitk := k;
+        z.avail_in := n;
+        Inc(z.total_in, ptruint(p)-ptruint(z.next_in));
+        z.next_in := p;
+        s.write := q;
+        inflate_codes := inflate_flush(s,z,r);
+        exit;
+      end;
+      c^.mode := ZEND;
+      { falltrough }
+    end;
+
+  ZEND:
+    begin
+      r := Z_STREAM_END;
+      {UPDATE}
+      s.bitb := b;
+      s.bitk := k;
+      z.avail_in := n;
+      Inc(z.total_in, ptruint(p)-ptruint(z.next_in));
+      z.next_in := p;
+      s.write := q;
+      inflate_codes := inflate_flush(s,z,r);
+      exit;
+    end;
+  BADCODE:       { x: got error }
+    begin
+      r := Z_DATA_ERROR;
+      {UPDATE}
+      s.bitb := b;
+      s.bitk := k;
+      z.avail_in := n;
+      Inc(z.total_in, ptruint(p)-ptruint(z.next_in));
+      z.next_in := p;
+      s.write := q;
+      inflate_codes := inflate_flush(s,z,r);
+      exit;
+    end;
+  else
+    begin
+      r := Z_STREAM_ERROR;
+      {UPDATE}
+      s.bitb := b;
+      s.bitk := k;
+      z.avail_in := n;
+      Inc(z.total_in, ptruint(p)-ptruint(z.next_in));
+      z.next_in := p;
+      s.write := q;
+      inflate_codes := inflate_flush(s,z,r);
+      exit;
+    end;
+  end;
+{NEED_DUMMY_RETURN - Delphi2+ dumb compilers complain without this }
+  inflate_codes := Z_STREAM_ERROR;
+end;
+
+
+procedure inflate_codes_free(c : pInflate_codes_state;
+                             var z : z_stream);
+begin
+  dispose(c);
+  {$IFDEF ZLIB_DEBUG}  
+  Tracev('inflate:       codes free');
+  {$ENDIF}
+end;
+
+end.

+ 315 - 0
src/libraries/paszlib/paszlib_inffast.pas

@@ -0,0 +1,315 @@
+Unit paszlib_InfFast;
+
+{
+  inffast.h and
+  inffast.c -- process literals and length/distance pairs fast
+  Copyright (C) 1995-1998 Mark Adler
+
+  Pascal tranlastion
+  Copyright (C) 1998 by Jacques Nomssi Nzali
+  For conditions of distribution and use, see copyright notice in readme.txt
+}
+
+
+interface
+
+{$I paszlib_zconf.inc}
+
+uses
+  paszlib_zbase;
+
+function inflate_fast( bl : cardinal;
+                       bd : cardinal;
+                       tl : pInflate_huft;
+                       td : pInflate_huft;
+                      var s : inflate_blocks_state;
+                      var z : z_stream) : integer;
+
+
+implementation
+
+uses
+  paszlib_infutil;
+
+
+{ 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. }
+
+function inflate_fast( bl : cardinal;
+                       bd : cardinal;
+                       tl : pInflate_huft;
+                       td : pInflate_huft;
+                      var s : inflate_blocks_state;
+                      var z : z_stream) : integer;
+
+var
+  t : pInflate_huft;      { temporary pointer }
+  e : cardinal;               { extra bits or operation }
+  b : longint;              { 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 }
+  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 (macro LOAD) }
+  p := z.next_in;
+  n := z.avail_in;
+  b := s.bitb;
+  k := s.bitk;
+  q := s.write;
+  if ptruint(q) < ptruint(s.read) then
+    m := cardinal(ptruint(s.read)-ptruint(q)-1)
+  else
+    m := cardinal(ptruint(s.zend)-ptruint(q));
+
+  { initialize masks }
+  ml := inflate_mask[bl];
+  md := inflate_mask[bd];
+
+  { do until not enough input or output space for fast loop }
+  repeat                      { assume called with (m >= 258) and (n >= 10) }
+    { get literal/length code }
+    {GRABBITS(20);}             { max bits for literal/length code }
+    while (k < 20) do
+    begin
+      dec(n);
+      b := b or (longint(p^) shl k);
+      inc(p);
+      inc(k, 8);
+    end;
+
+    t := @(huft_ptr(tl)^[cardinal(b) and ml]);
+
+    e := t^.exop;
+    if (e = 0) then
+    begin
+      {DUMPBITS(t^.bits);}
+      b := b shr t^.bits;
+      dec(k, t^.bits);
+     {$IFDEF ZLIB_DEBUG}
+      if (t^.base >= $20) and (t^.base < $7f) then
+        Tracevv('inflate:         * literal '+char(t^.base))
+      else
+        Tracevv('inflate:         * literal '+ IntToStr(t^.base));
+      {$ENDIF}
+      q^ := Byte(t^.base);
+      inc(q);
+      dec(m);
+      continue;
+    end;
+    repeat
+      {DUMPBITS(t^.bits);}
+      b := b shr t^.bits;
+      dec(k, t^.bits);
+
+      if (e and 16 <> 0) then
+      begin
+        { get extra bits for length }
+        e := e and 15;
+        c := t^.base + (cardinal(b) and inflate_mask[e]);
+        {DUMPBITS(e);}
+        b := b shr e;
+        dec(k, e);
+        {$IFDEF ZLIB_DEBUG}
+        Tracevv('inflate:         * length ' + IntToStr(c));
+        {$ENDIF}
+        { decode distance base of block to copy }
+        {GRABBITS(15);}           { max bits for distance code }
+        while (k < 15) do
+        begin
+          dec(n);
+          b := b or (longint(p^) shl k);
+          inc(p);
+          inc(k, 8);
+        end;
+
+        t := @huft_ptr(td)^[cardinal(b) and md];
+        e := t^.exop;
+        repeat
+          {DUMPBITS(t^.bits);}
+          b := b shr t^.bits;
+          dec(k, t^.bits);
+
+          if (e and 16 <> 0) then
+          begin
+            { get extra bits to add to distance base }
+            e := e and 15;
+            {GRABBITS(e);}         { get extra bits (up to 13) }
+            while (k < e) do
+            begin
+              dec(n);
+              b := b or (longint(p^) shl k);
+              inc(p);
+              inc(k, 8);
+            end;
+
+            d := t^.base + (cardinal(b) and inflate_mask[e]);
+            {DUMPBITS(e);}
+            b := b shr e;
+            dec(k, e);
+
+            {$IFDEF ZLIB_DEBUG}
+            Tracevv('inflate:         * distance '+IntToStr(d));
+            {$ENDIF}
+            { do the copy }
+            dec(m, c);
+            if (cardinal(ptruint(q) - ptruint(s.window)) >= d) then     { offset before dest }
+            begin                                  {  just copy }
+              r := q;
+              dec(r, d);
+              q^ := r^;  inc(q); inc(r); dec(c); { minimum count is three, }
+              q^ := r^;  inc(q); inc(r); dec(c); { so unroll loop a little }
+            end
+            else                        { else offset after destination }
+            begin
+              e := d - cardinal(ptruint(q) - ptruint(s.window)); { bytes from offset to end }
+              r := s.zend;
+              dec(r, e);                  { pointer to offset }
+              if (c > e) then             { if source crosses, }
+              begin
+                dec(c, e);                { copy to end of window }
+                repeat
+                  q^ := r^;
+                  inc(q);
+                  inc(r);
+                  dec(e);
+                until (e=0);
+                r := s.window;           { copy rest from start of window }
+              end;
+            end;
+            repeat                       { copy all or what's left }
+              q^ := r^;
+              inc(q);
+              inc(r);
+              dec(c);
+            until (c = 0);
+            break;
+          end
+          else
+            if (e and 64 = 0) then
+            begin
+              inc(t, t^.base + (cardinal(b) and inflate_mask[e]));
+              e := t^.exop;
+            end
+          else
+          begin
+            z.msg := 'invalid distance code';
+            {UNGRAB}
+            c := z.avail_in-n;
+            if (k shr 3) < c then
+              c := k shr 3;
+            inc(n, c);
+            dec(p, c);
+            dec(k, c shl 3);
+            {UPDATE}
+            s.bitb := b;
+            s.bitk := k;
+            z.avail_in := n;
+            inc(z.total_in, ptruint(p)-ptruint(z.next_in));
+            z.next_in := p;
+            s.write := q;
+
+            inflate_fast := Z_DATA_ERROR;
+            exit;
+          end;
+        until FALSE;
+        break;
+      end;
+      if (e and 64 = 0) then
+      begin
+         {t += t->base;
+          e = (t += ((cardinal)b & inflate_mask[e]))->exop;}
+
+        inc(t, t^.base + (cardinal(b) and inflate_mask[e]));
+        e := t^.exop;
+        if (e = 0) then
+        begin
+          {DUMPBITS(t^.bits);}
+          b := b shr t^.bits;
+          dec(k, t^.bits);
+
+         {$IFDEF ZLIB_DEBUG}
+          if (t^.base >= $20) and (t^.base < $7f) then
+            Tracevv('inflate:         * literal '+char(t^.base))
+          else
+            Tracevv('inflate:         * literal '+IntToStr(t^.base));
+          {$ENDIF}            
+          q^ := Byte(t^.base);
+          inc(q);
+          dec(m);
+          break;
+        end;
+      end
+      else
+        if (e and 32 <> 0) then
+        begin
+          {$IFDEF ZLIB_DEBUG}
+          Tracevv('inflate:         * end of block');
+          {$ENDIF}
+          {UNGRAB}
+          c := z.avail_in-n;
+          if (k shr 3) < c then
+            c := k shr 3;
+          inc(n, c);
+          dec(p, c);
+          dec(k, c shl 3);
+          {UPDATE}
+          s.bitb := b;
+          s.bitk := k;
+          z.avail_in := n;
+          inc(z.total_in, ptruint(p)-ptruint(z.next_in));
+          z.next_in := p;
+          s.write := q;
+          inflate_fast := Z_STREAM_END;
+          exit;
+        end
+        else
+        begin
+          z.msg := 'invalid literal/length code';
+          {UNGRAB}
+          c := z.avail_in-n;
+          if (k shr 3) < c then
+            c := k shr 3;
+          inc(n, c);
+          dec(p, c);
+          dec(k, c shl 3);
+          {UPDATE}
+          s.bitb := b;
+          s.bitk := k;
+          z.avail_in := n;
+          inc(z.total_in, ptruint(p)-ptruint(z.next_in));
+          z.next_in := p;
+          s.write := q;
+          inflate_fast := Z_DATA_ERROR;
+          exit;
+        end;
+    until FALSE;
+  until (m < 258) or (n < 10);
+
+  { not enough input or output--restore pointers and return }
+  {UNGRAB}
+  c := z.avail_in-n;
+  if (k shr 3) < c then
+    c := k shr 3;
+  inc(n, c);
+  dec(p, c);
+  dec(k, c shl 3);
+  {UPDATE}
+  s.bitb := b;
+  s.bitk := k;
+  z.avail_in := n;
+  inc(z.total_in, ptruint(p)-ptruint(z.next_in));
+  z.next_in := p;
+  s.write := q;
+  inflate_fast := Z_OK;
+end;
+
+end.

+ 780 - 0
src/libraries/paszlib/paszlib_inftrees.pas

@@ -0,0 +1,780 @@
+unit paszlib_inftrees;
+
+{ inftrees.h -- header to use inftrees.c
+  inftrees.c -- generate Huffman trees for efficient decoding
+  Copyright (C) 1995-1998 Mark Adler
+
+  WARNING: this file should *not* be used by applications. It is
+   part of the implementation of the compression library and is
+   subject to change.
+
+  Pascal tranlastion
+  Copyright (C) 1998 by Jacques Nomssi Nzali
+  For conditions of distribution and use, see copyright notice in readme.txt
+}
+
+interface
+
+{$I paszlib_zconf.inc}
+
+uses
+  paszlib_zbase;
+
+
+{ Maximum size of dynamic tree.  The maximum found in a long 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. }
+const
+  MANY = 1440;
+
+
+{$ifdef ZLIB_DEBUG}
+var
+  inflate_hufts : cardinal;
+{$endif}
+
+function inflate_trees_bits(
+  var c : array of cardinal;  { 19 code lengths }
+  var bb : cardinal;          { bits tree desired/actual depth }
+  var tb : pinflate_huft;  { bits tree result }
+  var hp : array of Inflate_huft;      { space for trees }
+  var z : z_stream         { for messages }
+    ) : integer;
+
+function inflate_trees_dynamic(
+    nl : cardinal;                    { number of literal/length codes }
+    nd : cardinal;                    { number of distance codes }
+    var c : Array of cardinal;           { that many (total) code lengths }
+    var bl : cardinal;               { literal desired/actual bit depth }
+    var bd : cardinal;               { distance desired/actual bit depth }
+var tl : pInflate_huft;           { literal/length tree result }
+var td : pInflate_huft;           { distance tree result }
+var hp : array of Inflate_huft;   { space for trees }
+var z : z_stream                  { for messages }
+     ) : integer;
+
+function inflate_trees_fixed (
+    var bl : cardinal;                { literal desired/actual bit depth }
+    var bd : cardinal;                { distance desired/actual bit depth }
+    var tl : pInflate_huft;       { literal/length tree result }
+    var td : pInflate_huft;       { distance tree result }
+    var z : z_stream              { for memory allocation }
+     ) : integer;
+
+
+implementation
+
+const
+ inflate_copyright = 'inflate 1.1.2 Copyright 1995-1998 Mark Adler';
+
+{
+  If you use the zlib library in a product, an acknowledgment is welcome
+  in the documentation of your product. If for some reason you cannot
+  include such an acknowledgment, I would appreciate that you keep this
+  copyright string in the executable of your product.
+}
+
+
+const
+{ Tables for deflate from PKZIP's appnote.txt. }
+  cplens : Array [0..30] Of cardinal  { Copy lengths for literal codes 257..285 }
+     = (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);
+        { actually lengths - 2; also see note #13 above about 258 }
+
+  invalid_code = 112;
+
+  cplext : Array [0..30] Of cardinal  { Extra bits for literal codes 257..285 }
+     = (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);
+
+  cpdist : Array [0..29] Of cardinal { Copy offsets for distance codes 0..29 }
+     = (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);
+
+  cpdext : Array [0..29] Of cardinal { Extra bits for distance codes }
+     = (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);
+
+{  Huffman code decoding is performed using a multi-level table lookup.
+   The 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 long.  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 lbits and dbits
+   below.  lbits is the number of bits the first level table for literal/
+   length codes can decode in one step, and dbits 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 lbits is 8+1 and dbits is 5+1.
+   The optimum values may differ though from machine to machine, and
+   possibly even between compilers.  Your mileage may vary. }
+
+
+{ If BMAX needs to be larger than 16, then h and x[] should be uLong. }
+const
+  BMAX = 15;         { maximum bit length of any code }
+
+{$DEFINE USE_PTR}
+
+function huft_build(
+var b : array of cardinal;    { code lengths in bits (all assumed <= BMAX) }
+    n : cardinal;              { number of codes (assumed <= N_MAX) }
+    s : cardinal;              { number of simple-valued codes (0..s-1) }
+const d : array of cardinal;  { list of base values for non-simple codes }
+{ array of word }
+const e : array of cardinal;  { list of extra bits for non-simple codes }
+{ array of byte }
+  t : ppInflate_huft;     { result: starting table }
+var m : cardinal;             { maximum lookup bits, returns actual }
+var hp : array of inflate_huft;  { space for trees }
+var hn : cardinal;             { hufts used in space }
+var v : array of cardinal     { working area: values in order of bit length }
+   ) : integer;
+{ Given a list of code lengths and a maximum table size, make a set of
+  tables to decode that set of codes.  Return 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. }
+Var
+  a : cardinal;                     { counter for codes of length k }
+  c : Array [0..BMAX] Of cardinal;  { bit length count table }
+  f : cardinal;                     { i repeats in table every f entries }
+  g : integer;                      { maximum code length }
+  h : integer;                      { table level }
+  i : cardinal;  {register}         { counter, current code }
+  j : cardinal;  {register}         { counter }
+  k : integer;   {register}         { 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 : ^cardinal; {register}        { pointer into c[], b[], or v[] }
+  q : pInflate_huft;            { points to current table }
+  r : inflate_huft;             { table entry for structure assignment }
+  u : Array [0..BMAX-1] Of pInflate_huft; { table stack }
+  w : integer;   {register}         { bits before this table = (l*h) }
+  x : Array [0..BMAX] Of cardinal;  { bit offsets, then code stack }
+  {$IFDEF USE_PTR}
+  xp : Pcardinal;                  { pointer into x }
+  {$ELSE}
+  xp : cardinal;
+  {$ENDIF}
+  y : integer;                      { number of dummy codes added }
+  z : cardinal;                     { number of entries in current table }
+Begin
+  { Generate counts for each bit length }
+  FillChar(c,SizeOf(c),0) ;     { clear c[] }
+
+  for i := 0 to n-1 do
+    Inc (c[b[i]]);              { assume all entries <= BMAX }
+
+  If (c[0] = n) Then            { null input--all zero length codes }
+  Begin
+    t^ := pInflate_huft(NIL);
+    m := 0 ;
+    huft_build := 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;
+  k := j ;                      { minimum code length }
+  if (cardinal(l) < j) then
+    l := j;
+  for i := BMAX downto 1 do
+    if (c[i] <> 0) then
+      break ;
+  g := i ;                      { maximum code length }
+  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
+      huft_build := Z_DATA_ERROR;   { bad input: more codes than bits }
+      exit;
+    end ;
+    Inc(j) ;
+    y := y shl 1
+  end;
+  Dec (y, c[i]) ;
+  if (y < 0) then
+  begin
+    huft_build := Z_DATA_ERROR;     { bad input: more codes than bits }
+    exit;
+  end;
+  Inc(c[i], y);
+
+  { Generate starting offsets into the value table FOR each length }
+  {$IFDEF USE_PTR}
+  x[1] := 0;
+  j := 0;
+
+  p := @c[1];
+  xp := @x[2];
+
+  dec(i);               { note that i = g from above }
+  WHILE (i > 0) DO
+  BEGIN
+    inc(j, p^);
+    xp^ := j;
+    inc(p);
+    inc(xp);
+    dec(i);
+  END;
+  {$ELSE}
+  x[1] := 0;
+  j := 0 ;
+  for i := 1 to g do
+  begin
+    x[i] := j;
+    Inc(j, c[i]);
+  end;
+  {$ENDIF}
+
+  { 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;
+  n := x[g];                     { set n to length of v }
+
+  { Generate the Huffman codes and for each, make the table entries }
+  i := 0 ;
+  x[0] := 0 ;                   { first Huffman code is zero }
+  p := @v[0] ;                { grab values in bit order }
+  h := -1 ;                     { no tables yet--level -1 }
+  w := -l ;                     { bits decoded = (l*h) }
+
+  u[0] := pInflate_huft(NIL);   { just to keep compilers happy }
+  q := pInflate_huft(NIL);      { ditto }
+  z := 0 ;                      { ditto }
+
+  { 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) ;
+        Inc (w, l);              { add bits already decoded }
+                                 { previous table always l bits }
+        { compute minimum size table less than or equal to l bits }
+
+        { table size upper limit }
+        z := g - w;
+        If (z > cardinal(l)) Then
+          z := l;
+
+        { try a k-w bit table }
+        j := k - w;
+        f := 1 shl j;
+        if (f > a+1) Then        { too few codes for k-w bit table }
+        begin
+          Dec(f, a+1);           { deduct codes from patterns left }
+          {$IFDEF USE_PTR}
+          xp := Addr(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) ;
+              If (f <= xp^) Then
+                break;           { enough codes to use up j bits }
+              Dec(f, xp^);       { else deduct codes from patterns }
+              Inc(j);
+            end;
+          end;
+          {$ELSE}
+          xp := k;
+
+          if (j < z) then
+          begin
+            Inc (j) ;
+            While (j < z) Do
+            begin                 { try smaller tables up to z bits }
+              f := f * 2;
+              Inc (xp) ;
+              if (f <= c[xp]) then
+                Break ;           { enough codes to use up j bits }
+              Dec (f, c[xp]) ;      { else deduct codes from patterns }
+              Inc (j);
+            end;
+          end;
+          {$ENDIF}
+        end;
+
+        z := 1 shl j;            { table entries for j-bit table }
+
+        { allocate new table }
+        if (hn + z > MANY) then { (note: doesn't matter for fixed) }
+        begin
+          huft_build := Z_MEM_ERROR;     { not enough memory }
+          exit;
+        end;
+
+        q := @hp[hn];
+        u[h] := q;
+        Inc(hn, z);
+
+        { connect to last table, if there is one }
+        if (h <> 0) then
+        begin
+          x[h] := i;             { save pattern for backing up }
+          r.bits := byte(l);     { bits to dump before this table }
+          r.exop := byte(j);     { bits in this table }
+          j := i shr (w - l);
+          {r.base := cardinal( q - u[h-1] -j);}   { offset to this table }
+          r.base := (ptruint(q) - ptruint(u[h-1]) ) div sizeof(q^) - j;
+          huft_Ptr(u[h-1])^[j] := r;  { connect to last table }
+        end
+        else
+          t^ := q;               { first table is returned result }
+      end;
+
+      { set up table entry in r }
+      r.bits := byte(k - w);
+
+      { C-code: if (p >= v + n) - see ZUTIL.PAS for comments }
+
+      if ptruint(p)>=ptruint(@(v[n])) then  { also works under DPMI ?? }
+        r.exop := 128 + 64                  { out of values--invalid code }
+      else
+        if (p^ < s) then
+        begin
+          if (p^ < 256) then     { 256 is end-of-block code }
+            r.exop := 0
+          Else
+            r.exop := 32 + 64;   { EOB_code; }
+          r.base := p^;          { simple code is just the value }
+          Inc(p);
+        end
+        Else
+        begin
+          r.exop := byte(e[p^-s] + 16 + 64);  { non-simple--look up in lists }
+          r.base := d[p^-s];
+          Inc (p);
+        end ;
+
+      { fill code-like entries with r }
+      f := 1 shl (k - w);
+      j := i shr w;
+      while (j < z) do
+      begin
+        huft_Ptr(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;         { bitwise exclusive or }
+        j := j shr 1
+      end ;
+      i := i xor j;
+
+      { backup over finished tables }
+      mask := (1 shl w) - 1;   { needed on HP, cc -O bug }
+      while ((i and mask) <> x[h]) do
+      begin
+        Dec(h);                { don't need to update q }
+        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
+    huft_build := Z_BUF_ERROR
+  else
+    huft_build := Z_OK;
+end; { huft_build}
+
+
+function inflate_trees_bits(
+  var c : array of cardinal;  { 19 code lengths }
+  var bb : cardinal;          { bits tree desired/actual depth }
+  var tb : pinflate_huft;  { bits tree result }
+  var hp : array of Inflate_huft;      { space for trees }
+  var z : z_stream         { for messages }
+    ) : integer;
+var
+  r : integer;
+  hn : cardinal;          { hufts used in space }
+  v : Pcardinalarray;     { work area for huft_build }
+begin
+  hn := 0;
+  getmem(v,19*sizeof(cardinal));
+  if (v = nil) then
+  begin
+    inflate_trees_bits := Z_MEM_ERROR;
+    exit;
+  end;
+
+  r := huft_build(c, 19, 19, cplens, cplext,
+                             {Pcardinal(nil), Pcardinal(nil),}
+                  @tb, bb, hp, hn, v^);
+  if (r = Z_DATA_ERROR) then
+    z.msg := 'oversubscribed dynamic bit lengths tree'
+  else
+    if (r = Z_BUF_ERROR) or (bb = 0) then
+    begin
+      z.msg := 'incomplete dynamic bit lengths tree';
+      r := Z_DATA_ERROR;
+    end;
+  freemem(v);
+  inflate_trees_bits := r;
+end;
+
+
+function inflate_trees_dynamic(
+    nl : cardinal;                    { number of literal/length codes }
+    nd : cardinal;                    { number of distance codes }
+    var c : Array of cardinal;           { that many (total) code lengths }
+    var bl : cardinal;          { literal desired/actual bit depth }
+    var bd : cardinal;          { distance desired/actual bit depth }
+var tl : pInflate_huft;           { literal/length tree result }
+var td : pInflate_huft;           { distance tree result }
+var hp : array of Inflate_huft;   { space for trees }
+var z : z_stream                  { for messages }
+     ) : integer;
+var
+  r : integer;
+  hn : cardinal;          { hufts used in space }
+  v : Pcardinalarray;     { work area for huft_build }
+begin
+  hn := 0;
+  { allocate work area }
+  getmem(v,288*sizeof(cardinal));
+  if (v = nil) then
+  begin
+    inflate_trees_dynamic := Z_MEM_ERROR;
+    exit;
+  end;
+
+  { build literal/length tree }
+  r := huft_build(c, nl, 257, cplens, cplext, @tl, bl, hp, hn, v^);
+  if (r <> Z_OK) or (bl = 0) then
+  begin
+    if (r = Z_DATA_ERROR) then
+      z.msg := 'oversubscribed literal/length tree'
+    else
+      if (r <> Z_MEM_ERROR) then
+      begin
+        z.msg := 'incomplete literal/length tree';
+        r := Z_DATA_ERROR;
+      end;
+
+    freemem(v);
+    inflate_trees_dynamic := r;
+    exit;
+  end;
+
+  { build distance tree }
+  r := huft_build(Pcardinalarray(@c[nl])^, nd, 0,
+                  cpdist, cpdext, @td, bd, hp, hn, v^);
+  if (r <> Z_OK) or ((bd = 0) and (nl > 257)) then
+  begin
+    if (r = Z_DATA_ERROR) then
+      z.msg := 'oversubscribed literal/length tree'
+    else
+      if (r = Z_BUF_ERROR) then
+      begin
+{$ifdef PKZIP_BUG_WORKAROUND}
+        r := Z_OK;
+      end;
+{$else}
+        z.msg := 'incomplete literal/length tree';
+        r := Z_DATA_ERROR;
+      end
+      else
+        if (r <> Z_MEM_ERROR) then
+        begin
+          z.msg := 'empty distance tree with lengths';
+          r := Z_DATA_ERROR;
+        end;
+    freemem(v);
+    inflate_trees_dynamic := r;
+    exit;
+{$endif}
+  end;
+
+  { done }
+  freemem(v);
+  inflate_trees_dynamic := Z_OK;
+end;
+
+{$UNDEF BUILDFIXED}
+
+{ build fixed tables only once--keep them here }
+{$IFNDEF BUILDFIXED}
+{ locals }
+const
+  fixed_built : Boolean = false;
+  FIXEDH = 544;      { number of hufts used by fixed tables }
+var
+  fixed_mem : array[0..FIXEDH-1] of inflate_huft;
+  fixed_bl : cardinal;
+  fixed_bd : cardinal;
+  fixed_tl : pInflate_huft;
+  fixed_td : pInflate_huft;
+
+{$ELSE}
+
+{ inffixed.h -- table for decoding fixed codes }
+
+{local}
+const
+  fixed_bl = 9;
+{local}
+const
+  fixed_bd = 5;
+{local}
+const
+  fixed_tl : array [0..288-1] of inflate_huft = (
+    Exop,             { number of extra bits or operation }
+    bits : byte;      { number of bits in this code or subcode }
+    {pad : cardinal;}       { pad structure to a power of 2 (4 bytes for }
+                      {  16-bit, 8 bytes for 32-bit integer's) }
+    base : cardinal;      { literal, length base, or distance base }
+                      { or table offset }
+
+    ((96,7),256), ((0,8),80), ((0,8),16), ((84,8),115), ((82,7),31),
+    ((0,8),112), ((0,8),48), ((0,9),192), ((80,7),10), ((0,8),96),
+    ((0,8),32), ((0,9),160), ((0,8),0), ((0,8),128), ((0,8),64),
+    ((0,9),224), ((80,7),6), ((0,8),88), ((0,8),24), ((0,9),144),
+    ((83,7),59), ((0,8),120), ((0,8),56), ((0,9),208), ((81,7),17),
+    ((0,8),104), ((0,8),40), ((0,9),176), ((0,8),8), ((0,8),136),
+    ((0,8),72), ((0,9),240), ((80,7),4), ((0,8),84), ((0,8),20),
+    ((85,8),227), ((83,7),43), ((0,8),116), ((0,8),52), ((0,9),200),
+    ((81,7),13), ((0,8),100), ((0,8),36), ((0,9),168), ((0,8),4),
+    ((0,8),132), ((0,8),68), ((0,9),232), ((80,7),8), ((0,8),92),
+    ((0,8),28), ((0,9),152), ((84,7),83), ((0,8),124), ((0,8),60),
+    ((0,9),216), ((82,7),23), ((0,8),108), ((0,8),44), ((0,9),184),
+    ((0,8),12), ((0,8),140), ((0,8),76), ((0,9),248), ((80,7),3),
+    ((0,8),82), ((0,8),18), ((85,8),163), ((83,7),35), ((0,8),114),
+    ((0,8),50), ((0,9),196), ((81,7),11), ((0,8),98), ((0,8),34),
+    ((0,9),164), ((0,8),2), ((0,8),130), ((0,8),66), ((0,9),228),
+    ((80,7),7), ((0,8),90), ((0,8),26), ((0,9),148), ((84,7),67),
+    ((0,8),122), ((0,8),58), ((0,9),212), ((82,7),19), ((0,8),106),
+    ((0,8),42), ((0,9),180), ((0,8),10), ((0,8),138), ((0,8),74),
+    ((0,9),244), ((80,7),5), ((0,8),86), ((0,8),22), ((192,8),0),
+    ((83,7),51), ((0,8),118), ((0,8),54), ((0,9),204), ((81,7),15),
+    ((0,8),102), ((0,8),38), ((0,9),172), ((0,8),6), ((0,8),134),
+    ((0,8),70), ((0,9),236), ((80,7),9), ((0,8),94), ((0,8),30),
+    ((0,9),156), ((84,7),99), ((0,8),126), ((0,8),62), ((0,9),220),
+    ((82,7),27), ((0,8),110), ((0,8),46), ((0,9),188), ((0,8),14),
+    ((0,8),142), ((0,8),78), ((0,9),252), ((96,7),256), ((0,8),81),
+    ((0,8),17), ((85,8),131), ((82,7),31), ((0,8),113), ((0,8),49),
+    ((0,9),194), ((80,7),10), ((0,8),97), ((0,8),33), ((0,9),162),
+    ((0,8),1), ((0,8),129), ((0,8),65), ((0,9),226), ((80,7),6),
+    ((0,8),89), ((0,8),25), ((0,9),146), ((83,7),59), ((0,8),121),
+    ((0,8),57), ((0,9),210), ((81,7),17), ((0,8),105), ((0,8),41),
+    ((0,9),178), ((0,8),9), ((0,8),137), ((0,8),73), ((0,9),242),
+    ((80,7),4), ((0,8),85), ((0,8),21), ((80,8),258), ((83,7),43),
+    ((0,8),117), ((0,8),53), ((0,9),202), ((81,7),13), ((0,8),101),
+    ((0,8),37), ((0,9),170), ((0,8),5), ((0,8),133), ((0,8),69),
+    ((0,9),234), ((80,7),8), ((0,8),93), ((0,8),29), ((0,9),154),
+    ((84,7),83), ((0,8),125), ((0,8),61), ((0,9),218), ((82,7),23),
+    ((0,8),109), ((0,8),45), ((0,9),186), ((0,8),13), ((0,8),141),
+    ((0,8),77), ((0,9),250), ((80,7),3), ((0,8),83), ((0,8),19),
+    ((85,8),195), ((83,7),35), ((0,8),115), ((0,8),51), ((0,9),198),
+    ((81,7),11), ((0,8),99), ((0,8),35), ((0,9),166), ((0,8),3),
+    ((0,8),131), ((0,8),67), ((0,9),230), ((80,7),7), ((0,8),91),
+    ((0,8),27), ((0,9),150), ((84,7),67), ((0,8),123), ((0,8),59),
+    ((0,9),214), ((82,7),19), ((0,8),107), ((0,8),43), ((0,9),182),
+    ((0,8),11), ((0,8),139), ((0,8),75), ((0,9),246), ((80,7),5),
+    ((0,8),87), ((0,8),23), ((192,8),0), ((83,7),51), ((0,8),119),
+    ((0,8),55), ((0,9),206), ((81,7),15), ((0,8),103), ((0,8),39),
+    ((0,9),174), ((0,8),7), ((0,8),135), ((0,8),71), ((0,9),238),
+    ((80,7),9), ((0,8),95), ((0,8),31), ((0,9),158), ((84,7),99),
+    ((0,8),127), ((0,8),63), ((0,9),222), ((82,7),27), ((0,8),111),
+    ((0,8),47), ((0,9),190), ((0,8),15), ((0,8),143), ((0,8),79),
+    ((0,9),254), ((96,7),256), ((0,8),80), ((0,8),16), ((84,8),115),
+    ((82,7),31), ((0,8),112), ((0,8),48), ((0,9),193), ((80,7),10),
+    ((0,8),96), ((0,8),32), ((0,9),161), ((0,8),0), ((0,8),128),
+    ((0,8),64), ((0,9),225), ((80,7),6), ((0,8),88), ((0,8),24),
+    ((0,9),145), ((83,7),59), ((0,8),120), ((0,8),56), ((0,9),209),
+    ((81,7),17), ((0,8),104), ((0,8),40), ((0,9),177), ((0,8),8),
+    ((0,8),136), ((0,8),72), ((0,9),241), ((80,7),4), ((0,8),84),
+    ((0,8),20), ((85,8),227), ((83,7),43), ((0,8),116), ((0,8),52),
+    ((0,9),201), ((81,7),13), ((0,8),100), ((0,8),36), ((0,9),169),
+    ((0,8),4), ((0,8),132), ((0,8),68), ((0,9),233), ((80,7),8),
+    ((0,8),92), ((0,8),28), ((0,9),153), ((84,7),83), ((0,8),124),
+    ((0,8),60), ((0,9),217), ((82,7),23), ((0,8),108), ((0,8),44),
+    ((0,9),185), ((0,8),12), ((0,8),140), ((0,8),76), ((0,9),249),
+    ((80,7),3), ((0,8),82), ((0,8),18), ((85,8),163), ((83,7),35),
+    ((0,8),114), ((0,8),50), ((0,9),197), ((81,7),11), ((0,8),98),
+    ((0,8),34), ((0,9),165), ((0,8),2), ((0,8),130), ((0,8),66),
+    ((0,9),229), ((80,7),7), ((0,8),90), ((0,8),26), ((0,9),149),
+    ((84,7),67), ((0,8),122), ((0,8),58), ((0,9),213), ((82,7),19),
+    ((0,8),106), ((0,8),42), ((0,9),181), ((0,8),10), ((0,8),138),
+    ((0,8),74), ((0,9),245), ((80,7),5), ((0,8),86), ((0,8),22),
+    ((192,8),0), ((83,7),51), ((0,8),118), ((0,8),54), ((0,9),205),
+    ((81,7),15), ((0,8),102), ((0,8),38), ((0,9),173), ((0,8),6),
+    ((0,8),134), ((0,8),70), ((0,9),237), ((80,7),9), ((0,8),94),
+    ((0,8),30), ((0,9),157), ((84,7),99), ((0,8),126), ((0,8),62),
+    ((0,9),221), ((82,7),27), ((0,8),110), ((0,8),46), ((0,9),189),
+    ((0,8),14), ((0,8),142), ((0,8),78), ((0,9),253), ((96,7),256),
+    ((0,8),81), ((0,8),17), ((85,8),131), ((82,7),31), ((0,8),113),
+    ((0,8),49), ((0,9),195), ((80,7),10), ((0,8),97), ((0,8),33),
+    ((0,9),163), ((0,8),1), ((0,8),129), ((0,8),65), ((0,9),227),
+    ((80,7),6), ((0,8),89), ((0,8),25), ((0,9),147), ((83,7),59),
+    ((0,8),121), ((0,8),57), ((0,9),211), ((81,7),17), ((0,8),105),
+    ((0,8),41), ((0,9),179), ((0,8),9), ((0,8),137), ((0,8),73),
+    ((0,9),243), ((80,7),4), ((0,8),85), ((0,8),21), ((80,8),258),
+    ((83,7),43), ((0,8),117), ((0,8),53), ((0,9),203), ((81,7),13),
+    ((0,8),101), ((0,8),37), ((0,9),171), ((0,8),5), ((0,8),133),
+    ((0,8),69), ((0,9),235), ((80,7),8), ((0,8),93), ((0,8),29),
+    ((0,9),155), ((84,7),83), ((0,8),125), ((0,8),61), ((0,9),219),
+    ((82,7),23), ((0,8),109), ((0,8),45), ((0,9),187), ((0,8),13),
+    ((0,8),141), ((0,8),77), ((0,9),251), ((80,7),3), ((0,8),83),
+    ((0,8),19), ((85,8),195), ((83,7),35), ((0,8),115), ((0,8),51),
+    ((0,9),199), ((81,7),11), ((0,8),99), ((0,8),35), ((0,9),167),
+    ((0,8),3), ((0,8),131), ((0,8),67), ((0,9),231), ((80,7),7),
+    ((0,8),91), ((0,8),27), ((0,9),151), ((84,7),67), ((0,8),123),
+    ((0,8),59), ((0,9),215), ((82,7),19), ((0,8),107), ((0,8),43),
+    ((0,9),183), ((0,8),11), ((0,8),139), ((0,8),75), ((0,9),247),
+    ((80,7),5), ((0,8),87), ((0,8),23), ((192,8),0), ((83,7),51),
+    ((0,8),119), ((0,8),55), ((0,9),207), ((81,7),15), ((0,8),103),
+    ((0,8),39), ((0,9),175), ((0,8),7), ((0,8),135), ((0,8),71),
+    ((0,9),239), ((80,7),9), ((0,8),95), ((0,8),31), ((0,9),159),
+    ((84,7),99), ((0,8),127), ((0,8),63), ((0,9),223), ((82,7),27),
+    ((0,8),111), ((0,8),47), ((0,9),191), ((0,8),15), ((0,8),143),
+    ((0,8),79), ((0,9),255)
+  );
+
+{local}
+const
+  fixed_td : array[0..32-1] of inflate_huft = (
+(Exop:80;bits:5;base:1),      (Exop:87;bits:5;base:257),   (Exop:83;bits:5;base:17),
+(Exop:91;bits:5;base:4097),   (Exop:81;bits:5;base),       (Exop:89;bits:5;base:1025),
+(Exop:85;bits:5;base:65),     (Exop:93;bits:5;base:16385), (Exop:80;bits:5;base:3),
+(Exop:88;bits:5;base:513),    (Exop:84;bits:5;base:33),    (Exop:92;bits:5;base:8193),
+(Exop:82;bits:5;base:9),      (Exop:90;bits:5;base:2049),  (Exop:86;bits:5;base:129),
+(Exop:192;bits:5;base:24577), (Exop:80;bits:5;base:2),     (Exop:87;bits:5;base:385),
+(Exop:83;bits:5;base:25),     (Exop:91;bits:5;base:6145),  (Exop:81;bits:5;base:7),
+(Exop:89;bits:5;base:1537),   (Exop:85;bits:5;base:97),    (Exop:93;bits:5;base:24577),
+(Exop:80;bits:5;base:4),      (Exop:88;bits:5;base:769),   (Exop:84;bits:5;base:49),
+(Exop:92;bits:5;base:12289),  (Exop:82;bits:5;base:13),    (Exop:90;bits:5;base:3073),
+(Exop:86;bits:5;base:193),    (Exop:192;bits:5;base:24577)
+  );
+{$ENDIF}
+
+function inflate_trees_fixed(
+var bl : cardinal;               { literal desired/actual bit depth }
+var bd : cardinal;               { distance desired/actual bit depth }
+var tl : pInflate_huft;      { literal/length tree result }
+var td : pInflate_huft;      { distance tree result }
+var  z : z_stream            { for memory allocation }
+      ) : integer;
+type
+  pFixed_table = ^fixed_table;
+  fixed_table = array[0..288-1] of cardinal;
+var
+  k : integer;                   { temporary variable }
+  c : pFixed_table;              { length list for huft_build }
+  v : Pcardinalarray;            { work area for huft_build }
+var
+  f : cardinal;                  { number of hufts used in fixed_mem }
+begin
+  { build fixed tables if not already (multiple overlapped executions ok) }
+  if not fixed_built then
+  begin
+    f := 0;
+
+    { allocate memory }
+    getmem(c,288*sizeof(cardinal));
+    if (c = nil) then
+    begin
+      inflate_trees_fixed := Z_MEM_ERROR;
+      exit;
+    end;
+    getmem(v,288*sizeof(cardinal));
+    if (v = nil) then
+    begin
+      freemem(c);
+      inflate_trees_fixed := Z_MEM_ERROR;
+      exit;
+    end;
+
+    { literal table }
+    for k := 0 to Pred(144) do
+      c^[k] := 8;
+    for k := 144 to Pred(256) do
+      c^[k] := 9;
+    for k := 256 to Pred(280) do
+      c^[k] := 7;
+    for k := 280 to Pred(288) do
+      c^[k] := 8;
+    fixed_bl := 9;
+    huft_build(c^, 288, 257, cplens, cplext, @fixed_tl, fixed_bl,
+               fixed_mem, f, v^);
+
+    { distance table }
+    for k := 0 to Pred(30) do
+      c^[k] := 5;
+    fixed_bd := 5;
+    huft_build(c^, 30, 0, cpdist, cpdext, @fixed_td, fixed_bd,
+               fixed_mem, f, v^);
+
+    { done }
+    freemem(v);
+    freemem(c);
+    fixed_built := True;
+  end;
+  bl := fixed_bl;
+  bd := fixed_bd;
+  tl := fixed_tl;
+  td := fixed_td;
+  inflate_trees_fixed := Z_OK;
+end; { inflate_trees_fixed }
+
+
+end.

+ 222 - 0
src/libraries/paszlib/paszlib_infutil.pas

@@ -0,0 +1,222 @@
+Unit paszlib_infutil;
+
+{ types and macros common to blocks and codes
+  Copyright (C) 1995-1998 Mark Adler
+
+   WARNING: this file should *not* be used by applications. It is
+   part of the implementation of the compression library and is
+   subject to change.
+
+  Pascal tranlastion
+  Copyright (C) 1998 by Jacques Nomssi Nzali
+  For conditions of distribution and use, see copyright notice in readme.txt
+}
+
+interface
+
+{$I paszlib_zconf.inc}
+
+uses
+  paszlib_zbase;
+
+{ copy as much as possible from the sliding window to the output area }
+function inflate_flush(var s : inflate_blocks_state;
+                       var z : z_stream;
+                       r : integer) : integer;
+
+{ And'ing with mask[n] masks the lower n bits }
+const
+  inflate_mask : array[0..17-1] of cardinal = (
+    $0000,
+    $0001, $0003, $0007, $000f, $001f, $003f, $007f, $00ff,
+    $01ff, $03ff, $07ff, $0fff, $1fff, $3fff, $7fff, $ffff);
+
+{procedure GRABBITS(j : integer);}
+{procedure DUMPBITS(j : integer);}
+{procedure NEEDBITS(j : integer);}
+
+implementation
+
+{ macros for bit input with no checking and for returning unused bytes }
+procedure GRABBITS(j : integer);
+begin
+  {while (k < j) do
+  begin
+    dec(z^.avail_in);
+    inc(z^.total_in);
+    b := b or (uLong(z^.next_in^) shl k);
+    inc(z^.next_in);
+    inc(k, 8);
+  end;}
+end;
+
+procedure DUMPBITS(j : integer);
+begin
+  {b := b shr j;
+  dec(k, j);}
+end;
+
+procedure NEEDBITS(j : integer);
+begin
+ (*
+          while (k < j) do
+          begin
+            {NEEDBYTE;}
+            if (n <> 0) then
+              r :=Z_OK
+            else
+            begin
+              {UPDATE}
+              s.bitb := b;
+              s.bitk := k;
+              z.avail_in := n;
+              inc(z.total_in, LongInt(p)-LongInt(z.next_in));
+              z.next_in := p;
+              s.write := q;
+              result := inflate_flush(s,z,r);
+              exit;
+            end;
+            dec(n);
+            b := b or (uLong(p^) shl k);
+            inc(p);
+            inc(k, 8);
+          end;
+ *)
+end;
+
+procedure NEEDOUT;
+begin
+ (*
+  if (m = 0) then
+  begin
+    {WRAP}
+    if (q = s.zend) and (s.read <> s.window) then
+    begin
+      q := s.window;
+      if LongInt(q) < LongInt(s.read) then
+        m := cardinal(LongInt(s.read)-LongInt(q)-1)
+      else
+        m := cardinal(LongInt(s.zend)-LongInt(q));
+    end;
+
+    if (m = 0) then
+    begin
+      {FLUSH}
+      s.write := q;
+      r := inflate_flush(s,z,r);
+      q := s.write;
+      if LongInt(q) < LongInt(s.read) then
+        m := cardinal(LongInt(s.read)-LongInt(q)-1)
+      else
+        m := cardinal(LongInt(s.zend)-LongInt(q));
+
+      {WRAP}
+      if (q = s.zend) and (s.read <> s.window) then
+      begin
+        q := s.window;
+        if LongInt(q) < LongInt(s.read) then
+          m := cardinal(LongInt(s.read)-LongInt(q)-1)
+        else
+          m := cardinal(LongInt(s.zend)-LongInt(q));
+      end;
+
+      if (m = 0) then
+      begin
+        {UPDATE}
+        s.bitb := b;
+        s.bitk := k;
+        z.avail_in := n;
+        inc(z.total_in, LongInt(p)-LongInt(z.next_in));
+        z.next_in := p;
+        s.write := q;
+        result := inflate_flush(s,z,r);
+        exit;
+      end;
+    end;
+  end;
+  r := Z_OK;
+ *)
+end;
+
+{ copy as much as possible from the sliding window to the output area }
+function inflate_flush(var s : inflate_blocks_state;
+                       var z : z_stream;
+                       r : integer) : integer;
+var
+  n : cardinal;
+  p : Pbyte;
+  q : Pbyte;
+begin
+  { local copies of source and destination pointers }
+  p := z.next_out;
+  q := s.read;
+
+  { compute number of bytes to copy as far as end of window }
+  if ptruint(q) <= ptruint(s.write) then
+    n := cardinal(ptruint(s.write) - ptruint(q))
+  else
+    n := cardinal(ptruint(s.zend) - ptruint(q));
+  if (n > z.avail_out) then
+    n := z.avail_out;
+  if (n <> 0) and (r = Z_BUF_ERROR) then
+    r := Z_OK;
+
+  { update counters }
+  dec(z.avail_out, n);
+  inc(z.total_out, n);
+
+
+  { update check information }
+  if Assigned(s.checkfn) then
+  begin
+    s.check := s.checkfn(s.check, q, n);
+    z.adler := s.check;
+  end;
+
+  { 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 := cardinal(ptruint(s.write) - ptruint(q));
+    if (n > z.avail_out) then
+      n := z.avail_out;
+    if (n <> 0) and (r = Z_BUF_ERROR) then
+      r := Z_OK;
+
+    { update counters }
+    dec( z.avail_out, n);
+    inc( z.total_out, n);
+
+    { update check information }
+    if Assigned(s.checkfn) then
+    begin
+      s.check := s.checkfn(s.check, q, n);
+      z.adler := s.check;
+    end;
+
+    { copy }
+    move(q^,p^,n);
+    inc(p, n);
+    inc(q, n);
+  end;
+
+
+  { update pointers }
+  z.next_out := p;
+  s.read := q;
+
+  { done }
+  inflate_flush := r;
+end;
+
+end.

+ 338 - 0
src/libraries/paszlib/paszlib_paszlib.pas

@@ -0,0 +1,338 @@
+unit paszlib_PasZLib;
+
+{$inline on}
+
+interface
+
+uses
+  paszlib_zbase;
+
+const
+  ZLIB_VERSION = '1.2';
+
+type
+  { Compatibility types }
+  z_off_t = longint;
+
+  TInternalState = record
+    end;
+  PInternalState = ^TInternalstate;
+
+  TZStream = z_stream;
+  PZstream = ^TZStream;
+
+  gzFile = pointer;
+
+
+const
+  Z_NO_FLUSH = 0;
+
+  Z_PARTIAL_FLUSH = 1;
+  Z_SYNC_FLUSH = 2;
+  Z_FULL_FLUSH = 3;
+  Z_FINISH = 4;
+
+  Z_OK = 0;
+  Z_STREAM_END = 1;
+  Z_NEED_DICT = 2;
+  Z_ERRNO = -(1);
+  Z_STREAM_ERROR = -(2);
+  Z_DATA_ERROR = -(3);
+  Z_MEM_ERROR = -(4);
+  Z_BUF_ERROR = -(5);
+  Z_VERSION_ERROR = -(6);
+
+  Z_NO_COMPRESSION = 0;
+  Z_BEST_SPEED = 1;
+  Z_BEST_COMPRESSION = 9;
+  Z_DEFAULT_COMPRESSION = -(1);
+
+  Z_FILTERED = 1;
+  Z_HUFFMAN_ONLY = 2;
+  Z_DEFAULT_STRATEGY = 0;
+
+  Z_BINARY = 0;
+  Z_ASCII = 1;
+  Z_UNKNOWN = 2;
+
+  Z_DEFLATED = 8;
+
+  Z_NULL = nil;
+
+function zlibVersion:string;inline;
+function deflate(var strm:TZstream; flush:longint):longint;inline;
+function deflateEnd(var strm:TZstream):longint;inline;
+function inflate(var strm:TZstream; flush:longint):longint;inline;
+function inflateEnd(var strm:TZstream):longint;inline;
+function deflateSetDictionary(var strm:TZstream;dictionary : Pchar; dictLength:cardinal):longint;inline;
+function deflateCopy(var dest,source:TZstream):longint;inline;
+function deflateReset(var strm:TZstream):longint;inline;
+function deflateParams(var strm:TZstream; level:longint; strategy:longint):longint;inline;
+function inflateSetDictionary(var strm:TZStream;dictionary : Pchar; dictLength:cardinal):longint;inline;
+function inflateSync(var strm:TZStream):longint;inline;
+function inflateReset(var strm:TZStream):longint;inline;
+function compress(dest:Pchar;var destLen:cardinal; source : Pchar; sourceLen:cardinal):longint;
+function compress2(dest:Pchar;var destLen:cardinal; source : Pchar; sourceLen:cardinal; level:longint):longint;
+function uncompress(dest:Pchar;var destLen:cardinal; source : Pchar; sourceLen:cardinal):longint;
+function gzopen(path:Pchar; mode:Pchar):gzFile;inline;
+function gzsetparams(Thefile:gzFile; level:longint; strategy:longint):longint;inline;
+function gzread(thefile:gzFile; buf : pointer; len:cardinal):longint;inline;
+function gzwrite(thefile:gzFile; buf: pointer; len:cardinal):longint;inline;
+function gzputs(thefile:gzFile; s:Pchar):longint;inline;
+function gzgets(thefile:gzFile; buf:Pchar; len:longint):Pchar;inline;
+function gzputc(thefile:gzFile; c:char):longint;inline;
+function gzgetc(thefile:gzFile):char;inline;
+function gzflush(thefile:gzFile; flush:longint):longint;inline;
+function gzseek(thefile:gzFile; offset:z_off_t; whence:longint):z_off_t;inline;
+function gzrewind(thefile:gzFile):longint;inline;
+function gztell(thefile:gzFile):z_off_t;inline;
+function gzeof(thefile:gzFile):longbool;inline;
+function gzclose(thefile:gzFile):longint;inline;
+function gzerror(thefile:gzFile; var errnum:smallint):string;inline;
+function adler32(theadler:cardinal;buf : Pchar; len:cardinal):cardinal;inline;
+function crc32(thecrc:cardinal;buf : Pchar; len:cardinal):cardinal;inline;
+function deflateInit_(var strm:TZStream; level:longint; version:Pchar; stream_size:longint):longint;inline;
+function inflateInit_(var strm:TZStream; version:Pchar; stream_size:longint):longint;inline;
+function deflateInit2_(var strm:TZStream; level:longint; method:longint; windowBits:longint; memLevel:longint;strategy:longint; version:Pchar; stream_size:longint):longint;inline;
+function inflateInit2_(var strm:TZStream; windowBits:longint; version:Pchar; stream_size:longint):longint;inline;
+function deflateInit(var strm:TZStream;level : longint) : longint;inline;
+function inflateInit(var strm:TZStream) : longint;inline;
+function deflateInit2(var strm:TZStream;level,method,windowBits,memLevel,strategy : longint) : longint;inline;
+function inflateInit2(var strm:TZStream; windowBits : longint) : longint;inline;
+function zError(err:longint):string;inline;
+function inflateSyncPoint(z:PZstream):longint;inline;
+function get_crc_table:pointer;inline;
+
+implementation
+
+uses
+  paszlib_zdeflate,paszlib_zinflate,paszlib_zcompres,paszlib_zuncompr,paszlib_gzio,paszlib_adler,crc;
+
+function zlibVersion:string;inline;
+begin
+  zlibversion:=zbase.zlibversion;
+end;
+
+function deflate(var strm:TZstream; flush:longint):longint;inline;
+begin
+  deflate:=zdeflate.deflate(strm,flush);
+end;
+
+function deflateEnd(var strm:TZstream):longint;inline;
+begin
+  deflateEnd:=zdeflate.deflateEnd(strm);
+end;
+
+function inflate(var strm:TZstream; flush:longint):longint;inline;
+begin
+  inflate:=zinflate.inflate(strm,flush);
+end;
+
+function inflateEnd(var strm:TZstream):longint;inline;
+begin
+  inflateEnd:=zinflate.inflateEnd(strm);
+end;
+
+function deflateSetDictionary(var strm:TZstream;dictionary : Pchar; dictLength:cardinal):longint;inline;
+begin
+  deflateSetDictionary:=zdeflate.deflateSetDictionary(strm,Pbyte(dictionary),dictlength);
+end;
+
+function deflateCopy(var dest,source:TZstream):longint;inline;
+begin
+  deflateCopy:=zdeflate.deflateCopy(@dest,@source);
+end;
+
+function deflateReset(var strm:TZstream):longint;inline;
+begin
+  deflateReset:=zdeflate.deflateReset(strm);
+end;
+
+function deflateParams(var strm:TZstream; level:longint; strategy:longint):longint;inline;
+begin
+  deflateParams:=zdeflate.deflateParams(strm,level,strategy);
+end;
+
+function inflateSetDictionary(var strm:TZStream;dictionary : Pchar; dictLength:cardinal):longint;inline;
+begin
+  inflateSetDictionary:=zinflate.inflateSetDictionary(strm,Pbyte(dictionary),dictlength);
+end;
+
+function inflateSync(var strm:TZStream):longint;inline;
+begin
+  inflateSync:=zinflate.inflateSync(strm);
+end;
+
+function inflateReset(var strm:TZStream):longint;inline;
+begin
+  inflateReset:=zinflate.inflateReset(strm);
+end;
+
+function compress(dest:Pchar;var destLen:cardinal; source : Pchar; sourceLen:cardinal):longint;
+
+type Pbytearray=^Tbytearray;
+     Tbytearray=array[0..0] of byte;
+
+begin
+  compress:=zcompres.compress(Pbyte(dest),destlen,Pbytearray(source)^,sourcelen);
+end;
+
+function compress2(dest:Pchar;var destLen:cardinal; source : Pchar; sourceLen:cardinal; level:longint):longint;
+
+type Pbytearray=^Tbytearray;
+     Tbytearray=array[0..0] of byte;
+
+begin
+  compress2:=zcompres.compress2(Pbyte(dest),destlen,Pbytearray(source)^,sourcelen,level);
+end;
+
+function uncompress(dest:Pchar;var destLen:cardinal; source : Pchar; sourceLen:cardinal):longint;
+
+type Pbytearray=^Tbytearray;
+     Tbytearray=array[0..0] of byte;
+
+begin
+  uncompress:=zuncompr.uncompress(Pbyte(dest),destlen,Pbytearray(source)^,sourcelen);
+end;
+
+function gzopen(path:Pchar; mode:Pchar):gzFile;inline;
+begin
+  gzopen:=gzio.gzopen(path,mode);
+end;
+
+function gzsetparams(Thefile:gzFile; level:longint; strategy:longint):longint;inline;
+begin
+  gzsetparams:=gzio.gzsetparams(thefile,level,strategy);
+end;
+
+function gzread(thefile:gzFile; buf : pointer; len:cardinal):longint;inline;
+begin
+  gzread:=gzio.gzread(thefile,buf,len);
+end;
+
+function gzwrite(thefile:gzFile; buf: pointer; len:cardinal):longint;inline;
+begin
+  gzwrite:=gzio.gzwrite(thefile,buf,len);
+end;
+
+function gzputs(thefile:gzFile; s:Pchar):longint;inline;
+begin
+  gzputs:=gzio.gzputs(thefile,s);
+end;
+
+function gzgets(thefile:gzFile; buf:Pchar; len:longint):Pchar;inline;
+begin
+  gzgets:=gzio.gzgets(thefile,buf,len);
+end;
+
+function gzputc(thefile:gzFile; c:char):longint;inline;
+begin
+  gzputc:=gzio.gzputc(thefile,c);
+end;
+
+function gzgetc(thefile:gzFile):char;inline;
+begin
+  gzgetc:=chr(gzio.gzgetc(thefile));
+end;
+
+function gzflush(thefile:gzFile; flush:longint):longint;inline;
+begin
+  gzflush:=gzio.gzflush(thefile,flush);
+end;
+
+function gzseek(thefile:gzFile; offset:z_off_t; whence:longint):z_off_t;inline;
+begin
+  gzseek:=gzio.gzseek(thefile,offset,whence);
+end;
+
+function gzrewind(thefile:gzFile):longint;inline;
+begin
+  gzrewind:=gzio.gzrewind(thefile);
+end;
+
+function gztell(thefile:gzFile):z_off_t;inline;
+begin
+  gztell:=gzio.gztell(thefile);
+end;
+
+function gzeof(thefile:gzFile):longbool;inline;
+begin
+  gzeof:=gzio.gzeof(thefile);
+end;
+
+function gzclose(thefile:gzFile):longint;inline;
+begin
+  gzclose:=gzio.gzclose(thefile);
+end;
+
+function gzerror(thefile:gzFile; var errnum:smallint):string;inline;
+begin
+  gzerror:=gzio.gzerror(thefile,errnum);
+end;
+
+function adler32(theadler:cardinal;buf : Pchar; len:cardinal):cardinal;inline;
+begin
+  adler32:=adler.adler32(theadler,Pbyte(buf),len);
+end;
+
+function crc32(thecrc:cardinal;buf : Pchar; len:cardinal):cardinal;inline;
+begin
+  crc32:=crc.crc32(thecrc,Pbyte(buf),len);
+end;
+
+function deflateInit_(var strm:TZStream; level:longint; version:Pchar; stream_size:longint):longint;inline;
+begin
+  deflateInit_:=zdeflate.deflateInit_(@strm,level,version,stream_size);
+end;
+
+function inflateInit_(var strm:TZStream; version:Pchar; stream_size:longint):longint;inline;
+begin
+  inflateInit_:=zinflate.inflateInit_(@strm,version,stream_size);
+end;
+
+function deflateInit2_(var strm:TZStream; level:longint; method:longint; windowBits:longint; memLevel:longint;strategy:longint; version:Pchar; stream_size:longint):longint;inline;
+begin
+  deflateInit2_:=zdeflate.deflateInit2_(strm,level,method,windowBits,memlevel,strategy,version,stream_size);
+end;
+
+function inflateInit2_(var strm:TZStream; windowBits:longint; version:Pchar; stream_size:longint):longint;inline;
+begin
+  inflateInit2_:=zinflate.inflateInit2_(strm,windowBits,version,stream_size);
+end;
+
+function deflateInit(var strm:TZStream;level : longint) : longint;inline;
+begin
+  deflateInit:=zdeflate.deflateInit(strm,level);
+end;
+
+function inflateInit(var strm:TZStream) : longint;inline;
+begin
+  inflateInit:=zinflate.inflateInit(strm);
+end;
+
+function deflateInit2(var strm:TZStream;level,method,windowBits,memLevel,strategy : longint) : longint;inline;
+begin
+  deflateInit2:=zdeflate.deflateInit2(strm,level,method,windowbits,memlevel,strategy);
+end;
+
+function inflateInit2(var strm:TZStream; windowBits : longint) : longint;inline;
+begin
+  inflateInit2:=zinflate.inflateInit2_(strm,windowBits,ZLIB_VERSION,sizeof(TZStream));
+end;
+
+function zError(err:longint):string;inline;
+begin
+  zerror:=zbase.zerror(err);
+end;
+
+function inflateSyncPoint(z:PZstream):longint;inline;
+begin
+  inflateSyncPoint:=zinflate.inflateSyncPoint(z^);
+end;
+
+function get_crc_table:pointer;inline;
+begin
+  get_crc_table:=crc.get_crc_table;
+end;
+
+end.

+ 2210 - 0
src/libraries/paszlib/paszlib_trees.pas

@@ -0,0 +1,2210 @@
+unit paszlib_Trees;
+
+{$IFDEF FPC}
+  {$MODE FPC}
+{$ENDIF}
+
+{$T-}
+{$define ORG_DEBUG}
+{
+  trees.c -- output deflated data using Huffman coding
+  Copyright (C) 1995-1998 Jean-loup Gailly
+
+  Pascal tranlastion
+  Copyright (C) 1998 by Jacques Nomssi Nzali
+  For conditions of distribution and use, see copyright notice in readme.txt
+}
+
+{
+ *  ALGORITHM
+ *
+ *      The "deflation" process uses several Huffman trees. The more
+ *      common source values are represented by shorter bit sequences.
+ *
+ *      Each code tree is stored in a compressed form which is itself
+ * a Huffman encoding of the lengths of all the code strings (in
+ * ascending order by source values).  The actual code strings are
+ * reconstructed from the lengths in the inflate process, as described
+ * in the deflate specification.
+ *
+ *  REFERENCES
+ *
+ *      Deutsch, L.P.,"'Deflate' Compressed Data Format Specification".
+ *      Available in ftp.uu.net:/pub/archiving/zip/doc/deflate-1.1.doc
+ *
+ *      Storer, James A.
+ *          Data Compression:  Methods and Theory, pp. 49-50.
+ *          Computer Science Press, 1988.  ISBN 0-7167-8156-5.
+ *
+ *      Sedgewick, R.
+ *          Algorithms, p290.
+ *          Addison-Wesley, 1983. ISBN 0-201-06672-6.
+ }
+
+interface
+
+{$I paszlib_zconf.inc}
+
+uses
+  {$ifdef ZLIB_DEBUG}
+  sysutils,
+  {$endif}
+  paszlib_zbase
+  ;
+
+{ ===========================================================================
+  Internal compression state. }
+
+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 }
+
+const
+  INIT_STATE =  42;
+  BUSY_STATE =  113;
+  FINISH_STATE = 666;
+{ Stream status }
+
+
+{ Data structure describing a single value and its code string. }
+type
+  ct_data_ptr = ^ct_data;
+  ct_data = record
+    fc : record
+      case byte of
+      0:(freq : 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;
+
+{ Freq = fc.freq
+ Code = fc.code
+ Dad = dl.dad
+ Len = dl.len }
+
+type
+  ltree_type = array[0..HEAP_SIZE-1] of ct_data;    { literal and length tree }
+  dtree_type = array[0..2*D_CODES+1-1] of ct_data;  { distance tree }
+  htree_type = array[0..2*BL_CODES+1-1] of ct_data;  { Huffman tree for bit lengths }
+  { generic tree type }
+  tree_type = array[0..(maxzbaseint div SizeOf(ct_data))-1] of ct_data;
+
+  tree_ptr = ^ct_data;
+  ltree_ptr = ^ltree_type;
+  dtree_ptr = ^dtree_type;
+  htree_ptr = ^htree_type;
+
+
+type
+  static_tree_desc_ptr = ^static_tree_desc;
+  static_tree_desc =
+         record
+    {const} static_tree : tree_ptr;     { static tree or NIL }
+    {const} extra_bits : pinteger;   { extra bits for each code or NIL }
+            extra_base : integer;           { base index for extra_bits }
+            elems : integer;                { max number of elements in the tree }
+            max_length : integer;           { max bit length for the codes }
+          end;
+
+  tree_desc_ptr = ^tree_desc;
+  tree_desc = record
+    dyn_tree : tree_ptr;    { the dynamic tree }
+    max_code : integer;            { largest code with non zero frequency }
+    stat_desc : static_tree_desc_ptr; { the corresponding static tree }
+  end;
+
+type
+  Pos = word;
+  Posf = Pos; {FAR}
+  IPos = cardinal;
+
+  pPosf = ^Posf;
+
+  zPosfArray = array[0..(maxzbaseint div SizeOf(Posf))-1] of Posf;
+  pzPosfArray = ^zPosfArray;
+
+{ A Pos is an index in the character window. We use short instead of integer to
+  save space in the various tables. IPos is used only for parameter passing.}
+
+type
+  deflate_state_ptr = ^deflate_state;
+  deflate_state = record
+    strm : z_streamp;          { pointer back to this zlib stream }
+    status : integer;              { as the name implies }
+    pending_buf : Pbytearray; { output still pending }
+    pending_buf_size : longint;    { size of pending_buf }
+    pending_out : Pbyte;      { next pending byte to output to the stream }
+    pending : longint;             { nb of bytes in the pending buffer }
+    noheader : integer;            { suppress zlib header and adler32 }
+    data_type : Byte;          { UNKNOWN, BINARY or ASCII }
+    method : Byte;             { STORED (for zip only) or DEFLATED }
+    last_flush : integer;          { value of flush param for previous deflate call }
+
+                { used by deflate.pas: }
+
+    w_size : cardinal;             { LZ77 window size (32K by default) }
+    w_bits : cardinal;             { log2(w_size)  (8..16) }
+    w_mask : cardinal;             { w_size - 1 }
+
+    window : Pbytearray;
+    { 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_size : longint;
+    { Actual size of window: 2*wSize, except when the user input buffer
+      is directly used as sliding window. }
+
+    prev : pzPosfArray;
+    { 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. }
+
+    head : pzPosfArray;    { Heads of the hash chains or NIL. }
+
+    ins_h : cardinal;          { hash index of string to be inserted }
+    hash_size : cardinal;      { number of elements in hash table }
+    hash_bits : cardinal;      { log2(hash_size) }
+    hash_mask : cardinal;      { hash_size-1 }
+
+    hash_shift : cardinal;
+    { Number of bits by which ins_h 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:
+        hash_shift * MIN_MATCH >= hash_bits     }
+
+    block_start : longint;
+    { Window position at the beginning of the current output block. Gets
+      negative when the window is moved backwards. }
+
+    match_length : cardinal;           { length of best match }
+    prev_match : IPos;             { previous match }
+    match_available : boolean;     { set if previous match exists }
+    strstart : cardinal;               { start of string to insert }
+    match_start : cardinal;            { start of matching string }
+    lookahead : cardinal;              { number of valid bytes ahead in window }
+
+    prev_length : cardinal;
+    { Length of the best match at previous step. Matches not greater than this
+      are discarded. This is used in the lazy match evaluation. }
+
+    max_chain_length : cardinal;
+    { To speed up deflation, hash chains are never searched beyond this
+      length.  A higher limit improves compression ratio but degrades the
+      speed. }
+
+    { moved to the end because Borland Pascal won't accept the following:
+    max_lazy_match : cardinal;
+    max_insert_length : cardinal absolute max_lazy_match;
+    }
+
+    level : integer;    { compression level (1..9) }
+    strategy : integer; { favor or force Huffman coding}
+
+    good_match : cardinal;
+    { Use a faster search when the previous match is longer than this }
+
+    nice_match : integer; { Stop searching when current match exceeds this }
+
+                { used by trees.pas: }
+    { Didn't use ct_data typedef below to supress compiler warning }
+    dyn_ltree : ltree_type;    { literal and length tree }
+    dyn_dtree : dtree_type;  { distance tree }
+    bl_tree : htree_type;   { Huffman tree for bit lengths }
+
+    l_desc : tree_desc;                { desc. for literal tree }
+    d_desc : tree_desc;                { desc. for distance tree }
+    bl_desc : tree_desc;               { desc. for bit length tree }
+
+    bl_count : array[0..MAX_BITS+1-1] of word;
+    { number of codes at each bit length for an optimal tree }
+
+    heap : array[0..2*L_CODES+1-1] of integer; { heap used to build the Huffman trees }
+    heap_len : integer;                   { number of elements in the heap }
+    heap_max : 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+1-1] of byte;
+    { Depth of each subtree used as tie breaker for trees of equal frequency }
+
+
+    l_buf : Pbytearray;       { buffer for literals or lengths }
+
+    lit_bufsize : cardinal;
+    { Size of match buffer for literals/lengths.  There are 4 reasons for
+      limiting lit_bufsize 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 lit_bufsize 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 }
+
+
+    last_lit : cardinal;      { running index in l_buf }
+
+    d_buf : Pwordarray;
+    { Buffer for distances. To simplify the code, d_buf and l_buf have
+      the same number of elements. To use different lengths, an extra flag
+      array would be necessary. }
+
+    opt_len : longint;        { bit length of current block with optimal trees }
+    static_len : longint;     { bit length of current block with static trees }
+    compressed_len : longint; { total bit length of compressed file }
+    matches : cardinal;       { number of string matches in current block }
+    last_eob_len : integer;   { bit length of EOB code for last block }
+
+{$ifdef ZLIB_DEBUG}
+    bits_sent : longint;    { bit length of the compressed data }
+{$endif}
+
+    bi_buf : word;
+    { Output buffer. bits are inserted starting at the bottom (least
+      significant bits). }
+
+    bi_valid : integer;
+    { Number of valid bits in bi_buf.  All bits above the last valid bit
+      are always zero. }
+
+    case byte of
+    0:(max_lazy_match : cardinal);
+    { Attempt to find a better match only when the current match is strictly
+      smaller than this value. This mechanism is used only for compression
+      levels >= 4. }
+
+    1:(max_insert_length : cardinal);
+    { Insert new strings in the hash table only if the match length is not
+      greater than this length. This saves time but degrades compression.
+      max_insert_length is used only for compression levels <= 3. }
+  end;
+
+procedure _tr_init (var s : deflate_state);
+
+function _tr_tally (var s : deflate_state;
+                    dist : cardinal;
+                    lc : cardinal) : boolean;
+
+function _tr_flush_block (var s : deflate_state;
+                          buf : Pbyte;
+                          stored_len : longint;
+			  eof : boolean) : longint;
+
+procedure _tr_align(var s : deflate_state);
+
+procedure _tr_stored_block(var s : deflate_state;
+                           buf : Pbyte;
+                           stored_len : longint;
+                           eof : boolean);
+
+implementation
+
+{ #define GEN_TREES_H }
+
+{$ifndef GEN_TREES_H}
+{ header created automatically with -DGEN_TREES_H }
+
+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 _tr_init
+  below). }
+const
+  static_ltree : array[0..L_CODES+2-1] of ct_data = (
+{ fc:(freq, code) dl:(dad,len) }
+(fc:(freq: 12);dl:(len: 8)), (fc:(freq:140);dl:(len: 8)), (fc:(freq: 76);dl:(len: 8)),
+(fc:(freq:204);dl:(len: 8)), (fc:(freq: 44);dl:(len: 8)), (fc:(freq:172);dl:(len: 8)),
+(fc:(freq:108);dl:(len: 8)), (fc:(freq:236);dl:(len: 8)), (fc:(freq: 28);dl:(len: 8)),
+(fc:(freq:156);dl:(len: 8)), (fc:(freq: 92);dl:(len: 8)), (fc:(freq:220);dl:(len: 8)),
+(fc:(freq: 60);dl:(len: 8)), (fc:(freq:188);dl:(len: 8)), (fc:(freq:124);dl:(len: 8)),
+(fc:(freq:252);dl:(len: 8)), (fc:(freq:  2);dl:(len: 8)), (fc:(freq:130);dl:(len: 8)),
+(fc:(freq: 66);dl:(len: 8)), (fc:(freq:194);dl:(len: 8)), (fc:(freq: 34);dl:(len: 8)),
+(fc:(freq:162);dl:(len: 8)), (fc:(freq: 98);dl:(len: 8)), (fc:(freq:226);dl:(len: 8)),
+(fc:(freq: 18);dl:(len: 8)), (fc:(freq:146);dl:(len: 8)), (fc:(freq: 82);dl:(len: 8)),
+(fc:(freq:210);dl:(len: 8)), (fc:(freq: 50);dl:(len: 8)), (fc:(freq:178);dl:(len: 8)),
+(fc:(freq:114);dl:(len: 8)), (fc:(freq:242);dl:(len: 8)), (fc:(freq: 10);dl:(len: 8)),
+(fc:(freq:138);dl:(len: 8)), (fc:(freq: 74);dl:(len: 8)), (fc:(freq:202);dl:(len: 8)),
+(fc:(freq: 42);dl:(len: 8)), (fc:(freq:170);dl:(len: 8)), (fc:(freq:106);dl:(len: 8)),
+(fc:(freq:234);dl:(len: 8)), (fc:(freq: 26);dl:(len: 8)), (fc:(freq:154);dl:(len: 8)),
+(fc:(freq: 90);dl:(len: 8)), (fc:(freq:218);dl:(len: 8)), (fc:(freq: 58);dl:(len: 8)),
+(fc:(freq:186);dl:(len: 8)), (fc:(freq:122);dl:(len: 8)), (fc:(freq:250);dl:(len: 8)),
+(fc:(freq:  6);dl:(len: 8)), (fc:(freq:134);dl:(len: 8)), (fc:(freq: 70);dl:(len: 8)),
+(fc:(freq:198);dl:(len: 8)), (fc:(freq: 38);dl:(len: 8)), (fc:(freq:166);dl:(len: 8)),
+(fc:(freq:102);dl:(len: 8)), (fc:(freq:230);dl:(len: 8)), (fc:(freq: 22);dl:(len: 8)),
+(fc:(freq:150);dl:(len: 8)), (fc:(freq: 86);dl:(len: 8)), (fc:(freq:214);dl:(len: 8)),
+(fc:(freq: 54);dl:(len: 8)), (fc:(freq:182);dl:(len: 8)), (fc:(freq:118);dl:(len: 8)),
+(fc:(freq:246);dl:(len: 8)), (fc:(freq: 14);dl:(len: 8)), (fc:(freq:142);dl:(len: 8)),
+(fc:(freq: 78);dl:(len: 8)), (fc:(freq:206);dl:(len: 8)), (fc:(freq: 46);dl:(len: 8)),
+(fc:(freq:174);dl:(len: 8)), (fc:(freq:110);dl:(len: 8)), (fc:(freq:238);dl:(len: 8)),
+(fc:(freq: 30);dl:(len: 8)), (fc:(freq:158);dl:(len: 8)), (fc:(freq: 94);dl:(len: 8)),
+(fc:(freq:222);dl:(len: 8)), (fc:(freq: 62);dl:(len: 8)), (fc:(freq:190);dl:(len: 8)),
+(fc:(freq:126);dl:(len: 8)), (fc:(freq:254);dl:(len: 8)), (fc:(freq:  1);dl:(len: 8)),
+(fc:(freq:129);dl:(len: 8)), (fc:(freq: 65);dl:(len: 8)), (fc:(freq:193);dl:(len: 8)),
+(fc:(freq: 33);dl:(len: 8)), (fc:(freq:161);dl:(len: 8)), (fc:(freq: 97);dl:(len: 8)),
+(fc:(freq:225);dl:(len: 8)), (fc:(freq: 17);dl:(len: 8)), (fc:(freq:145);dl:(len: 8)),
+(fc:(freq: 81);dl:(len: 8)), (fc:(freq:209);dl:(len: 8)), (fc:(freq: 49);dl:(len: 8)),
+(fc:(freq:177);dl:(len: 8)), (fc:(freq:113);dl:(len: 8)), (fc:(freq:241);dl:(len: 8)),
+(fc:(freq:  9);dl:(len: 8)), (fc:(freq:137);dl:(len: 8)), (fc:(freq: 73);dl:(len: 8)),
+(fc:(freq:201);dl:(len: 8)), (fc:(freq: 41);dl:(len: 8)), (fc:(freq:169);dl:(len: 8)),
+(fc:(freq:105);dl:(len: 8)), (fc:(freq:233);dl:(len: 8)), (fc:(freq: 25);dl:(len: 8)),
+(fc:(freq:153);dl:(len: 8)), (fc:(freq: 89);dl:(len: 8)), (fc:(freq:217);dl:(len: 8)),
+(fc:(freq: 57);dl:(len: 8)), (fc:(freq:185);dl:(len: 8)), (fc:(freq:121);dl:(len: 8)),
+(fc:(freq:249);dl:(len: 8)), (fc:(freq:  5);dl:(len: 8)), (fc:(freq:133);dl:(len: 8)),
+(fc:(freq: 69);dl:(len: 8)), (fc:(freq:197);dl:(len: 8)), (fc:(freq: 37);dl:(len: 8)),
+(fc:(freq:165);dl:(len: 8)), (fc:(freq:101);dl:(len: 8)), (fc:(freq:229);dl:(len: 8)),
+(fc:(freq: 21);dl:(len: 8)), (fc:(freq:149);dl:(len: 8)), (fc:(freq: 85);dl:(len: 8)),
+(fc:(freq:213);dl:(len: 8)), (fc:(freq: 53);dl:(len: 8)), (fc:(freq:181);dl:(len: 8)),
+(fc:(freq:117);dl:(len: 8)), (fc:(freq:245);dl:(len: 8)), (fc:(freq: 13);dl:(len: 8)),
+(fc:(freq:141);dl:(len: 8)), (fc:(freq: 77);dl:(len: 8)), (fc:(freq:205);dl:(len: 8)),
+(fc:(freq: 45);dl:(len: 8)), (fc:(freq:173);dl:(len: 8)), (fc:(freq:109);dl:(len: 8)),
+(fc:(freq:237);dl:(len: 8)), (fc:(freq: 29);dl:(len: 8)), (fc:(freq:157);dl:(len: 8)),
+(fc:(freq: 93);dl:(len: 8)), (fc:(freq:221);dl:(len: 8)), (fc:(freq: 61);dl:(len: 8)),
+(fc:(freq:189);dl:(len: 8)), (fc:(freq:125);dl:(len: 8)), (fc:(freq:253);dl:(len: 8)),
+(fc:(freq: 19);dl:(len: 9)), (fc:(freq:275);dl:(len: 9)), (fc:(freq:147);dl:(len: 9)),
+(fc:(freq:403);dl:(len: 9)), (fc:(freq: 83);dl:(len: 9)), (fc:(freq:339);dl:(len: 9)),
+(fc:(freq:211);dl:(len: 9)), (fc:(freq:467);dl:(len: 9)), (fc:(freq: 51);dl:(len: 9)),
+(fc:(freq:307);dl:(len: 9)), (fc:(freq:179);dl:(len: 9)), (fc:(freq:435);dl:(len: 9)),
+(fc:(freq:115);dl:(len: 9)), (fc:(freq:371);dl:(len: 9)), (fc:(freq:243);dl:(len: 9)),
+(fc:(freq:499);dl:(len: 9)), (fc:(freq: 11);dl:(len: 9)), (fc:(freq:267);dl:(len: 9)),
+(fc:(freq:139);dl:(len: 9)), (fc:(freq:395);dl:(len: 9)), (fc:(freq: 75);dl:(len: 9)),
+(fc:(freq:331);dl:(len: 9)), (fc:(freq:203);dl:(len: 9)), (fc:(freq:459);dl:(len: 9)),
+(fc:(freq: 43);dl:(len: 9)), (fc:(freq:299);dl:(len: 9)), (fc:(freq:171);dl:(len: 9)),
+(fc:(freq:427);dl:(len: 9)), (fc:(freq:107);dl:(len: 9)), (fc:(freq:363);dl:(len: 9)),
+(fc:(freq:235);dl:(len: 9)), (fc:(freq:491);dl:(len: 9)), (fc:(freq: 27);dl:(len: 9)),
+(fc:(freq:283);dl:(len: 9)), (fc:(freq:155);dl:(len: 9)), (fc:(freq:411);dl:(len: 9)),
+(fc:(freq: 91);dl:(len: 9)), (fc:(freq:347);dl:(len: 9)), (fc:(freq:219);dl:(len: 9)),
+(fc:(freq:475);dl:(len: 9)), (fc:(freq: 59);dl:(len: 9)), (fc:(freq:315);dl:(len: 9)),
+(fc:(freq:187);dl:(len: 9)), (fc:(freq:443);dl:(len: 9)), (fc:(freq:123);dl:(len: 9)),
+(fc:(freq:379);dl:(len: 9)), (fc:(freq:251);dl:(len: 9)), (fc:(freq:507);dl:(len: 9)),
+(fc:(freq:  7);dl:(len: 9)), (fc:(freq:263);dl:(len: 9)), (fc:(freq:135);dl:(len: 9)),
+(fc:(freq:391);dl:(len: 9)), (fc:(freq: 71);dl:(len: 9)), (fc:(freq:327);dl:(len: 9)),
+(fc:(freq:199);dl:(len: 9)), (fc:(freq:455);dl:(len: 9)), (fc:(freq: 39);dl:(len: 9)),
+(fc:(freq:295);dl:(len: 9)), (fc:(freq:167);dl:(len: 9)), (fc:(freq:423);dl:(len: 9)),
+(fc:(freq:103);dl:(len: 9)), (fc:(freq:359);dl:(len: 9)), (fc:(freq:231);dl:(len: 9)),
+(fc:(freq:487);dl:(len: 9)), (fc:(freq: 23);dl:(len: 9)), (fc:(freq:279);dl:(len: 9)),
+(fc:(freq:151);dl:(len: 9)), (fc:(freq:407);dl:(len: 9)), (fc:(freq: 87);dl:(len: 9)),
+(fc:(freq:343);dl:(len: 9)), (fc:(freq:215);dl:(len: 9)), (fc:(freq:471);dl:(len: 9)),
+(fc:(freq: 55);dl:(len: 9)), (fc:(freq:311);dl:(len: 9)), (fc:(freq:183);dl:(len: 9)),
+(fc:(freq:439);dl:(len: 9)), (fc:(freq:119);dl:(len: 9)), (fc:(freq:375);dl:(len: 9)),
+(fc:(freq:247);dl:(len: 9)), (fc:(freq:503);dl:(len: 9)), (fc:(freq: 15);dl:(len: 9)),
+(fc:(freq:271);dl:(len: 9)), (fc:(freq:143);dl:(len: 9)), (fc:(freq:399);dl:(len: 9)),
+(fc:(freq: 79);dl:(len: 9)), (fc:(freq:335);dl:(len: 9)), (fc:(freq:207);dl:(len: 9)),
+(fc:(freq:463);dl:(len: 9)), (fc:(freq: 47);dl:(len: 9)), (fc:(freq:303);dl:(len: 9)),
+(fc:(freq:175);dl:(len: 9)), (fc:(freq:431);dl:(len: 9)), (fc:(freq:111);dl:(len: 9)),
+(fc:(freq:367);dl:(len: 9)), (fc:(freq:239);dl:(len: 9)), (fc:(freq:495);dl:(len: 9)),
+(fc:(freq: 31);dl:(len: 9)), (fc:(freq:287);dl:(len: 9)), (fc:(freq:159);dl:(len: 9)),
+(fc:(freq:415);dl:(len: 9)), (fc:(freq: 95);dl:(len: 9)), (fc:(freq:351);dl:(len: 9)),
+(fc:(freq:223);dl:(len: 9)), (fc:(freq:479);dl:(len: 9)), (fc:(freq: 63);dl:(len: 9)),
+(fc:(freq:319);dl:(len: 9)), (fc:(freq:191);dl:(len: 9)), (fc:(freq:447);dl:(len: 9)),
+(fc:(freq:127);dl:(len: 9)), (fc:(freq:383);dl:(len: 9)), (fc:(freq:255);dl:(len: 9)),
+(fc:(freq:511);dl:(len: 9)), (fc:(freq:  0);dl:(len: 7)), (fc:(freq: 64);dl:(len: 7)),
+(fc:(freq: 32);dl:(len: 7)), (fc:(freq: 96);dl:(len: 7)), (fc:(freq: 16);dl:(len: 7)),
+(fc:(freq: 80);dl:(len: 7)), (fc:(freq: 48);dl:(len: 7)), (fc:(freq:112);dl:(len: 7)),
+(fc:(freq:  8);dl:(len: 7)), (fc:(freq: 72);dl:(len: 7)), (fc:(freq: 40);dl:(len: 7)),
+(fc:(freq:104);dl:(len: 7)), (fc:(freq: 24);dl:(len: 7)), (fc:(freq: 88);dl:(len: 7)),
+(fc:(freq: 56);dl:(len: 7)), (fc:(freq:120);dl:(len: 7)), (fc:(freq:  4);dl:(len: 7)),
+(fc:(freq: 68);dl:(len: 7)), (fc:(freq: 36);dl:(len: 7)), (fc:(freq:100);dl:(len: 7)),
+(fc:(freq: 20);dl:(len: 7)), (fc:(freq: 84);dl:(len: 7)), (fc:(freq: 52);dl:(len: 7)),
+(fc:(freq:116);dl:(len: 7)), (fc:(freq:  3);dl:(len: 8)), (fc:(freq:131);dl:(len: 8)),
+(fc:(freq: 67);dl:(len: 8)), (fc:(freq:195);dl:(len: 8)), (fc:(freq: 35);dl:(len: 8)),
+(fc:(freq:163);dl:(len: 8)), (fc:(freq: 99);dl:(len: 8)), (fc:(freq:227);dl:(len: 8))
+);
+
+
+{ The static distance tree. (Actually a trivial tree since all lens use
+  5 bits.) }
+  static_dtree : array[0..D_CODES-1] of ct_data = (
+(fc:(freq: 0); dl:(len:5)), (fc:(freq:16); dl:(len:5)), (fc:(freq: 8); dl:(len:5)),
+(fc:(freq:24); dl:(len:5)), (fc:(freq: 4); dl:(len:5)), (fc:(freq:20); dl:(len:5)),
+(fc:(freq:12); dl:(len:5)), (fc:(freq:28); dl:(len:5)), (fc:(freq: 2); dl:(len:5)),
+(fc:(freq:18); dl:(len:5)), (fc:(freq:10); dl:(len:5)), (fc:(freq:26); dl:(len:5)),
+(fc:(freq: 6); dl:(len:5)), (fc:(freq:22); dl:(len:5)), (fc:(freq:14); dl:(len:5)),
+(fc:(freq:30); dl:(len:5)), (fc:(freq: 1); dl:(len:5)), (fc:(freq:17); dl:(len:5)),
+(fc:(freq: 9); dl:(len:5)), (fc:(freq:25); dl:(len:5)), (fc:(freq: 5); dl:(len:5)),
+(fc:(freq:21); dl:(len:5)), (fc:(freq:13); dl:(len:5)), (fc:(freq:29); dl:(len:5)),
+(fc:(freq: 3); dl:(len:5)), (fc:(freq:19); dl:(len:5)), (fc:(freq:11); dl:(len:5)),
+(fc:(freq:27); dl:(len:5)), (fc:(freq: 7); dl:(len:5)), (fc:(freq: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. }
+  _dist_code : 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) }
+  _length_code : array[0..MAX_MATCH-MIN_MATCH+1-1] 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) }
+  base_length : array[0..LENGTH_CODES-1] of integer = (
+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) }
+  base_dist : 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
+);
+{$endif}
+
+{ Output a byte on the stream.
+  IN assertion: there is enough room in pending_buf.
+macro put_byte(s, c)
+begin
+  s^.pending_buf^[s^.pending] := (c);
+  inc(s^.pending);
+end
+}
+
+const
+  MIN_LOOKAHEAD = (MAX_MATCH+MIN_MATCH+1);
+{ Minimum amount of lookahead, except at the end of the input file.
+  See deflate.c for comments about the MIN_MATCH+1. }
+
+{macro d_code(dist)
+   if (dist) < 256 then
+     := _dist_code[dist]
+   else
+     := _dist_code[256+((dist) shr 7)]);
+  Mapping from a distance to a distance code. dist is the distance - 1 and
+  must not have side effects. _dist_code[256] and _dist_code[257] are never
+  used. }
+
+{$ifndef ORG_DEBUG}
+{ Inline versions of _tr_tally for speed: }
+
+#if defined(GEN_TREES_H) || !defined(STDC)
+  extern byte _length_code[];
+  extern byte _dist_code[];
+#else
+  extern const byte _length_code[];
+  extern const byte _dist_code[];
+#endif
+
+macro _tr_tally_lit(s, c, flush)
+var
+  cc : byte;
+begin
+    cc := (c);
+    s^.d_buf[s^.last_lit] := 0;
+    s^.l_buf[s^.last_lit] := cc;
+    inc(s^.last_lit);
+    inc(s^.dyn_ltree[cc].fc.Freq);
+    flush := (s^.last_lit = s^.lit_bufsize-1);
+end;
+
+macro _tr_tally_dist(s, distance, length, flush) \
+var
+  len : byte;
+  dist : word;
+begin
+    len := (length);
+    dist := (distance);
+    s^.d_buf[s^.last_lit] := dist;
+    s^.l_buf[s^.last_lit] = len;
+    inc(s^.last_lit);
+    dec(dist);
+    inc(s^.dyn_ltree[_length_code[len]+LITERALS+1].fc.Freq);
+    inc(s^.dyn_dtree[d_code(dist)].Freq);
+    flush := (s^.last_lit = s^.lit_bufsize-1);
+end;
+
+{$endif}
+
+{ ===========================================================================
+  Constants }
+
+const
+  MAX_BL_BITS = 7;
+{ Bit length codes must not exceed MAX_BL_BITS bits }
+
+const
+  END_BLOCK = 256;
+{ end of block literal code }
+
+const
+  REP_3_6 = 16;
+{ repeat previous bit length 3-6 times (2 bits of repeat count) }
+
+const
+  REPZ_3_10 = 17;
+{ repeat a zero length 3-10 times  (3 bits of repeat count) }
+
+const
+  REPZ_11_138 = 18;
+{ repeat a zero length 11-138 times  (7 bits of repeat count) }
+
+{local}
+const
+  extra_lbits : array[0..LENGTH_CODES-1] of integer
+    { extra bits for each length code }
+   = (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);
+
+{local}
+const
+  extra_dbits : array[0..D_CODES-1] of integer
+    { extra bits for each distance code }
+   = (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);
+
+{local}
+const
+  extra_blbits : array[0..BL_CODES-1] of integer { extra bits for each bit length code }
+   = (0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,2,3,7);
+
+{local}
+const
+  bl_order : 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);
+{ The lengths of the bit length codes are sent in order of decreasing
+  probability, to avoid transmitting the lengths for unused bit length codes.
+ }
+
+const
+  Buf_size = (8 * 2*sizeof(char));
+{ Number of bits used within bi_buf. (bi_buf might be implemented on
+  more than 16 bits on some systems.) }
+
+{ ===========================================================================
+  Local data. These are initialized only once. }
+
+
+{$ifdef GEN_TREES_H)}
+{ non ANSI compilers may not accept trees.h }
+
+const
+  DIST_CODE_LEN = 512; { see definition of array dist_code below }
+
+{local}
+var
+  static_ltree : array[0..L_CODES+2-1] of ct_data;
+{ 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 _tr_init
+  below). }
+
+{local}
+  static_dtree : array[0..D_CODES-1] of ct_data;
+{ The static distance tree. (Actually a trivial tree since all codes use
+  5 bits.) }
+
+  _dist_code : array[0..DIST_CODE_LEN-1] of byte;
+{ 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. }
+
+  _length_code : array[0..MAX_MATCH-MIN_MATCH+1-1] of byte;
+{ length code for each normalized match length (0 == MIN_MATCH) }
+
+{local}
+  base_length : array[0..LENGTH_CODES-1] of integer;
+{ First normalized length for each code (0 = MIN_MATCH) }
+
+{local}
+  base_dist : array[0..D_CODES-1] of integer;
+{ First normalized distance for each code (0 = distance of 1) }
+
+{$endif} { GEN_TREES_H }
+
+{local}
+const
+  static_l_desc :  static_tree_desc  =
+      (static_tree: {tree_ptr}@static_ltree[0];  { pointer to array of ct_data }
+       extra_bits: {pzIntfArray}@extra_lbits[0]; { pointer to array of integer }
+       extra_base: LITERALS+1;
+       elems: L_CODES;
+       max_length: MAX_BITS);
+
+{local}
+const
+  static_d_desc : static_tree_desc  =
+      (static_tree: {tree_ptr}@static_dtree[0];
+       extra_bits: {pzIntfArray}@extra_dbits[0];
+       extra_base : 0;
+       elems: D_CODES;
+       max_length: MAX_BITS);
+
+{local}
+const
+  static_bl_desc : static_tree_desc =
+      (static_tree: {tree_ptr}(NIL);
+       extra_bits: {pzIntfArray}@extra_blbits[0];
+       extra_base : 0;
+       elems: BL_CODES;
+       max_length: MAX_BL_BITS);
+
+{$ifdef GEN_TREES_H}
+{local}
+procedure gen_trees_header;
+{$endif}
+
+(*
+{ ===========================================================================
+  Output a short LSB first on the stream.
+  IN assertion: there is enough room in pendingBuf. }
+
+macro put_short(s, w)
+begin
+    {put_byte(s, (byte)((w) & 0xff));}
+    s.pending_buf^[s.pending] := byte((w) and $ff);
+    inc(s.pending);
+
+    {put_byte(s, (byte)((word)(w) >> 8));}
+    s.pending_buf^[s.pending] := byte(word(w) shr 8);;
+    inc(s.pending);
+end
+*)
+
+{ ===========================================================================
+  Send a value on a given number of bits.
+  IN assertion: length <= 16 and value fits in length bits. }
+
+{$ifdef ORG_DEBUG}
+
+{local}
+procedure send_bits(var s : deflate_state;
+                    value : integer;   { value to send }
+                    length : integer); { number of bits }
+begin
+  {$ifdef ZLIB_DEBUG}
+  Tracevv(' l '+IntToStr(length)+ ' v '+IntToStr(value));
+  Assert((length > 0) and (length <= 15), 'invalid length');
+  inc(s.bits_sent, longint(length));
+  {$ENDIF}
+
+  { If not enough room in bi_buf, use (valid) bits from bi_buf and
+    (16 - bi_valid) bits from value, leaving (width - (16-bi_valid))
+    unused bits in value. }
+  {$PUSH}
+  {$Q-}
+  {$R-}
+  if (s.bi_valid > integer(Buf_size) - length) then
+  begin
+    s.bi_buf := s.bi_buf or integer(value shl s.bi_valid);
+    {put_short(s, s.bi_buf);}
+    s.pending_buf^[s.pending] := byte(s.bi_buf and $ff);
+    inc(s.pending);
+    s.pending_buf^[s.pending] := byte(word(s.bi_buf) shr 8);;
+    inc(s.pending);
+
+    s.bi_buf := word(value) shr (Buf_size - s.bi_valid);
+    inc(s.bi_valid, length - Buf_size);
+  end
+  else
+  begin
+    s.bi_buf := s.bi_buf or integer(value shl s.bi_valid);
+    inc(s.bi_valid, length);
+  end;
+  {$POP}
+end;
+
+{$else} { !ZLIB_DEBUG }
+
+
+macro send_code(s, c, tree)
+begin
+  send_bits(s, tree[c].Code, tree[c].Len);
+  { Send a code of the given tree. c and tree must not have side effects }
+end
+
+macro send_bits(s, value, length) \
+begin integer len := length;\
+  if (s^.bi_valid > (integer)Buf_size - len) begin\
+    integer val := value;\
+    s^.bi_buf |= (val << s^.bi_valid);\
+    {put_short(s, s.bi_buf);}
+    s.pending_buf^[s.pending] := byte(s.bi_buf and $ff);
+    inc(s.pending);
+    s.pending_buf^[s.pending] := byte(word(s.bi_buf) shr 8);;
+    inc(s.pending);
+
+    s^.bi_buf := (word)val >> (Buf_size - s^.bi_valid);\
+    s^.bi_valid += len - Buf_size;\
+  end else begin\
+    s^.bi_buf |= (value) << s^.bi_valid;\
+    s^.bi_valid += len;\
+  end\
+end;
+{$endif} { ZLIB_DEBUG }
+
+{ ===========================================================================
+  Reverse the first len bits of a code, using straightforward code (a faster
+  method would use a table)
+  IN assertion: 1 <= len <= 15 }
+
+{local}
+function bi_reverse(code : cardinal;         { the value to invert }
+                    len : integer) : cardinal;   { its bit length }
+
+var
+  res : cardinal; {register}
+begin
+  res := 0;
+  repeat
+    res := res or (code and 1);
+    code := code shr 1;
+    res := res shl 1;
+    dec(len);
+  until (len <= 0);
+  bi_reverse := res shr 1;
+end;
+
+{ ===========================================================================
+  Generate the codes for a given tree and bit counts (which need not be
+  optimal).
+  IN assertion: the array bl_count contains the bit length statistics for
+  the given tree and the field len is set for all tree elements.
+  OUT assertion: the field code is set for all tree elements of non
+      zero code length. }
+
+{local}
+procedure gen_codes(tree : tree_ptr;  { the tree to decorate }
+                    max_code : integer;   { largest code with non zero frequency }
+                    var bl_count : array of word);  { number of codes at each bit length }
+
+var
+  next_code : array[0..MAX_BITS+1-1] of word; { next code value for each bit length }
+  code : word;              { running code value }
+  bits : integer;                  { bit index }
+  n : integer;                     { code index }
+var
+  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 + bl_count[bits-1]) shl 1);
+    next_code[bits] := code;
+  end;
+  { Check that the bit counts in bl_count are consistent. The last code
+    must be all ones. }
+
+  {$IFDEF ZLIB_DEBUG}
+  Assert (code + bl_count[MAX_BITS]-1 = (1 shl MAX_BITS)-1,
+          'inconsistent bit counts');
+  Tracev(#13'gen_codes: max_code '+IntToStr(max_code));
+  {$ENDIF}
+
+  for n := 0 to max_code do
+  begin
+    len := tree[n].dl.Len;
+    if (len = 0) then
+      continue;
+    { Now reverse the bits }
+    tree[n].fc.Code := bi_reverse(next_code[len], len);
+    inc(next_code[len]);
+    {$ifdef ZLIB_DEBUG}
+    if (n>31) and (n<128) then
+      Tracecv(tree <> tree_ptr(@static_ltree),
+       (^M'n #'+IntToStr(n)+' '+char(n)+' l '+IntToStr(len)+' c '+
+         IntToStr(tree[n].fc.Code)+' ('+IntToStr(next_code[len]-1)+')'))
+    else
+      Tracecv(tree <> tree_ptr(@static_ltree),
+      (^M'n #'+IntToStr(n)+'   l '+IntToStr(len)+' c '+
+         IntToStr(tree[n].fc.Code)+' ('+IntToStr(next_code[len]-1)+')'));
+    {$ENDIF}
+  end;
+end;
+
+{ ===========================================================================
+  Genererate the file trees.h describing the static trees. }
+{$ifdef GEN_TREES_H}
+
+macro SEPARATOR(i, last, width)
+  if (i) = (last) then
+    ( ^M');'^M^M
+  else    \
+    if (i) mod (width) = (width)-1 then
+       ','^M
+     else
+       ', '
+
+procedure gen_trees_header;
+var
+  header : system.text;
+  i : integer;
+begin
+  system.assign(header, 'trees.inc');
+  {$push}{$I-}
+  ReWrite(header);
+  {$pop}
+  Assert (IOresult <> 0, 'Can''t open trees.h');
+  WriteLn(header,
+    '{ header created automatically with -DGEN_TREES_H }'^M);
+
+  WriteLn(header, 'local const ct_data static_ltree[L_CODES+2] := (');
+  for i := 0 to L_CODES+2-1 do
+  begin
+    WriteLn(header, '((%3u),(%3u))%s', static_ltree[i].Code,
+		static_ltree[i].Len, SEPARATOR(i, L_CODES+1, 5));
+  end;
+
+  WriteLn(header, 'local const ct_data static_dtree[D_CODES] := (');
+  for i := 0 to D_CODES-1 do
+  begin
+    WriteLn(header, '((%2u),(%2u))%s', static_dtree[i].Code,
+		static_dtree[i].Len, SEPARATOR(i, D_CODES-1, 5));
+  end;
+
+  WriteLn(header, 'const byte _dist_code[DIST_CODE_LEN] := (');
+  for i := 0 to DIST_CODE_LEN-1 do
+  begin
+    WriteLn(header, '%2u%s', _dist_code[i],
+		SEPARATOR(i, DIST_CODE_LEN-1, 20));
+  end;
+
+  WriteLn(header, 'const byte _length_code[MAX_MATCH-MIN_MATCH+1]= (');
+  for i := 0 to MAX_MATCH-MIN_MATCH+1-1 do
+  begin
+    WriteLn(header, '%2u%s', _length_code[i],
+		SEPARATOR(i, MAX_MATCH-MIN_MATCH, 20));
+  end;
+
+  WriteLn(header, 'local const integer base_length[LENGTH_CODES] := (');
+  for i := 0 to LENGTH_CODES-1 do
+  begin
+    WriteLn(header, '%1u%s', base_length[i],
+		SEPARATOR(i, LENGTH_CODES-1, 20));
+  end;
+
+  WriteLn(header, 'local const integer base_dist[D_CODES] := (');
+  for i := 0 to D_CODES-1 do
+  begin
+    WriteLn(header, '%5u%s', base_dist[i],
+		SEPARATOR(i, D_CODES-1, 10));
+  end;
+
+  close(header);
+end;
+{$endif} { GEN_TREES_H }
+
+
+{ ===========================================================================
+  Initialize the various 'constant' tables. }
+
+{local}
+procedure tr_static_init;
+
+{$ifdef GEN_TREES_H}
+const
+  static_init_done : boolean = FALSE;
+var
+  n : integer;        { iterates over tree elements }
+  bits : integer;     { bit counter }
+  length : integer;   { length value }
+  code : integer;     { code value }
+  dist : integer;     { distance index }
+  bl_count : array[0..MAX_BITS+1-1] of word;
+    { number of codes at each bit length for an optimal tree }
+begin
+    if (static_init_done) then
+      exit;
+
+    { Initialize the mapping length (0..255) -> length code (0..28) }
+    length := 0;
+    for code := 0 to LENGTH_CODES-1-1 do
+    begin
+      base_length[code] := length;
+      for n := 0 to (1 shl extra_lbits[code])-1 do
+      begin
+        _length_code[length] := byte(code);
+        inc(length);
+      end;
+    end;
+    Assert (length = 256, 'tr_static_init: length <> 256');
+    { Note that the length 255 (match length 258) can be represented
+      in two different ways: code 284 + 5 bits or code 285, so we
+      overwrite length_code[255] to use the best encoding: }
+
+    _length_code[length-1] := byte(code);
+
+    { Initialize the mapping dist (0..32K) -> dist code (0..29) }
+    dist := 0;
+    for code := 0 to 16-1 do
+    begin
+      base_dist[code] := dist;
+      for n := 0 to (1 shl extra_dbits[code])-1 do
+      begin
+        _dist_code[dist] := byte(code);
+        inc(dist);
+      end;
+    end;
+    Assert (dist = 256, 'tr_static_init: dist <> 256');
+    dist := dist shr 7; { from now on, all distances are divided by 128 }
+    for code := 16 to D_CODES-1 do
+    begin
+      base_dist[code] := dist shl 7;
+      for n := 0 to (1 shl (extra_dbits[code]-7))-1 do
+      begin
+        _dist_code[256 + dist] := byte(code);
+        inc(dist);
+      end;
+    end;
+    Assert (dist = 256, 'tr_static_init: 256+dist <> 512');
+
+    { Construct the codes of the static literal tree }
+    for bits := 0 to MAX_BITS do
+      bl_count[bits] := 0;
+    n := 0;
+    while (n <= 143) do
+    begin
+      static_ltree[n].dl.Len := 8;
+      inc(n);
+      inc(bl_count[8]);
+    end;
+    while (n <= 255) do
+    begin
+      static_ltree[n].dl.Len := 9;
+      inc(n);
+      inc(bl_count[9]);
+    end;
+    while (n <= 279) do
+    begin
+      static_ltree[n].dl.Len := 7;
+      inc(n);
+      inc(bl_count[7]);
+    end;
+    while (n <= 287) do
+    begin
+      static_ltree[n].dl.Len := 8;
+      inc(n);
+      inc(bl_count[8]);
+    end;
+
+    { Codes 286 and 287 do not exist, but we must include them in the
+      tree construction to get a canonical Huffman tree (longest code
+      all ones)  }
+
+    gen_codes(tree_ptr(@static_ltree), L_CODES+1, bl_count);
+
+    { The static distance tree is trivial: }
+    for n := 0 to D_CODES-1 do
+    begin
+      static_dtree[n].dl.Len := 5;
+      static_dtree[n].fc.Code := bi_reverse(cardinal(n), 5);
+    end;
+    static_init_done := TRUE;
+
+    gen_trees_header;  { save to include file }
+{$else}
+begin
+{$endif} { GEN_TREES_H) }
+end;
+
+{ ===========================================================================
+  Initialize a new block. }
+{local}
+
+procedure init_block(var s : deflate_state);
+var
+  n : integer; { iterates over tree elements }
+begin
+  { Initialize the trees. }
+  for n := 0 to L_CODES-1 do
+    s.dyn_ltree[n].fc.Freq := 0;
+  for n := 0 to D_CODES-1 do
+    s.dyn_dtree[n].fc.Freq := 0;
+  for n := 0 to BL_CODES-1 do
+    s.bl_tree[n].fc.Freq := 0;
+
+  s.dyn_ltree[END_BLOCK].fc.Freq := 1;
+  s.static_len := 0;
+  s.opt_len := 0;
+  s.matches := 0;
+  s.last_lit := 0;
+end;
+
+const
+  SMALLEST = 1;
+{ Index within the heap array of least frequent node in the Huffman tree }
+
+{ ===========================================================================
+  Initialize the tree data structures for a new zlib stream. }
+procedure _tr_init(var s : deflate_state);
+begin
+  tr_static_init;
+
+  s.compressed_len := 0;
+
+  s.l_desc.dyn_tree := tree_ptr(@s.dyn_ltree);
+  s.l_desc.stat_desc := @static_l_desc;
+
+  s.d_desc.dyn_tree := tree_ptr(@s.dyn_dtree);
+  s.d_desc.stat_desc := @static_d_desc;
+
+  s.bl_desc.dyn_tree := tree_ptr(@s.bl_tree);
+  s.bl_desc.stat_desc := @static_bl_desc;
+
+  s.bi_buf := 0;
+  s.bi_valid := 0;
+  s.last_eob_len := 8; { enough lookahead for inflate }
+{$ifdef ZLIB_DEBUG}
+  s.bits_sent := 0;
+{$endif}
+
+  { Initialize the first block of the first file: }
+  init_block(s);
+end;
+
+{ ===========================================================================
+  Remove the smallest element from the heap and recreate the heap with
+  one less element. Updates heap and heap_len.
+
+macro pqremove(s, tree, top)
+begin
+    top := s.heap[SMALLEST];
+    s.heap[SMALLEST] := s.heap[s.heap_len];
+    dec(s.heap_len);
+    pqdownheap(s, tree, SMALLEST);
+end
+}
+
+{ ===========================================================================
+  Compares to subtrees, using the tree depth as tie breaker when
+  the subtrees have equal frequency. This minimizes the worst case length.
+
+macro smaller(tree, n, m, depth)
+   ( (tree[n].Freq < tree[m].Freq) or
+     ((tree[n].Freq = tree[m].Freq) and (depth[n] <= depth[m])) )
+}
+
+{ ===========================================================================
+  Restore the heap property by moving down the 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). }
+{local}
+
+procedure pqdownheap(var s : deflate_state;
+                     tree : tree_ptr;   { the tree to restore }
+                     k : integer);          { node to move down }
+var
+  v : integer;
+  j : integer;
+begin
+  v := s.heap[k];
+  j := k shl 1;  { left son of k }
+  while (j <= s.heap_len) do
+  begin
+    { Set j to the smallest of the two sons: }
+    if (j < s.heap_len) and
+       {smaller(tree, s.heap[j+1], s.heap[j], s.depth)}
+      ( (tree[s.heap[j+1]].fc.Freq < tree[s.heap[j]].fc.Freq) or
+        ((tree[s.heap[j+1]].fc.Freq = tree[s.heap[j]].fc.Freq) and
+         (s.depth[s.heap[j+1]] <= s.depth[s.heap[j]])) ) then
+    begin
+      inc(j);
+    end;
+    { Exit if v is smaller than both sons }
+    if {(smaller(tree, v, s.heap[j], s.depth))}
+     ( (tree[v].fc.Freq < tree[s.heap[j]].fc.Freq) or
+       ((tree[v].fc.Freq = tree[s.heap[j]].fc.Freq) 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 continue down the tree, setting j to the left son of k }
+    j := j shl 1;
+  end;
+  s.heap[k] := v;
+end;
+
+{ ===========================================================================
+  Compute the optimal bit lengths for a tree and update the total bit length
+  for the current block.
+  IN assertion: the fields freq and dad are set, heap[heap_max] and
+     above are the tree nodes sorted by increasing frequency.
+  OUT assertions: the field len is set to the optimal bit length, the
+      array bl_count contains the frequencies for each bit length.
+      The length opt_len is updated; static_len is also updated if stree is
+      not null. }
+
+{local}
+procedure gen_bitlen(var s : deflate_state;
+                     var desc : tree_desc);   { the tree descriptor }
+var
+  tree : tree_ptr;
+  max_code : integer;
+  stree : tree_ptr; {const}
+  extra : pinteger; {const}
+  base : integer;
+  max_length : integer;
+  h : integer;              { heap index }
+  n, m : integer;           { iterate over the tree elements }
+  bits : integer;           { bit length }
+  xbits : integer;          { extra bits }
+  f : word;              { frequency }
+  overflow : integer;   { number of elements with bit length too large }
+begin
+  tree := desc.dyn_tree;
+  max_code := desc.max_code;
+  stree := desc.stat_desc^.static_tree;
+  extra := desc.stat_desc^.extra_bits;
+  base := desc.stat_desc^.extra_base;
+  max_length := desc.stat_desc^.max_length;
+  overflow := 0;
+
+  for bits := 0 to MAX_BITS do
+    s.bl_count[bits] := 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.heap_max]].dl.Len := 0; { root of the heap }
+
+  for h := s.heap_max+1 to HEAP_SIZE-1 do
+  begin
+    n := s.heap[h];
+    bits := tree[tree[n].dl.Dad].dl.Len + 1;
+    if (bits > max_length) then
+    begin
+      bits := max_length;
+      inc(overflow);
+    end;
+    tree[n].dl.Len := word(bits);
+    { We overwrite tree[n].dl.Dad which is no longer needed }
+
+    if (n > max_code) then
+      continue; { not a leaf node }
+
+    inc(s.bl_count[bits]);
+    xbits := 0;
+    if (n >= base) then
+      xbits := extra[n-base];
+    f := tree[n].fc.Freq;
+    inc(s.opt_len, longint(f) * (bits + xbits));
+    if (stree <> NIL) then
+      inc(s.static_len, longint(f) * (stree[n].dl.Len + xbits));
+  end;
+  if (overflow = 0) then
+    exit;
+  {$ifdef ZLIB_DEBUG}
+  Tracev(^M'bit length overflow');
+  {$endif}
+  { This happens for example on obj2 and pic of the Calgary corpus }
+
+  { Find the first bit length which could increase: }
+  repeat
+    bits := max_length-1;
+    while (s.bl_count[bits] = 0) do
+      dec(bits);
+    dec(s.bl_count[bits]);      { move one leaf down the tree }
+    inc(s.bl_count[bits+1], 2); { move one overflow item as its brother }
+    dec(s.bl_count[max_length]);
+    { The brother of the overflow item also moves one step up,
+      but this does not affect bl_count[max_length] }
+
+    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;  { Delphi3: compiler warning w/o this }
+  for bits := max_length downto 1 do
+  begin
+    n := s.bl_count[bits];
+    while (n <> 0) do
+    begin
+      dec(h);
+      m := s.heap[h];
+      if (m > max_code) then
+        continue;
+      if (tree[m].dl.Len <> cardinal(bits)) then
+      begin
+        {$ifdef ZLIB_DEBUG}
+        Trace('code '+IntToStr(m)+' bits '+IntToStr(tree[m].dl.Len)
+              +'.'+IntToStr(bits));
+        {$ENDIF}
+        inc(s.opt_len, (cardinal(bits) - cardinal(tree[m].dl.Len))
+                        * cardinal(tree[m].fc.Freq) );
+        tree[m].dl.Len := word(bits);
+      end;
+      dec(n);
+    end;
+  end;
+end;
+
+{ ===========================================================================
+  Construct one Huffman tree and assigns the code bit strings and lengths.
+  Update the total bit length for the current block.
+  IN assertion: the field freq is set for all tree elements.
+  OUT assertions: the fields len and code are set to the optimal bit length
+      and corresponding code. The length opt_len is updated; static_len is
+      also updated if stree is not null. The field max_code is set. }
+
+{local}
+procedure build_tree(var s : deflate_state;
+                     var desc : tree_desc); { the tree descriptor }
+
+var
+  tree : tree_ptr;
+  stree : tree_ptr; {const}
+  elems : integer;
+  n, m : integer;          { iterate over heap elements }
+  max_code : integer;      { largest code with non zero frequency }
+  node : integer;          { new node being created }
+begin
+  tree := desc.dyn_tree;
+  stree := desc.stat_desc^.static_tree;
+  elems := desc.stat_desc^.elems;
+  max_code := -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.heap_len := 0;
+  s.heap_max := HEAP_SIZE;
+
+  for n := 0 to elems-1 do
+  begin
+    if (tree[n].fc.Freq <> 0) then
+    begin
+      max_code := n;
+      inc(s.heap_len);
+      s.heap[s.heap_len] := n;
+      s.depth[n] := 0;
+    end
+    else
+    begin
+      tree[n].dl.Len := 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.heap_len < 2) do
+  begin
+    inc(s.heap_len);
+    if (max_code < 2) then
+    begin
+      inc(max_code);
+      s.heap[s.heap_len] := max_code;
+      node := max_code;
+    end
+    else
+    begin
+      s.heap[s.heap_len] := 0;
+      node := 0;
+    end;
+    tree[node].fc.Freq := 1;
+    s.depth[node] := 0;
+    dec(s.opt_len);
+    if (stree <> NIL) then
+      dec(s.static_len, stree[node].dl.Len);
+    { node is 0 or 1 so it does not have extra bits }
+  end;
+  desc.max_code := max_code;
+
+  { The elements heap[heap_len/2+1 .. heap_len] are leaves of the tree,
+    establish sub-heaps of increasing lengths: }
+
+  for n := s.heap_len div 2 downto 1 do
+    pqdownheap(s, tree, n);
+
+  { Construct the Huffman tree by repeatedly combining the least two
+    frequent nodes. }
+
+  node := elems;              { next internal node of the tree }
+  repeat
+    {pqremove(s, tree, n);}  { n := node of least frequency }
+    n := s.heap[SMALLEST];
+    s.heap[SMALLEST] := s.heap[s.heap_len];
+    dec(s.heap_len);
+    pqdownheap(s, tree, SMALLEST);
+
+    m := s.heap[SMALLEST]; { m := node of next least frequency }
+
+    dec(s.heap_max);
+    s.heap[s.heap_max] := n; { keep the nodes sorted by frequency }
+    dec(s.heap_max);
+    s.heap[s.heap_max] := m;
+
+    { Create a new node father of n and m }
+    tree[node].fc.Freq := tree[n].fc.Freq + tree[m].fc.Freq;
+    { 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);
+{$ifdef DUMP_BL_TREE}
+    if (tree = tree_ptr(@s.bl_tree)) then
+    begin
+      WriteLn(#13'node ',node,'(',tree[node].fc.Freq,') sons ',n,
+              '(',tree[n].fc.Freq,') ', m, '(',tree[m].fc.Freq,')');
+    end;
+{$endif}
+    { and insert the new node in the heap }
+    s.heap[SMALLEST] := node;
+    inc(node);
+    pqdownheap(s, tree, SMALLEST);
+
+  until (s.heap_len < 2);
+
+  dec(s.heap_max);
+  s.heap[s.heap_max] := s.heap[SMALLEST];
+
+  { At this point, the fields freq and dad are set. We can now
+    generate the bit lengths. }
+
+  gen_bitlen(s, desc);
+
+  { The field len is now set, we can generate the bit codes }
+  gen_codes (tree, max_code, s.bl_count);
+end;
+
+{ ===========================================================================
+  Scan a literal or distance tree to determine the frequencies of the codes
+  in the bit length tree. }
+
+{local}
+procedure scan_tree(var s : deflate_state;
+                    var tree : array of ct_data;    { the tree to be scanned }
+                    max_code : integer);    { and its largest code of non zero frequency }
+var
+  n : integer;                 { iterates over all tree elements }
+  prevlen : integer;           { last emitted length }
+  curlen : integer;            { length of current code }
+  nextlen : integer;           { length of next code }
+  count : integer;             { repeat count of the current code }
+  max_count : integer;         { max repeat count }
+  min_count : integer;         { min repeat count }
+begin
+  prevlen := -1;
+  nextlen := tree[0].dl.Len;
+  count := 0;
+  max_count := 7;
+  min_count := 4;
+
+  if (nextlen = 0) then
+  begin
+    max_count := 138;
+    min_count := 3;
+  end;
+  tree[max_code+1].dl.Len := word($ffff); { guard }
+
+  for n := 0 to max_code do
+  begin
+    curlen := nextlen;
+{$push}{$R-}
+    nextlen := tree[n+1].dl.Len;
+{$pop}
+    inc(count);
+    if (count < max_count) and (curlen = nextlen) then
+      continue
+    else
+      if (count < min_count) then
+        inc(s.bl_tree[curlen].fc.Freq, count)
+      else
+        if (curlen <> 0) then
+        begin
+          if (curlen <> prevlen) then
+            inc(s.bl_tree[curlen].fc.Freq);
+          inc(s.bl_tree[REP_3_6].fc.Freq);
+        end
+        else
+          if (count <= 10) then
+            inc(s.bl_tree[REPZ_3_10].fc.Freq)
+          else
+            inc(s.bl_tree[REPZ_11_138].fc.Freq);
+
+    count := 0;
+    prevlen := curlen;
+    if (nextlen = 0) then
+    begin
+      max_count := 138;
+      min_count := 3;
+    end
+    else
+      if (curlen = nextlen) then
+      begin
+        max_count := 6;
+        min_count := 3;
+      end
+      else
+      begin
+        max_count := 7;
+        min_count := 4;
+      end;
+  end;
+end;
+
+{ ===========================================================================
+  Send a literal or distance tree in compressed form, using the codes in
+  bl_tree. }
+
+{local}
+procedure send_tree(var s : deflate_state;
+                    var tree : array of ct_data;    { the tree to be scanned }
+                    max_code : integer);    { and its largest code of non zero frequency }
+
+var
+  n : integer;                { iterates over all tree elements }
+  prevlen : integer;          { last emitted length }
+  curlen : integer;           { length of current code }
+  nextlen : integer;          { length of next code }
+  count : integer;            { repeat count of the current code }
+  max_count : integer;        { max repeat count }
+  min_count : integer;        { min repeat count }
+begin
+  prevlen := -1;
+  nextlen := tree[0].dl.Len;
+  count := 0;
+  max_count := 7;
+  min_count := 4;
+
+  { tree[max_code+1].dl.Len := -1; }  { guard already set }
+  if (nextlen = 0) then
+  begin
+    max_count := 138;
+    min_count := 3;
+  end;
+
+  for n := 0 to max_code do
+  begin
+    curlen := nextlen;
+    nextlen := tree[n+1].dl.Len;
+    inc(count);
+    if (count < max_count) and (curlen = nextlen) then
+      continue
+    else
+      if (count < min_count) then
+      begin
+        repeat
+          {$ifdef ZLIB_DEBUG}
+          Tracevvv(#13'cd '+IntToStr(curlen));
+          {$ENDIF}
+          send_bits(s, s.bl_tree[curlen].fc.Code, s.bl_tree[curlen].dl.Len);
+          dec(count);
+        until (count = 0);
+      end
+      else
+        if (curlen <> 0) then
+        begin
+          if (curlen <> prevlen) then
+          begin
+            {$ifdef ZLIB_DEBUG}
+            Tracevvv(#13'cd '+IntToStr(curlen));
+            {$ENDIF}
+            send_bits(s, s.bl_tree[curlen].fc.Code, s.bl_tree[curlen].dl.Len);
+            dec(count);
+          end;
+          {$IFDEF ZLIB_DEBUG}
+          Assert((count >= 3) and (count <= 6), ' 3_6?');
+          {$ENDIF}
+          {$ifdef ZLIB_DEBUG}
+          Tracevvv(#13'cd '+IntToStr(REP_3_6));
+          {$ENDIF}
+          send_bits(s, s.bl_tree[REP_3_6].fc.Code, s.bl_tree[REP_3_6].dl.Len);
+          send_bits(s, count-3, 2);
+        end
+        else
+          if (count <= 10) then
+          begin
+            {$ifdef ZLIB_DEBUG}
+            Tracevvv(#13'cd '+IntToStr(REPZ_3_10));
+            {$ENDIF}
+            send_bits(s, s.bl_tree[REPZ_3_10].fc.Code, s.bl_tree[REPZ_3_10].dl.Len);
+            send_bits(s, count-3, 3);
+          end
+          else
+          begin
+            {$ifdef ZLIB_DEBUG}
+            Tracevvv(#13'cd '+IntToStr(REPZ_11_138));
+            {$ENDIF}
+            send_bits(s, s.bl_tree[REPZ_11_138].fc.Code, s.bl_tree[REPZ_11_138].dl.Len);
+            send_bits(s, count-11, 7);
+          end;
+    count := 0;
+    prevlen := curlen;
+    if (nextlen = 0) then
+    begin
+      max_count := 138;
+      min_count := 3;
+    end
+    else
+      if (curlen = nextlen) then
+      begin
+        max_count := 6;
+        min_count := 3;
+      end
+      else
+      begin
+        max_count := 7;
+        min_count := 4;
+      end;
+  end;
+end;
+
+{ ===========================================================================
+  Construct the Huffman tree for the bit lengths and return the index in
+  bl_order of the last bit length code to send. }
+
+{local}
+function build_bl_tree(var s : deflate_state) : integer;
+var
+  max_blindex : integer;  { index of last bit length code of non zero freq }
+begin
+  { Determine the bit length frequencies for literal and distance trees }
+  scan_tree(s, s.dyn_ltree, s.l_desc.max_code);
+  scan_tree(s, s.dyn_dtree, s.d_desc.max_code);
+
+  { Build the bit length tree: }
+  build_tree(s, s.bl_desc);
+  { opt_len now includes the length of the tree representations, except
+    the lengths of the bit lengths codes and the 5+5+4 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 max_blindex := BL_CODES-1 downto 3 do
+  begin
+    if (s.bl_tree[bl_order[max_blindex]].dl.Len <> 0) then
+      break;
+  end;
+  { Update opt_len to include the bit length tree and counts }
+  inc(s.opt_len, 3*(max_blindex+1) + 5+5+4);
+  {$ifdef ZLIB_DEBUG}
+  Tracev(^M'dyn trees: dyn %ld, stat %ld {s.opt_len, s.static_len}');
+  {$ENDIF}
+
+  build_bl_tree := max_blindex;
+end;
+
+{ ===========================================================================
+  Send 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.
+  IN assertion: lcodes >= 257, dcodes >= 1, blcodes >= 4. }
+
+{local}
+procedure send_all_trees(var s : deflate_state;
+                         lcodes : integer;
+                         dcodes : integer;
+                         blcodes : integer); { number of codes for each tree }
+var
+  rank : integer;                    { index in bl_order }
+begin
+  {$IFDEF ZLIB_DEBUG}
+  Assert ((lcodes >= 257) and (dcodes >= 1) and (blcodes >= 4),
+          'not enough codes');
+  Assert ((lcodes <= L_CODES) and (dcodes <= D_CODES)
+          and (blcodes <= BL_CODES), 'too many codes');
+  Tracev(^M'bl counts: ');
+  {$ENDIF}
+  send_bits(s, lcodes-257, 5); { not +255 as stated in appnote.txt }
+  send_bits(s, dcodes-1,   5);
+  send_bits(s, blcodes-4,  4); { not -3 as stated in appnote.txt }
+  for rank := 0 to blcodes-1 do
+  begin
+    {$ifdef ZLIB_DEBUG}
+    Tracev(^M'bl code '+IntToStr(bl_order[rank]));
+    {$ENDIF}
+    send_bits(s, s.bl_tree[bl_order[rank]].dl.Len, 3);
+  end;
+  {$ifdef ZLIB_DEBUG}
+  Tracev(^M'bl tree: sent '+IntToStr(s.bits_sent));
+  {$ENDIF}
+
+  send_tree(s, s.dyn_ltree, lcodes-1); { literal tree }
+  {$ifdef ZLIB_DEBUG}
+  Tracev(^M'lit tree: sent '+IntToStr(s.bits_sent));
+  {$ENDIF}
+
+  send_tree(s, s.dyn_dtree, dcodes-1); { distance tree }
+  {$ifdef ZLIB_DEBUG}
+  Tracev(^M'dist tree: sent '+IntToStr(s.bits_sent));
+  {$ENDIF}
+end;
+
+{ ===========================================================================
+  Flush the bit buffer and align the output on a byte boundary }
+
+{local}
+procedure bi_windup(var s : deflate_state);
+begin
+  if (s.bi_valid > 8) then
+  begin
+    {put_short(s, s.bi_buf);}
+    s.pending_buf^[s.pending] := byte(s.bi_buf and $ff);
+    inc(s.pending);
+    s.pending_buf^[s.pending] := byte(word(s.bi_buf) shr 8);;
+    inc(s.pending);
+  end
+  else
+    if (s.bi_valid > 0) then
+    begin
+      {put_byte(s, (Byte)s^.bi_buf);}
+      s.pending_buf^[s.pending] := Byte(s.bi_buf);
+      inc(s.pending);
+    end;
+  s.bi_buf := 0;
+  s.bi_valid := 0;
+{$ifdef ZLIB_DEBUG}
+  s.bits_sent := (s.bits_sent+7) and (not 7);
+{$endif}
+end;
+
+{ ===========================================================================
+  Copy a stored block, storing first the length and its
+  one's complement if requested. }
+
+{local}
+procedure copy_block(var s : deflate_state;
+                     buf : Pbyte;       { the input data }
+                     len : word;        { its length }
+                     header : boolean); { true if block header must be written }
+begin
+  bi_windup(s);        { align on byte boundary }
+  s.last_eob_len := 8; { enough lookahead for inflate }
+
+  if (header) then
+  begin
+    {put_short(s, (word)len);}
+    s.pending_buf^[s.pending] := byte(len and $ff);
+    inc(s.pending);
+    s.pending_buf^[s.pending] := byte(len shr 8);;
+    inc(s.pending);
+    {put_short(s, (word)~len);}
+    s.pending_buf^[s.pending] := byte((not len) and $ff);
+    inc(s.pending);
+    s.pending_buf^[s.pending] := byte((not len) shr 8);;
+    inc(s.pending);
+
+{$ifdef ZLIB_DEBUG}
+    inc(s.bits_sent, 2*16);
+{$endif}
+  end;
+{$ifdef ZLIB_DEBUG}
+  inc(s.bits_sent, len shl 3);
+{$endif}
+  move(buf^,s.pending_buf^[s.pending],len);
+  inc(s.pending,len);
+end;
+
+
+{ ===========================================================================
+  Send a stored block }
+
+procedure _tr_stored_block(var s : deflate_state;
+                           buf : Pbyte;     { input block }
+                           stored_len : longint; { length of input block }
+                           eof : boolean);   { true if this is the last block for a file }
+
+begin
+  send_bits(s, (STORED_BLOCK shl 1)+ord(eof), 3);  { send block type }
+  s.compressed_len := (s.compressed_len + 3 + 7) and longint(not cardinal(7));
+  inc(s.compressed_len, (stored_len + 4) shl 3);
+
+  copy_block(s, buf, cardinal(stored_len), TRUE); { with header }
+end;
+
+{ ===========================================================================
+  Flush the bit buffer, keeping at most 7 bits in it. }
+
+{local}
+procedure bi_flush(var s : deflate_state);
+begin
+  if (s.bi_valid = 16) then
+  begin
+    {put_short(s, s.bi_buf);}
+    s.pending_buf^[s.pending] := byte(s.bi_buf and $ff);
+    inc(s.pending);
+    s.pending_buf^[s.pending] := byte(word(s.bi_buf) shr 8);;
+    inc(s.pending);
+
+    s.bi_buf := 0;
+    s.bi_valid := 0;
+  end
+  else
+   if (s.bi_valid >= 8) then
+   begin
+     {put_byte(s, (Byte)s^.bi_buf);}
+     s.pending_buf^[s.pending] := Byte(s.bi_buf);
+     inc(s.pending);
+
+     s.bi_buf := s.bi_buf shr 8;
+     dec(s.bi_valid, 8);
+   end;
+end;
+
+
+{ ===========================================================================
+  Send one empty static block to give enough lookahead for inflate.
+  This takes 10 bits, of which 7 may remain in the bit buffer.
+  The current inflate code requires 9 bits of lookahead. If the
+  last two codes for the previous block (real code plus EOB) were coded
+  on 5 bits or less, inflate may have only 5+3 bits of lookahead to decode
+  the last real code. In this case we send two empty static blocks instead
+  of one. (There are no problems if the previous block is stored or fixed.)
+  To simplify the code, we assume the worst case of last real code encoded
+  on one bit only. }
+
+procedure _tr_align(var s : deflate_state);
+begin
+  send_bits(s, STATIC_TREES shl 1, 3);
+  {$ifdef ZLIB_DEBUG}
+  Tracevvv(#13'cd '+IntToStr(END_BLOCK));
+  {$ENDIF}
+  send_bits(s, static_ltree[END_BLOCK].fc.Code, static_ltree[END_BLOCK].dl.Len);
+  inc(s.compressed_len, cardinal(10)); { 3 for block type, 7 for EOB }
+  bi_flush(s);
+  { Of the 10 bits for the empty block, we have already sent
+    (10 - bi_valid) bits. The lookahead for the last real code (before
+    the EOB of the previous block) was thus at least one plus the length
+    of the EOB plus what we have just sent of the empty static block. }
+  if (1 + s.last_eob_len + 10 - s.bi_valid < 9) then
+  begin
+    send_bits(s, STATIC_TREES shl 1, 3);
+    {$ifdef ZLIB_DEBUG}
+    Tracevvv(#13'cd '+IntToStr(END_BLOCK));
+    {$ENDIF}
+    send_bits(s, static_ltree[END_BLOCK].fc.Code, static_ltree[END_BLOCK].dl.Len);
+    inc(s.compressed_len, cardinal(10));
+    bi_flush(s);
+  end;
+  s.last_eob_len := 7;
+end;
+
+{ ===========================================================================
+  Set the data type to ASCII or BINARY, using a crude approximation:
+  binary if more than 20% of the bytes are <= 6 or >= 128, ascii otherwise.
+  IN assertion: the fields freq of dyn_ltree are set and the total of all
+  frequencies does not exceed 64K (to fit in an integer on 16 bit machines). }
+
+{local}
+procedure set_data_type(var s : deflate_state);
+var
+  n : integer;
+  ascii_freq : cardinal;
+  bin_freq : cardinal;
+begin
+  n := 0;
+  ascii_freq := 0;
+  bin_freq := 0;
+
+  while (n < 7) do
+  begin
+    inc(bin_freq, s.dyn_ltree[n].fc.Freq);
+    inc(n);
+  end;
+  while (n < 128) do
+  begin
+    inc(ascii_freq, s.dyn_ltree[n].fc.Freq);
+    inc(n);
+  end;
+  while (n < LITERALS) do
+  begin
+    inc(bin_freq, s.dyn_ltree[n].fc.Freq);
+    inc(n);
+  end;
+  if (bin_freq > (ascii_freq shr 2)) then
+    s.data_type := Byte(Z_BINARY)
+  else
+    s.data_type := Byte(Z_ASCII);
+end;
+
+{ ===========================================================================
+  Send the block data compressed using the given Huffman trees }
+
+{local}
+procedure compress_block(var s : deflate_state;
+                         var ltree : array of ct_data;   { literal tree }
+                         var dtree : array of ct_data);  { distance tree }
+var
+  dist : cardinal;      { distance of matched string }
+  lc : integer;             { match length or unmatched char (if dist == 0) }
+  lx : cardinal;        { running index in l_buf }
+  code : cardinal;      { the code to send }
+  extra : integer;          { number of extra bits to send }
+begin
+  lx := 0;
+  if (s.last_lit <> 0) then
+  repeat
+    dist := s.d_buf^[lx];
+    lc := s.l_buf^[lx];
+    inc(lx);
+    if (dist = 0) then
+    begin
+      { send a literal byte }
+      {$ifdef ZLIB_DEBUG}
+      Tracevvv(#13'cd '+IntToStr(lc));
+      Tracecv((lc > 31) and (lc < 128), ' '+char(lc)+' ');
+      {$ENDIF}
+      send_bits(s, ltree[lc].fc.Code, ltree[lc].dl.Len);
+    end
+    else
+    begin
+      { Here, lc is the match length - MIN_MATCH }
+      code := _length_code[lc];
+      { send the length code }
+      {$ifdef ZLIB_DEBUG}
+      Tracevvv(#13'cd '+IntToStr(code+LITERALS+1));
+      {$ENDIF}
+      send_bits(s, ltree[code+LITERALS+1].fc.Code, ltree[code+LITERALS+1].dl.Len);
+      extra := extra_lbits[code];
+      if (extra <> 0) then
+      begin
+        dec(lc, base_length[code]);
+        send_bits(s, lc, extra);       { send the extra length bits }
+      end;
+      dec(dist); { dist is now the match distance - 1 }
+      {code := d_code(dist);}
+      if (dist < 256) then
+        code := _dist_code[dist]
+      else
+        code := _dist_code[256+(dist shr 7)];
+
+      {$IFDEF ZLIB_DEBUG}
+      Assert (code < D_CODES, 'bad d_code');
+      {$ENDIF}
+
+      { send the distance code }
+      {$ifdef ZLIB_DEBUG}
+      Tracevvv(#13'cd '+IntToStr(code));
+      {$ENDIF}
+      send_bits(s, dtree[code].fc.Code, dtree[code].dl.Len);
+      extra := extra_dbits[code];
+      if (extra <> 0) then
+      begin
+        dec(dist, base_dist[code]);
+        send_bits(s, dist, extra);   { send the extra distance bits }
+      end;
+    end; { literal or match pair ? }
+
+    { Check that the overlay between pending_buf and d_buf+l_buf is ok: }
+    {$IFDEF ZLIB_DEBUG}
+    Assert(s.pending < s.lit_bufsize + 2*lx, 'pendingBuf overflow');
+    {$ENDIF}
+  until (lx >= s.last_lit);
+
+  {$ifdef ZLIB_DEBUG}
+  Tracevvv(#13'cd '+IntToStr(END_BLOCK));
+  {$ENDIF}
+  send_bits(s, ltree[END_BLOCK].fc.Code, ltree[END_BLOCK].dl.Len);
+  s.last_eob_len := ltree[END_BLOCK].dl.Len;
+end;
+
+
+{ ===========================================================================
+  Determine the best encoding for the current block: dynamic trees, static
+  trees or store, and output the encoded block to the zip file. This function
+  returns the total compressed length for the file so far. }
+
+function _tr_flush_block (var s : deflate_state;
+         buf : Pbyte;         { input block, or NULL if too old }
+         stored_len : longint;     { length of input block }
+         eof : boolean) : longint; { true if this is the last block for a file }
+var
+  opt_lenb, static_lenb : longint; { opt_len and static_len in bytes }
+  max_blindex : integer;  { index of last bit length code of non zero freq }
+begin
+  max_blindex := 0;
+
+  { Build the Huffman trees unless a stored block is forced }
+  if (s.level > 0) then
+  begin
+    { Check if the file is ascii or binary }
+    if (s.data_type = Z_UNKNOWN) then
+      set_data_type(s);
+
+    { Construct the literal and distance trees }
+    build_tree(s, s.l_desc);
+    {$ifdef ZLIB_DEBUG}
+    Tracev(^M'lit data: dyn %ld, stat %ld {s.opt_len, s.static_len}');
+    {$ENDIF}
+
+    build_tree(s, s.d_desc);
+    {$ifdef ZLIB_DEBUG}
+    Tracev(^M'dist data: dyn %ld, stat %ld {s.opt_len, s.static_len}');
+    {$ENDIF}
+    { At this point, opt_len and static_len are the total bit lengths of
+      the compressed block data, excluding the tree representations. }
+
+    { Build the bit length tree for the above two trees, and get the index
+      in bl_order of the last bit length code to send. }
+    max_blindex := build_bl_tree(s);
+
+    { Determine the best encoding. Compute first the block length in bytes}
+    opt_lenb := (s.opt_len+3+7) shr 3;
+    static_lenb := (s.static_len+3+7) shr 3;
+
+    {$ifdef ZLIB_DEBUG}
+    Tracev(^M'opt %lu(%lu) stat %lu(%lu) stored %lu lit %u '+
+	    '{opt_lenb, s.opt_len, static_lenb, s.static_len, stored_len,'+
+	    's.last_lit}');
+    {$ENDIF}
+
+    if (static_lenb <= opt_lenb) then
+      opt_lenb := static_lenb;
+
+  end
+  else
+  begin
+    {$IFDEF ZLIB_DEBUG}
+    Assert(buf <> nil, 'lost buf');
+    {$ENDIF}
+    static_lenb := stored_len + 5;
+    opt_lenb := static_lenb;        { force a stored block }
+  end;
+
+  { 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:  }
+
+{$ifdef STORED_FILE_OK}
+{$ifdef FORCE_STORED_FILE}
+  if eof and (s.compressed_len = 0) then
+  begin { force stored file }
+{$else}
+  if (stored_len <= opt_lenb) and eof and (s.compressed_len=cardinal(0))
+     and seekable()) do
+  begin
+{$endif}
+    { Since LIT_BUFSIZE <= 2*WSIZE, the input data must be there: }
+    if buf=nil then
+      error ('block vanished');
+
+    copy_block(buf, cardinal(stored_len), 0); { without header }
+    s.compressed_len := stored_len shl 3;
+    s.method := STORED;
+  end
+  else
+{$endif} { STORED_FILE_OK }
+
+{$ifdef FORCE_STORED}
+  if buf<>nil then
+  begin { force stored block }
+{$else}
+  if (stored_len+4 <= opt_lenb) and (buf <> nil) then
+  begin
+                     { 4: two words for the lengths }
+{$endif}
+    { The test buf <> NULL is only necessary if LIT_BUFSIZE > WSIZE.
+      Otherwise we can't have processed more than WSIZE input bytes since
+      the last block flush, because compression would have been
+      successful. If LIT_BUFSIZE <= WSIZE, it is never too late to
+      transform a block into a stored block. }
+
+    _tr_stored_block(s, buf, stored_len, eof);
+
+{$ifdef FORCE_STATIC}
+  end
+  else
+    if (static_lenb >= 0) then
+    begin { force static trees }
+{$else}
+  end
+  else
+    if (static_lenb = opt_lenb) then
+    begin
+{$endif}
+      send_bits(s, (STATIC_TREES shl 1)+ord(eof), 3);
+      compress_block(s, static_ltree, static_dtree);
+      inc(s.compressed_len, 3 + s.static_len);
+    end
+    else
+    begin
+      send_bits(s, (DYN_TREES shl 1)+ord(eof), 3);
+      send_all_trees(s, s.l_desc.max_code+1, s.d_desc.max_code+1,
+                     max_blindex+1);
+      compress_block(s, s.dyn_ltree, s.dyn_dtree);
+      inc(s.compressed_len, 3 + s.opt_len);
+    end;
+  {$ifdef ZLIB_DEBUG}
+  Assert (s.compressed_len = s.bits_sent, 'bad compressed size');
+  {$ENDIF}
+  init_block(s);
+
+  if (eof) then
+  begin
+    bi_windup(s);
+    inc(s.compressed_len, 7);  { align on byte boundary }
+  end;
+  {$ifdef ZLIB_DEBUG}
+  Tracev(#13'comprlen %lu(%lu) {s.compressed_len shr 3,'+
+         's.compressed_len-7*ord(eof)}');
+  {$ENDIF}
+
+  _tr_flush_block := s.compressed_len shr 3;
+end;
+
+
+{ ===========================================================================
+  Save the match info and tally the frequency counts. Return true if
+  the current block must be flushed. }
+
+function _tr_tally (var s : deflate_state;
+   dist : cardinal;          { distance of matched string }
+   lc : cardinal) : boolean; { match length-MIN_MATCH or unmatched char (if dist=0) }
+var
+  {$IFDEF ZLIB_DEBUG}
+  MAX_DIST : word;
+  {$ENDIF}
+  code : word;
+{$ifdef TRUNCATE_BLOCK}
+var
+  out_length : longint;
+  in_length : longint;
+  dcode : integer;
+{$endif}
+begin
+  s.d_buf^[s.last_lit] := word(dist);
+  s.l_buf^[s.last_lit] := byte(lc);
+  inc(s.last_lit);
+  if (dist = 0) then
+  begin
+    { lc is the unmatched char }
+    inc(s.dyn_ltree[lc].fc.Freq);
+  end
+  else
+  begin
+    inc(s.matches);
+    { Here, lc is the match length - MIN_MATCH }
+    dec(dist);             { dist := match distance - 1 }
+
+    {macro d_code(dist)}
+    if (dist) < 256 then
+      code := _dist_code[dist]
+    else
+      code := _dist_code[256+(dist shr 7)];
+    {$IFDEF ZLIB_DEBUG}
+{macro  MAX_DIST(s) <=> ((s)^.w_size-MIN_LOOKAHEAD)
+   In order to simplify the code, particularly on 16 bit machines, match
+   distances are limited to MAX_DIST instead of WSIZE. }
+    MAX_DIST := word(s.w_size-MIN_LOOKAHEAD);
+    Assert((dist < word(MAX_DIST)) and
+           (word(lc) <= word(MAX_MATCH-MIN_MATCH)) and
+           (word(code) < word(D_CODES)),  '_tr_tally: bad match');
+    {$ENDIF}
+    inc(s.dyn_ltree[_length_code[lc]+LITERALS+1].fc.Freq);
+    {s.dyn_dtree[d_code(dist)].Freq++;}
+    inc(s.dyn_dtree[code].fc.Freq);
+  end;
+
+{$ifdef TRUNCATE_BLOCK}
+  { Try to guess if it is profitable to stop the current block here }
+  if (s.last_lit and $1fff = 0) and (s.level > 2) then
+  begin
+    { Compute an upper bound for the compressed length }
+    out_length := longint(s.last_lit)*cardinal(8);
+    in_length := longint(cardinal(s.strstart) - s.block_start);
+    for dcode := 0 to D_CODES-1 do
+    begin
+      inc(out_length, longint(s.dyn_dtree[dcode].fc.Freq *
+            (cardinal(5)+extra_dbits[dcode])) );
+    end;
+    out_length := out_length shr 3;
+    {$ifdef ZLIB_DEBUG}
+    Tracev(^M'last_lit %u, in %ld, out ~%ld(%ld%%) ');
+          { s.last_lit, in_length, out_length,
+           cardinal(100) - out_length*100 div in_length)); }
+    {$ENDIF}
+    if (s.matches < s.last_lit div 2) and (out_length < in_length div 2) then
+    begin
+      _tr_tally := TRUE;
+      exit;
+    end;
+  end;
+{$endif}
+  _tr_tally := (s.last_lit = s.lit_bufsize-1);
+  { We avoid equality with lit_bufsize because of wraparound at 64K
+    on 16 bit machines and because stored blocks are restricted to
+    64K-1 bytes. }
+end;
+
+end.

+ 1561 - 0
src/libraries/paszlib/paszlib_unzip.pas

@@ -0,0 +1,1561 @@
+unit paszlib_Unzip;
+
+{$mode tp}
+
+{ ----------------------------------------------------------------- }
+{ unzip.c -- IO on .zip files using zlib
+   Version 0.15 beta, Mar 19th, 1998,
+  unzip.h -- IO for uncompress .zip files using zlib
+  Version 0.15 beta, Mar 19th, 1998,
+
+  Copyright (C) 1998 Gilles Vollant <[email protected]>
+  http://www.winimage.com/zLibDll/zip.htm
+
+   This unzip package allow extract file from .ZIP file, compatible
+   with PKZip 2.04g, WinZip, InfoZip tools and compatible.
+   Encryption and multi volume ZipFile (span) are not supported.
+   Old compressions used by old PKZip 1.x are not supported
+
+  Pascal tranlastion
+  Copyright (C) 2000 by Jacques Nomssi Nzali
+  For conditions of distribution and use, see copyright notice in readme.txt }
+
+
+interface
+
+{$ifdef WIN32}
+  {$define Delphi}
+{$endif}
+
+uses
+  //zutil,
+  paszlib_zbase,
+  //zLib,
+  paszlib_ziputils;
+
+const
+  UNZ_OK    = (0);
+  UNZ_END_OF_LIST_OF_FILE = (-100);
+   UNZ_ERRNO = (Z_ERRNO);
+  UNZ_EOF   = (0);
+  UNZ_PARAMERROR = (-102);
+  UNZ_BADZIPFILE = (-103);
+  UNZ_INTERNALERROR = (-104);
+  UNZ_CRCERROR = (-105);
+(*
+{ tm_unz contain date/time info }
+type
+ tm_unz = record
+   tm_sec : integer;       { seconds after the minute - [0,59] }
+   tm_min : integer;       { minutes after the hour - [0,59] }
+   tm_hour : integer;      { hours since midnight - [0,23] }
+   tm_mday : integer;      { day of the month - [1,31] }
+   tm_mon : integer;       { months since January - [0,11] }
+   tm_year : integer;      { years - [1980..2044] }
+  end;
+*)
+{ unz_global_info structure contain global data about the ZIPfile
+  These data comes from the end of central dir }
+type
+  unz_global_info = record
+    number_entry: longint;   { total number of entries in
+                              the central dir on this disk }
+    size_comment: longint;   { size of the global comment of the zipfile }
+  end;
+
+
+{ unz_file_info contain information about a file in the zipfile }
+type
+  unz_file_info = record
+    version: longint;                  { version made by                 2 bytes }
+    version_needed: longint;           { version needed to extract       2 bytes }
+    flag:    longint;                  { general purpose bit flag        2 bytes }
+    compression_method: longint;       { compression method              2 bytes }
+    dosDate: longint;                  { last mod file date in Dos fmt   4 bytes }
+    crc:     longint;                  { crc-32                          4 bytes }
+    compressed_size: longint;          { compressed size                 4 bytes }
+    uncompressed_size: longint;        { uncompressed size               4 bytes }
+    size_filename: longint;            { filename length                 2 bytes }
+    size_file_extra: longint;          { extra field length              2 bytes }
+    size_file_comment: longint;        { file comment length             2 bytes }
+
+    disk_num_start: longint;          { disk number start               2 bytes }
+    internal_fa:    longint;          { internal file attributes        2 bytes }
+    external_fa:    longint;          { external file attributes        4 bytes }
+
+    tmu_date: tm_unz;
+  end;
+  unz_file_info_ptr = ^unz_file_info;
+
+
+function unzStringFileNameCompare(const fileName1: PChar; const fileName2: PChar; iCaseSensitivity: longint): longint;
+{ Compare two filename (fileName1,fileName2).
+  If iCaseSenisivity = 1 (1=true),
+    comparision is case sensitive (like strcmp)
+  If iCaseSenisivity = 2 (0=false),
+    comparision is not case sensitive (like strcmpi or strcasecmp)
+  If iCaseSenisivity = 0, case sensitivity is defaut of your
+    operating system like 1 on Unix, 2 on Windows)
+}
+
+
+function unzOpen(const path: PChar): unzFile;
+
+{ Open a Zip file. path contain the full pathname (by example,
+  on a Windows NT computer "c:\\zlib\\zlib111.zip" or on an Unix computer
+  "zlib/zlib111.zip".
+  If the zipfile cannot be opened (file don't exist or in not valid), the
+  return value is NIL.
+  Else, the return value is a unzFile Handle, usable with other function
+     of this unzip package.
+}
+
+function unzClose(afile: unzFile): longint;
+
+{ Close a ZipFile opened with unzipOpen.
+  If there are files inside the .Zip opened with unzOpenCurrentFile()
+  (see later), these files MUST be closed with unzipCloseCurrentFile()
+  before a call unzipClose.
+  return UNZ_OK if there is no problem. }
+
+function unzGetGlobalInfo(afile: unzFile; var pglobal_info: unz_global_info): longint;
+
+{ Write info about the ZipFile in the *pglobal_info structure.
+  No preparation of the structure is needed
+  return UNZ_OK if there is no problem. }
+
+function unzGetGlobalComment(afile: unzFile; szComment: PChar; uSizeBuf: longint): longint;
+
+{ Get the global comment string of the ZipFile, in the szComment buffer.
+  uSizeBuf is the size of the szComment buffer.
+  return the number of byte copied or an error code <0 }
+
+ {***************************************************************************}
+ { Unzip package allow you browse the directory of the zipfile }
+
+function unzGoToFirstFile(afile: unzFile): longint;
+
+{ Set the current file of the zipfile to the first file.
+  return UNZ_OK if there is no problem }
+
+function unzGoToNextFile(afile: unzFile): longint;
+
+{ Set the current file of the zipfile to the next file.
+  return UNZ_OK if there is no problem
+  return UNZ_END_OF_LIST_OF_FILE if the actual file was the latest. }
+
+
+function unzLocateFile(afile: unzFile; const szFileName: PChar; iCaseSensitivity: longint): longint; { ZEXPORT }
+
+{ Try locate the file szFileName in the zipfile.
+  For the iCaseSensitivity signification, see unzStringFileNameCompare
+
+  return value :
+  UNZ_OK if the file is found. It becomes the current file.
+  UNZ_END_OF_LIST_OF_FILE if the file is not found }
+
+
+function unzGetCurrentFileInfo(afile: unzFile; pfile_info: unz_file_info_ptr; szFileName: PChar; fileNameBufferSize: longint; extraField: pointer; extraFieldBufferSize: longint; szComment: PChar; commentBufferSize: longint): longint; { ZEXPORT }
+
+{ Get Info about the current file
+  if pfile_info<>NIL, the pfile_info^ structure will contain somes
+  info about the current file
+  if szFileName<>NIL, the filemane string will be copied in szFileName
+      (fileNameBufferSize is the size of the buffer)
+  if extraField<>NIL, the extra field information will be copied in
+    extraField  (extraFieldBufferSize is the size of the buffer).
+    This is the Central-header version of the extra field
+  if szComment<>NIL, the comment string of the file will be copied in
+    szComment (commentBufferSize is the size of the buffer) }
+
+
+{***************************************************************************}
+{* for reading the content of the current zipfile, you can open it, read data
+   from it, and close it (you can close it before reading all the file) }
+
+
+function unzOpenCurrentFile(afile: unzFile): longint; { ZEXPORT }
+
+{ Open for reading data the current file in the zipfile.
+  If there is no error, the return value is UNZ_OK. }
+
+
+function unzCloseCurrentFile(afile: unzFile): longint; { ZEXPORT }
+
+{ Close the file in zip opened with unzOpenCurrentFile
+  Return UNZ_CRCERROR if all the file was read but the CRC is not good }
+
+
+function unzReadCurrentFile(afile: unzFile; buf: pointer; len: cardinal): longint; { ZEXPORT }
+
+{ Read bytes from the current file (opened by unzOpenCurrentFile)
+  buf contain buffer where data must be copied
+  len the size of buf.
+
+  return the number of byte copied if somes bytes are copied
+  return 0 if the end of file was reached
+  return <0 with error code if there is an error
+    (UNZ_ERRNO for IO error, or zLib error for uncompress error) }
+
+function unztell(afile: unzFile): z_off_t;
+
+{ Give the current position in uncompressed data }
+
+function unzeof(afile: unzFile): longint;
+
+{ return 1 if the end of file was reached, 0 elsewhere
+  ! checks for valid params }
+
+function unzGetLocalExtrafield(afile: unzFile; buf: pointer; len: cardinal): longint;
+{ Read extra field from the current file (opened by unzOpenCurrentFile)
+  This is the local-header version of the extra field (sometimes, there is
+    more info in the local-header version than in the central-header)
+
+  if buf=NIL, it return the size of the local extra field
+
+  if buf<>NIL, len is the size of the buffer, the extra header is copied in
+  buf.
+  the return value is the number of bytes copied in buf, or (if <0)
+  the error code }
+
+
+{ ----------------------------------------------------------------- }
+
+implementation
+
+uses
+  {$ifdef Delphi}
+  SysUtils,
+  {$else}
+  strings,
+  {$endif}
+  paszlib_zInflate, crc;
+
+{$ifdef unix and not def (CASESENSITIVITYDEFAULT_YES) and \
+                      !defined(CASESENSITIVITYDEFAULT_NO)}
+{$define CASESENSITIVITYDEFAULT_NO}
+{$endif}
+
+
+const
+  UNZ_BUFSIZE = Z_BUFSIZE;
+  UNZ_MAXFILENAMEINZIP = Z_MAXFILENAMEINZIP;
+
+const
+  unz_copyright: PChar = ' unzip 0.15 Copyright 1998 Gilles Vollant ';
+
+{ unz_file_info_internal contain internal info about a file in zipfile }
+type
+  unz_file_info_internal = record
+    offset_curfile: longint; { relative offset of local header 4 bytes }
+  end;
+  unz_file_info_internal_ptr = ^unz_file_info_internal;
+
+
+{ file_in_zip_read_info_s contain internal information about a file
+  in zipfile, when reading and decompress it }
+type
+  file_in_zip_read_info_s = record
+    read_buffer: PChar;       { internal buffer for compressed data }
+    stream:      z_stream;    { zLib stream structure for inflate }
+
+    pos_in_zipfile:     longint;       { position in byte on the zipfile, for fseek}
+    stream_initialised: boolean;     { flag set if stream structure is initialised}
+
+    offset_local_extrafield: longint;   { offset of the local extra field }
+    size_local_extrafield:   smallint;    { size of the local extra field }
+    pos_local_extrafield:    longint;   { position in the local extra field in read}
+
+    crc32:      longint;                { crc32 of all data uncompressed }
+    crc32_wait: longint;                { crc32 we must obtain after decompress all }
+    rest_read_compressed: longint;      { number of byte to be decompressed }
+    rest_read_uncompressed: longint;    {number of byte to be obtained after decomp}
+    afile:      FILEptr;              { io structure of the zipfile }
+    compression_method: longint;        { compression method (0=store) }
+    byte_before_the_zipfile: longint;   { byte before the zipfile, (>0 for sfx) }
+  end;
+  file_in_zip_read_info_s_ptr = ^file_in_zip_read_info_s;
+
+
+{ unz_s contain internal information about the zipfile }
+type
+  unz_s = record
+    afile: FILEptr;                 { io structore of the zipfile }
+    gi:    unz_global_info;         { public global information }
+    byte_before_the_zipfile: longint; { byte before the zipfile, (>0 for sfx)}
+    num_file: longint;                { number of the current file in the zipfile}
+    pos_in_central_dir: longint;      { pos of the current file in the central dir}
+    current_file_ok: boolean;       { flag about the usability of the current file}
+    central_pos: longint;             { position of the beginning of the central dir}
+
+    size_central_dir:   longint;     { size of the central directory  }
+    offset_central_dir: longint;   { offset of start of central directory with
+                                   respect to the starting disk number }
+
+    cur_file_info:     unz_file_info; { public info about the current file in zip}
+    cur_file_info_internal: unz_file_info_internal; { private info about it}
+    pfile_in_zip_read: file_in_zip_read_info_s_ptr; { structure about the current
+                                      file if we are decompressing it }
+  end;
+  unz_s_ptr = ^unz_s;
+
+
+{ ===========================================================================
+  Read a byte from a gz_stream; update next_in and avail_in. Return EOF
+  for end of file.
+  IN assertion: the stream s has been sucessfully opened for reading. }
+
+
+function unzlocal_getByte(fin: FILEptr; var pi: longint): longint;
+var
+  c:   byte;
+  err: longint;
+begin
+  err := fread(@c, 1, 1, fin);
+
+  if (err = 1) then
+  begin
+    pi := longint(c);
+    unzlocal_getByte := UNZ_OK;
+    {exit;}
+  end
+  else
+  if feof(fin) = 1 then    {if ferror(fin) then}
+    unzlocal_getByte := UNZ_ERRNO
+  else
+    unzlocal_getByte := UNZ_EOF{exit;};
+end;
+
+
+{ ===========================================================================
+   Reads a long in LSB order from the given gz_stream. Sets }
+
+function unzlocal_getShort(fin: FILEptr; var pX: longint): longint;
+var
+  x:   longint;
+  i:   longint;
+  err: longint;
+begin
+  err := unzlocal_getByte(fin, i);
+  x   := longint(i);
+
+  if (err = UNZ_OK) then
+    err := unzlocal_getByte(fin, i);
+  Inc(x, longint(i) shl 8);
+
+  if (err = UNZ_OK) then
+    pX := x
+  else
+    pX := 0;
+  unzlocal_getShort := err;
+end;
+
+function unzlocal_getLong(fin: FILEptr; var pX: longint): longint;
+var
+  x:   longint;
+  i:   longint;
+  err: longint;
+begin
+  err := unzlocal_getByte(fin, i);
+  x   := longint(i);
+
+  if (err = UNZ_OK) then
+    err := unzlocal_getByte(fin, i);
+  Inc(x, longint(i) shl 8);
+
+  if (err = UNZ_OK) then
+    err := unzlocal_getByte(fin, i);
+  Inc(x, longint(i) shl 16);
+
+  if (err = UNZ_OK) then
+    err := unzlocal_getByte(fin, i);
+  Inc(x, longint(i) shl 24);
+
+  if (err = UNZ_OK) then
+    pX := x
+  else
+    pX := 0;
+  unzlocal_getLong := err;
+end;
+
+
+{ My own strcmpi / strcasecmp }
+function strcmpcasenosensitive_internal(fileName1: PChar; fileName2: PChar): longint;
+var
+  c1, c2: char;
+begin
+  repeat
+    c1 := fileName1^;
+    Inc(fileName1);
+    c2 := fileName2^;
+    Inc(fileName2);
+    if (c1 >= 'a') and (c1 <= 'z') then
+      Dec(c1, $20);
+    if (c2 >= 'a') and (c2 <= 'z') then
+      Dec(c2, $20);
+    if (c1 = #0) then
+    begin
+      if c2 = #0 then
+        strcmpcasenosensitive_internal := 0
+      else
+        strcmpcasenosensitive_internal := -1;
+      exit;
+    end;
+    if (c2 = #0) then
+    begin
+      strcmpcasenosensitive_internal := 1;
+      exit;
+    end;
+    if (c1 < c2) then
+    begin
+      strcmpcasenosensitive_internal := -1;
+      exit;
+    end;
+    if (c1 > c2) then
+    begin
+      strcmpcasenosensitive_internal := 1;
+      exit;
+    end;
+  until False;
+end;
+
+
+const
+  CASESENSITIVITYDEFAULTVALUE = 2;
+
+function unzStringFileNameCompare(const fileName1: PChar; const fileName2: PChar; iCaseSensitivity: longint): longint; { ZEXPORT }
+{ Compare two filename (fileName1,fileName2).
+  If iCaseSenisivity = 1 (1=true),
+    comparision is case sensitive (like strcmp)
+  If iCaseSenisivity = 2 (0=false),
+    comparision is not case sensitive (like strcmpi or strcasecmp)
+  If iCaseSenisivity = 0, case sensitivity is defaut of your
+    operating system like 1 on Unix, 2 on Windows)
+}
+begin
+  if (iCaseSensitivity = 0) then
+    iCaseSensitivity := CASESENSITIVITYDEFAULTVALUE;
+
+  if (iCaseSensitivity = 1) then
+  begin
+    unzStringFileNameCompare := strComp(fileName1, fileName2);
+    exit;
+  end;
+
+  unzStringFileNameCompare := strcmpcasenosensitive_internal(fileName1, fileName2);
+end;
+
+const
+  BUFREADCOMMENT = $400;
+
+{ Locate the Central directory of a zipfile (at the end, just before
+  the global comment) }
+
+function unzlocal_SearchCentralDir(fin: FILEptr): longint;
+var
+  buf: Pbytearray;
+  uSizeFile: longint;
+  uBackRead: longint;
+  uMaxBack: longint;
+  uPosFound: longint;
+var
+  uReadSize, uReadPos: longint;
+  i: longint;
+begin
+  uMaxBack  := $ffff; { maximum size of global comment }
+  uPosFound := 0;
+
+  if (fseek(fin, 0, SEEK_END) <> 0) then
+  begin
+    unzlocal_SearchCentralDir := 0;
+    exit;
+  end;
+
+  uSizeFile := ftell(fin);
+
+  if (uMaxBack > uSizeFile) then
+    uMaxBack := uSizeFile;
+
+  buf := Pbytearray(AllocMem(BUFREADCOMMENT + 4));
+  if (buf = nil) then
+  begin
+    unzlocal_SearchCentralDir := 0;
+    exit;
+  end;
+
+  uBackRead := 4;
+  while (uBackRead < uMaxBack) do
+  begin
+
+    if (uBackRead + BUFREADCOMMENT > uMaxBack) then
+      uBackRead := uMaxBack
+    else
+      Inc(uBackRead, BUFREADCOMMENT);
+    uReadPos := uSizeFile - uBackRead;
+
+    if ((BUFREADCOMMENT + 4) < (uSizeFile - uReadPos)) then
+      uReadSize := (BUFREADCOMMENT + 4)
+    else
+      uReadSize := (uSizeFile - uReadPos);
+
+    if fseek(fin, uReadPos, SEEK_SET) <> 0 then
+      break;
+
+    if fread(buf, uReadSize, 1, fin) <> 1 then
+      break;
+
+    i := uReadSize - 3;
+    while (i > 0) do
+    begin
+      Dec(i);
+      if (buf^[i] = $50) and (buf^[i + 1] = $4b) and    { ENDHEADERMAGIC }
+        (buf^[i + 2] = $05) and (buf^[i + 3] = $06) then
+      begin
+        uPosFound := uReadPos + i;
+        break;
+      end;
+    end;
+
+    if (uPosFound <> 0) then
+      break;
+  end;
+  FreeMem(buf);
+  unzlocal_SearchCentralDir := uPosFound;
+end;
+
+
+{ Open a Zip file. path contain the full pathname (by example,
+  on a Windows NT computer "c:\\zlib\\zlib111.zip" or on an Unix computer
+  "zlib/zlib111.zip".
+  If the zipfile cannot be opened (file don't exist or in not valid), the
+  return value is NIL.
+  Else, the return value is a unzFile Handle, usable with other function
+     of this unzip package.
+}
+
+function unzOpen(const path: PChar): unzFile; { ZEXPORT }
+var
+  us:  unz_s;
+  s:   unz_s_ptr;
+  central_pos, uL: longint;
+  fin: FILEptr;
+
+  number_disk:     longint; { number of the current dist, used for spaning ZIP,
+                         unsupported, always 0 }
+  number_disk_with_CD: longint; { number the the disk with central dir,
+                        used for spaning ZIP, unsupported, always 0 }
+  number_entry_CD: longint; { total number of entries in the central dir
+                                 (same than number_entry on nospan) }
+
+  err: longint;
+begin
+  err := UNZ_OK;
+
+  if (unz_copyright[0] <> ' ') then
+  begin
+    unzOpen := nil;
+    exit;
+  end;
+
+  fin := fopen(path, fopenread);
+  if (fin = nil) then
+  begin
+    unzOpen := nil;
+    exit;
+  end;
+
+  central_pos := unzlocal_SearchCentralDir(fin);
+  if (central_pos = 0) then
+    err := UNZ_ERRNO;
+
+  if (fseek(fin, central_pos, SEEK_SET) <> 0) then
+    err := UNZ_ERRNO;
+
+  { the signature, already checked }
+  if (unzlocal_getLong(fin, uL) <> UNZ_OK) then
+    err := UNZ_ERRNO;
+
+  { number of this disk }
+  if (unzlocal_getShort(fin, number_disk) <> UNZ_OK) then
+    err := UNZ_ERRNO;
+
+  { number of the disk with the start of the central directory }
+  if (unzlocal_getShort(fin, number_disk_with_CD) <> UNZ_OK) then
+    err := UNZ_ERRNO;
+
+  { total number of entries in the central dir on this disk }
+  if (unzlocal_getShort(fin, us.gi.number_entry) <> UNZ_OK) then
+    err := UNZ_ERRNO;
+
+  { total number of entries in the central dir }
+  if (unzlocal_getShort(fin, number_entry_CD) <> UNZ_OK) then
+    err := UNZ_ERRNO;
+
+  if ((number_entry_CD <> us.gi.number_entry) or
+    (number_disk_with_CD <> 0) or
+    (number_disk <> 0)) then
+    err := UNZ_BADZIPFILE;
+
+  { size of the central directory }
+  if (unzlocal_getLong(fin, us.size_central_dir) <> UNZ_OK) then
+    err := UNZ_ERRNO;
+
+  { offset of start of central directory with respect to the
+        starting disk number }
+  if (unzlocal_getLong(fin, us.offset_central_dir) <> UNZ_OK) then
+    err := UNZ_ERRNO;
+
+  { zipfile comment length }
+  if (unzlocal_getShort(fin, us.gi.size_comment) <> UNZ_OK) then
+    err := UNZ_ERRNO;
+
+  if ((central_pos < us.offset_central_dir + us.size_central_dir) and
+    (err = UNZ_OK)) then
+    err := UNZ_BADZIPFILE;
+
+  if (err <> UNZ_OK) then
+  begin
+    fclose(fin);
+    unzOpen := nil;
+    exit;
+  end;
+
+  us.afile := fin;
+  us.byte_before_the_zipfile := central_pos -
+    (us.offset_central_dir + us.size_central_dir);
+  us.central_pos := central_pos;
+  us.pfile_in_zip_read := nil;
+
+  s  := unz_s_ptr(AllocMem(sizeof(unz_s)));
+  s^ := us;
+  unzGoToFirstFile(unzFile(s));
+  unzOpen := unzFile(s);
+end;
+
+
+{ Close a ZipFile opened with unzipOpen.
+  If there are files inside the .Zip opened with unzOpenCurrentFile()
+  (see later), these files MUST be closed with unzipCloseCurrentFile()
+  before a call unzipClose.
+  return UNZ_OK if there is no problem. }
+
+function unzClose(afile: unzFile): longint; { ZEXPORT }
+var
+  s: unz_s_ptr;
+begin
+  if (afile = nil) then
+  begin
+    unzClose := UNZ_PARAMERROR;
+    exit;
+  end;
+  s := unz_s_ptr(afile);
+
+  if (s^.pfile_in_zip_read <> nil) then
+    unzCloseCurrentFile(afile);
+
+  fclose(s^.afile);
+  FreeMem(s);
+  unzClose := UNZ_OK;
+end;
+
+{ Write info about the ZipFile in the pglobal_info structure.
+  No preparation of the structure is needed
+  return UNZ_OK if there is no problem. }
+
+function unzGetGlobalInfo(afile: unzFile; var pglobal_info: unz_global_info): longint; { ZEXPORT }
+var
+  s: unz_s_ptr;
+begin
+  if (afile = nil) then
+  begin
+    unzGetGlobalInfo := UNZ_PARAMERROR;
+    exit;
+  end;
+  s := unz_s_ptr(afile);
+  pglobal_info := s^.gi;
+  unzGetGlobalInfo := UNZ_OK;
+end;
+
+
+{ Translate date/time from Dos format to tm_unz (more easily readable) }
+procedure unzlocal_DosDateToTmuDate(ulDosDate: longint; var ptm: tm_unz);
+var
+  uDate: longint;
+begin
+  uDate      := longint(ulDosDate shr 16);
+  ptm.tm_mday := integer(uDate and $1f);
+  ptm.tm_mon := integer((((uDate) and $1E0) div $20) - 1);
+  ptm.tm_year := integer(((uDate and $0FE00) div $0200) + 1980);
+
+  ptm.tm_hour := integer((ulDosDate and $F800) div $800);
+  ptm.tm_min  := integer((ulDosDate and $7E0) div $20);
+  ptm.tm_sec  := integer(2 * (ulDosDate and $1f));
+end;
+
+{ Get Info about the current file in the zipfile, with internal only info }
+function unzlocal_GetCurrentFileInfoInternal(afile: unzFile; pfile_info: unz_file_info_ptr; pfile_info_internal: unz_file_info_internal_ptr; szFileName: PChar; fileNameBufferSize: longint; extraField: pointer; extraFieldBufferSize: longint; szComment: PChar; commentBufferSize: longint): longint;
+var
+  s:      unz_s_ptr;
+  file_info: unz_file_info;
+  file_info_internal: unz_file_info_internal;
+  err:    longint;
+  uMagic: longint;
+  lSeek:  longint;
+var
+  uSizeRead: longint;
+begin
+  err   := UNZ_OK;
+  lSeek := 0;
+  if (afile = nil) then
+  begin
+    unzlocal_GetCurrentFileInfoInternal := UNZ_PARAMERROR;
+    exit;
+  end;
+  s := unz_s_ptr(afile);
+
+  if (fseek(s^.afile,
+    s^.pos_in_central_dir + s^.byte_before_the_zipfile, SEEK_SET) <> 0) then
+    err := UNZ_ERRNO;
+
+  { we check the magic }
+  if (err = UNZ_OK) then
+    if (unzlocal_getLong(s^.afile, uMagic) <> UNZ_OK) then
+      err := UNZ_ERRNO
+    else
+    if (uMagic <> CENTRALHEADERMAGIC) then
+      err := UNZ_BADZIPFILE;
+
+  if (unzlocal_getShort(s^.afile, file_info.version) <> UNZ_OK) then
+    err := UNZ_ERRNO;
+
+  if (unzlocal_getShort(s^.afile, file_info.version_needed) <> UNZ_OK) then
+    err := UNZ_ERRNO;
+
+  if (unzlocal_getShort(s^.afile, file_info.flag) <> UNZ_OK) then
+    err := UNZ_ERRNO;
+
+  if (unzlocal_getShort(s^.afile, file_info.compression_method) <> UNZ_OK) then
+    err := UNZ_ERRNO;
+
+  if (unzlocal_getLong(s^.afile, file_info.dosDate) <> UNZ_OK) then
+    err := UNZ_ERRNO;
+
+  unzlocal_DosDateToTmuDate(file_info.dosDate, file_info.tmu_date);
+
+  if (unzlocal_getLong(s^.afile, file_info.crc) <> UNZ_OK) then
+    err := UNZ_ERRNO;
+
+  if (unzlocal_getLong(s^.afile, file_info.compressed_size) <> UNZ_OK) then
+    err := UNZ_ERRNO;
+
+  if (unzlocal_getLong(s^.afile, file_info.uncompressed_size) <> UNZ_OK) then
+    err := UNZ_ERRNO;
+
+  if (unzlocal_getShort(s^.afile, file_info.size_filename) <> UNZ_OK) then
+    err := UNZ_ERRNO;
+
+  if (unzlocal_getShort(s^.afile, file_info.size_file_extra) <> UNZ_OK) then
+    err := UNZ_ERRNO;
+
+  if (unzlocal_getShort(s^.afile, file_info.size_file_comment) <> UNZ_OK) then
+    err := UNZ_ERRNO;
+
+  if (unzlocal_getShort(s^.afile, file_info.disk_num_start) <> UNZ_OK) then
+    err := UNZ_ERRNO;
+
+  if (unzlocal_getShort(s^.afile, file_info.internal_fa) <> UNZ_OK) then
+    err := UNZ_ERRNO;
+
+  if (unzlocal_getLong(s^.afile, file_info.external_fa) <> UNZ_OK) then
+    err := UNZ_ERRNO;
+
+  if (unzlocal_getLong(s^.afile, file_info_internal.offset_curfile) <> UNZ_OK) then
+    err := UNZ_ERRNO;
+
+  Inc(lSeek, file_info.size_filename);
+  if ((err = UNZ_OK) and (szFileName <> nil)) then
+  begin
+    if (file_info.size_filename < fileNameBufferSize) then
+    begin
+      (szFileName +file_info.size_filename)^ := #0;
+      uSizeRead := file_info.size_filename;
+    end
+    else
+      uSizeRead := fileNameBufferSize;
+
+    if (file_info.size_filename > 0) and (fileNameBufferSize > 0) then
+      if fread(szFileName, uSizeRead, 1, s^.afile) <> 1 then
+        err := UNZ_ERRNO;
+    Dec(lSeek, uSizeRead);
+  end;
+
+  if ((err = UNZ_OK) and (extraField <> nil)) then
+  begin
+    if (file_info.size_file_extra < extraFieldBufferSize) then
+      uSizeRead := file_info.size_file_extra
+    else
+      uSizeRead := extraFieldBufferSize;
+
+    if (lSeek <> 0) then
+      if (fseek(s^.afile, lSeek, SEEK_CUR) = 0) then
+        lSeek := 0
+      else
+        err   := UNZ_ERRNO;
+
+    if ((file_info.size_file_extra > 0) and (extraFieldBufferSize > 0)) then
+      if fread(extraField, uSizeRead, 1, s^.afile) <> 1 then
+        err := UNZ_ERRNO;
+    Inc(lSeek, file_info.size_file_extra - uSizeRead);
+  end
+  else
+    Inc(lSeek, file_info.size_file_extra);
+
+  if ((err = UNZ_OK) and (szComment <> nil)) then
+  begin
+    if (file_info.size_file_comment < commentBufferSize) then
+    begin
+      (szComment +file_info.size_file_comment)^ := #0;
+      uSizeRead := file_info.size_file_comment;
+    end
+    else
+      uSizeRead := commentBufferSize;
+
+    if (lSeek <> 0) then
+      if (fseek(s^.afile, lSeek, SEEK_CUR) = 0) then
+        lSeek := 0
+      else
+        err   := UNZ_ERRNO;
+    if ((file_info.size_file_comment > 0) and (commentBufferSize > 0)) then
+      if fread(szComment, uSizeRead, 1, s^.afile) <> 1 then
+        err := UNZ_ERRNO;
+    Inc(lSeek, file_info.size_file_comment - uSizeRead);
+  end
+  else
+    Inc(lSeek, file_info.size_file_comment);
+
+  if ((err = UNZ_OK) and (pfile_info <> nil)) then
+    pfile_info^ := file_info;
+
+  if ((err = UNZ_OK) and (pfile_info_internal <> nil)) then
+    pfile_info_internal^ := file_info_internal;
+
+  unzlocal_GetCurrentFileInfoInternal := err;
+end;
+
+
+{ Write info about the ZipFile in the *pglobal_info structure.
+  No preparation of the structure is needed
+  return UNZ_OK if there is no problem. }
+
+function unzGetCurrentFileInfo(afile: unzFile; pfile_info: unz_file_info_ptr; szFileName: PChar; fileNameBufferSize: longint; extraField: pointer; extraFieldBufferSize: longint; szComment: PChar; commentBufferSize: longint): longint; { ZEXPORT }
+
+{ Get Info about the current file
+  if pfile_info<>NIL, the pfile_info^ structure will contain somes
+  info about the current file
+  if szFileName<>NIL, the filemane string will be copied in szFileName
+      (fileNameBufferSize is the size of the buffer)
+  if extraField<>NIL, the extra field information will be copied in
+    extraField  (extraFieldBufferSize is the size of the buffer).
+    This is the Central-header version of the extra field
+  if szComment<>NIL, the comment string of the file will be copied in
+    szComment (commentBufferSize is the size of the buffer) }
+
+begin
+  unzGetCurrentFileInfo := unzlocal_GetCurrentFileInfoInternal(afile,
+    pfile_info, nil, szFileName, fileNameBufferSize, extraField,
+    extraFieldBufferSize, szComment, commentBufferSize);
+end;
+
+
+{ Set the current file of the zipfile to the first file.
+  return UNZ_OK if there is no problem }
+
+function unzGoToFirstFile(afile: unzFile): longint;  { ZEXPORT }
+var
+  err: longint;
+  s:   unz_s_ptr;
+begin
+  if (afile = nil) then
+  begin
+    unzGoToFirstFile := UNZ_PARAMERROR;
+    exit;
+  end;
+  s   := unz_s_ptr(afile);
+  s^.pos_in_central_dir := s^.offset_central_dir;
+  s^.num_file := 0;
+  err := unzlocal_GetCurrentFileInfoInternal(afile, @s^.cur_file_info, @s^.cur_file_info_internal, nil, 0, nil, 0, nil, 0);
+  s^.current_file_ok := (err = UNZ_OK);
+  unzGoToFirstFile := err;
+end;
+
+
+{ Set the current file of the zipfile to the next file.
+  return UNZ_OK if there is no problem
+  return UNZ_END_OF_LIST_OF_FILE if the actual file was the latest. }
+
+function unzGoToNextFile(afile: unzFile): longint; { ZEXPORT }
+var
+  s:   unz_s_ptr;
+  err: longint;
+begin
+  if (afile = nil) then
+  begin
+    unzGoToNextFile := UNZ_PARAMERROR;
+    exit;
+  end;
+  s := unz_s_ptr(afile);
+  if not s^.current_file_ok then
+  begin
+    unzGoToNextFile := UNZ_END_OF_LIST_OF_FILE;
+    exit;
+  end;
+  if (s^.num_file + 1 = s^.gi.number_entry) then
+  begin
+    unzGoToNextFile := UNZ_END_OF_LIST_OF_FILE;
+    exit;
+  end;
+
+  Inc(s^.pos_in_central_dir,
+    SIZECENTRALDIRITEM + s^.cur_file_info.size_filename +
+    s^.cur_file_info.size_file_extra + s^.cur_file_info.size_file_comment);
+  Inc(s^.num_file);
+  err := unzlocal_GetCurrentFileInfoInternal(afile, @s^.cur_file_info, @s^.cur_file_info_internal, nil, 0, nil, 0, nil, 0);
+  s^.current_file_ok := (err = UNZ_OK);
+  unzGoToNextFile := err;
+end;
+
+
+{ Try locate the file szFileName in the zipfile.
+  For the iCaseSensitivity signification, see unzStringFileNameCompare
+
+  return value :
+  UNZ_OK if the file is found. It becomes the current file.
+  UNZ_END_OF_LIST_OF_FILE if the file is not found }
+
+function unzLocateFile(afile: unzFile; const szFileName: PChar; iCaseSensitivity: longint): longint; { ZEXPORT }
+var
+  s:   unz_s_ptr;
+  err: longint;
+  num_fileSaved: longint;
+  pos_in_central_dirSaved: longint;
+var
+  szCurrentFileName: array[0..UNZ_MAXFILENAMEINZIP + 1 - 1] of char;
+begin
+  if (afile = nil) then
+  begin
+    unzLocateFile := UNZ_PARAMERROR;
+    exit;
+  end;
+
+  if (strlen(szFileName) >= UNZ_MAXFILENAMEINZIP) then
+  begin
+    unzLocateFile := UNZ_PARAMERROR;
+    exit;
+  end;
+
+  s := unz_s_ptr(afile);
+  if (not s^.current_file_ok) then
+  begin
+    unzLocateFile := UNZ_END_OF_LIST_OF_FILE;
+    exit;
+  end;
+  num_fileSaved := s^.num_file;
+  pos_in_central_dirSaved := s^.pos_in_central_dir;
+
+  err := unzGoToFirstFile(afile);
+
+  while (err = UNZ_OK) do
+  begin
+    unzGetCurrentFileInfo(afile, nil,
+      szCurrentFileName, sizeof(szCurrentFileName) - 1, nil, 0, nil, 0);
+    if (unzStringFileNameCompare(szCurrentFileName,
+      szFileName, iCaseSensitivity) = 0) then
+    begin
+      unzLocateFile := UNZ_OK;
+      exit;
+    end;
+    err := unzGoToNextFile(afile);
+  end;
+
+  s^.num_file   := num_fileSaved;
+  s^.pos_in_central_dir := pos_in_central_dirSaved;
+  unzLocateFile := err;
+end;
+
+
+{ Read the local header of the current zipfile
+  Check the coherency of the local header and info in the end of central
+        directory about this file
+  store in *piSizeVar the size of extra info in local header
+        (filename and size of extra field data) }
+
+function unzlocal_CheckCurrentFileCoherencyHeader(s: unz_s_ptr; var piSizeVar: longint; var poffset_local_extrafield: longint; var psize_local_extrafield: integer): longint;
+var
+  uMagic, uData, uFlags: longint;
+  size_filename: longint;
+  size_extra_field: longint;
+  err: longint;
+begin
+  err := UNZ_OK;
+
+  piSizeVar := 0;
+  poffset_local_extrafield := 0;
+  psize_local_extrafield := 0;
+
+  if (fseek(s^.afile, s^.cur_file_info_internal.offset_curfile +
+    s^.byte_before_the_zipfile, SEEK_SET) <> 0) then
+  begin
+    unzlocal_CheckCurrentFileCoherencyHeader := UNZ_ERRNO;
+    exit;
+  end;
+
+  if (err = UNZ_OK) then
+    if (unzlocal_getLong(s^.afile, uMagic) <> UNZ_OK) then
+      err := UNZ_ERRNO
+    else
+    if (uMagic <> $04034b50) then
+      err := UNZ_BADZIPFILE;
+
+  if (unzlocal_getShort(s^.afile, uData) <> UNZ_OK) then
+    err := UNZ_ERRNO;
+{
+  else
+    if ((err=UNZ_OK) and (uData<>s^.cur_file_info.wVersion)) then
+      err := UNZ_BADZIPFILE;
+}
+  if (unzlocal_getShort(s^.afile, uFlags) <> UNZ_OK) then
+    err := UNZ_ERRNO;
+
+  if (unzlocal_getShort(s^.afile, uData) <> UNZ_OK) then
+    err := UNZ_ERRNO
+  else
+  if ((err = UNZ_OK) and (uData <> s^.cur_file_info.compression_method)) then
+    err := UNZ_BADZIPFILE;
+
+  if ((err = UNZ_OK) and (s^.cur_file_info.compression_method <> 0) and
+    (s^.cur_file_info.compression_method <> Z_DEFLATED)) then
+    err := UNZ_BADZIPFILE;
+
+  if (unzlocal_getLong(s^.afile, uData) <> UNZ_OK) then { date/time }
+    err := UNZ_ERRNO;
+
+  if (unzlocal_getLong(s^.afile, uData) <> UNZ_OK) then { crc }
+    err := UNZ_ERRNO
+  else
+  if ((err = UNZ_OK) and (uData <> s^.cur_file_info.crc) and
+    ((uFlags and 8) = 0)) then
+    err := UNZ_BADZIPFILE;
+
+  if (unzlocal_getLong(s^.afile, uData) <> UNZ_OK) then { size compr }
+    err := UNZ_ERRNO
+  else
+  if ((err = UNZ_OK) and (uData <> s^.cur_file_info.compressed_size) and
+    ((uFlags and 8) = 0)) then
+    err := UNZ_BADZIPFILE;
+
+  if (unzlocal_getLong(s^.afile, uData) <> UNZ_OK) then { size uncompr }
+    err := UNZ_ERRNO
+  else
+  if ((err = UNZ_OK) and (uData <> s^.cur_file_info.uncompressed_size) and
+    ((uFlags and 8) = 0)) then
+    err := UNZ_BADZIPFILE;
+
+
+  if (unzlocal_getShort(s^.afile, size_filename) <> UNZ_OK) then
+    err := UNZ_ERRNO
+  else
+  if ((err = UNZ_OK) and (size_filename <> s^.cur_file_info.size_filename)) then
+    err := UNZ_BADZIPFILE;
+
+  Inc(piSizeVar, integer(size_filename));
+
+  if (unzlocal_getShort(s^.afile, size_extra_field) <> UNZ_OK) then
+    err := UNZ_ERRNO;
+  poffset_local_extrafield := s^.cur_file_info_internal.offset_curfile +
+    SIZEZIPLOCALHEADER + size_filename;
+  psize_local_extrafield := integer(size_extra_field);
+
+  Inc(piSizeVar, integer(size_extra_field));
+
+  unzlocal_CheckCurrentFileCoherencyHeader := err;
+end;
+
+{ Open for reading data the current file in the zipfile.
+  If there is no error, the return value is UNZ_OK. }
+
+function unzOpenCurrentFile(afile: unzFile): longint; { ZEXPORT }
+var
+  err: longint;
+  Store: boolean;
+  iSizeVar: longint;
+  s: unz_s_ptr;
+  pfile_in_zip_read_info: file_in_zip_read_info_s_ptr;
+  offset_local_extrafield: longint;  { offset of the local extra field }
+  size_local_extrafield: smallint;     { size of the local extra field }
+begin
+  err := UNZ_OK;
+
+  if (afile = nil) then
+  begin
+    unzOpenCurrentFile := UNZ_PARAMERROR;
+    exit;
+  end;
+  s := unz_s_ptr(afile);
+  if not s^.current_file_ok then
+  begin
+    unzOpenCurrentFile := UNZ_PARAMERROR;
+    exit;
+  end;
+
+  if (s^.pfile_in_zip_read <> nil) then
+    unzCloseCurrentFile(afile);
+
+  if (unzlocal_CheckCurrentFileCoherencyHeader(s, iSizeVar,
+    offset_local_extrafield, size_local_extrafield) <> UNZ_OK) then
+  begin
+    unzOpenCurrentFile := UNZ_BADZIPFILE;
+    exit;
+  end;
+
+  pfile_in_zip_read_info := file_in_zip_read_info_s_ptr(
+    AllocMem(sizeof(file_in_zip_read_info_s)));
+  if (pfile_in_zip_read_info = nil) then
+  begin
+    unzOpenCurrentFile := UNZ_INTERNALERROR;
+    exit;
+  end;
+
+  pfile_in_zip_read_info^.read_buffer := PChar(AllocMem(UNZ_BUFSIZE));
+  pfile_in_zip_read_info^.offset_local_extrafield := offset_local_extrafield;
+  pfile_in_zip_read_info^.size_local_extrafield := size_local_extrafield;
+  pfile_in_zip_read_info^.pos_local_extrafield := 0;
+
+  if (pfile_in_zip_read_info^.read_buffer = nil) then
+  begin
+    FreeMem(pfile_in_zip_read_info);
+    unzOpenCurrentFile := UNZ_INTERNALERROR;
+    exit;
+  end;
+
+  pfile_in_zip_read_info^.stream_initialised := False;
+
+  if ((s^.cur_file_info.compression_method <> 0) and
+    (s^.cur_file_info.compression_method <> Z_DEFLATED)) then
+    err := UNZ_BADZIPFILE;
+  Store := s^.cur_file_info.compression_method = 0;
+
+  pfile_in_zip_read_info^.crc32_wait := s^.cur_file_info.crc;
+  pfile_in_zip_read_info^.crc32      := 0;
+  pfile_in_zip_read_info^.compression_method := s^.cur_file_info.compression_method;
+  pfile_in_zip_read_info^.afile      := s^.afile;
+  pfile_in_zip_read_info^.byte_before_the_zipfile := s^.byte_before_the_zipfile;
+
+  pfile_in_zip_read_info^.stream.total_out := 0;
+
+  if (not Store) then
+  begin
+    err := inflateInit2(pfile_in_zip_read_info^.stream, -MAX_WBITS);
+
+    if (err = Z_OK) then
+      pfile_in_zip_read_info^.stream_initialised := True;
+        { windowBits is passed < 0 to tell that there is no zlib header.
+          Note that in this case inflate *requires* an extra "dummy" byte
+          after the compressed stream in order to complete decompression and
+          return Z_STREAM_END.
+          In unzip, i don't wait absolutely Z_STREAM_END because I known the
+          size of both compressed and uncompressed data }
+  end;
+  pfile_in_zip_read_info^.rest_read_compressed   := s^.cur_file_info.compressed_size;
+  pfile_in_zip_read_info^.rest_read_uncompressed := s^.cur_file_info.uncompressed_size;
+
+
+  pfile_in_zip_read_info^.pos_in_zipfile :=
+    s^.cur_file_info_internal.offset_curfile + SIZEZIPLOCALHEADER + iSizeVar;
+
+  pfile_in_zip_read_info^.stream.avail_in := 0;
+
+
+  s^.pfile_in_zip_read := pfile_in_zip_read_info;
+  unzOpenCurrentFile   := UNZ_OK;
+end;
+
+
+{ Read bytes from the current file (opened by unzOpenCurrentFile)
+  buf contain buffer where data must be copied
+  len the size of buf.
+
+  return the number of byte copied if somes bytes are copied
+  return 0 if the end of file was reached
+  return <0 with error code if there is an error
+    (UNZ_ERRNO for IO error, or zLib error for uncompress error) }
+
+function unzReadCurrentFile(afile: unzFile; buf: pointer; len: cardinal): longint; { ZEXPORT }
+
+var
+  err:   longint;
+  iRead: Longint;
+  s:     unz_s_ptr;
+  pfile_in_zip_read_info: file_in_zip_read_info_s_ptr;
+var
+  uReadThis: longint;
+var
+  uDoCopy, i: longint;
+var
+  uTotalOutBefore, uTotalOutAfter: longint;
+  bufBefore: pbyte;
+  uOutThis: longint;
+  flush: longint;
+begin
+  err   := UNZ_OK;
+  iRead := 0;
+  if (afile = nil) then
+  begin
+    unzReadCurrentFile := UNZ_PARAMERROR;
+    exit;
+  end;
+  s := unz_s_ptr(afile);
+  pfile_in_zip_read_info := s^.pfile_in_zip_read;
+
+  if (pfile_in_zip_read_info = nil) then
+  begin
+    unzReadCurrentFile := UNZ_PARAMERROR;
+    exit;
+  end;
+
+  if ((pfile_in_zip_read_info^.read_buffer = nil)) then
+  begin
+    unzReadCurrentFile := UNZ_END_OF_LIST_OF_FILE;
+    exit;
+  end;
+
+  if (len = 0) then
+  begin
+    unzReadCurrentFile := 0;
+    exit;
+  end;
+
+  pfile_in_zip_read_info^.stream.next_out := pbyte(buf);
+
+  pfile_in_zip_read_info^.stream.avail_out := len;
+
+  if (len > pfile_in_zip_read_info^.rest_read_uncompressed) then
+    pfile_in_zip_read_info^.stream.avail_out :=
+      pfile_in_zip_read_info^.rest_read_uncompressed;
+
+  while (pfile_in_zip_read_info^.stream.avail_out > 0) do
+  begin
+    if ((pfile_in_zip_read_info^.stream.avail_in = 0) and
+      (pfile_in_zip_read_info^.rest_read_compressed > 0)) then
+    begin
+      uReadThis := UNZ_BUFSIZE;
+      if (pfile_in_zip_read_info^.rest_read_compressed < uReadThis) then
+        uReadThis := pfile_in_zip_read_info^.rest_read_compressed;
+      if (uReadThis = 0) then
+      begin
+        unzReadCurrentFile := UNZ_EOF;
+        exit;
+      end;
+      if (fseek(pfile_in_zip_read_info^.afile,
+        pfile_in_zip_read_info^.pos_in_zipfile +
+        pfile_in_zip_read_info^.byte_before_the_zipfile, SEEK_SET) <> 0) then
+      begin
+        unzReadCurrentFile := UNZ_ERRNO;
+        exit;
+      end;
+      if fread(pfile_in_zip_read_info^.read_buffer, uReadThis, 1,
+        pfile_in_zip_read_info^.afile) <> 1 then
+      begin
+        unzReadCurrentFile := UNZ_ERRNO;
+        exit;
+      end;
+      Inc(pfile_in_zip_read_info^.pos_in_zipfile, uReadThis);
+
+      Dec(pfile_in_zip_read_info^.rest_read_compressed, uReadThis);
+
+      pfile_in_zip_read_info^.stream.next_in  :=
+        pbyte(pfile_in_zip_read_info^.read_buffer);
+      pfile_in_zip_read_info^.stream.avail_in := uReadThis;
+    end;
+
+    if (pfile_in_zip_read_info^.compression_method = 0) then
+    begin
+      if (pfile_in_zip_read_info^.stream.avail_out <
+        pfile_in_zip_read_info^.stream.avail_in) then
+        uDoCopy := pfile_in_zip_read_info^.stream.avail_out
+      else
+        uDoCopy := pfile_in_zip_read_info^.stream.avail_in;
+
+      for i := 0 to uDoCopy - 1 do
+        Pbytearray(pfile_in_zip_read_info^.stream.next_out)^[i] :=
+          Pbytearray(pfile_in_zip_read_info^.stream.next_in)^[i];
+
+      pfile_in_zip_read_info^.crc32 := crc32(pfile_in_zip_read_info^.crc32,
+        pfile_in_zip_read_info^.stream.next_out, uDoCopy);
+      Dec(pfile_in_zip_read_info^.rest_read_uncompressed, uDoCopy);
+      Dec(pfile_in_zip_read_info^.stream.avail_in, uDoCopy);
+      Dec(pfile_in_zip_read_info^.stream.avail_out, uDoCopy);
+      Inc(pfile_in_zip_read_info^.stream.next_out, uDoCopy);
+      Inc(pfile_in_zip_read_info^.stream.next_in, uDoCopy);
+      Inc(pfile_in_zip_read_info^.stream.total_out, uDoCopy);
+      Inc(iRead, uDoCopy);
+    end
+    else
+    begin
+      flush := Z_SYNC_FLUSH;
+
+      uTotalOutBefore := pfile_in_zip_read_info^.stream.total_out;
+      bufBefore := pfile_in_zip_read_info^.stream.next_out;
+
+      {
+      if ((pfile_in_zip_read_info^.rest_read_uncompressed =
+     pfile_in_zip_read_info^.stream.avail_out) and
+    (pfile_in_zip_read_info^.rest_read_compressed = 0)) then
+        flush := Z_FINISH;
+      }
+      err := inflate(pfile_in_zip_read_info^.stream, flush);
+
+      uTotalOutAfter := pfile_in_zip_read_info^.stream.total_out;
+      uOutThis := uTotalOutAfter - uTotalOutBefore;
+
+      pfile_in_zip_read_info^.crc32 :=
+        crc32(pfile_in_zip_read_info^.crc32, bufBefore, uOutThis);
+
+      Dec(pfile_in_zip_read_info^.rest_read_uncompressed, uOutThis);
+
+      Inc(iRead, uTotalOutAfter - uTotalOutBefore);
+
+      if (err = Z_STREAM_END) then
+      begin
+        if iRead = 0 then
+          unzReadCurrentFile := UNZ_EOF
+        else
+          unzReadCurrentFile := iRead;
+        exit;
+      end;
+      if (err <> Z_OK) then
+        break;
+    end;
+  end; { while }
+
+  if (err = Z_OK) then
+  begin
+    unzReadCurrentFile := iRead;
+    exit;
+  end;
+  unzReadCurrentFile := err;
+end;
+
+{ Give the current position in uncompressed data }
+
+function unztell(afile: unzFile): z_off_t; { ZEXPORT }
+var
+  s: unz_s_ptr;
+  pfile_in_zip_read_info: file_in_zip_read_info_s_ptr;
+begin
+  if (afile = nil) then
+  begin
+    unztell := UNZ_PARAMERROR;
+    exit;
+  end;
+
+  s := unz_s_ptr(afile);
+  pfile_in_zip_read_info := s^.pfile_in_zip_read;
+
+  if (pfile_in_zip_read_info = nil) then
+  begin
+    unztell := UNZ_PARAMERROR;
+    exit;
+  end;
+
+  unztell := z_off_t(pfile_in_zip_read_info^.stream.total_out);
+end;
+
+
+{ return 1 (TRUE) if the end of file was reached, 0 elsewhere }
+
+function unzeof(afile: unzFile): longint;
+var
+  s: unz_s_ptr;
+  pfile_in_zip_read_info: file_in_zip_read_info_s_ptr;
+begin
+  if (afile = nil) then
+  begin
+    unzeof := UNZ_PARAMERROR;
+    exit;
+  end;
+
+  s := unz_s_ptr(afile);
+  pfile_in_zip_read_info := s^.pfile_in_zip_read;
+
+  if (pfile_in_zip_read_info = nil) then
+  begin
+    unzeof := UNZ_PARAMERROR;
+    exit;
+  end;
+
+  if (pfile_in_zip_read_info^.rest_read_uncompressed = 0) then
+    unzeof := 1
+  else
+    unzeof := 0;
+end;
+
+
+{ Read extra field from the current file (opened by unzOpenCurrentFile)
+  This is the local-header version of the extra field (sometimes, there is
+    more info in the local-header version than in the central-header)
+
+  if buf=NIL, it return the size of the local extra field
+
+  if buf<>NIL, len is the size of the buffer, the extra header is copied in
+  buf.
+  the return value is the number of bytes copied in buf, or (if <0)
+  the error code }
+
+function unzGetLocalExtrafield(afile: unzFile; buf: pointer; len: cardinal): longint;
+var
+  s: unz_s_ptr;
+  pfile_in_zip_read_info: file_in_zip_read_info_s_ptr;
+  read_now: longint;
+  size_to_read: longint;
+begin
+  if (afile = nil) then
+  begin
+    unzGetLocalExtrafield := UNZ_PARAMERROR;
+    exit;
+  end;
+
+  s := unz_s_ptr(afile);
+  pfile_in_zip_read_info := s^.pfile_in_zip_read;
+
+  if (pfile_in_zip_read_info = nil) then
+  begin
+    unzGetLocalExtrafield := UNZ_PARAMERROR;
+    exit;
+  end;
+
+  size_to_read := (pfile_in_zip_read_info^.size_local_extrafield -
+    pfile_in_zip_read_info^.pos_local_extrafield);
+
+  if (buf = nil) then
+  begin
+    unzGetLocalExtrafield := longint(size_to_read);
+    exit;
+  end;
+
+  if (len > size_to_read) then
+    read_now := size_to_read
+  else
+    read_now := len;
+
+  if (read_now = 0) then
+  begin
+    unzGetLocalExtrafield := 0;
+    exit;
+  end;
+
+  if (fseek(pfile_in_zip_read_info^.afile,
+    pfile_in_zip_read_info^.offset_local_extrafield +
+    pfile_in_zip_read_info^.pos_local_extrafield, SEEK_SET) <> 0) then
+  begin
+    unzGetLocalExtrafield := UNZ_ERRNO;
+    exit;
+  end;
+
+  if fread(buf, size_to_read, 1, pfile_in_zip_read_info^.afile) <> 1 then
+  begin
+    unzGetLocalExtrafield := UNZ_ERRNO;
+    exit;
+  end;
+
+  unzGetLocalExtrafield := longint(read_now);
+end;
+
+{ Close the file in zip opened with unzOpenCurrentFile
+  Return UNZ_CRCERROR if all the file was read but the CRC is not good }
+
+function unzCloseCurrentFile(afile: unzFile): longint; { ZEXPORT }
+var
+  err: longint;
+  s:   unz_s_ptr;
+  pfile_in_zip_read_info: file_in_zip_read_info_s_ptr;
+begin
+  err := UNZ_OK;
+
+  if (afile = nil) then
+  begin
+    unzCloseCurrentFile := UNZ_PARAMERROR;
+    exit;
+  end;
+  s := unz_s_ptr(afile);
+  pfile_in_zip_read_info := s^.pfile_in_zip_read;
+
+  if (pfile_in_zip_read_info = nil) then
+  begin
+    unzCloseCurrentFile := UNZ_PARAMERROR;
+    exit;
+  end;
+
+
+  if (pfile_in_zip_read_info^.rest_read_uncompressed = 0) then
+    if (pfile_in_zip_read_info^.crc32 <> pfile_in_zip_read_info^.crc32_wait) then
+      err := UNZ_CRCERROR;
+
+
+  FreeMem(pfile_in_zip_read_info^.read_buffer);
+  pfile_in_zip_read_info^.read_buffer := nil;
+  if (pfile_in_zip_read_info^.stream_initialised) then
+    inflateEnd(pfile_in_zip_read_info^.stream);
+
+  pfile_in_zip_read_info^.stream_initialised := False;
+  FreeMem(pfile_in_zip_read_info);
+
+  s^.pfile_in_zip_read := nil;
+
+  unzCloseCurrentFile := err;
+end;
+
+
+{ Get the global comment string of the ZipFile, in the szComment buffer.
+  uSizeBuf is the size of the szComment buffer.
+  return the number of byte copied or an error code <0 }
+
+function unzGetGlobalComment(afile: unzFile; szComment: PChar; uSizeBuf: longint): longint; { ZEXPORT }
+
+var
+  s: unz_s_ptr;
+  uReadThis: longint;
+begin
+  if (afile = nil) then
+  begin
+    unzGetGlobalComment := UNZ_PARAMERROR;
+    exit;
+  end;
+  s := unz_s_ptr(afile);
+
+  uReadThis := uSizeBuf;
+  if (uReadThis > s^.gi.size_comment) then
+    uReadThis := s^.gi.size_comment;
+
+  if (fseek(s^.afile, s^.central_pos + 22, SEEK_SET) <> 0) then
+  begin
+    unzGetGlobalComment := UNZ_ERRNO;
+    exit;
+  end;
+
+  if (uReadThis > 0) then
+  begin
+    szComment^ := #0;
+    if fread(szComment, uReadThis, 1, s^.afile) <> 1 then
+    begin
+      unzGetGlobalComment := UNZ_ERRNO;
+      exit;
+    end;
+  end;
+
+  if ((szComment <> nil) and (uSizeBuf > s^.gi.size_comment)) then
+    (szComment +s^.gi.size_comment)^ := #0;
+
+  unzGetGlobalComment := longint(uReadThis);
+end;
+
+end.

+ 509 - 0
src/libraries/paszlib/paszlib_zbase.pas

@@ -0,0 +1,509 @@
+unit paszlib_ZBase;
+
+{$IFDEF FPC}
+  {$MODE FPC}
+{$ENDIF}
+
+
+{ Original:
+   zlib.h -- interface of the 'zlib' general purpose compression library
+  version 1.1.0, Feb 24th, 1998
+
+  Copyright (C) 1995-1998 Jean-loup Gailly and Mark Adler
+
+  This software is provided 'as-is', without any express or implied
+  warranty.  In no event will the authors be held liable for any damages
+  arising from the use of this software.
+
+  Permission is granted to anyone to use this software for any purpose,
+  including commercial applications, and to alter it and redistribute it
+  freely, subject to the following restrictions:
+
+  1. The origin of this software must not be misrepresented; you must not
+     claim that you wrote the original software. If you use this software
+     in a product, an acknowledgment in the product documentation would be
+     appreciated but is not required.
+  2. Altered source versions must be plainly marked as such, and must not be
+     misrepresented as being the original software.
+  3. This notice may not be removed or altered from any source distribution.
+
+  Jean-loup Gailly        Mark Adler
+  [email protected]          [email protected]
+
+
+  The data format used by the zlib library is described by RFCs (Request for
+  Comments) 1950 to 1952 in the files ftp://ds.internic.net/rfc/rfc1950.txt
+  (zlib format), rfc1951.txt (deflate format) and rfc1952.txt (gzip format).
+
+
+  Pascal tranlastion
+  Copyright (C) 1998 by Jacques Nomssi Nzali
+  For conditions of distribution and use, see copyright notice in readme.txt
+}
+
+interface
+
+{$I paszlib_zconf.inc}
+
+{ zconf.h -- configuration of the zlib compression library }
+{ zutil.c -- target dependent utility functions for the compression library }
+
+{ The 'zlib' compression library provides in-memory compression and
+  decompression functions, including integrity checks of the uncompressed
+  data.  This version of the library supports only one compression method
+  (deflation) but other algorithms will be added later and will have the same
+  stream interface.
+
+     Compression can be done in a single step if the buffers are large
+  enough (for example if an input file is mmap'ed), or can be done by
+  repeated calls of the compression function.  In the latter case, the
+  application must provide more input and/or consume the output
+  (providing more output space) before each call.
+
+     The library also supports reading and writing files in gzip (.gz) format
+  with an interface similar to that of stdio.
+
+     The library does not install any signal handler. The decoder checks
+  the consistency of the compressed data, so the library should never
+  crash even in case of corrupted input. }
+
+
+
+{ Compile with -DMAXSEG_64K if the alloc function cannot allocate more
+  than 64k bytes at a time (needed on systems with 16-bit integer). }
+
+{ Maximum value for memLevel in deflateInit2 }
+{$ifdef MAXSEG_64K}
+  {$IFDEF TP}
+  const
+    MAX_MEM_LEVEL = 7;
+    DEF_MEM_LEVEL = MAX_MEM_LEVEL;  { default memLevel }
+  {$ELSE}
+  const
+    MAX_MEM_LEVEL = 8;
+    DEF_MEM_LEVEL = MAX_MEM_LEVEL;  { default memLevel }
+  {$ENDIF}
+{$else}
+const
+  MAX_MEM_LEVEL = 9;
+  DEF_MEM_LEVEL = 8; { if MAX_MEM_LEVEL > 8 }
+{$endif}
+
+{ Maximum value for windowBits in deflateInit2 and inflateInit2 }
+const
+{$IFDEF TP}
+  MAX_WBITS = 14; { 16K LZ77 window }
+  maxzbaseint = maxint;
+{$ELSE}
+  MAX_WBITS = 15; { 32K LZ77 window }
+  maxzbaseint = maxlongint;
+{$ENDIF}
+
+{ default windowBits for decompression. MAX_WBITS is for compression only }
+const
+  DEF_WBITS = MAX_WBITS;
+
+
+type  Pbytearray=^Tbytearray;
+      Pwordarray=^Twordarray;
+      Pcardinalarray=^Tcardinalarray;
+
+      Tbytearray = array [0..maxzbaseint div sizeof(byte)-1] of byte;
+      Twordarray = array [0..maxzbaseint div sizeof(word)-1] of word;
+      Tintegerarray = array [0..maxzbaseint div sizeof(integer)-1] of integer;
+      Tcardinalarray = array [0..maxzbaseint div sizeof(cardinal)-1] of cardinal;
+
+
+{ The memory requirements for deflate are (in bytes):
+            1 shl (windowBits+2)   +  1 shl (memLevel+9)
+ that is: 128K for windowBits=15  +  128K for memLevel = 8  (default values)
+ plus a few kilobytes for small objects. For example, if you want to reduce
+ the default memory requirements from 256K to 128K, compile with
+     DMAX_WBITS=14 DMAX_MEM_LEVEL=7
+ Of course this will generally degrade compression (there's no free lunch).
+
+ The memory requirements for inflate are (in bytes) 1 shl windowBits
+ that is, 32K for windowBits=15 (default value) plus a few kilobytes
+ for small objects. }
+
+
+{ Huffman code lookup table entry--this entry is four bytes for machines
+  that have 16-bit pointers (e.g. PC's in the small or medium model). }
+
+type
+  pInflate_huft = ^inflate_huft;
+  inflate_huft = Record
+    Exop,             { number of extra bits or operation }
+    bits : Byte;      { number of bits in this code or subcode }
+    {pad : cardinal;}       { pad structure to a power of 2 (4 bytes for }
+                      {  16-bit, 8 bytes for 32-bit integer's) }
+    base : cardinal;      { literal, length base, or distance base }
+                      { or table offset }
+  End;
+
+type
+  huft_field = Array[0..(maxzbaseint div SizeOf(inflate_huft))-1] of inflate_huft;
+  huft_ptr = ^huft_field;
+type
+  ppInflate_huft = ^pInflate_huft;
+
+type
+  inflate_codes_mode = ( { waiting for "i:"=input, "o:"=output, "x:"=nothing }
+        START,    { x: set up for LEN }
+        LEN,      { i: get length/literal/eob next }
+        LENEXT,   { i: getting length extra (have base) }
+        DIST,     { i: get distance next }
+        DISTEXT,  { i: getting distance extra }
+        COPY,     { o: copying bytes in window, waiting for space }
+        LIT,      { o: got literal, waiting for output space }
+        WASH,     { o: got eob, possibly still output waiting }
+        ZEND,     { x: got eob and all data flushed }
+        BADCODE); { x: got error }
+
+{ inflate codes private state }
+type
+  pInflate_codes_state = ^inflate_codes_state;
+  inflate_codes_state = record
+
+    mode : inflate_codes_mode;        { current inflate_codes mode }
+
+    { mode dependent information }
+    len : cardinal;
+    sub : record                      { submode }
+      Case Byte of
+      0:(code : record                { if LEN or DIST, where in tree }
+          tree : pInflate_huft;       { pointer into tree }
+          need : cardinal;                { bits needed }
+         end);
+      1:(lit : cardinal);                 { if LIT, literal }
+      2:(copy: record                 { if EXT or COPY, where and how much }
+           get : cardinal;                { bits to get for extra }
+           dist : cardinal;               { distance back to copy from }
+         end);
+    end;
+
+    { mode independent information }
+    lbits : Byte;                     { ltree bits decoded per branch }
+    dbits : Byte;                     { dtree bits decoder per branch }
+    ltree : pInflate_huft;            { literal/length/eob tree }
+    dtree : pInflate_huft;            { distance tree }
+  end;
+
+type
+  check_func = function(check : cardinal;
+                        buf : Pbyte;
+                        {const buf : array of byte;}
+	                len : cardinal) : cardinal;
+type
+  inflate_block_mode =
+     (ZTYPE,    { get type bits (3, including end bit) }
+      LENS,     { get lengths for stored }
+      STORED,   { processing stored block }
+      TABLE,    { get table lengths }
+      BTREE,    { get bit lengths tree for a dynamic block }
+      DTREE,    { get length, distance trees for a dynamic block }
+      CODES,    { processing fixed or dynamic block }
+      DRY,      { output remaining window bytes }
+      BLKDONE,  { finished last block, done }
+      BLKBAD);  { got a data error--stuck here }
+
+type
+  pInflate_blocks_state = ^inflate_blocks_state;
+
+{ inflate blocks semi-private state }
+  inflate_blocks_state = record
+
+    mode : inflate_block_mode;     { current inflate_block mode }
+
+    { mode dependent information }
+    sub : record                  { submode }
+    case Byte of
+    0:(left : cardinal);              { if STORED, bytes left to copy }
+    1:(trees : record             { if DTREE, decoding info for trees }
+        table : cardinal;               { table lengths (14 bits) }
+        index : cardinal;               { index into blens (or border) }
+        blens : Pcardinalarray;         { bit lengths of codes }
+        bb : cardinal;                  { bit length tree depth }
+        tb : pInflate_huft;         { bit length decoding tree }
+      end);
+    2:(decode : record            { if CODES, current state }
+        tl : pInflate_huft;
+        td : pInflate_huft;         { trees to free }
+        codes : pInflate_codes_state;
+      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 : huft_ptr; {pInflate_huft;}  { single malloc for tree space }
+    window : Pbyte;        { sliding window }
+    zend : Pbyte;          { one byte after sliding window }
+    read : Pbyte;          { window read pointer }
+    write : Pbyte;         { window write pointer }
+    checkfn : check_func;   { check function }
+    check : cardinal;          { check on output }
+  end;
+
+type
+  inflate_mode = (
+      METHOD,   { waiting for method byte }
+      FLAG,     { waiting for flag byte }
+      DICT4,    { four dictionary check bytes to go }
+      DICT3,    { three dictionary check bytes to go }
+      DICT2,    { two dictionary check bytes to go }
+      DICT1,    { one dictionary check byte to go }
+      DICT0,    { waiting for inflateSetDictionary }
+      BLOCKS,   { decompressing blocks }
+      CHECK4,   { four check bytes to go }
+      CHECK3,   { three check bytes to go }
+      CHECK2,   { two check bytes to go }
+      CHECK1,   { one check byte to go }
+      DONE,     { finished check, done }
+      BAD);     { got an error--stay here }
+
+{ inflate private state }
+type
+  pInternal_state = ^internal_state; { or point to a deflate_state record }
+  internal_state = record
+
+     mode : inflate_mode;  { current inflate mode }
+
+     { mode dependent information }
+     sub : record          { submode }
+       case byte of
+       0:(method : cardinal);  { if FLAGS, method byte }
+       1:(check : record   { if CHECK, check values to compare }
+           was : cardinal;        { computed check value }
+           need : cardinal;       { stream check value }
+          end);
+       2:(marker : cardinal);  { if BAD, inflateSync's marker bytes count }
+     end;
+
+     { mode independent information }
+     nowrap : boolean;      { flag for no wrapper }
+     wbits : cardinal;          { log2(window size)  (8..15, defaults to 15) }
+     blocks : pInflate_blocks_state;    { current inflate_blocks state }
+   end;
+
+type
+  z_streamp = ^z_stream;
+  z_stream = record
+    next_in : Pbyte;     { next input byte }
+    avail_in : cardinal;      { number of bytes available at next_in }
+    total_in : qword;     { total nb of input bytes read so far }
+
+    next_out : Pbyte;    { next output byte should be put there }
+    avail_out : cardinal;     { remaining free space at next_out }
+    total_out : qword;    { total nb of bytes output so far }
+
+    msg : string[255];         { last error message, '' if no error }
+    state : pInternal_state; { not visible by applications }
+
+    data_type : integer;      { best guess about the data type: ascii or binary }
+    adler : cardinal;        { adler32 value of the uncompressed data }
+    reserved : cardinal;     { reserved for future use }
+  end;
+
+
+{  The application must update next_in and avail_in when avail_in has
+   dropped to zero. It must update next_out and avail_out when avail_out
+   has dropped to zero. The application must initialize zalloc, zfree and
+   opaque before calling the init function. All other fields are set by the
+   compression library and must not be updated by the application.
+
+   The fields total_in and total_out can be used for statistics or
+   progress reports. After compression, total_in 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). }
+
+const  { constants }
+   Z_NO_FLUSH      = 0;
+   Z_PARTIAL_FLUSH = 1;
+   Z_SYNC_FLUSH    = 2;
+   Z_FULL_FLUSH    = 3;
+   Z_FINISH        = 4;
+{ Allowed flush values; see deflate() below for details }
+
+   Z_OK            = 0;
+   Z_STREAM_END    = 1;
+   Z_NEED_DICT     = 2;
+   Z_ERRNO         = (-1);
+   Z_STREAM_ERROR  = (-2);
+   Z_DATA_ERROR    = (-3);
+   Z_MEM_ERROR     = (-4);
+   Z_BUF_ERROR     = (-5);
+   Z_VERSION_ERROR = (-6);
+{ Return codes for the compression/decompression functions. Negative
+  values are errors, positive values are used for special but normal events.}
+
+   Z_NO_COMPRESSION         = 0;
+   Z_BEST_SPEED             = 1;
+   Z_BEST_COMPRESSION       = 9;
+   Z_DEFAULT_COMPRESSION    = (-1);
+{ compression levels }
+
+   Z_FILTERED            = 1;
+   Z_HUFFMAN_ONLY        = 2;
+   Z_DEFAULT_STRATEGY    = 0;
+{ compression strategy; see deflateInit2() below for details }
+
+   Z_BINARY   = 0;
+   Z_ASCII    = 1;
+   Z_UNKNOWN  = 2;
+{ Possible values of the data_type field }
+
+   Z_DEFLATED   = 8;
+{ The deflate compression method (the only one supported in this version) }
+
+  {$IFDEF GZIO}
+var
+  errno : integer;
+  {$ENDIF}
+
+        { common constants }
+
+
+{ The three kinds of block type }
+const
+  STORED_BLOCK = 0;
+  STATIC_TREES = 1;
+  DYN_TREES = 2;
+{ The minimum and maximum match lengths }
+const
+  MIN_MATCH = 3;
+{$ifdef MAX_MATCH_IS_258}
+  MAX_MATCH = 258;
+{$else}
+  MAX_MATCH = ??;    { deliberate syntax error }
+{$endif}
+
+const
+  PRESET_DICT = $20; { preset dictionary flag in zlib header }
+
+
+  {$IFDEF ZLIB_DEBUG}
+  procedure Assert(cond : boolean; msg : string);
+  {$ENDIF}
+
+  procedure Trace(x : string);
+  procedure Tracev(x : string);
+  procedure Tracevv(x : string);
+  procedure Tracevvv(x : string);
+  procedure Tracec(c : boolean; x : string);
+  procedure Tracecv(c : boolean; x : string);
+
+function zlibVersion : string;
+{ The application can compare zlibVersion and ZLIB_VERSION for consistency.
+  If the first character differs, the library code actually used is
+  not compatible with the zlib.h header file used by the application.
+  This check is automatically made by deflateInit and inflateInit. }
+
+function zError(err : integer) : string;
+
+const
+  ZLIB_VERSION : string[10] = '1.1.2';
+
+resourcestring Sneed_dict     = 'need dictionary';
+               Sstream_end    = 'stream end';
+               Sfile_error    = 'file error';
+               Sstream_error  = 'stream error';
+               Sdata_error    = 'data error';
+               Smem_error     = 'insufficient memory';
+               Sbuf_error     = 'buffer error';
+               Sversion_error = 'incompatible version';
+
+const
+  z_verbose : longint = 1;
+
+{$IFDEF ZLIB_DEBUG}
+procedure z_error (m : string);
+{$ENDIF}
+
+implementation
+
+function zError(err : integer) : string;
+
+begin
+  case err of
+    Z_VERSION_ERROR:
+      zerror:=Sversion_error;
+    Z_BUF_ERROR:
+      zerror:=Sbuf_error;
+    Z_MEM_ERROR:
+      zerror:=Smem_error;
+    Z_DATA_ERROR:
+      zerror:=Sdata_error;
+    Z_STREAM_ERROR:
+      zerror:=Sstream_error;
+    Z_ERRNO:
+      zerror:=Sfile_error;
+    Z_OK:
+      zerror:='';
+    Z_STREAM_END:
+      zerror:=Sstream_end;
+    Z_NEED_DICT:
+      zerror:=Sneed_dict;
+    else
+      str(err,zerror);
+      zerror:='Unknown zlib error '+zerror;
+  end;
+end;
+
+function zlibVersion : string;
+begin
+  zlibVersion := ZLIB_VERSION;
+end;
+
+procedure z_error (m : string);
+begin
+  WriteLn(output, m);
+  Write('Zlib - Halt...');
+  ReadLn;
+  Halt(1);
+end;
+
+procedure Assert(cond : boolean; msg : string);
+begin
+  if not cond then
+    z_error(msg);
+end;
+
+procedure Trace(x : string);
+begin
+  WriteLn(x);
+end;
+
+procedure Tracev(x : string);
+begin
+ if (z_verbose>0) then
+   WriteLn(x);
+end;
+
+procedure Tracevv(x : string);
+begin
+  if (z_verbose>1) then
+    WriteLn(x);
+end;
+
+procedure Tracevvv(x : string);
+begin
+  if (z_verbose>2) then
+    WriteLn(x);
+end;
+
+procedure Tracec(c : boolean; x : string);
+begin
+  if (z_verbose>0) and (c) then
+    WriteLn(x);
+end;
+
+procedure Tracecv(c : boolean; x : string);
+begin
+  if (z_verbose>1) and c then
+    WriteLn(x);
+end;
+
+end.

+ 118 - 0
src/libraries/paszlib/paszlib_zcompres.pas

@@ -0,0 +1,118 @@
+Unit paszlib_ZCompres;
+
+{ compress.c -- compress a memory buffer
+  Copyright (C) 1995-1998 Jean-loup Gailly.
+
+  Pascal tranlastion
+  Copyright (C) 1998 by Jacques Nomssi Nzali
+  For conditions of distribution and use, see copyright notice in readme.txt
+}
+
+interface
+
+{$I paszlib_zconf.inc}
+
+uses
+  paszlib_zbase, paszlib_zdeflate;
+
+                        { utility functions }
+
+{EXPORT}
+function compress (dest : Pbyte;
+                   var destLen : cardinal;
+                   const source : array of Byte;
+                   sourceLen : cardinal) : integer;
+
+ { Compresses the source buffer into the destination buffer.  sourceLen is
+   the byte length of the source buffer. Upon entry, destLen is the total
+   size of the destination buffer, which must be at least 0.1% larger than
+   sourceLen plus 12 bytes. Upon exit, destLen is the actual size of the
+   compressed buffer.
+     This function can be used to compress a whole file at once if the
+   input file is mmap'ed.
+     compress returns Z_OK if success, Z_MEM_ERROR if there was not
+   enough memory, Z_BUF_ERROR if there was not enough room in the output
+   buffer. }
+
+{EXPORT}
+function compress2 (dest : Pbyte;
+                    var destLen : cardinal;
+                    const source : array of byte;
+                    sourceLen : cardinal;
+                    level : integer) : integer;
+{  Compresses the source buffer into the destination buffer. The level
+   parameter has the same meaning as in deflateInit.  sourceLen is the byte
+   length of the source buffer. Upon entry, destLen is the total size of the
+   destination buffer, which must be at least 0.1% larger than sourceLen plus
+   12 bytes. Upon exit, destLen is the actual size of the compressed buffer.
+
+   compress2 returns Z_OK if success, Z_MEM_ERROR if there was not enough
+   memory, Z_BUF_ERROR if there was not enough room in the output buffer,
+   Z_STREAM_ERROR if the level parameter is invalid. }
+
+implementation
+
+{ ===========================================================================
+}
+function compress2 (dest : Pbyte;
+                    var destLen : cardinal;
+                    const source : array of byte;
+                    sourceLen : cardinal;
+                    level : integer) : integer;
+var
+  stream : z_stream;
+  err : integer;
+begin
+  stream.next_in := Pbyte(@source);
+  stream.avail_in := cardinal(sourceLen);
+{$ifdef MAXSEG_64K}
+  { Check for source > 64K on 16-bit machine: }
+  if (cardinal(stream.avail_in) <> sourceLen) then
+  begin
+    compress2 := Z_BUF_ERROR;
+    exit;
+  end;
+{$endif}
+  stream.next_out := dest;
+  stream.avail_out := cardinal(destLen);
+  if (cardinal(stream.avail_out) <> destLen) then
+  begin
+    compress2 := Z_BUF_ERROR;
+    exit;
+  end;
+
+  err := deflateInit(stream, level);
+  if (err <> Z_OK) then
+  begin
+    compress2 := err;
+    exit;
+  end;
+
+  err := deflate(stream, Z_FINISH);
+  if (err <> Z_STREAM_END) then
+  begin
+    deflateEnd(stream);
+    if err = Z_OK then
+      compress2 := Z_BUF_ERROR
+    else
+      compress2 := err;
+    exit;
+  end;
+  destLen := stream.total_out;
+
+  err := deflateEnd(stream);
+  compress2 := err;
+end;
+
+{ ===========================================================================
+ }
+function compress (dest : Pbyte;
+                   var destLen : cardinal;
+                   const source : array of Byte;
+                   sourceLen : cardinal) : integer;
+begin
+  compress := compress2(dest, destLen, source, sourceLen, Z_DEFAULT_COMPRESSION);
+end;
+
+
+end.

+ 38 - 0
src/libraries/paszlib/paszlib_zconf.inc

@@ -0,0 +1,38 @@
+{ -------------------------------------------------------------------- }
+
+{$DEFINE MAX_MATCH_IS_258}
+
+{ Compile with -DMAXSEG_64K if the alloc function cannot allocate more
+  than 64k bytes at a time (needed on systems with 16-bit int). }
+
+{- $DEFINE MAXSEG_64K}
+{$IFDEF VER70}
+  {$DEFINE TP}
+  {$DEFINE MAXSEG_64K}
+{$ENDIF}
+{$IFNDEF WIN32}
+  {$DEFINE UNALIGNED_OK}  { requires SizeOf(ush) = 2 ! }
+{$ENDIF}
+
+{$UNDEF DYNAMIC_CRC_TABLE}
+{$UNDEF FASTEST}
+{$define patch112}        { apply patch from the zlib home page }
+{ -------------------------------------------------------------------- }
+{$IFDEF WIN32}
+  {$DEFINE Delphi32}
+  {- $DEFINE Delphi5}  { keep compiler quiet }
+{$ENDIF}
+
+{$IFDEF DPMI}
+  {$DEFINE MSDOS}
+{$ENDIF}
+
+{$IFDEF FPC}
+ {$DEFINE Use32}
+ {$DEFINE pointer_arith}
+ {$UNDEF DPMI}
+ {$UNDEF MSDOS}
+ {$UNDEF UNALIGNED_OK}  { requires SizeOf(ush) = 2 ! }
+ {$UNDEF MAXSEG_64K}
+ {$UNDEF Delphi32}
+{$ENDIF}

+ 2117 - 0
src/libraries/paszlib/paszlib_zdeflate.pas

@@ -0,0 +1,2117 @@
+unit paszlib_ZDeflate;
+
+{$goto on}
+
+{ Orginal: deflate.h -- internal compression state
+           deflate.c -- compress data using the deflation algorithm
+  Copyright (C) 1995-1996 Jean-loup Gailly.
+
+  Pascal tranlastion
+  Copyright (C) 1998 by Jacques Nomssi Nzali
+  For conditions of distribution and use, see copyright notice in readme.txt
+}
+
+
+{  ALGORITHM
+
+       The "deflation" process depends on being able to identify portions
+       of the input text which are identical to earlier input (within a
+       sliding window trailing behind the input currently being processed).
+
+       The most straightforward technique turns out to be the fastest for
+       most input files: try all possible matches and select the longest.
+       The key feature of this algorithm is that insertions into the string
+       dictionary are very simple and thus fast, and deletions are avoided
+       completely. Insertions are performed at each input character, whereas
+       string matches are performed only when the previous match ends. So it
+       is preferable to spend more time in matches to allow very fast string
+       insertions and avoid deletions. The matching algorithm for small
+       strings is inspired from that of Rabin & Karp. A brute force approach
+       is used to find longer strings when a small match has been found.
+       A similar algorithm is used in comic (by Jan-Mark Wams) and freeze
+       (by Leonid Broukhis).
+          A previous version of this file used a more sophisticated algorithm
+       (by Fiala and Greene) which is guaranteed to run in linear amortized
+       time, but has a larger average cost, uses more memory and is patented.
+       However the F&G algorithm may be faster for some highly redundant
+       files if the parameter max_chain_length (described below) is too large.
+
+   ACKNOWLEDGEMENTS
+
+       The idea of lazy evaluation of matches is due to Jan-Mark Wams, and
+       I found it in 'freeze' written by Leonid Broukhis.
+       Thanks to many people for bug reports and testing.
+
+   REFERENCES
+
+       Deutsch, L.P.,"'Deflate' Compressed Data Format Specification".
+       Available in ftp.uu.net:/pub/archiving/zip/doc/deflate-1.1.doc
+
+       A description of the Rabin and Karp algorithm is given in the book
+          "Algorithms" by R. Sedgewick, Addison-Wesley, p252.
+
+       Fiala,E.R., and Greene,D.H.
+          Data Compression with Finite Windows, Comm.ACM, 32,4 (1989) 490-595}
+
+{ $Id: deflate.c,v 1.14 1996/07/02 12:40:55 me Exp $ }
+
+interface
+
+{$I paszlib_zconf.inc}
+
+uses
+ paszlib_zbase;
+
+
+function deflateInit_(strm : z_streamp;
+                      level : integer;
+                      const version : string;
+                      stream_size : integer) : integer;
+
+
+function deflateInit (var strm : z_stream; level : integer) : integer;
+
+{  Initializes the internal stream state for compression.
+
+     The compression level must be Z_DEFAULT_COMPRESSION, or between 0 and 9:
+   1 gives best speed, 9 gives best compression, 0 gives no compression at
+   all (the input data is simply copied a block at a time).
+   Z_DEFAULT_COMPRESSION requests a default compromise between speed and
+   compression (currently equivalent to level 6).
+
+     deflateInit returns Z_OK if success, Z_MEM_ERROR if there was not
+   enough memory, Z_STREAM_ERROR if level is not a valid compression level,
+   Z_VERSION_ERROR if the zlib library version (zlib_version) is incompatible
+   with the version assumed by the caller (ZLIB_VERSION).
+   msg is set to null if there is no error message.  deflateInit does not
+   perform any compression: this will be done by deflate(). }
+
+
+{EXPORT}
+function deflate (var strm : z_stream; flush : integer) : integer;
+
+{ Performs one or both of the following actions:
+
+  - Compress more input starting at next_in and update next_in and avail_in
+    accordingly. If not all input can be processed (because there is not
+    enough room in the output buffer), next_in and avail_in are updated and
+    processing will resume at this point for the next call of deflate().
+
+  - Provide more output starting at next_out and update next_out and avail_out
+    accordingly. This action is forced if the parameter flush is non zero.
+    Forcing flush frequently degrades the compression ratio, so this parameter
+    should be set only when necessary (in interactive applications).
+    Some output may be provided even if flush is not set.
+
+  Before the call of deflate(), the application should ensure that at least
+  one of the actions is possible, by providing more input and/or consuming
+  more output, and updating avail_in or avail_out accordingly; avail_out
+  should never be zero before the call. The application can consume the
+  compressed output when it wants, for example when the output buffer is full
+  (avail_out == 0), or after each call of deflate(). If deflate returns Z_OK
+  and with zero avail_out, it must be called again after making room in the
+  output buffer because there might be more output pending.
+
+    If the parameter flush is set to Z_PARTIAL_FLUSH, the current compression
+  block is terminated and flushed to the output buffer so that the
+  decompressor can get all input data available so far. For method 9, a future
+  variant on method 8, the current block will be flushed but not terminated.
+  Z_SYNC_FLUSH has the same effect as partial flush except that the compressed
+  output is byte aligned (the compressor can clear its internal bit buffer)
+  and the current block is always terminated; this can be useful if the
+  compressor has to be restarted from scratch after an interruption (in which
+  case the internal state of the compressor may be lost).
+    If flush is set to Z_FULL_FLUSH, the compression block is terminated, a
+  special marker is output and the compression dictionary is discarded; this
+  is useful to allow the decompressor to synchronize if one compressed block
+  has been damaged (see inflateSync below).  Flushing degrades compression and
+  so should be used only when necessary.  Using Z_FULL_FLUSH too often can
+  seriously degrade the compression. If deflate returns with avail_out == 0,
+  this function must be called again with the same value of the flush
+  parameter and more output space (updated avail_out), until the flush is
+  complete (deflate returns with non-zero avail_out).
+
+    If the parameter flush is set to Z_FINISH, all pending input is processed,
+  all pending output is flushed and deflate returns with Z_STREAM_END if there
+  was enough output space; if deflate returns with Z_OK, this function must be
+  called again with Z_FINISH and more output space (updated avail_out) but no
+  more input data, until it returns with Z_STREAM_END or an error. After
+  deflate has returned Z_STREAM_END, the only possible operations on the
+  stream are deflateReset or deflateEnd.
+
+    Z_FINISH can be used immediately after deflateInit if all the compression
+  is to be done in a single step. In this case, avail_out must be at least
+  0.1% larger than avail_in plus 12 bytes.  If deflate does not return
+  Z_STREAM_END, then it must be called again as described above.
+
+    deflate() may update data_type if it can make a good guess about
+  the input data type (Z_ASCII or Z_BINARY). In doubt, the data is considered
+  binary. This field is only for information purposes and does not affect
+  the compression algorithm in any manner.
+
+    deflate() returns Z_OK if some progress has been made (more input
+  processed or more output produced), Z_STREAM_END if all input has been
+  consumed and all output has been produced (only when flush is set to
+  Z_FINISH), Z_STREAM_ERROR if the stream state was inconsistent (for example
+  if next_in or next_out was NULL), Z_BUF_ERROR if no progress is possible. }
+
+
+function deflateEnd (var strm : z_stream) : integer;
+
+{     All dynamically allocated data structures for this stream are freed.
+   This function discards any unprocessed input and does not flush any
+   pending output.
+
+     deflateEnd returns Z_OK if success, Z_STREAM_ERROR if the
+   stream state was inconsistent, Z_DATA_ERROR if the stream was freed
+   prematurely (some input or output was discarded). In the error case,
+   msg may be set but then points to a static string (which must not be
+   deallocated). }
+
+
+
+
+                        { Advanced functions }
+
+{ The following functions are needed only in some special applications. }
+
+
+{EXPORT}
+function deflateInit2 (var strm : z_stream;
+                       level : integer;
+                       method : integer;
+                       windowBits : integer;
+                       memLevel : integer;
+                       strategy : integer) : integer;
+function deflateInit2_(var strm : z_stream;
+                       level : integer;
+                       method : integer;
+                       windowBits : integer;
+                       memLevel : integer;
+                       strategy : integer;
+                       const version : string;
+                       stream_size : integer) : integer;
+
+{  This is another version of deflateInit with more compression options. The
+   fields next_in, and opaque must be initialized before by
+   the caller.
+
+     The method parameter is the compression method. It must be Z_DEFLATED in
+   this version of the library. (Method 9 will allow a 64K history buffer and
+   partial block flushes.)
+
+     The windowBits parameter is the base two logarithm of the window size
+   (the size of the history buffer).  It should be in the range 8..15 for this
+   version of the library (the value 16 will be allowed for method 9). Larger
+   values of this parameter result in better compression at the expense of
+   memory usage. The default value is 15 if deflateInit is used instead.
+
+     The memLevel parameter specifies how much memory should be allocated
+   for the internal compression state. memLevel=1 uses minimum memory but
+   is slow and reduces compression ratio; memLevel=9 uses maximum memory
+   for optimal speed. The default value is 8. See zconf.h for total memory
+   usage as a function of windowBits and memLevel.
+
+     The strategy parameter is used to tune the compression algorithm. Use the
+   value Z_DEFAULT_STRATEGY for normal data, Z_FILTERED for data produced by a
+   filter (or predictor), or Z_HUFFMAN_ONLY to force Huffman encoding only (no
+   string match).  Filtered data consists mostly of small values with a
+   somewhat random distribution. In this case, the compression algorithm is
+   tuned to compress them better. The effect of Z_FILTERED is to force more
+   Huffman coding and less string matching; it is somewhat intermediate
+   between Z_DEFAULT and Z_HUFFMAN_ONLY. The strategy parameter only affects
+   the compression ratio but not the correctness of the compressed output even
+   if it is not set appropriately.
+
+     If next_in is not null, the library will use this buffer to hold also
+   some history information; the buffer must either hold the entire input
+   data, or have at least 1<<(windowBits+1) bytes and be writable. If next_in
+   is null, the library will allocate its own history buffer (and leave next_in
+   null). next_out need not be provided here but must be provided by the
+   application for the next call of deflate().
+
+     If the history buffer is provided by the application, next_in must
+   must never be changed by the application since the compressor maintains
+   information inside this buffer from call to call; the application
+   must provide more input only by increasing avail_in. next_in is always
+   reset by the library in this case.
+
+      deflateInit2 returns Z_OK if success, Z_MEM_ERROR if there was
+   not enough memory, Z_STREAM_ERROR if a parameter is invalid (such as
+   an invalid method). msg is set to null if there is no error message.
+   deflateInit2 does not perform any compression: this will be done by
+   deflate(). }
+
+
+{EXPORT}
+function deflateSetDictionary (var strm : z_stream;
+                               dictionary : Pbyte; {const bytes}
+			       dictLength : cardinal) : integer;
+
+{    Initializes the compression dictionary (history buffer) from the given
+   byte sequence without producing any compressed output. This function must
+   be called immediately after deflateInit or deflateInit2, before any call
+   of deflate. The compressor and decompressor must use exactly the same
+   dictionary (see inflateSetDictionary).
+     The dictionary should consist of strings (byte sequences) that are likely
+   to be encountered later in the data to be compressed, with the most commonly
+   used strings preferably put towards the end of the dictionary. Using a
+   dictionary is most useful when the data to be compressed is short and
+   can be predicted with good accuracy; the data can then be compressed better
+   than with the default empty dictionary. In this version of the library,
+   only the last 32K bytes of the dictionary are used.
+     Upon return of this function, strm->adler is set to the Adler32 value
+   of the dictionary; the decompressor may later use this value to determine
+   which dictionary has been used by the compressor. (The Adler32 value
+   applies to the whole dictionary even if only a subset of the dictionary is
+   actually used by the compressor.)
+
+     deflateSetDictionary returns Z_OK if success, or Z_STREAM_ERROR if a
+   parameter is invalid (such as NULL dictionary) or the stream state
+   is inconsistent (for example if deflate has already been called for this
+   stream). deflateSetDictionary does not perform any compression: this will
+   be done by deflate(). }
+
+{EXPORT}
+function deflateCopy (dest : z_streamp;
+                      source : z_streamp) : integer;
+
+{  Sets the destination stream as a complete copy of the source stream.  If
+   the source stream is using an application-supplied history buffer, a new
+   buffer is allocated for the destination stream.  The compressed output
+   buffer is always application-supplied. It's the responsibility of the
+   application to provide the correct values of next_out and avail_out for the
+   next call of deflate.
+
+     This function can be useful when several compression strategies will be
+   tried, for example when there are several ways of pre-processing the input
+   data with a filter. The streams that will be discarded should then be freed
+   by calling deflateEnd.  Note that deflateCopy duplicates the internal
+   compression state which can be quite large, so this strategy is slow and
+   can consume lots of memory.
+
+     deflateCopy returns Z_OK if success, Z_MEM_ERROR if there was not
+   enough memory, Z_STREAM_ERROR if the source stream state was inconsistent
+   (such as getmem returns nil). msg is left unchanged in both source and
+   destination. }
+
+{EXPORT}
+function deflateReset (var strm : z_stream) : integer;
+
+{   This function is equivalent to deflateEnd followed by deflateInit,
+   but does not free and reallocate all the internal compression state.
+   The stream will keep the same compression level and any other attributes
+   that may have been set by deflateInit2.
+
+      deflateReset returns Z_OK if success, or Z_STREAM_ERROR if the source
+   stream state was inconsistent (such as getmem or state being NIL). }
+
+
+{EXPORT}
+function deflateParams (var strm : z_stream; level : integer; strategy : integer) : integer;
+
+{    Dynamically update the compression level and compression strategy.
+   This can be used to switch between compression and straight copy of
+   the input data, or to switch to a different kind of input data requiring
+   a different strategy. If the compression level is changed, the input
+   available so far is compressed with the old level (and may be flushed);
+   the new level will take effect only at the next call of deflate().
+
+     Before the call of deflateParams, the stream state must be set as for
+   a call of deflate(), since the currently available input may have to
+   be compressed and flushed. In particular, strm->avail_out must be non-zero.
+
+     deflateParams returns Z_OK if success, Z_STREAM_ERROR if the source
+   stream state was inconsistent or if a parameter was invalid, Z_BUF_ERROR
+   if strm->avail_out was zero. }
+
+
+const
+   deflate_copyright : string = ' deflate 1.1.2 Copyright 1995-1998 Jean-loup Gailly ';
+
+{ If you use the zlib library in a product, an acknowledgment is welcome
+  in the documentation of your product. If for some reason you cannot
+  include such an acknowledgment, I would appreciate that you keep this
+  copyright string in the executable of your product. }
+
+implementation
+
+uses
+  paszlib_trees, paszlib_adler;
+
+{  ===========================================================================
+   Function prototypes. }
+
+type
+   block_state = (
+    need_more,      { block not completed, need more input or more output }
+    block_done,     { block flush performed }
+    finish_started, { finish started, need only more output at next deflate }
+    finish_done);   { finish done, accept no more input or output }
+
+{ Compression function. Returns the block state after the call. }
+type
+  compress_func = function(var s : deflate_state; flush : integer) : block_state;
+
+{local}
+procedure fill_window(var s : deflate_state); forward;
+{local}
+function deflate_stored(var s : deflate_state; flush : integer) : block_state; far; forward;
+{local}
+function deflate_fast(var s : deflate_state; flush : integer) : block_state; far; forward;
+{local}
+function deflate_slow(var s : deflate_state; flush : integer) : block_state; far; forward;
+{local}
+procedure lm_init(var s : deflate_state); forward;
+
+{local}
+procedure putShortMSB(var s : deflate_state; b : cardinal); forward;
+{local}
+procedure  flush_pending (var strm : z_stream); forward;
+{local}
+function read_buf(strm : z_streamp;
+                  buf : Pbyte;
+                  size : cardinal) : cardinal; forward;
+{$ifdef ASMV}
+procedure match_init; { asm code initialization }
+function longest_match(var deflate_state; cur_match : IPos) : cardinal; forward;
+{$else}
+{local}
+function longest_match(var s : deflate_state; cur_match : IPos) : cardinal;
+  forward;
+{$endif}
+
+{$ifdef ZLIB_DEBUG}
+{local}
+procedure check_match(var s : deflate_state;
+                      start, match : IPos;
+                      length : integer); forward;
+{$endif}
+
+{  ==========================================================================
+  local data }
+
+const
+  ZNIL = 0;
+{ Tail of hash chains }
+
+const
+  TOO_FAR = 4096;
+{ Matches of length 3 are discarded if their distance exceeds TOO_FAR }
+
+const
+  MIN_LOOKAHEAD = (MAX_MATCH+MIN_MATCH+1);
+{ Minimum amount of lookahead, except at the end of the input file.
+  See deflate.c for comments about the MIN_MATCH+1. }
+
+{macro MAX_DIST(var s : deflate_state) : cardinal;
+begin
+  MAX_DIST := (s.w_size - MIN_LOOKAHEAD);
+end;
+  In order to simplify the code, particularly on 16 bit machines, match
+  distances are limited to MAX_DIST instead of WSIZE. }
+
+
+{ Values for max_lazy_match, good_match and max_chain_length, depending on
+  the desired pack level (0..9). The values given below have been tuned to
+  exclude worst case performance for pathological files. Better values may be
+  found for specific files. }
+
+type
+  config = record
+   good_length : word; { reduce lazy search above this match length }
+   max_lazy : word;    { do not perform lazy search above this match length }
+   nice_length : word; { quit search above this match length }
+   max_chain : word;
+   func : compress_func;
+  end;
+
+{local}
+const
+  configuration_table : array[0..10-1] of config = (
+{      good lazy nice chain }
+{0} (good_length:0;  max_lazy:0;   nice_length:0;   max_chain:0;    func:@deflate_stored),  { store only }
+{1} (good_length:4;  max_lazy:4;   nice_length:8;   max_chain:4;    func:@deflate_fast), { maximum speed, no lazy matches }
+{2} (good_length:4;  max_lazy:5;   nice_length:16;  max_chain:8;    func:@deflate_fast),
+{3} (good_length:4;  max_lazy:6;   nice_length:32;  max_chain:32;   func:@deflate_fast),
+
+{4} (good_length:4;  max_lazy:4;   nice_length:16;  max_chain:16;   func:@deflate_slow),  { lazy matches }
+{5} (good_length:8;  max_lazy:16;  nice_length:32;  max_chain:32;   func:@deflate_slow),
+{6} (good_length:8;  max_lazy:16;  nice_length:128; max_chain:128;  func:@deflate_slow),
+{7} (good_length:8;  max_lazy:32;  nice_length:128; max_chain:256;  func:@deflate_slow),
+{8} (good_length:32; max_lazy:128; nice_length:258; max_chain:1024; func:@deflate_slow),
+{9} (good_length:32; max_lazy:258; nice_length:258; max_chain:4096; func:@deflate_slow)); { maximum compression }
+
+{ Note: the deflate() code requires max_lazy >= MIN_MATCH and max_chain >= 4
+  For deflate_fast() (levels <= 3) good is ignored and lazy has a different
+  meaning. }
+
+const
+  EQUAL = 0;
+{ result of memcmp for equal strings }
+
+{ ==========================================================================
+  Update a hash value with the given input byte
+  IN  assertion: all calls to to UPDATE_HASH are made with consecutive
+     input characters, so that a running hash key can be computed from the
+     previous key instead of complete recalculation each time.
+
+macro UPDATE_HASH(s,h,c)
+   h := (( (h) shl s^.hash_shift) xor (c)) and s^.hash_mask;
+}
+
+{ ===========================================================================
+  Insert string str in the dictionary and set match_head to the previous head
+  of the hash chain (the most recent string with same hash key). Return
+  the previous length of the hash chain.
+  If this file is compiled with -DFASTEST, the compression level is forced
+  to 1, and no hash chains are maintained.
+  IN  assertion: all calls to to INSERT_STRING 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). }
+
+procedure INSERT_STRING(var s : deflate_state;
+                        str : cardinal;
+                        var match_head : IPos);
+begin
+{$ifdef FASTEST}
+   {UPDATE_HASH(s, s.ins_h, s.window[(str) + (MIN_MATCH-1)])}
+    s.ins_h := ((s.ins_h shl s.hash_shift) xor
+                 (s.window^[(str) + (MIN_MATCH-1)])) and s.hash_mask;
+    match_head := s.head[s.ins_h]
+    s.head[s.ins_h] := Pos(str);
+{$else}
+   {UPDATE_HASH(s, s.ins_h, s.window[(str) + (MIN_MATCH-1)])}
+    s.ins_h := ((s.ins_h shl s.hash_shift) xor
+                 (s.window^[(str) + (MIN_MATCH-1)])) and s.hash_mask;
+
+    match_head := s.head^[s.ins_h];
+    s.prev^[(str) and s.w_mask] := match_head;
+    s.head^[s.ins_h] := Pos(str);
+{$endif}
+end;
+
+{  =========================================================================
+  Initialize the hash table (avoiding 64K overflow for 16 bit systems).
+  prev[] will be initialized on the fly.
+
+macro CLEAR_HASH(s)
+    s^.head[s^.hash_size-1] := ZNIL;
+    zmemzero(Pbyte(s^.head), cardinal(s^.hash_size-1)*sizeof(s^.head^[0]));
+}
+
+{  ======================================================================== }
+
+function deflateInit2_(var strm : z_stream;
+                       level : integer;
+                       method : integer;
+                       windowBits : integer;
+                       memLevel : integer;
+                       strategy : integer;
+                       const version : string;
+                       stream_size : integer) : integer;
+var
+  s : deflate_state_ptr;
+  noheader : integer;
+
+  overlay : Pwordarray;
+  { We overlay pending_buf and d_buf+l_buf. This works since the average
+    output size for (length,distance) codes is <= 24 bits. }
+begin
+  noheader := 0;
+  if (version  =  '') or (version[1] <> ZLIB_VERSION[1]) or
+     (stream_size <> sizeof(z_stream)) then
+  begin
+    deflateInit2_ := Z_VERSION_ERROR;
+    exit;
+  end;
+  {
+  if strm=nil then
+  begin
+    deflateInit2_ := Z_STREAM_ERROR;
+    exit;
+  end;
+  }
+  { SetLength(strm.msg, 255); }
+  strm.msg := '';
+
+  if (level  =  Z_DEFAULT_COMPRESSION) then
+    level := 6;
+{$ifdef FASTEST}
+    level := 1;
+{$endif}
+
+  if (windowBits < 0) then { undocumented feature: suppress zlib header }
+  begin
+    noheader := 1;
+    windowBits := -windowBits;
+  end;
+  if (memLevel < 1) or (memLevel > MAX_MEM_LEVEL) or (method <> Z_DEFLATED)
+    or (windowBits < 8) or (windowBits > 15) or (level < 0)
+    or (level > 9) or (strategy < 0) or (strategy > Z_HUFFMAN_ONLY) then
+  begin
+    deflateInit2_ := Z_STREAM_ERROR;
+    exit;
+  end;
+
+  getmem(s,sizeof(deflate_state));
+  if (s = nil) then
+  begin
+    deflateInit2_ := Z_MEM_ERROR;
+    exit;
+  end;
+  strm.state := pInternal_state(s);
+  s^.strm := @strm;
+
+  s^.noheader := noheader;
+  s^.w_bits := windowBits;
+  s^.w_size := 1 shl s^.w_bits;
+  s^.w_mask := s^.w_size - 1;
+
+  s^.hash_bits := memLevel + 7;
+  s^.hash_size := 1 shl s^.hash_bits;
+  s^.hash_mask := s^.hash_size - 1;
+  s^.hash_shift :=  ((s^.hash_bits+MIN_MATCH-1) div MIN_MATCH);
+
+  getmem(s^.window,s^.w_size*2*sizeof(byte));
+  getmem(s^.prev,s^.w_size*sizeof(pos));
+  getmem(s^.head,s^.hash_size*sizeof(pos));
+
+  s^.lit_bufsize := 1 shl (memLevel + 6); { 16K elements by default }
+
+  getmem(overlay,s^.lit_bufsize*(sizeof(word)+2));
+  s^.pending_buf := Pbytearray(overlay);
+  s^.pending_buf_size := longint(s^.lit_bufsize) * (sizeof(word)+longint(2));
+
+  if (s^.window=nil) or (s^.prev=nil) or (s^.head=nil) or
+     (s^.pending_buf=nil) then
+  begin
+    {ERR_MSG(Z_MEM_ERROR);}
+    strm.msg := zerror(Z_MEM_ERROR);
+    deflateEnd (strm);
+    deflateInit2_ := Z_MEM_ERROR;
+    exit;
+  end;
+  s^.d_buf := Pwordarray( @overlay^[s^.lit_bufsize div sizeof(word)] );
+  s^.l_buf := Pbytearray( @s^.pending_buf^[(1+sizeof(word))*s^.lit_bufsize] );
+
+  s^.level := level;
+  s^.strategy := strategy;
+  s^.method := Byte(method);
+
+  deflateInit2_ := deflateReset(strm);
+end;
+
+{  ========================================================================= }
+
+function deflateInit2(var strm : z_stream;
+                      level : integer;
+                      method : integer;
+                      windowBits : integer;
+                      memLevel : integer;
+                      strategy : integer) : integer;
+{ a macro }
+begin
+  deflateInit2 := deflateInit2_(strm, level, method, windowBits,
+                   memLevel, strategy, ZLIB_VERSION, sizeof(z_stream));
+end;
+
+{  ========================================================================= }
+
+function deflateInit_(strm : z_streamp;
+                      level : integer;
+                      const version : string;
+                      stream_size : integer) : integer;
+begin
+  if strm=nil then
+    deflateInit_ := Z_STREAM_ERROR
+  else
+    deflateInit_ := deflateInit2_(strm^, level, Z_DEFLATED, MAX_WBITS,
+                   DEF_MEM_LEVEL, Z_DEFAULT_STRATEGY, version, stream_size);
+  { To do: ignore strm^.next_in if we use it as window }
+end;
+
+{  ========================================================================= }
+
+function deflateInit(var strm : z_stream; level : integer) : integer;
+{ deflateInit is a macro to allow checking the zlib version
+  and the compiler's view of z_stream: }
+begin
+  deflateInit := deflateInit2_(strm, level, Z_DEFLATED, MAX_WBITS,
+         DEF_MEM_LEVEL, Z_DEFAULT_STRATEGY, ZLIB_VERSION, sizeof(z_stream));
+end;
+
+{  ======================================================================== }
+function deflateSetDictionary (var strm : z_stream;
+                               dictionary : Pbyte;
+                               dictLength : cardinal) : integer;
+var
+  s : deflate_state_ptr;
+  length : cardinal;
+  n : cardinal;
+  hash_head : IPos;
+var
+  MAX_DIST : cardinal;  {macro}
+begin
+  length := dictLength;
+  hash_head := 0;
+
+  if {(@strm=nil) or}
+     (strm.state=nil) or (dictionary=nil)
+    or (deflate_state_ptr(strm.state)^.status<>INIT_STATE) then
+  begin
+    deflateSetDictionary := Z_STREAM_ERROR;
+    exit;
+  end;
+
+  s := deflate_state_ptr(strm.state);
+  strm.adler := adler32(strm.adler, dictionary, dictLength);
+
+  if (length < MIN_MATCH) then
+  begin
+    deflateSetDictionary := Z_OK;
+    exit;
+  end;
+  MAX_DIST := (s^.w_size - MIN_LOOKAHEAD);
+  if (length > MAX_DIST) then
+  begin
+    length := MAX_DIST;
+{$ifndef USE_DICT_HEAD}
+    inc(dictionary, dictLength - length);  { use the tail of the dictionary }
+{$endif}
+  end;
+
+  move(dictionary^,Pbyte(s^.window)^,length);
+  s^.strstart := length;
+  s^.block_start := longint(length);
+
+  { Insert all strings in the hash table (except for the last two bytes).
+    s^.lookahead stays null, so s^.ins_h will be recomputed at the next
+    call of fill_window. }
+
+  s^.ins_h := s^.window^[0];
+  {UPDATE_HASH(s, s^.ins_h, s^.window[1]);}
+  s^.ins_h := ((s^.ins_h shl s^.hash_shift) xor (s^.window^[1]))
+              and s^.hash_mask;
+
+  for n := 0 to length - MIN_MATCH do
+    INSERT_STRING(s^, n, hash_head);
+  {if (hash_head <> 0) then
+    hash_head := 0;  - to make compiler happy }
+  deflateSetDictionary := Z_OK;
+end;
+
+{  ======================================================================== }
+function deflateReset (var strm : z_stream) : integer;
+var
+  s : deflate_state_ptr;
+begin
+  if {(@strm=nil) or}
+   (strm.state=nil) then
+  begin
+    deflateReset := Z_STREAM_ERROR;
+    exit;
+  end;
+
+  strm.total_out := 0;
+  strm.total_in := 0;
+  strm.msg := '';      { use freemem if we ever allocate msg dynamically }
+  strm.data_type := Z_UNKNOWN;
+
+  s := deflate_state_ptr(strm.state);
+  s^.pending := 0;
+  s^.pending_out := Pbyte(s^.pending_buf);
+
+  if (s^.noheader < 0) then
+  begin
+    s^.noheader := 0; { was set to -1 by deflate(..., Z_FINISH); }
+  end;
+  if s^.noheader <> 0 then
+    s^.status := BUSY_STATE
+  else
+    s^.status := INIT_STATE;
+  strm.adler := 1;
+  s^.last_flush := Z_NO_FLUSH;
+
+  _tr_init(s^);
+  lm_init(s^);
+
+  deflateReset := Z_OK;
+end;
+
+{  ======================================================================== }
+function deflateParams(var strm : z_stream;
+                       level : integer;
+                       strategy : integer) : integer;
+var
+  s : deflate_state_ptr;
+  func : compress_func;
+  err : integer;
+begin
+  err := Z_OK;
+  if {(@strm=nil) or} (strm.state=nil) then
+  begin
+    deflateParams := Z_STREAM_ERROR;
+    exit;
+  end;
+
+  s := deflate_state_ptr(strm.state);
+
+  if (level = Z_DEFAULT_COMPRESSION) then
+  begin
+    level := 6;
+  end;
+  if (level < 0) or (level > 9) or (strategy < 0)
+  or (strategy > Z_HUFFMAN_ONLY) then
+  begin
+    deflateParams := Z_STREAM_ERROR;
+    exit;
+  end;
+  func := configuration_table[s^.level].func;
+
+  if (@func <> @configuration_table[level].func)
+    and (strm.total_in <> 0) then
+  begin
+      { Flush the last buffer: }
+      err := deflate(strm, Z_PARTIAL_FLUSH);
+  end;
+  if (s^.level <> level) then
+  begin
+    s^.level := level;
+    s^.max_lazy_match   := configuration_table[level].max_lazy;
+    s^.good_match       := configuration_table[level].good_length;
+    s^.nice_match       := configuration_table[level].nice_length;
+    s^.max_chain_length := configuration_table[level].max_chain;
+  end;
+  s^.strategy := strategy;
+  deflateParams := err;
+end;
+
+{ =========================================================================
+  Put a short in the pending buffer. The 16-bit value is put in MSB order.
+  IN assertion: the stream state is correct and there is enough room in
+  pending_buf. }
+
+{local}
+procedure putShortMSB (var s : deflate_state; b : cardinal);
+begin
+  s.pending_buf^[s.pending] := Byte(b shr 8);
+  inc(s.pending);
+  s.pending_buf^[s.pending] := Byte(b and $ff);
+  inc(s.pending);
+end;
+
+{ =========================================================================
+  Flush 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 strm^.next_out buffer and copying into it.
+  (See also read_buf()). }
+
+{local}
+procedure flush_pending(var strm : z_stream);
+var
+  len : cardinal;
+  s : deflate_state_ptr;
+begin
+  s := deflate_state_ptr(strm.state);
+  len := s^.pending;
+
+  if (len > strm.avail_out) then
+    len := strm.avail_out;
+  if (len = 0) then
+    exit;
+
+  move(s^.pending_out^,strm.next_out^,len);
+  inc(strm.next_out, len);
+  inc(s^.pending_out, len);
+  inc(strm.total_out, len);
+  dec(strm.avail_out, len);
+  dec(s^.pending, len);
+  if (s^.pending = 0) then
+  begin
+    s^.pending_out := Pbyte(s^.pending_buf);
+  end;
+end;
+
+{ ========================================================================= }
+function deflate (var strm : z_stream; flush : integer) : integer;
+var
+  old_flush : integer; { value of flush param for previous deflate call }
+  s : deflate_state_ptr;
+var
+  header : cardinal;
+  level_flags : cardinal;
+var
+  bstate : block_state;
+begin
+  if {(@strm=nil) or} (strm.state=nil)
+    or (flush > Z_FINISH) or (flush < 0) then
+  begin
+    deflate := Z_STREAM_ERROR;
+    exit;
+  end;
+  s := deflate_state_ptr(strm.state);
+
+  if (strm.next_out=nil) or
+     ((strm.next_in=nil) and (strm.avail_in<>0)) or
+     ((s^.status=FINISH_STATE) and (flush<>Z_FINISH)) then
+  begin
+    {ERR_RETURN(strm^, Z_STREAM_ERROR);}
+    strm.msg := zerror(Z_STREAM_ERROR);
+    deflate := Z_STREAM_ERROR;
+    exit;
+  end;
+  if (strm.avail_out = 0) then
+  begin
+    {ERR_RETURN(strm^, Z_BUF_ERROR);}
+    strm.msg := zerror(Z_BUF_ERROR);
+    deflate := Z_BUF_ERROR;
+    exit;
+  end;
+
+  s^.strm := @strm; { just in case }
+  old_flush := s^.last_flush;
+  s^.last_flush := flush;
+
+  { Write the zlib header }
+  if (s^.status = INIT_STATE) then
+  begin
+
+    header := (Z_DEFLATED + ((s^.w_bits-8) shl 4)) shl 8;
+    level_flags := (s^.level-1) shr 1;
+
+    if (level_flags > 3) then
+      level_flags := 3;
+    header := header or (level_flags shl 6);
+    if (s^.strstart <> 0) then
+      header := header or PRESET_DICT;
+    inc(header, 31 - (header mod 31));
+
+    s^.status := BUSY_STATE;
+    putShortMSB(s^, header);
+
+    { Save the adler32 of the preset dictionary: }
+    if (s^.strstart <> 0) then
+    begin
+      putShortMSB(s^, cardinal(strm.adler shr 16));
+      putShortMSB(s^, cardinal(strm.adler and $ffff));
+    end;
+    strm.adler := longint(1);
+  end;
+
+  { Flush as much pending output as possible }
+  if (s^.pending <> 0) then
+  begin
+    flush_pending(strm);
+    if (strm.avail_out = 0) then
+    begin
+      { Since avail_out is 0, deflate will be called again with
+	more output space, but possibly with both pending and
+	avail_in equal to zero. There won't be anything to do,
+	but this is not an error situation so make sure we
+	return OK instead of BUF_ERROR at next call of deflate: }
+
+      s^.last_flush := -1;
+      deflate := Z_OK;
+      exit;
+    end;
+
+  { Make sure there is something to do and avoid duplicate consecutive
+    flushes. For repeated and useless calls with Z_FINISH, we keep
+    returning Z_STREAM_END instead of Z_BUFF_ERROR. }
+
+  end
+  else
+    if (strm.avail_in = 0) and (flush <= old_flush)
+      and (flush <> Z_FINISH) then
+    begin
+      {ERR_RETURN(strm^, Z_BUF_ERROR);}
+      strm.msg := zerror(Z_BUF_ERROR);
+      deflate := Z_BUF_ERROR;
+      exit;
+    end;
+
+  { User must not provide more input after the first FINISH: }
+  if (s^.status = FINISH_STATE) and (strm.avail_in <> 0) then
+  begin
+    {ERR_RETURN(strm^, Z_BUF_ERROR);}
+    strm.msg := zerror(Z_BUF_ERROR);
+    deflate := Z_BUF_ERROR;
+    exit;
+  end;
+
+  { Start a new block or continue the current one. }
+  if (strm.avail_in <> 0) or (s^.lookahead <> 0)
+    or ((flush <> Z_NO_FLUSH) and (s^.status <> FINISH_STATE)) then
+  begin
+    bstate := configuration_table[s^.level].func(s^, flush);
+
+    if (bstate = finish_started) or (bstate = finish_done) then
+      s^.status := FINISH_STATE;
+
+    if (bstate = need_more) or (bstate = finish_started) then
+    begin
+      if (strm.avail_out = 0) then
+        s^.last_flush := -1; { avoid BUF_ERROR next call, see above }
+
+      deflate := Z_OK;
+      exit;
+      { If flush != Z_NO_FLUSH && avail_out == 0, the next call
+	of deflate should use the same flush parameter to make sure
+	that the flush is complete. So we don't have to output an
+	empty block here, this will be done at next call. This also
+	ensures that for a very small output buffer, we emit at most
+	 one empty block. }
+    end;
+    if (bstate = block_done) then
+    begin
+      if (flush = Z_PARTIAL_FLUSH) then
+        _tr_align(s^)
+      else
+      begin  { FULL_FLUSH or SYNC_FLUSH }
+        _tr_stored_block(s^, nil, 0, FALSE);
+        { For a full flush, this empty block will be recognized
+          as a special marker by inflate_sync(). }
+
+        if (flush = Z_FULL_FLUSH) then
+        begin
+          {macro CLEAR_HASH(s);}             { forget history }
+          s^.head^[s^.hash_size-1] := ZNIL;
+          fillchar(Pbyte(s^.head)^,cardinal(s^.hash_size-1)*sizeof(s^.head^[0]),0);
+        end;
+      end;
+
+      flush_pending(strm);
+      if (strm.avail_out = 0) then
+      begin
+        s^.last_flush := -1; { avoid BUF_ERROR at next call, see above }
+	deflate := Z_OK;
+        exit;
+      end;
+
+    end;
+  end;
+  {$IFDEF ZLIB_DEBUG}
+  Assert(strm.avail_out > 0, 'bug2');
+  {$ENDIF}
+  if (flush <> Z_FINISH) then
+  begin
+    deflate := Z_OK;
+    exit;
+  end;
+
+  if (s^.noheader <> 0) then
+  begin
+    deflate := Z_STREAM_END;
+    exit;
+  end;
+
+  { Write the zlib trailer (adler32) }
+  putShortMSB(s^, cardinal(strm.adler shr 16));
+  putShortMSB(s^, cardinal(strm.adler and $ffff));
+  flush_pending(strm);
+  { If avail_out is zero, the application will call deflate again
+    to flush the rest. }
+
+  s^.noheader := -1; { write the trailer only once! }
+  if s^.pending <> 0 then
+    deflate := Z_OK
+  else
+    deflate := Z_STREAM_END;
+end;
+
+{ ========================================================================= }
+function deflateEnd (var strm : z_stream) : integer;
+var
+  status : integer;
+  s : deflate_state_ptr;
+begin
+  if {(@strm=nil) or} (strm.state=nil) then
+  begin
+    deflateEnd := Z_STREAM_ERROR;
+    exit;
+  end;
+
+  s := deflate_state_ptr(strm.state);
+  status := s^.status;
+  if (status <> INIT_STATE) and (status <> BUSY_STATE) and
+     (status <> FINISH_STATE) then
+  begin
+    deflateEnd := Z_STREAM_ERROR;
+    exit;
+  end;
+
+  { Deallocate in reverse order of allocations: }
+  freemem(s^.pending_buf);
+  freemem(s^.head);
+  freemem(s^.prev);
+  freemem(s^.window);
+
+  freemem(s);
+  strm.state := nil;
+
+  if status = BUSY_STATE then
+    deflateEnd := Z_DATA_ERROR
+  else
+    deflateEnd := Z_OK;
+end;
+
+{ =========================================================================
+  Copy the source state to the destination state.
+  To simplify the source, this is not supported for 16-bit MSDOS (which
+  doesn't have enough memory anyway to duplicate compression states). }
+
+
+{ ========================================================================= }
+function deflateCopy (dest, source : z_streamp) : integer;
+{$ifndef MAXSEG_64K}
+var
+  ds : deflate_state_ptr;
+  ss : deflate_state_ptr;
+  overlay : Pwordarray;
+{$endif}
+begin
+{$ifdef MAXSEG_64K}
+  deflateCopy := Z_STREAM_ERROR;
+  exit;
+{$else}
+
+  if (source=nil) or (dest=nil) or (source^.state=nil) then
+  begin
+    deflateCopy := Z_STREAM_ERROR;
+    exit;
+  end;
+  ss := deflate_state_ptr(source^.state);
+  dest^ := source^;
+
+  getmem(ds,sizeof(deflate_state));
+  if ds=nil then
+  begin
+    deflateCopy := Z_MEM_ERROR;
+    exit;
+  end;
+  dest^.state := pInternal_state(ds);
+  ds^ := ss^;
+  ds^.strm := dest;
+
+  getmem(ds^.window,ds^.w_size*2*sizeof(byte));
+  getmem(ds^.prev,ds^.w_size*sizeof(pos));
+  getmem(ds^.head,ds^.hash_size*sizeof(pos));
+  getmem(overlay,ds^.lit_bufsize*(sizeof(word)+2));
+  ds^.pending_buf := Pbytearray ( overlay );
+
+  if (ds^.window=nil) or (ds^.prev=nil) or (ds^.head=nil)
+     or (ds^.pending_buf=nil) then
+  begin
+    deflateEnd (dest^);
+    deflateCopy := Z_MEM_ERROR;
+    exit;
+  end;
+
+  move(Pbyte(ss^.window)^,Pbyte(ds^.window)^,ds^.w_size * 2 * sizeof(byte));
+  move(Pbyte(ss^.prev)^,Pbyte(ds^.prev)^,ds^.w_size * sizeof(pos));
+  move(Pbyte(ss^.head)^,Pbyte(ds^.head)^,ds^.hash_size * sizeof(pos));
+  move(Pbyte(ss^.pending_buf)^,Pbyte(ds^.pending_buf)^,cardinal(ds^.pending_buf_size));
+
+  ds^.pending_out := @ds^.pending_buf^[ptruint(ss^.pending_out) - ptruint(ss^.pending_buf)];
+  ds^.d_buf := Pwordarray(@overlay^[ds^.lit_bufsize div sizeof(word)] );
+  ds^.l_buf := Pbytearray(@ds^.pending_buf^[(1+sizeof(word))*ds^.lit_bufsize]);
+
+  ds^.l_desc.dyn_tree := tree_ptr(@ds^.dyn_ltree);
+  ds^.d_desc.dyn_tree := tree_ptr(@ds^.dyn_dtree);
+  ds^.bl_desc.dyn_tree := tree_ptr(@ds^.bl_tree);
+
+  deflateCopy := Z_OK;
+{$endif}
+end;
+
+
+{ ===========================================================================
+  Read a new buffer from the current input stream, update 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 strm^.next_in buffer and copying from it.
+  (See also flush_pending()). }
+
+{local}
+function read_buf(strm:z_streamp;buf:Pbyte;size:cardinal):cardinal;
+
+var len:cardinal;
+
+begin
+  len:=strm^.avail_in;
+  if len>size then
+    len:=size;
+  dec(strm^.avail_in, len);
+
+  if len<>0 then
+    begin
+      if deflate_state_ptr(strm^.state)^.noheader=0 then
+        strm^.adler:=adler32(strm^.adler,strm^.next_in,len);
+      move(strm^.next_in^,buf^,len);
+      inc(strm^.next_in,len);
+      inc(strm^.total_in,len);
+    end;
+  read_buf:=len;
+end;
+
+{ ===========================================================================
+  Initialize the "longest match" routines for a new zlib stream }
+
+{local}
+procedure lm_init (var s : deflate_state);
+begin
+  s.window_size := longint( 2*s.w_size);
+
+  {macro CLEAR_HASH(s);}
+  s.head^[s.hash_size-1] := ZNIL;
+  fillchar(Pbyte(s.head)^, cardinal(s.hash_size-1)*sizeof(s.head^[0]),0);
+
+  { Set the default configuration parameters: }
+
+  s.max_lazy_match   := configuration_table[s.level].max_lazy;
+  s.good_match       := configuration_table[s.level].good_length;
+  s.nice_match       := configuration_table[s.level].nice_length;
+  s.max_chain_length := configuration_table[s.level].max_chain;
+
+  s.strstart := 0;
+  s.block_start := longint(0);
+  s.lookahead := 0;
+  s.prev_length := MIN_MATCH-1;
+  s.match_length := MIN_MATCH-1;
+  s.match_available := FALSE;
+  s.ins_h := 0;
+{$ifdef ASMV}
+  match_init; { initialize the asm code }
+{$endif}
+end;
+
+{ ===========================================================================
+  Set match_start to the longest match starting at the given string and
+  return its length. Matches shorter or equal to prev_length are discarded,
+  in which case the result is equal to prev_length and match_start is
+  garbage.
+  IN assertions: cur_match is the head of the hash chain for the current
+    string (strstart) and its distance is <= MAX_DIST, and prev_length >= 1
+  OUT assertion: the match length is not greater than s^.lookahead. }
+
+
+{$ifndef ASMV}
+{ For 80x86 and 680x0, an optimized version will be provided in match.asm or
+  match.S. The code will be functionally equivalent. }
+
+{$ifndef FASTEST}
+
+{local}
+function longest_match(var s : deflate_state;
+                       cur_match : IPos  { current match }
+                       ) : cardinal;
+label
+  nextstep;
+var
+  chain_length : cardinal;    { max hash chain length }
+  {register} scan : Pbyte;   { current string }
+  {register} match : Pbyte;  { matched string }
+  {register} len : integer;       { length of current match }
+  best_len : integer;             { best match length so far }
+  nice_match : integer;           { stop if match longint enough }
+  limit : IPos;
+
+  prev : pzPosfArray;
+  wmask : cardinal;
+{$ifdef UNALIGNED_OK}
+  {register} strend : Pbyte;
+  {register} scan_start : word;
+  {register} scan_end : word;
+{$else}
+  {register} strend : Pbyte;
+  {register} scan_end1 : Byte;
+  {register} scan_end : Byte;
+{$endif}
+var
+  MAX_DIST : cardinal;
+begin
+  chain_length := s.max_chain_length; { max hash chain length }
+  scan := @(s.window^[s.strstart]);
+  best_len := s.prev_length;              { best match length so far }
+  nice_match := s.nice_match;             { stop if match longint enough }
+
+
+  MAX_DIST := s.w_size - MIN_LOOKAHEAD;
+{In order to simplify the code, particularly on 16 bit machines, match
+distances are limited to MAX_DIST instead of WSIZE. }
+
+  if s.strstart > IPos(MAX_DIST) then
+    limit := s.strstart - IPos(MAX_DIST)
+  else
+    limit := ZNIL;
+  { Stop when cur_match becomes <= limit. To simplify the code,
+    we prevent matches with the string of window index 0. }
+
+  prev := s.prev;
+  wmask := s.w_mask;
+
+{$ifdef UNALIGNED_OK}
+  { Compare two bytes at a time. Note: this is not always beneficial.
+    Try with and without -DUNALIGNED_OK to check. }
+
+  strend := Pbyte(@(s.window^[s.strstart + MAX_MATCH - 1]));
+  scan_start := pushf(scan)^;
+  scan_end   := Pwordarray(scan)^[best_len-1];   { fix }
+{$else}
+  strend := Pbyte(@(s.window^[s.strstart + MAX_MATCH]));
+  {$push} {$R-}
+  scan_end1  := Pbytearray(scan)^[best_len-1];
+  {$pop}
+  scan_end   := Pbytearray(scan)^[best_len];
+{$endif}
+
+    { The code is optimized for HASH_BITS >= 8 and MAX_MATCH-2 multiple of 16.
+      It is easy to get rid of this optimization if necessary. }
+    {$IFDEF ZLIB_DEBUG}
+    Assert((s.hash_bits >= 8) and (MAX_MATCH = 258), 'Code too clever');
+    {$ENDIF}
+    { Do not waste too much time if we already have a good match: }
+    if (s.prev_length >= s.good_match) then
+    begin
+      chain_length := chain_length shr 2;
+    end;
+
+    { Do not look for matches beyond the end of the input. This is necessary
+      to make deflate deterministic. }
+
+    if (cardinal(nice_match) > s.lookahead) then
+      nice_match := s.lookahead;
+    {$IFDEF ZLIB_DEBUG}
+    Assert(longint(s.strstart) <= s.window_size-MIN_LOOKAHEAD, 'need lookahead');
+    {$ENDIF}
+    repeat
+        {$IFDEF ZLIB_DEBUG}
+        Assert(cur_match < s.strstart, 'no future');
+        {$ENDIF}
+        match := @(s.window^[cur_match]);
+
+        { Skip to next match if the match length cannot increase
+          or if the match length is less than 2: }
+
+{$undef DO_UNALIGNED_OK}
+{$ifdef UNALIGNED_OK}
+  {$ifdef MAX_MATCH_IS_258}
+    {$define DO_UNALIGNED_OK}
+  {$endif}
+{$endif}
+
+{$ifdef DO_UNALIGNED_OK}
+        { This code assumes sizeof(cardinal short) = 2. Do not use
+          UNALIGNED_OK if your compiler uses a different size. }
+  {$PUSH} {$R-}
+        if (match[best_len-1]<>scan_end) or
+           (match^ <> scan_start) then
+          goto nextstep; {continue;}
+  {$POP}
+
+        { 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 HASH_BITS >= 8. Compare 2 bytes at a time at
+          strstart+3, +5, ... up to strstart+257. We check for insufficient
+          lookahead only every 4th comparison; the 128th check will be made
+          at strstart+257. If MAX_MATCH-2 is not a multiple of 8, it is
+          necessary to put more guard bytes at the end of the window, or
+          to check more often for insufficient lookahead. }
+        {$IFDEF ZLIB_DEBUG}
+        Assert(pzByteArray(scan)^[2] = pzByteArray(match)^[2], 'scan[2]?');
+        {$ENDIF}
+        inc(scan);
+        inc(match);
+
+        repeat
+          inc(scan,2); inc(match,2); if scan^<>match^ then break;
+          inc(scan,2); inc(match,2); if scan^<>match^ then break;
+          inc(scan,2); inc(match,2); if scan^<>match^ then break;
+          inc(scan,2); inc(match,2); if scan^<>match^ then break;
+        until ptruint(scan)>=ptruint(strend);
+        { The funny "do while" generates better code on most compilers }
+
+        { Here, scan <= window+strstart+257 }
+        {$IFDEF ZLIB_DEBUG}
+        {$PUSH} {$R-}
+        Assert(ptruint(scan) <=
+               ptruint(@(s.window^[cardinal(s.window_size-1)])),
+               'wild scan');
+        {$POP}
+        {$ENDIF}
+        if scan^=match^ then
+          inc(scan);
+
+        len := (MAX_MATCH - 1) - integer(ptruint(strend)) + integer(ptruint(scan));
+        scan := strend;
+        dec(scan, (MAX_MATCH-1));
+
+{$else} { UNALIGNED_OK }
+
+  {$PUSH} {$R-}
+        if (Pbytearray(match)^[best_len]   <> scan_end) or
+           (Pbytearray(match)^[best_len-1] <> scan_end1) or
+           (match^ <> scan^) then
+          goto nextstep; {continue;}
+  {$POP}
+        inc(match);
+        if (match^ <> Pbytearray(scan)^[1]) then
+          goto nextstep; {continue;}
+
+        { The check at best_len-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 HASH_BITS >= 8. }
+
+        inc(scan, 2);
+        inc(match);
+        {$IFDEF ZLIB_DEBUG}
+        Assert( scan^ = match^, 'match[2]?');
+        {$ENDIF}
+        { We check for insufficient lookahead only every 8th comparison;
+          the 256th check will be made at strstart+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);
+
+        {$IFDEF ZLIB_DEBUG}
+        Assert(ptruint(scan) <=
+               ptruint(@(s.window^[cardinal(s.window_size-1)])),
+               'wild scan');
+        {$ENDIF}
+
+        len := MAX_MATCH - (ptruint(strend) - ptruint(scan));
+        scan := strend;
+        dec(scan, MAX_MATCH);
+
+{$endif} { UNALIGNED_OK }
+
+        if (len > best_len) then
+        begin
+            s.match_start := cur_match;
+            best_len := len;
+            if (len >= nice_match) then
+              break;
+{$push} {$R-}
+{$ifdef UNALIGNED_OK}
+            scan_end   := Pbytearray(scan)^[best_len-1];
+{$else}
+            scan_end1  := Pbytearray(scan)^[best_len-1];
+            scan_end   := Pbytearray(scan)^[best_len];
+{$endif}
+{$pop}
+        end;
+    nextstep:
+      cur_match := prev^[cur_match and wmask];
+      dec(chain_length);
+    until (cur_match <= limit) or (chain_length = 0);
+
+    if (cardinal(best_len) <= s.lookahead) then
+      longest_match := cardinal(best_len)
+    else
+      longest_match := s.lookahead;
+end;
+{$endif} { ASMV }
+
+{$else} { FASTEST }
+{ ---------------------------------------------------------------------------
+  Optimized version for level = 1 only }
+
+{local}
+function longest_match(var s : deflate_state;
+                       cur_match : IPos  { current match }
+                       ) : cardinal;
+var
+  {register} scan : Pbyte;   { current string }
+  {register} match : Pbyte;  { matched string }
+  {register} len : integer;       { length of current match }
+  {register} strend : Pbyte;
+begin
+  scan := @s.window^[s.strstart];
+  strend := @s.window^[s.strstart + MAX_MATCH];
+
+
+    { The code is optimized for HASH_BITS >= 8 and MAX_MATCH-2 multiple of 16.
+      It is easy to get rid of this optimization if necessary. }
+    {$IFDEF ZLIB_DEBUG}
+    Assert((s.hash_bits >= 8) and (MAX_MATCH = 258), 'Code too clever');
+
+    Assert(longint(s.strstart) <= s.window_size-MIN_LOOKAHEAD, 'need lookahead');
+
+    Assert(cur_match < s.strstart, 'no future');
+    {$ENDIF}
+    match := s.window + cur_match;
+
+    { Return failure if the match length is less than 2: }
+
+    if (match[0] <> scan[0]) or (match[1] <> scan[1]) then
+    begin
+      longest_match := MIN_MATCH-1;
+      exit;
+    end;
+
+    { The check at best_len-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 HASH_BITS >= 8. }
+
+    scan += 2, match += 2;
+    Assert(scan^ = match^, 'match[2]?');
+
+    { We check for insufficient lookahead only every 8th comparison;
+      the 256th check will be made at strstart+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));
+
+    Assert(scan <= s.window+cardinal(s.window_size-1), 'wild scan');
+
+    len := MAX_MATCH - integer(strend - scan);
+
+    if (len < MIN_MATCH) then
+    begin
+      return := MIN_MATCH - 1;
+      exit;
+    end;
+
+    s.match_start := cur_match;
+    if len <= s.lookahead then
+      longest_match := len
+    else
+      longest_match := s.lookahead;
+end;
+{$endif} { FASTEST }
+
+{$ifdef ZLIB_DEBUG}
+{ ===========================================================================
+  Check that the match at match_start is indeed a match. }
+
+{local}
+procedure check_match(var s : deflate_state;
+                      start, match : IPos;
+                      length : integer);
+begin
+  exit;
+  { check that the match is indeed a match }
+  if (zmemcmp(Pbyte(@s.window^[match]),
+              Pbyte(@s.window^[start]), length) <> EQUAL) then
+  begin
+    WriteLn(' start ',start,', match ',match ,' length ', length);
+    repeat
+      Write(char(s.window^[match]), char(s.window^[start]));
+      inc(match);
+      inc(start);
+      dec(length);
+    Until (length = 0);
+    z_error('invalid match');
+  end;
+  if (z_verbose > 1) then
+  begin
+    Write('\\[',start-match,',',length,']');
+    repeat
+       Write(char(s.window^[start]));
+       inc(start);
+       dec(length);
+    Until (length = 0);
+  end;
+end;
+{$endif}
+
+{ ===========================================================================
+  Fill the window when the lookahead becomes insufficient.
+  Updates strstart and lookahead.
+
+  IN assertion: lookahead < MIN_LOOKAHEAD
+  OUT assertions: strstart <= window_size-MIN_LOOKAHEAD
+     At least one byte has been read, or avail_in = 0; reads are
+     performed for at least two bytes (required for the zip translate_eol
+     option -- not supported here). }
+
+{local}
+procedure fill_window(var s : deflate_state);
+var
+  {register} n, m : cardinal;
+  {register} p : pPosf;
+  more : cardinal;    { Amount of free space at the end of the window. }
+  wsize : cardinal;
+begin
+   wsize := s.w_size;
+   repeat
+     more := cardinal(s.window_size -longint(s.lookahead) -longint(s.strstart));
+
+     { Deal with !@#$% 64K limit: }
+     if (more = 0) and (s.strstart = 0) and (s.lookahead = 0) then
+       more := wsize
+     else
+     if (more = cardinal(-1)) then
+     begin
+       { Very unlikely, but possible on 16 bit machine if strstart = 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.strstart >= wsize+ {MAX_DIST}(wsize-MIN_LOOKAHEAD)) then
+       begin
+         move(s.window^[wsize],Pbyte(s.window)^,wsize);
+         dec(s.match_start, wsize);
+         dec(s.strstart, wsize); { we now have strstart >= MAX_DIST }
+         dec(s.block_start, longint(wsize));
+
+         { 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.) }
+
+         n := s.hash_size;
+         p := @s.head^[n];
+         repeat
+           dec(p);
+           m := p^;
+           if (m >= wsize) then
+             p^ := Pos(m-wsize)
+           else
+             p^ := Pos(ZNIL);
+           dec(n);
+         Until (n=0);
+
+         n := wsize;
+{$ifndef FASTEST}
+         p := @s.prev^[n];
+         repeat
+           dec(p);
+           m := p^;
+           if (m >= wsize) then
+             p^ := Pos(m-wsize)
+           else
+             p^:= Pos(ZNIL);
+             { If n is not on any hash chain, prev^[n] is garbage but
+               its value will never be used. }
+           dec(n);
+         Until (n=0);
+{$endif}
+         inc(more, wsize);
+     end;
+     if (s.strm^.avail_in = 0) then
+       exit;
+
+     {* If there was no sliding:
+      *    strstart <= WSIZE+MAX_DIST-1 && lookahead <= MIN_LOOKAHEAD - 1 &&
+      *    more == window_size - lookahead - strstart
+      * => more >= window_size - (MIN_LOOKAHEAD-1 + WSIZE + MAX_DIST-1)
+      * => more >= window_size - 2*WSIZE + 2
+      * In the BIG_MEM or MMAP case (not yet supported),
+      *   window_size == input_size + MIN_LOOKAHEAD  &&
+      *   strstart + s->lookahead <= input_size => more >= MIN_LOOKAHEAD.
+      * Otherwise, window_size == 2*WSIZE so more >= 2.
+      * If there was sliding, more >= WSIZE. So in all cases, more >= 2. }
+
+     {$IFDEF ZLIB_DEBUG}
+     Assert(more >= 2, 'more < 2');
+     {$ENDIF}
+
+     n := read_buf(s.strm, Pbyte(@(s.window^[s.strstart + 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.ins_h := s.window^[s.strstart];
+       {UPDATE_HASH(s, s.ins_h, s.window[s.strstart+1]);}
+       s.ins_h := ((s.ins_h shl s.hash_shift) xor s.window^[s.strstart+1])
+                     and s.hash_mask;
+{$ifdef MIN_MATCH <> 3}
+       Call UPDATE_HASH() MIN_MATCH-3 more times
+{$endif}
+     end;
+     { If the whole input has less than MIN_MATCH bytes, ins_h is garbage,
+       but this is not important since only literal bytes will be emitted. }
+
+   until (s.lookahead >= MIN_LOOKAHEAD) or (s.strm^.avail_in = 0);
+end;
+
+{ ===========================================================================
+  Flush the current block, with given end-of-file flag.
+  IN assertion: strstart is set to the end of the current match. }
+
+procedure FLUSH_BLOCK_ONLY(var s : deflate_state; eof : boolean); {macro}
+begin
+  if (s.block_start >= 0) then
+    _tr_flush_block(s, Pbyte(@s.window^[s.block_start]),
+                    longint(longint(s.strstart) - s.block_start), eof)
+  else
+    _tr_flush_block(s, nil,
+                    longint(longint(s.strstart) - s.block_start), eof);
+
+  s.block_start := s.strstart;
+  flush_pending(s.strm^);
+  {$IFDEF ZLIB_DEBUG}
+  Tracev('[FLUSH]');
+  {$ENDIF}
+end;
+
+{ Same but force premature exit if necessary.
+macro FLUSH_BLOCK(var s : deflate_state; eof : boolean) : boolean;
+var
+  result : block_state;
+begin
+ FLUSH_BLOCK_ONLY(s, eof);
+ if (s.strm^.avail_out = 0) then
+ begin
+   if eof then
+     result := finish_started
+   else
+     result := need_more;
+   exit;
+ end;
+end;
+}
+
+{ ===========================================================================
+  Copy without compression as much as possible from the input stream, return
+  the current block state.
+  This function does not insert new strings in the dictionary since
+  uncompressible data is probably not useful. This function is used
+  only for the level=0 compression option.
+  NOTE: this function should be optimized to avoid extra copying from
+  window to pending_buf. }
+
+
+{local}
+function deflate_stored(var s : deflate_state; flush : integer) : block_state;
+{ Stored blocks are limited to 0xffff bytes, pending_buf is limited
+  to pending_buf_size, and each stored block has a 5 byte header: }
+var
+  max_block_size : longint;
+  max_start : longint;
+begin
+  max_block_size := $ffff;
+  if (max_block_size > s.pending_buf_size - 5) then
+    max_block_size := s.pending_buf_size - 5;
+
+  { Copy as much as possible from input to output: }
+  while TRUE do
+  begin
+    { Fill the window as much as possible: }
+    if (s.lookahead <= 1) then
+    begin
+      {$IFDEF ZLIB_DEBUG}
+      Assert( (s.strstart < s.w_size + {MAX_DIST}s.w_size-MIN_LOOKAHEAD) or
+              (s.block_start >= longint(s.w_size)), 'slide too late');
+      {$ENDIF}
+      fill_window(s);
+      if (s.lookahead = 0) and (flush = Z_NO_FLUSH) then
+      begin
+        deflate_stored := need_more;
+        exit;
+      end;
+
+      if (s.lookahead = 0) then
+        break; { flush the current block }
+    end;
+    {$IFDEF ZLIB_DEBUG}
+    Assert(s.block_start >= 0, 'block gone');
+    {$ENDIF}
+    inc(s.strstart, s.lookahead);
+    s.lookahead := 0;
+
+    { Emit a stored block if pending_buf will be full: }
+    max_start := s.block_start + max_block_size;
+    if (s.strstart = 0) or (longint(s.strstart) >= max_start) then
+    begin
+      { strstart = 0 is possible when wraparound on 16-bit machine }
+      s.lookahead := cardinal(s.strstart) - cardinal(max_start);
+      s.strstart := cardinal(max_start);
+      {FLUSH_BLOCK(s, FALSE);}
+      FLUSH_BLOCK_ONLY(s, FALSE);
+      if (s.strm^.avail_out = 0) then
+      begin
+        deflate_stored := need_more;
+        exit;
+      end;
+    end;
+
+    { Flush if we may have to slide, otherwise block_start may become
+      negative and the data will be gone: }
+
+    if (s.strstart - cardinal(s.block_start) >= {MAX_DIST}
+        s.w_size-MIN_LOOKAHEAD) then
+    begin
+      {FLUSH_BLOCK(s, FALSE);}
+      FLUSH_BLOCK_ONLY(s, FALSE);
+      if (s.strm^.avail_out = 0) then
+      begin
+        deflate_stored := need_more;
+        exit;
+      end;
+    end;
+  end;
+
+  {FLUSH_BLOCK(s, flush = Z_FINISH);}
+  FLUSH_BLOCK_ONLY(s, flush = Z_FINISH);
+  if (s.strm^.avail_out = 0) then
+  begin
+    if flush = Z_FINISH then
+      deflate_stored := finish_started
+    else
+      deflate_stored := need_more;
+    exit;
+  end;
+
+  if flush = Z_FINISH then
+    deflate_stored := finish_done
+  else
+    deflate_stored := block_done;
+end;
+
+{ ===========================================================================
+  Compress as much as possible from the input stream, return the current
+  block state.
+  This function does not perform lazy evaluation of matches and inserts
+  new strings in the dictionary only for unmatched strings or for short
+  matches. It is used only for the fast compression options. }
+
+{local}
+function deflate_fast(var s : deflate_state; flush : integer) : block_state;
+var
+  hash_head : IPos;     { head of the hash chain }
+  bflush : boolean;     { set if current block must be flushed }
+begin
+  hash_head := ZNIL;
+  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
+      fill_window(s);
+      if (s.lookahead < MIN_LOOKAHEAD) and (flush = Z_NO_FLUSH) then
+      begin
+        deflate_fast := need_more;
+        exit;
+      end;
+
+      if (s.lookahead = 0) then
+        break; { flush the current block }
+    end;
+
+
+    { Insert the string window[strstart .. strstart+2] in the
+      dictionary, and set hash_head to the head of the hash chain: }
+
+    if (s.lookahead >= MIN_MATCH) then
+      INSERT_STRING(s, s.strstart, hash_head);
+
+    { Find the longest match, discarding those <= prev_length.
+      At this point we have always match_length < MIN_MATCH }
+    if (hash_head <> ZNIL) and
+       (s.strstart - hash_head <= (s.w_size-MIN_LOOKAHEAD){MAX_DIST}) then
+    begin
+      { To simplify the code, we prevent matches with the string
+        of window index 0 (in particular we have to avoid a match
+        of the string with itself at the start of the input file). }
+      if (s.strategy <> Z_HUFFMAN_ONLY) then
+      begin
+        s.match_length := longest_match (s, hash_head);
+      end;
+      { longest_match() sets match_start }
+    end;
+    if (s.match_length >= MIN_MATCH) then
+    begin
+      {$IFDEF ZLIB_DEBUG}
+      check_match(s, s.strstart, s.match_start, s.match_length);
+      {$ENDIF}
+
+      {_tr_tally_dist(s, s.strstart - s.match_start,
+                        s.match_length - MIN_MATCH, bflush);}
+      bflush := _tr_tally(s, s.strstart - s.match_start,
+                        s.match_length - MIN_MATCH);
+
+      dec(s.lookahead, s.match_length);
+
+      { Insert new strings in the hash table only if the match length
+        is not too large. This saves time but degrades compression. }
+
+{$ifndef FASTEST}
+      if (s.match_length <= s.max_insert_length)
+       and (s.lookahead >= MIN_MATCH) then
+      begin
+        dec(s.match_length); { string at strstart already in hash table }
+        repeat
+          inc(s.strstart);
+          INSERT_STRING(s, s.strstart, hash_head);
+          { strstart never exceeds WSIZE-MAX_MATCH, so there are
+            always MIN_MATCH bytes ahead. }
+          dec(s.match_length);
+        until (s.match_length = 0);
+        inc(s.strstart);
+      end
+      else
+{$endif}
+
+      begin
+        inc(s.strstart, s.match_length);
+        s.match_length := 0;
+        s.ins_h := s.window^[s.strstart];
+        {UPDATE_HASH(s, s.ins_h, s.window[s.strstart+1]);}
+        s.ins_h := (( s.ins_h shl s.hash_shift) xor
+                     s.window^[s.strstart+1]) and s.hash_mask;
+if MIN_MATCH <> 3 then   { the linker removes this }
+begin
+          {Call UPDATE_HASH() MIN_MATCH-3 more times}
+end;
+
+        { If lookahead < MIN_MATCH, ins_h 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 }
+      {$IFDEF ZLIB_DEBUG}
+      Tracevv(char(s.window^[s.strstart]));
+      {$ENDIF}
+      {_tr_tally_lit (s, 0, s.window^[s.strstart], bflush);}
+      bflush := _tr_tally (s, 0, s.window^[s.strstart]);
+
+      dec(s.lookahead);
+      inc(s.strstart);
+    end;
+    if bflush then
+    begin  {FLUSH_BLOCK(s, FALSE);}
+      FLUSH_BLOCK_ONLY(s, FALSE);
+      if (s.strm^.avail_out = 0) then
+      begin
+        deflate_fast := need_more;
+        exit;
+      end;
+    end;
+  end;
+  {FLUSH_BLOCK(s, flush = Z_FINISH);}
+  FLUSH_BLOCK_ONLY(s, flush = Z_FINISH);
+  if (s.strm^.avail_out = 0) then
+  begin
+    if flush = Z_FINISH then
+      deflate_fast := finish_started
+    else
+      deflate_fast := need_more;
+    exit;
+  end;
+
+  if flush = Z_FINISH then
+    deflate_fast := finish_done
+  else
+    deflate_fast := block_done;
+end;
+
+{ ===========================================================================
+  Same as above, but achieves better compression. We use a lazy
+  evaluation for matches: a match is finally adopted only if there is
+  no better match at the next window position. }
+
+{local}
+function deflate_slow(var s : deflate_state; flush : integer) : block_state;
+var
+  hash_head : IPos;       { head of hash chain }
+  bflush : boolean;       { set if current block must be flushed }
+var
+  max_insert : cardinal;
+begin
+  hash_head := ZNIL;
+
+  { Process the input block. }
+  repeat
+    { 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
+        fill_window(s);
+        if (s.lookahead < MIN_LOOKAHEAD) and (flush = Z_NO_FLUSH) then
+          begin
+            deflate_slow := need_more;
+            exit;
+          end;
+
+        if s.lookahead=0 then
+          break; { flush the current block }
+      end;
+
+    { Insert the string window[strstart .. strstart+2] in the
+      dictionary, and set hash_head to the head of the hash chain: }
+
+    if (s.lookahead >= MIN_MATCH) then
+      INSERT_STRING(s, s.strstart, hash_head);
+
+    { Find the longest match, discarding those <= prev_length. }
+
+    s.prev_length := s.match_length;
+    s.prev_match := s.match_start;
+    s.match_length := MIN_MATCH-1;
+
+    if (hash_head <> ZNIL) and (s.prev_length < s.max_lazy_match) and
+       (s.strstart - hash_head <= {MAX_DIST}(s.w_size-MIN_LOOKAHEAD)) then
+      begin
+        { To simplify the code, we prevent matches with the string
+          of window index 0 (in particular we have to avoid a match
+          of the string with itself at the start of the input file). }
+
+        if (s.strategy <> Z_HUFFMAN_ONLY) then
+          s.match_length := longest_match (s, hash_head);
+        { longest_match() sets match_start }
+
+        if (s.match_length <= 5) and ((s.strategy = Z_FILTERED) or
+             ((s.match_length = MIN_MATCH) and
+              (s.strstart - s.match_start > TOO_FAR))) then
+          begin
+            { If prev_match is also MIN_MATCH, match_start is garbage
+              but we will ignore the current match anyway. }
+
+            s.match_length := MIN_MATCH-1;
+          end;
+      end;
+    { If there was a match at the previous step and the current
+      match is not better, output the previous match: }
+
+    if (s.prev_length>=MIN_MATCH) and (s.match_length<=s.prev_length) then
+      begin
+        max_insert := s.strstart + s.lookahead - MIN_MATCH;
+        { Do not insert strings in hash table beyond this. }
+        {$ifdef ZLIB_DEBUG}
+        check_match(s, s.strstart-1, s.prev_match, s.prev_length);
+        {$endif}
+
+        {_tr_tally_dist(s, s->strstart -1 - s->prev_match,
+  	                  s->prev_length - MIN_MATCH, bflush);}
+        bflush := _tr_tally(s, s.strstart -1 - s.prev_match,
+                             s.prev_length - MIN_MATCH);
+
+      { Insert in hash table all strings up to the end of the match.
+        strstart-1 and strstart are already inserted. If there is not
+        enough lookahead, the last two strings are not inserted in
+        the hash table. }
+
+{$ifdef ZLIB_DEBUG}
+        if s.lookahead<s.prev_length-1 then
+           runerror(255);
+{$endif}
+        dec(s.lookahead, s.prev_length-1);
+        dec(s.prev_length, 2);
+        repeat
+          inc(s.strstart);
+          if s.strstart<=max_insert then
+            INSERT_STRING(s, s.strstart, hash_head);
+          dec(s.prev_length);
+        until s.prev_length = 0;
+        s.match_available := false;
+        s.match_length := MIN_MATCH-1;
+        inc(s.strstart);
+
+        if bflush then  {FLUSH_BLOCK(s, FALSE);}
+          begin
+            FLUSH_BLOCK_ONLY(s,false);
+            if s.strm^.avail_out=0 then
+              begin
+                deflate_slow := need_more;
+                exit;
+              end;
+          end;
+      end
+    else
+      if s.match_available then
+        begin
+          { If there was no match at the previous position, output a
+            single literal. If there was a match but the current match
+            is longer, truncate the previous match to a single literal. }
+          {$IFDEF ZLIB_DEBUG}
+          Tracevv(char(s.window^[s.strstart-1]));
+          {$ENDIF}
+          bflush := _tr_tally (s, 0, s.window^[s.strstart-1]);
+
+          if bflush then
+            FLUSH_BLOCK_ONLY(s, FALSE);
+          inc(s.strstart);
+{$ifdef ZLIB_DEBUG}
+          if s.lookahead=0 then
+             runerror(255);
+{$endif}
+          dec(s.lookahead);
+          if (s.strm^.avail_out = 0) then
+            begin
+              deflate_slow := need_more;
+              exit;
+            end;
+        end
+      else
+        begin
+        { There is no previous match to compare with, wait for
+          the next step to decide. }
+
+          s.match_available := TRUE;
+          inc(s.strstart);
+{$ifdef ZLIB_DEBUG}
+          if s.lookahead=0 then
+             runerror(255);
+{$endif}
+          dec(s.lookahead);
+        end;
+  until false;
+
+  {$IFDEF ZLIB_DEBUG}
+  Assert (flush <> Z_NO_FLUSH, 'no flush?');
+  {$ENDIF}
+  if (s.match_available) then
+  begin
+    {$IFDEF ZLIB_DEBUG}
+    Tracevv(char(s.window^[s.strstart-1]));
+    bflush :=
+    {$ENDIF}
+      _tr_tally (s, 0, s.window^[s.strstart-1]);
+    s.match_available := FALSE;
+  end;
+  {FLUSH_BLOCK(s, flush = Z_FINISH);}
+  FLUSH_BLOCK_ONLY(s, flush = Z_FINISH);
+  if (s.strm^.avail_out = 0) then
+  begin
+    if flush = Z_FINISH then
+      deflate_slow := finish_started
+    else
+      deflate_slow := need_more;
+    exit;
+  end;
+  if flush = Z_FINISH then
+    deflate_slow := finish_done
+  else
+    deflate_slow := block_done;
+end;
+
+end.

+ 730 - 0
src/libraries/paszlib/paszlib_zinflate.pas

@@ -0,0 +1,730 @@
+unit  paszlib_ZInflate;
+
+{  inflate.c -- zlib interface to inflate modules
+   Copyright (C) 1995-1998 Mark Adler
+
+  Pascal translation
+  Copyright (C) 1998 by Jacques Nomssi Nzali
+  For conditions of distribution and use, see copyright notice in readme.txt
+}
+
+interface
+
+{$I paszlib_zconf.inc}
+
+uses
+  paszlib_zbase, paszlib_infblock, paszlib_infutil;
+
+function inflateInit(var z : z_stream) : integer;
+
+{    Initializes the internal stream state for decompression.
+
+     inflateInit returns Z_OK if success, Z_MEM_ERROR if there was not
+   enough memory, Z_VERSION_ERROR if the zlib library version is incompatible
+   with the version assumed by the caller.  msg is set to null if there is no
+   error message. inflateInit does not perform any decompression: this will be
+   done by inflate(). }
+
+
+
+function inflateInit_(z : z_streamp;
+                      const version : string;
+                      stream_size : integer) : integer;
+
+
+function inflateInit2_(var z: z_stream;
+                       w : integer;
+                       const version : string;
+                       stream_size : integer) : integer;
+
+function inflateInit2(var z: z_stream;
+                       windowBits : integer) : integer;
+
+{
+     This is another version of inflateInit with an extra parameter.
+
+     The windowBits parameter is the base two logarithm of the maximum window
+   size (the size of the history buffer).  It should be in the range 8..15 for
+   this version of the library. The default value is 15 if inflateInit is used
+   instead. If a compressed stream with a larger window size is given as
+   input, inflate() will return with the error code Z_DATA_ERROR instead of
+   trying to allocate a larger window.
+
+      inflateInit2 returns Z_OK if success, Z_MEM_ERROR if there was not enough
+   memory, Z_STREAM_ERROR if a parameter is invalid (such as a negative
+   memLevel). msg is set to null if there is no error message.  inflateInit2
+   does not perform any decompression apart from reading the zlib header if
+   present: this will be done by inflate(). (So next_in and avail_in may be
+   modified, but next_out and avail_out are unchanged.)
+}
+
+
+
+function inflateEnd(var z : z_stream) : integer;
+
+{
+   All dynamically allocated data structures for this stream are freed.
+   This function discards any unprocessed input and does not flush any
+   pending output.
+
+     inflateEnd returns Z_OK if success, Z_STREAM_ERROR if the stream state
+   was inconsistent. In the error case, msg may be set but then points to a
+   static string (which must not be deallocated).
+}
+
+function inflateReset(var z : z_stream) : integer;
+
+{
+   This function is equivalent to inflateEnd followed by inflateInit,
+   but does not free and reallocate all the internal decompression state.
+   The stream will keep attributes that may have been set by inflateInit2.
+
+      inflateReset returns Z_OK if success, or Z_STREAM_ERROR if the source
+   stream state was inconsistent (such as getmem or state being NULL).
+}
+
+
+function inflate(var z : z_stream;
+                 f : integer) : integer;
+{
+  inflate decompresses as much data as possible, and stops when the input
+  buffer becomes empty or the output buffer becomes full. It may introduce
+  some output latency (reading input without producing any output)
+  except when forced to flush.
+
+  The detailed semantics are as follows. inflate performs one or both of the
+  following actions:
+
+  - Decompress more input starting at next_in and update next_in and avail_in
+    accordingly. If not all input can be processed (because there is not
+    enough room in the output buffer), next_in is updated and processing
+    will resume at this point for the next call of inflate().
+
+  - Provide more output starting at next_out and update next_out and avail_out
+    accordingly.  inflate() provides as much output as possible, until there
+    is no more input data or no more space in the output buffer (see below
+    about the flush parameter).
+
+  Before the call of inflate(), the application should ensure that at least
+  one of the actions is possible, by providing more input and/or consuming
+  more output, and updating the next_* and avail_* values accordingly.
+  The application can consume the uncompressed output when it wants, for
+  example when the output buffer is full (avail_out == 0), or after each
+  call of inflate(). If inflate returns Z_OK and with zero avail_out, it
+  must be called again after making room in the output buffer because there
+  might be more output pending.
+
+    If the parameter flush is set to Z_SYNC_FLUSH, inflate flushes as much
+  output as possible to the output buffer. The flushing behavior of inflate is
+  not specified for values of the flush parameter other than Z_SYNC_FLUSH
+  and Z_FINISH, but the current implementation actually flushes as much output
+  as possible anyway.
+
+    inflate() should normally be called until it returns Z_STREAM_END or an
+  error. However if all decompression is to be performed in a single step
+  (a single call of inflate), the parameter flush should be set to
+  Z_FINISH. In this case all pending input is processed and all pending
+  output is flushed; avail_out must be large enough to hold all the
+  uncompressed data. (The size of the uncompressed data may have been saved
+  by the compressor for this purpose.) The next operation on this stream must
+  be inflateEnd to deallocate the decompression state. The use of Z_FINISH
+  is never required, but can be used to inform inflate that a faster routine
+  may be used for the single inflate() call.
+
+     If a preset dictionary is needed at this point (see inflateSetDictionary
+  below), inflate sets strm-adler to the adler32 checksum of the
+  dictionary chosen by the compressor and returns Z_NEED_DICT; otherwise 
+  it sets strm->adler to the adler32 checksum of all output produced
+  so far (that is, total_out bytes) and returns Z_OK, Z_STREAM_END or
+  an error code as described below. At the end of the stream, inflate()
+  checks that its computed adler32 checksum is equal to that saved by the
+  compressor and returns Z_STREAM_END only if the checksum is correct.
+
+    inflate() returns Z_OK if some progress has been made (more input processed
+  or more output produced), Z_STREAM_END if the end of the compressed data has
+  been reached and all uncompressed output has been produced, Z_NEED_DICT if a
+  preset dictionary is needed at this point, Z_DATA_ERROR if the input data was
+  corrupted (input stream not conforming to the zlib format or incorrect
+  adler32 checksum), Z_STREAM_ERROR if the stream structure was inconsistent
+  (for example if next_in or next_out was NULL), Z_MEM_ERROR if there was not
+  enough memory, Z_BUF_ERROR if no progress is possible or if there was not
+  enough room in the output buffer when Z_FINISH is used. In the Z_DATA_ERROR
+  case, the application may then call inflateSync to look for a good
+  compression block.
+}
+
+
+function inflateSetDictionary(var z : z_stream;
+                              dictionary : Pbyte; {const array of byte}
+                              dictLength : cardinal) : integer;
+
+{
+     Initializes the decompression dictionary from the given uncompressed byte
+   sequence. This function must be called immediately after a call of inflate
+   if this call returned Z_NEED_DICT. The dictionary chosen by the compressor
+   can be determined from the Adler32 value returned by this call of
+   inflate. The compressor and decompressor must use exactly the same
+   dictionary (see deflateSetDictionary).
+
+     inflateSetDictionary returns Z_OK if success, Z_STREAM_ERROR if a
+   parameter is invalid (such as NULL dictionary) or the stream state is
+   inconsistent, Z_DATA_ERROR if the given dictionary doesn't match the
+   expected one (incorrect Adler32 value). inflateSetDictionary does not
+   perform any decompression: this will be done by subsequent calls of
+   inflate().
+}
+
+function inflateSync(var z : z_stream) : integer;
+
+{
+  Skips invalid compressed data until a full flush point (see above the
+  description of deflate with Z_FULL_FLUSH) can be found, or until all
+  available input is skipped. No output is provided.
+
+    inflateSync returns Z_OK if a full flush point has been found, Z_BUF_ERROR
+  if no more input was provided, Z_DATA_ERROR if no flush point has been found,
+  or Z_STREAM_ERROR if the stream structure was inconsistent. In the success
+  case, the application may save the current current value of total_in which
+  indicates where valid compressed data was found. In the error case, the
+  application may repeatedly call inflateSync, providing more input each time,
+  until success or end of the input data.
+}
+
+
+function inflateSyncPoint(var z : z_stream) : integer;
+
+
+implementation
+
+uses
+  paszlib_adler;
+
+function inflateReset(var z : z_stream) : integer;
+begin
+  if z.state=nil then
+  begin
+    inflateReset :=  Z_STREAM_ERROR;
+    exit;
+  end;
+  z.total_out := 0;
+  z.total_in := 0;
+  z.msg := '';
+  if z.state^.nowrap then
+    z.state^.mode := BLOCKS
+  else
+    z.state^.mode := METHOD;
+  inflate_blocks_reset(z.state^.blocks^, z, nil);
+  {$IFDEF ZLIB_DEBUG}
+  Tracev('inflate: reset');
+  {$ENDIF}
+  inflateReset :=  Z_OK;
+end;
+
+
+function inflateEnd(var z : z_stream) : integer;
+begin
+  if z.state=nil then
+  begin
+    inflateEnd :=  Z_STREAM_ERROR;
+    exit;
+  end;
+  if z.state^.blocks<>nil then
+    inflate_blocks_free(z.state^.blocks, z);
+  dispose(z.state);
+  z.state := nil;
+  {$IFDEF ZLIB_DEBUG}
+  Tracev('inflate: end');
+  {$ENDIF}
+  inflateEnd :=  Z_OK;
+end;
+
+
+function inflateInit2_(var z: z_stream;
+                       w : integer;
+                       const version : string;
+                       stream_size : integer) : integer;
+begin
+  if (version = '') or (version[1] <> ZLIB_VERSION[1]) or
+      (stream_size <> sizeof(z_stream)) then
+  begin
+    inflateInit2_ := Z_VERSION_ERROR;
+    exit;
+  end;
+  { initialize state }
+  { SetLength(strm.msg, 255); }
+  z.msg := '';
+
+  new(z.state);
+  if z.state=nil then
+  begin
+    inflateInit2_ := Z_MEM_ERROR;
+    exit;
+  end;
+
+  z.state^.blocks := nil;
+
+  { handle undocumented nowrap option (no zlib header or check) }
+  z.state^.nowrap := FALSE;
+  if (w < 0) then
+  begin
+    w := - w;
+    z.state^.nowrap := TRUE;
+  end;
+
+  { set window size }
+  if (w < 8) or (w > 15) then
+  begin
+    inflateEnd(z);
+    inflateInit2_ := Z_STREAM_ERROR;
+    exit;
+  end;
+  z.state^.wbits := cardinal(w);
+
+  { create inflate_blocks state }
+  if z.state^.nowrap then
+    z.state^.blocks := inflate_blocks_new(z, nil, cardinal(1) shl w)
+  else
+    z.state^.blocks := inflate_blocks_new(z, @adler32, cardinal(1) shl w);
+  if z.state^.blocks=nil then
+  begin
+    inflateEnd(z);
+    inflateInit2_ := Z_MEM_ERROR;
+    exit;
+  end;
+  {$IFDEF ZLIB_DEBUG}
+  Tracev('inflate: allocated');
+  {$ENDIF}
+  { reset state }
+  inflateReset(z);
+  inflateInit2_ :=  Z_OK;
+end;
+
+function inflateInit2(var z: z_stream; windowBits : integer) : integer;
+begin
+  inflateInit2 := inflateInit2_(z, windowBits, ZLIB_VERSION, sizeof(z_stream));
+end;
+
+
+function inflateInit(var z : z_stream) : integer;
+{ inflateInit is a macro to allow checking the zlib version
+  and the compiler's view of z_stream:  }
+begin
+  inflateInit := inflateInit2_(z, DEF_WBITS, ZLIB_VERSION, sizeof(z_stream));
+end;
+
+function inflateInit_(z : z_streamp;
+                      const version : string;
+                      stream_size : integer) : integer;
+begin
+  { initialize state }
+  if z=nil then
+    inflateInit_ := Z_STREAM_ERROR
+  else
+    inflateInit_ := inflateInit2_(z^, DEF_WBITS, version, stream_size);
+end;
+
+function inflate(var z : z_stream;
+                 f : integer) : integer;
+var
+  r : integer;
+  b : cardinal;
+begin
+  if (z.state=nil) or (z.next_in=nil) then
+  begin
+    inflate := Z_STREAM_ERROR;
+    exit;
+  end;
+  if f = Z_FINISH then
+    f := Z_BUF_ERROR
+  else
+    f := Z_OK;
+  r := Z_BUF_ERROR;
+  while True do
+  case (z.state^.mode) of
+    BLOCKS:
+      begin
+        r := inflate_blocks(z.state^.blocks^, z, r);
+        if (r = Z_DATA_ERROR) then
+        begin
+          z.state^.mode := BAD;
+          z.state^.sub.marker := 0;       { can try inflateSync }
+          continue;            { break C-switch }
+        end;
+        if (r = Z_OK) then
+          r := f;
+        if (r <> Z_STREAM_END) then
+        begin
+          inflate := r;
+          exit;
+        end;
+        r := f;
+        inflate_blocks_reset(z.state^.blocks^, z, @z.state^.sub.check.was);
+        if (z.state^.nowrap) then
+        begin
+          z.state^.mode := DONE;
+          continue;            { break C-switch }
+        end;
+        z.state^.mode := CHECK4;  { falltrough }
+      end;
+    CHECK4:
+      begin
+        {NEEDBYTE}
+        if (z.avail_in = 0) then
+        begin
+          inflate := r;
+          exit;
+        end;
+        r := f;
+
+        {z.state^.sub.check.need := cardinal(NEXTBYTE(z)) shl 24;}
+        dec(z.avail_in);
+        inc(z.total_in);
+        z.state^.sub.check.need := cardinal(z.next_in^) shl 24;
+        inc(z.next_in);
+
+        z.state^.mode := CHECK3;   { falltrough }
+      end;
+    CHECK3:
+      begin
+        {NEEDBYTE}
+        if (z.avail_in = 0) then
+        begin
+          inflate := r;
+          exit;
+        end;
+        r := f;
+        {inc( z.state^.sub.check.need, cardinal(NEXTBYTE(z)) shl 16);}
+        dec(z.avail_in);
+        inc(z.total_in);
+        inc(z.state^.sub.check.need, cardinal(z.next_in^) shl 16);
+        inc(z.next_in);
+
+        z.state^.mode := CHECK2;   { falltrough }
+      end;
+    CHECK2:
+      begin
+        {NEEDBYTE}
+        if (z.avail_in = 0) then
+        begin
+          inflate := r;
+          exit;
+        end;
+        r := f;
+
+        {inc( z.state^.sub.check.need, cardinal(NEXTBYTE(z)) shl 8);}
+        dec(z.avail_in);
+        inc(z.total_in);
+        inc(z.state^.sub.check.need, cardinal(z.next_in^) shl 8);
+        inc(z.next_in);
+
+        z.state^.mode := CHECK1;   { falltrough }
+      end;
+    CHECK1:
+      begin
+        {NEEDBYTE}
+        if (z.avail_in = 0) then
+        begin
+          inflate := r;
+          exit;
+        end;
+        r := f;
+        {inc( z.state^.sub.check.need, cardinal(NEXTBYTE(z)) );}
+        dec(z.avail_in);
+        inc(z.total_in);
+        inc(z.state^.sub.check.need, cardinal(z.next_in^) );
+        inc(z.next_in);
+
+
+        if (z.state^.sub.check.was <> z.state^.sub.check.need) then
+        begin
+          z.state^.mode := BAD;
+          z.msg := 'incorrect data check';
+          z.state^.sub.marker := 5;       { can't try inflateSync }
+          continue;           { break C-switch }
+        end;
+        {$IFDEF ZLIB_DEBUG}
+        Tracev('inflate: zlib check ok');
+        {$ENDIF}
+        z.state^.mode := DONE; { falltrough }
+      end;
+    DONE:
+      begin
+        inflate := Z_STREAM_END;
+        exit;
+      end;
+    METHOD:
+      begin
+        {NEEDBYTE}
+        if (z.avail_in = 0) then
+        begin
+          inflate := r;
+          exit;
+        end;
+        r := f; {}
+
+        {z.state^.sub.method := NEXTBYTE(z);}
+        dec(z.avail_in);
+        inc(z.total_in);
+        z.state^.sub.method := z.next_in^;
+        inc(z.next_in);
+
+        if ((z.state^.sub.method and $0f) <> Z_DEFLATED) then
+        begin
+          z.state^.mode := BAD;
+          z.msg := 'unknown compression method';
+          z.state^.sub.marker := 5;       { can't try inflateSync }
+          continue;  { break C-switch }
+        end;
+        if ((z.state^.sub.method shr 4) + 8 > z.state^.wbits) then
+        begin
+          z.state^.mode := BAD;
+          z.msg := 'invalid window size';
+          z.state^.sub.marker := 5;       { can't try inflateSync }
+          continue; { break C-switch }
+        end;
+        z.state^.mode := FLAG;
+        { fall trough }
+      end;
+    FLAG:
+      begin
+        {NEEDBYTE}
+        if (z.avail_in = 0) then
+        begin
+          inflate := r;
+          exit;
+        end;
+        r := f; {}
+        {b := NEXTBYTE(z);}
+        dec(z.avail_in);
+        inc(z.total_in);
+        b := z.next_in^;
+        inc(z.next_in);
+
+        if (((z.state^.sub.method shl 8) + b) mod 31) <> 0 then {% mod ?}
+        begin
+          z.state^.mode := BAD;
+          z.msg := 'incorrect header check';
+          z.state^.sub.marker := 5;       { can't try inflateSync }
+          continue;      { break C-switch }
+        end;
+        {$IFDEF ZLIB_DEBUG}
+        Tracev('inflate: zlib header ok');
+        {$ENDIF}
+        if ((b and PRESET_DICT) = 0) then
+        begin
+          z.state^.mode := BLOCKS;
+	  continue;      { break C-switch }
+        end;
+        z.state^.mode := DICT4;
+        { falltrough }
+      end;
+    DICT4:
+      begin
+        if (z.avail_in = 0) then
+        begin
+          inflate := r;
+          exit;
+        end;
+        r := f;
+
+        {z.state^.sub.check.need := cardinal(NEXTBYTE(z)) shl 24;}
+        dec(z.avail_in);
+        inc(z.total_in);
+        z.state^.sub.check.need :=  cardinal(z.next_in^) shl 24;
+        inc(z.next_in);
+
+        z.state^.mode := DICT3;        { falltrough }
+      end;
+    DICT3:
+      begin
+        if (z.avail_in = 0) then
+        begin
+          inflate := r;
+          exit;
+        end;
+        r := f;
+        {inc(z.state^.sub.check.need, cardinal(NEXTBYTE(z)) shl 16);}
+        dec(z.avail_in);
+        inc(z.total_in);
+        inc(z.state^.sub.check.need, cardinal(z.next_in^) shl 16);
+        inc(z.next_in);
+
+        z.state^.mode := DICT2;        { falltrough }
+      end;
+    DICT2:
+      begin
+        if (z.avail_in = 0) then
+        begin
+          inflate := r;
+          exit;
+        end;
+        r := f;
+
+        {inc(z.state^.sub.check.need, cardinal(NEXTBYTE(z)) shl 8);}
+        dec(z.avail_in);
+        inc(z.total_in);
+        inc(z.state^.sub.check.need, cardinal(z.next_in^) shl 8);
+        inc(z.next_in);
+
+        z.state^.mode := DICT1;        { falltrough }
+      end;
+    DICT1:
+      begin
+        if (z.avail_in = 0) then
+        begin
+          inflate := r;
+          exit;
+        end;
+        { r := f;    ---  wird niemals benutzt }
+        {inc(z.state^.sub.check.need, cardinal(NEXTBYTE(z)) );}
+        dec(z.avail_in);
+        inc(z.total_in);
+        inc(z.state^.sub.check.need, cardinal(z.next_in^) );
+        inc(z.next_in);
+
+        z.adler := z.state^.sub.check.need;
+        z.state^.mode := DICT0;
+        inflate := Z_NEED_DICT;
+        exit;
+      end;
+    DICT0:
+      begin
+        z.state^.mode := BAD;
+        z.msg := 'need dictionary';
+        z.state^.sub.marker := 0;         { can try inflateSync }
+        inflate := Z_STREAM_ERROR;
+        exit;
+      end;
+    BAD:
+      begin
+        inflate := Z_DATA_ERROR;
+        exit;
+      end;
+    else
+      begin
+        inflate := Z_STREAM_ERROR;
+        exit;
+      end;
+  end;
+{$ifdef NEED_DUMMY_result}
+  result := Z_STREAM_ERROR;  { Some dumb compilers complain without this }
+{$endif}
+end;
+
+function inflateSetDictionary(var z : z_stream;
+                              dictionary : Pbyte; {const array of byte}
+                              dictLength : cardinal) : integer;
+var
+  length : cardinal;
+begin
+  length := dictLength;
+
+  if (z.state=nil) or (z.state^.mode<>DICT0) then
+  begin
+    inflateSetDictionary := Z_STREAM_ERROR;
+    exit;
+  end;
+  if (adler32(1, dictionary, dictLength) <> z.adler) then
+  begin
+    inflateSetDictionary := Z_DATA_ERROR;
+    exit;
+  end;
+  z.adler := 1;
+
+  if (length >= (1 shl z.state^.wbits)) then
+  begin
+    length := (1 shl z.state^.wbits)-1;
+    inc( dictionary, dictLength - length);
+  end;
+  inflate_set_dictionary(z.state^.blocks^, dictionary^, length);
+  z.state^.mode := BLOCKS;
+  inflateSetDictionary := Z_OK;
+end;
+
+
+function inflateSync(var z : z_stream) : integer;
+const
+  mark : packed array[0..3] of byte = (0, 0, $ff, $ff);
+var
+  n : cardinal;       { number of bytes to look at }
+  p : Pbyte;     { pointer to bytes }
+  m : cardinal;       { number of marker bytes found in a row }
+  r, w : cardinal;   { temporaries to save total_in and total_out }
+begin
+  { set up }
+  if z.state=nil then
+  begin
+    inflateSync := Z_STREAM_ERROR;
+    exit;
+  end;
+  if (z.state^.mode <> BAD) then
+  begin
+    z.state^.mode := BAD;
+    z.state^.sub.marker := 0;
+  end;
+  n := z.avail_in;
+  if (n = 0) then
+  begin
+    inflateSync := Z_BUF_ERROR;
+    exit;
+  end;
+  p := z.next_in;
+  m := z.state^.sub.marker;
+
+  { search }
+  while (n <> 0) and (m < 4) do
+  begin
+    if (p^ = mark[m]) then
+      inc(m)
+    else
+      if (p^ <> 0) then
+        m := 0
+      else
+        m := 4 - m;
+    inc(p);
+    dec(n);
+  end;
+
+  { restore }
+  inc(z.total_in, ptruint(p) - ptruint(z.next_in));
+  z.next_in := p;
+  z.avail_in := n;
+  z.state^.sub.marker := m;
+
+
+  { return no joy or set up to restart on a new block }
+  if (m <> 4) then
+  begin
+    inflateSync := Z_DATA_ERROR;
+    exit;
+  end;
+  r := z.total_in;
+  w := z.total_out;
+  inflateReset(z);
+  z.total_in := r;
+  z.total_out := w;
+  z.state^.mode := BLOCKS;
+  inflateSync := Z_OK;
+end;
+
+
+{
+  returns true if inflate is currently at the end of a block generated
+  by Z_SYNC_FLUSH or Z_FULL_FLUSH. This function is used by one PPP
+  implementation to provide an additional safety check. PPP uses Z_SYNC_FLUSH
+  but removes the length bytes of the resulting empty stored block. When
+  decompressing, PPP checks that at the end of input packet, inflate is
+  waiting for these length bytes.
+}
+
+function inflateSyncPoint(var z : z_stream) : integer;
+begin
+  if (z.state = nil) or (z.state^.blocks = nil) then
+  begin
+    inflateSyncPoint := Z_STREAM_ERROR;
+    exit;
+  end;
+  inflateSyncPoint := inflate_blocks_sync_point(z.state^.blocks^);
+end;
+
+end.

+ 792 - 0
src/libraries/paszlib/paszlib_zip.pas

@@ -0,0 +1,792 @@
+unit paszlib_Zip;
+
+{ zip.c -- IO on .zip files using zlib
+  zip.h -- IO for compress .zip files using zlib
+   Version 0.15 alpha, Mar 19th, 1998,
+
+   Copyright (C) 1998 Gilles Vollant
+
+   This package allows to create .ZIP file, compatible with PKZip 2.04g
+     WinZip, InfoZip tools and compatible.
+   Encryption and multi volume ZipFile (span) are not supported.
+   Old compressions used by old PKZip 1.x are not supported
+
+  For decompression of .zip files, look at unzip.pas
+
+  Pascal tranlastion
+  Copyright (C) 2000 by Jacques Nomssi Nzali
+  For conditions of distribution and use, see copyright notice in readme.txt }
+
+
+interface
+
+{$ifdef WIN32}
+  {$define Delphi}
+{$endif}
+
+uses
+  //zutil,
+  paszlib_zbase,
+  //zLib,
+  paszlib_ziputils;
+
+const
+  ZIP_OK    = (0);
+  ZIP_ERRNO = (Z_ERRNO);
+  ZIP_PARAMERROR = (-102);
+  ZIP_INTERNALERROR = (-104);
+  Z_DEFAULT_COMPRESSION = -(1);
+  Z_DEFLATED = 8;
+
+(*
+{ tm_zip contain date/time info }
+type
+  tm_zip = record
+     tm_sec : integer;            { seconds after the minute - [0,59] }
+     tm_min : integer;            { minutes after the hour - [0,59] }
+     tm_hour : integer;           { hours since midnight - [0,23] }
+     tm_mday : integer;           { day of the month - [1,31] }
+     tm_mon : integer;            { months since January - [0,11] }
+     tm_year : integer;           { years - [1980..2044] }
+  end;
+*)
+type
+  zip_fileinfo = record
+    tmz_date: tm_zip;        { date in understandable format           }
+    dosDate:  longword;         { if dos_date = 0, tmu_date is used       }
+    {   flag : longint;       }{ general purpose bit flag        2 bytes }
+
+    internal_fa: longint;    { internal file attributes        2 bytes }
+    external_fa: longint;    { external file attributes        4 bytes }
+  end;
+  zip_fileinfo_ptr = ^zip_fileinfo;
+
+function zipOpen(const pathname: PChar; append: longint): zipFile; {ZEXPORT}
+{ Create a zipfile.
+  pathname contain on Windows NT a filename like "c:\\zlib\\zlib111.zip" or on
+  an Unix computer "zlib/zlib111.zip".
+  if the file pathname exist and append=1, the zip will be created at the end
+  of the file. (useful if the file contain a self extractor code)
+  If the zipfile cannot be opened, the return value is NIL.
+  Else, the return value is a zipFile Handle, usable with other function
+  of this zip package. }
+
+function zipOpenNewFileInZip(afile: zipFile;
+  {const} filename: PChar; const zipfi: zip_fileinfo_ptr; const extrafield_local: pointer; size_extrafield_local: integer; const extrafield_global: pointer; size_extrafield_global: integer; const comment: PChar; method: longint; level: longint): longint; {ZEXPORT}
+{ Open a file in the ZIP for writing.
+  filename : the filename in zip (if NIL, '-' without quote will be used
+  zipfi^ contain supplemental information
+  if extrafield_local<>NIL and size_extrafield_local>0, extrafield_local
+    contains the extrafield data the the local header
+  if extrafield_global<>NIL and size_extrafield_global>0, extrafield_global
+    contains the extrafield data the the local header
+  if comment <> NIL, comment contain the comment string
+  method contain the compression method (0 for store, Z_DEFLATED for deflate)
+  level contain the level of compression (can be Z_DEFAULT_COMPRESSION) }
+
+function zipWriteInFileInZip(afile: zipFile; const buf: pointer; len: cardinal): longint; {ZEXPORT}
+{ Write data in the zipfile }
+
+function zipCloseFileInZip(afile: zipFile): longint; {ZEXPORT}
+ { Close the current file in the zipfile }
+
+function zipClose(afile: zipFile; const global_comment: PChar): longint; {ZEXPORT}
+ { Close the zipfile }
+
+implementation
+
+uses
+  {$ifdef Delphi}
+  SysUtils,
+  {$else}
+  strings,
+  {$endif}
+  paszlib_zDeflate, crc;
+
+const
+  VERSIONMADEBY = ($0); { platform depedent }
+
+const
+  zip_copyright: PChar = ' zip 0.15 Copyright 1998 Gilles Vollant ';
+
+
+const
+  SIZEDATA_INDATABLOCK = (4096 - (4 * 4));
+
+  LOCALHEADERMAGIC = $04034b50;
+  {CENTRALHEADERMAGIC = $02014b50;}
+  ENDHEADERMAGIC   = $06054b50;
+
+  FLAG_LOCALHEADER_OFFSET = $06;
+  CRC_LOCALHEADER_OFFSET  = $0e;
+
+  SIZECENTRALHEADER = $2e; { 46 }
+
+type
+  linkedlist_datablock_internal_ptr = ^linkedlist_datablock_internal;
+
+  linkedlist_datablock_internal = record
+    next_datablock: linkedlist_datablock_internal_ptr;
+    avail_in_this_block: longint;
+    filled_in_this_block: longint;
+    unused: longint; { for future use and alignement }
+    Data:   array[0..SIZEDATA_INDATABLOCK - 1] of byte;
+  end;
+
+type
+  linkedlist_data = record
+    first_block: linkedlist_datablock_internal_ptr;
+    last_block:  linkedlist_datablock_internal_ptr;
+  end;
+  linkedlist_data_ptr = ^linkedlist_data;
+
+type
+  curfile_info = record
+    stream: z_stream;            { zLib stream structure for inflate }
+    stream_initialised: boolean; { TRUE is stream is initialised }
+    pos_in_buffered_data: integer;  { last written byte in buffered_data }
+
+    pos_local_header: longint;     { offset of the local header of the file
+                                    currenty writing }
+    central_header: PChar;       { central header data for the current file }
+    size_centralheader: longint;   { size of the central header for cur file }
+    flag: longint;                 { flag of the file currently writing }
+
+    method:  longint;                { compression method of file currenty wr.}
+    buffered_data: array[0..Z_BUFSIZE - 1] of byte;{ buffer contain compressed data to be written}
+    dosDate: longint;
+    crc32:   longint;
+  end;
+
+type
+  zip_internal = record
+    filezip: FILEptr;
+    central_dir: linkedlist_data;  { datablock with central dir in construction}
+    in_opened_file_inzip: boolean; { TRUE if a file in the zip is currently writ.}
+    ci: curfile_info;              { info on the file curretly writing }
+
+    begin_pos:    longint;            { position of the beginning of the zipfile }
+    number_entry: longint;
+  end;
+  zip_internal_ptr = ^zip_internal;
+
+function allocate_new_datablock: linkedlist_datablock_internal_ptr;
+var
+  ldi: linkedlist_datablock_internal_ptr;
+begin
+  ldi := linkedlist_datablock_internal_ptr(GetMem(sizeof(linkedlist_datablock_internal)));
+  if (ldi <> nil) then
+  begin
+    ldi^.next_datablock      := nil;
+    ldi^.filled_in_this_block := 0;
+    ldi^.avail_in_this_block := SIZEDATA_INDATABLOCK;
+  end;
+  allocate_new_datablock := ldi;
+end;
+
+procedure free_datablock(ldi: linkedlist_datablock_internal_ptr);
+var
+  ldinext: linkedlist_datablock_internal_ptr;
+begin
+  while (ldi <> nil) do
+  begin
+    ldinext := ldi^.next_datablock;
+    FreeMem(ldi);
+    ldi := ldinext;
+  end;
+end;
+
+procedure init_linkedlist(var ll: linkedlist_data);
+begin
+  ll.last_block  := nil;
+  ll.first_block := nil;
+end;
+
+procedure free_linkedlist(var ll: linkedlist_data);
+begin
+  free_datablock(ll.first_block);
+  ll.last_block  := nil;
+  ll.first_block := nil;
+end;
+
+function add_data_in_datablock(ll: linkedlist_data_ptr; const buf: pointer; len: longint): longint;
+var
+  ldi: linkedlist_datablock_internal_ptr;
+  from_copy: {const} Pbyte;
+var
+  copy_this: integer;
+  i:   integer;
+  to_copy: Pbyte;
+begin
+  if (ll = nil) then
+  begin
+    add_data_in_datablock := ZIP_INTERNALERROR;
+    exit;
+  end;
+
+  if (ll^.last_block = nil) then
+  begin
+    ll^.last_block  := allocate_new_datablock;
+    ll^.first_block := ll^.last_block;
+    if (ll^.first_block = nil) then
+    begin
+      add_data_in_datablock := ZIP_INTERNALERROR;
+      exit;
+    end;
+  end;
+
+  ldi := ll^.last_block;
+  from_copy := Pbyte(buf);
+
+  while (len > 0) do
+  begin
+    if (ldi^.avail_in_this_block = 0) then
+    begin
+      ldi^.next_datablock := allocate_new_datablock;
+      if (ldi^.next_datablock = nil) then
+      begin
+        add_data_in_datablock := ZIP_INTERNALERROR;
+        exit;
+      end;
+      ldi := ldi^.next_datablock;
+      ll^.last_block := ldi;
+    end;
+
+    if (ldi^.avail_in_this_block < len) then
+      copy_this := integer(ldi^.avail_in_this_block)
+    else
+      copy_this := integer(len);
+
+    to_copy := @(ldi^.Data[ldi^.filled_in_this_block]);
+
+    for i := 0 to copy_this - 1 do
+      Pbytearray(to_copy)^[i] := Pbytearray(from_copy)^[i];
+
+    Inc(ldi^.filled_in_this_block, copy_this);
+    Dec(ldi^.avail_in_this_block, copy_this);
+    Inc(from_copy, copy_this);
+    Dec(len, copy_this);
+  end;
+  add_data_in_datablock := ZIP_OK;
+end;
+
+
+function write_datablock(fout: FILEptr; ll: linkedlist_data_ptr): longint;
+var
+  ldi: linkedlist_datablock_internal_ptr;
+begin
+  ldi := ll^.first_block;
+  while (ldi <> nil) do
+  begin
+    if (ldi^.filled_in_this_block > 0) then
+      if (fwrite(@ldi^.Data, integer(ldi^.filled_in_this_block), 1, fout) <> 1) then
+      begin
+        write_datablock := ZIP_ERRNO;
+        exit;
+      end;
+    ldi := ldi^.next_datablock;
+  end;
+  write_datablock := ZIP_OK;
+end;
+
+{**************************************************************************}
+
+{ ===========================================================================
+   Outputs a long in LSB order to the given file
+   nbByte = 1, 2 or 4 (byte, short or long)  }
+
+function ziplocal_putValue(afile: FILEptr; x: longint; nbByte: longint): longint;
+var
+  buf: array[0..4 - 1] of byte;
+  n:   longint;
+begin
+  for n := 0 to nbByte - 1 do
+  begin
+    buf[n] := byte(x and $ff);
+    x      := x shr 8;
+  end;
+  if (fwrite(@buf, nbByte, 1, afile) <> 1) then
+    ziplocal_putValue := ZIP_ERRNO
+  else
+    ziplocal_putValue := ZIP_OK;
+end;
+
+procedure ziplocal_putValue_inmemory(dest: pointer; x: longint; nbByte: longint);
+var
+  buf: Pbytearray;
+  n:   longint;
+begin
+  buf := Pbytearray(dest);
+  for n := 0 to nbByte - 1 do
+  begin
+    buf^[n] := Byte(x and $ff);
+    x := x shr 8;
+  end;
+end;
+
+{**************************************************************************}
+
+
+function ziplocal_TmzDateToDosDate(var ptm: tm_zip; dosDate: longint): longint;
+var
+  year: longint;
+begin
+  year := longint(ptm.tm_year);
+  if (year > 1980) then
+    Dec(year, 1980)
+  else
+  if (year > 80) then
+    Dec(year, 80);
+  ziplocal_TmzDateToDosDate := longint(
+    ((ptm.tm_mday) + (32 * (ptm.tm_mon + 1)) + (512 * year)) shl 16) or
+    ((ptm.tm_sec div 2) + (32 * ptm.tm_min) + (2048 * longint(ptm.tm_hour)));
+end;
+
+
+{**************************************************************************}
+
+function zipOpen(const pathname: PChar; append: longint): zipFile; {ZEXPORT}
+var
+  ziinit: zip_internal;
+  zi:     zip_internal_ptr;
+begin
+  if (append = 0) then
+    ziinit.filezip := fopen(pathname, fopenwrite)
+  else
+    ziinit.filezip := fopen(pathname, fappendwrite);
+
+  if (ziinit.filezip = nil) then
+  begin
+    zipOpen := nil;
+    exit;
+  end;
+  ziinit.begin_pos    := ftell(ziinit.filezip);
+  ziinit.in_opened_file_inzip := False;
+  ziinit.ci.stream_initialised := False;
+  ziinit.number_entry := 0;
+  init_linkedlist(ziinit.central_dir);
+
+  zi := zip_internal_ptr(AllocMem(sizeof(zip_internal)));
+  if (zi = nil) then
+  begin
+    fclose(ziinit.filezip);
+    zipOpen := nil;
+    exit;
+  end;
+
+  zi^     := ziinit;
+  zipOpen := zipFile(zi);
+end;
+
+function zipOpenNewFileInZip(afile: zipFile;
+  {const} filename: PChar; const zipfi: zip_fileinfo_ptr; const extrafield_local: pointer; size_extrafield_local: integer; const extrafield_global: pointer; size_extrafield_global: integer; const comment: PChar; method: longint; level: longint): longint; {ZEXPORT}
+var
+  zi:  zip_internal_ptr;
+  size_filename: integer;
+  size_comment: integer;
+  i:   integer;
+  err: longint;
+begin
+  err := ZIP_OK;
+  if (afile = nil) then
+  begin
+    zipOpenNewFileInZip := ZIP_PARAMERROR;
+    exit;
+  end;
+  if ((method <> 0) and (method <> Z_DEFLATED)) then
+  begin
+    zipOpenNewFileInZip := ZIP_PARAMERROR;
+    exit;
+  end;
+
+  zi := zip_internal_ptr(afile);
+
+  if (zi^.in_opened_file_inzip = True) then
+  begin
+    err := zipCloseFileInZip(afile);
+    if (err <> ZIP_OK) then
+    begin
+      zipOpenNewFileInZip := err;
+      exit;
+    end;
+  end;
+
+  if (filename = nil) then
+    filename := '-';
+
+  if (comment = nil) then
+    size_comment := 0
+  else
+    size_comment := strlen(comment);
+
+  size_filename := strlen(filename);
+
+  if (zipfi = nil) then
+    zi^.ci.dosDate := 0
+  else
+  if (zipfi^.dosDate <> 0) then
+    zi^.ci.dosDate := zipfi^.dosDate
+  else
+    zi^.ci.dosDate := ziplocal_TmzDateToDosDate(zipfi^.tmz_date, zipfi^.dosDate);
+  zi^.ci.flag := 0;
+  if ((level = 8) or (level = 9)) then
+    zi^.ci.flag := zi^.ci.flag or 2;
+  if ((level = 2)) then
+    zi^.ci.flag := zi^.ci.flag or 4;
+  if ((level = 1)) then
+    zi^.ci.flag := zi^.ci.flag or 6;
+
+  zi^.ci.crc32  := 0;
+  zi^.ci.method := method;
+  zi^.ci.stream_initialised := False;
+  zi^.ci.pos_in_buffered_data := 0;
+  zi^.ci.pos_local_header := ftell(zi^.filezip);
+  zi^.ci.size_centralheader := SIZECENTRALHEADER + size_filename +
+    size_extrafield_global + size_comment;
+  zi^.ci.central_header := PChar(AllocMem(integer(zi^.ci.size_centralheader)));
+
+  ziplocal_putValue_inmemory(zi^.ci.central_header, longint(CENTRALHEADERMAGIC), 4);
+  { version info }
+  ziplocal_putValue_inmemory(zi^.ci.central_header + 4, longint(VERSIONMADEBY), 2);
+  ziplocal_putValue_inmemory(zi^.ci.central_header + 6, longint(20), 2);
+  ziplocal_putValue_inmemory(zi^.ci.central_header + 8, longint(zi^.ci.flag), 2);
+  ziplocal_putValue_inmemory(zi^.ci.central_header + 10, longint(zi^.ci.method), 2);
+  ziplocal_putValue_inmemory(zi^.ci.central_header + 12, longint(zi^.ci.dosDate), 4);
+  ziplocal_putValue_inmemory(zi^.ci.central_header + 16, longint(0), 4); {crc}
+  ziplocal_putValue_inmemory(zi^.ci.central_header + 20, longint(0), 4); {compr size}
+  ziplocal_putValue_inmemory(zi^.ci.central_header + 24, longint(0), 4); {uncompr size}
+  ziplocal_putValue_inmemory(zi^.ci.central_header + 28, longint(size_filename), 2);
+  ziplocal_putValue_inmemory(zi^.ci.central_header + 30, longint(size_extrafield_global), 2);
+  ziplocal_putValue_inmemory(zi^.ci.central_header + 32, longint(size_comment), 2);
+  ziplocal_putValue_inmemory(zi^.ci.central_header + 34, longint(0), 2); {disk nm start}
+
+  if (zipfi = nil) then
+    ziplocal_putValue_inmemory(zi^.ci.central_header + 36, longint(0), 2)
+  else
+    ziplocal_putValue_inmemory(zi^.ci.central_header + 36, longint(zipfi^.internal_fa), 2);
+
+  if (zipfi = nil) then
+    ziplocal_putValue_inmemory(zi^.ci.central_header + 38, longint(0), 4)
+  else
+    ziplocal_putValue_inmemory(zi^.ci.central_header + 38, longint(zipfi^.external_fa), 4);
+
+  ziplocal_putValue_inmemory(zi^.ci.central_header + 42, longint(zi^.ci.pos_local_header), 4);
+
+  i := 0;
+  while (i < size_filename) do
+  begin
+    (zi^.ci.central_header +SIZECENTRALHEADER + i)^ := (filename + i)^;
+    Inc(i);
+  end;
+
+  i := 0;
+  while (i < size_extrafield_global) do
+  begin
+    (zi^.ci.central_header +SIZECENTRALHEADER + size_filename + i)^ :=
+      ({const} PChar(extrafield_global) + i)^;
+    Inc(i);
+  end;
+
+  i := 0;
+  while (i < size_comment) do
+  begin
+    (zi^.ci.central_header +SIZECENTRALHEADER + size_filename + size_extrafield_global + i)^ := (filename + i)^;
+    Inc(i);
+  end;
+  if (zi^.ci.central_header = nil) then
+  begin
+    zipOpenNewFileInZip := ZIP_INTERNALERROR;
+    exit;
+  end;
+
+  { write the local header }
+  err := ziplocal_putValue(zi^.filezip, longint(LOCALHEADERMAGIC), 4);
+
+  if (err = ZIP_OK) then
+    err := ziplocal_putValue(zi^.filezip, longint(20), 2); { version needed to extract }
+  if (err = ZIP_OK) then
+    err := ziplocal_putValue(zi^.filezip, longint(zi^.ci.flag), 2);
+
+  if (err = ZIP_OK) then
+    err := ziplocal_putValue(zi^.filezip, longint(zi^.ci.method), 2);
+
+  if (err = ZIP_OK) then
+    err := ziplocal_putValue(zi^.filezip, longint(zi^.ci.dosDate), 4);
+
+  if (err = ZIP_OK) then
+    err := ziplocal_putValue(zi^.filezip, longint(0), 4); { crc 32, unknown }
+  if (err = ZIP_OK) then
+    err := ziplocal_putValue(zi^.filezip, longint(0), 4); { compressed size, unknown }
+  if (err = ZIP_OK) then
+    err := ziplocal_putValue(zi^.filezip, longint(0), 4); { uncompressed size, unknown }
+
+  if (err = ZIP_OK) then
+    err := ziplocal_putValue(zi^.filezip, longint(size_filename), 2);
+
+  if (err = ZIP_OK) then
+    err := ziplocal_putValue(zi^.filezip, longint(size_extrafield_local), 2);
+
+  if ((err = ZIP_OK) and (size_filename > 0)) then
+    if (fwrite(filename, integer(size_filename), 1, zi^.filezip) <> 1) then
+      err := ZIP_ERRNO;
+
+  if ((err = ZIP_OK) and (size_extrafield_local > 0)) then
+    if (fwrite(extrafield_local, integer(size_extrafield_local), 1, zi^.filezip) <> 1) then
+      err := ZIP_ERRNO;
+
+  zi^.ci.stream.avail_in  := integer(0);
+  zi^.ci.stream.avail_out := integer(Z_BUFSIZE);
+  zi^.ci.stream.next_out  := Pbyte(@zi^.ci.buffered_data);
+  zi^.ci.stream.total_in  := 0;
+  zi^.ci.stream.total_out := 0;
+
+  if ((err = ZIP_OK) and (zi^.ci.method = Z_DEFLATED)) then
+  begin
+    err := deflateInit2(zi^.ci.stream, level,
+      Z_DEFLATED, -MAX_WBITS, DEF_MEM_LEVEL, 0);
+
+    if (err = Z_OK) then
+      zi^.ci.stream_initialised := True;
+  end;
+
+  if (err = Z_OK) then
+    zi^.in_opened_file_inzip := True;
+  zipOpenNewFileInZip := err;
+end;
+
+function zipWriteInFileInZip(afile: zipFile; const buf: pointer; len: cardinal): longint; {ZEXPORT}
+var
+  zi:  zip_internal_ptr;
+  err: longint;
+var
+  uTotalOutBefore: longint;
+var
+  copy_this, i: integer;
+begin
+  err := ZIP_OK;
+
+  if (afile = nil) then
+  begin
+    zipWriteInFileInZip := ZIP_PARAMERROR;
+    exit;
+  end;
+  zi := zip_internal_ptr(afile);
+
+  if (zi^.in_opened_file_inzip = False) then
+  begin
+    zipWriteInFileInZip := ZIP_PARAMERROR;
+    exit;
+  end;
+
+  zi^.ci.stream.next_in := buf;
+  zi^.ci.stream.avail_in := len;
+  zi^.ci.crc32 := crc32(zi^.ci.crc32, buf, len);
+
+  while ((err = ZIP_OK) and (zi^.ci.stream.avail_in > 0)) do
+  begin
+    if (zi^.ci.stream.avail_out = 0) then
+    begin
+      if fwrite(@zi^.ci.buffered_data, integer(zi^.ci.pos_in_buffered_data), 1, zi^.filezip) <> 1 then
+        err := ZIP_ERRNO;
+      zi^.ci.pos_in_buffered_data := 0;
+      zi^.ci.stream.avail_out := integer(Z_BUFSIZE);
+      zi^.ci.stream.next_out  := Pbyte(@zi^.ci.buffered_data);
+    end;
+
+    if (zi^.ci.method = Z_DEFLATED) then
+    begin
+      uTotalOutBefore := zi^.ci.stream.total_out;
+      err := deflate(zi^.ci.stream, Z_NO_FLUSH);
+      Inc(zi^.ci.pos_in_buffered_data, integer(zi^.ci.stream.total_out - uTotalOutBefore));
+    end
+    else
+    begin
+      if (zi^.ci.stream.avail_in < zi^.ci.stream.avail_out) then
+        copy_this := zi^.ci.stream.avail_in
+      else
+        copy_this := zi^.ci.stream.avail_out;
+
+      for i := 0 to copy_this - 1 do
+        (PChar(zi^.ci.stream.next_out) +i)^ :=
+          ( {const} PChar(zi^.ci.stream.next_in) + i)^;
+
+
+      Dec(zi^.ci.stream.avail_in, copy_this);
+      Dec(zi^.ci.stream.avail_out, copy_this);
+      Inc(zi^.ci.stream.next_in, copy_this);
+      Inc(zi^.ci.stream.next_out, copy_this);
+      Inc(zi^.ci.stream.total_in, copy_this);
+      Inc(zi^.ci.stream.total_out, copy_this);
+      Inc(zi^.ci.pos_in_buffered_data, copy_this);
+    end;
+  end;
+
+  zipWriteInFileInZip := 0;
+end;
+
+function zipCloseFileInZip(afile: zipFile): longint; {ZEXPORT}
+var
+  zi:  zip_internal_ptr;
+  err: longint;
+var
+  uTotalOutBefore: longint;
+var
+  cur_pos_inzip: longint;
+begin
+  err := ZIP_OK;
+
+  if (afile = nil) then
+  begin
+    zipCloseFileInZip := ZIP_PARAMERROR;
+    exit;
+  end;
+  zi := zip_internal_ptr(afile);
+
+  if (zi^.in_opened_file_inzip = False) then
+  begin
+    zipCloseFileInZip := ZIP_PARAMERROR;
+    exit;
+  end;
+  zi^.ci.stream.avail_in := 0;
+
+  if (zi^.ci.method = Z_DEFLATED) then
+    while (err = ZIP_OK) do
+    begin
+      if (zi^.ci.stream.avail_out = 0) then
+      begin
+        if fwrite(@zi^.ci.buffered_data, integer(zi^.ci.pos_in_buffered_data), 1, zi^.filezip) <> 1 then
+          err := ZIP_ERRNO;
+        zi^.ci.pos_in_buffered_data := 0;
+        zi^.ci.stream.avail_out := integer(Z_BUFSIZE);
+        zi^.ci.stream.next_out  := Pbyte(@zi^.ci.buffered_data);
+      end;
+      uTotalOutBefore := zi^.ci.stream.total_out;
+      err := deflate(zi^.ci.stream, Z_FINISH);
+      Inc(zi^.ci.pos_in_buffered_data, integer(zi^.ci.stream.total_out - uTotalOutBefore));
+    end;
+
+  if (err = Z_STREAM_END) then
+    err := ZIP_OK; { this is normal }
+
+  if (zi^.ci.pos_in_buffered_data > 0) and (err = ZIP_OK) then
+    if fwrite(@zi^.ci.buffered_data, integer(zi^.ci.pos_in_buffered_data), 1, zi^.filezip) <> 1 then
+      err := ZIP_ERRNO;
+
+  if ((zi^.ci.method = Z_DEFLATED) and (err = ZIP_OK)) then
+  begin
+    err := deflateEnd(zi^.ci.stream);
+    zi^.ci.stream_initialised := False;
+  end;
+
+  ziplocal_putValue_inmemory(zi^.ci.central_header + 16, longint(zi^.ci.crc32), 4); {crc}
+  ziplocal_putValue_inmemory(zi^.ci.central_header + 20, longint(zi^.ci.stream.total_out), 4); {compr size}
+  ziplocal_putValue_inmemory(zi^.ci.central_header + 24, longint(zi^.ci.stream.total_in), 4); {uncompr size}
+
+  if (err = ZIP_OK) then
+    err := add_data_in_datablock(@zi^.central_dir, zi^.ci.central_header, longint(zi^.ci.size_centralheader));
+
+  FreeMem(zi^.ci.central_header);
+
+  if (err = ZIP_OK) then
+  begin
+    cur_pos_inzip := ftell(zi^.filezip);
+    if fseek(zi^.filezip, zi^.ci.pos_local_header + 14, SEEK_SET) <> 0 then
+      err := ZIP_ERRNO;
+
+    if (err = ZIP_OK) then
+      err := ziplocal_putValue(zi^.filezip, longint(zi^.ci.crc32), 4); { crc 32, unknown }
+
+    if (err = ZIP_OK) then { compressed size, unknown }
+      err := ziplocal_putValue(zi^.filezip, longint(zi^.ci.stream.total_out), 4);
+
+    if (err = ZIP_OK) then { uncompressed size, unknown }
+      err := ziplocal_putValue(zi^.filezip, longint(zi^.ci.stream.total_in), 4);
+
+    if fseek(zi^.filezip, cur_pos_inzip, SEEK_SET) <> 0 then
+      err := ZIP_ERRNO;
+  end;
+
+  Inc(zi^.number_entry);
+  zi^.in_opened_file_inzip := False;
+
+  zipCloseFileInZip := err;
+end;
+
+function zipClose(afile: zipFile; const global_comment: PChar): longint; {ZEXPORT}
+var
+  zi:  zip_internal_ptr;
+  err: longint;
+  size_centraldir: longint;
+  centraldir_pos_inzip: longint;
+  size_global_comment: integer;
+var
+  ldi: linkedlist_datablock_internal_ptr;
+begin
+  err := 0;
+  size_centraldir := 0;
+  if (afile = nil) then
+  begin
+    zipClose := ZIP_PARAMERROR;
+    exit;
+  end;
+  zi := zip_internal_ptr(afile);
+
+  if (zi^.in_opened_file_inzip = True) then
+    err := zipCloseFileInZip(afile);
+
+  if (global_comment = nil) then
+    size_global_comment := 0
+  else
+    size_global_comment := strlen(global_comment);
+
+  centraldir_pos_inzip := ftell(zi^.filezip);
+  if (err = ZIP_OK) then
+  begin
+    ldi := zi^.central_dir.first_block;
+    while (ldi <> nil) do
+    begin
+      if ((err = ZIP_OK) and (ldi^.filled_in_this_block > 0)) then
+        if fwrite(@ldi^.Data, integer(ldi^.filled_in_this_block), 1, zi^.filezip) <> 1 then
+          err := ZIP_ERRNO;
+
+      Inc(size_centraldir, ldi^.filled_in_this_block);
+      ldi := ldi^.next_datablock;
+    end;
+  end;
+  free_datablock(zi^.central_dir.first_block);
+
+  if (err = ZIP_OK) then { Magic End }
+    err := ziplocal_putValue(zi^.filezip, longint(ENDHEADERMAGIC), 4);
+
+  if (err = ZIP_OK) then { number of this disk }
+    err := ziplocal_putValue(zi^.filezip, longint(0), 2);
+
+  if (err = ZIP_OK) then { number of the disk with the start of the central directory }
+    err := ziplocal_putValue(zi^.filezip, longint(0), 2);
+
+  if (err = ZIP_OK) then { total number of entries in the central dir on this disk }
+    err := ziplocal_putValue(zi^.filezip, longint(zi^.number_entry), 2);
+
+  if (err = ZIP_OK) then { total number of entries in the central dir }
+    err := ziplocal_putValue(zi^.filezip, longint(zi^.number_entry), 2);
+
+  if (err = ZIP_OK) then { size of the central directory }
+    err := ziplocal_putValue(zi^.filezip, longint(size_centraldir), 4);
+
+  if (err = ZIP_OK) then { offset of start of central directory with respect to the
+                          starting disk number }
+    err := ziplocal_putValue(zi^.filezip, longint(centraldir_pos_inzip), 4);
+
+  if (err = ZIP_OK) then { zipfile comment length }
+    err := ziplocal_putValue(zi^.filezip, longint(size_global_comment), 2);
+
+  if ((err = ZIP_OK) and (size_global_comment > 0)) then
+    if fwrite(global_comment, integer(size_global_comment), 1, zi^.filezip) <> 1 then
+      err := ZIP_ERRNO;
+  fclose(zi^.filezip);
+  FreeMem(zi);
+
+  zipClose := err;
+end;
+
+end.

+ 3084 - 0
src/libraries/paszlib/paszlib_zipper.pp

@@ -0,0 +1,3084 @@
+{
+    $Id: header,v 1.3 2013/05/26 06:33:45 michael Exp $
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 1999-2014 by the Free Pascal development team
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program 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.
+
+ **********************************************************************}
+{$mode objfpc}
+{$h+}
+unit paszlib_Zipper;
+
+Interface
+
+Uses
+  {$IFDEF UNIX}
+   BaseUnix,
+  {$ENDIF}
+   SysUtils,Classes,paszlib_zstream;
+
+
+Const
+  { Signatures }
+  END_OF_CENTRAL_DIR_SIGNATURE               = $06054B50;
+  ZIP64_END_OF_CENTRAL_DIR_SIGNATURE         = $06064B50;
+  ZIP64_END_OF_CENTRAL_DIR_LOCATOR_SIGNATURE = $07064B50;
+  LOCAL_FILE_HEADER_SIGNATURE                = $04034B50;
+  CENTRAL_FILE_HEADER_SIGNATURE              = $02014B50;
+  ZIP64_HEADER_ID                            = $0001;
+  // infozip unicode path
+  INFOZIP_UNICODE_PATH_ID                    = $7075;
+
+const
+  OS_FAT  = 0; //MS-DOS and OS/2 (FAT/VFAT/FAT32)
+  OS_UNIX = 3;
+  OS_OS2  = 6; //OS/2 HPFS
+  OS_NTFS = 10;
+  OS_VFAT = 14;
+  OS_OSX  = 19;
+
+  UNIX_MASK = $F000;
+  UNIX_FIFO = $1000;
+  UNIX_CHAR = $2000;
+  UNIX_DIR  = $4000;
+  UNIX_BLK  = $6000;
+  UNIX_FILE = $8000;
+  UNIX_LINK = $A000;
+  UNIX_SOCK = $C000;
+
+
+  UNIX_RUSR = $0100;
+  UNIX_WUSR = $0080;
+  UNIX_XUSR = $0040;
+
+  UNIX_RGRP = $0020;
+  UNIX_WGRP = $0010;
+  UNIX_XGRP = $0008;
+
+  UNIX_ROTH = $0004;
+  UNIX_WOTH = $0002;
+  UNIX_XOTH = $0001;
+
+  UNIX_DEFAULT = UNIX_RUSR or UNIX_WUSR or UNIX_XUSR or UNIX_RGRP or UNIX_ROTH;
+
+Type
+   Local_File_Header_Type = Packed Record //1 per zipped file
+     Signature              :  LongInt; //4 bytes
+     Extract_Version_Reqd   :  Word; //if zip64: >= 45
+     {$warning TODO implement EFS/language enooding using UTF-8}
+     Bit_Flag               :  Word; //"General purpose bit flag in PKZip appnote
+     Compress_Method        :  Word;
+     Last_Mod_Time          :  Word;
+     Last_Mod_Date          :  Word;
+     Crc32                  :  LongWord;
+     Compressed_Size        :  LongWord;
+     Uncompressed_Size      :  LongWord;
+     Filename_Length        :  Word;
+     Extra_Field_Length     :  Word; //refers to Extensible data field size
+   end;
+
+   Extensible_Data_Field_Header_Type = Packed Record
+     // Beginning of extra field
+     // after local file header
+     // after central directory header
+     Header_ID              :  Word;
+     //e.g. $0001 (ZIP64_HEADER_ID) Zip64 extended information extra field
+     //     $0009 OS/2: extended attributes
+     //     $000a NTFS: (Win32 really)
+     //     $000d UNIX: uid, gid etc
+     Data_Size              :  Word; //size of following field data
+     //... field data should follow...
+   end;
+
+   Zip64_Extended_Info_Field_Type = Packed Record //goes after Extensible_Data_Field_Header_Type
+     // overrides Local and Central Directory data
+     // stored in extra field
+     Original_Size          :  QWord; //Uncompressed file
+     Compressed_Size        :  QWord; //Compressed data
+     Relative_Hdr_Offset    :  QWord; //Offset that leads to local header record
+     Disk_Start_Number      :  LongWord; //on which disk this file starts
+   end;
+
+  { Define the Central Directory record types }
+
+  Central_File_Header_Type = Packed Record
+    Signature            :  LongInt; //4 bytes
+    MadeBy_Version       :  Word; //if zip64: lower byte >= 45
+    Extract_Version_Reqd :  Word; //if zip64: >=45
+    Bit_Flag             :  Word; //General purpose bit flag in PKZip appnote
+    Compress_Method      :  Word;
+    Last_Mod_Time        :  Word;
+    Last_Mod_Date        :  Word;
+    Crc32                :  LongWord;
+    Compressed_Size      :  LongWord;
+    Uncompressed_Size    :  LongWord;
+    Filename_Length      :  Word;
+    Extra_Field_Length   :  Word;
+    File_Comment_Length  :  Word;
+    Starting_Disk_Num    :  Word;
+    Internal_Attributes  :  Word;
+    External_Attributes  :  LongWord;
+    Local_Header_Offset  :  LongWord; // if zip64: 0xFFFFFFFF
+  End;
+
+  End_of_Central_Dir_Type =  Packed Record //End of central directory record
+    //1 per zip file, near end, before comment
+    Signature               :  LongInt; //4 bytes
+    Disk_Number             :  Word;
+    Central_Dir_Start_Disk  :  Word;
+    Entries_This_Disk       :  Word;
+    Total_Entries           :  Word;
+    Central_Dir_Size        :  LongWord;
+    Start_Disk_Offset       :  LongWord;
+    ZipFile_Comment_Length  :  Word;
+  end;
+
+  Zip64_End_of_Central_Dir_type = Packed Record
+    Signature                 : LongInt;
+    Record_Size               : QWord;
+    Version_Made_By           : Word; //lower byte >= 45
+    Extract_Version_Reqd      : Word; //version >= 45
+    Disk_Number               : LongWord;
+    Central_Dir_Start_Disk    : LongWord;
+    Entries_This_Disk         : QWord;
+    Total_Entries             : QWord;
+    Central_Dir_Size          : QWord;
+    Start_Disk_Offset         : QWord;
+  end;
+
+  Zip64_End_of_Central_Dir_Locator_type = Packed Record //comes after Zip64_End_of_Central_Dir_type
+    Signature                           : LongInt;
+    Zip64_EOCD_Start_Disk               : LongWord; //Starting disk for Zip64 End of Central Directory record
+    Central_Dir_Zip64_EOCD_Offset       : QWord; //offset of Zip64 End of Central Directory record
+    Total_Disks                         : LongWord; //total number of disks (contained in zip)
+  end;
+
+Const
+  Crc_32_Tab : Array[0..255] of LongWord = (
+    $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
+  );
+
+Type
+
+  TProgressEvent = Procedure(Sender : TObject; Const Pct : Double) of object;
+  TProgressEventEx = Procedure(Sender : TObject; Const ATotPos, ATotSize: Int64) of object;
+  TOnEndOfFileEvent = Procedure(Sender : TObject; Const Ratio : Double) of object;
+  TOnStartFileEvent = Procedure(Sender : TObject; Const AFileName : String) of object;
+
+Type
+
+  { TCompressor }
+  TCompressor = Class(TObject)
+  private
+    FTerminated: Boolean;
+  Protected
+    FInFile     : TStream;        { I/O file variables                         }
+    FOutFile    : TStream;
+    FCrc32Val   : LongWord;       { CRC calculation variable                   }
+    FBufferSize : LongWord;
+    FOnPercent  : Integer;
+    FOnProgress : TProgressEvent;
+    Procedure UpdC32(Octet: Byte);
+  Public
+    Constructor Create(AInFile, AOutFile : TStream; ABufSize : LongWord); virtual;
+    Procedure Compress; Virtual; Abstract;
+    Class Function ZipID : Word; virtual; Abstract;
+    Class Function ZipVersionReqd: Word; virtual; Abstract;
+    Function ZipBitFlag: Word; virtual; Abstract;
+    Procedure Terminate;
+    Property BufferSize : LongWord read FBufferSize;
+    Property OnPercent : Integer Read FOnPercent Write FOnPercent;
+    Property OnProgress : TProgressEvent Read FOnProgress Write FOnProgress;
+    Property Crc32Val : LongWord Read FCrc32Val Write FCrc32Val;
+    Property Terminated : Boolean Read FTerminated;
+  end;
+
+  { TDeCompressor }
+  TDeCompressor = Class(TObject)
+  Protected
+    FInFile     : TStream;        { I/O file variables                         }
+    FOutFile    : TStream;
+    FCrc32Val   : LongWord;       { CRC calculation variable                   }
+    FBufferSize : LongWord;
+    FOnPercent  : Integer;
+    FOnProgress : TProgressEvent;
+    FOnProgressEx: TProgressEventEx;
+    FTotPos      : Int64;
+    FTotSize     : Int64;
+    FTerminated : Boolean;
+    Procedure UpdC32(Octet: Byte);
+  Public
+    Constructor Create(AInFile, AOutFile : TStream; ABufSize : LongWord); virtual;
+    Procedure DeCompress; Virtual; Abstract;
+    Procedure Terminate;
+    Class Function ZipID : Word; virtual; Abstract;
+    Property BufferSize : LongWord read FBufferSize;
+    Property OnPercent : Integer Read FOnPercent Write FOnPercent;
+    Property OnProgress : TProgressEvent Read FOnProgress Write FOnProgress;
+    Property OnProgressEx : TProgressEventEx Read FOnProgressEx Write FOnProgressEx;
+    Property Crc32Val : LongWord Read FCrc32Val Write FCrc32Val;
+    Property Terminated : Boolean Read FTerminated;
+  end;
+
+  { TShrinker }
+
+Const
+   TABLESIZE   =   8191;
+   FIRSTENTRY  =    257;
+
+Type
+  CodeRec =  Packed Record
+    Child   : Smallint;
+    Sibling : Smallint;
+    Suffix  : Byte;
+  end;
+  CodeArray   =  Array[0..TABLESIZE] of CodeRec;
+  TablePtr    =  ^CodeArray;
+
+  FreeListPtr    =  ^FreeListArray;
+  FreeListArray  =  Array[FIRSTENTRY..TABLESIZE] of Word;
+
+  BufPtr      =  PByte;
+
+  TShrinker = Class(TCompressor)
+  Private
+    FBufSize    : LongWord;
+    MaxInBufIdx :  LongWord;      { Count of valid chars in input buffer       }
+    InputEof    :  Boolean;       { End of file indicator                      }
+    CodeTable   :  TablePtr;      { Points to code table for LZW compression   }
+    FreeList    :  FreeListPtr;   { Table of free code table entries           }
+    NextFree    :  Word;          { Index into free list table                 }
+
+    ClearList   :  Array[0..1023] of Byte;  { Bit mapped structure used in     }
+                                            {    during adaptive resets        }
+    CodeSize    :  Byte;     { Size of codes (in bits) currently being written }
+    MaxCode     :  Word;   { Largest code that can be written in CodeSize bits }
+    InBufIdx,                     { Points to next char in buffer to be read   }
+    OutBufIdx   :  LongWord;      { Points to next free space in output buffer }
+    InBuf,                        { I/O buffers                                }
+    OutBuf      :  BufPtr;
+    FirstCh     :  Boolean;  { Flag indicating the START of a shrink operation }
+    TableFull   :  Boolean;  { Flag indicating a full symbol table             }
+    SaveByte    :  Byte;     { Output code buffer                              }
+    BitsUsed    :  Byte;     { Index into output code buffer                   }
+    BytesIn     :  LongWord;  { Count of input file bytes processed             }
+    BytesOut    :  LongWord;  { Count of output bytes                           }
+    FOnBytes    :  LongWord;
+    Procedure FillInputBuffer;
+    Procedure WriteOutputBuffer;
+    Procedure FlushOutput;
+    Procedure PutChar(B : Byte);
+    procedure PutCode(Code : Smallint);
+    Procedure InitializeCodeTable;
+    Procedure Prune(Parent : Word);
+    Procedure Clear_Table;
+    Procedure Table_Add(Prefix : Word; Suffix : Byte);
+    function  Table_Lookup(TargetPrefix : Smallint;
+                           TargetSuffix : Byte;
+                           Out FoundAt  : Smallint) : Boolean;
+    Procedure Shrink(Suffix : Smallint);
+    Procedure ProcessLine(Const Source : String);
+    Procedure DoOnProgress(Const Pct : Double); Virtual;
+  Public
+    Constructor Create(AInFile, AOutFile : TStream; ABufSize : LongWord); override;
+    Destructor Destroy; override;
+    Procedure Compress; override;
+    Class Function ZipID : Word; override;
+    Class Function ZipVersionReqd : Word; override;
+    Function ZipBitFlag : Word; override;
+  end;
+
+  { TDeflater }
+
+  TDeflater = Class(TCompressor)
+  private
+    FCompressionLevel: TCompressionlevel;
+  Public
+    Constructor Create(AInFile, AOutFile : TStream; ABufSize : LongWord);override;
+    Procedure Compress; override;
+    Class Function ZipID : Word; override;
+    Class Function ZipVersionReqd : Word; override;
+    Function ZipBitFlag : Word; override;
+    Property CompressionLevel : TCompressionlevel Read FCompressionLevel Write FCompressionLevel;
+  end;
+
+  { TInflater }
+
+  TInflater = Class(TDeCompressor)
+  Public
+    Constructor Create(AInFile, AOutFile : TStream; ABufSize : LongWord);override;
+    Procedure DeCompress; override;
+    Class Function ZipID : Word; override;
+  end;
+
+  { TZipFileEntry }
+
+  TZipFileEntry = Class(TCollectionItem)
+  private
+    FArchiveFileName: String; //Name of the file as it appears in the zip file list
+    FUTF8FileName : UTF8String;
+    FUTF8DiskFileName : UTF8String;
+    FAttributes: LongWord;
+    FDateTime: TDateTime;
+    FDiskFileName: String; {Name of the file on disk (i.e. uncompressed. Can be empty if based on a stream.);
+    uses local OS/filesystem directory separators}
+    FHeaderPos: int64;
+    FNeedsZip64: Boolean; //flags whether filesize is big enough so we need a zip64 entry
+    FOS: Byte;
+    FSize: Int64;
+    FStream: TStream;
+    FCompressionLevel: TCompressionlevel;
+    function GetArchiveFileName: String;
+    function GetUTF8ArchiveFileName: UTF8String;
+    function GetUTF8DiskFileName: UTF8String;
+    procedure SetArchiveFileName(Const AValue: String);
+    procedure SetDiskFileName(Const AValue: String);
+    procedure SetUTF8ArchiveFileName(AValue: UTF8String);
+    procedure SetUTF8DiskFileName(AValue: UTF8String);
+  Protected
+    // For multi-disk support, a disk number property could be added here.
+    Property HdrPos : int64 Read FHeaderPos Write FheaderPos;
+    Property NeedsZip64 : boolean Read FNeedsZip64 Write FNeedsZip64;
+  Public
+    constructor Create(ACollection: TCollection); override;
+    function IsDirectory: Boolean;
+    function IsLink: Boolean;
+    Procedure Assign(Source : TPersistent); override;
+    Property Stream : TStream Read FStream Write FStream;
+  Published
+    Property ArchiveFileName : String Read GetArchiveFileName Write SetArchiveFileName;
+    Property UTF8ArchiveFileName : UTF8String Read GetUTF8ArchiveFileName Write SetUTF8ArchiveFileName;
+    Property DiskFileName : String Read FDiskFileName Write SetDiskFileName;
+    Property UTF8DiskFileName : UTF8String Read GetUTF8DiskFileName Write SetUTF8DiskFileName;
+    Property Size : Int64 Read FSize Write FSize;
+    Property DateTime : TDateTime Read FDateTime Write FDateTime;
+    property OS: Byte read FOS write FOS;
+    property Attributes: LongWord read FAttributes write FAttributes;
+    Property CompressionLevel: TCompressionlevel read FCompressionLevel write FCompressionLevel;
+  end;
+
+  { TZipFileEntries }
+
+  TZipFileEntries = Class(TCollection)
+  private
+    function GetZ(AIndex : Integer): TZipFileEntry;
+    procedure SetZ(AIndex : Integer; const AValue: TZipFileEntry);
+  Public
+    Function AddFileEntry(Const ADiskFileName : String): TZipFileEntry;
+    Function AddFileEntry(Const ADiskFileName, AArchiveFileName : String): TZipFileEntry;
+    Function AddFileEntry(Const AStream : TSTream; Const AArchiveFileName : String): TZipFileEntry;
+    Procedure AddFileEntries(Const List : TStrings);
+    Property Entries[AIndex : Integer] : TZipFileEntry Read GetZ Write SetZ; default;
+  end;
+
+  { TZipper }
+
+  TZipper = Class(TObject)
+  Private
+    FEntries        : TZipFileEntries;
+    FTerminated: Boolean;
+    FZipping        : Boolean;
+    FBufSize        : LongWord;
+    FFileName       : RawByteString;         { Name of resulting Zip file                 }
+    FFileComment    : String;
+    FFiles          : TStrings;
+    FInMemSize      : Int64;
+    FZipFileNeedsZip64 : Boolean; //flags whether at least one file is big enough to require a zip64 record
+    FOutStream      : TStream;
+    FInFile         : TStream;     { I/O file variables                         }
+    LocalHdr        : Local_File_Header_Type;
+    LocalZip64ExtHdr: Extensible_Data_Field_Header_Type; //Extra field header fixed to zip64 (i.e. .ID=1)
+    LocalZip64Fld   : Zip64_Extended_Info_Field_Type; //header is in LocalZip64ExtHdr
+    CentralHdr      : Central_File_Header_Type;
+    EndHdr          : End_of_Central_Dir_Type;
+    FOnPercent      : LongInt;
+    FOnProgress     : TProgressEvent;
+    FOnEndOfFile    : TOnEndOfFileEvent;
+    FOnStartFile    : TOnStartFileEvent;
+    FCurrentCompressor : TCompressor;
+    function CheckEntries: Integer;
+    procedure SetEntries(const AValue: TZipFileEntries);
+  Protected
+    Procedure CloseInput(Item : TZipFileEntry);
+    Procedure StartZipFile(Item : TZipFileEntry);
+    Function  UpdateZipHeader(Item : TZipFileEntry; FZip : TStream; ACRC : LongWord;AMethod : Word; AZipVersionReqd : Word; AZipBitFlag : Word) : Boolean;
+    Procedure BuildZipDirectory; //Builds central directory based on local headers
+    Procedure DoEndOfFile;
+    Procedure ZipOneFile(Item : TZipFileEntry); virtual;
+    Function  OpenInput(Item : TZipFileEntry) : Boolean;
+    Procedure GetFileInfo;
+    Procedure SetBufSize(Value : LongWord);
+    Procedure SetFileName(Value : RawByteString);
+    Function CreateCompressor(Item : TZipFileEntry; AinFile,AZipStream : TStream) : TCompressor; virtual;
+    Property NeedsZip64 : boolean Read FZipFileNeedsZip64 Write FZipFileNeedsZip64;
+  Public
+    Constructor Create;
+    Destructor Destroy;override;
+    Procedure ZipAllFiles; virtual;
+    // Saves zip to file and changes FileName
+    Procedure SaveToFile(AFileName: RawByteString);
+    // Saves zip to stream
+    Procedure SaveToStream(AStream: TStream);
+    // Zips specified files into a zip with name AFileName
+    Procedure ZipFiles(AFileName : RawByteString; FileList : TStrings);
+    Procedure ZipFiles(FileList : TStrings);
+    // Zips specified entries into a zip with name AFileName
+    Procedure ZipFiles(AFileName : RawByteString; Entries : TZipFileEntries);
+    Procedure ZipFiles(Entries : TZipFileEntries);
+    Procedure Clear;
+    Procedure Terminate;
+  Public
+    Property BufferSize : LongWord Read FBufSize Write SetBufSize;
+    Property OnPercent : Integer Read FOnPercent Write FOnPercent;
+    Property OnProgress : TProgressEvent Read FOnProgress Write FOnProgress;
+    Property OnStartFile : TOnStartFileEvent Read FOnStartFile Write FOnStartFile;
+    Property OnEndFile : TOnEndOfFileEvent Read FOnEndOfFile Write FOnEndOfFile;
+    Property FileName : RawByteString Read FFileName Write SetFileName;
+    Property FileComment: String Read FFileComment Write FFileComment;
+    // Deprecated. Use Entries.AddFileEntry(FileName) or Entries.AddFileEntries(List) instead.
+    Property Files : TStrings Read FFiles; deprecated;
+    Property InMemSize : Int64 Read FInMemSize Write FInMemSize;
+    Property Entries : TZipFileEntries Read FEntries Write SetEntries;
+    Property Terminated : Boolean Read FTerminated;
+  end;
+
+  { TFullZipFileEntry }
+
+  TFullZipFileEntry = Class(TZipFileEntry)
+  private
+    FBitFlags: Word;
+    FCompressedSize: QWord;
+    FCompressMethod: Word;
+    FCRC32: LongWord;
+  Public
+    Property BitFlags : Word Read FBitFlags;
+    Property CompressMethod : Word Read FCompressMethod;
+    Property CompressedSize : QWord Read FCompressedSize;
+    property CRC32: LongWord read FCRC32 write FCRC32;
+  end;
+
+  TOnCustomStreamEvent = Procedure(Sender : TObject; var AStream : TStream; AItem : TFullZipFileEntry) of object;
+  TCustomInputStreamEvent = Procedure(Sender: TObject; var AStream: TStream) of object;
+
+  { TFullZipFileEntries }
+
+  TFullZipFileEntries = Class(TZipFileEntries)
+  private
+    function GetFZ(AIndex : Integer): TFullZipFileEntry;
+    procedure SetFZ(AIndex : Integer; const AValue: TFullZipFileEntry);
+  Public
+    Property FullEntries[AIndex : Integer] : TFullZipFileEntry Read GetFZ Write SetFZ; default;
+  end;
+
+  { TUnZipper }
+
+  TUnZipper = Class(TObject)
+  Private
+    FOnCloseInputStream: TCustomInputStreamEvent;
+    FOnCreateStream: TOnCustomStreamEvent;
+    FOnDoneStream: TOnCustomStreamEvent;
+    FOnOpenInputStream: TCustomInputStreamEvent;
+    FUnZipping  : Boolean;
+    FBufSize    : LongWord;
+    FFileName   : RawByteString;         { Name of resulting Zip file                 }
+    FOutputPath : RawByteString;
+    FFileComment: String;
+    FEntries    : TFullZipFileEntries;
+    FFiles      : TStrings;
+    FUseUTF8    : Boolean;
+    FFlat       : Boolean;
+    FZipStream  : TStream;     { I/O file variables                         }
+    LocalHdr    : Local_File_Header_Type; //Local header, before compressed file data
+    LocalZip64Fld   : Zip64_Extended_Info_Field_Type; //header is in LocalZip64ExtHdr
+    CentralHdr  : Central_File_Header_Type;
+    FTotPos     : Int64;
+    FTotSize    : Int64;
+    FTerminated: Boolean;
+    FOnPercent  : LongInt;
+    FOnProgress : TProgressEvent;
+    FOnProgressEx : TProgressEventEx;
+    FOnEndOfFile : TOnEndOfFileEvent;
+    FOnStartFile : TOnStartFileEvent;
+    FCurrentDecompressor: TDecompressor;
+    function CalcTotalSize(AllFiles: Boolean): Int64;
+    function IsMatch(I: TFullZipFileEntry): Boolean;
+  Protected
+    Procedure OpenInput;
+    Procedure CloseOutput(Item : TFullZipFileEntry; var OutStream: TStream);
+    Procedure CloseInput;
+    Procedure FindEndHeaders(
+      out AEndHdr: End_of_Central_Dir_Type;
+      out AEndHdrPos: Int64;
+      out AEndZip64Hdr: Zip64_End_of_Central_Dir_type;
+      out AEndZip64HdrPos: Int64);
+    Procedure ReadZipDirectory;
+    Procedure ReadZipHeader(Item : TFullZipFileEntry; out AMethod : Word);
+    Procedure DoEndOfFile;
+    Procedure UnZipOneFile(Item : TFullZipFileEntry); virtual;
+    Function  OpenOutput(OutFileName : RawByteString; Out OutStream: TStream; Item : TFullZipFileEntry) : Boolean;
+    Procedure SetBufSize(Value : LongWord);
+    Procedure SetFileName(Value : RawByteString);
+    Procedure SetOutputPath(Value: RawByteString);
+    Function CreateDeCompressor(Item : TZipFileEntry; AMethod : Word;AZipFile,AOutFile : TStream) : TDeCompressor; virtual;
+  Public
+    Constructor Create;
+    Destructor Destroy;override;
+    Procedure UnZipAllFiles; virtual;
+    Procedure UnZipFiles(AFileName : RawByteString; FileList : TStrings);
+    Procedure UnZipFiles(FileList : TStrings);
+    Procedure UnZipAllFiles(AFileName : RawByteString);
+    Procedure Clear;
+    Procedure Examine;
+    Procedure Terminate;
+  Public
+    Property BufferSize : LongWord Read FBufSize Write SetBufSize;
+    Property OnOpenInputStream: TCustomInputStreamEvent read FOnOpenInputStream write FOnOpenInputStream;
+    Property OnCloseInputStream: TCustomInputStreamEvent read FOnCloseInputStream write FOnCloseInputStream;
+    Property OnCreateStream : TOnCustomStreamEvent Read FOnCreateStream Write FOnCreateStream;
+    Property OnDoneStream : TOnCustomStreamEvent Read FOnDoneStream Write FOnDoneStream;
+    Property OnPercent : Integer Read FOnPercent Write FOnPercent;
+    Property OnProgress : TProgressEvent Read FOnProgress Write FOnProgress;
+    Property OnProgressEx : TProgressEventEx Read FOnProgressEx Write FOnProgressEx;
+    Property OnStartFile : TOnStartFileEvent Read FOnStartFile Write FOnStartFile;
+    Property OnEndFile : TOnEndOfFileEvent Read FOnEndOfFile Write FOnEndOfFile;
+    Property FileName : RawByteString Read FFileName Write SetFileName;
+    Property OutputPath : RawByteString Read FOutputPath Write SetOutputPath;
+    Property FileComment: String Read FFileComment;
+    Property Files : TStrings Read FFiles;
+    Property Entries : TFullZipFileEntries Read FEntries;
+    Property UseUTF8 : Boolean Read FUseUTF8 Write FUseUTF8;
+    Property Flat : Boolean Read FFlat Write FFlat; // enable flat extraction, like -j when using unzip
+    Property Terminated : Boolean Read FTerminated;
+  end;
+
+  EZipError = Class(Exception);
+
+Implementation
+
+uses rtlconsts;
+
+ResourceString
+  SErrBufsizeChange = 'Changing buffer size is not allowed while (un)zipping.';
+  SErrFileChange = 'Changing output file name is not allowed while (un)zipping.';
+  SErrInvalidCRC = 'Invalid CRC checksum while unzipping %s.';
+  SErrCorruptZIP = 'Corrupt ZIP file %s.';
+  SErrUnsupportedCompressionFormat = 'Unsupported compression format %d';
+  SErrUnsupportedMultipleDisksCD = 'A central directory split over multiple disks is unsupported.';
+  SErrMaxEntries = 'Encountered %d file entries; maximum supported is %d.';
+  SErrMissingFileName = 'Missing filename in entry %d.';
+  SErrMissingArchiveName = 'Missing archive filename in streamed entry %d.';
+  SErrFileDoesNotExist = 'File "%s" does not exist.';
+  SErrPosTooLarge = 'Position/offset %d is larger than maximum supported %d.';
+  SErrNoFileName = 'No archive filename for examine operation.';
+  SErrNoStream = 'No stream is opened.';
+  SErrEncryptionNotSupported = 'Cannot unzip item "%s" : encryption is not supported.';
+  SErrPatchSetNotSupported = 'Cannot unzip item "%s" : Patch sets are not supported.';
+
+{ ---------------------------------------------------------------------
+    Auxiliary
+  ---------------------------------------------------------------------}
+Type
+  // A local version of TFileStream which uses rawbytestring. It
+  TFileStream = class(THandleStream)
+  Private
+    FFileName : RawBytestring;
+  public
+    constructor Create(const AFileName: RawBytestring; Mode: Word);
+    constructor Create(const AFileName: RawBytestring; Mode: Word; Rights: Cardinal);
+    destructor Destroy; override;
+    property FileName : RawBytestring Read FFilename;
+  end;
+  constructor TFileStream.Create(const AFileName: rawbytestring; Mode: Word);
+
+  begin
+    Create(AFileName,Mode,438);
+  end;
+
+
+  constructor TFileStream.Create(const AFileName: rawbytestring; Mode: Word; Rights: Cardinal);
+
+  Var
+    H : Thandle;
+
+  begin
+    FFileName:=AFileName;
+    If (Mode and fmCreate) > 0 then
+      H:=FileCreate(AFileName,Mode,Rights)
+    else
+      H:=FileOpen(AFileName,Mode);
+
+    If (THandle(H)=feInvalidHandle) then
+      If Mode=fmcreate then
+        raise EFCreateError.createfmt(SFCreateError,[AFileName])
+      else
+        raise EFOpenError.Createfmt(SFOpenError,[AFilename]);
+    Inherited Create(H);
+  end;
+
+
+  destructor TFileStream.Destroy;
+
+  begin
+    FileClose(Handle);
+  end;
+
+{$IFDEF FPC_BIG_ENDIAN}
+function SwapLFH(const Values: Local_File_Header_Type): Local_File_Header_Type;
+begin
+  with Values do
+  begin
+    Result.Signature := SwapEndian(Signature);
+    Result.Extract_Version_Reqd := SwapEndian(Extract_Version_Reqd);
+    Result.Bit_Flag := SwapEndian(Bit_Flag);
+    Result.Compress_Method := SwapEndian(Compress_Method);
+    Result.Last_Mod_Time := SwapEndian(Last_Mod_Time);
+    Result.Last_Mod_Date := SwapEndian(Last_Mod_Date);
+    Result.Crc32 := SwapEndian(Crc32);
+    Result.Compressed_Size := SwapEndian(Compressed_Size);
+    Result.Uncompressed_Size := SwapEndian(Uncompressed_Size);
+    Result.Filename_Length := SwapEndian(Filename_Length);
+    Result.Extra_Field_Length := SwapEndian(Extra_Field_Length);
+  end;
+end;
+
+function SwapEDFH(const Values: Extensible_Data_Field_Header_Type): Extensible_Data_Field_Header_Type;
+begin
+  with Values do
+  begin
+    Result.Header_ID := SwapEndian(Header_ID);
+    Result.Data_Size := SwapEndian(Data_Size);
+  end;
+end;
+
+function SwapZ64EIF(const Values: Zip64_Extended_Info_Field_Type): Zip64_Extended_Info_Field_Type;
+begin
+  with Values do
+  begin
+    Result.Original_Size := SwapEndian(Original_Size);
+    Result.Compressed_Size := SwapEndian(Compressed_Size);
+    Result.Relative_Hdr_Offset := SwapEndian(Relative_Hdr_Offset);
+    Result.Disk_Start_Number := SwapEndian(Disk_Start_Number);
+  end;
+end;
+
+function SwapCFH(const Values: Central_File_Header_Type): Central_File_Header_Type;
+begin
+  with Values do
+  begin
+    Result.Signature := SwapEndian(Signature);
+    Result.MadeBy_Version := SwapEndian(MadeBy_Version);
+    Result.Extract_Version_Reqd := SwapEndian(Extract_Version_Reqd);
+    Result.Bit_Flag := SwapEndian(Bit_Flag);
+    Result.Compress_Method := SwapEndian(Compress_Method);
+    Result.Last_Mod_Time := SwapEndian(Last_Mod_Time);
+    Result.Last_Mod_Date := SwapEndian(Last_Mod_Date);
+    Result.Crc32 := SwapEndian(Crc32);
+    Result.Compressed_Size := SwapEndian(Compressed_Size);
+    Result.Uncompressed_Size := SwapEndian(Uncompressed_Size);
+    Result.Filename_Length := SwapEndian(Filename_Length);
+    Result.Extra_Field_Length := SwapEndian(Extra_Field_Length);
+    Result.File_Comment_Length := SwapEndian(File_Comment_Length);
+    Result.Starting_Disk_Num := SwapEndian(Starting_Disk_Num);
+    Result.Internal_Attributes := SwapEndian(Internal_Attributes);
+    Result.External_Attributes := SwapEndian(External_Attributes);
+    Result.Local_Header_Offset := SwapEndian(Local_Header_Offset);
+  end;
+end;
+
+function SwapECD(const Values: End_of_Central_Dir_Type): End_of_Central_Dir_Type;
+begin
+  with Values do
+  begin
+    Result.Signature := SwapEndian(Signature);
+    Result.Disk_Number := SwapEndian(Disk_Number);
+    Result.Central_Dir_Start_Disk := SwapEndian(Central_Dir_Start_Disk);
+    Result.Entries_This_Disk := SwapEndian(Entries_This_Disk);
+    Result.Total_Entries := SwapEndian(Total_Entries);
+    Result.Central_Dir_Size := SwapEndian(Central_Dir_Size);
+    Result.Start_Disk_Offset := SwapEndian(Start_Disk_Offset);
+    Result.ZipFile_Comment_Length := SwapEndian(ZipFile_Comment_Length);
+  end;
+end;
+
+function SwapZ64ECD(const Values: Zip64_End_of_Central_Dir_Type): Zip64_End_of_Central_Dir_Type;
+begin
+  with Values do
+  begin
+    Result.Signature := SwapEndian(Signature);
+    Result.Record_Size := SwapEndian(Record_Size);
+    Result.Version_Made_By := SwapEndian(Version_Made_By);
+    Result.Extract_Version_Reqd := SwapEndian(Extract_Version_Reqd);
+    Result.Disk_Number := SwapEndian(Disk_Number);
+    Result.Central_Dir_Start_Disk := SwapEndian(Central_Dir_Start_Disk);
+    Result.Entries_This_Disk := SwapEndian(Entries_This_Disk);
+    Result.Total_Entries := SwapEndian(Total_Entries);
+    Result.Central_Dir_Size := SwapEndian(Central_Dir_Size);
+    Result.Start_Disk_Offset := SwapEndian(Start_Disk_Offset);
+  end;
+end;
+
+function SwapZ64ECDL(const Values: Zip64_End_of_Central_Dir_Locator_type): Zip64_End_of_Central_Dir_Locator_type;
+begin
+  with Values do
+  begin
+    Result.Signature := SwapEndian(Signature);
+    Result.Zip64_EOCD_Start_Disk := SwapEndian(Zip64_EOCD_Start_Disk);
+    Result.Central_Dir_Zip64_EOCD_Offset := SwapEndian(Central_Dir_Zip64_EOCD_Offset);
+    Result.Total_Disks := SwapEndian(Total_Disks);
+  end;
+end;
+{$ENDIF FPC_BIG_ENDIAN}
+
+Procedure DateTimeToZipDateTime(DT : TDateTime; out ZD,ZT : Word);
+
+Var
+  Y,M,D,H,N,S,MS : Word;
+
+begin
+  DecodeDate(DT,Y,M,D);
+  DecodeTime(DT,H,N,S,MS);
+  if Y<1980 then
+  begin
+    // Invalid date/time; set to earliest possible
+    Y:=0;
+    M:=1;
+    D:=1;
+    H:=0;
+    N:=0;
+    S:=0;
+    MS:=0;
+  end
+  else
+  begin
+    Y:=Y-1980;
+  end;
+  ZD:=d+(32*M)+(512*Y);
+  ZT:=(S div 2)+(32*N)+(2048*h);
+end;
+
+Procedure ZipDateTimeToDateTime(ZD,ZT : Word;out DT : TDateTime);
+
+Var
+  Y,M,D,H,N,S,MS : Word;
+
+begin
+  MS:=0;
+  S:=(ZT and 31) shl 1;
+  N:=(ZT shr 5) and 63;
+  H:=ZT shr 11;
+  D:=ZD and 31;
+  M:=(ZD shr 5) and 15;
+  Y:=((ZD shr 9) and 127)+1980;
+
+  if M < 1 then M := 1;
+  if D < 1 then D := 1;
+  DT:=ComposeDateTime(EncodeDate(Y,M,D),EncodeTime(H,N,S,MS));
+end;
+
+
+
+function ZipUnixAttrsToFatAttrs(const Name: String; Attrs: Longint): Longint;
+begin
+  Result := faArchive;
+
+  if (Pos('.', Name) = 1) and (Name <> '.') and (Name <> '..') then
+    Result := Result + faHidden;
+  case (Attrs and UNIX_MASK) of
+    UNIX_DIR:  Result := Result + faDirectory;
+    UNIX_LINK: Result := Result + faSymLink;
+    UNIX_FIFO, UNIX_CHAR, UNIX_BLK, UNIX_SOCK:
+               Result := Result + faSysFile;
+  end;
+
+  if (Attrs and UNIX_WUSR) = 0 then
+    Result := Result + faReadOnly;
+end;
+
+function ZipFatAttrsToUnixAttrs(Attrs: Longint): Longint;
+begin
+  Result := UNIX_DEFAULT;
+  if (faReadOnly and Attrs) > 0 then
+    Result := Result and not (UNIX_WUSR);
+
+  if (faSymLink and Attrs) > 0 then
+    Result := Result or UNIX_LINK
+  else
+    if (faDirectory and Attrs) > 0 then
+      Result := Result or UNIX_DIR
+    else
+      Result := Result or UNIX_FILE;
+end;
+
+function CRC32Str(const s:string):DWord;
+var
+  i:Integer;
+begin
+  Result:=$FFFFFFFF;
+  if Length(S)>0 then
+    for i:=1 to Length(s) do
+      Result:=Crc_32_Tab[Byte(Result XOR LongInt(s[i]))] XOR ((Result SHR 8) AND $00FFFFFF);
+  Result:=not Result;
+end;
+
+{ ---------------------------------------------------------------------
+    TDeCompressor
+  ---------------------------------------------------------------------}
+
+
+Procedure TDeCompressor.UpdC32(Octet: Byte);
+
+Begin
+  FCrc32Val := Crc_32_Tab[Byte(FCrc32Val XOR LongInt(Octet))] XOR ((FCrc32Val SHR 8) AND $00FFFFFF);
+end;
+
+constructor TDeCompressor.Create(AInFile, AOutFile: TStream; ABufSize: LongWord);
+begin
+  FinFile:=AInFile;
+  FoutFile:=AOutFile;
+  FBufferSize:=ABufSize;
+  CRC32Val:=$FFFFFFFF;
+end;
+
+procedure TDeCompressor.Terminate;
+begin
+  FTerminated:=True;
+end;
+
+
+{ ---------------------------------------------------------------------
+    TCompressor
+  ---------------------------------------------------------------------}
+
+
+Procedure TCompressor.UpdC32(Octet: Byte);
+
+Begin
+  FCrc32Val := Crc_32_Tab[Byte(FCrc32Val XOR LongInt(Octet))] XOR ((FCrc32Val SHR 8) AND $00FFFFFF);
+end;
+
+constructor TCompressor.Create(AInFile, AOutFile: TStream; ABufSize: LongWord);
+begin
+  FinFile:=AInFile;
+  FoutFile:=AOutFile;
+  FBufferSize:=ABufSize;
+  CRC32Val:=$FFFFFFFF;
+end;
+
+procedure TCompressor.Terminate;
+begin
+  FTerminated:=True;
+end;
+
+
+{ ---------------------------------------------------------------------
+    TDeflater
+  ---------------------------------------------------------------------}
+
+constructor TDeflater.Create(AInFile, AOutFile: TStream; ABufSize: LongWord);
+begin
+  Inherited;
+  FCompressionLevel:=clDefault;
+end;
+
+
+procedure TDeflater.Compress;
+Var
+  Buf : PByte;
+  I,Count,NewCount : integer;
+  C : TCompressionStream;
+  BytesNow : Int64;
+  NextMark : Int64;
+  OnBytes : Int64;
+  FSize : Int64;
+begin
+  CRC32Val:=$FFFFFFFF;
+  Buf:=GetMem(FBufferSize);
+  if FOnPercent = 0 then
+    FOnPercent := 1;
+  OnBytes:=Round((FInFile.Size * FOnPercent) / 100);
+  BytesNow:=0;
+  NextMark := OnBytes;
+  FSize:=FInfile.Size;
+  Try
+    C:=TCompressionStream.Create(FCompressionLevel,FOutFile,True);
+    Try
+      if assigned(FOnProgress) then
+        fOnProgress(self,0);
+      Repeat
+        Count:=FInFile.Read(Buf^,FBufferSize);
+        For I:=0 to Count-1 do
+          UpdC32(Buf[i]);
+        NewCount:=Count;
+        while (NewCount>0) do
+          NewCount:=NewCount-C.Write(Buf^,NewCount);
+        inc(BytesNow,Count);
+        if BytesNow>NextMark Then
+          begin
+            if (FSize>0) and assigned(FOnProgress) Then
+              FOnProgress(self,100 * ( BytesNow / FSize));
+            inc(NextMark,OnBytes);
+          end;
+      Until (Count=0) or Terminated;
+    Finally
+      C.Free;
+    end;
+  Finally
+    FreeMem(Buf);
+  end;
+  if assigned(FOnProgress) then
+    fOnProgress(self,100.0);
+  Crc32Val:=NOT Crc32Val;
+end;
+
+class function TDeflater.ZipID: Word;
+begin
+  Result:=8;
+end;
+
+class function TDeflater.ZipVersionReqd: Word;
+begin
+  Result:=20;
+end;
+
+function TDeflater.ZipBitFlag: Word;
+begin
+  case CompressionLevel of
+    clnone: Result := %110;
+    clfastest: Result := %100;
+    cldefault: Result := %000;
+    clmax: Result := %010;
+    else
+      Result := 0;
+  end;
+end;
+
+{ ---------------------------------------------------------------------
+    TInflater
+  ---------------------------------------------------------------------}
+
+constructor TInflater.Create(AInFile, AOutFile: TStream; ABufSize: LongWord);
+begin
+  Inherited;
+end;
+
+
+procedure TInflater.DeCompress;
+
+Var
+  Buf : PByte;
+  I,Count : Integer;
+  C : TDeCompressionStream;
+  BytesNow : Integer;
+  NextMark : Integer;
+  OnBytes  : Integer;
+  FSize    : Integer;
+
+begin
+  CRC32Val:=$FFFFFFFF;
+  if FOnPercent = 0 then
+    FOnPercent := 1;
+  OnBytes:=Round((FInFile.Size * FOnPercent) / 100);
+  BytesNow:=0; NextMark := OnBytes;
+  FSize:=FInfile.Size;
+
+  If Assigned(FOnProgress) then
+    fOnProgress(self,0);
+
+  Buf:=GetMem(FBufferSize);
+  Try
+    C:=TDeCompressionStream.Create(FInFile,True);
+    Try
+      Repeat
+        Count:=C.Read(Buf^,FBufferSize);
+        For I:=0 to Count-1 do
+          UpdC32(Buf[i]);
+        FOutFile.Write(Buf^,Count);
+        inc(BytesNow,Count);
+        if BytesNow>NextMark Then
+           begin
+             if (FSize>0) and assigned(FOnProgress) Then
+               FOnProgress(self,100 * ( BytesNow / FSize));
+             if assigned(FOnProgressEx) Then
+               FOnProgressEx(Self, FTotPos + BytesNow, FTotSize);
+             inc(NextMark,OnBytes);
+           end;
+      Until (Count=0) or Terminated;
+      FTotPos := FTotPos + FOutFile.Size;
+    Finally
+      C.Free;
+    end;
+  Finally
+    FreeMem(Buf);
+  end;
+ if assigned(FOnProgress) then
+   fOnProgress(self,100.0);
+ if assigned(FOnProgressEx) then
+   FOnProgressEx(Self, FTotPos, FTotSize);
+  Crc32Val:=NOT Crc32Val;
+end;
+
+class function TInflater.ZipID: Word;
+begin
+  Result:=8;
+end;
+
+
+{ ---------------------------------------------------------------------
+    TShrinker
+  ---------------------------------------------------------------------}
+
+Const
+   DefaultInMemSize = 256*1024; { Files larger than 256k are processed on disk   }
+   DefaultBufSize =  16384;     { Use 16K file buffers                             }
+   MINBITS     =      9;        { Starting code size of 9 bits                     }
+   MAXBITS     =     13;        { Maximum code size of 13 bits                     }
+   SPECIAL     =    256;        { Special function code                            }
+   INCSIZE     =      1;        { Code indicating a jump in code size              }
+   CLEARCODE   =      2;        { Code indicating code table has been cleared      }
+   STDATTR     =    faAnyFile;  { Standard file attribute for DOS Find First/Next  }
+
+constructor TShrinker.Create(AInFile, AOutFile : TStream; ABufSize : LongWord);
+begin
+  Inherited;
+  FBufSize:=ABufSize;
+  InBuf:=GetMem(FBUFSIZE);
+  OutBuf:=GetMem(FBUFSIZE);
+  CodeTable:=GetMem(SizeOf(CodeTable^));
+  FreeList:=GetMem(SizeOf(FreeList^));
+end;
+
+destructor TShrinker.Destroy;
+begin
+  FreeMem(CodeTable);
+  FreeMem(FreeList);
+  FreeMem(InBuf);
+  FreeMem(OutBuf);
+  inherited Destroy;
+end;
+
+Procedure TShrinker.Compress;
+
+Var
+   OneString : String;
+   Remaining : Word;
+
+begin
+  BytesIn := 1;
+  BytesOut := 1;
+  InitializeCodeTable;
+  FillInputBuffer;
+  FirstCh:= TRUE;
+  Crc32Val:=$FFFFFFFF;
+  FOnBytes:=Round((FInFile.Size * FOnPercent) / 100);
+  While Not InputEof do
+    begin
+    Remaining:=Succ(MaxInBufIdx - InBufIdx);
+    If Remaining>255 then
+      Remaining:=255;
+    If Remaining=0 then
+      FillInputBuffer
+    else
+      begin
+      SetLength(OneString,Remaining);
+      Move(InBuf[InBufIdx], OneString[1], Remaining);
+      Inc(InBufIdx, Remaining);
+      ProcessLine(OneString);
+      end;
+    end;
+   Crc32Val := Not Crc32Val;
+   ProcessLine('');
+end;
+
+class function TShrinker.ZipID: Word;
+begin
+  Result:=1;
+end;
+
+class function TShrinker.ZipVersionReqd: Word;
+begin
+  Result:=10;
+end;
+
+function TShrinker.ZipBitFlag: Word;
+begin
+  Result:=0;
+end;
+
+
+Procedure TShrinker.DoOnProgress(Const Pct: Double);
+
+begin
+  If Assigned(FOnProgress) then
+    FOnProgress(Self,Pct);
+end;
+
+
+Procedure TShrinker.FillInputBuffer;
+
+Begin
+   MaxInbufIDx:=FInfile.Read(InBuf[0], FBufSize);
+   If MaxInbufIDx=0 then
+      InputEof := TRUE
+   else
+      InputEOF := FALSE;
+   InBufIdx := 0;
+end;
+
+
+Procedure TShrinker.WriteOutputBuffer;
+Begin
+  FOutFile.WriteBuffer(OutBuf[0], OutBufIdx);
+  OutBufIdx := 0;
+end;
+
+
+Procedure TShrinker.PutChar(B : Byte);
+
+Begin
+  OutBuf[OutBufIdx] := B;
+  Inc(OutBufIdx);
+  If OutBufIdx>=FBufSize then
+    WriteOutputBuffer;
+  Inc(BytesOut);
+end;
+
+Procedure TShrinker.FlushOutput;
+Begin
+  If OutBufIdx>0 then
+    WriteOutputBuffer;
+End;
+
+
+procedure TShrinker.PutCode(Code : Smallint);
+
+var
+  ACode : LongInt;
+  XSize : Smallint;
+
+begin
+  if (Code=-1) then
+    begin
+    if BitsUsed>0 then
+      PutChar(SaveByte);
+    end
+  else
+    begin
+    ACode := Longint(Code);
+    XSize := CodeSize+BitsUsed;
+    ACode := (ACode shl BitsUsed) or SaveByte;
+    while (XSize div 8) > 0 do
+      begin
+      PutChar(Lo(ACode));
+      ACode := ACode shr 8;
+      Dec(XSize,8);
+      end;
+    BitsUsed := XSize;
+    SaveByte := Lo(ACode);
+    end;
+end;
+
+
+Procedure TShrinker.InitializeCodeTable;
+
+Var
+   I  :  Word;
+Begin
+   For I := 0 to TableSize do
+     begin
+     With CodeTable^[I] do
+       begin
+       Child := -1;
+       Sibling := -1;
+       If (I<=255) then
+         Suffix := I;
+       end;
+     If (I>=257) then
+       FreeList^[I] := I;
+     end;
+   NextFree  := FIRSTENTRY;
+   TableFull := FALSE;
+end;
+
+
+Procedure TShrinker.Prune(Parent : Word);
+
+Var
+   CurrChild   : Smallint;
+   NextSibling : Smallint;
+Begin
+  CurrChild := CodeTable^[Parent].Child;
+  { Find first Child that has descendants .. clear any that don't }
+  While (CurrChild <> -1) and (CodeTable^[CurrChild].Child = -1) do
+    begin
+    CodeTable^[Parent].Child := CodeTable^[CurrChild].Sibling;
+    CodeTable^[CurrChild].Sibling := -1;
+     { Turn on ClearList bit to indicate a cleared entry }
+    ClearList[CurrChild DIV 8] := (ClearList[CurrChild DIV 8] OR (1 SHL (CurrChild MOD 8)));
+    CurrChild := CodeTable^[Parent].Child;
+    end;
+  If CurrChild <> -1 then
+    begin   { If there are any children left ...}
+    Prune(CurrChild);
+    NextSibling := CodeTable^[CurrChild].Sibling;
+    While NextSibling <> -1 do
+      begin
+      If CodeTable^[NextSibling].Child = -1 then
+        begin
+        CodeTable^[CurrChild].Sibling := CodeTable^[NextSibling].Sibling;
+        CodeTable^[NextSibling].Sibling := -1;
+        { Turn on ClearList bit to indicate a cleared entry }
+        ClearList[NextSibling DIV 8] := (ClearList[NextSibling DIV 8] OR (1 SHL (NextSibling MOD 8)));
+        NextSibling := CodeTable^[CurrChild].Sibling;
+        end
+      else
+        begin
+        CurrChild := NextSibling;
+        Prune(CurrChild);
+        NextSibling := CodeTable^[CurrChild].Sibling;
+        end;
+      end;
+    end;
+end;
+
+
+Procedure TShrinker.Clear_Table;
+Var
+   Node : Word;
+Begin
+   FillChar(ClearList, SizeOf(ClearList), $00);
+   For Node := 0 to 255 do
+     Prune(Node);
+   NextFree := Succ(TABLESIZE);
+   For Node := TABLESIZE downto FIRSTENTRY do
+     begin
+     If (ClearList[Node DIV 8] AND (1 SHL (Node MOD 8))) <> 0 then
+       begin
+       Dec(NextFree);
+       FreeList^[NextFree] := Node;
+       end;
+     end;
+   If NextFree <= TABLESIZE then
+     TableFull := FALSE;
+end;
+
+
+Procedure TShrinker.Table_Add(Prefix : Word; Suffix : Byte);
+Var
+   FreeNode : Word;
+Begin
+  If NextFree <= TABLESIZE then
+    begin
+    FreeNode := FreeList^[NextFree];
+    Inc(NextFree);
+    CodeTable^[FreeNode].Child := -1;
+    CodeTable^[FreeNode].Sibling := -1;
+    CodeTable^[FreeNode].Suffix := Suffix;
+    If CodeTable^[Prefix].Child  = -1 then
+      CodeTable^[Prefix].Child := FreeNode
+    else
+      begin
+      Prefix := CodeTable^[Prefix].Child;
+      While CodeTable^[Prefix].Sibling <> -1 do
+        Prefix := CodeTable^[Prefix].Sibling;
+      CodeTable^[Prefix].Sibling := FreeNode;
+      end;
+    end;
+  if NextFree > TABLESIZE then
+    TableFull := TRUE;
+end;
+
+function TShrinker.Table_Lookup(    TargetPrefix : Smallint;
+                          TargetSuffix : Byte;
+                      Out FoundAt      : Smallint   ) : Boolean;
+
+var TempPrefix : Smallint;
+
+begin
+  TempPrefix := TargetPrefix;
+  Table_lookup := False;
+  if CodeTable^[TempPrefix].Child <> -1 then
+    begin
+    TempPrefix := CodeTable^[TempPrefix].Child;
+    repeat
+      if CodeTable^[TempPrefix].Suffix = TargetSuffix then
+        begin
+        Table_lookup := True;
+        break;
+        end;
+      if CodeTable^[TempPrefix].Sibling = -1 then
+        break;
+      TempPrefix := CodeTable^[TempPrefix].Sibling;
+    until False;
+  end;
+  if Table_Lookup then
+    FoundAt := TempPrefix
+  else
+    FoundAt := -1;
+end;
+
+Procedure TShrinker.Shrink(Suffix : Smallint);
+
+Const
+  LastCode : Smallint = 0;
+
+Var
+  WhereFound : Smallint;
+
+Begin
+  If FirstCh then
+    begin
+    SaveByte := $00;
+    BitsUsed := 0;
+    CodeSize := MINBITS;
+    MaxCode  := (1 SHL CodeSize) - 1;
+    LastCode := Suffix;
+    FirstCh  := FALSE;
+    end
+  else
+    begin
+    If Suffix <> -1 then
+      begin
+      If TableFull then
+        begin
+        Putcode(LastCode);
+        PutCode(SPECIAL);
+        Putcode(CLEARCODE);
+        Clear_Table;
+        Table_Add(LastCode, Suffix);
+        LastCode := Suffix;
+        end
+      else
+        begin
+        If Table_Lookup(LastCode, Suffix, WhereFound) then
+          begin
+          LastCode  := WhereFound;
+          end
+        else
+          begin
+          PutCode(LastCode);
+          Table_Add(LastCode, Suffix);
+          LastCode := Suffix;
+          If (FreeList^[NextFree] > MaxCode) and (CodeSize < MaxBits) then
+            begin
+            PutCode(SPECIAL);
+            PutCode(INCSIZE);
+            Inc(CodeSize);
+            MaxCode := (1 SHL CodeSize) -1;
+            end;
+          end;
+        end;
+      end
+    else
+      begin
+      PutCode(LastCode);
+      PutCode(-1);
+      FlushOutput;
+      end;
+    end;
+end;
+
+Procedure TShrinker.ProcessLine(Const Source : String);
+
+Var
+  I : Word;
+
+Begin
+  If Source = '' then
+    Shrink(-1)
+  else
+    For I := 1 to Length(Source) do
+      begin
+      Inc(BytesIn);
+      If (Pred(BytesIn) MOD FOnBytes) = 0 then
+        DoOnProgress(100 * ( BytesIn / FInFile.Size));
+      UpdC32(Ord(Source[I]));
+      Shrink(Ord(Source[I]));
+      end;
+end;
+
+{ ---------------------------------------------------------------------
+    TZipper
+  ---------------------------------------------------------------------}
+
+
+Procedure TZipper.GetFileInfo;
+
+Var
+  F    : TZipFileEntry;
+  Info : TSearchRec;
+  I    : integer; //zip spec allows QWord but FEntries.Count does not support it
+{$IFDEF UNIX}
+  UnixInfo: Stat;
+{$ENDIF}
+Begin
+  For I := 0 to FEntries.Count-1 do
+    begin
+    F:=FEntries[i];
+    If F.Stream=Nil then
+      begin
+      If (F.DiskFileName='') then
+        Raise EZipError.CreateFmt(SErrMissingFileName,[I]);
+      If FindFirst(F.DiskFileName, STDATTR, Info)=0 then
+        try
+          F.Size:=Info.Size;
+          F.DateTime:=FileDateToDateTime(Info.Time);
+        {$IFDEF UNIX}
+          if fplstat(F.DiskFileName, @UnixInfo) = 0 then
+            F.Attributes := UnixInfo.st_mode;
+        {$ELSE}
+          F.Attributes := Info.Attr;
+        {$ENDIF}
+        finally
+          FindClose(Info);
+        end
+      else
+        Raise EZipError.CreateFmt(SErrFileDoesNotExist,[F.DiskFileName]);
+      end
+    else
+    begin
+      If (F.ArchiveFileName='') then
+        Raise EZipError.CreateFmt(SErrMissingArchiveName,[I]);
+      F.Size:=F.Stream.Size;
+      if (F.Attributes = 0) then
+      begin
+      {$IFDEF UNIX}
+        F.Attributes := UNIX_FILE or UNIX_DEFAULT;
+      {$ELSE}
+        F.Attributes := faArchive;
+      {$ENDIF}
+      end;	
+    end;
+  end;
+end;
+
+
+procedure TZipper.SetEntries(const AValue: TZipFileEntries);
+begin
+  if FEntries=AValue then exit;
+  FEntries.Assign(AValue);
+end;
+
+Function TZipper.OpenInput(Item : TZipFileEntry) : Boolean;
+
+Begin
+  If (Item.Stream<>nil) then
+    FInFile:=Item.Stream
+  else
+    if Item.IsDirectory then
+      FInFile := TStringStream.Create('')
+    else
+      FInFile:=TFileStream.Create(Item.DiskFileName,fmOpenRead);
+  Result:=True;
+  If Assigned(FOnStartFile) then
+    FOnStartFile(Self,Item.ArchiveFileName);
+End;
+
+
+Procedure TZipper.CloseInput(Item : TZipFileEntry);
+
+Begin
+  If (FInFile<>Item.Stream) then
+    FreeAndNil(FInFile)
+  else
+    FinFile:=Nil;
+  DoEndOfFile;
+end;
+
+
+Procedure TZipper.StartZipFile(Item : TZipFileEntry);
+
+Begin
+  FillChar(LocalHdr,SizeOf(LocalHdr),0);
+  FillChar(LocalZip64Fld,SizeOf(LocalZip64Fld),0);
+  With LocalHdr do
+    begin
+    Signature := LOCAL_FILE_HEADER_SIGNATURE;
+    Extract_Version_Reqd := 20; //default value, v2.0
+    Bit_Flag := 0;
+    Compress_Method := 1;
+    DateTimeToZipDateTime(Item.DateTime,Last_Mod_Date,Last_Mod_Time);
+    Crc32 := 0;
+    Compressed_Size := 0;
+    LocalZip64Fld.Compressed_Size := 0;
+    if Item.Size >= $FFFFFFFF then
+      begin
+      Uncompressed_Size := $FFFFFFFF;
+      LocalZip64Fld.Original_Size := Item.Size;
+      end
+    else
+      begin
+      Uncompressed_Size := Item.Size;
+      LocalZip64Fld.Original_Size := 0;
+      end;
+    FileName_Length := 0;
+    if (LocalZip64Fld.Original_Size>0) or
+      (LocalZip64Fld.Compressed_Size>0) or
+      (LocalZip64Fld.Disk_Start_Number>0) or
+      (LocalZip64Fld.Relative_Hdr_Offset>0) then
+      Extra_Field_Length := SizeOf(LocalZip64ExtHdr) + SizeOf(LocalZip64Fld)
+    else
+      Extra_Field_Length := 0;
+  end;
+End;
+
+
+function TZipper.UpdateZipHeader(Item: TZipFileEntry; FZip: TStream;
+  ACRC: LongWord; AMethod: Word; AZipVersionReqd: Word; AZipBitFlag: Word
+  ): Boolean;
+  // Update header for a single zip file (local header)
+var
+  IsZip64           : boolean; //Must the local header be in zip64 format?
+  // Separate from zip64 status of entire zip file.
+  ZFileName         : String;
+Begin
+  ZFileName := Item.ArchiveFileName;
+  IsZip64 := false;
+  With LocalHdr do
+    begin
+    FileName_Length := Length(ZFileName);
+    Crc32 := ACRC;
+    if LocalZip64Fld.Original_Size > 0 then
+      Result := Not (FZip.Size >= LocalZip64Fld.Original_Size)
+    else
+      Result := Not (Compressed_Size >= Uncompressed_Size);
+    if Item.CompressionLevel=clNone
+      then Result:=false; //user wishes override or invalid compression
+    If Not Result then
+      begin
+      Compress_Method := 0; // No use for compression: change storage type & compression size...
+      if LocalZip64Fld.Original_Size>0 then
+        begin
+        IsZip64 := true;
+        Compressed_Size := $FFFFFFFF;
+        LocalZip64Fld.Compressed_Size := LocalZip64Fld.Original_Size;
+        end
+      else
+        begin
+        Compressed_Size := Uncompressed_Size;
+        LocalZip64Fld.Compressed_Size := 0;
+        end;
+      end
+    else { Using compression }
+      begin
+      Compress_method := AMethod;
+      Bit_Flag := Bit_Flag or AZipBitFlag;
+      if FZip.Size >= $FFFFFFFF then
+      begin
+        IsZip64 := true;
+        Compressed_Size := $FFFFFFFF;
+        LocalZip64Fld.Compressed_Size := FZip.Size;
+      end
+      else
+      begin
+        Compressed_Size := FZip.Size;
+        LocalZip64Fld.Compressed_Size := 0;
+      end;
+      if AZipVersionReqd > Extract_Version_Reqd then
+        Extract_Version_Reqd := AZipVersionReqd;
+      end;
+    if (IsZip64) and (Extract_Version_Reqd<45) then
+      Extract_Version_Reqd := 45;
+    end;
+  if IsZip64 then
+    LocalHdr.Extra_Field_Length:=SizeOf(LocalZip64ExtHdr)+SizeOf(LocalZip64Fld);
+  FOutStream.WriteBuffer({$IFDEF ENDIAN_BIG}SwapLFH{$ENDIF}(LocalHdr),SizeOf(LocalHdr));
+  // Append extensible field header+zip64 extensible field if needed:
+  FOutStream.WriteBuffer(ZFileName[1],Length(ZFileName));
+  if IsZip64 then
+  begin
+    LocalZip64ExtHdr.Header_ID:=ZIP64_HEADER_ID;
+    FOutStream.WriteBuffer({$IFDEF ENDIAN_BIG}SwapEDFH{$ENDIF}(LocalZip64ExtHdr),SizeOf(LocalZip64ExtHdr));
+    FOutStream.WriteBuffer({$IFDEF ENDIAN_BIG}SwapZ64EIF{$ENDIF}(LocalZip64Fld),SizeOf(LocalZip64Fld));
+  end;
+End;
+
+
+Procedure TZipper.BuildZipDirectory;
+// Write out all central file headers using info from local headers
+Var
+  SavePos   : Int64;
+  HdrPos    : Int64; //offset from disk where file begins to local header
+  CenDirPos : Int64;
+  ACount    : QWord; //entry counter
+  ZFileName : string; //archive filename
+  IsZip64   : boolean; //local header=zip64 format?
+  MinReqdVersion: word; //minimum needed to extract
+  ExtInfoHeader : Extensible_Data_Field_Header_Type;
+  Zip64ECD  : Zip64_End_of_Central_Dir_type;
+  Zip64ECDL : Zip64_End_of_Central_Dir_Locator_type;
+Begin
+  ACount := 0;
+  MinReqdVersion:=0;
+  CenDirPos := FOutStream.Position;
+  FOutStream.Seek(0,soBeginning);             { Rewind output file }
+  HdrPos := FOutStream.Position;
+  FOutStream.ReadBuffer(LocalHdr, SizeOf(LocalHdr));
+{$IFDEF FPC_BIG_ENDIAN}
+  LocalHdr := SwapLFH(LocalHdr);
+{$ENDIF}
+  Repeat
+    SetLength(ZFileName,LocalHdr.FileName_Length);
+    FOutStream.ReadBuffer(ZFileName[1], LocalHdr.FileName_Length);
+    IsZip64:=(LocalHdr.Compressed_Size=$FFFFFFFF) or (LocalHdr.Uncompressed_Size=$FFFFFFFF) or (HdrPos>=$FFFFFFFF);
+    FillChar(LocalZip64Fld,SizeOf(LocalZip64Fld),0); // easier to check compressed length
+    if LocalHdr.Extra_Field_Length>0 then
+      begin
+      SavePos := FOutStream.Position;
+      if (IsZip64 and (LocalHdr.Extra_Field_Length>=SizeOf(LocalZip64ExtHdr)+SizeOf(LocalZip64Fld))) then
+        while FOutStream.Position<SavePos+LocalHdr.Extra_Field_Length do
+          begin
+          FOutStream.ReadBuffer(ExtInfoHeader, SizeOf(ExtInfoHeader));
+        {$IFDEF FPC_BIG_ENDIAN}
+          ExtInfoHeader := SwapEDFH(ExtInfoHeader);
+        {$ENDIF}
+          if ExtInfoHeader.Header_ID=ZIP64_HEADER_ID then
+            begin
+            FOutStream.ReadBuffer(LocalZip64Fld, SizeOf(LocalZip64Fld));
+          {$IFDEF FPC_BIG_ENDIAN}
+            LocalZip64Fld := SwapZ64EIF(LocalZip64Fld);
+          {$ENDIF}
+            end
+          else
+            begin
+            // Read past non-zip64 extra field
+            FOutStream.Seek(ExtInfoHeader.Data_Size,soFromCurrent);
+            end;
+          end;
+      // Move past extra fields
+      FOutStream.Seek(SavePos+LocalHdr.Extra_Field_Length,soFromBeginning);
+      end;
+    SavePos := FOutStream.Position;
+    FillChar(CentralHdr,SizeOf(CentralHdr),0);
+    With CentralHdr do
+      begin
+      Signature := CENTRAL_FILE_HEADER_SIGNATURE;
+      MadeBy_Version := LocalHdr.Extract_Version_Reqd;
+      if (IsZip64) and (MadeBy_Version<45) then
+        MadeBy_Version := 45;
+    {$IFDEF UNIX}
+      {$IFDEF DARWIN} //OSX
+      MadeBy_Version := MadeBy_Version or (OS_OSX shl 8);
+      {$ELSE}
+      MadeBy_Version := MadeBy_Version or (OS_UNIX shl 8);
+      {$ENDIF}
+    {$ENDIF}
+    {$IFDEF OS2}
+      MadeBy_Version := MadeBy_Version or (OS_OS2 shl 8);
+    {$ENDIF}
+      {$warning TODO: find a way to recognize VFAT and NTFS}
+      // Copy over extract_version_reqd..extra_field_length
+      Move(LocalHdr.Extract_Version_Reqd, Extract_Version_Reqd, 26);
+      if (IsZip64) and (Extract_Version_Reqd<45) then
+        Extract_Version_Reqd := 45;
+      // Keep track of the minimum version required to extract
+      // zip file as a whole
+      if Extract_Version_Reqd>MinReqdVersion then
+        MinReqdVersion:=Extract_Version_Reqd;
+      Last_Mod_Time:=localHdr.Last_Mod_Time;
+      Last_Mod_Date:=localHdr.Last_Mod_Date;
+      File_Comment_Length := 0;
+      Starting_Disk_Num := 0;
+      Internal_Attributes := 0;
+    {$IFDEF UNIX}
+      External_Attributes := Entries[ACount].Attributes shl 16;
+    {$ELSE}
+      External_Attributes := Entries[ACount].Attributes;
+    {$ENDIF}
+      if HdrPos>=$FFFFFFFF then
+      begin
+        FZipFileNeedsZip64:=true;
+        IsZip64:=true;
+        Local_Header_offset := $FFFFFFFF;
+        // LocalZip64Fld will be written out as central dir extra field later
+        LocalZip64Fld.Relative_Hdr_Offset := HdrPos;
+      end
+      else
+        Local_Header_Offset := HdrPos;
+      end;
+    FOutStream.Seek(0,soEnd);
+    FOutStream.WriteBuffer({$IFDEF FPC_BIG_ENDIAN}SwapCFH{$ENDIF}(CentralHdr),SizeOf(CentralHdr));
+    FOutStream.WriteBuffer(ZFileName[1],Length(ZFileName));
+    if IsZip64 then
+      begin
+      FOutStream.Seek(0,soEnd);
+      FOutStream.WriteBuffer({$IFDEF FPC_BIG_ENDIAN}SwapEDFH{$ENDIF}(LocalZip64ExtHdr),SizeOf(LocalZip64ExtHdr));
+      FOutStream.WriteBuffer({$IFDEF FPC_BIG_ENDIAN}SwapZ64EIF{$ENDIF}(LocalZip64Fld),SizeOf(LocalZip64Fld));
+      end;
+
+    Inc(ACount);
+    // Move past compressed file data to next header:
+    if Iszip64 then
+      FOutStream.Seek(SavePos + LocalZip64Fld.Compressed_Size,soBeginning)
+    else
+      FOutStream.Seek(SavePos + LocalHdr.Compressed_Size,soBeginning);
+    HdrPos:=FOutStream.Position;
+    FOutStream.ReadBuffer(LocalHdr, SizeOf(LocalHdr));
+  {$IFDEF FPC_BIG_ENDIAN}
+    LocalHdr := SwapLFH(LocalHdr);
+  {$ENDIF}
+  Until LocalHdr.Signature = CENTRAL_FILE_HEADER_SIGNATURE ;
+
+  FOutStream.Seek(0,soEnd);
+  FillChar(EndHdr,SizeOf(EndHdr),0);
+
+  // Write end of central directory record
+  // We'll use the zip64 variants to store counts etc
+  // and copy to the old record variables if possible
+  // This seems to match expected behaviour of unzippers like
+  // unrar that only look at the zip64 record
+  FillChar(Zip64ECD, SizeOf(Zip64ECD), 0);
+  Zip64ECD.Signature:=ZIP64_END_OF_CENTRAL_DIR_SIGNATURE;
+  FillChar(Zip64ECDL, SizeOf(Zip64ECDL), 0);
+  Zip64ECDL.Signature:=ZIP64_END_OF_CENTRAL_DIR_LOCATOR_SIGNATURE;
+  Zip64ECDL.Total_Disks:=1; //default and no support for multi disks yet anyway
+  With EndHdr do
+    begin
+    Signature := END_OF_CENTRAL_DIR_SIGNATURE;
+    Disk_Number := 0;
+    Central_Dir_Start_Disk := 0;
+
+    Zip64ECD.Entries_This_Disk:=ACount;
+    Zip64ECD.Total_Entries:=Acount;
+    if ACount>$FFFF then
+      begin
+      FZipFileNeedsZip64 := true;
+      Entries_This_Disk := $FFFF;
+      Total_Entries := $FFFF;
+      end
+    else
+      begin
+      Entries_This_Disk := Zip64ECD.Entries_This_Disk;
+      Total_Entries := Zip64ECD.Total_Entries;
+      end;
+
+    Zip64ECD.Central_Dir_Size := FOutStream.Size-CenDirPos;
+    if (Zip64ECD.Central_Dir_Size)>$FFFFFFFF then
+      begin
+      FZipFileNeedsZip64 := true;
+      Central_Dir_Size := $FFFFFFFF;
+      end
+    else
+      begin
+      Central_Dir_Size := Zip64ECD.Central_Dir_Size;
+      end;
+
+    Zip64ECD.Start_Disk_Offset := CenDirPos;
+    if Zip64ECD.Start_Disk_Offset>$FFFFFFFF then
+      begin
+      FZipFileNeedsZip64 := true;
+      Start_Disk_Offset := $FFFFFFFF;
+      end
+    else
+      begin
+      Start_Disk_Offset := Zip64ECD.Start_Disk_Offset;
+      end;
+
+    ZipFile_Comment_Length := Length(FFileComment);
+
+    if FZipFileNeedsZip64 then
+    begin
+      //Write zip64 end of central directory record if needed
+      if MinReqdVersion<45 then
+        MinReqdVersion := 45;
+      Zip64ECD.Extract_Version_Reqd := MinReqdVersion;
+      Zip64ECD.Version_Made_By := MinReqdVersion;
+      Zip64ECD.Record_Size := SizeOf(Zip64ECD)-12; //Assumes no variable length field following
+      Zip64ECDL.Central_Dir_Zip64_EOCD_Offset := FOutStream.Position;
+      Zip64ECDL.Zip64_EOCD_Start_Disk := 0;
+      FOutStream.WriteBuffer({$IFDEF FPC_BIG_ENDIAN}SwapZ64ECD{$ENDIF}(Zip64ECD), SizeOf(Zip64ECD));
+
+      //Write zip64 end of central directory locator if needed
+      FOutStream.WriteBuffer({$IFDEF FPC_BIG_ENDIAN}SwapZ64ECDL{$ENDIF}(Zip64ECDL), SizeOf(Zip64ECDL));
+    end;
+
+    FOutStream.WriteBuffer({$IFDEF FPC_BIG_ENDIAN}SwapECD{$ENDIF}(EndHdr), SizeOf(EndHdr));
+    if Length(FFileComment) > 0 then
+      FOutStream.WriteBuffer(FFileComment[1],Length(FFileComment));
+    end;
+end;
+
+Function TZipper.CreateCompressor(Item : TZipFileEntry; AInFile,AZipStream : TStream) : TCompressor;
+
+begin
+  Result:=TDeflater.Create(AinFile,AZipStream,FBufSize);
+  (Result as TDeflater).CompressionLevel:=Item.CompressionLevel;
+  FCurrentCompressor:=Result;
+end;
+
+Procedure TZipper.ZipOneFile(Item : TZipFileEntry);
+
+Var
+  CRC : LongWord;
+  ZMethod : Word;
+  ZVersionReqd : Word;
+  ZBitFlag : Word;
+  ZipStream : TStream;
+  TmpFileName, Start : String;
+  I : Integer;
+
+Begin
+  OpenInput(Item);
+  Try
+    StartZipFile(Item);
+    If (FInfile.Size<=FInMemSize) then
+      ZipStream:=TMemoryStream.Create
+    else
+      begin
+      Start := ChangeFileExt(FFileName, '');
+      I := 0;
+      repeat
+        TmpFileName := Format('%s%.5d.tmp', [Start, I]);
+        Inc(I);
+      until not FileExists(TmpFileName);
+      ZipStream:=TFileStream.Create(TmpFileName,fmCreate);
+      end;
+    Try
+      With CreateCompressor(Item, FinFile,ZipStream) do
+        Try
+          OnProgress:=Self.OnProgress;
+          OnPercent:=Self.OnPercent;
+          Compress;
+          CRC:=Crc32Val;
+          ZMethod:=ZipID;
+          ZVersionReqd:=ZipVersionReqd;
+          ZBitFlag:=ZipBitFlag;
+        Finally
+          FCurrentCompressor:=Nil;
+          Free;
+        end;
+      If UpdateZipHeader(Item,ZipStream,CRC,ZMethod,ZVersionReqd,ZBitFlag) then
+        // Compressed file smaller than original file.
+        FOutStream.CopyFrom(ZipStream,0)
+      else
+        begin
+        // Original file smaller than compressed file.
+        FInfile.Seek(0,soBeginning);
+        FOutStream.CopyFrom(FInFile,0);
+        end;
+    finally
+      ZipStream.Free;
+      If (TmpFileName<>'') then
+        DeleteFile(TmpFileName);
+    end;
+  Finally
+    CloseInput(Item);
+  end;
+end;
+
+// Just like SaveToFile, but uses the FileName property
+Procedure TZipper.ZipAllFiles;
+begin
+  SaveToFile(FileName);
+end;
+
+procedure TZipper.SaveToFile(AFileName: RawByteString);
+var
+  lStream: TFileStream;
+begin
+  FFileName:=AFileName;
+  lStream:=TFileStream.Create(FFileName,fmCreate);
+  try
+    SaveToStream(lStream);
+  finally
+    FreeAndNil(lStream);
+  end;
+end;
+
+procedure TZipper.SaveToStream(AStream: TStream);
+Var
+  I : integer; //could be qword but limited by FEntries.Count
+begin
+  FTerminated:=False;
+  FOutStream := AStream;
+  If CheckEntries=0 then
+    Exit;
+  FZipping:=True;
+  Try
+    GetFileInfo; //get info on file entries in zip
+    I:=0;
+    While (I<FEntries.Count) and not Terminated do
+      begin
+      ZipOneFile(FEntries[i]);
+      Inc(I);
+      end;
+    if (FEntries.Count>0) and not Terminated then
+      BuildZipDirectory;
+  finally
+    FZipping:=False;
+    // Remove entries that have been added by CheckEntries from Files.
+    for I:=0 to FFiles.Count-1 do
+      FEntries.Delete(FEntries.Count-1);
+  end;
+end;
+
+
+Procedure TZipper.SetBufSize(Value : LongWord);
+
+begin
+  If FZipping then
+    Raise EZipError.Create(SErrBufsizeChange);
+  If Value>=DefaultBufSize then
+    FBufSize:=Value;
+end;
+
+Procedure TZipper.SetFileName(Value : RawByteString);
+
+begin
+  If FZipping then
+    Raise EZipError.Create(SErrFileChange);
+  FFileName:=Value;
+end;
+
+Procedure TZipper.ZipFiles(AFileName : RawByteString; FileList : TStrings);
+
+begin
+  FFileName:=AFileName;
+  ZipFiles(FileList);
+end;
+
+procedure TZipper.ZipFiles(FileList: TStrings);
+begin
+  FFiles.Assign(FileList);
+  ZipAllFiles;
+end;
+
+procedure TZipper.ZipFiles(AFileName: RawByteString; Entries: TZipFileEntries);
+begin
+  FFileName:=AFileName;
+  ZipFiles(Entries);
+end;
+
+procedure TZipper.ZipFiles(Entries: TZipFileEntries);
+begin
+  FEntries.Assign(Entries);
+  ZipAllFiles;
+end;
+
+Procedure TZipper.DoEndOfFile;
+
+Var
+  ComprPct : Double;
+
+begin
+  if (FZipFileNeedsZip64) and (LocalZip64Fld.Original_Size>0) then
+    ComprPct := (100.0 * (LocalZip64Fld.Original_size - LocalZip64Fld.Compressed_Size)) / LocalZip64Fld.Original_Size
+  else if (LocalHdr.Uncompressed_Size>0) then
+    ComprPct := (100.0 * (LocalHdr.Uncompressed_Size - LocalHdr.Compressed_Size)) / LocalHdr.Uncompressed_Size
+  else
+    ComprPct := 0;
+  If Assigned(FOnEndOfFile) then
+    FOnEndOfFile(Self,ComprPct);
+end;
+
+Constructor TZipper.Create;
+
+begin
+  FBufSize:=DefaultBufSize;
+  FInMemSize:=DefaultInMemSize;
+  FFiles:=TStringList.Create;
+  FEntries:=TZipFileEntries.Create(TZipFileEntry);
+  FOnPercent:=1;
+  FZipFileNeedsZip64:=false;
+  LocalZip64ExtHdr.Header_ID:=ZIP64_HEADER_ID;
+  LocalZip64ExtHdr.Data_Size:=SizeOf(Zip64_Extended_Info_Field_Type);
+end;
+
+Function TZipper.CheckEntries : Integer;
+
+Var
+  I : integer; //Could be QWord but limited by FFiles.Count
+
+begin
+  for I:=0 to FFiles.Count-1 do
+    FEntries.AddFileEntry(FFiles[i]);
+
+  // Use zip64 when number of file entries
+  // or individual (un)compressed sizes
+  // require it.
+  if FEntries.Count >= $FFFF then
+    FZipFileNeedsZip64:=true;
+
+  if not(FZipFileNeedsZip64) then
+    begin
+    for I:=0 to FFiles.Count-1 do
+      begin
+      if FEntries[i].FNeedsZip64 then
+        begin
+        FZipFileNeedsZip64:=true;
+        break;
+        end;
+      end;
+    end;
+
+  Result:=FEntries.Count;
+end;
+
+
+Procedure TZipper.Clear;
+
+begin
+  FEntries.Clear;
+  FFiles.Clear;
+end;
+
+procedure TZipper.Terminate;
+begin
+  FTerminated:=True;
+  if Assigned(FCurrentCompressor) then
+    FCurrentCompressor.Terminate;
+end;
+
+Destructor TZipper.Destroy;
+
+begin
+  Clear;
+  FreeAndNil(FEntries);
+  FreeAndNil(FFiles);
+  Inherited;
+end;
+
+{ ---------------------------------------------------------------------
+    TUnZipper
+  ---------------------------------------------------------------------}
+
+procedure TUnZipper.OpenInput;
+
+Begin
+  if Assigned(FOnOpenInputStream) then
+    FOnOpenInputStream(Self, FZipStream);
+  if FZipStream = nil then
+    FZipStream:=TFileStream.Create(FFileName,fmOpenRead or fmShareDenyWrite);
+End;
+
+
+function TUnZipper.OpenOutput(OutFileName: RawByteString;
+  out OutStream: TStream; Item: TFullZipFileEntry): Boolean;
+Var
+  Path: RawByteString;
+  OldDirectorySeparators: set of char;
+  
+Begin
+  { the default RTL behavior is broken on Unix platforms
+    for Windows compatibility: it allows both '/' and '\'
+    as directory separator. We don't want that behavior
+    here, since 'abc\' is a valid file name under Unix.
+	
+    The zip standard appnote.txt says zip files must have '/' as path
+    separator, even on Windows: 4.4.17.1:
+    "The path stored MUST not contain a drive or device letter, or a leading
+    slash. All slashes MUST be forward slashes '/' as opposed to backwards
+    slashes '\'" See also mantis issue #15836
+    However, old versions of FPC on Windows (and possibly other utilities)
+    created incorrect zip files with \ separator, so accept these as well as
+    they're not valid in Windows file names anyway.
+  }
+  OldDirectorySeparators:=AllowDirectorySeparators;
+  {$ifdef Windows}
+  // Explicitly allow / and \ regardless of what Windows supports
+  AllowDirectorySeparators:=['\','/'];
+  {$else}
+  // Follow the standard: only allow / regardless of actual separator on OS
+  AllowDirectorySeparators:=['/'];
+  {$endif}
+  Path:=ExtractFilePath(OutFileName);
+  OutStream:=Nil;
+  If Assigned(FOnCreateStream) then
+    FOnCreateStream(Self, OutStream, Item);
+  // If FOnCreateStream didn't create one, we create one now.
+  If (OutStream=Nil) then
+    begin
+    if (Path<>'') then
+      ForceDirectories(Path);
+    AllowDirectorySeparators:=OldDirectorySeparators;
+    OutStream:=TFileStream.Create(OutFileName,fmCreate);
+	
+    end;
+	
+  AllowDirectorySeparators:=OldDirectorySeparators;
+  Result:=True;
+  If Assigned(FOnStartFile) then
+    FOnStartFile(Self,OutFileName);
+End;
+
+
+procedure TUnZipper.CloseOutput(Item: TFullZipFileEntry; var OutStream: TStream
+  );
+
+Begin
+  if Assigned(FOnDoneStream) then
+  begin
+    FOnDoneStream(Self, OutStream, Item);
+    OutStream := nil;
+  end
+  else
+    FreeAndNil(OutStream);
+  DoEndOfFile;
+end;
+
+
+procedure TUnZipper.CloseInput;
+
+Begin
+  if Assigned(FOnCloseInputStream) then
+    FOnCloseInputStream(Self, FZipStream);
+  FreeAndNil(FZipStream);
+end;
+
+
+procedure TUnZipper.ReadZipHeader(Item: TFullZipFileEntry; out AMethod: Word);
+Var
+  S : String;
+  U : UTF8String;
+  D : TDateTime;
+  ExtraFieldHdr: Extensible_Data_Field_Header_Type;
+  SavePos: int64; //could be qword but limited by stream
+  // Infozip unicode path
+  Infozip_Unicode_Path_Ver:Byte;
+  Infozip_Unicode_Path_CRC32:DWord;
+Begin
+  FZipStream.Seek(Item.HdrPos,soBeginning);
+  FZipStream.ReadBuffer(LocalHdr,SizeOf(LocalHdr));
+{$IFDEF FPC_BIG_ENDIAN}
+  LocalHdr := SwapLFH(LocalHdr);
+{$ENDIF}
+  FillChar(LocalZip64Fld,SizeOf(LocalZip64Fld),0); //ensure no erroneous info
+  With LocalHdr do
+    begin
+      Item.FBitFlags:=Bit_Flag;
+      SetLength(S,Filename_Length);
+      FZipStream.ReadBuffer(S[1],Filename_Length);
+      Item.ArchiveFileName:=S;
+      Item.DiskFileName:=S;
+      SavePos:=FZipStream.Position; //after filename, before extra fields
+      if Extra_Field_Length>0 then
+        begin
+        SavePos := FZipStream.Position;
+        if (LocalHdr.Extra_Field_Length>=SizeOf(ExtraFieldHdr)) then
+          while FZipStream.Position<SavePos+LocalHdr.Extra_Field_Length do
+            begin
+            FZipStream.ReadBuffer(ExtraFieldHdr, SizeOf(ExtraFieldHdr));
+          {$IFDEF FPC_BIG_ENDIAN}
+            ExtraFieldHdr := SwapEDFH(ExtraFieldHdr);
+          {$ENDIF}
+            if ExtraFieldHdr.Header_ID=ZIP64_HEADER_ID then
+              begin
+              FZipStream.ReadBuffer(LocalZip64Fld, SizeOf(LocalZip64Fld));
+            {$IFDEF FPC_BIG_ENDIAN}
+              LocalZip64Fld := SwapZ64EIF(LocalZip64Fld);
+            {$ENDIF}
+              end
+            // Infozip unicode path
+            else if ExtraFieldHdr.Header_ID=INFOZIP_UNICODE_PATH_ID then
+              begin
+              FZipStream.ReadBuffer(Infozip_Unicode_Path_Ver,1);
+              if Infozip_Unicode_Path_Ver=1 then
+                begin
+                FZipStream.ReadBuffer(Infozip_Unicode_Path_CRC32,sizeof(Infozip_Unicode_Path_CRC32));
+                {$IFDEF FPC_BIG_ENDIAN}
+                Infozip_Unicode_Path_CRC32:=SwapEndian(Infozip_Unicode_Path_CRC32);
+                {$ENDIF}
+                if CRC32Str(S)=Infozip_Unicode_Path_CRC32 then
+                  begin
+                  SetLength(U,ExtraFieldHdr.Data_Size-5);
+                  FZipStream.ReadBuffer(U[1],Length(U));
+                  Item.UTF8ArchiveFileName:=U;
+                  Item.UTF8DiskFileName:=U;
+                  end
+                else
+                  FZipStream.Seek(ExtraFieldHdr.Data_Size-5,soFromCurrent);
+                end
+              else
+                FZipStream.Seek(ExtraFieldHdr.Data_Size-1,soFromCurrent);
+              end
+            else
+              FZipStream.Seek(ExtraFieldHdr.Data_Size,soFromCurrent);
+            end;
+        // Move past extra fields
+        FZipStream.Seek(SavePos+Extra_Field_Length,soFromBeginning);
+        end;
+      Item.Size:=Uncompressed_Size;
+      ZipDateTimeToDateTime(Last_Mod_Date,Last_Mod_Time,D);
+      Item.DateTime:=D;
+      if Crc32 <> 0 then
+        Item.CRC32 := Crc32;
+      AMethod:=Compress_method;
+    end;
+End;
+
+procedure TUnZipper.FindEndHeaders(
+  out AEndHdr: End_of_Central_Dir_Type;
+  out AEndHdrPos: Int64;
+  out AEndZip64Hdr: Zip64_End_of_Central_Dir_type;
+  out AEndZip64HdrPos: Int64);
+// Reads backwords from the end of the zip file,
+// following end of central directory, and, if present
+// zip64 end of central directory locator and
+// zip64 end of central directory record
+
+// If valid regular end of directory found, AEndHdrPos>0
+// If valid zip64 end of directory found, AEndZip64HdrPos>0
+var
+  EndZip64Locator: Zip64_End_of_Central_Dir_Locator_type;
+  procedure SearchForSignature;
+  // Search for end of central directory record signature
+  // If failed, set AEndHdrPos to 0
+  var
+    I: Integer;
+    Buf: PByte;
+    BufSize: Integer;
+    result: boolean;
+  begin
+    result:=false;
+    // scan the last (64k + something) bytes for the END_OF_CENTRAL_DIR_SIGNATURE
+    // (zip file comments are 64k max).
+    BufSize := 65536 + SizeOf(AEndHdr) + 128;
+    if FZipStream.Size < BufSize then
+      BufSize := FZipStream.Size;
+
+    Buf := GetMem(BufSize);
+    try
+      FZipStream.Seek(FZipStream.Size - BufSize, soBeginning);
+      FZipStream.ReadBuffer(Buf^, BufSize);
+
+      for I := BufSize - SizeOf(AEndHdr) downto 0 do
+      begin
+        if (Buf[I] or (Buf[I + 1] shl 8) or (Buf[I + 2] shl 16) or (Buf[I + 3] shl 24)) = END_OF_CENTRAL_DIR_SIGNATURE then
+        begin
+          Move(Buf[I], AEndHdr, SizeOf(AEndHdr));
+          {$IFDEF FPC_BIG_ENDIAN}
+          AEndHdr := SwapECD(AEndHdr);
+          {$ENDIF}
+          if (AEndHdr.Signature = END_OF_CENTRAL_DIR_SIGNATURE) and
+             (I + SizeOf(AEndHdr) + AEndHdr.ZipFile_Comment_Length = BufSize) then
+          begin
+            AEndHdrPos := FZipStream.Size - BufSize + I;
+            FZipStream.Seek(AEndHdrPos + SizeOf(AEndHdr), soBeginning);
+            SetLength(FFileComment, AEndHdr.ZipFile_Comment_Length);
+            FZipStream.ReadBuffer(FFileComment[1], Length(FFileComment));
+            result:=true; //found it
+            break;
+          end;
+        end;
+      end;
+    finally
+      FreeMem(Buf);
+    end;
+    if not(result) then
+    begin
+      AEndHdrPos := 0;
+      FillChar(AEndHdr, SizeOf(AEndHdr), 0);
+    end;
+  end;
+
+  procedure ZeroData;
+  begin
+    AEndHdrPos := 0;
+    FillChar(AEndHdr, SizeOf(AEndHdr), 0);
+    AEndZip64HdrPos:=0;
+    FillChar(AEndZip64Hdr, SizeOf(AEndZip64Hdr), 0);
+  end;
+
+begin
+  // Zip64 records may not exist, so fill out default values
+  FillChar(AEndZip64Hdr,SizeOf(AEndZip64Hdr), 0);
+  AEndZip64HdrPos:=0;
+  // Look for end of central directory record from
+  // back of file based on signature (only way due to
+  // variable length zip comment etc)
+  FFileComment := '';
+  // Zip file requires end of central dir header so
+  // is corrupt if it is smaller than that
+  if FZipStream.Size < SizeOf(AEndHdr) then
+  begin
+    ZeroData;
+    exit;
+  end;
+
+  AEndHdrPos := FZipStream.Size - SizeOf(AEndHdr);
+  FZipStream.Seek(AEndHdrPos, soBeginning);
+  FZipStream.ReadBuffer(AEndHdr, SizeOf(AEndHdr));
+  {$IFDEF FPC_BIG_ENDIAN}
+  AEndHdr := SwapECD(AEndHdr);
+  {$ENDIF}
+  // Search unless record is right at the end of the file:
+  if (AEndHdr.Signature <> END_OF_CENTRAL_DIR_SIGNATURE) or
+     (AEndHdr.ZipFile_Comment_Length <> 0) then
+    SearchForSignature;
+  if AEndHdrPos=0 then
+  begin
+    ZeroData;
+    exit;
+  end;
+
+  // With a valid end of dir record, see if there's zip64
+  // fields:
+  FZipStream.Seek(AEndHdrPos-SizeOf(Zip64_End_of_Central_Dir_Locator_type),soBeginning);
+  FZipStream.ReadBuffer(EndZip64Locator, SizeOf(EndZip64Locator));
+  {$IFDEF FPC_BIG_ENDIAN}
+  EndZip64Locator := SwapZ64ECDL(EndZip64Locator);
+  {$ENDIF}
+  if EndZip64Locator.Signature=ZIP64_END_OF_CENTRAL_DIR_LOCATOR_SIGNATURE then
+  begin
+    //Read EndZip64Locator.Total_Disks when implementing multiple disks support
+    if EndZip64Locator.Central_Dir_Zip64_EOCD_Offset>High(Int64) then
+      raise EZipError.CreateFmt(SErrPosTooLarge,[EndZip64Locator.Central_Dir_Zip64_EOCD_Offset,High(Int64)]);
+    AEndZip64HdrPos:=EndZip64Locator.Central_Dir_Zip64_EOCD_Offset;
+    FZipStream.Seek(AEndZip64HdrPos, soBeginning);
+    FZipStream.ReadBuffer(AEndZip64Hdr, SizeOf(AEndZip64Hdr));
+    {$IFDEF FPC_BIG_ENDIAN}
+    AEndZip64Hdr := SwapZ64ECD(AEndZip64Hdr);
+    {$ENDIF}
+    if AEndZip64Hdr.Signature<>ZIP64_END_OF_CENTRAL_DIR_SIGNATURE then
+    begin
+      //Corrupt header
+      ZeroData;
+      Exit;
+    end;
+  end
+  else
+  begin
+    // No zip64 data, so follow the offset in the end of central directory record
+    AEndZip64HdrPos:=0;
+    FillChar(AEndZip64Hdr, SizeOf(AEndZip64Hdr), 0);
+  end;
+end;
+
+procedure TUnZipper.ReadZipDirectory;
+
+Var
+  EndHdr      : End_of_Central_Dir_Type;
+  EndZip64Hdr : Zip64_End_of_Central_Dir_type;
+  i : integer; //could be Qword but limited to number of items in collection
+  EndHdrPos,
+  EndZip64HdrPos,
+  CenDirPos,
+  SavePos   : Int64; //could be QWord but limited to stream maximums
+  ExtraFieldHeader : Extensible_Data_Field_Header_Type;
+  EntriesThisDisk : QWord;
+  Zip64Field: Zip64_Extended_Info_Field_Type;
+  NewNode   : TFullZipFileEntry;
+  D : TDateTime;
+  S : String;
+  U : UTF8String;
+  // infozip unicode path
+  Infozip_unicode_path_ver : byte; // always 1
+  Infozip_unicode_path_crc32 : DWord;
+Begin
+  FindEndHeaders(EndHdr, EndHdrPos,
+    EndZip64Hdr, EndZip64HdrPos);
+  if EndHdrPos=0 then
+    raise EZipError.CreateFmt(SErrCorruptZIP,[FileName]);
+  if (EndZip64HdrPos>0) and (EndZip64Hdr.Start_Disk_Offset>0) then
+    begin
+    if EndZip64Hdr.Start_Disk_Offset>High(Int64) then
+      raise EZipError.CreateFmt(SErrPosTooLarge,[EndZip64Hdr.Start_Disk_Offset,High(Int64)]);
+    CenDirPos := EndZip64Hdr.Start_Disk_Offset;
+    end
+  else
+    CenDirPos := EndHdr.Start_Disk_Offset;
+  FZipStream.Seek(CenDirPos,soBeginning);
+  FEntries.Clear;
+  if (EndZip64HdrPos>0) and (EndZip64Hdr.Entries_This_Disk>0) then
+  begin
+    EntriesThisDisk := EndZip64Hdr.Entries_This_Disk;
+    if EntriesThisDisk<>EndZip64Hdr.Total_Entries then
+      raise EZipError.Create(SErrUnsupportedMultipleDisksCD);
+  end
+  else
+  begin
+    EntriesThisDisk :=EndHdr.Entries_This_Disk;
+    if EntriesThisDisk<>EndHdr.Total_Entries then
+      raise EZipError.Create(SErrUnsupportedMultipleDisksCD);
+  end;
+
+  // Entries are added to a collection. The max number of items
+  // in a collection limits the entries we can process.
+  if EntriesThisDisk>MaxInt then
+    raise EZipError.CreateFmt(SErrMaxEntries,[EntriesThisDisk,MaxInt]);
+
+  // Using while instead of for loop so qword can be used on 32 bit as well.
+  for i:=0 to EntriesThisDisk-1 do
+    begin
+    FZipStream.ReadBuffer(CentralHdr, SizeOf(CentralHdr));
+{$IFDEF FPC_BIG_ENDIAN}
+    CentralHdr := SwapCFH(CentralHdr);
+{$ENDIF}
+    With CentralHdr do
+      begin
+      if Signature<>CENTRAL_FILE_HEADER_SIGNATURE then
+        raise EZipError.CreateFmt(SErrCorruptZIP,[FileName]);
+      NewNode:=FEntries.Add as TFullZipFileEntry;
+      // Header position will be corrected later with zip64 version, if needed..
+      NewNode.HdrPos := Local_Header_Offset;
+      NewNode.FBitFlags:=Bit_Flag;
+      SetLength(S,Filename_Length);
+      FZipStream.ReadBuffer(S[1],Filename_Length);
+      SavePos:=FZipStream.Position; //After fixed part of central directory...
+      // and the filename; before any extra field(s)
+      NewNode.ArchiveFileName:=S;
+      // Size/compressed size will be adjusted by zip64 entries if needed...
+      NewNode.Size:=Uncompressed_Size;
+      NewNode.FCompressedSize:=Compressed_Size;
+      NewNode.CRC32:=CRC32;
+      NewNode.OS := MadeBy_Version shr 8;
+      if NewNode.OS = OS_UNIX then
+        NewNode.Attributes := External_Attributes shr 16
+      else
+        NewNode.Attributes := External_Attributes;
+      ZipDateTimeToDateTime(Last_Mod_Date,Last_Mod_Time,D);
+      NewNode.DateTime:=D;
+
+      // Go through any extra fields and extract any zip64 info
+      if Extra_Field_Length>0 then
+        begin
+        while (FZipStream.Position<SavePos+Extra_Field_Length) do
+          begin
+          FZipStream.ReadBuffer(ExtraFieldHeader, SizeOf(ExtraFieldHeader));
+        {$IFDEF FPC_BIG_ENDIAN}
+          ExtraFieldHeader := SwapEDFH(ExtraFieldHeader);
+        {$ENDIF}
+          if ExtraFieldHeader.Header_ID = ZIP64_HEADER_ID then
+            begin
+            FZipStream.ReadBuffer(Zip64Field, SizeOf(Zip64Field));
+          {$IFDEF FPC_BIG_ENDIAN}
+            Zip64Field := SwapZ64EIF(Zip64Field);
+          {$ENDIF}
+            if Zip64Field.Compressed_Size > 0 then
+              NewNode.FCompressedSize := Zip64Field.Compressed_Size;
+            if Zip64Field.Original_Size>0 then
+              NewNode.Size := Zip64Field.Original_Size;
+            if Zip64Field.Relative_Hdr_Offset<>0 then
+              begin
+              if Zip64Field.Relative_Hdr_Offset>High(Int64) then
+                raise EZipError.CreateFmt(SErrPosTooLarge,[Zip64Field.Relative_Hdr_Offset,High(Int64)]);
+              NewNode.HdrPos := Zip64Field.Relative_Hdr_Offset;
+              end;
+            end
+            // infozip unicode path extra field
+          else if ExtraFieldHeader.Header_ID = INFOZIP_UNICODE_PATH_ID then
+            begin
+            FZipStream.ReadBuffer(Infozip_unicode_path_ver,1);
+            if Infozip_unicode_path_ver=1 then
+              begin
+              FZipStream.ReadBuffer(Infozip_unicode_path_crc32,sizeof(Infozip_unicode_path_crc32));
+              {$IFDEF FPC_BIG_ENDIAN}
+              Infozip_unicode_path_crc32:=SwapEndian(Infozip_unicode_path_crc32);
+              {$ENDIF}
+              if CRC32Str(S)=Infozip_unicode_path_crc32 then
+                begin
+                SetLength(U,ExtraFieldHeader.Data_Size-5);
+				FZipStream.ReadBuffer(U[1],Length(U));
+                NewNode.UTF8ArchiveFileName:=U;
+                end
+              else
+                FZipStream.Seek(ExtraFieldHeader.Data_Size-5,soFromCurrent);
+              end
+            else
+              FZipStream.Seek(ExtraFieldHeader.Data_Size-1,soFromCurrent);
+            end
+          else
+            begin
+              // Read past non-Zip64 extra field
+              FZipStream.Seek(ExtraFieldHeader.Data_Size,soFromCurrent);
+            end;
+          end;
+        end;
+      // Move past extra fields and file comment to next header
+      FZipStream.Seek(SavePos+Extra_Field_Length+File_Comment_Length,soFromBeginning);
+      end;
+    end;
+end;
+
+function TUnZipper.CreateDeCompressor(Item: TZipFileEntry; AMethod: Word;
+  AZipFile, AOutFile: TStream): TDeCompressor;
+begin
+  case AMethod of
+    8 :
+      Result:=TInflater.Create(AZipFile,AOutFile,FBufSize);
+  else
+    raise EZipError.CreateFmt(SErrUnsupportedCompressionFormat,[AMethod]);
+  end;
+  FCurrentDecompressor:=Result;
+end;
+
+procedure TUnZipper.UnZipOneFile(Item: TFullZipFileEntry);
+
+Var
+  ZMethod : Word;
+{$ifdef unix}
+  LinkTargetStream: TStringStream;
+{$endif}
+  OutputFileName: RawByteString;
+  FOutStream: TStream;
+  IsLink: Boolean;
+  IsCustomStream: Boolean;
+  U : UnicodeString;
+
+  Procedure SetAttributes;
+  Var
+    Attrs : Longint;
+  begin
+    // set attributes
+    FileSetDate(OutputFileName, DateTimeToFileDate(Item.DateTime));
+    if (Item.Attributes <> 0) then
+      begin
+      Attrs := 0;
+      {$IFDEF UNIX}
+      if (Item.OS in [OS_UNIX,OS_OSX]) then Attrs := Item.Attributes;
+      if (Item.OS in [OS_FAT,OS_NTFS,OS_OS2,OS_VFAT]) then
+        Attrs := ZipFatAttrsToUnixAttrs(Item.Attributes);
+      {$ELSE}
+      if (Item.OS in [OS_FAT,OS_NTFS,OS_OS2,OS_VFAT]) then Attrs := Item.Attributes;
+      if (Item.OS in [OS_UNIX,OS_OSX]) then
+        Attrs := ZipUnixAttrsToFatAttrs(ExtractFileName(Item.ArchiveFileName), Item.Attributes);
+      {$ENDIF}
+      if Attrs <> 0 then
+        begin
+        {$IFDEF UNIX}
+        FpChmod(OutputFileName, Attrs);
+        {$ELSE}
+        FileSetAttr(OutputFileName, Attrs);
+        {$ENDIF}
+        end;
+      end;
+  end;
+
+  procedure DoUnzip(const Dest: TStream);
+
+  begin
+    if ZMethod=0 then
+      begin
+      if (LocalHdr.Compressed_Size<>0) then
+        begin
+        if LocalZip64Fld.Compressed_Size>0 then
+          Dest.CopyFrom(FZipStream,LocalZip64Fld.Compressed_Size)
+        else
+          Dest.CopyFrom(FZipStream,LocalHdr.Compressed_Size);
+        {$warning TODO: Implement CRC Check}
+        end;
+      end
+    else
+      With CreateDecompressor(Item, ZMethod, FZipStream, Dest) do
+        Try
+          FTotPos := Self.FTotPos;
+          FTotSize := Self.FTotSize;
+          OnProgress:=Self.OnProgress;
+          OnProgressEx := Self.OnProgressEx;
+          OnPercent:=Self.OnPercent;
+          OnProgress:=Self.OnProgress;
+          OnPercent:=Self.OnPercent;
+          DeCompress;
+          Self.FTotPos := FTotPos; 
+          if Item.CRC32 <> Crc32Val then
+            raise EZipError.CreateFmt(SErrInvalidCRC,[Item.ArchiveFileName]);
+        Finally
+          FCurrentDecompressor:=Nil;
+          Free;
+        end;
+  end;
+
+  Procedure GetOutputFileName;
+
+  Var
+    I : Integer;
+
+  begin
+    if Not UseUTF8 then
+      OutputFileName:=StringReplace(Item.DiskFileName,'/',DirectorySeparator,[rfReplaceAll])
+    else
+      begin
+      // Sets codepage.
+      OutputFileName:=Item.UTF8DiskFileName;
+      U:=UTF8Decode(OutputFileName);
+      // Do not use stringreplace, it will mess up the codepage.
+      if '/'<>DirectorySeparator then
+        For I:=1 to Length(U) do
+          if U[i]='/' then
+            U[i]:=DirectorySeparator;
+      OutputFileName:=UTF8Encode(U);
+      end;
+    if (Not IsCustomStream) then
+      begin
+      if Flat then
+        OutputFileName:=ExtractFileName(OutputFileName);
+      if (FOutputPath<>'') then
+        begin
+        // Do not use IncludeTrailingPathdelimiter
+        OutputFileName:=FOutputPath+OutputFileName;
+        end;
+      end;
+  end;
+
+Begin
+  ReadZipHeader(Item, ZMethod);
+  if (Item.BitFlags and 1)<>0 then
+    Raise EZipError.CreateFmt(SErrEncryptionNotSupported,[Item.ArchiveFileName]);
+  if (Item.BitFlags and (1 shl 5))<>0 then
+    Raise EZipError.CreateFmt(SErrPatchSetNotSupported,[Item.ArchiveFileName]);
+  // Normalize output filename to conventions of target platform.
+  // Zip file always has / path separators
+  IsCustomStream := Assigned(FOnCreateStream);
+  GetOutputFileName;
+  IsLink := Item.IsLink;
+{$IFNDEF UNIX}
+  if IsLink and Not IsCustomStream then
+    begin
+    {$warning TODO: Implement symbolic link creation for non-unix, e.g.
+    Windows NTFS}
+    IsLink := False;
+    end;
+{$ENDIF}
+  if IsCustomStream then
+    begin
+    try
+      OpenOutput(OutputFileName, FOutStream, Item);
+      if (IsLink = False) and (Item.IsDirectory = False) then
+        DoUnzip(FOutStream);
+    Finally
+      CloseOutput(Item, FOutStream);
+    end;
+    end
+  else
+    begin
+    if IsLink then
+      begin
+      {$IFDEF UNIX}
+        LinkTargetStream := TStringStream.Create('');
+        try
+          DoUnzip(LinkTargetStream);
+          fpSymlink(PChar(LinkTargetStream.DataString), PChar(OutputFileName));
+        finally
+          LinkTargetStream.Free;
+        end;
+      {$ENDIF}
+      end
+    else if Item.IsDirectory then
+      begin
+        if (NOT Flat) then CreateDir(OutputFileName);
+      end
+    else
+      begin
+      try
+        OpenOutput(OutputFileName, FOutStream, Item);
+        DoUnzip(FOutStream);
+      Finally
+        CloseOutput(Item, FOutStream);
+      end;
+      end;
+    SetAttributes;
+    end;
+end;
+
+Function TUnZipper.IsMatch(I : TFullZipFileEntry) : Boolean;
+
+begin
+  if UseUTF8 then
+    Result:=(FFiles.IndexOf(I.UTF8ArchiveFileName)<>-1)
+  else
+    Result:=(FFiles.IndexOf(I.ArchiveFileName)<>-1)
+end;
+
+Function TUnZipper.CalcTotalSize(AllFiles : Boolean) : Int64;
+
+Var
+  I : Integer;
+  Item : TFullZipFileEntry;
+
+begin
+  Result:=0;
+  for i:=0 to FEntries.Count-1 do
+    begin
+    Item := FEntries[i];
+    if AllFiles or IsMatch(Item) then
+      Result := Result + TZipFileEntry(Item).Size;
+    end;
+end;
+
+procedure TUnZipper.UnZipAllFiles;
+
+
+Var
+  Item : TFullZipFileEntry;
+  I : integer; //Really QWord but limited to FEntries.Count
+  AllFiles : Boolean;
+
+Begin
+  FTerminated:=False;
+  FUnZipping:=True;
+  Try
+    AllFiles:=(FFiles.Count=0);
+    OpenInput;
+    Try
+      ReadZipDirectory;
+      FTotPos := 0;
+      FTotSize := CalcTotalSize(AllFiles);
+      i:=0;
+      While (I<FEntries.Count) and not Terminated do
+        begin
+        Item:=FEntries[i];
+        if AllFiles or IsMatch(Item) then
+          UnZipOneFile(Item);
+        inc(I);
+        end;
+      if Assigned(FOnProgressEx) and not Terminated then
+        FOnProgressEx(Self, FTotPos, FTotSize);
+    Finally
+      CloseInput;
+    end;
+  finally
+    FUnZipping:=False;
+  end;
+end;
+
+
+procedure TUnZipper.SetBufSize(Value: LongWord);
+
+begin
+  If FUnZipping then
+    Raise EZipError.Create(SErrBufsizeChange);
+  If Value>=DefaultBufSize then
+    FBufSize:=Value;
+end;
+
+procedure TUnZipper.SetFileName(Value: RawByteString);
+
+begin
+  If FUnZipping then
+    Raise EZipError.Create(SErrFileChange);
+  FFileName:=Value;
+end;
+
+procedure TUnZipper.SetOutputPath(Value: RawByteString);
+
+Var
+  DS : RawByteString;
+
+begin
+  If FUnZipping then
+    Raise EZipError.Create(SErrFileChange);
+  FOutputPath:=Value;
+  If (FOutputPath<>'') and (FoutputPath[Length(FoutputPath)]<>DirectorySeparator) then
+    begin
+    // Preserve codepage of outputpath
+    DS:=DirectorySeparator;
+    SetCodePage(DS,StringCodePage(FoutputPath),False);
+    FOutputPath:=FoutputPath+DS;
+    end;
+end;
+
+procedure TUnZipper.UnZipFiles(AFileName: RawByteString; FileList: TStrings);
+
+begin
+  FFileName:=AFileName;
+  UNzipFiles(FileList);
+end;
+
+procedure TUnZipper.UnZipFiles(FileList: TStrings);
+begin
+  FFiles.Assign(FileList);
+  UnZipAllFiles;
+end;
+
+procedure TUnZipper.UnZipAllFiles(AFileName: RawByteString);
+
+begin
+  FFileName:=AFileName;
+  UnZipAllFiles;
+end;
+
+procedure TUnZipper.DoEndOfFile;
+
+Var
+  ComprPct : Double;
+  Uncompressed: QWord;
+  Compressed: QWord;
+begin
+  If LocalZip64Fld.Original_Size > 0 then
+    Uncompressed := LocalZip64Fld.Original_Size
+  else
+    Uncompressed := LocalHdr.Uncompressed_Size;
+
+  If LocalZip64Fld.Compressed_Size > 0 then
+    Compressed := LocalZip64Fld.Compressed_Size
+  else
+    Compressed := LocalHdr.Compressed_Size;
+
+  If (Compressed>0) and (Uncompressed>0) then
+    if (Compressed>Uncompressed) then
+      ComprPct := (-100.0 * (Compressed - Uncompressed)) / Uncompressed
+    else
+      ComprPct := (100.0 * (Uncompressed - Compressed)) / Uncompressed
+  else
+    ComprPct := 0;
+  If Assigned(FOnEndOfFile) then
+    FOnEndOfFile(Self,ComprPct);
+end;
+
+constructor TUnZipper.Create;
+
+begin
+  FBufSize:=DefaultBufSize;
+  FFiles:=TStringList.Create;
+  TStringlist(FFiles).Sorted:=True;
+  FEntries:=TFullZipFileEntries.Create(TFullZipFileEntry);
+  FOnPercent:=1;
+end;
+
+procedure TUnZipper.Clear;
+
+begin
+  FFiles.Clear;
+  FEntries.Clear;
+end;
+
+procedure TUnZipper.Examine;
+begin
+  if (FOnOpenInputStream = nil) and (FFileName='') then
+    Raise EZipError.Create(SErrNoFileName);
+  OpenInput;
+  If (FZipStream=nil) then
+    Raise EZipError.Create(SErrNoStream);
+  Try
+    ReadZipDirectory;
+  Finally
+    CloseInput;
+  end;
+end;
+
+procedure TUnZipper.Terminate;
+begin
+  FTerminated:=True;
+  if Assigned(FCurrentDecompressor) then
+    FCurrentDecompressor.Terminate;
+end;
+
+destructor TUnZipper.Destroy;
+
+begin
+  Clear;
+  FreeAndNil(FFiles);
+  FreeAndNil(FEntries);
+  Inherited;
+end;
+
+{ TZipFileEntry }
+
+function TZipFileEntry.GetArchiveFileName: String;
+begin
+  Result:=FArchiveFileName;
+  If (Result='') then
+    Result:=FDiskFileName;
+end;
+
+function TZipFileEntry.GetUTF8ArchiveFileName: UTF8String;
+begin
+  Result:=FUTF8FileName;
+  If Result='' then
+    Result:=ArchiveFileName;
+end;
+
+function TZipFileEntry.GetUTF8DiskFileName: UTF8String;
+begin
+  Result:=FUTF8DiskFileName;
+  If Result='' then
+    Result:=DiskFileName;
+end;
+
+constructor TZipFileEntry.Create(ACollection: TCollection);
+
+begin
+{$IFDEF UNIX}
+  FOS := OS_UNIX;
+{$ELSE}
+  FOS := OS_FAT;
+{$ENDIF}
+  FCompressionLevel:=cldefault;
+  FDateTime:=now;
+  FNeedsZip64:=false;
+  FAttributes:=0;
+
+  inherited create(ACollection);
+end;
+
+function TZipFileEntry.IsDirectory: Boolean;
+begin
+  Result := (DiskFileName <> '') and (DiskFileName[Length(DiskFileName)] = DirectorySeparator);
+  if Attributes <> 0 then
+  begin
+    case OS of
+      OS_FAT: Result := (faDirectory and Attributes) > 0;
+      OS_UNIX: Result := (Attributes and UNIX_MASK) = UNIX_DIR;
+    end;
+  end;
+end;
+
+function TZipFileEntry.IsLink: Boolean;
+begin
+  Result := False;
+  if Attributes <> 0 then
+  begin
+    case OS of
+      OS_FAT: Result := (faSymLink and Attributes) > 0;
+      OS_UNIX: Result := (Attributes and UNIX_MASK) = UNIX_LINK;
+    end;
+  end;
+end;
+
+procedure TZipFileEntry.SetArchiveFileName(const AValue: String);
+
+begin
+  if FArchiveFileName=AValue then Exit;
+  // Zip standard: filenames inside the zip archive have / path separator
+  if DirectorySeparator='/' then
+    FArchiveFileName:=AValue
+  else
+    FArchiveFileName:=StringReplace(AValue, DirectorySeparator, '/', [rfReplaceAll]);
+end;
+
+procedure TZipFileEntry.SetDiskFileName(const AValue: String);
+begin
+  if FDiskFileName=AValue then Exit;
+  // Zip file uses / as directory separator on all platforms
+  // so convert to separator used on current OS
+  if DirectorySeparator='/' then
+    FDiskFileName:=AValue
+  else
+    FDiskFileName:=StringReplace(AValue,'/',DirectorySeparator,[rfReplaceAll]);
+end;
+
+procedure TZipFileEntry.SetUTF8ArchiveFileName(AValue: UTF8String);
+begin
+  FUTF8FileName:=AValue;
+  If ArchiveFileName='' then
+    if DefaultSystemCodePage<>CP_UTF8 then
+      ArchiveFileName:=Utf8ToAnsi(AValue)
+    else
+      ArchiveFileName:=AValue;
+end;
+
+procedure TZipFileEntry.SetUTF8DiskFileName(AValue: UTF8String);
+begin
+  FUTF8DiskFileName:=AValue;
+  If DiskFileName='' then
+    if DefaultRTLFileSystemCodePage<>CP_UTF8 then
+      DiskFileName:=Utf8ToAnsi(AValue)
+    else
+      DiskFileName:=AValue;
+end;
+
+
+procedure TZipFileEntry.Assign(Source: TPersistent);
+
+Var
+  Z : TZipFileEntry;
+
+begin
+  if Source is TZipFileEntry then
+    begin
+    Z:=Source as TZipFileEntry;
+    FArchiveFileName:=Z.FArchiveFileName;
+    FDiskFileName:=Z.FDiskFileName;
+    FSize:=Z.FSize;
+    FDateTime:=Z.FDateTime;
+    FStream:=Z.FStream;
+    FOS:=Z.OS;
+    FAttributes:=Z.Attributes;
+    end
+  else
+    inherited Assign(Source);
+end;
+
+{ TZipFileEntries }
+
+function TZipFileEntries.GetZ(AIndex : Integer): TZipFileEntry;
+begin
+  Result:=TZipFileEntry(Items[AIndex]);
+end;
+
+procedure TZipFileEntries.SetZ(AIndex : Integer; const AValue: TZipFileEntry);
+begin
+  Items[AIndex]:=AValue;
+end;
+
+function TZipFileEntries.AddFileEntry(const ADiskFileName: String): TZipFileEntry;
+begin
+  Result:=Add as TZipFileEntry;
+  Result.DiskFileName:=ADiskFileName;
+end;
+
+function TZipFileEntries.AddFileEntry(const ADiskFileName,
+  AArchiveFileName: String): TZipFileEntry;
+begin
+  Result:=AddFileEntry(ADiskFileName);
+  Result.ArchiveFileName:=AArchiveFileName;
+end;
+
+function TZipFileEntries.AddFileEntry(const AStream: TSTream;
+  const AArchiveFileName: String): TZipFileEntry;
+begin
+  Result:=Add as TZipFileEntry;
+  Result.Stream:=AStream;
+  Result.ArchiveFileName:=AArchiveFileName;
+end;
+
+Procedure TZipFileEntries.AddFileEntries(Const List : TStrings);
+
+Var
+  I : integer;
+
+begin
+  For I:=0 to List.Count-1 do
+    AddFileEntry(List[i]);
+end;
+
+{ TFullZipFileEntries }
+
+function TFullZipFileEntries.GetFZ(AIndex : Integer): TFullZipFileEntry;
+begin
+  Result:=TFullZipFileEntry(Items[AIndex]);
+end;
+
+procedure TFullZipFileEntries.SetFZ(AIndex : Integer;
+  const AValue: TFullZipFileEntry);
+begin
+  Items[AIndex]:=AValue;
+end;
+
+End.

+ 309 - 0
src/libraries/paszlib/paszlib_ziputils.pas

@@ -0,0 +1,309 @@
+unit paszlib_ZipUtils;
+
+{ ziputils.pas - IO on .zip files using zlib
+  - definitions, declarations and routines used by both
+    zip.pas and unzip.pas
+    The file IO is implemented here.
+
+  based on work by Gilles Vollant
+
+  March 23th, 2000,
+  Copyright (C) 2000 Jacques Nomssi Nzali }
+
+interface
+
+{$undef UseStream}
+
+{$ifdef WIN32}
+  {$define Delphi}
+  {$ifdef UseStream}
+    {$define Streams}
+  {$endif}
+{$endif}
+
+//uses  Classes, SysUtils;
+
+{ -------------------------------------------------------------- }
+{$ifdef Streams}
+type
+  FILEptr = TFileStream;
+{$else}
+type
+  FILEptr = ^file;
+{$endif}
+
+type
+  seek_mode = (SEEK_SET, SEEK_CUR, SEEK_END);
+  open_mode = (fopenread, fopenwrite, fappendwrite);
+
+function fopen(filename: PChar; mode: open_mode): FILEptr;
+
+procedure fclose(fp: FILEptr);
+
+function fseek(fp: FILEptr; recPos: longint; mode: seek_mode): longint;
+
+function fread(buf: pointer; recSize: longint; recCount: longint; fp: FILEptr): longint;
+
+function fwrite(buf: pointer; recSize: longint; recCount: longint; fp: FILEptr): longint;
+
+function ftell(fp: FILEptr): longint;  { ZIP }
+
+function feof(fp: FILEptr): longint;   { MiniZIP }
+
+{ ------------------------------------------------------------------- }
+
+type
+  zipFile = pointer;
+  unzFile = pointer;
+
+type
+  z_off_t = longint;
+
+{ tm_zip contain date/time info }
+type
+  tm_zip = record
+    tm_sec:  longint;            { seconds after the minute - [0,59] }
+    tm_min:  longint;            { minutes after the hour - [0,59] }
+    tm_hour: longint;            { hours since midnight - [0,23] }
+    tm_mday: longint;            { day of the month - [1,31] }
+    tm_mon:  longint;            { months since January - [0,11] }
+    tm_year: longint;            { years - [1980..2044] }
+  end;
+
+  tm_unz = tm_zip;
+
+const
+  Z_BUFSIZE = (16384);
+  Z_MAXFILENAMEINZIP = (256);
+
+const
+  CENTRALHEADERMAGIC = $02014b50;
+
+const
+  SIZECENTRALDIRITEM = $2e;
+  SIZEZIPLOCALHEADER = $1e;
+
+const
+  Paszip_copyright: PChar = ' Paszip Copyright 2000 Jacques Nomssi Nzali ';
+
+implementation
+
+{$ifdef Streams}
+{ ---------------------------------------------------------------- }
+
+function fopen(filename: PChar; mode: open_mode): FILEptr;
+var
+  fp: FILEptr;
+begin
+  fp := nil;
+  try
+    case mode of
+      fopenread: fp  := TFileStream.Create(strpas(filename), fmOpenRead);
+      fopenwrite: fp := TFileStream.Create(strpas(filename), fmCreate);
+      fappendwrite:
+      begin
+        fp := TFileStream.Create(strpas(filename), fmOpenReadWrite);
+        fp.Seek(soFromEnd, 0);
+      end;
+    end;
+  except
+    on EFOpenError do
+      fp := nil;
+  end;
+  fopen := fp;
+end;
+
+procedure fclose(fp: FILEptr);
+begin
+  fp.Free;
+end;
+
+function fread(buf: pointer; recSize: longint; recCount: longint; fp: FILEptr): longint;
+var
+  totalSize, readcount: longint;
+begin
+  if Assigned(buf) then
+  begin
+    totalSize := recCount * longint(recSize);
+    readCount := fp.Read(buf^, totalSize);
+    if (readcount <> totalSize) then
+      fread := readcount div recSize
+    else
+      fread := recCount;
+  end
+  else
+    fread := 0;
+end;
+
+function fwrite(buf: pointer; recSize: longint; recCount: longint; fp: FILEptr): longint;
+var
+  totalSize, written: longint;
+begin
+  if Assigned(buf) then
+  begin
+    totalSize := recCount * longint(recSize);
+    written   := fp.Write(buf^, totalSize);
+    if (written <> totalSize) then
+      fwrite := written div recSize
+    else
+      fwrite := recCount;
+  end
+  else
+    fwrite := 0;
+end;
+
+function fseek(fp: FILEptr; recPos: longint; mode: seek_mode): int;
+const
+  fsmode: array[seek_mode] of word = (soFromBeginning, soFromCurrent, soFromEnd);
+begin
+  fp.Seek(recPos, fsmode[mode]);
+  fseek := 0; { = 0 for success }
+end;
+
+function ftell(fp: FILEptr): longint;
+begin
+  ftell := fp.Position;
+end;
+
+function feof(fp: FILEptr): longint;
+begin
+  feof := 0;
+  if Assigned(fp) then
+    if fp.Position = fp.Size then
+      feof := 1
+    else
+      feof := 0;
+end;
+
+{$else}
+{ ---------------------------------------------------------------- }
+
+function fopen(filename : PChar; mode : open_mode) : FILEptr;
+var
+  fp : FILEptr;
+  OldFileMode : byte;
+begin
+  fp := NIL;
+  OldFileMode := FileMode;
+
+  GetMem(fp, SizeOf(file));
+  Assign(fp^, strpas(filename));
+  {$push}{$i-}
+  Case mode of
+  fopenread:
+    begin
+      FileMode := 0;
+      Reset(fp^, 1);
+    end;
+  fopenwrite:
+    begin
+      FileMode := 1;
+      ReWrite(fp^, 1);
+    end;
+  fappendwrite :
+    begin
+      FileMode := 2;
+      Reset(fp^, 1);
+      Seek(fp^, FileSize(fp^));
+    end;
+  end;
+  FileMode := OldFileMode;
+  {$pop}
+  if IOresult<>0 then
+  begin
+    FreeMem(fp, SizeOf(file));
+    fp := NIL;
+  end;
+
+  fopen := fp;
+end;
+
+procedure fclose(fp : FILEptr);
+begin
+  if Assigned(fp) then
+  begin
+    {$push}{$i-}
+    system.close(fp^);
+    {$pop}
+    if IOresult=0 then;
+    FreeMem(fp, SizeOf(file));
+  end;
+end;
+
+function fread(buf : pointer;
+               recSize : LongInt;
+               recCount : LongInt;
+               fp : FILEptr) : LongInt;
+var
+  totalSize, readcount : LongInt;
+begin
+  if Assigned(buf) then
+  begin
+    totalSize := recCount * LongInt(recSize);
+    {$push}{$i-}
+    system.BlockRead(fp^, buf^, totalSize, readcount);
+    if (readcount <> totalSize) then
+      fread := readcount div recSize
+    else
+      fread := recCount;
+    {$pop}
+  end
+  else
+    fread := 0;
+end;
+
+function fwrite(buf : pointer;
+                recSize : LongInt;
+                recCount : LongInt;
+                fp : FILEptr) : LongInt;
+var
+  totalSize, written : LongInt;
+begin
+  if Assigned(buf) then
+  begin
+    totalSize := recCount * LongInt(recSize);
+    {$push}{$i-}
+    system.BlockWrite(fp^, buf^, totalSize, written);
+    if (written <> totalSize) then
+      fwrite := written div recSize
+    else
+      fwrite := recCount;
+    {$pop}
+  end
+  else
+    fwrite := 0;
+end;
+
+function fseek(fp : FILEptr;
+               recPos : LongInt;
+               mode : seek_mode) : longint;
+begin
+  {$push}{$i-}
+  case mode of
+    SEEK_SET : system.Seek(fp^, recPos);
+    SEEK_CUR : system.Seek(fp^, FilePos(fp^)+recPos);
+    SEEK_END : system.Seek(fp^, FileSize(fp^)-1-recPos); { ?? check }
+  end;
+  {$pop}
+  fseek := IOresult; { = 0 for success }
+end;
+
+function ftell(fp : FILEptr) : LongInt;
+begin
+  ftell := FilePos(fp^);
+end;
+
+function feof(fp : FILEptr) : LongInt;
+begin
+  feof := 0;
+  if Assigned(fp) then
+    if eof(fp^) then
+      feof := 1
+    else
+      feof := 0;
+end;
+
+{$endif}
+{ ---------------------------------------------------------------- }
+
+end.

+ 422 - 0
src/libraries/paszlib/paszlib_zstream.pp

@@ -0,0 +1,422 @@
+unit paszlib_ZStream;
+
+{**********************************************************************
+    This file is part of the Free Pascal free component library.
+
+    Copyright (c) 2007 by Daniel Mantione
+      member of the Free Pascal development team
+
+    Implements a Tstream descendents that allow you to read and write
+    compressed data according to the Deflate algorithm described in
+    RFC1951.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program 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.
+
+ **********************************************************************}
+
+{$mode objfpc}
+
+{***************************************************************************}
+                                    interface
+{***************************************************************************}
+
+uses    classes,paszlib_zbase,paszlib_gzio;
+
+type
+        Tcompressionlevel=(
+          clnone,                     {Do not use compression, just copy data.}
+          clfastest,                  {Use fast (but less) compression.}
+          cldefault,                  {Use default compression}
+          clmax                       {Use maximum compression}
+        );
+
+        Tgzopenmode=(
+          gzopenread,                 {Open file for reading.}
+          gzopenwrite                 {Open file for writing.}
+        );
+
+        Tcustomzlibstream=class(Townerstream)
+        protected
+          Fstream:z_stream;
+          Fbuffer:pointer;
+          Fonprogress:Tnotifyevent;
+          procedure progress(sender:Tobject);
+          property onprogress:Tnotifyevent read Fonprogress write Fonprogress;
+        public
+          constructor create(stream:Tstream);
+          destructor destroy;override;
+        end;
+
+        { Tcompressionstream }
+
+        Tcompressionstream=class(Tcustomzlibstream)
+        private
+          function ClearOutBuffer: Integer;
+        protected
+          raw_written,compressed_written: int64;
+        public
+          constructor create(level:Tcompressionlevel;
+                             dest:Tstream;
+                             Askipheader:boolean=false);
+          destructor destroy;override;
+          function write(const buffer;count:longint):longint;override;
+          procedure flush;
+          function get_compressionrate:single;
+          property OnProgress;
+        end;
+
+        Tdecompressionstream=class(Tcustomzlibstream)
+        protected
+          raw_read,compressed_read:int64;
+          skipheader:boolean;
+          procedure reset;
+          function GetPosition() : Int64; override;
+        public
+          constructor create(Asource:Tstream;Askipheader:boolean=false);
+          destructor destroy;override;
+          function read(var buffer;count:longint):longint;override;
+          function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;  override;
+          function get_compressionrate:single;
+          property OnProgress;
+        end;
+
+        TGZFileStream = Class(TStream)
+        protected
+          Fgzfile:gzfile;
+          Ffilemode:Tgzopenmode;
+        public
+          constructor create(filename:ansistring;filemode:Tgzopenmode);
+          function read(var buffer;count:longint):longint;override;
+          function write(const buffer;count:longint):longint;override;
+          function seek(offset:longint;origin:word):longint;override;
+          destructor destroy;override;
+        end;
+
+        Ezliberror=class(Estreamerror)
+        end;
+
+        Egzfileerror=class(Ezliberror)
+        end;
+
+        Ecompressionerror=class(Ezliberror)
+        end;
+
+        Edecompressionerror=class(Ezliberror)
+        end;
+
+{***************************************************************************}
+                                 implementation
+{***************************************************************************}
+
+uses    paszlib_zdeflate,paszlib_zinflate;
+
+const   bufsize=16384;     {Size of the buffer used for temporarily storing
+                            data from the child stream.}
+
+resourcestring Sgz_open_error='Could not open gzip compressed file %s.';
+               Sgz_read_only='Gzip compressed file was opened for reading.';
+               Sgz_write_only='Gzip compressed file was opened for writing.';
+               Sseek_failed='Seek in deflate compressed stream failed.';
+
+constructor Tcustomzlibstream.create(stream:Tstream);
+
+begin
+  assert(stream<>nil);
+  inherited create(stream);
+  getmem(Fbuffer,bufsize);
+end;
+
+procedure Tcustomzlibstream.progress(sender:Tobject);
+
+begin
+  if Fonprogress<>nil then
+    Fonprogress(sender);
+end;
+
+destructor Tcustomzlibstream.destroy;
+
+begin
+  freemem(Fbuffer);
+  inherited destroy;
+end;
+
+{***************************************************************************}
+
+constructor Tcompressionstream.create(level:Tcompressionlevel;
+                                      dest:Tstream;
+                                      Askipheader:boolean=false);
+
+var err,l:smallint;
+
+begin
+  inherited create(dest);
+  Fstream.next_out:=Fbuffer;
+  Fstream.avail_out:=bufsize;
+
+  case level of
+    clnone:
+      l:=Z_NO_COMPRESSION;
+    clfastest:
+      l:=Z_BEST_SPEED;
+    cldefault:
+      l:=Z_DEFAULT_COMPRESSION;
+    clmax:
+      l:=Z_BEST_COMPRESSION;
+  end;
+
+  if Askipheader then
+    err:=deflateInit2(Fstream,l,Z_DEFLATED,-MAX_WBITS,DEF_MEM_LEVEL,0)
+  else
+    err:=deflateInit(Fstream,l);
+  if err<>Z_OK then
+    raise Ecompressionerror.create(zerror(err));
+end;
+
+function Tcompressionstream.write(const buffer;count:longint):longint;
+
+var err:smallint;
+    lastavail:longint;
+
+begin
+  Fstream.next_in:=@buffer;
+  Fstream.avail_in:=count;
+  lastavail:=count;
+  while Fstream.avail_in<>0 do
+    begin
+      if Fstream.avail_out=0 then
+        ClearOutBuffer;
+      inc(raw_written,lastavail-Fstream.avail_in);
+      lastavail:=Fstream.avail_in;
+      err:=deflate(Fstream,Z_NO_FLUSH);
+      if err<>Z_OK then
+        raise Ecompressionerror.create(zerror(err));
+    end;
+  inc(raw_written,lastavail-Fstream.avail_in);
+  write:=count;
+end;
+
+function Tcompressionstream.get_compressionrate:single;
+
+begin
+  get_compressionrate:=100*compressed_written/raw_written;
+end;
+
+Function TCompressionstream.ClearOutBuffer : Integer;
+
+
+begin
+  { Flush the buffer to the stream and update progress }
+  Result:=source.write(Fbuffer^,bufsize);
+  inc(compressed_written,Result);
+  progress(self);
+  { reset output buffer }
+  Fstream.next_out:=Fbuffer;
+  Fstream.avail_out:=bufsize;
+end;
+
+procedure Tcompressionstream.flush;
+
+var err:smallint;
+
+begin
+  {Compress remaining data still in internal zlib data buffers.}
+  repeat
+    if Fstream.avail_out=0 then
+      ClearOutBuffer;
+    err:=deflate(Fstream,Z_FINISH);
+    if err=Z_STREAM_END then
+      break;
+    if (err<>Z_OK) then
+      raise Ecompressionerror.create(zerror(err));
+  until false;
+  if Fstream.avail_out<bufsize then
+    begin
+      source.writebuffer(FBuffer^,bufsize-Fstream.avail_out);
+      inc(compressed_written,bufsize-Fstream.avail_out);
+      progress(self);
+      Fstream.next_out:=Fbuffer;
+      Fstream.avail_out:=bufsize;
+    end;
+end;
+
+
+destructor Tcompressionstream.destroy;
+
+begin
+  try
+    Flush;
+  finally
+    deflateEnd(Fstream);
+    inherited destroy;
+  end;
+end;
+
+{***************************************************************************}
+
+constructor Tdecompressionstream.create(Asource:Tstream;Askipheader:boolean=false);
+
+var err:smallint;
+
+begin
+  inherited create(Asource);
+
+  skipheader:=Askipheader;
+  if Askipheader then
+    err:=inflateInit2(Fstream,-MAX_WBITS)
+  else
+    err:=inflateInit(Fstream);
+  if err<>Z_OK then
+    raise Ecompressionerror.create(zerror(err));
+end;
+
+function Tdecompressionstream.read(var buffer;count:longint):longint;
+
+var err:smallint;
+    lastavail:longint;
+
+begin
+  Fstream.next_out:=@buffer;
+  Fstream.avail_out:=count;
+  lastavail:=count;
+  while Fstream.avail_out<>0 do
+    begin
+      if Fstream.avail_in=0 then
+        begin
+          {Refill the buffer.}
+          Fstream.next_in:=Fbuffer;
+          Fstream.avail_in:=source.read(Fbuffer^,bufsize);
+          inc(compressed_read,Fstream.avail_in);
+          inc(raw_read,lastavail-Fstream.avail_out);
+          lastavail:=Fstream.avail_out;
+          progress(self);
+        end;
+      err:=inflate(Fstream,Z_NO_FLUSH);
+      if err=Z_STREAM_END then
+        break;
+      if err<>Z_OK then
+        raise Edecompressionerror.create(zerror(err));
+    end;
+  if err=Z_STREAM_END then
+    dec(compressed_read,Fstream.avail_in);
+  inc(raw_read,lastavail-Fstream.avail_out);
+  read:=count-Fstream.avail_out;
+end;
+
+procedure Tdecompressionstream.reset;
+
+var err:smallint;
+
+begin
+  source.seek(-compressed_read,sofromcurrent);
+  raw_read:=0;
+  compressed_read:=0;
+  inflateEnd(Fstream);
+  if skipheader then
+    err:=inflateInit2(Fstream,-MAX_WBITS)
+  else
+    err:=inflateInit(Fstream);
+  if err<>Z_OK then
+    raise Edecompressionerror.create(zerror(err));
+end;
+
+function Tdecompressionstream.GetPosition() : Int64;
+begin
+  GetPosition := raw_read;
+end;
+
+function Tdecompressionstream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
+
+var c,off: int64;
+
+begin
+  off:=Offset;
+
+  if origin=soCurrent then
+    inc(off,raw_read);
+  if (origin=soEnd) or (off<0) then
+    raise Edecompressionerror.create(Sseek_failed);
+
+  seek:=off;
+
+  if off<raw_read then
+    reset
+  else
+    dec(off,raw_read);
+
+  while off>0 do
+    begin
+      c:=off;
+      if c>bufsize then
+        c:=bufsize;
+      if read(Fbuffer^,c)<>c then
+        raise Edecompressionerror.create(Sseek_failed);
+      dec(off,c);
+    end;
+end;
+
+function Tdecompressionstream.get_compressionrate:single;
+
+begin
+  get_compressionrate:=100*compressed_read/raw_read;
+end;
+
+
+destructor Tdecompressionstream.destroy;
+
+begin
+  inflateEnd(Fstream);
+  inherited destroy;
+end;
+
+
+{***************************************************************************}
+
+constructor Tgzfilestream.create(filename:ansistring;filemode:Tgzopenmode);
+
+begin
+  if filemode=gzopenread then
+    Fgzfile:=gzopen(filename,'rb')
+  else
+    Fgzfile:=gzopen(filename,'wb');
+  Ffilemode:=filemode;
+  if Fgzfile=nil then
+    raise Egzfileerror.createfmt(Sgz_open_error,[filename]);
+end;
+
+function Tgzfilestream.read(var buffer;count:longint):longint;
+
+begin
+  if Ffilemode=gzopenwrite then
+    raise Egzfileerror.create(Sgz_write_only);
+  read:=gzread(Fgzfile,@buffer,count);
+end;
+
+function Tgzfilestream.write(const buffer;count:longint):longint;
+
+begin
+  if Ffilemode=gzopenread then
+    raise Egzfileerror.create(Sgz_write_only);
+  write:=gzwrite(Fgzfile,@buffer,count);
+end;
+
+function Tgzfilestream.seek(offset:longint;origin:word):longint;
+
+begin
+  seek:=gzseek(Fgzfile,offset,origin);
+  if seek=-1 then
+    raise egzfileerror.create(Sseek_failed);
+end;
+
+destructor Tgzfilestream.destroy;
+
+begin
+  gzclose(Fgzfile);
+  inherited destroy;
+end;
+
+end.

+ 89 - 0
src/libraries/paszlib/paszlib_zuncompr.pas

@@ -0,0 +1,89 @@
+unit paszlib_ZUncompr;
+
+{ uncompr.c -- decompress a memory buffer
+  Copyright (C) 1995-1998 Jean-loup Gailly.
+
+  Pascal tranlastion
+  Copyright (C) 1998 by Jacques Nomssi Nzali
+  For conditions of distribution and use, see copyright notice in readme.txt
+}
+
+interface
+
+{$I paszlib_zconf.inc}
+
+uses
+  paszlib_zbase, paszlib_zinflate;
+
+{ ===========================================================================
+     Decompresses the source buffer into the destination buffer.  sourceLen is
+   the byte length of the source buffer. Upon entry, destLen is the total
+   size of the destination buffer, which must be large enough to hold the
+   entire uncompressed data. (The size of the uncompressed data must have
+   been saved previously by the compressor and transmitted to the decompressor
+   by some mechanism outside the scope of this compression library.)
+   Upon exit, destLen is the actual size of the compressed buffer.
+     This function can be used to decompress a whole file at once if the
+   input file is mmap'ed.
+
+     uncompress returns Z_OK if success, Z_MEM_ERROR if there was not
+   enough memory, Z_BUF_ERROR if there was not enough room in the output
+   buffer, or Z_DATA_ERROR if the input data was corrupted.
+}
+
+function uncompress (dest : Pbyte;
+                     var destLen : cardinal;
+                     const source : array of byte;
+                     sourceLen : cardinal) : integer;
+
+implementation
+
+function uncompress (dest : Pbyte;
+                     var destLen : cardinal;
+                     const source : array of byte;
+                     sourceLen : cardinal) : integer;
+var
+  stream : z_stream;
+  err : integer;
+begin
+  stream.next_in := Pbyte(@source);
+  stream.avail_in := cardinal(sourceLen);
+  { Check for source > 64K on 16-bit machine: }
+  if (cardinal(stream.avail_in) <> sourceLen) then
+  begin
+    uncompress := Z_BUF_ERROR;
+    exit;
+  end;
+
+  stream.next_out := dest;
+  stream.avail_out := cardinal(destLen);
+  if (cardinal(stream.avail_out) <> destLen) then
+  begin
+    uncompress := Z_BUF_ERROR;
+    exit;
+  end;
+
+  err := inflateInit(stream);
+  if (err <> Z_OK) then
+  begin
+    uncompress := err;
+    exit;
+  end;
+
+  err := inflate(stream, Z_FINISH);
+  if (err <> Z_STREAM_END) then
+  begin
+    inflateEnd(stream);
+    if err = Z_OK then
+      uncompress := Z_BUF_ERROR
+    else
+      uncompress := err;
+    exit;
+  end;
+  destLen := stream.total_out;
+
+  err := inflateEnd(stream);
+  uncompress := err;
+end;
+
+end.

+ 5 - 5
src/pascalcoin_wallet_classic.lpi

@@ -14,15 +14,15 @@
       <Title Value="PascalCoinWalletLazarus"/>
       <Title Value="PascalCoinWalletLazarus"/>
       <UseAppBundle Value="False"/>
       <UseAppBundle Value="False"/>
       <ResourceType Value="res"/>
       <ResourceType Value="res"/>
+      <Icon Value="0"/>
     </General>
     </General>
     <i18n>
     <i18n>
       <EnableI18N LFM="False"/>
       <EnableI18N LFM="False"/>
     </i18n>
     </i18n>
     <VersionInfo>
     <VersionInfo>
       <UseVersionInfo Value="True"/>
       <UseVersionInfo Value="True"/>
-      <MajorVersionNr Value="2"/>
-      <MinorVersionNr Value="1"/>
-      <RevisionNr Value="6"/>
+      <MajorVersionNr Value="4"/>
+      <RevisionNr Value="2"/>
       <StringTable ProductVersion="0.0.0.0"/>
       <StringTable ProductVersion="0.0.0.0"/>
     </VersionInfo>
     </VersionInfo>
     <BuildModes Count="1">
     <BuildModes Count="1">
@@ -45,7 +45,7 @@
       <Unit0>
       <Unit0>
         <Filename Value="pascalcoin_wallet_classic.dpr"/>
         <Filename Value="pascalcoin_wallet_classic.dpr"/>
         <IsPartOfProject Value="True"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="PascalCoin_wallet"/>
+        <UnitName Value="PascalCoin_wallet_classic"/>
       </Unit0>
       </Unit0>
       <Unit1>
       <Unit1>
         <Filename Value="core\UBlockChain.pas"/>
         <Filename Value="core\UBlockChain.pas"/>
@@ -212,7 +212,7 @@
     </Target>
     </Target>
     <SearchPaths>
     <SearchPaths>
       <IncludeFiles Value="$(ProjOutDir)"/>
       <IncludeFiles Value="$(ProjOutDir)"/>
-      <OtherUnitFiles Value="core;gui-classic;libraries\synapse;libraries\sphere10;libraries\hashlib4pascal;libraries\generics.collections;libraries\pascalcoin"/>
+      <OtherUnitFiles Value="core;gui-classic;libraries\synapse;libraries\sphere10;libraries\hashlib4pascal;libraries\generics.collections;libraries\pascalcoin;libraries\paszlib"/>
       <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
       <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
     </SearchPaths>
     </SearchPaths>
     <Parsing>
     <Parsing>