diff options
author | marha <marha@users.sourceforge.net> | 2009-06-28 22:07:26 +0000 |
---|---|---|
committer | marha <marha@users.sourceforge.net> | 2009-06-28 22:07:26 +0000 |
commit | 3562e78743202e43aec8727005182a2558117eca (patch) | |
tree | 8f9113a77d12470c5c851a2a8e4cb02e89df7d43 /zlib/contrib/pascal | |
download | vcxsrv-3562e78743202e43aec8727005182a2558117eca.tar.gz vcxsrv-3562e78743202e43aec8727005182a2558117eca.tar.bz2 vcxsrv-3562e78743202e43aec8727005182a2558117eca.zip |
Checked in the following released items:
xkeyboard-config-1.4.tar.gz
ttf-bitstream-vera-1.10.tar.gz
font-alias-1.0.1.tar.gz
font-sun-misc-1.0.0.tar.gz
font-sun-misc-1.0.0.tar.gz
font-sony-misc-1.0.0.tar.gz
font-schumacher-misc-1.0.0.tar.gz
font-mutt-misc-1.0.0.tar.gz
font-misc-misc-1.0.0.tar.gz
font-misc-meltho-1.0.0.tar.gz
font-micro-misc-1.0.0.tar.gz
font-jis-misc-1.0.0.tar.gz
font-isas-misc-1.0.0.tar.gz
font-dec-misc-1.0.0.tar.gz
font-daewoo-misc-1.0.0.tar.gz
font-cursor-misc-1.0.0.tar.gz
font-arabic-misc-1.0.0.tar.gz
font-winitzki-cyrillic-1.0.0.tar.gz
font-misc-cyrillic-1.0.0.tar.gz
font-cronyx-cyrillic-1.0.0.tar.gz
font-screen-cyrillic-1.0.1.tar.gz
font-xfree86-type1-1.0.1.tar.gz
font-adobe-utopia-type1-1.0.1.tar.gz
font-ibm-type1-1.0.0.tar.gz
font-bitstream-type1-1.0.0.tar.gz
font-bitstream-speedo-1.0.0.tar.gz
font-bh-ttf-1.0.0.tar.gz
font-bh-type1-1.0.0.tar.gz
font-bitstream-100dpi-1.0.0.tar.gz
font-bh-lucidatypewriter-100dpi-1.0.0.tar.gz
font-bh-100dpi-1.0.0.tar.gz
font-adobe-utopia-100dpi-1.0.1.tar.gz
font-adobe-100dpi-1.0.0.tar.gz
font-util-1.0.1.tar.gz
font-bitstream-75dpi-1.0.0.tar.gz
font-bh-lucidatypewriter-75dpi-1.0.0.tar.gz
font-adobe-utopia-75dpi-1.0.1.tar.gz
font-bh-75dpi-1.0.0.tar.gz
bdftopcf-1.0.1.tar.gz
font-adobe-75dpi-1.0.0.tar.gz
mkfontscale-1.0.6.tar.gz
openssl-0.9.8k.tar.gz
bigreqsproto-1.0.2.tar.gz
xtrans-1.2.2.tar.gz
resourceproto-1.0.2.tar.gz
inputproto-1.4.4.tar.gz
compositeproto-0.4.tar.gz
damageproto-1.1.0.tar.gz
zlib-1.2.3.tar.gz
xkbcomp-1.0.5.tar.gz
freetype-2.3.9.tar.gz
pthreads-w32-2-8-0-release.tar.gz
pixman-0.12.0.tar.gz
kbproto-1.0.3.tar.gz
evieext-1.0.2.tar.gz
fixesproto-4.0.tar.gz
recordproto-1.13.2.tar.gz
randrproto-1.2.2.tar.gz
scrnsaverproto-1.1.0.tar.gz
renderproto-0.9.3.tar.gz
xcmiscproto-1.1.2.tar.gz
fontsproto-2.0.2.tar.gz
xextproto-7.0.3.tar.gz
xproto-7.0.14.tar.gz
libXdmcp-1.0.2.tar.gz
libxkbfile-1.0.5.tar.gz
libfontenc-1.0.4.tar.gz
libXfont-1.3.4.tar.gz
libX11-1.1.5.tar.gz
libXau-1.0.4.tar.gz
libxcb-1.1.tar.gz
xorg-server-1.5.3.tar.gz
Diffstat (limited to 'zlib/contrib/pascal')
-rw-r--r-- | zlib/contrib/pascal/example.pas | 599 | ||||
-rw-r--r-- | zlib/contrib/pascal/readme.txt | 76 | ||||
-rw-r--r-- | zlib/contrib/pascal/zlibd32.mak | 93 | ||||
-rw-r--r-- | zlib/contrib/pascal/zlibpas.pas | 236 |
4 files changed, 1004 insertions, 0 deletions
diff --git a/zlib/contrib/pascal/example.pas b/zlib/contrib/pascal/example.pas new file mode 100644 index 000000000..5518b36a7 --- /dev/null +++ b/zlib/contrib/pascal/example.pas @@ -0,0 +1,599 @@ +(* example.c -- usage example of the zlib compression library + * Copyright (C) 1995-2003 Jean-loup Gailly. + * For conditions of distribution and use, see copyright notice in zlib.h + * + * Pascal translation + * Copyright (C) 1998 by Jacques Nomssi Nzali. + * For conditions of distribution and use, see copyright notice in readme.txt + * + * Adaptation to the zlibpas interface + * Copyright (C) 2003 by Cosmin Truta. + * For conditions of distribution and use, see copyright notice in readme.txt + *) + +program example; + +{$DEFINE TEST_COMPRESS} +{DO NOT $DEFINE TEST_GZIO} +{$DEFINE TEST_DEFLATE} +{$DEFINE TEST_INFLATE} +{$DEFINE TEST_FLUSH} +{$DEFINE TEST_SYNC} +{$DEFINE TEST_DICT} + +uses SysUtils, zlibpas; + +const TESTFILE = 'foo.gz'; + +(* "hello world" would be more standard, but the repeated "hello" + * stresses the compression code better, sorry... + *) +const hello: PChar = 'hello, hello!'; + +const dictionary: PChar = 'hello'; + +var dictId: LongInt; (* Adler32 value of the dictionary *) + +procedure CHECK_ERR(err: Integer; msg: String); +begin + if err <> Z_OK then + begin + WriteLn(msg, ' error: ', err); + Halt(1); + end; +end; + +procedure EXIT_ERR(const msg: String); +begin + WriteLn('Error: ', msg); + Halt(1); +end; + +(* =========================================================================== + * Test compress and uncompress + *) +{$IFDEF TEST_COMPRESS} +procedure test_compress(compr: Pointer; comprLen: LongInt; + uncompr: Pointer; uncomprLen: LongInt); +var err: Integer; + len: LongInt; +begin + len := StrLen(hello)+1; + + err := compress(compr, comprLen, hello, len); + CHECK_ERR(err, 'compress'); + + StrCopy(PChar(uncompr), 'garbage'); + + err := uncompress(uncompr, uncomprLen, compr, comprLen); + CHECK_ERR(err, 'uncompress'); + + if StrComp(PChar(uncompr), hello) <> 0 then + EXIT_ERR('bad uncompress') + else + WriteLn('uncompress(): ', PChar(uncompr)); +end; +{$ENDIF} + +(* =========================================================================== + * Test read/write of .gz files + *) +{$IFDEF TEST_GZIO} +procedure test_gzio(const fname: PChar; (* compressed file name *) + uncompr: Pointer; + uncomprLen: LongInt); +var err: Integer; + len: Integer; + zfile: gzFile; + pos: LongInt; +begin + len := StrLen(hello)+1; + + zfile := gzopen(fname, 'wb'); + if zfile = NIL then + begin + WriteLn('gzopen error'); + Halt(1); + end; + gzputc(zfile, 'h'); + if gzputs(zfile, 'ello') <> 4 then + begin + WriteLn('gzputs err: ', gzerror(zfile, err)); + Halt(1); + end; + {$IFDEF GZ_FORMAT_STRING} + if gzprintf(zfile, ', %s!', 'hello') <> 8 then + begin + WriteLn('gzprintf err: ', gzerror(zfile, err)); + Halt(1); + end; + {$ELSE} + if gzputs(zfile, ', hello!') <> 8 then + begin + WriteLn('gzputs err: ', gzerror(zfile, err)); + Halt(1); + end; + {$ENDIF} + gzseek(zfile, 1, SEEK_CUR); (* add one zero byte *) + gzclose(zfile); + + zfile := gzopen(fname, 'rb'); + if zfile = NIL then + begin + WriteLn('gzopen error'); + Halt(1); + end; + + StrCopy(PChar(uncompr), 'garbage'); + + if gzread(zfile, uncompr, uncomprLen) <> len then + begin + WriteLn('gzread err: ', gzerror(zfile, err)); + Halt(1); + end; + if StrComp(PChar(uncompr), hello) <> 0 then + begin + WriteLn('bad gzread: ', PChar(uncompr)); + Halt(1); + end + else + WriteLn('gzread(): ', PChar(uncompr)); + + pos := gzseek(zfile, -8, SEEK_CUR); + if (pos <> 6) or (gztell(zfile) <> pos) then + begin + WriteLn('gzseek error, pos=', pos, ', gztell=', gztell(zfile)); + Halt(1); + end; + + if gzgetc(zfile) <> ' ' then + begin + WriteLn('gzgetc error'); + Halt(1); + end; + + if gzungetc(' ', zfile) <> ' ' then + begin + WriteLn('gzungetc error'); + Halt(1); + end; + + gzgets(zfile, PChar(uncompr), uncomprLen); + uncomprLen := StrLen(PChar(uncompr)); + if uncomprLen <> 7 then (* " hello!" *) + begin + WriteLn('gzgets err after gzseek: ', gzerror(zfile, err)); + Halt(1); + end; + if StrComp(PChar(uncompr), hello + 6) <> 0 then + begin + WriteLn('bad gzgets after gzseek'); + Halt(1); + end + else + WriteLn('gzgets() after gzseek: ', PChar(uncompr)); + + gzclose(zfile); +end; +{$ENDIF} + +(* =========================================================================== + * Test deflate with small buffers + *) +{$IFDEF TEST_DEFLATE} +procedure test_deflate(compr: Pointer; comprLen: LongInt); +var c_stream: z_stream; (* compression stream *) + err: Integer; + len: LongInt; +begin + len := StrLen(hello)+1; + + c_stream.zalloc := NIL; + c_stream.zfree := NIL; + c_stream.opaque := NIL; + + err := deflateInit(c_stream, Z_DEFAULT_COMPRESSION); + CHECK_ERR(err, 'deflateInit'); + + c_stream.next_in := hello; + c_stream.next_out := compr; + + while (c_stream.total_in <> len) and + (c_stream.total_out < comprLen) do + begin + c_stream.avail_out := 1; { force small buffers } + c_stream.avail_in := 1; + err := deflate(c_stream, Z_NO_FLUSH); + CHECK_ERR(err, 'deflate'); + end; + + (* Finish the stream, still forcing small buffers: *) + while TRUE do + begin + c_stream.avail_out := 1; + err := deflate(c_stream, Z_FINISH); + if err = Z_STREAM_END then + break; + CHECK_ERR(err, 'deflate'); + end; + + err := deflateEnd(c_stream); + CHECK_ERR(err, 'deflateEnd'); +end; +{$ENDIF} + +(* =========================================================================== + * Test inflate with small buffers + *) +{$IFDEF TEST_INFLATE} +procedure test_inflate(compr: Pointer; comprLen : LongInt; + uncompr: Pointer; uncomprLen : LongInt); +var err: Integer; + d_stream: z_stream; (* decompression stream *) +begin + StrCopy(PChar(uncompr), 'garbage'); + + d_stream.zalloc := NIL; + d_stream.zfree := NIL; + d_stream.opaque := NIL; + + d_stream.next_in := compr; + d_stream.avail_in := 0; + d_stream.next_out := uncompr; + + err := inflateInit(d_stream); + CHECK_ERR(err, 'inflateInit'); + + while (d_stream.total_out < uncomprLen) and + (d_stream.total_in < comprLen) do + begin + d_stream.avail_out := 1; (* force small buffers *) + d_stream.avail_in := 1; + err := inflate(d_stream, Z_NO_FLUSH); + if err = Z_STREAM_END then + break; + CHECK_ERR(err, 'inflate'); + end; + + err := inflateEnd(d_stream); + CHECK_ERR(err, 'inflateEnd'); + + if StrComp(PChar(uncompr), hello) <> 0 then + EXIT_ERR('bad inflate') + else + WriteLn('inflate(): ', PChar(uncompr)); +end; +{$ENDIF} + +(* =========================================================================== + * Test deflate with large buffers and dynamic change of compression level + *) +{$IFDEF TEST_DEFLATE} +procedure test_large_deflate(compr: Pointer; comprLen: LongInt; + uncompr: Pointer; uncomprLen: LongInt); +var c_stream: z_stream; (* compression stream *) + err: Integer; +begin + c_stream.zalloc := NIL; + c_stream.zfree := NIL; + c_stream.opaque := NIL; + + err := deflateInit(c_stream, Z_BEST_SPEED); + CHECK_ERR(err, 'deflateInit'); + + c_stream.next_out := compr; + c_stream.avail_out := Integer(comprLen); + + (* At this point, uncompr is still mostly zeroes, so it should compress + * very well: + *) + c_stream.next_in := uncompr; + c_stream.avail_in := Integer(uncomprLen); + err := deflate(c_stream, Z_NO_FLUSH); + CHECK_ERR(err, 'deflate'); + if c_stream.avail_in <> 0 then + EXIT_ERR('deflate not greedy'); + + (* Feed in already compressed data and switch to no compression: *) + deflateParams(c_stream, Z_NO_COMPRESSION, Z_DEFAULT_STRATEGY); + c_stream.next_in := compr; + c_stream.avail_in := Integer(comprLen div 2); + err := deflate(c_stream, Z_NO_FLUSH); + CHECK_ERR(err, 'deflate'); + + (* Switch back to compressing mode: *) + deflateParams(c_stream, Z_BEST_COMPRESSION, Z_FILTERED); + c_stream.next_in := uncompr; + c_stream.avail_in := Integer(uncomprLen); + err := deflate(c_stream, Z_NO_FLUSH); + CHECK_ERR(err, 'deflate'); + + err := deflate(c_stream, Z_FINISH); + if err <> Z_STREAM_END then + EXIT_ERR('deflate should report Z_STREAM_END'); + + err := deflateEnd(c_stream); + CHECK_ERR(err, 'deflateEnd'); +end; +{$ENDIF} + +(* =========================================================================== + * Test inflate with large buffers + *) +{$IFDEF TEST_INFLATE} +procedure test_large_inflate(compr: Pointer; comprLen: LongInt; + uncompr: Pointer; uncomprLen: LongInt); +var err: Integer; + d_stream: z_stream; (* decompression stream *) +begin + StrCopy(PChar(uncompr), 'garbage'); + + d_stream.zalloc := NIL; + d_stream.zfree := NIL; + d_stream.opaque := NIL; + + d_stream.next_in := compr; + d_stream.avail_in := Integer(comprLen); + + err := inflateInit(d_stream); + CHECK_ERR(err, 'inflateInit'); + + while TRUE do + begin + d_stream.next_out := uncompr; (* discard the output *) + d_stream.avail_out := Integer(uncomprLen); + err := inflate(d_stream, Z_NO_FLUSH); + if err = Z_STREAM_END then + break; + CHECK_ERR(err, 'large inflate'); + end; + + err := inflateEnd(d_stream); + CHECK_ERR(err, 'inflateEnd'); + + if d_stream.total_out <> 2 * uncomprLen + comprLen div 2 then + begin + WriteLn('bad large inflate: ', d_stream.total_out); + Halt(1); + end + else + WriteLn('large_inflate(): OK'); +end; +{$ENDIF} + +(* =========================================================================== + * Test deflate with full flush + *) +{$IFDEF TEST_FLUSH} +procedure test_flush(compr: Pointer; var comprLen : LongInt); +var c_stream: z_stream; (* compression stream *) + err: Integer; + len: Integer; +begin + len := StrLen(hello)+1; + + c_stream.zalloc := NIL; + c_stream.zfree := NIL; + c_stream.opaque := NIL; + + err := deflateInit(c_stream, Z_DEFAULT_COMPRESSION); + CHECK_ERR(err, 'deflateInit'); + + c_stream.next_in := hello; + c_stream.next_out := compr; + c_stream.avail_in := 3; + c_stream.avail_out := Integer(comprLen); + err := deflate(c_stream, Z_FULL_FLUSH); + CHECK_ERR(err, 'deflate'); + + Inc(PByteArray(compr)^[3]); (* force an error in first compressed block *) + c_stream.avail_in := len - 3; + + err := deflate(c_stream, Z_FINISH); + if err <> Z_STREAM_END then + CHECK_ERR(err, 'deflate'); + + err := deflateEnd(c_stream); + CHECK_ERR(err, 'deflateEnd'); + + comprLen := c_stream.total_out; +end; +{$ENDIF} + +(* =========================================================================== + * Test inflateSync() + *) +{$IFDEF TEST_SYNC} +procedure test_sync(compr: Pointer; comprLen: LongInt; + uncompr: Pointer; uncomprLen : LongInt); +var err: Integer; + d_stream: z_stream; (* decompression stream *) +begin + StrCopy(PChar(uncompr), 'garbage'); + + d_stream.zalloc := NIL; + d_stream.zfree := NIL; + d_stream.opaque := NIL; + + d_stream.next_in := compr; + d_stream.avail_in := 2; (* just read the zlib header *) + + err := inflateInit(d_stream); + CHECK_ERR(err, 'inflateInit'); + + d_stream.next_out := uncompr; + d_stream.avail_out := Integer(uncomprLen); + + inflate(d_stream, Z_NO_FLUSH); + CHECK_ERR(err, 'inflate'); + + d_stream.avail_in := Integer(comprLen-2); (* read all compressed data *) + err := inflateSync(d_stream); (* but skip the damaged part *) + CHECK_ERR(err, 'inflateSync'); + + err := inflate(d_stream, Z_FINISH); + if err <> Z_DATA_ERROR then + EXIT_ERR('inflate should report DATA_ERROR'); + (* Because of incorrect adler32 *) + + err := inflateEnd(d_stream); + CHECK_ERR(err, 'inflateEnd'); + + WriteLn('after inflateSync(): hel', PChar(uncompr)); +end; +{$ENDIF} + +(* =========================================================================== + * Test deflate with preset dictionary + *) +{$IFDEF TEST_DICT} +procedure test_dict_deflate(compr: Pointer; comprLen: LongInt); +var c_stream: z_stream; (* compression stream *) + err: Integer; +begin + c_stream.zalloc := NIL; + c_stream.zfree := NIL; + c_stream.opaque := NIL; + + err := deflateInit(c_stream, Z_BEST_COMPRESSION); + CHECK_ERR(err, 'deflateInit'); + + err := deflateSetDictionary(c_stream, dictionary, StrLen(dictionary)); + CHECK_ERR(err, 'deflateSetDictionary'); + + dictId := c_stream.adler; + c_stream.next_out := compr; + c_stream.avail_out := Integer(comprLen); + + c_stream.next_in := hello; + c_stream.avail_in := StrLen(hello)+1; + + err := deflate(c_stream, Z_FINISH); + if err <> Z_STREAM_END then + EXIT_ERR('deflate should report Z_STREAM_END'); + + err := deflateEnd(c_stream); + CHECK_ERR(err, 'deflateEnd'); +end; +{$ENDIF} + +(* =========================================================================== + * Test inflate with a preset dictionary + *) +{$IFDEF TEST_DICT} +procedure test_dict_inflate(compr: Pointer; comprLen: LongInt; + uncompr: Pointer; uncomprLen: LongInt); +var err: Integer; + d_stream: z_stream; (* decompression stream *) +begin + StrCopy(PChar(uncompr), 'garbage'); + + d_stream.zalloc := NIL; + d_stream.zfree := NIL; + d_stream.opaque := NIL; + + d_stream.next_in := compr; + d_stream.avail_in := Integer(comprLen); + + err := inflateInit(d_stream); + CHECK_ERR(err, 'inflateInit'); + + d_stream.next_out := uncompr; + d_stream.avail_out := Integer(uncomprLen); + + while TRUE do + begin + err := inflate(d_stream, Z_NO_FLUSH); + if err = Z_STREAM_END then + break; + if err = Z_NEED_DICT then + begin + if d_stream.adler <> dictId then + EXIT_ERR('unexpected dictionary'); + err := inflateSetDictionary(d_stream, dictionary, StrLen(dictionary)); + end; + CHECK_ERR(err, 'inflate with dict'); + end; + + err := inflateEnd(d_stream); + CHECK_ERR(err, 'inflateEnd'); + + if StrComp(PChar(uncompr), hello) <> 0 then + EXIT_ERR('bad inflate with dict') + else + WriteLn('inflate with dictionary: ', PChar(uncompr)); +end; +{$ENDIF} + +var compr, uncompr: Pointer; + comprLen, uncomprLen: LongInt; + +begin + if zlibVersion^ <> ZLIB_VERSION[1] then + EXIT_ERR('Incompatible zlib version'); + + WriteLn('zlib version: ', zlibVersion); + WriteLn('zlib compile flags: ', Format('0x%x', [zlibCompileFlags])); + + comprLen := 10000 * SizeOf(Integer); (* don't overflow on MSDOS *) + uncomprLen := comprLen; + GetMem(compr, comprLen); + GetMem(uncompr, uncomprLen); + if (compr = NIL) or (uncompr = NIL) then + EXIT_ERR('Out of memory'); + (* compr and uncompr are cleared to avoid reading uninitialized + * data and to ensure that uncompr compresses well. + *) + FillChar(compr^, comprLen, 0); + FillChar(uncompr^, uncomprLen, 0); + + {$IFDEF TEST_COMPRESS} + WriteLn('** Testing compress'); + test_compress(compr, comprLen, uncompr, uncomprLen); + {$ENDIF} + + {$IFDEF TEST_GZIO} + WriteLn('** Testing gzio'); + if ParamCount >= 1 then + test_gzio(ParamStr(1), uncompr, uncomprLen) + else + test_gzio(TESTFILE, uncompr, uncomprLen); + {$ENDIF} + + {$IFDEF TEST_DEFLATE} + WriteLn('** Testing deflate with small buffers'); + test_deflate(compr, comprLen); + {$ENDIF} + {$IFDEF TEST_INFLATE} + WriteLn('** Testing inflate with small buffers'); + test_inflate(compr, comprLen, uncompr, uncomprLen); + {$ENDIF} + + {$IFDEF TEST_DEFLATE} + WriteLn('** Testing deflate with large buffers'); + test_large_deflate(compr, comprLen, uncompr, uncomprLen); + {$ENDIF} + {$IFDEF TEST_INFLATE} + WriteLn('** Testing inflate with large buffers'); + test_large_inflate(compr, comprLen, uncompr, uncomprLen); + {$ENDIF} + + {$IFDEF TEST_FLUSH} + WriteLn('** Testing deflate with full flush'); + test_flush(compr, comprLen); + {$ENDIF} + {$IFDEF TEST_SYNC} + WriteLn('** Testing inflateSync'); + test_sync(compr, comprLen, uncompr, uncomprLen); + {$ENDIF} + comprLen := uncomprLen; + + {$IFDEF TEST_DICT} + WriteLn('** Testing deflate and inflate with preset dictionary'); + test_dict_deflate(compr, comprLen); + test_dict_inflate(compr, comprLen, uncompr, uncomprLen); + {$ENDIF} + + FreeMem(compr, comprLen); + FreeMem(uncompr, uncomprLen); +end. diff --git a/zlib/contrib/pascal/readme.txt b/zlib/contrib/pascal/readme.txt new file mode 100644 index 000000000..60e87c8a3 --- /dev/null +++ b/zlib/contrib/pascal/readme.txt @@ -0,0 +1,76 @@ + +This directory contains a Pascal (Delphi, Kylix) interface to the +zlib data compression library. + + +Directory listing +================= + +zlibd32.mak makefile for Borland C++ +example.pas usage example of zlib +zlibpas.pas the Pascal interface to zlib +readme.txt this file + + +Compatibility notes +=================== + +- Although the name "zlib" would have been more normal for the + zlibpas unit, this name is already taken by Borland's ZLib unit. + This is somehow unfortunate, because that unit is not a genuine + interface to the full-fledged zlib functionality, but a suite of + class wrappers around zlib streams. Other essential features, + such as checksums, are missing. + It would have been more appropriate for that unit to have a name + like "ZStreams", or something similar. + +- The C and zlib-supplied types int, uInt, long, uLong, etc. are + translated directly into Pascal types of similar sizes (Integer, + LongInt, etc.), to avoid namespace pollution. In particular, + there is no conversion of unsigned int into a Pascal unsigned + integer. The Word type is non-portable and has the same size + (16 bits) both in a 16-bit and in a 32-bit environment, unlike + Integer. Even if there is a 32-bit Cardinal type, there is no + real need for unsigned int in zlib under a 32-bit environment. + +- Except for the callbacks, the zlib function interfaces are + assuming the calling convention normally used in Pascal + (__pascal for DOS and Windows16, __fastcall for Windows32). + Since the cdecl keyword is used, the old Turbo Pascal does + not work with this interface. + +- The gz* function interfaces are not translated, to avoid + interfacing problems with the C runtime library. Besides, + gzprintf(gzFile file, const char *format, ...) + cannot be translated into Pascal. + + +Legal issues +============ + +The zlibpas interface is: + Copyright (C) 1995-2003 Jean-loup Gailly and Mark Adler. + Copyright (C) 1998 by Bob Dellaca. + Copyright (C) 2003 by Cosmin Truta. + +The example program is: + Copyright (C) 1995-2003 by Jean-loup Gailly. + Copyright (C) 1998,1999,2000 by Jacques Nomssi Nzali. + Copyright (C) 2003 by Cosmin Truta. + + This software is provided 'as-is', without any express or implied + warranty. In no event will the author be held liable for any damages + arising from the use of this software. + + Permission is granted to anyone to use this software for any purpose, + including commercial applications, and to alter it and redistribute it + freely, subject to the following restrictions: + + 1. The origin of this software must not be misrepresented; you must not + claim that you wrote the original software. If you use this software + in a product, an acknowledgment in the product documentation would be + appreciated but is not required. + 2. Altered source versions must be plainly marked as such, and must not be + misrepresented as being the original software. + 3. This notice may not be removed or altered from any source distribution. + diff --git a/zlib/contrib/pascal/zlibd32.mak b/zlib/contrib/pascal/zlibd32.mak new file mode 100644 index 000000000..88fafa0b1 --- /dev/null +++ b/zlib/contrib/pascal/zlibd32.mak @@ -0,0 +1,93 @@ +# Makefile for zlib +# For use with Delphi and C++ Builder under Win32 +# Updated for zlib 1.2.x by Cosmin Truta + +# ------------ Borland C++ ------------ + +# This project uses the Delphi (fastcall/register) calling convention: +LOC = -DZEXPORT=__fastcall -DZEXPORTVA=__cdecl + +CC = bcc32 +LD = bcc32 +AR = tlib +# do not use "-pr" in CFLAGS +CFLAGS = -a -d -k- -O2 $(LOC) +LDFLAGS = + + +# variables +ZLIB_LIB = zlib.lib + +OBJ1 = adler32.obj compress.obj crc32.obj deflate.obj gzio.obj infback.obj +OBJ2 = inffast.obj inflate.obj inftrees.obj trees.obj uncompr.obj zutil.obj +OBJP1 = +adler32.obj+compress.obj+crc32.obj+deflate.obj+gzio.obj+infback.obj +OBJP2 = +inffast.obj+inflate.obj+inftrees.obj+trees.obj+uncompr.obj+zutil.obj + + +# targets +all: $(ZLIB_LIB) example.exe minigzip.exe + +.c.obj: + $(CC) -c $(CFLAGS) $*.c + +adler32.obj: adler32.c zlib.h zconf.h + +compress.obj: compress.c zlib.h zconf.h + +crc32.obj: crc32.c zlib.h zconf.h crc32.h + +deflate.obj: deflate.c deflate.h zutil.h zlib.h zconf.h + +gzio.obj: gzio.c zutil.h zlib.h zconf.h + +infback.obj: infback.c zutil.h zlib.h zconf.h inftrees.h inflate.h \ + inffast.h inffixed.h + +inffast.obj: inffast.c zutil.h zlib.h zconf.h inftrees.h inflate.h \ + inffast.h + +inflate.obj: inflate.c zutil.h zlib.h zconf.h inftrees.h inflate.h \ + inffast.h inffixed.h + +inftrees.obj: inftrees.c zutil.h zlib.h zconf.h inftrees.h + +trees.obj: trees.c zutil.h zlib.h zconf.h deflate.h trees.h + +uncompr.obj: uncompr.c zlib.h zconf.h + +zutil.obj: zutil.c zutil.h zlib.h zconf.h + +example.obj: example.c zlib.h zconf.h + +minigzip.obj: minigzip.c zlib.h zconf.h + + +# For the sake of the old Borland make, +# the command line is cut to fit in the MS-DOS 128 byte limit: +$(ZLIB_LIB): $(OBJ1) $(OBJ2) + -del $(ZLIB_LIB) + $(AR) $(ZLIB_LIB) $(OBJP1) + $(AR) $(ZLIB_LIB) $(OBJP2) + + +# testing +test: example.exe minigzip.exe + example + echo hello world | minigzip | minigzip -d + +example.exe: example.obj $(ZLIB_LIB) + $(LD) $(LDFLAGS) example.obj $(ZLIB_LIB) + +minigzip.exe: minigzip.obj $(ZLIB_LIB) + $(LD) $(LDFLAGS) minigzip.obj $(ZLIB_LIB) + + +# cleanup +clean: + -del *.obj + -del *.exe + -del *.lib + -del *.tds + -del zlib.bak + -del foo.gz + diff --git a/zlib/contrib/pascal/zlibpas.pas b/zlib/contrib/pascal/zlibpas.pas new file mode 100644 index 000000000..836848c2b --- /dev/null +++ b/zlib/contrib/pascal/zlibpas.pas @@ -0,0 +1,236 @@ +(* zlibpas -- Pascal interface to the zlib data compression library + * + * Copyright (C) 2003 Cosmin Truta. + * Derived from original sources by Bob Dellaca. + * For conditions of distribution and use, see copyright notice in readme.txt + *) + +unit zlibpas; + +interface + +const + ZLIB_VERSION = '1.2.3'; + +type + alloc_func = function(opaque: Pointer; items, size: Integer): Pointer; + cdecl; + free_func = procedure(opaque, address: Pointer); + cdecl; + + in_func = function(opaque: Pointer; var buf: PByte): Integer; + cdecl; + out_func = function(opaque: Pointer; buf: PByte; size: Integer): Integer; + cdecl; + + z_streamp = ^z_stream; + z_stream = packed record + next_in: PChar; (* next input byte *) + avail_in: Integer; (* number of bytes available at next_in *) + total_in: LongInt; (* total nb of input bytes read so far *) + + next_out: PChar; (* next output byte should be put there *) + avail_out: Integer; (* remaining free space at next_out *) + total_out: LongInt; (* total nb of bytes output so far *) + + msg: PChar; (* last error message, NULL if no error *) + state: Pointer; (* not visible by applications *) + + zalloc: alloc_func; (* used to allocate the internal state *) + zfree: free_func; (* used to free the internal state *) + opaque: Pointer; (* private data object passed to zalloc and zfree *) + + data_type: Integer; (* best guess about the data type: ascii or binary *) + adler: LongInt; (* adler32 value of the uncompressed data *) + reserved: LongInt; (* reserved for future use *) + end; + +(* constants *) +const + Z_NO_FLUSH = 0; + Z_PARTIAL_FLUSH = 1; + Z_SYNC_FLUSH = 2; + Z_FULL_FLUSH = 3; + Z_FINISH = 4; + + Z_OK = 0; + Z_STREAM_END = 1; + Z_NEED_DICT = 2; + Z_ERRNO = -1; + Z_STREAM_ERROR = -2; + Z_DATA_ERROR = -3; + Z_MEM_ERROR = -4; + Z_BUF_ERROR = -5; + Z_VERSION_ERROR = -6; + + Z_NO_COMPRESSION = 0; + Z_BEST_SPEED = 1; + Z_BEST_COMPRESSION = 9; + Z_DEFAULT_COMPRESSION = -1; + + Z_FILTERED = 1; + Z_HUFFMAN_ONLY = 2; + Z_RLE = 3; + Z_DEFAULT_STRATEGY = 0; + + Z_BINARY = 0; + Z_ASCII = 1; + Z_UNKNOWN = 2; + + Z_DEFLATED = 8; + +(* basic functions *) +function zlibVersion: PChar; +function deflateInit(var strm: z_stream; level: Integer): Integer; +function deflate(var strm: z_stream; flush: Integer): Integer; +function deflateEnd(var strm: z_stream): Integer; +function inflateInit(var strm: z_stream): Integer; +function inflate(var strm: z_stream; flush: Integer): Integer; +function inflateEnd(var strm: z_stream): Integer; + +(* advanced functions *) +function deflateInit2(var strm: z_stream; level, method, windowBits, + memLevel, strategy: Integer): Integer; +function deflateSetDictionary(var strm: z_stream; const dictionary: PChar; + dictLength: Integer): Integer; +function deflateCopy(var dest, source: z_stream): Integer; +function deflateReset(var strm: z_stream): Integer; +function deflateParams(var strm: z_stream; level, strategy: Integer): Integer; +function deflateBound(var strm: z_stream; sourceLen: LongInt): LongInt; +function deflatePrime(var strm: z_stream; bits, value: Integer): Integer; +function inflateInit2(var strm: z_stream; windowBits: Integer): Integer; +function inflateSetDictionary(var strm: z_stream; const dictionary: PChar; + dictLength: Integer): Integer; +function inflateSync(var strm: z_stream): Integer; +function inflateCopy(var dest, source: z_stream): Integer; +function inflateReset(var strm: z_stream): Integer; +function inflateBackInit(var strm: z_stream; + windowBits: Integer; window: PChar): Integer; +function inflateBack(var strm: z_stream; in_fn: in_func; in_desc: Pointer; + out_fn: out_func; out_desc: Pointer): Integer; +function inflateBackEnd(var strm: z_stream): Integer; +function zlibCompileFlags: LongInt; + +(* utility functions *) +function compress(dest: PChar; var destLen: LongInt; + const source: PChar; sourceLen: LongInt): Integer; +function compress2(dest: PChar; var destLen: LongInt; + const source: PChar; sourceLen: LongInt; + level: Integer): Integer; +function compressBound(sourceLen: LongInt): LongInt; +function uncompress(dest: PChar; var destLen: LongInt; + const source: PChar; sourceLen: LongInt): Integer; + +(* checksum functions *) +function adler32(adler: LongInt; const buf: PChar; len: Integer): LongInt; +function crc32(crc: LongInt; const buf: PChar; len: Integer): LongInt; + +(* various hacks, don't look :) *) +function deflateInit_(var strm: z_stream; level: Integer; + const version: PChar; stream_size: Integer): Integer; +function inflateInit_(var strm: z_stream; const version: PChar; + stream_size: Integer): Integer; +function deflateInit2_(var strm: z_stream; + level, method, windowBits, memLevel, strategy: Integer; + const version: PChar; stream_size: Integer): Integer; +function inflateInit2_(var strm: z_stream; windowBits: Integer; + const version: PChar; stream_size: Integer): Integer; +function inflateBackInit_(var strm: z_stream; + windowBits: Integer; window: PChar; + const version: PChar; stream_size: Integer): Integer; + + +implementation + +{$L adler32.obj} +{$L compress.obj} +{$L crc32.obj} +{$L deflate.obj} +{$L infback.obj} +{$L inffast.obj} +{$L inflate.obj} +{$L inftrees.obj} +{$L trees.obj} +{$L uncompr.obj} +{$L zutil.obj} + +function adler32; external; +function compress; external; +function compress2; external; +function compressBound; external; +function crc32; external; +function deflate; external; +function deflateBound; external; +function deflateCopy; external; +function deflateEnd; external; +function deflateInit_; external; +function deflateInit2_; external; +function deflateParams; external; +function deflatePrime; external; +function deflateReset; external; +function deflateSetDictionary; external; +function inflate; external; +function inflateBack; external; +function inflateBackEnd; external; +function inflateBackInit_; external; +function inflateCopy; external; +function inflateEnd; external; +function inflateInit_; external; +function inflateInit2_; external; +function inflateReset; external; +function inflateSetDictionary; external; +function inflateSync; external; +function uncompress; external; +function zlibCompileFlags; external; +function zlibVersion; external; + +function deflateInit(var strm: z_stream; level: Integer): Integer; +begin + Result := deflateInit_(strm, level, ZLIB_VERSION, sizeof(z_stream)); +end; + +function deflateInit2(var strm: z_stream; level, method, windowBits, memLevel, + strategy: Integer): Integer; +begin + Result := deflateInit2_(strm, level, method, windowBits, memLevel, strategy, + ZLIB_VERSION, sizeof(z_stream)); +end; + +function inflateInit(var strm: z_stream): Integer; +begin + Result := inflateInit_(strm, ZLIB_VERSION, sizeof(z_stream)); +end; + +function inflateInit2(var strm: z_stream; windowBits: Integer): Integer; +begin + Result := inflateInit2_(strm, windowBits, ZLIB_VERSION, sizeof(z_stream)); +end; + +function inflateBackInit(var strm: z_stream; + windowBits: Integer; window: PChar): Integer; +begin + Result := inflateBackInit_(strm, windowBits, window, + ZLIB_VERSION, sizeof(z_stream)); +end; + +function _malloc(Size: Integer): Pointer; cdecl; +begin + GetMem(Result, Size); +end; + +procedure _free(Block: Pointer); cdecl; +begin + FreeMem(Block); +end; + +procedure _memset(P: Pointer; B: Byte; count: Integer); cdecl; +begin + FillChar(P^, count, B); +end; + +procedure _memcpy(dest, source: Pointer; count: Integer); cdecl; +begin + Move(source^, dest^, count); +end; + +end. |