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