summaryrefslogtreecommitdiff
path: root/contrib/pascal
diff options
context:
space:
mode:
authorMark Adler <madler@alumni.caltech.edu>2011-09-09 23:22:37 -0700
committerMark Adler <madler@alumni.caltech.edu>2011-09-09 23:22:37 -0700
commit4b5a43a219d51066c01ff2ab86af18b967f2d0dd (patch)
tree4dcaf0cd18751d04cf638a9a6ec521990d4f2e90 /contrib/pascal
parent086e982175da84b3db958191031380794315f95f (diff)
downloadzlib-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.pas599
-rw-r--r--contrib/pascal/readme.txt76
-rw-r--r--contrib/pascal/zlibd32.mak93
-rw-r--r--contrib/pascal/zlibpas.pas234
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
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.
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
2This directory contains a Pascal (Delphi, Kylix) interface to the
3zlib data compression library.
4
5
6Directory listing
7=================
8
9zlibd32.mak makefile for Borland C++
10example.pas usage example of zlib
11zlibpas.pas the Pascal interface to zlib
12readme.txt this file
13
14
15Compatibility 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
48Legal issues
49============
50
51The 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
56The 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:
8LOC = -DZEXPORT=__fastcall -DZEXPORTVA=__cdecl
9
10CC = bcc32
11LD = bcc32
12AR = tlib
13# do not use "-pr" in CFLAGS
14CFLAGS = -a -d -k- -O2 $(LOC)
15LDFLAGS =
16
17
18# variables
19ZLIB_LIB = zlib.lib
20
21OBJ1 = adler32.obj compress.obj crc32.obj deflate.obj gzio.obj infback.obj
22OBJ2 = inffast.obj inflate.obj inftrees.obj trees.obj uncompr.obj zutil.obj
23OBJP1 = +adler32.obj+compress.obj+crc32.obj+deflate.obj+gzio.obj+infback.obj
24OBJP2 = +inffast.obj+inflate.obj+inftrees.obj+trees.obj+uncompr.obj+zutil.obj
25
26
27# targets
28all: $(ZLIB_LIB) example.exe minigzip.exe
29
30.c.obj:
31 $(CC) -c $(CFLAGS) $*.c
32
33adler32.obj: adler32.c zlib.h zconf.h
34
35compress.obj: compress.c zlib.h zconf.h
36
37crc32.obj: crc32.c zlib.h zconf.h crc32.h
38
39deflate.obj: deflate.c deflate.h zutil.h zlib.h zconf.h
40
41gzio.obj: gzio.c zutil.h zlib.h zconf.h
42
43infback.obj: infback.c zutil.h zlib.h zconf.h inftrees.h inflate.h \
44 inffast.h inffixed.h
45
46inffast.obj: inffast.c zutil.h zlib.h zconf.h inftrees.h inflate.h \
47 inffast.h
48
49inflate.obj: inflate.c zutil.h zlib.h zconf.h inftrees.h inflate.h \
50 inffast.h inffixed.h
51
52inftrees.obj: inftrees.c zutil.h zlib.h zconf.h inftrees.h
53
54trees.obj: trees.c zutil.h zlib.h zconf.h deflate.h trees.h
55
56uncompr.obj: uncompr.c zlib.h zconf.h
57
58zutil.obj: zutil.c zutil.h zlib.h zconf.h
59
60example.obj: example.c zlib.h zconf.h
61
62minigzip.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
74test: example.exe minigzip.exe
75 example
76 echo hello world | minigzip | minigzip -d
77
78example.exe: example.obj $(ZLIB_LIB)
79 $(LD) $(LDFLAGS) example.obj $(ZLIB_LIB)
80
81minigzip.exe: minigzip.obj $(ZLIB_LIB)
82 $(LD) $(LDFLAGS) minigzip.obj $(ZLIB_LIB)
83
84
85# cleanup
86clean:
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
8unit zlibpas;
9
10interface
11
12const
13 ZLIB_VERSION = '1.2.0';
14
15type
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 *)
49const
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 *)
83function zlibVersion: PChar;
84function deflateInit(var strm: z_stream; level: Integer): Integer;
85function deflate(var strm: z_stream; flush: Integer): Integer;
86function deflateEnd(var strm: z_stream): Integer;
87function inflateInit(var strm: z_stream): Integer;
88function inflate(var strm: z_stream; flush: Integer): Integer;
89function inflateEnd(var strm: z_stream): Integer;
90
91(* advanced functions *)
92function deflateInit2(var strm: z_stream; level, method, windowBits,
93 memLevel, strategy: Integer): Integer;
94function deflateSetDictionary(var strm: z_stream; const dictionary: PChar;
95 dictLength: Integer): Integer;
96function deflateCopy(var dest, source: z_stream): Integer;
97function deflateReset(var strm: z_stream): Integer;
98function deflateParams(var strm: z_stream; level, strategy: Integer): Integer;
99function deflateBound(var strm: z_stream; sourceLen: LongInt): LongInt;
100function inflateInit2(var strm: z_stream; windowBits: Integer): Integer;
101function inflateSetDictionary(var strm: z_stream; const dictionary: PChar;
102 dictLength: Integer): Integer;
103function inflateSync(var strm: z_stream): Integer;
104function inflateCopy(var dest, source: z_stream): Integer;
105function inflateReset(var strm: z_stream): Integer;
106function inflateBackInit(var strm: z_stream;
107 windowBits: Integer; window: PChar): Integer;
108function inflateBack(var strm: z_stream; in_fn: in_func; in_desc: Pointer;
109 out_fn: out_func; out_desc: Pointer): Integer;
110function inflateBackEnd(var strm: z_stream): Integer;
111function zlibCompileFlags: LongInt;
112
113(* utility functions *)
114function compress(dest: PChar; var destLen: LongInt;
115 const source: PChar; sourceLen: LongInt): Integer;
116function compress2(dest: PChar; var destLen: LongInt;
117 const source: PChar; sourceLen: LongInt;
118 level: Integer): Integer;
119function compressBound(sourceLen: LongInt): LongInt;
120function uncompress(dest: PChar; var destLen: LongInt;
121 const source: PChar; sourceLen: LongInt): Integer;
122
123(* checksum functions *)
124function adler32(adler: LongInt; const buf: PChar; len: Integer): LongInt;
125function crc32(crc: LongInt; const buf: PChar; len: Integer): LongInt;
126
127(* various hacks, don't look :) *)
128function deflateInit_(var strm: z_stream; level: Integer;
129 const version: PChar; stream_size: Integer): Integer;
130function inflateInit_(var strm: z_stream; const version: PChar;
131 stream_size: Integer): Integer;
132function deflateInit2_(var strm: z_stream;
133 level, method, windowBits, memLevel, strategy: Integer;
134 const version: PChar; stream_size: Integer): Integer;
135function inflateInit2_(var strm: z_stream; windowBits: Integer;
136 const version: PChar; stream_size: Integer): Integer;
137function inflateBackInit_(var strm: z_stream;
138 windowBits: Integer; window: PChar;
139 const version: PChar; stream_size: Integer): Integer;
140
141
142implementation
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
156function adler32; external;
157function compress; external;
158function compress2; external;
159function compressBound; external;
160function crc32; external;
161function deflate; external;
162function deflateBound; external;
163function deflateCopy; external;
164function deflateEnd; external;
165function deflateInit_; external;
166function deflateInit2_; external;
167function deflateParams; external;
168function deflateReset; external;
169function deflateSetDictionary; external;
170function inflate; external;
171function inflateBack; external;
172function inflateBackEnd; external;
173function inflateBackInit_; external;
174function inflateCopy; external;
175function inflateEnd; external;
176function inflateInit_; external;
177function inflateInit2_; external;
178function inflateReset; external;
179function inflateSetDictionary; external;
180function inflateSync; external;
181function uncompress; external;
182function zlibCompileFlags; external;
183function zlibVersion; external;
184
185function deflateInit(var strm: z_stream; level: Integer): Integer;
186begin
187 Result := deflateInit_(strm, level, ZLIB_VERSION, sizeof(z_stream));
188end;
189
190function deflateInit2(var strm: z_stream; level, method, windowBits, memLevel,
191 strategy: Integer): Integer;
192begin
193 Result := deflateInit2_(strm, level, method, windowBits, memLevel, strategy,
194 ZLIB_VERSION, sizeof(z_stream));
195end;
196
197function inflateInit(var strm: z_stream): Integer;
198begin
199 Result := inflateInit_(strm, ZLIB_VERSION, sizeof(z_stream));
200end;
201
202function inflateInit2(var strm: z_stream; windowBits: Integer): Integer;
203begin
204 Result := inflateInit2_(strm, windowBits, ZLIB_VERSION, sizeof(z_stream));
205end;
206
207function inflateBackInit(var strm: z_stream;
208 windowBits: Integer; window: PChar): Integer;
209begin
210 Result := inflateBackInit_(strm, windowBits, window,
211 ZLIB_VERSION, sizeof(z_stream));
212end;
213
214function _malloc(Size: Integer): Pointer; cdecl;
215begin
216 GetMem(Result, Size);
217end;
218
219procedure _free(Block: Pointer); cdecl;
220begin
221 FreeMem(Block);
222end;
223
224procedure _memset(P: Pointer; B: Byte; count: Integer); cdecl;
225begin
226 FillChar(P^, count, B);
227end;
228
229procedure _memcpy(dest, source: Pointer; count: Integer); cdecl;
230begin
231 Move(source^, dest^, count);
232end;
233
234end.