diff options
author | Mark Adler <madler@alumni.caltech.edu> | 2011-09-09 23:22:37 -0700 |
---|---|---|
committer | Mark Adler <madler@alumni.caltech.edu> | 2011-09-09 23:22:37 -0700 |
commit | 4b5a43a219d51066c01ff2ab86af18b967f2d0dd (patch) | |
tree | 4dcaf0cd18751d04cf638a9a6ec521990d4f2e90 /contrib/pascal | |
parent | 086e982175da84b3db958191031380794315f95f (diff) | |
download | zlib-1.2.0.5.tar.gz zlib-1.2.0.5.tar.bz2 zlib-1.2.0.5.zip |
zlib 1.2.0.5v1.2.0.5
Diffstat (limited to 'contrib/pascal')
-rw-r--r-- | contrib/pascal/example.pas | 599 | ||||
-rw-r--r-- | contrib/pascal/readme.txt | 76 | ||||
-rw-r--r-- | contrib/pascal/zlibd32.mak | 93 | ||||
-rw-r--r-- | contrib/pascal/zlibpas.pas | 234 |
4 files changed, 1002 insertions, 0 deletions
diff --git a/contrib/pascal/example.pas b/contrib/pascal/example.pas new file mode 100644 index 0000000..5518b36 --- /dev/null +++ b/contrib/pascal/example.pas | |||
@@ -0,0 +1,599 @@ | |||
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. | ||
diff --git a/contrib/pascal/readme.txt b/contrib/pascal/readme.txt new file mode 100644 index 0000000..60e87c8 --- /dev/null +++ b/contrib/pascal/readme.txt | |||
@@ -0,0 +1,76 @@ | |||
1 | |||
2 | This directory contains a Pascal (Delphi, Kylix) interface to the | ||
3 | zlib data compression library. | ||
4 | |||
5 | |||
6 | Directory listing | ||
7 | ================= | ||
8 | |||
9 | zlibd32.mak makefile for Borland C++ | ||
10 | example.pas usage example of zlib | ||
11 | zlibpas.pas the Pascal interface to zlib | ||
12 | readme.txt this file | ||
13 | |||
14 | |||
15 | Compatibility notes | ||
16 | =================== | ||
17 | |||
18 | - Although the name "zlib" would have been more normal for the | ||
19 | zlibpas unit, this name is already taken by Borland's ZLib unit. | ||
20 | This is somehow unfortunate, because that unit is not a genuine | ||
21 | interface to the full-fledged zlib functionality, but a suite of | ||
22 | class wrappers around zlib streams. Other essential features, | ||
23 | such as checksums, are missing. | ||
24 | It would have been more appropriate for that unit to have a name | ||
25 | like "ZStreams", or something similar. | ||
26 | |||
27 | - The C and zlib-supplied types int, uInt, long, uLong, etc. are | ||
28 | translated directly into Pascal types of similar sizes (Integer, | ||
29 | LongInt, etc.), to avoid namespace pollution. In particular, | ||
30 | there is no conversion of unsigned int into a Pascal unsigned | ||
31 | integer. The Word type is non-portable and has the same size | ||
32 | (16 bits) both in a 16-bit and in a 32-bit environment, unlike | ||
33 | Integer. Even if there is a 32-bit Cardinal type, there is no | ||
34 | real need for unsigned int in zlib under a 32-bit environment. | ||
35 | |||
36 | - Except for the callbacks, the zlib function interfaces are | ||
37 | assuming the calling convention normally used in Pascal | ||
38 | (__pascal for DOS and Windows16, __fastcall for Windows32). | ||
39 | Since the cdecl keyword is used, the old Turbo Pascal does | ||
40 | not work with this interface. | ||
41 | |||
42 | - The gz* function interfaces are not translated, to avoid | ||
43 | interfacing problems with the C runtime library. Besides, | ||
44 | gzprintf(gzFile file, const char *format, ...) | ||
45 | cannot be translated into Pascal. | ||
46 | |||
47 | |||
48 | Legal issues | ||
49 | ============ | ||
50 | |||
51 | The zlibpas interface is: | ||
52 | Copyright (C) 1995-2003 Jean-loup Gailly and Mark Adler. | ||
53 | Copyright (C) 1998 by Bob Dellaca. | ||
54 | Copyright (C) 2003 by Cosmin Truta. | ||
55 | |||
56 | The example program is: | ||
57 | Copyright (C) 1995-2003 by Jean-loup Gailly. | ||
58 | Copyright (C) 1998,1999,2000 by Jacques Nomssi Nzali. | ||
59 | Copyright (C) 2003 by Cosmin Truta. | ||
60 | |||
61 | This software is provided 'as-is', without any express or implied | ||
62 | warranty. In no event will the author be held liable for any damages | ||
63 | arising from the use of this software. | ||
64 | |||
65 | Permission is granted to anyone to use this software for any purpose, | ||
66 | including commercial applications, and to alter it and redistribute it | ||
67 | freely, subject to the following restrictions: | ||
68 | |||
69 | 1. The origin of this software must not be misrepresented; you must not | ||
70 | claim that you wrote the original software. If you use this software | ||
71 | in a product, an acknowledgment in the product documentation would be | ||
72 | appreciated but is not required. | ||
73 | 2. Altered source versions must be plainly marked as such, and must not be | ||
74 | misrepresented as being the original software. | ||
75 | 3. This notice may not be removed or altered from any source distribution. | ||
76 | |||
diff --git a/contrib/pascal/zlibd32.mak b/contrib/pascal/zlibd32.mak new file mode 100644 index 0000000..88fafa0 --- /dev/null +++ b/contrib/pascal/zlibd32.mak | |||
@@ -0,0 +1,93 @@ | |||
1 | # Makefile for zlib | ||
2 | # For use with Delphi and C++ Builder under Win32 | ||
3 | # Updated for zlib 1.2.x by Cosmin Truta | ||
4 | |||
5 | # ------------ Borland C++ ------------ | ||
6 | |||
7 | # This project uses the Delphi (fastcall/register) calling convention: | ||
8 | LOC = -DZEXPORT=__fastcall -DZEXPORTVA=__cdecl | ||
9 | |||
10 | CC = bcc32 | ||
11 | LD = bcc32 | ||
12 | AR = tlib | ||
13 | # do not use "-pr" in CFLAGS | ||
14 | CFLAGS = -a -d -k- -O2 $(LOC) | ||
15 | LDFLAGS = | ||
16 | |||
17 | |||
18 | # variables | ||
19 | ZLIB_LIB = zlib.lib | ||
20 | |||
21 | OBJ1 = adler32.obj compress.obj crc32.obj deflate.obj gzio.obj infback.obj | ||
22 | OBJ2 = inffast.obj inflate.obj inftrees.obj trees.obj uncompr.obj zutil.obj | ||
23 | OBJP1 = +adler32.obj+compress.obj+crc32.obj+deflate.obj+gzio.obj+infback.obj | ||
24 | OBJP2 = +inffast.obj+inflate.obj+inftrees.obj+trees.obj+uncompr.obj+zutil.obj | ||
25 | |||
26 | |||
27 | # targets | ||
28 | all: $(ZLIB_LIB) example.exe minigzip.exe | ||
29 | |||
30 | .c.obj: | ||
31 | $(CC) -c $(CFLAGS) $*.c | ||
32 | |||
33 | adler32.obj: adler32.c zlib.h zconf.h | ||
34 | |||
35 | compress.obj: compress.c zlib.h zconf.h | ||
36 | |||
37 | crc32.obj: crc32.c zlib.h zconf.h crc32.h | ||
38 | |||
39 | deflate.obj: deflate.c deflate.h zutil.h zlib.h zconf.h | ||
40 | |||
41 | gzio.obj: gzio.c zutil.h zlib.h zconf.h | ||
42 | |||
43 | infback.obj: infback.c zutil.h zlib.h zconf.h inftrees.h inflate.h \ | ||
44 | inffast.h inffixed.h | ||
45 | |||
46 | inffast.obj: inffast.c zutil.h zlib.h zconf.h inftrees.h inflate.h \ | ||
47 | inffast.h | ||
48 | |||
49 | inflate.obj: inflate.c zutil.h zlib.h zconf.h inftrees.h inflate.h \ | ||
50 | inffast.h inffixed.h | ||
51 | |||
52 | inftrees.obj: inftrees.c zutil.h zlib.h zconf.h inftrees.h | ||
53 | |||
54 | trees.obj: trees.c zutil.h zlib.h zconf.h deflate.h trees.h | ||
55 | |||
56 | uncompr.obj: uncompr.c zlib.h zconf.h | ||
57 | |||
58 | zutil.obj: zutil.c zutil.h zlib.h zconf.h | ||
59 | |||
60 | example.obj: example.c zlib.h zconf.h | ||
61 | |||
62 | minigzip.obj: minigzip.c zlib.h zconf.h | ||
63 | |||
64 | |||
65 | # For the sake of the old Borland make, | ||
66 | # the command line is cut to fit in the MS-DOS 128 byte limit: | ||
67 | $(ZLIB_LIB): $(OBJ1) $(OBJ2) | ||
68 | -del $(ZLIB_LIB) | ||
69 | $(AR) $(ZLIB_LIB) $(OBJP1) | ||
70 | $(AR) $(ZLIB_LIB) $(OBJP2) | ||
71 | |||
72 | |||
73 | # testing | ||
74 | test: example.exe minigzip.exe | ||
75 | example | ||
76 | echo hello world | minigzip | minigzip -d | ||
77 | |||
78 | example.exe: example.obj $(ZLIB_LIB) | ||
79 | $(LD) $(LDFLAGS) example.obj $(ZLIB_LIB) | ||
80 | |||
81 | minigzip.exe: minigzip.obj $(ZLIB_LIB) | ||
82 | $(LD) $(LDFLAGS) minigzip.obj $(ZLIB_LIB) | ||
83 | |||
84 | |||
85 | # cleanup | ||
86 | clean: | ||
87 | -del *.obj | ||
88 | -del *.exe | ||
89 | -del *.lib | ||
90 | -del *.tds | ||
91 | -del zlib.bak | ||
92 | -del foo.gz | ||
93 | |||
diff --git a/contrib/pascal/zlibpas.pas b/contrib/pascal/zlibpas.pas new file mode 100644 index 0000000..f81893f --- /dev/null +++ b/contrib/pascal/zlibpas.pas | |||
@@ -0,0 +1,234 @@ | |||
1 | (* zlibpas -- Pascal interface to the zlib data compression library | ||
2 | * | ||
3 | * Copyright (C) 2003 Cosmin Truta. | ||
4 | * Derived from original sources by Bob Dellaca. | ||
5 | * For conditions of distribution and use, see copyright notice in readme.txt | ||
6 | *) | ||
7 | |||
8 | unit zlibpas; | ||
9 | |||
10 | interface | ||
11 | |||
12 | const | ||
13 | ZLIB_VERSION = '1.2.0'; | ||
14 | |||
15 | type | ||
16 | alloc_func = function(opaque: Pointer; items, size: Integer): Pointer; | ||
17 | cdecl; | ||
18 | free_func = procedure(opaque, address: Pointer); | ||
19 | cdecl; | ||
20 | |||
21 | in_func = function(opaque: Pointer; var buf: PByte): Integer; | ||
22 | cdecl; | ||
23 | out_func = function(opaque: Pointer; buf: PByte; size: Integer): Integer; | ||
24 | cdecl; | ||
25 | |||
26 | z_streamp = ^z_stream; | ||
27 | z_stream = packed record | ||
28 | next_in: PChar; (* next input byte *) | ||
29 | avail_in: Integer; (* number of bytes available at next_in *) | ||
30 | total_in: LongInt; (* total nb of input bytes read so far *) | ||
31 | |||
32 | next_out: PChar; (* next output byte should be put there *) | ||
33 | avail_out: Integer; (* remaining free space at next_out *) | ||
34 | total_out: LongInt; (* total nb of bytes output so far *) | ||
35 | |||
36 | msg: PChar; (* last error message, NULL if no error *) | ||
37 | state: Pointer; (* not visible by applications *) | ||
38 | |||
39 | zalloc: alloc_func; (* used to allocate the internal state *) | ||
40 | zfree: free_func; (* used to free the internal state *) | ||
41 | opaque: Pointer; (* private data object passed to zalloc and zfree *) | ||
42 | |||
43 | data_type: Integer; (* best guess about the data type: ascii or binary *) | ||
44 | adler: LongInt; (* adler32 value of the uncompressed data *) | ||
45 | reserved: LongInt; (* reserved for future use *) | ||
46 | end; | ||
47 | |||
48 | (* constants *) | ||
49 | const | ||
50 | Z_NO_FLUSH = 0; | ||
51 | Z_PARTIAL_FLUSH = 1; | ||
52 | Z_SYNC_FLUSH = 2; | ||
53 | Z_FULL_FLUSH = 3; | ||
54 | Z_FINISH = 4; | ||
55 | |||
56 | Z_OK = 0; | ||
57 | Z_STREAM_END = 1; | ||
58 | Z_NEED_DICT = 2; | ||
59 | Z_ERRNO = -1; | ||
60 | Z_STREAM_ERROR = -2; | ||
61 | Z_DATA_ERROR = -3; | ||
62 | Z_MEM_ERROR = -4; | ||
63 | Z_BUF_ERROR = -5; | ||
64 | Z_VERSION_ERROR = -6; | ||
65 | |||
66 | Z_NO_COMPRESSION = 0; | ||
67 | Z_BEST_SPEED = 1; | ||
68 | Z_BEST_COMPRESSION = 9; | ||
69 | Z_DEFAULT_COMPRESSION = -1; | ||
70 | |||
71 | Z_FILTERED = 1; | ||
72 | Z_HUFFMAN_ONLY = 2; | ||
73 | Z_RLE = 3; | ||
74 | Z_DEFAULT_STRATEGY = 0; | ||
75 | |||
76 | Z_BINARY = 0; | ||
77 | Z_ASCII = 1; | ||
78 | Z_UNKNOWN = 2; | ||
79 | |||
80 | Z_DEFLATED = 8; | ||
81 | |||
82 | (* basic functions *) | ||
83 | function zlibVersion: PChar; | ||
84 | function deflateInit(var strm: z_stream; level: Integer): Integer; | ||
85 | function deflate(var strm: z_stream; flush: Integer): Integer; | ||
86 | function deflateEnd(var strm: z_stream): Integer; | ||
87 | function inflateInit(var strm: z_stream): Integer; | ||
88 | function inflate(var strm: z_stream; flush: Integer): Integer; | ||
89 | function inflateEnd(var strm: z_stream): Integer; | ||
90 | |||
91 | (* advanced functions *) | ||
92 | function deflateInit2(var strm: z_stream; level, method, windowBits, | ||
93 | memLevel, strategy: Integer): Integer; | ||
94 | function deflateSetDictionary(var strm: z_stream; const dictionary: PChar; | ||
95 | dictLength: Integer): Integer; | ||
96 | function deflateCopy(var dest, source: z_stream): Integer; | ||
97 | function deflateReset(var strm: z_stream): Integer; | ||
98 | function deflateParams(var strm: z_stream; level, strategy: Integer): Integer; | ||
99 | function deflateBound(var strm: z_stream; sourceLen: LongInt): LongInt; | ||
100 | function inflateInit2(var strm: z_stream; windowBits: Integer): Integer; | ||
101 | function inflateSetDictionary(var strm: z_stream; const dictionary: PChar; | ||
102 | dictLength: Integer): Integer; | ||
103 | function inflateSync(var strm: z_stream): Integer; | ||
104 | function inflateCopy(var dest, source: z_stream): Integer; | ||
105 | function inflateReset(var strm: z_stream): Integer; | ||
106 | function inflateBackInit(var strm: z_stream; | ||
107 | windowBits: Integer; window: PChar): Integer; | ||
108 | function inflateBack(var strm: z_stream; in_fn: in_func; in_desc: Pointer; | ||
109 | out_fn: out_func; out_desc: Pointer): Integer; | ||
110 | function inflateBackEnd(var strm: z_stream): Integer; | ||
111 | function zlibCompileFlags: LongInt; | ||
112 | |||
113 | (* utility functions *) | ||
114 | function compress(dest: PChar; var destLen: LongInt; | ||
115 | const source: PChar; sourceLen: LongInt): Integer; | ||
116 | function compress2(dest: PChar; var destLen: LongInt; | ||
117 | const source: PChar; sourceLen: LongInt; | ||
118 | level: Integer): Integer; | ||
119 | function compressBound(sourceLen: LongInt): LongInt; | ||
120 | function uncompress(dest: PChar; var destLen: LongInt; | ||
121 | const source: PChar; sourceLen: LongInt): Integer; | ||
122 | |||
123 | (* checksum functions *) | ||
124 | function adler32(adler: LongInt; const buf: PChar; len: Integer): LongInt; | ||
125 | function crc32(crc: LongInt; const buf: PChar; len: Integer): LongInt; | ||
126 | |||
127 | (* various hacks, don't look :) *) | ||
128 | function deflateInit_(var strm: z_stream; level: Integer; | ||
129 | const version: PChar; stream_size: Integer): Integer; | ||
130 | function inflateInit_(var strm: z_stream; const version: PChar; | ||
131 | stream_size: Integer): Integer; | ||
132 | function deflateInit2_(var strm: z_stream; | ||
133 | level, method, windowBits, memLevel, strategy: Integer; | ||
134 | const version: PChar; stream_size: Integer): Integer; | ||
135 | function inflateInit2_(var strm: z_stream; windowBits: Integer; | ||
136 | const version: PChar; stream_size: Integer): Integer; | ||
137 | function inflateBackInit_(var strm: z_stream; | ||
138 | windowBits: Integer; window: PChar; | ||
139 | const version: PChar; stream_size: Integer): Integer; | ||
140 | |||
141 | |||
142 | implementation | ||
143 | |||
144 | {$L adler32.obj} | ||
145 | {$L compress.obj} | ||
146 | {$L crc32.obj} | ||
147 | {$L deflate.obj} | ||
148 | {$L infback.obj} | ||
149 | {$L inffast.obj} | ||
150 | {$L inflate.obj} | ||
151 | {$L inftrees.obj} | ||
152 | {$L trees.obj} | ||
153 | {$L uncompr.obj} | ||
154 | {$L zutil.obj} | ||
155 | |||
156 | function adler32; external; | ||
157 | function compress; external; | ||
158 | function compress2; external; | ||
159 | function compressBound; external; | ||
160 | function crc32; external; | ||
161 | function deflate; external; | ||
162 | function deflateBound; external; | ||
163 | function deflateCopy; external; | ||
164 | function deflateEnd; external; | ||
165 | function deflateInit_; external; | ||
166 | function deflateInit2_; external; | ||
167 | function deflateParams; external; | ||
168 | function deflateReset; external; | ||
169 | function deflateSetDictionary; external; | ||
170 | function inflate; external; | ||
171 | function inflateBack; external; | ||
172 | function inflateBackEnd; external; | ||
173 | function inflateBackInit_; external; | ||
174 | function inflateCopy; external; | ||
175 | function inflateEnd; external; | ||
176 | function inflateInit_; external; | ||
177 | function inflateInit2_; external; | ||
178 | function inflateReset; external; | ||
179 | function inflateSetDictionary; external; | ||
180 | function inflateSync; external; | ||
181 | function uncompress; external; | ||
182 | function zlibCompileFlags; external; | ||
183 | function zlibVersion; external; | ||
184 | |||
185 | function deflateInit(var strm: z_stream; level: Integer): Integer; | ||
186 | begin | ||
187 | Result := deflateInit_(strm, level, ZLIB_VERSION, sizeof(z_stream)); | ||
188 | end; | ||
189 | |||
190 | function deflateInit2(var strm: z_stream; level, method, windowBits, memLevel, | ||
191 | strategy: Integer): Integer; | ||
192 | begin | ||
193 | Result := deflateInit2_(strm, level, method, windowBits, memLevel, strategy, | ||
194 | ZLIB_VERSION, sizeof(z_stream)); | ||
195 | end; | ||
196 | |||
197 | function inflateInit(var strm: z_stream): Integer; | ||
198 | begin | ||
199 | Result := inflateInit_(strm, ZLIB_VERSION, sizeof(z_stream)); | ||
200 | end; | ||
201 | |||
202 | function inflateInit2(var strm: z_stream; windowBits: Integer): Integer; | ||
203 | begin | ||
204 | Result := inflateInit2_(strm, windowBits, ZLIB_VERSION, sizeof(z_stream)); | ||
205 | end; | ||
206 | |||
207 | function inflateBackInit(var strm: z_stream; | ||
208 | windowBits: Integer; window: PChar): Integer; | ||
209 | begin | ||
210 | Result := inflateBackInit_(strm, windowBits, window, | ||
211 | ZLIB_VERSION, sizeof(z_stream)); | ||
212 | end; | ||
213 | |||
214 | function _malloc(Size: Integer): Pointer; cdecl; | ||
215 | begin | ||
216 | GetMem(Result, Size); | ||
217 | end; | ||
218 | |||
219 | procedure _free(Block: Pointer); cdecl; | ||
220 | begin | ||
221 | FreeMem(Block); | ||
222 | end; | ||
223 | |||
224 | procedure _memset(P: Pointer; B: Byte; count: Integer); cdecl; | ||
225 | begin | ||
226 | FillChar(P^, count, B); | ||
227 | end; | ||
228 | |||
229 | procedure _memcpy(dest, source: Pointer; count: Integer); cdecl; | ||
230 | begin | ||
231 | Move(source^, dest^, count); | ||
232 | end; | ||
233 | |||
234 | end. | ||