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