1(* example.c -- usage example of the zlib compression library
2 * Copyright (C) 1995-2003 Jean-loup Gailly.
3 * For conditions of distribution and use, see copyright notice in zlib.h
4 *
5 * Pascal translation
6 * Copyright (C) 1998 by Jacques Nomssi Nzali.
7 * For conditions of distribution and use, see copyright notice in readme.txt
8 *
9 * Adaptation to the zlibpas interface
10 * Copyright (C) 2003 by Cosmin Truta.
11 * For conditions of distribution and use, see copyright notice in readme.txt
12 *)
13
14program example;
15
16{$DEFINE TEST_COMPRESS}
17{DO NOT $DEFINE TEST_GZIO}
18{$DEFINE TEST_DEFLATE}
19{$DEFINE TEST_INFLATE}
20{$DEFINE TEST_FLUSH}
21{$DEFINE TEST_SYNC}
22{$DEFINE TEST_DICT}
23
24uses SysUtils, zlibpas;
25
26const TESTFILE = 'foo.gz';
27
28(* "hello world" would be more standard, but the repeated "hello"
29 * stresses the compression code better, sorry...
30 *)
31const hello: PChar = 'hello, hello!';
32
33const dictionary: PChar = 'hello';
34
35var dictId: LongInt; (* Adler32 value of the dictionary *)
36
37procedure CHECK_ERR(err: Integer; msg: String);
38begin
39  if err <> Z_OK then
40  begin
41    WriteLn(msg, ' error: ', err);
42    Halt(1);
43  end;
44end;
45
46procedure EXIT_ERR(const msg: String);
47begin
48  WriteLn('Error: ', msg);
49  Halt(1);
50end;
51
52(* ===========================================================================
53 * Test compress and uncompress
54 *)
55{$IFDEF TEST_COMPRESS}
56procedure test_compress(compr: Pointer; comprLen: LongInt;
57                        uncompr: Pointer; uncomprLen: LongInt);
58var err: Integer;
59    len: LongInt;
60begin
61  len := StrLen(hello)+1;
62
63  err := compress(compr, comprLen, hello, len);
64  CHECK_ERR(err, 'compress');
65
66  StrCopy(PChar(uncompr), 'garbage');
67
68  err := uncompress(uncompr, uncomprLen, compr, comprLen);
69  CHECK_ERR(err, 'uncompress');
70
71  if StrComp(PChar(uncompr), hello) <> 0 then
72    EXIT_ERR('bad uncompress')
73  else
74    WriteLn('uncompress(): ', PChar(uncompr));
75end;
76{$ENDIF}
77
78(* ===========================================================================
79 * Test read/write of .gz files
80 *)
81{$IFDEF TEST_GZIO}
82procedure test_gzio(const fname: PChar; (* compressed file name *)
83                    uncompr: Pointer;
84                    uncomprLen: LongInt);
85var err: Integer;
86    len: Integer;
87    zfile: gzFile;
88    pos: LongInt;
89begin
90  len := StrLen(hello)+1;
91
92  zfile := gzopen(fname, 'wb');
93  if zfile = NIL then
94  begin
95    WriteLn('gzopen error');
96    Halt(1);
97  end;
98  gzputc(zfile, 'h');
99  if gzputs(zfile, 'ello') <> 4 then
100  begin
101    WriteLn('gzputs err: ', gzerror(zfile, err));
102    Halt(1);
103  end;
104  {$IFDEF GZ_FORMAT_STRING}
105  if gzprintf(zfile, ', %s!', 'hello') <> 8 then
106  begin
107    WriteLn('gzprintf err: ', gzerror(zfile, err));
108    Halt(1);
109  end;
110  {$ELSE}
111  if gzputs(zfile, ', hello!') <> 8 then
112  begin
113    WriteLn('gzputs err: ', gzerror(zfile, err));
114    Halt(1);
115  end;
116  {$ENDIF}
117  gzseek(zfile, 1, SEEK_CUR); (* add one zero byte *)
118  gzclose(zfile);
119
120  zfile := gzopen(fname, 'rb');
121  if zfile = NIL then
122  begin
123    WriteLn('gzopen error');
124    Halt(1);
125  end;
126
127  StrCopy(PChar(uncompr), 'garbage');
128
129  if gzread(zfile, uncompr, uncomprLen) <> len then
130  begin
131    WriteLn('gzread err: ', gzerror(zfile, err));
132    Halt(1);
133  end;
134  if StrComp(PChar(uncompr), hello) <> 0 then
135  begin
136    WriteLn('bad gzread: ', PChar(uncompr));
137    Halt(1);
138  end
139  else
140    WriteLn('gzread(): ', PChar(uncompr));
141
142  pos := gzseek(zfile, -8, SEEK_CUR);
143  if (pos <> 6) or (gztell(zfile) <> pos) then
144  begin
145    WriteLn('gzseek error, pos=', pos, ', gztell=', gztell(zfile));
146    Halt(1);
147  end;
148
149  if gzgetc(zfile) <> ' ' then
150  begin
151    WriteLn('gzgetc error');
152    Halt(1);
153  end;
154
155  if gzungetc(' ', zfile) <> ' ' then
156  begin
157    WriteLn('gzungetc error');
158    Halt(1);
159  end;
160
161  gzgets(zfile, PChar(uncompr), uncomprLen);
162  uncomprLen := StrLen(PChar(uncompr));
163  if uncomprLen <> 7 then (* " hello!" *)
164  begin
165    WriteLn('gzgets err after gzseek: ', gzerror(zfile, err));
166    Halt(1);
167  end;
168  if StrComp(PChar(uncompr), hello + 6) <> 0 then
169  begin
170    WriteLn('bad gzgets after gzseek');
171    Halt(1);
172  end
173  else
174    WriteLn('gzgets() after gzseek: ', PChar(uncompr));
175
176  gzclose(zfile);
177end;
178{$ENDIF}
179
180(* ===========================================================================
181 * Test deflate with small buffers
182 *)
183{$IFDEF TEST_DEFLATE}
184procedure test_deflate(compr: Pointer; comprLen: LongInt);
185var c_stream: z_stream; (* compression stream *)
186    err: Integer;
187    len: LongInt;
188begin
189  len := StrLen(hello)+1;
190
191  c_stream.zalloc := NIL;
192  c_stream.zfree := NIL;
193  c_stream.opaque := NIL;
194
195  err := deflateInit(c_stream, Z_DEFAULT_COMPRESSION);
196  CHECK_ERR(err, 'deflateInit');
197
198  c_stream.next_in := hello;
199  c_stream.next_out := compr;
200
201  while (c_stream.total_in <> len) and
202        (c_stream.total_out < comprLen) do
203  begin
204    c_stream.avail_out := 1; { force small buffers }
205    c_stream.avail_in := 1;
206    err := deflate(c_stream, Z_NO_FLUSH);
207    CHECK_ERR(err, 'deflate');
208  end;
209
210  (* Finish the stream, still forcing small buffers: *)
211  while TRUE do
212  begin
213    c_stream.avail_out := 1;
214    err := deflate(c_stream, Z_FINISH);
215    if err = Z_STREAM_END then
216      break;
217    CHECK_ERR(err, 'deflate');
218  end;
219
220  err := deflateEnd(c_stream);
221  CHECK_ERR(err, 'deflateEnd');
222end;
223{$ENDIF}
224
225(* ===========================================================================
226 * Test inflate with small buffers
227 *)
228{$IFDEF TEST_INFLATE}
229procedure test_inflate(compr: Pointer; comprLen : LongInt;
230                       uncompr: Pointer; uncomprLen : LongInt);
231var err: Integer;
232    d_stream: z_stream; (* decompression stream *)
233begin
234  StrCopy(PChar(uncompr), 'garbage');
235
236  d_stream.zalloc := NIL;
237  d_stream.zfree := NIL;
238  d_stream.opaque := NIL;
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    EXIT_ERR('bad inflate')
263  else
264    WriteLn('inflate(): ', PChar(uncompr));
265end;
266{$ENDIF}
267
268(* ===========================================================================
269 * Test deflate with large buffers and dynamic change of compression level
270 *)
271{$IFDEF TEST_DEFLATE}
272procedure test_large_deflate(compr: Pointer; comprLen: LongInt;
273                             uncompr: Pointer; uncomprLen: LongInt);
274var c_stream: z_stream; (* compression stream *)
275    err: Integer;
276begin
277  c_stream.zalloc := NIL;
278  c_stream.zfree := NIL;
279  c_stream.opaque := NIL;
280
281  err := deflateInit(c_stream, Z_BEST_SPEED);
282  CHECK_ERR(err, 'deflateInit');
283
284  c_stream.next_out := compr;
285  c_stream.avail_out := Integer(comprLen);
286
287  (* At this point, uncompr is still mostly zeroes, so it should compress
288   * very well:
289   *)
290  c_stream.next_in := uncompr;
291  c_stream.avail_in := Integer(uncomprLen);
292  err := deflate(c_stream, Z_NO_FLUSH);
293  CHECK_ERR(err, 'deflate');
294  if c_stream.avail_in <> 0 then
295    EXIT_ERR('deflate not greedy');
296
297  (* Feed in already compressed data and switch to no compression: *)
298  deflateParams(c_stream, Z_NO_COMPRESSION, Z_DEFAULT_STRATEGY);
299  c_stream.next_in := compr;
300  c_stream.avail_in := Integer(comprLen div 2);
301  err := deflate(c_stream, Z_NO_FLUSH);
302  CHECK_ERR(err, 'deflate');
303
304  (* Switch back to compressing mode: *)
305  deflateParams(c_stream, Z_BEST_COMPRESSION, Z_FILTERED);
306  c_stream.next_in := uncompr;
307  c_stream.avail_in := Integer(uncomprLen);
308  err := deflate(c_stream, Z_NO_FLUSH);
309  CHECK_ERR(err, 'deflate');
310
311  err := deflate(c_stream, Z_FINISH);
312  if err <> Z_STREAM_END then
313    EXIT_ERR('deflate should report Z_STREAM_END');
314
315  err := deflateEnd(c_stream);
316  CHECK_ERR(err, 'deflateEnd');
317end;
318{$ENDIF}
319
320(* ===========================================================================
321 * Test inflate with large buffers
322 *)
323{$IFDEF TEST_INFLATE}
324procedure test_large_inflate(compr: Pointer; comprLen: LongInt;
325                             uncompr: Pointer; uncomprLen: LongInt);
326var err: Integer;
327    d_stream: z_stream; (* decompression stream *)
328begin
329  StrCopy(PChar(uncompr), 'garbage');
330
331  d_stream.zalloc := NIL;
332  d_stream.zfree := NIL;
333  d_stream.opaque := NIL;
334
335  d_stream.next_in := compr;
336  d_stream.avail_in := Integer(comprLen);
337
338  err := inflateInit(d_stream);
339  CHECK_ERR(err, 'inflateInit');
340
341  while TRUE do
342  begin
343    d_stream.next_out := uncompr;            (* discard the output *)
344    d_stream.avail_out := Integer(uncomprLen);
345    err := inflate(d_stream, Z_NO_FLUSH);
346    if err = Z_STREAM_END then
347      break;
348    CHECK_ERR(err, 'large inflate');
349  end;
350
351  err := inflateEnd(d_stream);
352  CHECK_ERR(err, 'inflateEnd');
353
354  if d_stream.total_out <> 2 * uncomprLen + comprLen div 2 then
355  begin
356    WriteLn('bad large inflate: ', d_stream.total_out);
357    Halt(1);
358  end
359  else
360    WriteLn('large_inflate(): OK');
361end;
362{$ENDIF}
363
364(* ===========================================================================
365 * Test deflate with full flush
366 *)
367{$IFDEF TEST_FLUSH}
368procedure test_flush(compr: Pointer; var comprLen : LongInt);
369var c_stream: z_stream; (* compression stream *)
370    err: Integer;
371    len: Integer;
372begin
373  len := StrLen(hello)+1;
374
375  c_stream.zalloc := NIL;
376  c_stream.zfree := NIL;
377  c_stream.opaque := NIL;
378
379  err := deflateInit(c_stream, Z_DEFAULT_COMPRESSION);
380  CHECK_ERR(err, 'deflateInit');
381
382  c_stream.next_in := hello;
383  c_stream.next_out := compr;
384  c_stream.avail_in := 3;
385  c_stream.avail_out := Integer(comprLen);
386  err := deflate(c_stream, Z_FULL_FLUSH);
387  CHECK_ERR(err, 'deflate');
388
389  Inc(PByteArray(compr)^[3]); (* force an error in first compressed block *)
390  c_stream.avail_in := len - 3;
391
392  err := deflate(c_stream, Z_FINISH);
393  if err <> Z_STREAM_END then
394    CHECK_ERR(err, 'deflate');
395
396  err := deflateEnd(c_stream);
397  CHECK_ERR(err, 'deflateEnd');
398
399  comprLen := c_stream.total_out;
400end;
401{$ENDIF}
402
403(* ===========================================================================
404 * Test inflateSync()
405 *)
406{$IFDEF TEST_SYNC}
407procedure test_sync(compr: Pointer; comprLen: LongInt;
408                    uncompr: Pointer; uncomprLen : LongInt);
409var err: Integer;
410    d_stream: z_stream; (* decompression stream *)
411begin
412  StrCopy(PChar(uncompr), 'garbage');
413
414  d_stream.zalloc := NIL;
415  d_stream.zfree := NIL;
416  d_stream.opaque := NIL;
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 := Integer(uncomprLen);
426
427  inflate(d_stream, Z_NO_FLUSH);
428  CHECK_ERR(err, 'inflate');
429
430  d_stream.avail_in := Integer(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    EXIT_ERR('inflate should report DATA_ERROR');
437    (* Because of incorrect adler32 *)
438
439  err := inflateEnd(d_stream);
440  CHECK_ERR(err, 'inflateEnd');
441
442  WriteLn('after inflateSync(): hel', PChar(uncompr));
443end;
444{$ENDIF}
445
446(* ===========================================================================
447 * Test deflate with preset dictionary
448 *)
449{$IFDEF TEST_DICT}
450procedure test_dict_deflate(compr: Pointer; comprLen: LongInt);
451var c_stream: z_stream; (* compression stream *)
452    err: Integer;
453begin
454  c_stream.zalloc := NIL;
455  c_stream.zfree := NIL;
456  c_stream.opaque := NIL;
457
458  err := deflateInit(c_stream, Z_BEST_COMPRESSION);
459  CHECK_ERR(err, 'deflateInit');
460
461  err := deflateSetDictionary(c_stream, 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 := Integer(comprLen);
467
468  c_stream.next_in := hello;
469  c_stream.avail_in := StrLen(hello)+1;
470
471  err := deflate(c_stream, Z_FINISH);
472  if err <> Z_STREAM_END then
473    EXIT_ERR('deflate should report Z_STREAM_END');
474
475  err := deflateEnd(c_stream);
476  CHECK_ERR(err, 'deflateEnd');
477end;
478{$ENDIF}
479
480(* ===========================================================================
481 * Test inflate with a preset dictionary
482 *)
483{$IFDEF TEST_DICT}
484procedure test_dict_inflate(compr: Pointer; comprLen: LongInt;
485                            uncompr: Pointer; uncomprLen: LongInt);
486var err: Integer;
487    d_stream: z_stream; (* decompression stream *)
488begin
489  StrCopy(PChar(uncompr), 'garbage');
490
491  d_stream.zalloc := NIL;
492  d_stream.zfree := NIL;
493  d_stream.opaque := NIL;
494
495  d_stream.next_in := compr;
496  d_stream.avail_in := Integer(comprLen);
497
498  err := inflateInit(d_stream);
499  CHECK_ERR(err, 'inflateInit');
500
501  d_stream.next_out := uncompr;
502  d_stream.avail_out := Integer(uncomprLen);
503
504  while TRUE do
505  begin
506    err := inflate(d_stream, Z_NO_FLUSH);
507    if err = Z_STREAM_END then
508      break;
509    if err = Z_NEED_DICT then
510    begin
511      if d_stream.adler <> dictId then
512        EXIT_ERR('unexpected dictionary');
513      err := inflateSetDictionary(d_stream, dictionary, StrLen(dictionary));
514    end;
515    CHECK_ERR(err, 'inflate with dict');
516  end;
517
518  err := inflateEnd(d_stream);
519  CHECK_ERR(err, 'inflateEnd');
520
521  if StrComp(PChar(uncompr), hello) <> 0 then
522    EXIT_ERR('bad inflate with dict')
523  else
524    WriteLn('inflate with dictionary: ', PChar(uncompr));
525end;
526{$ENDIF}
527
528var compr, uncompr: Pointer;
529    comprLen, uncomprLen: LongInt;
530
531begin
532  if zlibVersion^ <> ZLIB_VERSION[1] then
533    EXIT_ERR('Incompatible zlib version');
534
535  WriteLn('zlib version: ', zlibVersion);
536  WriteLn('zlib compile flags: ', Format('0x%x', [zlibCompileFlags]));
537
538  comprLen := 10000 * SizeOf(Integer); (* don't overflow on MSDOS *)
539  uncomprLen := comprLen;
540  GetMem(compr, comprLen);
541  GetMem(uncompr, uncomprLen);
542  if (compr = NIL) or (uncompr = NIL) then
543    EXIT_ERR('Out of memory');
544  (* compr and uncompr are cleared to avoid reading uninitialized
545   * data and to ensure that uncompr compresses well.
546   *)
547  FillChar(compr^, comprLen, 0);
548  FillChar(uncompr^, uncomprLen, 0);
549
550  {$IFDEF TEST_COMPRESS}
551  WriteLn('** Testing compress');
552  test_compress(compr, comprLen, uncompr, uncomprLen);
553  {$ENDIF}
554
555  {$IFDEF TEST_GZIO}
556  WriteLn('** Testing gzio');
557  if ParamCount >= 1 then
558    test_gzio(ParamStr(1), uncompr, uncomprLen)
559  else
560    test_gzio(TESTFILE, uncompr, uncomprLen);
561  {$ENDIF}
562
563  {$IFDEF TEST_DEFLATE}
564  WriteLn('** Testing deflate with small buffers');
565  test_deflate(compr, comprLen);
566  {$ENDIF}
567  {$IFDEF TEST_INFLATE}
568  WriteLn('** Testing inflate with small buffers');
569  test_inflate(compr, comprLen, uncompr, uncomprLen);
570  {$ENDIF}
571
572  {$IFDEF TEST_DEFLATE}
573  WriteLn('** Testing deflate with large buffers');
574  test_large_deflate(compr, comprLen, uncompr, uncomprLen);
575  {$ENDIF}
576  {$IFDEF TEST_INFLATE}
577  WriteLn('** Testing inflate with large buffers');
578  test_large_inflate(compr, comprLen, uncompr, uncomprLen);
579  {$ENDIF}
580
581  {$IFDEF TEST_FLUSH}
582  WriteLn('** Testing deflate with full flush');
583  test_flush(compr, comprLen);
584  {$ENDIF}
585  {$IFDEF TEST_SYNC}
586  WriteLn('** Testing inflateSync');
587  test_sync(compr, comprLen, uncompr, uncomprLen);
588  {$ENDIF}
589  comprLen := uncomprLen;
590
591  {$IFDEF TEST_DICT}
592  WriteLn('** Testing deflate and inflate with preset dictionary');
593  test_dict_deflate(compr, comprLen);
594  test_dict_inflate(compr, comprLen, uncompr, uncomprLen);
595  {$ENDIF}
596
597  FreeMem(compr, comprLen);
598  FreeMem(uncompr, uncomprLen);
599end.
600