home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / unity / d5 / JRZIP.ZIP / GzIOExt.pas next >
Pascal/Delphi Source File  |  2001-02-08  |  40KB  |  1,452 lines
  1. Unit gzioext;
  2. {
  3.   Pascal unit based on gzio.c -- IO on .gz files
  4.   Copyright (C) 1995-1998 Jean-loup Gailly.
  5.  
  6.   Define NO_DEFLATE to compile this file without the compression code
  7.  
  8.   Pascal tranlastion based on code contributed by Francisco Javier Crespo
  9.   Copyright (C) 1998 by Jacques Nomssi Nzali
  10.   For conditions of distribution and use, see copyright notice in readme.txt
  11. }
  12.  
  13. { -------------------------------------------------------------
  14.   modifications made for
  15.   - GZip:
  16.     - include original filename in header on writing
  17.     - include timestamp in header on writing
  18.     - extract original filename from header on reading
  19.     - extract timestamp from header on reading
  20.   - PKZip-Format
  21.     - write PK-Format (see "appnote-960915-pk")
  22.  
  23.   the following bugs were fixed:
  24.   - limitation of path length to 79 char in gzopen
  25.  
  26.   Copyright (c) by J. Rathlev, Jan. 2001 (E-Mail: rathlev@physik.uni-kiel.de)
  27. }
  28.  
  29. interface
  30.  
  31. {$I zconf.inc}
  32.  
  33. uses
  34.   SysUtils,
  35.   zutil, zlib, crc, zdeflate, zinflate;
  36.  
  37. const
  38.   PkLocalSignatur = $04034b50;
  39.   PkDirSignatur = $02014b50;
  40.   PkEndSignatur = $06054b50;
  41.  
  42. type
  43.   TPKLocalHeader = packed record
  44.     Signatur    : cardinal;
  45.     Vers,Flag,
  46.     Method      : word;
  47.     FTimeStamp,
  48.     CRC,
  49.     CSize,USize : cardinal;
  50.     FNLength,
  51.     ExtraLength : word;
  52.     end;
  53.  
  54.   TPKDirHeader = packed record
  55.     Signatur    : cardinal;
  56.     VersMade,
  57.     VersExtr,
  58.     Flag,
  59.     Method      : word;
  60.     FTimeStamp,
  61.     CRC,
  62.     CSize,USize : cardinal;
  63.     FNLength,
  64.     ExtraLength,
  65.     CommLength,
  66.     DiskStart,
  67.     IntAttr     : word;
  68.     ExtAttr,
  69.     Offset      : cardinal;
  70.     end;
  71.  
  72.   TPKEndHeader = packed record
  73.     Signatur    : cardinal;
  74.     ThisDisk,
  75.     StartDisk,
  76.     ThisEntries,
  77.     TotalEntries : word;
  78.     DirSize,
  79.     Offset      : cardinal;
  80.     CommLength  : word;
  81.     end;
  82.  
  83.   gz_stream = record
  84.     stream      : z_stream;
  85.     z_err       : int;      { error code for last stream operation }
  86.     z_eof       : boolean;  { set if end of input file }
  87.     gz_file     : file;     { .gz file }
  88.     inbuf       : pBytef;   { input buffer }
  89.     outbuf      : pBytef;   { output buffer }
  90.     crc         : uLong;    { crc32 of uncompressed data }
  91.     msg,                    { error message - limit 79 chars }
  92.     path        : string[255];   { path name for debugging only - limit 255 chars }
  93.     transparent : boolean;  { true if input file is not a .gz file }
  94.     mode        : char;     { 'w' or 'r' }
  95.     USize,CSize,
  96.     filepos,                { start of file section }
  97.     startpos    : long;     { start of compressed data in file (header skipped) }
  98.     time        : cardinal; { time stamp of file }
  99.     end;
  100.  
  101.   gzFile = ^gz_Stream;
  102.   gz_streamp = gzFile;
  103. {  gzFile = voidp;}
  104.   z_off_t = long;
  105.  
  106. { --- JR ------------------------------------------------------------ }
  107. function gzopen (path,mode      : string;
  108.                  var fname      : string;
  109.                  var timestamp  : cardinal) : gzFile;
  110. function ZipOpen (path,mode,fname : string;
  111.                   timestamp       : cardinal) : gzFile;
  112. function ZipClose (f:gzFile) : int;
  113. { ------------------------------------------------------------------- }
  114. function gzread  (f:gzFile; buf:voidp; len:uInt) : int;
  115. function gzgetc  (f:gzfile) : int;
  116. function gzgets  (f:gzfile; buf:PChar; len:int) : PChar;
  117.  
  118. {$ifndef NO_DEFLATE}
  119. function gzwrite (f:gzFile; buf:voidp; len:uInt) : int;
  120. function gzputc  (f:gzfile; c:char) : int;
  121. function gzputs  (f:gzfile; s:PChar) : int;
  122. function gzflush (f:gzFile; flush:int)           : int;
  123.   {$ifdef GZ_FORMAT_STRING}
  124.   function gzprintf (zfile : gzFile;
  125.                      const format : string;
  126.                      a : array of int);    { doesn't compile }
  127.   {$endif}
  128. {$endif}
  129.  
  130. function gzseek  (f:gzfile; offset:z_off_t; whence:int) : z_off_t;
  131. function gztell  (f:gzfile) : z_off_t;
  132. function gzclose (f:gzFile) : int;
  133. function gzerror (f:gzFile; var errnum:Int)      : string;
  134.  
  135. const
  136.   SEEK_SET {: z_off_t} = 0; { seek from beginning of file }
  137.   SEEK_CUR {: z_off_t} = 1; { seek from current position }
  138.   SEEK_END {: z_off_t} = 2;
  139.  
  140. implementation
  141.  
  142. const
  143.   Z_EOF = -1;         { same value as in STDIO.H }
  144.   Z_BUFSIZE = 16384;
  145.   { Z_PRINTF_BUFSIZE = 4096; }
  146.  
  147.  
  148.   gz_magic : array[0..1] of byte = ($1F, $8B); { gzip magic header }
  149.  
  150.   { gzip flag byte }
  151.  
  152.   ASCII_FLAG  = $01; { bit 0 set: file probably ascii text }
  153.   HEAD_CRC    = $02; { bit 1 set: header CRC present }
  154.   EXTRA_FIELD = $04; { bit 2 set: extra field present }
  155.   ORIG_NAME   = $08; { bit 3 set: original file name present }
  156.   COMMENT     = $10; { bit 4 set: file comment present }
  157.   RESERVED    = $E0; { bits 5..7: reserved }
  158.  
  159. type
  160.   TCardinal  = record
  161.     case integer of
  162.     1: (c : cardinal);
  163.     2: (b1,b2,b3,b4 : byte);
  164.     end;
  165.  
  166. function destroy (var s:gz_streamp) : int; forward;
  167. procedure check_header (s              : gz_streamp;
  168.                         var fname      : string;
  169.                         var timestamp  : cardinal); forward;
  170.  
  171.  
  172. { GZOPEN ====================================================================
  173.  
  174.   Opens a gzip (.gz) file for reading or writing. As Pascal does not use
  175.   file descriptors, the code has been changed to accept only path names.
  176.  
  177.   The mode parameter defaults to BINARY read or write operations ('r' or 'w')
  178.   but can also include a compression level ('w9') or a strategy: Z_FILTERED
  179.   as in 'w6f' or Z_HUFFMAN_ONLY as in 'w1h'. (See the description of
  180.   deflateInit2 for more information about the strategy parameter.)
  181.  
  182.   gzopen can be used to open a file which is not in gzip format; in this
  183.   case, gzread will directly read from the file without decompression.
  184.  
  185.   gzopen returns NIL if the file could not be opened (non-zero IOResult)
  186.   or if there was insufficient memory to allocate the (de)compression state
  187.   (zlib error is Z_MEM_ERROR).
  188.  
  189. ============================================================================}
  190.  
  191. { --- JR ------------------------------------------------------------ }
  192. function gzopen (path,mode      : string;
  193.                  var fname      : string;
  194.                  var timestamp  : cardinal) : gzFile;
  195. { ------------------------------------------------------------------- }
  196.  
  197. var
  198.   bt       : TCardinal absolute timestamp;
  199.   i        : uInt;
  200.   err      : int;
  201.   level    : int;        { compression level }
  202.   strategy : int;        { compression strategy }
  203.   s        : gz_streamp;
  204. {$IFDEF MSDOS}
  205.   attr     : word;       { file attributes }
  206. {$ENDIF}
  207.  
  208. {$IFNDEF NO_DEFLATE}
  209.   gzheader : array [0..9] of byte;
  210. {$ENDIF}
  211.  
  212. begin
  213.  
  214.   if (path='') or (mode='') then begin
  215.     gzopen := Z_NULL;
  216.     exit;
  217.   end;
  218.  
  219.   GetMem (s,sizeof(gz_stream));
  220.   if not Assigned (s) then begin
  221.     gzopen := Z_NULL;
  222.     exit;
  223.   end;
  224.  
  225.   level := Z_DEFAULT_COMPRESSION;
  226.   strategy := Z_DEFAULT_STRATEGY;
  227.  
  228.   s^.stream.zalloc := NIL;     { (alloc_func)0 }
  229.   s^.stream.zfree := NIL;      { (free_func)0 }
  230.   s^.stream.opaque := NIL;     { (voidpf)0 }
  231.   s^.stream.next_in := Z_NULL;
  232.   s^.stream.next_out := Z_NULL;
  233.   s^.stream.avail_in := 0;
  234.   s^.stream.avail_out := 0;
  235.   s^.z_err := Z_OK;
  236.   s^.z_eof := false;
  237.   s^.inbuf := Z_NULL;
  238.   s^.outbuf := Z_NULL;
  239.   s^.crc := crc32(0, Z_NULL, 0);
  240.   s^.msg := '';
  241.   s^.transparent := false;
  242.   s^.path := path; { limit to 255 chars }
  243.  
  244.   s^.mode := chr(0);
  245.   for i:=1 to Length(mode) do begin
  246.     case mode[i] of
  247.       'r'      : s^.mode := 'r';
  248.       'w'      : s^.mode := 'w';
  249.       '0'..'9' : level := Ord(mode[i])-Ord('0');
  250.       'f'      : strategy := Z_FILTERED;
  251.       'h'      : strategy := Z_HUFFMAN_ONLY;
  252.     end;
  253.   end;
  254.   if (s^.mode=chr(0)) then begin
  255.     destroy(s); FreeMem(s, sizeof(gz_stream));
  256.     gzopen := gzFile(Z_NULL);
  257.     exit;
  258.   end;
  259.  
  260.   if (s^.mode<>'r')  then begin
  261. {$IFDEF NO_DEFLATE}
  262.     err := Z_STREAM_ERROR;
  263. {$ELSE}
  264.     err := deflateInit2 (s^.stream, level, Z_DEFLATED, -MAX_WBITS,
  265.                          DEF_MEM_LEVEL, strategy);
  266.         { windowBits is passed < 0 to suppress zlib header }
  267.  
  268.     GetMem (s^.outbuf, Z_BUFSIZE);
  269.     s^.stream.next_out := s^.outbuf;
  270. {$ENDIF}
  271.     if (err <> Z_OK) or (s^.outbuf = Z_NULL) then begin
  272.       destroy(s); FreeMem(s, sizeof(gz_stream));
  273.       gzopen := gzFile(Z_NULL);
  274.       exit;
  275.     end;
  276.   end
  277.  
  278.   else begin
  279.     GetMem (s^.inbuf, Z_BUFSIZE);
  280.     s^.stream.next_in := s^.inbuf;
  281.  
  282.     err := inflateInit2_ (s^.stream, -MAX_WBITS, ZLIB_VERSION, sizeof(z_stream));
  283.         { windowBits is passed < 0 to tell that there is no zlib header }
  284.  
  285.     if (err <> Z_OK) or (s^.inbuf = Z_NULL) then begin
  286.       destroy(s); FreeMem(s, sizeof(gz_stream));
  287.       gzopen := gzFile(Z_NULL);
  288.       exit;
  289.     end;
  290.   end;
  291.  
  292.   s^.stream.avail_out := Z_BUFSIZE;
  293.  
  294.   {$IFOPT I+} {$I-} {$define IOcheck} {$ENDIF}
  295.   Assign (s^.gz_file, path);    (* use path instead of s^.path (JR) *)
  296.   {$ifdef MSDOS}
  297.   GetFAttr(s^.gz_file, Attr);
  298.   if (DosError <> 0) and (s^.mode<>'r') then
  299.     ReWrite (s^.gz_file,1)
  300.     else Reset (s^.gz_file,1);
  301.   {$else}
  302.   if (s^.mode<>'r') then ReWrite (s^.gz_file,1)
  303.   else Reset (s^.gz_file,1);
  304.   {$endif}
  305.   {$IFDEF IOCheck} {$I+} {$ENDIF}
  306.   if (IOResult <> 0) then begin
  307.     destroy(s); FreeMem(s, sizeof(gz_stream));
  308.     gzopen := gzFile(Z_NULL);
  309.     exit;
  310.   end;
  311.  
  312.   i:=length(fname);
  313.   if (s^.mode = 'w') then begin { Write a very simple .gz header }
  314. {$IFNDEF NO_DEFLATE}
  315.     gzheader [0] := gz_magic [0];
  316.     gzheader [1] := gz_magic [1];
  317.     gzheader [2] := Z_DEFLATED;   { method }
  318. { --- JR ------------------------------------------------------------ }
  319.     if i>0 then
  320.       gzheader [3] := $8            { with Filename }
  321.     else
  322.       gzheader [3] := 0;            { no flags }
  323.     gzheader [4] := bt.b1;            { time[0] }
  324.     gzheader [5] := bt.b2;            { time[1] }
  325.     gzheader [6] := bt.b3;            { time[2] }
  326.     gzheader [7] := bt.b4;            { time[3] }
  327. { ------------------------------------------------------------------- }
  328.     gzheader [8] := 0;            { xflags }
  329.     gzheader [9] := 0;            { OS code = MS-DOS }
  330.     blockwrite (s^.gz_file, gzheader, 10);
  331.     with s^ do startpos := startpos+LONG(10);
  332.     if i>0 then begin
  333.       inc(i);
  334.       blockwrite (s^.gz_file, fname[1], i);
  335.       with s^ do startpos := startpos+LONG(i);
  336.       end;
  337. {$ENDIF}
  338.   end
  339.   else begin
  340.     check_header(s,fname,timestamp); { skip the .gz header }
  341.     {$WARNINGS OFF} { combining signed and unsigned types }
  342.     s^.startpos := FilePos(s^.gz_file) - s^.stream.avail_in;
  343.     {$WARNINGS ON}
  344.   end;
  345.  
  346.   gzopen := gzFile(s);
  347. end;
  348.  
  349. { GZSETPARAMS ===============================================================
  350.  
  351.   Update the compression level and strategy.
  352.  
  353. ============================================================================}
  354.  
  355. //function gzsetparams (f:gzfile; level:int; strategy:int) : int;
  356.  
  357. //var
  358.  
  359. //  s : gz_streamp;
  360. //  written: integer;
  361.  
  362. //begin
  363.  
  364. //  s := gz_streamp(f);
  365.  
  366. //  if (s = NIL) or (s^.mode <> 'w') then begin
  367. //    gzsetparams := Z_STREAM_ERROR;
  368. //    exit;
  369. //  end;
  370.  
  371.   { Make room to allow flushing }
  372. //  if (s^.stream.avail_out = 0) then begin
  373. //    s^.stream.next_out := s^.outbuf;
  374. //    blockwrite(s^.gz_file, s^.outbuf^, Z_BUFSIZE, written);
  375. //    if (written <> Z_BUFSIZE) then s^.z_err := Z_ERRNO;
  376. //    s^.stream.avail_out := Z_BUFSIZE;
  377. //  end;
  378.  
  379. //  gzsetparams := deflateParams (s^.stream, level, strategy);
  380. //end;
  381.  
  382.  
  383. { GET_BYTE ==================================================================
  384.  
  385.   Read a byte from a gz_stream. Updates next_in and avail_in.
  386.   Returns EOF for end of file.
  387.   IN assertion: the stream s has been sucessfully opened for reading.
  388.  
  389. ============================================================================}
  390.  
  391. function get_byte (s:gz_streamp) : int;
  392.  
  393. begin
  394.  
  395.   if (s^.z_eof = true) then begin
  396.     get_byte := Z_EOF;
  397.     exit;
  398.   end;
  399.  
  400.   if (s^.stream.avail_in = 0) then begin
  401.     {$I-}
  402.     blockread (s^.gz_file, s^.inbuf^, Z_BUFSIZE, s^.stream.avail_in);
  403.     {$I+}
  404.     if (s^.stream.avail_in = 0) then begin
  405.       s^.z_eof := true;
  406.       if (IOResult <> 0) then s^.z_err := Z_ERRNO;
  407.       get_byte := Z_EOF;
  408.       exit;
  409.     end;
  410.     s^.stream.next_in := s^.inbuf;
  411.   end;
  412.  
  413.   Dec(s^.stream.avail_in);
  414.   get_byte := s^.stream.next_in^;
  415.   Inc(s^.stream.next_in);
  416.  
  417. end;
  418.  
  419.  
  420. { GETLONG ===================================================================
  421.  
  422.    Reads a Longint in LSB order from the given gz_stream.
  423.  
  424. ============================================================================}
  425. function getLong(s : gz_streamp) : uLong;
  426. var
  427.   bt : TCardinal;
  428.   i  : integer;
  429. begin
  430.   { x := uLong(get_byte(s));  - you can't do this with TP, no unsigned long }
  431.   { the following assumes a little endian machine and TP }
  432.   with bt do begin
  433.     b1 := Byte(get_byte(s));
  434.     b2 := Byte(get_byte(s));
  435.     b3 := Byte(get_byte(s));
  436.     i :=get_byte(s);
  437.     b4 := Byte(i);
  438.     if (b4 = Z_EOF) then s^.z_err := Z_DATA_ERROR;
  439.     GetLong :=c;
  440.     end;
  441.   end;
  442.  
  443.  
  444. { CHECK_HEADER ==============================================================
  445.  
  446.   Check the gzip header of a gz_stream opened for reading.
  447.   Set the stream mode to transparent if the gzip magic header is not present.
  448.   Set s^.err  to Z_DATA_ERROR if the magic header is present but the rest of
  449.   the header is incorrect.
  450.  
  451.   IN assertion: the stream s has already been created sucessfully;
  452.   s^.stream.avail_in is zero for the first time, but may be non-zero
  453.   for concatenated .gz files
  454.  
  455.   Modification made for timestamp and filename (JR)
  456. ============================================================================}
  457.  
  458. procedure check_header (s              : gz_streamp;
  459.                         var fname      : string;
  460.                         var timestamp  : cardinal);
  461.  
  462. var
  463.   method : int;  { method byte }
  464.   flags  : int;  { flags byte }
  465.   len    : uInt;
  466.   c      : int;
  467.  
  468. begin
  469.  
  470.   { Check the gzip magic header }
  471.   for len := 0 to 1 do begin
  472.     c := get_byte(s);
  473.     if (c <> gz_magic[len]) then begin
  474.       if (len <> 0) then begin
  475.         Inc(s^.stream.avail_in);
  476.         Dec(s^.stream.next_in);
  477.       end;
  478.       if (c <> Z_EOF) then begin
  479.         Inc(s^.stream.avail_in);
  480.         Dec(s^.stream.next_in);
  481.     s^.transparent := TRUE;
  482.       end;
  483.       if (s^.stream.avail_in <> 0) then s^.z_err := Z_OK
  484.       else s^.z_err := Z_STREAM_END;
  485.       exit;
  486.     end;
  487.   end;
  488.  
  489.   method := get_byte(s);
  490.   flags := get_byte(s);
  491.   if (method <> Z_DEFLATED) or ((flags and RESERVED) <> 0) then begin
  492.     s^.z_err := Z_DATA_ERROR;
  493.     exit;
  494.   end;
  495.  
  496.   timestamp:=getlong(s);              { read timestamp }
  497.   for len := 0 to 1 do get_byte(s);   { discard xflags and OS code }
  498.  
  499.   if ((flags and EXTRA_FIELD) <> 0) then begin { skip the extra field }
  500.     len := uInt(get_byte(s));
  501.     len := len + (uInt(get_byte(s)) shr 8);
  502.     { len is garbage if EOF but the loop below will quit anyway }
  503.     while (len <> 0) and (get_byte(s) <> Z_EOF) do Dec(len);
  504.   end;
  505.  
  506.   fname:='';
  507.   if ((flags and ORIG_NAME) <> 0) then begin { skip the original file name }
  508.     repeat
  509.       c := get_byte(s);
  510.       fname:=fname+chr(c);
  511.     until (c = 0) or (c = Z_EOF);
  512.   end;
  513.  
  514.   if ((flags and COMMENT) <> 0) then begin { skip the .gz file comment }
  515.     repeat
  516.       c := get_byte(s);
  517.     until (c = 0) or (c = Z_EOF);
  518.   end;
  519.  
  520.   if ((flags and HEAD_CRC) <> 0) then begin { skip the header crc }
  521.     get_byte(s);
  522.     get_byte(s);
  523.   end;
  524.  
  525.   if (s^.z_eof = true) then
  526.     s^.z_err := Z_DATA_ERROR
  527.   else
  528.     s^.z_err := Z_OK;
  529.  
  530. end;
  531.  
  532.  
  533. { DESTROY ===================================================================
  534.  
  535.   Cleanup then free the buffers of given gz_stream. Return a zlib error code.
  536.   Try freeing in the reverse order of allocations.
  537.   Changed (JR): memory for gz_stream is not freed (calling program has to do instead,
  538.         made to use the info of gz_stream to create the PkZip compatible file directory
  539.         in the calling program after gzclose)
  540.  
  541. ============================================================================}
  542.  
  543. function destroy (var s:gz_streamp) : int;
  544.  
  545. begin
  546.  
  547.   destroy := Z_OK;
  548.  
  549.   if not Assigned (s) then begin
  550.     destroy := Z_STREAM_ERROR;
  551.     exit;
  552.   end;
  553.  
  554.   if (s^.stream.state <> NIL) then begin
  555.     if (s^.mode<>'r') then begin
  556. {$IFDEF NO_DEFLATE}
  557.       destroy := Z_STREAM_ERROR;
  558. {$ELSE}
  559.       destroy := deflateEnd(s^.stream);
  560. {$ENDIF}
  561.     end
  562.     else begin
  563.       destroy := inflateEnd(s^.stream);
  564.     end;
  565.   end;
  566.  
  567.   if (s^.path <> '') then begin
  568.     {$I-}
  569.     Close (s^.gz_file);
  570.     {$I+}
  571.     if (IOResult <> 0) then destroy := Z_ERRNO;
  572.   end;
  573.  
  574.   if (s^.z_err < 0) then destroy := s^.z_err;
  575.  
  576.   if Assigned (s^.inbuf) then
  577.     FreeMem(s^.inbuf, Z_BUFSIZE);
  578.   if Assigned (s^.outbuf) then
  579.     FreeMem(s^.outbuf, Z_BUFSIZE);
  580. end;
  581.  
  582. { GZREAD ====================================================================
  583.  
  584.   Reads the given number of uncompressed bytes from the compressed file.
  585.   If the input file was not in gzip format, gzread copies the given number
  586.   of bytes into the buffer.
  587.  
  588.   gzread returns the number of uncompressed bytes actually read
  589.   (0 for end of file, -1 for error).
  590.  
  591. ============================================================================}
  592.  
  593. function gzread (f:gzFile; buf:voidp; len:uInt) : int;
  594.  
  595. var
  596.  
  597.   s         : gz_streamp;
  598.   start     : pBytef;
  599.   next_out  : pBytef;
  600.   n         : uInt;
  601.   crclen    : uInt;  { Buffer length to update CRC32 }
  602.   filecrc   : uLong; { CRC32 stored in GZIP'ed file }
  603.   filelen   : uLong; { Total lenght of uncompressed file }
  604.   bytes     : integer;  { bytes actually read in I/O blockread }
  605.   total_in  : uLong;
  606.   total_out : uLong;
  607.   fname      : string;
  608.   timestamp  : cardinal;
  609.  
  610. begin
  611.  
  612.   s := gz_streamp(f);
  613.   start := pBytef(buf); { starting point for crc computation }
  614.  
  615.   if (s = NIL) or (s^.mode <> 'r') then begin
  616.     gzread := Z_STREAM_ERROR;
  617.     exit;
  618.   end;
  619.  
  620.   if (s^.z_err = Z_DATA_ERROR) or (s^.z_err = Z_ERRNO) then begin
  621.     gzread := -1;
  622.     exit;
  623.   end;
  624.  
  625.   if (s^.z_err = Z_STREAM_END) then begin
  626.     gzread := 0;  { EOF }
  627.     exit;
  628.   end;
  629.  
  630.   s^.stream.next_out := pBytef(buf);
  631.   s^.stream.avail_out := len;
  632.  
  633.   while (s^.stream.avail_out <> 0) do begin
  634.  
  635.     if (s^.transparent = true) then begin
  636.       { Copy first the lookahead bytes: }
  637.       n := s^.stream.avail_in;
  638.       if (n > s^.stream.avail_out) then n := s^.stream.avail_out;
  639.       if (n > 0) then begin
  640.         zmemcpy(s^.stream.next_out, s^.stream.next_in, n);
  641.         inc (s^.stream.next_out, n);
  642.         inc (s^.stream.next_in, n);
  643.         dec (s^.stream.avail_out, n);
  644.         dec (s^.stream.avail_in, n);
  645.       end;
  646.       if (s^.stream.avail_out > 0) then begin
  647.         blockread (s^.gz_file, s^.stream.next_out^, s^.stream.avail_out, bytes);
  648.         dec (s^.stream.avail_out, uInt(bytes));
  649.       end;
  650.       dec (len, s^.stream.avail_out);
  651.       inc (s^.stream.total_in, uLong(len));
  652.       inc (s^.stream.total_out, uLong(len));
  653.       gzread := int(len);
  654.       exit;
  655.     end; { IF transparent }
  656.  
  657.     if (s^.stream.avail_in = 0) and (s^.z_eof = false) then begin
  658.       {$I-}
  659.       blockread (s^.gz_file, s^.inbuf^, Z_BUFSIZE, s^.stream.avail_in);
  660.       {$I+}
  661.       if (s^.stream.avail_in = 0) then begin
  662.         s^.z_eof := true;
  663.     if (IOResult <> 0) then begin
  664.       s^.z_err := Z_ERRNO;
  665.       break;
  666.         end;
  667.       end;
  668.       s^.stream.next_in := s^.inbuf;
  669.     end;
  670.  
  671.     s^.z_err := inflate(s^.stream, Z_NO_FLUSH);
  672.  
  673.     if (s^.z_err = Z_STREAM_END) then begin
  674.       crclen := 0;
  675.       next_out := s^.stream.next_out;
  676.       while (next_out <> start ) do begin
  677.         dec (next_out);
  678.         inc (crclen);   { Hack because Pascal cannot substract pointers }
  679.       end;
  680.       { Check CRC and original size }
  681.       s^.crc := crc32(s^.crc, start, crclen);
  682.       start := s^.stream.next_out;
  683.  
  684.       filecrc := getLong (s);
  685.       filelen := getLong (s);
  686.  
  687.       if (s^.crc <> filecrc) or (s^.stream.total_out <> filelen)
  688.         then s^.z_err := Z_DATA_ERROR
  689.     else begin
  690.       { Check for concatenated .gz files: }
  691.       check_header(s,fname,timestamp);
  692.       if (s^.z_err = Z_OK) then begin
  693.             total_in := s^.stream.total_in;
  694.             total_out := s^.stream.total_out;
  695.  
  696.         inflateReset (s^.stream);
  697.         s^.stream.total_in := total_in;
  698.         s^.stream.total_out := total_out;
  699.         s^.crc := crc32 (0, Z_NULL, 0);
  700.       end;
  701.       end; {IF-THEN-ELSE}
  702.     end;
  703.  
  704.     if (s^.z_err <> Z_OK) or (s^.z_eof = true) then break;
  705.  
  706.   end; {WHILE}
  707.  
  708.   crclen := 0;
  709.   next_out := s^.stream.next_out;
  710.   while (next_out <> start ) do begin
  711.     dec (next_out);
  712.     inc (crclen);   { Hack because Pascal cannot substract pointers }
  713.   end;
  714.   s^.crc := crc32 (s^.crc, start, crclen);
  715.  
  716.   gzread := int(len - s^.stream.avail_out);
  717.  
  718. end;
  719.  
  720.  
  721. { GZGETC ====================================================================
  722.  
  723.   Reads one byte from the compressed file.
  724.   gzgetc returns this byte or -1 in case of end of file or error.
  725.  
  726. ============================================================================}
  727.  
  728. function gzgetc (f:gzfile) : int;
  729.  
  730. var c:byte;
  731.  
  732. begin
  733.  
  734.   if (gzread (f,@c,1) = 1) then gzgetc := c else gzgetc := -1;
  735.  
  736. end;
  737.  
  738.  
  739. { GZGETS ====================================================================
  740.  
  741.   Reads bytes from the compressed file until len-1 characters are read,
  742.   or a newline character is read and transferred to buf, or an end-of-file
  743.   condition is encountered. The string is then Null-terminated.
  744.  
  745.   gzgets returns buf, or Z_NULL in case of error.
  746.   The current implementation is not optimized at all.
  747.  
  748. ============================================================================}
  749.  
  750. function gzgets (f:gzfile; buf:PChar; len:int) : PChar;
  751.  
  752. var
  753.  
  754.   b      : PChar; { start of buffer }
  755.   bytes  : Int;   { number of bytes read by gzread }
  756.   gzchar : char;  { char read by gzread }
  757.  
  758. begin
  759.  
  760.     if (buf = Z_NULL) or (len <= 0) then begin
  761.       gzgets := Z_NULL;
  762.       exit;
  763.     end;
  764.  
  765.     b := buf;
  766.     repeat
  767.       dec (len);
  768.       bytes := gzread (f, buf, 1);
  769.       gzchar := buf^;
  770.       inc (buf);
  771.     until (len = 0) or (bytes <> 1) or (gzchar = Chr(13));
  772.  
  773.     buf^ := Chr(0);
  774.     if (b = buf) and (len > 0) then gzgets := Z_NULL else gzgets := b;
  775.  
  776. end;
  777.  
  778.  
  779. {$IFNDEF NO_DEFLATE}
  780.  
  781. { GZWRITE ===================================================================
  782.  
  783.   Writes the given number of uncompressed bytes into the compressed file.
  784.   gzwrite returns the number of uncompressed bytes actually written
  785.   (0 in case of error).
  786.  
  787. ============================================================================}
  788.  
  789. function gzwrite (f:gzfile; buf:voidp; len:uInt) : int;
  790.  
  791. var
  792.  
  793.   s : gz_streamp;
  794.   written : integer;
  795.  
  796. begin
  797.  
  798.     s := gz_streamp(f);
  799.  
  800.     if (s = NIL) or (s^.mode='r') then begin
  801.       gzwrite := Z_STREAM_ERROR;
  802.       exit;
  803.     end;
  804.  
  805.     s^.stream.next_in := pBytef(buf);
  806.     s^.stream.avail_in := len;
  807.  
  808.     while (s^.stream.avail_in <> 0) do begin
  809.  
  810.       if (s^.stream.avail_out = 0) then begin
  811.         s^.stream.next_out := s^.outbuf;
  812.         blockwrite (s^.gz_file, s^.outbuf^, Z_BUFSIZE, written);
  813.         if (written <> Z_BUFSIZE) then begin
  814.           s^.z_err := Z_ERRNO;
  815.           break;
  816.         end;
  817.         s^.stream.avail_out := Z_BUFSIZE;
  818.       end;
  819.  
  820.       s^.z_err := deflate(s^.stream, Z_NO_FLUSH);
  821.       if (s^.z_err <> Z_OK) then break;
  822.  
  823.     end; {WHILE}
  824.  
  825.     s^.crc := crc32(s^.crc, buf, len);
  826.     gzwrite := int(len - s^.stream.avail_in);
  827.  
  828. end;
  829.  
  830.  
  831. { ===========================================================================
  832.    Converts, formats, and writes the args to the compressed file under
  833.    control of the format string, as in fprintf. gzprintf returns the number of
  834.    uncompressed bytes actually written (0 in case of error).
  835. }
  836.  
  837. {$IFDEF GZ_FORMAT_STRING}
  838. function gzprintf (zfile : gzFile;
  839.                    const format : string;
  840.                    a : array of int) : int;
  841. var
  842.   buf : array[0..Z_PRINTF_BUFSIZE-1] of char;
  843.   len : int;
  844. begin
  845. {$ifdef HAS_snprintf}
  846.     snprintf(buf, sizeof(buf), format, a1, a2, a3, a4, a5, a6, a7, a8,
  847.          a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20);
  848. {$else}
  849.     sprintf(buf, format, a1, a2, a3, a4, a5, a6, a7, a8,
  850.         a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20);
  851. {$endif}
  852.     len := strlen(buf); { old sprintf doesn't return the nb of bytes written }
  853.     if (len <= 0) return 0;
  854.  
  855.     gzprintf := gzwrite(file, buf, len);
  856. end;
  857. {$ENDIF}
  858.  
  859.  
  860. { GZPUTC ====================================================================
  861.  
  862.   Writes c, converted to an unsigned char, into the compressed file.
  863.   gzputc returns the value that was written, or -1 in case of error.
  864.  
  865. ============================================================================}
  866.  
  867. function gzputc (f:gzfile; c:char) : int;
  868. begin
  869.   if (gzwrite (f,@c,1) = 1) then
  870.   {$IFDEF FPC}
  871.     gzputc := int(ord(c))
  872.   {$ELSE}
  873.     gzputc := int(c)
  874.   {$ENDIF}
  875.   else
  876.     gzputc := -1;
  877. end;
  878.  
  879.  
  880. { GZPUTS ====================================================================
  881.  
  882.   Writes the given null-terminated string to the compressed file, excluding
  883.   the terminating null character.
  884.   gzputs returns the number of characters written, or -1 in case of error.
  885.  
  886. ============================================================================}
  887.  
  888. function gzputs (f:gzfile; s:PChar) : int;
  889. begin
  890.   gzputs := gzwrite (f, voidp(s), strlen(s));
  891. end;
  892.  
  893.  
  894. { DO_FLUSH ==================================================================
  895.  
  896.   Flushes all pending output into the compressed file.
  897.   The parameter flush is as in the zdeflate() function.
  898.  
  899. ============================================================================}
  900.  
  901. function do_flush (f:gzfile; flush:int) : int;
  902. var
  903.   len     : uInt;
  904.   done    : boolean;
  905.   s       : gz_streamp;
  906.   written : integer;
  907. begin
  908.   done := false;
  909.   s := gz_streamp(f);
  910.  
  911.   if (s = NIL) or (s^.mode = 'r') then begin
  912.     do_flush := Z_STREAM_ERROR;
  913.     exit;
  914.   end;
  915.  
  916.   s^.stream.avail_in := 0; { should be zero already anyway }
  917.  
  918.   while true do begin
  919.  
  920.     len := Z_BUFSIZE - s^.stream.avail_out;
  921.  
  922.     if (len <> 0) then begin
  923.       {$I-}
  924.       blockwrite(s^.gz_file, s^.outbuf^, len, written);
  925.       {$I+}
  926.       {$WARNINGS OFF} {Comparing signed and unsigned types}
  927.       if (written <> len) then begin
  928.       {$WARNINGS ON}
  929.         s^.z_err := Z_ERRNO;
  930.         do_flush := Z_ERRNO;
  931.         exit;
  932.       end;
  933.       s^.stream.next_out := s^.outbuf;
  934.       s^.stream.avail_out := Z_BUFSIZE;
  935.     end;
  936.  
  937.     if (done = true) then break;
  938.     s^.z_err := deflate(s^.stream, flush);
  939.  
  940.     { Ignore the second of two consecutive flushes: }
  941.     if (len = 0) and (s^.z_err = Z_BUF_ERROR) then s^.z_err := Z_OK;
  942.  
  943.     { deflate has finished flushing only when it hasn't used up
  944.       all the available space in the output buffer: }
  945.  
  946.     done := (s^.stream.avail_out <> 0) or (s^.z_err = Z_STREAM_END);
  947.     if (s^.z_err <> Z_OK) and (s^.z_err <> Z_STREAM_END) then break;
  948.  
  949.   end; {WHILE}
  950.  
  951.   if (s^.z_err = Z_STREAM_END) then do_flush:=Z_OK else do_flush:=s^.z_err;
  952. end;
  953.  
  954. { GZFLUSH ===================================================================
  955.  
  956.   Flushes all pending output into the compressed file.
  957.   The parameter flush is as in the zdeflate() function.
  958.  
  959.   The return value is the zlib error number (see function gzerror below).
  960.   gzflush returns Z_OK if the flush parameter is Z_FINISH and all output
  961.   could be flushed.
  962.  
  963.   gzflush should be called only when strictly necessary because it can
  964.   degrade compression.
  965.  
  966. ============================================================================}
  967.  
  968. function gzflush (f:gzfile; flush:int) : int;
  969. var
  970.   err : int;
  971.   s   : gz_streamp;
  972. begin
  973.   s := gz_streamp(f);
  974.   err := do_flush (f, flush);
  975.  
  976.   if (err <> 0) then begin
  977.     gzflush := err;
  978.     exit;
  979.   end;
  980.  
  981.   if (s^.z_err = Z_STREAM_END) then gzflush := Z_OK else gzflush := s^.z_err;
  982. end;
  983.  
  984. {$ENDIF} (* NO DEFLATE *)
  985.  
  986.  
  987. { GZREWIND ==================================================================
  988.  
  989.   Rewinds input file.
  990.  
  991. ============================================================================}
  992.  
  993. function gzrewind (f:gzFile) : int;
  994. var
  995.   s:gz_streamp;
  996. begin
  997.   s := gz_streamp(f);
  998.  
  999.   if (s = NIL) or (s^.mode <> 'r') then begin
  1000.     gzrewind := -1;
  1001.     exit;
  1002.   end;
  1003.  
  1004.   s^.z_err := Z_OK;
  1005.   s^.z_eof := false;
  1006.   s^.stream.avail_in := 0;
  1007.   s^.stream.next_in := s^.inbuf;
  1008.  
  1009.   if (s^.startpos = 0) then begin { not a compressed file }
  1010.     {$I-}
  1011.     seek (s^.gz_file, 0);
  1012.     {$I+}
  1013.     gzrewind := 0;
  1014.     exit;
  1015.   end;
  1016.  
  1017.   inflateReset(s^.stream);
  1018.   {$I-}
  1019.   seek (s^.gz_file, s^.startpos);
  1020.   {$I+}
  1021.   gzrewind := int(IOResult);
  1022.   exit;
  1023. end;
  1024.  
  1025.  
  1026. { GZSEEK ====================================================================
  1027.  
  1028.   Sets the starting position for the next gzread or gzwrite on the given
  1029.   compressed file. The offset represents a number of bytes from the beginning
  1030.   of the uncompressed stream.
  1031.  
  1032.   gzseek returns the resulting offset, or -1 in case of error.
  1033.   SEEK_END is not implemented, returns error.
  1034.   In this version of the library, gzseek can be extremely slow.
  1035.  
  1036. ============================================================================}
  1037.  
  1038. function gzseek (f:gzfile; offset:z_off_t; whence:int) : z_off_t;
  1039. var
  1040.   s : gz_streamp;
  1041.   size : uInt;
  1042. begin
  1043.   s := gz_streamp(f);
  1044.  
  1045.   if (s = NIL) or (whence = SEEK_END) or (s^.z_err = Z_ERRNO)
  1046.   or (s^.z_err = Z_DATA_ERROR) then begin
  1047.     gzseek := z_off_t(-1);
  1048.     exit;
  1049.   end;
  1050.  
  1051.   if (s^.mode<>'r') then begin
  1052. {$IFDEF NO_DEFLATE}
  1053.     gzseek := z_off_t(-1);
  1054.     exit;
  1055. {$ELSE}
  1056.     if (whence = SEEK_SET) then dec(offset, s^.stream.total_out);
  1057.     if (offset < 0) then begin;
  1058.       gzseek := z_off_t(-1);
  1059.       exit;
  1060.     end;
  1061.  
  1062.     { At this point, offset is the number of zero bytes to write. }
  1063.     if (s^.inbuf = Z_NULL) then begin
  1064.       GetMem (s^.inbuf, Z_BUFSIZE);
  1065.       zmemzero(s^.inbuf, Z_BUFSIZE);
  1066.     end;
  1067.  
  1068.     while (offset > 0) do begin
  1069.       size := Z_BUFSIZE;
  1070.       if (offset < Z_BUFSIZE) then size := uInt(offset);
  1071.  
  1072.       size := gzwrite(f, s^.inbuf, size);
  1073.       if (size = 0) then begin
  1074.         gzseek := z_off_t(-1);
  1075.         exit;
  1076.       end;
  1077.  
  1078.       dec (offset,size);
  1079.     end;
  1080.  
  1081.     gzseek := z_off_t(s^.stream.total_in);
  1082.     exit;
  1083. {$ENDIF}
  1084.   end;
  1085.   { Rest of function is for reading only }
  1086.  
  1087.   { compute absolute position }
  1088.   if (whence = SEEK_CUR) then inc (offset, s^.stream.total_out);
  1089.   if (offset < 0) then begin
  1090.     gzseek := z_off_t(-1);
  1091.     exit;
  1092.   end;
  1093.  
  1094.   if (s^.transparent = true) then begin
  1095.     s^.stream.avail_in := 0;
  1096.     s^.stream.next_in := s^.inbuf;
  1097.     {$I-}
  1098.     seek (s^.gz_file, offset);
  1099.     {$I+}
  1100.     if (IOResult <> 0) then begin
  1101.       gzseek := z_off_t(-1);
  1102.       exit;
  1103.     end;
  1104.  
  1105.     s^.stream.total_in := uLong(offset);
  1106.     s^.stream.total_out := uLong(offset);
  1107.     gzseek := z_off_t(offset);
  1108.     exit;
  1109.   end;
  1110.  
  1111.   { For a negative seek, rewind and use positive seek }
  1112.   if (uLong(offset) >= s^.stream.total_out)
  1113.     then dec (offset, s^.stream.total_out)
  1114.     else if (gzrewind(f) <> 0) then begin
  1115.       gzseek := z_off_t(-1);
  1116.       exit;
  1117.   end;
  1118.   { offset is now the number of bytes to skip. }
  1119.  
  1120.   if (offset <> 0) and (s^.outbuf = Z_NULL)
  1121.   then GetMem (s^.outbuf, Z_BUFSIZE);
  1122.  
  1123.   while (offset > 0) do begin
  1124.     size := Z_BUFSIZE;
  1125.     if (offset < Z_BUFSIZE) then size := int(offset);
  1126.  
  1127.     size := gzread (f, s^.outbuf, size);
  1128.     if (size <= 0) then begin
  1129.       gzseek := z_off_t(-1);
  1130.       exit;
  1131.     end;
  1132.     dec(offset, size);
  1133.   end;
  1134.  
  1135.   gzseek := z_off_t(s^.stream.total_out);
  1136. end;
  1137.  
  1138.  
  1139. { GZTELL ====================================================================
  1140.  
  1141.   Returns the starting position for the next gzread or gzwrite on the
  1142.   given compressed file. This position represents a number of bytes in the
  1143.   uncompressed data stream.
  1144.  
  1145. ============================================================================}
  1146.  
  1147. function gztell (f:gzfile) : z_off_t;
  1148. begin
  1149.   gztell := gzseek (f, 0, SEEK_CUR);
  1150. end;
  1151.  
  1152.  
  1153. { GZEOF =====================================================================
  1154.  
  1155.   Returns TRUE when EOF has previously been detected reading the given
  1156.   input stream, otherwise FALSE.
  1157.  
  1158. ============================================================================}
  1159.  
  1160. //function gzeof (f:gzfile) : boolean;
  1161. //var
  1162. //  s:gz_streamp;
  1163. //begin
  1164. //  s := gz_streamp(f);
  1165.  
  1166. //  if (s=NIL) or (s^.mode<>'r') then
  1167. //    gzeof := false
  1168. //  else
  1169. //    gzeof := s^.z_eof;
  1170. //end;
  1171.  
  1172.  
  1173. { PUTLONG ===================================================================
  1174.  
  1175.   Outputs a Longint in LSB order to the given file
  1176.  
  1177. ============================================================================}
  1178.  
  1179. procedure putLong (var f:file; x:uLong);
  1180. var
  1181.   n : int;
  1182.   c : byte;
  1183. begin
  1184.   for n:=0 to 3 do begin
  1185.     c := x and $FF;
  1186.     blockwrite (f, c, 1);
  1187.     x := x shr 8;
  1188.   end;
  1189. end;
  1190.  
  1191.  
  1192. { GZCLOSE ===================================================================
  1193.  
  1194.   Flushes all pending output if necessary, closes the compressed file
  1195.   and deallocates all the (de)compression state.
  1196.  
  1197.   The return value is the zlib error number (see function gzerror below).
  1198.  
  1199. ============================================================================}
  1200.  
  1201. function gzclose (f:gzFile) : int;
  1202. var
  1203.   err : int;
  1204.   s   : gz_streamp;
  1205. begin
  1206.   s := gz_streamp(f);
  1207.   if (s = NIL) then begin
  1208.     gzclose := Z_STREAM_ERROR;
  1209.     exit;
  1210.   end;
  1211.  
  1212.   if (s^.mode<>'r') then begin
  1213. {$IFDEF NO_DEFLATE}
  1214.     gzclose := Z_STREAM_ERROR;
  1215.     exit;
  1216. {$ELSE}
  1217.     err := do_flush (f, Z_FINISH);
  1218.     if (err <> Z_OK) then begin
  1219.       gzclose := destroy (gz_streamp(f));
  1220.       FreeMem(gz_streamp(f), sizeof(gz_stream));
  1221.       exit;
  1222.     end;
  1223.  
  1224.     putLong (s^.gz_file, s^.crc);
  1225.     putLong (s^.gz_file, s^.stream.total_in);
  1226. {$ENDIF}
  1227.   end;
  1228.  
  1229.   gzclose := destroy (gz_streamp(f));
  1230.   FreeMem(gz_streamp(f), sizeof(gz_stream));
  1231. end;
  1232.  
  1233.  
  1234. { GZERROR ===================================================================
  1235.  
  1236.   Returns the error message for the last error which occured on the
  1237.    given compressed file. errnum is set to zlib error number. If an
  1238.    error occured in the file system and not in the compression library,
  1239.    errnum is set to Z_ERRNO and the application may consult errno
  1240.    to get the exact error code.
  1241.  
  1242. ============================================================================}
  1243.  
  1244. function gzerror (f:gzfile; var errnum:int) : string;
  1245. var
  1246.  m : string;
  1247.  s : gz_streamp;
  1248. begin
  1249.   s := gz_streamp(f);
  1250.   if (s = NIL) then begin
  1251.     errnum := Z_STREAM_ERROR;
  1252.     gzerror := zError(Z_STREAM_ERROR);
  1253.     end;
  1254.  
  1255.   errnum := s^.z_err;
  1256.   if (errnum = Z_OK) then begin
  1257.     gzerror := zError(Z_OK);
  1258.     exit;
  1259.   end;
  1260.  
  1261.   m := s^.stream.msg;
  1262.   if (errnum = Z_ERRNO) then m := '';
  1263.   if (m = '') then m := zError(s^.z_err);
  1264.  
  1265.   s^.msg := s^.path+': '+m;
  1266.   gzerror := s^.msg;
  1267. end;
  1268.  
  1269. { ZIPOPEN =====(JR)=========================================================
  1270.   see gzopen (above) but only write
  1271.   ZipOpen writes a PK-Zip compatible file header
  1272. ============================================================================}
  1273. function ZipOpen (path,mode,fname : string;
  1274.                   timestamp       : cardinal) : gzFile;
  1275. var
  1276.   i        : uInt;
  1277.   err      : int;
  1278.   level    : int;        { compression level }
  1279.   strategy : int;        { compression strategy }
  1280.   s        : gz_streamp;
  1281. {$IFDEF MSDOS}
  1282.   attr     : word;       { file attributes }
  1283. {$ENDIF}
  1284. {$IFNDEF NO_DEFLATE}
  1285.   PKheader : TPKLocalHeader;
  1286. {$ENDIF}
  1287.  
  1288. begin
  1289.  
  1290.   if (path='') or (mode='') then begin
  1291.     ZipOpen := Z_NULL;
  1292.     exit;
  1293.   end;
  1294.  
  1295.   GetMem (s,sizeof(gz_stream));
  1296.   if not Assigned (s) then begin
  1297.     ZipOpen := Z_NULL;
  1298.     exit;
  1299.   end;
  1300.  
  1301.   level := Z_DEFAULT_COMPRESSION;
  1302.   strategy := Z_DEFAULT_STRATEGY;
  1303.  
  1304.   s^.stream.zalloc := NIL;     { (alloc_func)0 }
  1305.   s^.stream.zfree := NIL;      { (free_func)0 }
  1306.   s^.stream.opaque := NIL;     { (voidpf)0 }
  1307.   s^.stream.next_in := Z_NULL;
  1308.   s^.stream.next_out := Z_NULL;
  1309.   s^.stream.avail_in := 0;
  1310.   s^.stream.avail_out := 0;
  1311.   s^.z_err := Z_OK;
  1312.   s^.z_eof := false;
  1313.   s^.inbuf := Z_NULL;
  1314.   s^.outbuf := Z_NULL;
  1315.   s^.crc := crc32(0, Z_NULL, 0);
  1316.   s^.msg := '';
  1317.   s^.transparent := false;
  1318.   s^.path := path; { limit to 255 chars }
  1319.   s^.mode := 'w';
  1320.   s^.time := TimeStamp;
  1321.   for i:=1 to Length(mode) do begin
  1322.     case mode[i] of
  1323.       '0'..'9' : level := Ord(mode[i])-Ord('0');
  1324.       'f'      : strategy := Z_FILTERED;
  1325.       'h'      : strategy := Z_HUFFMAN_ONLY;
  1326.     end;
  1327.   end;
  1328.   if (s^.mode=chr(0)) then begin
  1329.     destroy(s); FreeMem(s, sizeof(gz_stream));
  1330.     ZipOpen := gzFile(Z_NULL);
  1331.     exit;
  1332.   end;
  1333.  
  1334. {$IFDEF NO_DEFLATE}
  1335.   err := Z_STREAM_ERROR;
  1336. {$ELSE}
  1337.   err := deflateInit2 (s^.stream, level, Z_DEFLATED, -MAX_WBITS,
  1338.                                    DEF_MEM_LEVEL, strategy);
  1339.           { windowBits is passed < 0 to suppress zlib header }
  1340.  
  1341.   GetMem (s^.outbuf, Z_BUFSIZE);
  1342.   s^.stream.next_out := s^.outbuf;
  1343. {$ENDIF}
  1344.   if (err <> Z_OK) or (s^.outbuf = Z_NULL) then begin
  1345.     destroy(s); FreeMem(s, sizeof(gz_stream));
  1346.     ZipOpen := gzFile(Z_NULL);
  1347.     exit;
  1348.   end;
  1349.  
  1350.   s^.stream.avail_out := Z_BUFSIZE;
  1351.  
  1352.   {$IFOPT I+} {$I-} {$define IOcheck} {$ENDIF}
  1353.   Assign (s^.gz_file,path);
  1354.   {$ifdef MSDOS}
  1355.   GetFAttr(s^.gz_file, Attr);
  1356.   if (DosError <> 0) and (s^.mode<>'r') then
  1357.     ReWrite (s^.gz_file,1)
  1358.     else Reset (s^.gz_file,1);
  1359.   {$else}
  1360. { --- JR ------------------------------------------------------------ }
  1361.   with s^ do begin
  1362.     Reset (gz_file,1);
  1363.     filepos:=filesize(gz_file);
  1364.     seek (gz_file,filepos);
  1365.     end;
  1366. { ------------------------------------------------------------------- }
  1367.   {$endif}
  1368.   {$IFDEF IOCheck} {$I+} {$ENDIF}
  1369.   if (IOResult <> 0) then begin
  1370.     destroy(s); FreeMem(s, sizeof(gz_stream));
  1371.     ZipOpen := gzFile(Z_NULL);
  1372.     exit;
  1373.   end;
  1374.  
  1375.   i:=length(fname);
  1376.   if (s^.mode = 'w') then begin { Write the Pk-header }
  1377. {$IFNDEF NO_DEFLATE}
  1378.     with PKHeader do begin
  1379.       Signatur:=PKLocalSignatur;
  1380.       Vers:=$14;
  1381.       Flag:=2;
  1382.       Method:=8;
  1383.       FTimeStamp:=TimeStamp;
  1384.       CRC:=0;
  1385.       CSize:=0;
  1386.       USize:=0;
  1387.       FNLength:=i;
  1388.       ExtraLength:=0;
  1389.       end;
  1390.     blockwrite (s^.gz_file, PKheader, sizeof(PkHeader));
  1391.     with s^ do begin
  1392.       startpos := filepos+LONG(sizeof(PkHeader));
  1393.       if i>0 then begin
  1394.         blockwrite (gz_file, fname[1], i);
  1395.         startpos := startpos+LONG(i);
  1396.         end;
  1397.       end;
  1398. {$ENDIF}
  1399.   end;
  1400.  
  1401.   ZipOpen := gzFile(s);
  1402. end;
  1403.  
  1404. { ZIPCLOSE ===================================================================
  1405.  
  1406.   Flushes all pending output if necessary, closes the compressed file
  1407.   and deallocates all the (de)compression state.
  1408.   Writes CRC and lebgth information to header
  1409.  
  1410.   The return value is the zlib error number (see function gzerror below).
  1411.  
  1412. ============================================================================}
  1413.  
  1414. function ZipClose (f:gzFile) : int;
  1415. var
  1416.   err : int;
  1417.   s   : gz_streamp;
  1418. begin
  1419.   s := gz_streamp(f);
  1420.   if (s = NIL) then begin
  1421.     ZipClose := Z_STREAM_ERROR;
  1422.     exit;
  1423.   end;
  1424.  
  1425.   if (s^.mode = 'w') then begin
  1426. {$IFDEF NO_DEFLATE}
  1427.     ZipClose := Z_STREAM_ERROR;
  1428.     exit;
  1429. {$ELSE}
  1430.     err := do_flush (f, Z_FINISH);
  1431.     if (err <> Z_OK) then begin
  1432.       ZipClose := destroy (gz_streamp(f));
  1433.       FreeMem(f, sizeof(gz_stream));
  1434.       exit;
  1435.     end;
  1436.  
  1437.   with s^ do begin
  1438.     USize:=stream.total_in;
  1439.     CSize:=filesize(gz_file)-startpos;
  1440.     seek (gz_file,filepos+14);
  1441.     putLong (gz_file, crc);
  1442.     putLong (gz_file, CSize);
  1443.     putLong (gz_file, USize);
  1444.     end;
  1445. {$ENDIF}
  1446.   end;
  1447.  
  1448.   ZipClose := destroy (gz_streamp(f));
  1449. end;
  1450.  
  1451. end.
  1452.