source: s10k/CommonLibs/zlib-1.2.8/contrib/pascal/example.pas@ 1115

Last change on this file since 1115 was 1096, checked in by s10k, 7 years ago

Added zlib, quazip, basicxmlsyntaxhighlighter, conditionalsemaphore and linenumberdisplay libraries. zlib and quazip are pre-compiled, but you can compile them yourself, just delete the dll files (or equivalent binary files to your OS)
File size: 15.3 KB
Line 
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.
Note: See TracBrowser for help on using the repository browser.