1 1.1 christos (* zlibpas -- Pascal interface to the zlib data compression library 2 1.1 christos * 3 1.1 christos * Copyright (C) 2003 Cosmin Truta. 4 1.1 christos * Derived from original sources by Bob Dellaca. 5 1.1 christos * For conditions of distribution and use, see copyright notice in readme.txt 6 1.1 christos *) 7 1.1 christos 8 1.1 christos unit zlibpas; 9 1.1 christos 10 1.1 christos interface 11 1.1 christos 12 1.1 christos const 13 1.1.1.4 christos ZLIB_VERSION = '1.3.1'; 14 1.1.1.2 christos ZLIB_VERNUM = $12a0; 15 1.1 christos 16 1.1 christos type 17 1.1 christos alloc_func = function(opaque: Pointer; items, size: Integer): Pointer; 18 1.1 christos cdecl; 19 1.1 christos free_func = procedure(opaque, address: Pointer); 20 1.1 christos cdecl; 21 1.1 christos 22 1.1 christos in_func = function(opaque: Pointer; var buf: PByte): Integer; 23 1.1 christos cdecl; 24 1.1 christos out_func = function(opaque: Pointer; buf: PByte; size: Integer): Integer; 25 1.1 christos cdecl; 26 1.1 christos 27 1.1 christos z_streamp = ^z_stream; 28 1.1 christos z_stream = packed record 29 1.1 christos next_in: PChar; (* next input byte *) 30 1.1 christos avail_in: Integer; (* number of bytes available at next_in *) 31 1.1 christos total_in: LongInt; (* total nb of input bytes read so far *) 32 1.1 christos 33 1.1 christos next_out: PChar; (* next output byte should be put there *) 34 1.1 christos avail_out: Integer; (* remaining free space at next_out *) 35 1.1 christos total_out: LongInt; (* total nb of bytes output so far *) 36 1.1 christos 37 1.1 christos msg: PChar; (* last error message, NULL if no error *) 38 1.1 christos state: Pointer; (* not visible by applications *) 39 1.1 christos 40 1.1 christos zalloc: alloc_func; (* used to allocate the internal state *) 41 1.1 christos zfree: free_func; (* used to free the internal state *) 42 1.1 christos opaque: Pointer; (* private data object passed to zalloc and zfree *) 43 1.1 christos 44 1.1 christos data_type: Integer; (* best guess about the data type: ascii or binary *) 45 1.1 christos adler: LongInt; (* adler32 value of the uncompressed data *) 46 1.1 christos reserved: LongInt; (* reserved for future use *) 47 1.1 christos end; 48 1.1 christos 49 1.1.1.2 christos gz_headerp = ^gz_header; 50 1.1.1.2 christos gz_header = packed record 51 1.1.1.2 christos text: Integer; (* true if compressed data believed to be text *) 52 1.1.1.2 christos time: LongInt; (* modification time *) 53 1.1.1.2 christos xflags: Integer; (* extra flags (not used when writing a gzip file) *) 54 1.1.1.2 christos os: Integer; (* operating system *) 55 1.1.1.2 christos extra: PChar; (* pointer to extra field or Z_NULL if none *) 56 1.1.1.2 christos extra_len: Integer; (* extra field length (valid if extra != Z_NULL) *) 57 1.1.1.2 christos extra_max: Integer; (* space at extra (only when reading header) *) 58 1.1.1.2 christos name: PChar; (* pointer to zero-terminated file name or Z_NULL *) 59 1.1.1.2 christos name_max: Integer; (* space at name (only when reading header) *) 60 1.1.1.2 christos comment: PChar; (* pointer to zero-terminated comment or Z_NULL *) 61 1.1.1.2 christos comm_max: Integer; (* space at comment (only when reading header) *) 62 1.1.1.2 christos hcrc: Integer; (* true if there was or will be a header crc *) 63 1.1.1.2 christos done: Integer; (* true when done reading gzip header *) 64 1.1.1.2 christos end; 65 1.1.1.2 christos 66 1.1 christos (* constants *) 67 1.1 christos const 68 1.1 christos Z_NO_FLUSH = 0; 69 1.1 christos Z_PARTIAL_FLUSH = 1; 70 1.1 christos Z_SYNC_FLUSH = 2; 71 1.1 christos Z_FULL_FLUSH = 3; 72 1.1 christos Z_FINISH = 4; 73 1.1.1.2 christos Z_BLOCK = 5; 74 1.1.1.2 christos Z_TREES = 6; 75 1.1 christos 76 1.1 christos Z_OK = 0; 77 1.1 christos Z_STREAM_END = 1; 78 1.1 christos Z_NEED_DICT = 2; 79 1.1 christos Z_ERRNO = -1; 80 1.1 christos Z_STREAM_ERROR = -2; 81 1.1 christos Z_DATA_ERROR = -3; 82 1.1 christos Z_MEM_ERROR = -4; 83 1.1 christos Z_BUF_ERROR = -5; 84 1.1 christos Z_VERSION_ERROR = -6; 85 1.1 christos 86 1.1 christos Z_NO_COMPRESSION = 0; 87 1.1 christos Z_BEST_SPEED = 1; 88 1.1 christos Z_BEST_COMPRESSION = 9; 89 1.1 christos Z_DEFAULT_COMPRESSION = -1; 90 1.1 christos 91 1.1 christos Z_FILTERED = 1; 92 1.1 christos Z_HUFFMAN_ONLY = 2; 93 1.1 christos Z_RLE = 3; 94 1.1.1.2 christos Z_FIXED = 4; 95 1.1 christos Z_DEFAULT_STRATEGY = 0; 96 1.1 christos 97 1.1 christos Z_BINARY = 0; 98 1.1.1.2 christos Z_TEXT = 1; 99 1.1 christos Z_ASCII = 1; 100 1.1 christos Z_UNKNOWN = 2; 101 1.1 christos 102 1.1 christos Z_DEFLATED = 8; 103 1.1 christos 104 1.1 christos (* basic functions *) 105 1.1 christos function zlibVersion: PChar; 106 1.1 christos function deflateInit(var strm: z_stream; level: Integer): Integer; 107 1.1 christos function deflate(var strm: z_stream; flush: Integer): Integer; 108 1.1 christos function deflateEnd(var strm: z_stream): Integer; 109 1.1 christos function inflateInit(var strm: z_stream): Integer; 110 1.1 christos function inflate(var strm: z_stream; flush: Integer): Integer; 111 1.1 christos function inflateEnd(var strm: z_stream): Integer; 112 1.1 christos 113 1.1 christos (* advanced functions *) 114 1.1 christos function deflateInit2(var strm: z_stream; level, method, windowBits, 115 1.1 christos memLevel, strategy: Integer): Integer; 116 1.1 christos function deflateSetDictionary(var strm: z_stream; const dictionary: PChar; 117 1.1 christos dictLength: Integer): Integer; 118 1.1 christos function deflateCopy(var dest, source: z_stream): Integer; 119 1.1 christos function deflateReset(var strm: z_stream): Integer; 120 1.1 christos function deflateParams(var strm: z_stream; level, strategy: Integer): Integer; 121 1.1.1.2 christos function deflateTune(var strm: z_stream; good_length, max_lazy, nice_length, max_chain: Integer): Integer; 122 1.1 christos function deflateBound(var strm: z_stream; sourceLen: LongInt): LongInt; 123 1.1.1.2 christos function deflatePending(var strm: z_stream; var pending: Integer; var bits: Integer): Integer; 124 1.1 christos function deflatePrime(var strm: z_stream; bits, value: Integer): Integer; 125 1.1.1.2 christos function deflateSetHeader(var strm: z_stream; head: gz_header): Integer; 126 1.1 christos function inflateInit2(var strm: z_stream; windowBits: Integer): Integer; 127 1.1 christos function inflateSetDictionary(var strm: z_stream; const dictionary: PChar; 128 1.1 christos dictLength: Integer): Integer; 129 1.1 christos function inflateSync(var strm: z_stream): Integer; 130 1.1 christos function inflateCopy(var dest, source: z_stream): Integer; 131 1.1 christos function inflateReset(var strm: z_stream): Integer; 132 1.1.1.2 christos function inflateReset2(var strm: z_stream; windowBits: Integer): Integer; 133 1.1.1.2 christos function inflatePrime(var strm: z_stream; bits, value: Integer): Integer; 134 1.1.1.2 christos function inflateMark(var strm: z_stream): LongInt; 135 1.1.1.2 christos function inflateGetHeader(var strm: z_stream; var head: gz_header): Integer; 136 1.1 christos function inflateBackInit(var strm: z_stream; 137 1.1 christos windowBits: Integer; window: PChar): Integer; 138 1.1 christos function inflateBack(var strm: z_stream; in_fn: in_func; in_desc: Pointer; 139 1.1 christos out_fn: out_func; out_desc: Pointer): Integer; 140 1.1 christos function inflateBackEnd(var strm: z_stream): Integer; 141 1.1 christos function zlibCompileFlags: LongInt; 142 1.1 christos 143 1.1 christos (* utility functions *) 144 1.1 christos function compress(dest: PChar; var destLen: LongInt; 145 1.1 christos const source: PChar; sourceLen: LongInt): Integer; 146 1.1 christos function compress2(dest: PChar; var destLen: LongInt; 147 1.1 christos const source: PChar; sourceLen: LongInt; 148 1.1 christos level: Integer): Integer; 149 1.1 christos function compressBound(sourceLen: LongInt): LongInt; 150 1.1 christos function uncompress(dest: PChar; var destLen: LongInt; 151 1.1 christos const source: PChar; sourceLen: LongInt): Integer; 152 1.1 christos 153 1.1 christos (* checksum functions *) 154 1.1 christos function adler32(adler: LongInt; const buf: PChar; len: Integer): LongInt; 155 1.1.1.2 christos function adler32_combine(adler1, adler2, len2: LongInt): LongInt; 156 1.1 christos function crc32(crc: LongInt; const buf: PChar; len: Integer): LongInt; 157 1.1.1.2 christos function crc32_combine(crc1, crc2, len2: LongInt): LongInt; 158 1.1 christos 159 1.1 christos (* various hacks, don't look :) *) 160 1.1 christos function deflateInit_(var strm: z_stream; level: Integer; 161 1.1 christos const version: PChar; stream_size: Integer): Integer; 162 1.1 christos function inflateInit_(var strm: z_stream; const version: PChar; 163 1.1 christos stream_size: Integer): Integer; 164 1.1 christos function deflateInit2_(var strm: z_stream; 165 1.1 christos level, method, windowBits, memLevel, strategy: Integer; 166 1.1 christos const version: PChar; stream_size: Integer): Integer; 167 1.1 christos function inflateInit2_(var strm: z_stream; windowBits: Integer; 168 1.1 christos const version: PChar; stream_size: Integer): Integer; 169 1.1 christos function inflateBackInit_(var strm: z_stream; 170 1.1 christos windowBits: Integer; window: PChar; 171 1.1 christos const version: PChar; stream_size: Integer): Integer; 172 1.1 christos 173 1.1 christos 174 1.1 christos implementation 175 1.1 christos 176 1.1 christos {$L adler32.obj} 177 1.1 christos {$L compress.obj} 178 1.1 christos {$L crc32.obj} 179 1.1 christos {$L deflate.obj} 180 1.1 christos {$L infback.obj} 181 1.1 christos {$L inffast.obj} 182 1.1 christos {$L inflate.obj} 183 1.1 christos {$L inftrees.obj} 184 1.1 christos {$L trees.obj} 185 1.1 christos {$L uncompr.obj} 186 1.1 christos {$L zutil.obj} 187 1.1 christos 188 1.1 christos function adler32; external; 189 1.1.1.2 christos function adler32_combine; external; 190 1.1 christos function compress; external; 191 1.1 christos function compress2; external; 192 1.1 christos function compressBound; external; 193 1.1 christos function crc32; external; 194 1.1.1.2 christos function crc32_combine; external; 195 1.1 christos function deflate; external; 196 1.1 christos function deflateBound; external; 197 1.1 christos function deflateCopy; external; 198 1.1 christos function deflateEnd; external; 199 1.1 christos function deflateInit_; external; 200 1.1 christos function deflateInit2_; external; 201 1.1 christos function deflateParams; external; 202 1.1.1.2 christos function deflatePending; external; 203 1.1 christos function deflatePrime; external; 204 1.1 christos function deflateReset; external; 205 1.1 christos function deflateSetDictionary; external; 206 1.1.1.2 christos function deflateSetHeader; external; 207 1.1.1.2 christos function deflateTune; external; 208 1.1 christos function inflate; external; 209 1.1 christos function inflateBack; external; 210 1.1 christos function inflateBackEnd; external; 211 1.1 christos function inflateBackInit_; external; 212 1.1 christos function inflateCopy; external; 213 1.1 christos function inflateEnd; external; 214 1.1.1.2 christos function inflateGetHeader; external; 215 1.1 christos function inflateInit_; external; 216 1.1 christos function inflateInit2_; external; 217 1.1.1.2 christos function inflateMark; external; 218 1.1.1.2 christos function inflatePrime; external; 219 1.1 christos function inflateReset; external; 220 1.1.1.2 christos function inflateReset2; external; 221 1.1 christos function inflateSetDictionary; external; 222 1.1 christos function inflateSync; external; 223 1.1 christos function uncompress; external; 224 1.1 christos function zlibCompileFlags; external; 225 1.1 christos function zlibVersion; external; 226 1.1 christos 227 1.1 christos function deflateInit(var strm: z_stream; level: Integer): Integer; 228 1.1 christos begin 229 1.1 christos Result := deflateInit_(strm, level, ZLIB_VERSION, sizeof(z_stream)); 230 1.1 christos end; 231 1.1 christos 232 1.1 christos function deflateInit2(var strm: z_stream; level, method, windowBits, memLevel, 233 1.1 christos strategy: Integer): Integer; 234 1.1 christos begin 235 1.1 christos Result := deflateInit2_(strm, level, method, windowBits, memLevel, strategy, 236 1.1 christos ZLIB_VERSION, sizeof(z_stream)); 237 1.1 christos end; 238 1.1 christos 239 1.1 christos function inflateInit(var strm: z_stream): Integer; 240 1.1 christos begin 241 1.1 christos Result := inflateInit_(strm, ZLIB_VERSION, sizeof(z_stream)); 242 1.1 christos end; 243 1.1 christos 244 1.1 christos function inflateInit2(var strm: z_stream; windowBits: Integer): Integer; 245 1.1 christos begin 246 1.1 christos Result := inflateInit2_(strm, windowBits, ZLIB_VERSION, sizeof(z_stream)); 247 1.1 christos end; 248 1.1 christos 249 1.1 christos function inflateBackInit(var strm: z_stream; 250 1.1 christos windowBits: Integer; window: PChar): Integer; 251 1.1 christos begin 252 1.1 christos Result := inflateBackInit_(strm, windowBits, window, 253 1.1 christos ZLIB_VERSION, sizeof(z_stream)); 254 1.1 christos end; 255 1.1 christos 256 1.1 christos function _malloc(Size: Integer): Pointer; cdecl; 257 1.1 christos begin 258 1.1 christos GetMem(Result, Size); 259 1.1 christos end; 260 1.1 christos 261 1.1 christos procedure _free(Block: Pointer); cdecl; 262 1.1 christos begin 263 1.1 christos FreeMem(Block); 264 1.1 christos end; 265 1.1 christos 266 1.1 christos procedure _memset(P: Pointer; B: Byte; count: Integer); cdecl; 267 1.1 christos begin 268 1.1 christos FillChar(P^, count, B); 269 1.1 christos end; 270 1.1 christos 271 1.1 christos procedure _memcpy(dest, source: Pointer; count: Integer); cdecl; 272 1.1 christos begin 273 1.1 christos Move(source^, dest^, count); 274 1.1 christos end; 275 1.1 christos 276 1.1 christos end. 277