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. 600