1 program example;
2
3 { example.c -- usage example of the zlib compression library
4 Copyright (C) 1995-1998 Jean-loup Gailly.
5
6 Pascal tranlastion
7 Copyright (C) 1998 by Jacques Nomssi Nzali
8 For conditions of distribution and use, see copyright notice in readme.txt
9 }
10 {-$define MemCheck}
11 {$DEFINE TEST_COMPRESS}
12 {$DEFINE TEST_GZIO}
13 {$DEFINE TEST_INFLATE}
14 {$DEFINE TEST_DEFLATE}
15 {$DEFINE TEST_SYNC}
16 {$DEFINE TEST_DICT}
17 {$DEFINE TEST_FLUSH}
18
19 uses
20 strings,
21 zbase,
22 gzio,
23 zinflate,
24 zdeflate,
25 zcompres,
26 zuncompr
27 {$ifdef memcheck}
28 , memcheck in '..\..\monotekt\pas\memcheck\memcheck.pas'
29 {$endif}
30 ;
31
32 procedure Stop;
33 begin
34 Write('Program halted...');
35 ReadLn;
36 Halt(1);
37 end;
38
39 procedure CHECK_ERR(err : integer; msg : string);
40 begin
41 if (err <> Z_OK) then
42 begin
43 Write(msg, ' error: ', err);
44 Stop;
45 end;
46 end;
47
48 const
49 hello : PChar = 'hello, hello!';
50 { "hello world" would be more standard, but the repeated "hello"
51 stresses the compression code better, sorry... }
52
53 {$IFDEF TEST_DICT}
54 const
55 dictionary : PChar = 'hello';
56 var
57 dictId : cardinal; { Adler32 value of the dictionary }
58 {$ENDIF}
59
60 { ===========================================================================
61 Test compress() and uncompress() }
62
63 {$IFDEF TEST_COMPRESS}
64 procedure test_compress(compr : Pbyte; var comprLen : cardinal;
65 uncompr : Pbyte; uncomprLen : cardinal);
66 var
67 err : integer;
68 len : cardinal;
69 begin
70 len := strlen(hello)+1;
71 err := compress(compr, comprLen, Pbyte(hello)^, len);
72 CHECK_ERR(err, 'compress');
73
74 strcopy(PChar(uncompr), 'garbage');
75
76 err := uncompress(uncompr, uncomprLen, compr^, comprLen);
77 CHECK_ERR(err, 'uncompress');
78
79 if (strcomp(PChar(uncompr), hello)) <> 0 then
80 begin
81 WriteLn('bad uncompress');
82 Stop;
83 end
84 else
85 WriteLn('uncompress(): ', StrPas(PChar(uncompr)));
86 end;
87 {$ENDIF}
88
89 { ===========================================================================
90 Test read/write of .gz files }
91
92 {$IFDEF TEST_GZIO}
93 procedure test_gzio(const outf : string; { output file }
94 const inf : string; { input file }
95 uncompr : Pbyte;
96 uncomprLen : integer);
97 var
98 err : integer;
99 len : integer;
100 var
101 zfile : gzFile;
102 pos : z_off_t;
103 begin
104 len := strlen(hello)+1;
105
106 zfile := gzopen(outf, 'w');
107 if (zfile = NIL) then
108 begin
109 WriteLn('_gzopen error');
110 Stop;
111 end;
112 gzputc(zfile, 'h');
113 if (gzputs(zfile, 'ello') <> 4) then
114 begin
115 WriteLn('gzputs err: ', gzerror(zfile, err));
116 Stop;
117 end;
118 {$ifdef GZ_FORMAT_STRING}
119 if (gzprintf(zfile, ', %s!', 'hello') <> 8) then
120 begin
121 WriteLn('gzprintf err: ', gzerror(zfile, err));
122 Stop;
123 end;
124 {$else}
125 if (gzputs(zfile, ', hello!') <> 8) then
126 begin
127 WriteLn('gzputs err: ', gzerror(zfile, err));
128 Stop;
129 end;
130 {$ENDIF}
131 gzseek(zfile, longint(1), SEEK_CUR); { add one zero byte }
132 gzclose(zfile);
133
134 zfile := gzopen(inf, 'r');
135 if (zfile = NIL) then
136 WriteLn('gzopen error');
137
138 strcopy(pchar(uncompr), 'garbage');
139
140 uncomprLen := gzread(zfile, uncompr, cardinal(uncomprLen));
141 if (uncomprLen <> len) then
142 begin
143 WriteLn('gzread err: ', gzerror(zfile, err));
144 Stop;
145 end;
146 if (strcomp(pchar(uncompr), hello)) <> 0 then
147 begin
148 WriteLn('bad gzread: ', pchar(uncompr));
149 Stop;
150 end
151 else
152 WriteLn('gzread(): ', pchar(uncompr));
153
154 pos := gzseek(zfile, longint(-8), SEEK_CUR);
155 if (pos <> 6) or (gztell(zfile) <> pos) then
156 begin
157 WriteLn('gzseek error, pos=',pos,', gztell=',gztell(zfile));
158 Stop;
159 end;
160
161 if (char(gzgetc(zfile)) <> ' ') then
162 begin
163 WriteLn('gzgetc error');
164 Stop;
165 end;
166
167 gzgets(zfile, pchar(uncompr), uncomprLen);
168 uncomprLen := strlen(pchar(uncompr));
169 if (uncomprLen <> 6) then
170 begin { "hello!" }
171 WriteLn('gzgets err after gzseek: ', gzerror(zfile, err));
172 Stop;
173 end;
174 if (strcomp(pchar(uncompr), hello+7)) <> 0 then
175 begin
176 WriteLn('bad gzgets after gzseek');
177 Stop;
178 end
179 else
180 WriteLn('gzgets() after gzseek: ', PChar(uncompr));
181
182 gzclose(zfile);
183 end;
184 {$ENDIF}
185
186 { ===========================================================================
187 Test deflate() with small buffers }
188
189 {$IFDEF TEST_DEFLATE}
190 procedure test_deflate(compr : Pbyte; comprLen : cardinal);
191 var
192 c_stream : z_stream; { compression stream }
193 err : integer;
194 len : integer;
195 begin
196 len := strlen(hello)+1;
197
198 err := deflateInit(c_stream, Z_DEFAULT_COMPRESSION);
199 CHECK_ERR(err, 'deflateInit');
200
201 c_stream.next_in := Pbyte(hello);
202 c_stream.next_out := compr;
203
204 while (c_stream.total_in <> cardinal(len)) and (c_stream.total_out < comprLen) do
205 begin
206 c_stream.avail_out := 1; { force small buffers }
207 c_stream.avail_in := 1;
208 err := deflate(c_stream, Z_NO_FLUSH);
209 CHECK_ERR(err, 'deflate');
210 end;
211
212 { Finish the stream, still forcing small buffers: }
213 while TRUE do
214 begin
215 c_stream.avail_out := 1;
216 err := deflate(c_stream, Z_FINISH);
217 if (err = Z_STREAM_END) then
218 break;
219 CHECK_ERR(err, 'deflate');
220 end;
221
222 err := deflateEnd(c_stream);
223 CHECK_ERR(err, 'deflateEnd');
224 end;
225 {$ENDIF}
226
227 { ===========================================================================
228 Test inflate() with small buffers
229 }
230
231 {$IFDEF TEST_INFLATE}
232 procedure test_inflate(compr : Pbyte; comprLen : cardinal;
233 uncompr : Pbyte; uncomprLen : cardinal);
234 var
235 err : integer;
236 d_stream : z_stream; { decompression stream }
237 begin
238 strcopy(PChar(uncompr), 'garbage');
239
240 d_stream.next_in := compr;
241 d_stream.avail_in := 0;
242 d_stream.next_out := uncompr;
243
244 err := inflateInit(d_stream);
245 CHECK_ERR(err, 'inflateInit');
246
247 while (d_stream.total_out < uncomprLen) and
248 (d_stream.total_in < comprLen) do
249 begin
250 d_stream.avail_out := 1; { force small buffers }
251 d_stream.avail_in := 1;
252 err := inflate(d_stream, Z_NO_FLUSH);
253 if (err = Z_STREAM_END) then
254 break;
255 CHECK_ERR(err, 'inflate');
256 end;
257
258 err := inflateEnd(d_stream);
259 CHECK_ERR(err, 'inflateEnd');
260
261 if (strcomp(PChar(uncompr), hello) <> 0) then
262 begin
263 WriteLn('bad inflate');
264 exit;
265 end
266 else
267 begin
268 WriteLn('inflate(): ', StrPas(PChar(uncompr)));
269 end;
270 end;
271 {$ENDIF}
272
273 { ===========================================================================
274 Test deflate() with large buffers and dynamic change of compression level
275 }
276
277 {$IFDEF TEST_DEFLATE}
278 procedure test_large_deflate(compr : Pbyte; comprLen : cardinal;
279 uncompr : Pbyte; uncomprLen : cardinal);
280 var
281 c_stream : z_stream; { compression stream }
282 err : integer;
283 begin
284 err := deflateInit(c_stream, Z_BEST_SPEED);
285 CHECK_ERR(err, 'deflateInit');
286
287 c_stream.next_out := compr;
288 c_stream.avail_out := cardinal(comprLen);
289
290 { At this point, uncompr is still mostly zeroes, so it should compress
291 very well: }
292
293 c_stream.next_in := uncompr;
294 c_stream.avail_in := cardinal(uncomprLen);
295 err := deflate(c_stream, Z_NO_FLUSH);
296 CHECK_ERR(err, 'deflate');
297 if (c_stream.avail_in <> 0) then
298 begin
299 WriteLn('deflate not greedy');
300 exit;
301 end;
302
303 { Feed in already compressed data and switch to no compression: }
304 deflateParams(c_stream, Z_NO_COMPRESSION, Z_DEFAULT_STRATEGY);
305 c_stream.next_in := compr;
306 c_stream.avail_in := cardinal(comprLen div 2);
307 err := deflate(c_stream, Z_NO_FLUSH);
308 CHECK_ERR(err, 'deflate');
309
310 { Switch back to compressing mode: }
311 deflateParams(c_stream, Z_BEST_COMPRESSION, Z_FILTERED);
312 c_stream.next_in := uncompr;
313 c_stream.avail_in := cardinal(uncomprLen);
314 err := deflate(c_stream, Z_NO_FLUSH);
315 CHECK_ERR(err, 'deflate');
316
317 err := deflate(c_stream, Z_FINISH);
318 if (err <> Z_STREAM_END) then
319 begin
320 WriteLn('deflate should report Z_STREAM_END');
321 exit;
322 end;
323 err := deflateEnd(c_stream);
324 CHECK_ERR(err, 'deflateEnd');
325 end;
326 {$ENDIF}
327
328 { ===========================================================================
329 Test inflate() with large buffers }
330
331 {$IFDEF TEST_INFLATE}
332 procedure test_large_inflate(compr : Pbyte; comprLen : cardinal;
333 uncompr : Pbyte; uncomprLen : cardinal);
334 var
335 err : integer;
336 d_stream : z_stream; { decompression stream }
337 begin
338 strcopy(PChar(uncompr), 'garbage');
339
340 d_stream.next_in := compr;
341 d_stream.avail_in := cardinal(comprLen);
342
343 err := inflateInit(d_stream);
344 CHECK_ERR(err, 'inflateInit');
345
346 while TRUE do
347 begin
348 d_stream.next_out := uncompr; { discard the output }
349 d_stream.avail_out := cardinal(uncomprLen);
350 err := inflate(d_stream, Z_NO_FLUSH);
351 if (err = Z_STREAM_END) then
352 break;
353 CHECK_ERR(err, 'large inflate');
354 end;
355
356 err := inflateEnd(d_stream);
357 CHECK_ERR(err, 'inflateEnd');
358
359 if (d_stream.total_out <> 2*uncomprLen + comprLen div 2) then
360 begin
361 WriteLn('bad large inflate: ', d_stream.total_out);
362 Stop;
363 end
364 else
365 WriteLn('large_inflate(): OK');
366 end;
367 {$ENDIF}
368
369 { ===========================================================================
370 Test deflate() with full flush
371 }
372 {$IFDEF TEST_FLUSH}
373 procedure test_flush(compr : Pbyte; var comprLen : cardinal);
374 var
375 c_stream : z_stream; { compression stream }
376 err : integer;
377 len : integer;
378
379 begin
380 len := strlen(hello)+1;
381 err := deflateInit(c_stream, Z_DEFAULT_COMPRESSION);
382 CHECK_ERR(err, 'deflateInit');
383
384 c_stream.next_in := Pbyte(hello);
385 c_stream.next_out := compr;
386 c_stream.avail_in := 3;
387 c_stream.avail_out := cardinal(comprLen);
388
389 err := deflate(c_stream, Z_FULL_FLUSH);
390 CHECK_ERR(err, 'deflate');
391
392 Inc(pchar(compr)[3]); { force an error in first compressed block }
393 c_stream.avail_in := len - 3;
394
395 err := deflate(c_stream, Z_FINISH);
396 if (err <> Z_STREAM_END) then
397 CHECK_ERR(err, 'deflate');
398
399 err := deflateEnd(c_stream);
400 CHECK_ERR(err, 'deflateEnd');
401
402 comprLen := c_stream.total_out;
403 end;
404 {$ENDIF}
405
406 { ===========================================================================
407 Test inflateSync()
408 }
409 {$IFDEF TEST_SYNC}
410 procedure test_sync(compr : Pbyte; comprLen : cardinal;
411 uncompr : Pbyte; uncomprLen : cardinal);
412 var
413 err : integer;
414 d_stream : z_stream; { decompression stream }
415 begin
416 strcopy(PChar(uncompr), 'garbage');
417
418 d_stream.next_in := compr;
419 d_stream.avail_in := 2; { just read the zlib header }
420
421 err := inflateInit(d_stream);
422 CHECK_ERR(err, 'inflateInit');
423
424 d_stream.next_out := uncompr;
425 d_stream.avail_out := cardinal(uncomprLen);
426
427 inflate(d_stream, Z_NO_FLUSH);
428 CHECK_ERR(err, 'inflate');
429
430 d_stream.avail_in := cardinal(comprLen-2); { read all compressed data }
431 err := inflateSync(d_stream); { but skip the damaged part }
432 CHECK_ERR(err, 'inflateSync');
433
434 err := inflate(d_stream, Z_FINISH);
435 if (err <> Z_DATA_ERROR) then
436 begin
437 WriteLn('inflate should report DATA_ERROR');
438 { Because of incorrect adler32 }
439 Stop;
440 end;
441 err := inflateEnd(d_stream);
442 CHECK_ERR(err, 'inflateEnd');
443
444 WriteLn('after inflateSync(): hel', StrPas(PChar(uncompr)));
445 end;
446 {$ENDIF}
447
448 { ===========================================================================
449 Test deflate() with preset dictionary
450 }
451 {$IFDEF TEST_DICT}
452 procedure test_dict_deflate(compr : Pbyte; comprLen : cardinal);
453 var
454 c_stream : z_stream; { compression stream }
455 err : integer;
456 begin
457 err := deflateInit(c_stream, Z_BEST_COMPRESSION);
458 CHECK_ERR(err, 'deflateInit');
459
460 err := deflateSetDictionary(c_stream,
461 Pbyte(dictionary), StrLen(dictionary));
462 CHECK_ERR(err, 'deflateSetDictionary');
463
464 dictId := c_stream.adler;
465 c_stream.next_out := compr;
466 c_stream.avail_out := cardinal(comprLen);
467
468 c_stream.next_in := Pbyte(hello);
469 c_stream.avail_in := cardinal(strlen(hello)+1);
470
471 err := deflate(c_stream, Z_FINISH);
472 if (err <> Z_STREAM_END) then
473 begin
474 WriteLn('deflate should report Z_STREAM_END');
475 exit;
476 end;
477 err := deflateEnd(c_stream);
478 CHECK_ERR(err, 'deflateEnd');
479 end;
480
481 { ===========================================================================
482 Test inflate() with a preset dictionary }
483
484 procedure test_dict_inflate(compr : Pbyte; comprLen : cardinal;
485 uncompr : Pbyte; uncomprLen : cardinal);
486 var
487 err : integer;
488 d_stream : z_stream; { decompression stream }
489 begin
490 strcopy(PChar(uncompr), 'garbage');
491
492 d_stream.next_in := compr;
493 d_stream.avail_in := cardinal(comprLen);
494
495 err := inflateInit(d_stream);
496 CHECK_ERR(err, 'inflateInit');
497
498 d_stream.next_out := uncompr;
499 d_stream.avail_out := cardinal(uncomprLen);
500
501 while TRUE do
502 begin
503 err := inflate(d_stream, Z_NO_FLUSH);
504 if (err = Z_STREAM_END) then
505 break;
506 if (err = Z_NEED_DICT) then
507 begin
508 if (d_stream.adler <> dictId) then
509 begin
510 WriteLn('unexpected dictionary');
511 Stop;
512 end;
513 err := inflateSetDictionary(d_stream, Pbyte(dictionary),
514 StrLen(dictionary));
515 end;
516 CHECK_ERR(err, 'inflate with dict');
517 end;
518
519 err := inflateEnd(d_stream);
520 CHECK_ERR(err, 'inflateEnd');
521
522 if (strcomp(PChar(uncompr), hello)) <> 0 then
523 begin
524 WriteLn('bad inflate with dict');
525 Stop;
526 end
527 else
528 begin
529 WriteLn('inflate with dictionary: ', StrPas(PChar(uncompr)));
530 end;
531 end;
532 {$ENDIF}
533
GetFromFilenull534 function GetFromFile(buf : Pbyte; FName : string;
535 var MaxLen : cardinal) : boolean;
536 const
537 zOfs = 0;
538 var
539 f : file;
540 Len : cardinal;
541 begin
542 assign(f, FName);
543 GetFromFile := false;
544 {$I-}
545 filemode := 0; { read only }
546 reset(f, 1);
547 if IOresult = 0 then
548 begin
549 Len := FileSize(f)-zOfs;
550 Seek(f, zOfs);
551 if Len < MaxLen then
552 MaxLen := Len;
553 BlockRead(f, buf^, MaxLen);
554 close(f);
555 WriteLn(FName);
556 GetFromFile := (IOresult = 0) and (MaxLen > 0);
557 end
558 else
559 WriteLn('Could not open ', FName);
560 end;
561
562 { ===========================================================================
563 Usage: example [output.gz [input.gz]]
564 }
565
566 var
567 compr, uncompr : Pbyte;
568 const
569 msdoslen = 25000;
570 comprLenL : cardinal = msdoslen div sizeof(cardinal); { don't overflow on MSDOS }
571 uncomprLenL : cardinal = msdoslen div sizeof(cardinal);
572 var
573 zVersion,
574 myVersion : string;
575 var
576 comprLen : cardinal;
577 uncomprLen : cardinal;
578 begin
579 {$ifdef MemCheck}
580 MemChk;
581 {$endif}
582 comprLen := comprLenL;
583 uncomprLen := uncomprLenL;
584
585 myVersion := ZLIB_VERSION;
586 zVersion := zlibVersion;
587 if (zVersion[1] <> myVersion[1]) then
588 begin
589 WriteLn('incompatible zlib version');
590 Stop;
591 end
592 else
593 if (zVersion <> ZLIB_VERSION) then
594 begin
595 WriteLn('warning: different zlib version');
596 end;
597
598 GetMem(compr, comprLen*sizeof(cardinal));
599 GetMem(uncompr, uncomprLen*sizeof(cardinal));
600 { compr and uncompr are cleared to avoid reading uninitialized
601 data and to ensure that uncompr compresses well. }
602
603 if (compr = nil) or (uncompr = nil) then
604 begin
605 WriteLn('out of memory');
606 Stop;
607 end;
608 FillChar(compr^, comprLen*sizeof(cardinal), 0);
609 FillChar(uncompr^, uncomprLen*sizeof(cardinal), 0);
610
611 if (compr = nil) or (uncompr = nil) then
612 begin
613 WriteLn('out of memory');
614 Stop;
615 end;
616 {$IFDEF TEST_COMPRESS}
617 test_compress(compr, comprLenL, uncompr, uncomprLen);
618 {$ENDIF}
619
620 {$IFDEF TEST_GZIO}
621 Case ParamCount of
622 0: test_gzio('foo.gz', 'foo.gz', uncompr, integer(uncomprLen));
623 1: test_gzio(ParamStr(1), 'foo.gz', uncompr, integer(uncomprLen));
624 else
625 test_gzio(ParamStr(1), ParamStr(2), uncompr, integer(uncomprLen));
626 end;
627 {$ENDIF}
628
629 {$IFDEF TEST_DEFLATE}
630 WriteLn('small buffer Deflate');
631 test_deflate(compr, comprLen);
632 {$ENDIF}
633 {$IFDEF TEST_INFLATE}
634 {$IFNDEF TEST_DEFLATE}
635 WriteLn('small buffer Inflate');
636 if GetFromFile(compr, 'u:\nomssi\paszlib\new\test0.z', comprLen) then
637 {$ENDIF}
638 test_inflate(compr, comprLen, uncompr, uncomprLen);
639 {$ENDIF}
640 readln;
641 {$IFDEF TEST_DEFLATE}
642 WriteLn('large buffer Deflate');
643 test_large_deflate(compr, comprLen, uncompr, uncomprLen);
644 {$ENDIF}
645 {$IFDEF TEST_INFLATE}
646 WriteLn('large buffer Inflate');
647 test_large_inflate(compr, comprLen, uncompr, uncomprLen);
648 {$ENDIF}
649 {$IFDEF TEST_FLUSH}
650 test_flush(compr, comprLenL);
651 {$ENDIF}
652 {$IFDEF TEST_SYNC}
653 test_sync(compr, comprLen, uncompr, uncomprLen);
654 {$ENDIF}
655 comprLen := uncomprLen;
656
657 {$IFDEF TEST_DICT}
658 test_dict_deflate(compr, comprLen);
659 test_dict_inflate(compr, comprLen, uncompr, uncomprLen);
660 {$ENDIF}
661 readln;
662 FreeMem(compr, comprLen*sizeof(cardinal));
663 FreeMem(uncompr, uncomprLen*sizeof(cardinal));
664 end.
665