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 

    14 program 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 

    24 uses SysUtils, zlibpas;

    25 

    26 const TESTFILE = 'foo.gz';

    27 

    28 (* "hello world" would be more standard, but the repeated "hello"

    29  * stresses the compression code better, sorry...

    30  *)

    31 const hello: PChar = 'hello, hello!';

    32 

    33 const dictionary: PChar = 'hello';

    34 

    35 var dictId: LongInt; (* Adler32 value of the dictionary *)

    36 

    37 procedure CHECK_ERR(err: Integer; msg: String);

    38 begin

    39   if err <> Z_OK then

    40   begin

    41     WriteLn(msg, ' error: ', err);

    42     Halt(1);

    43   end;

    44 end;

    45 

    46 procedure EXIT_ERR(const msg: String);

    47 begin

    48   WriteLn('Error: ', msg);

    49   Halt(1);

    50 end;

    51 

    52 (* ===========================================================================

    53  * Test compress and uncompress

    54  *)

    55 {$IFDEF TEST_COMPRESS}

    56 procedure test_compress(compr: Pointer; comprLen: LongInt;

    57                         uncompr: Pointer; uncomprLen: LongInt);

    58 var err: Integer;

    59     len: LongInt;

    60 begin

    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));

    75 end;

    76 {$ENDIF}

    77 

    78 (* ===========================================================================

    79  * Test read/write of .gz files

    80  *)

    81 {$IFDEF TEST_GZIO}

    82 procedure test_gzio(const fname: PChar; (* compressed file name *)

    83                     uncompr: Pointer;

    84                     uncomprLen: LongInt);

    85 var err: Integer;

    86     len: Integer;

    87     zfile: gzFile;

    88     pos: LongInt;

    89 begin

    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);

   177 end;

   178 {$ENDIF}

   179 

   180 (* ===========================================================================

   181  * Test deflate with small buffers

   182  *)

   183 {$IFDEF TEST_DEFLATE}

   184 procedure test_deflate(compr: Pointer; comprLen: LongInt);

   185 var c_stream: z_stream; (* compression stream *)

   186     err: Integer;

   187     len: LongInt;

   188 begin

   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');

   222 end;

   223 {$ENDIF}

   224 

   225 (* ===========================================================================

   226  * Test inflate with small buffers

   227  *)

   228 {$IFDEF TEST_INFLATE}

   229 procedure test_inflate(compr: Pointer; comprLen : LongInt;

   230                        uncompr: Pointer; uncomprLen : LongInt);

   231 var err: Integer;

   232     d_stream: z_stream; (* decompression stream *)

   233 begin

   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));

   265 end;

   266 {$ENDIF}

   267 

   268 (* ===========================================================================

   269  * Test deflate with large buffers and dynamic change of compression level

   270  *)

   271 {$IFDEF TEST_DEFLATE}

   272 procedure test_large_deflate(compr: Pointer; comprLen: LongInt;

   273                              uncompr: Pointer; uncomprLen: LongInt);

   274 var c_stream: z_stream; (* compression stream *)

   275     err: Integer;

   276 begin

   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');

   317 end;

   318 {$ENDIF}

   319 

   320 (* ===========================================================================

   321  * Test inflate with large buffers

   322  *)

   323 {$IFDEF TEST_INFLATE}

   324 procedure test_large_inflate(compr: Pointer; comprLen: LongInt;

   325                              uncompr: Pointer; uncomprLen: LongInt);

   326 var err: Integer;

   327     d_stream: z_stream; (* decompression stream *)

   328 begin

   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');

   361 end;

   362 {$ENDIF}

   363 

   364 (* ===========================================================================

   365  * Test deflate with full flush

   366  *)

   367 {$IFDEF TEST_FLUSH}

   368 procedure test_flush(compr: Pointer; var comprLen : LongInt);

   369 var c_stream: z_stream; (* compression stream *)

   370     err: Integer;

   371     len: Integer;

   372 begin

   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;

   400 end;

   401 {$ENDIF}

   402 

   403 (* ===========================================================================

   404  * Test inflateSync()

   405  *)

   406 {$IFDEF TEST_SYNC}

   407 procedure test_sync(compr: Pointer; comprLen: LongInt;

   408                     uncompr: Pointer; uncomprLen : LongInt);

   409 var err: Integer;

   410     d_stream: z_stream; (* decompression stream *)

   411 begin

   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));

   443 end;

   444 {$ENDIF}

   445 

   446 (* ===========================================================================

   447  * Test deflate with preset dictionary

   448  *)

   449 {$IFDEF TEST_DICT}

   450 procedure test_dict_deflate(compr: Pointer; comprLen: LongInt);

   451 var c_stream: z_stream; (* compression stream *)

   452     err: Integer;

   453 begin

   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');

   477 end;

   478 {$ENDIF}

   479 

   480 (* ===========================================================================

   481  * Test inflate with a preset dictionary

   482  *)

   483 {$IFDEF TEST_DICT}

   484 procedure test_dict_inflate(compr: Pointer; comprLen: LongInt;

   485                             uncompr: Pointer; uncomprLen: LongInt);

   486 var err: Integer;

   487     d_stream: z_stream; (* decompression stream *)

   488 begin

   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));

   525 end;

   526 {$ENDIF}

   527 

   528 var compr, uncompr: Pointer;

   529     comprLen, uncomprLen: LongInt;

   530 

   531 begin

   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);

   599 end.