zlib.pas

   1 Unit Zlib;\r
   2 \r
   3 \r
   4 { Original:\r
   5    zlib.h -- interface of the 'zlib' general purpose compression library\r
   6   version 1.1.0, Feb 24th, 1998\r
   7 \r
   8   Copyright (C) 1995-1998 Jean-loup Gailly and Mark Adler\r
   9 \r
  10   This software is provided 'as-is', without any express or implied\r
  11   warranty.  In no event will the authors be held liable for any damages\r
  12   arising from the use of this software.\r
  13 \r
  14   Permission is granted to anyone to use this software for any purpose,\r
  15   including commercial applications, and to alter it and redistribute it\r
  16   freely, subject to the following restrictions:\r
  17 \r
  18   1. The origin of this software must not be misrepresented; you must not\r
  19      claim that you wrote the original software. If you use this software\r
  20      in a product, an acknowledgment in the product documentation would be\r
  21      appreciated but is not required.\r
  22   2. Altered source versions must be plainly marked as such, and must not be\r
  23      misrepresented as being the original software.\r
  24   3. This notice may not be removed or altered from any source distribution.\r
  25 \r
  26   Jean-loup Gailly        Mark Adler\r
  27   jloup@gzip.org          madler@alumni.caltech.edu\r
  28 \r
  29 \r
  30   The data format used by the zlib library is described by RFCs (Request for\r
  31   Comments) 1950 to 1952 in the files ftp://ds.internic.net/rfc/rfc1950.txt\r
  32   (zlib format), rfc1951.txt (deflate format) and rfc1952.txt (gzip format).\r
  33 \r
  34 \r
  35   Pascal tranlastion\r
  36   Copyright (C) 1998 by Jacques Nomssi Nzali\r
  37   For conditions of distribution and use, see copyright notice in readme.txt\r
  38 }\r
  39 \r
  40 interface\r
  41 \r
  42 {$I zconf.inc}\r
  43 \r
  44 uses\r
  45   zutil;\r
  46 \r
  47 { zconf.h -- configuration of the zlib compression library }\r
  48 { zutil.c -- target dependent utility functions for the compression library }\r
  49 \r
  50 { The 'zlib' compression library provides in-memory compression and\r
  51   decompression functions, including integrity checks of the uncompressed\r
  52   data.  This version of the library supports only one compression method\r
  53   (deflation) but other algorithms will be added later and will have the same\r
  54   stream interface.\r
  55 \r
  56      Compression can be done in a single step if the buffers are large\r
  57   enough (for example if an input file is mmap'ed), or can be done by\r
  58   repeated calls of the compression function.  In the latter case, the\r
  59   application must provide more input and/or consume the output\r
  60   (providing more output space) before each call.\r
  61 \r
  62      The library also supports reading and writing files in gzip (.gz) format\r
  63   with an interface similar to that of stdio.\r
  64 \r
  65      The library does not install any signal handler. The decoder checks\r
  66   the consistency of the compressed data, so the library should never\r
  67   crash even in case of corrupted input. }\r
  68 \r
  69 \r
  70 \r
  71 { Compile with -DMAXSEG_64K if the alloc function cannot allocate more\r
  72   than 64k bytes at a time (needed on systems with 16-bit int). }\r
  73 \r
  74 { Maximum value for memLevel in deflateInit2 }\r
  75 {$ifdef MAXSEG_64K}\r
  76   {$IFDEF VER70}\r
  77   const\r
  78     MAX_MEM_LEVEL = 7;\r
  79     DEF_MEM_LEVEL = MAX_MEM_LEVEL;  { default memLevel }\r
  80   {$ELSE}\r
  81   const\r
  82     MAX_MEM_LEVEL = 8;\r
  83     DEF_MEM_LEVEL = MAX_MEM_LEVEL;  { default memLevel }\r
  84   {$ENDIF}\r
  85 {$else}\r
  86 const\r
  87   MAX_MEM_LEVEL = 9;\r
  88   DEF_MEM_LEVEL = 8; { if MAX_MEM_LEVEL > 8 }\r
  89 {$endif}\r
  90 \r
  91 { Maximum value for windowBits in deflateInit2 and inflateInit2 }\r
  92 const\r
  93 {$IFDEF VER70}\r
  94   MAX_WBITS = 14; { 32K LZ77 window }\r
  95 {$ELSE}\r
  96   MAX_WBITS = 15; { 32K LZ77 window }\r
  97 {$ENDIF}\r
  98 \r
  99 { default windowBits for decompression. MAX_WBITS is for compression only }\r
 100 const\r
 101   DEF_WBITS = MAX_WBITS;\r
 102 \r
 103 { The memory requirements for deflate are (in bytes):\r
 104             1 shl (windowBits+2)   +  1 shl (memLevel+9)\r
 105  that is: 128K for windowBits=15  +  128K for memLevel = 8  (default values)\r
 106  plus a few kilobytes for small objects. For example, if you want to reduce\r
 107  the default memory requirements from 256K to 128K, compile with\r
 108      DMAX_WBITS=14 DMAX_MEM_LEVEL=7\r
 109  Of course this will generally degrade compression (there's no free lunch).\r
 110 \r
 111  The memory requirements for inflate are (in bytes) 1 shl windowBits\r
 112  that is, 32K for windowBits=15 (default value) plus a few kilobytes\r
 113  for small objects. }\r
 114 \r
 115 \r
 116 { Huffman code lookup table entry--this entry is four bytes for machines\r
 117   that have 16-bit pointers (e.g. PC's in the small or medium model). }\r
 118 \r
 119 type\r
 120   pInflate_huft = ^inflate_huft;\r
 121   inflate_huft = Record\r
 122     Exop,             { number of extra bits or operation }\r
 123     bits : Byte;      { number of bits in this code or subcode }\r
 124     {pad : uInt;}       { pad structure to a power of 2 (4 bytes for }\r
 125                       {  16-bit, 8 bytes for 32-bit int's) }\r
 126     base : uInt;      { literal, length base, or distance base }\r
 127                       { or table offset }\r
 128   End;\r
 129 \r
 130 type\r
 131   huft_field = Array[0..(MaxMemBlock div SizeOf(inflate_huft))-1] of inflate_huft;\r
 132   huft_ptr = ^huft_field;\r
 133 type\r
 134   ppInflate_huft = ^pInflate_huft;\r
 135 \r
 136 type\r
 137   inflate_codes_mode = ( { waiting for "i:"=input, "o:"=output, "x:"=nothing }\r
 138         START,    { x: set up for LEN }\r
 139         LEN,      { i: get length/literal/eob next }\r
 140         LENEXT,   { i: getting length extra (have base) }\r
 141         DIST,     { i: get distance next }\r
 142         DISTEXT,  { i: getting distance extra }\r
 143         COPY,     { o: copying bytes in window, waiting for space }\r
 144         LIT,      { o: got literal, waiting for output space }\r
 145         WASH,     { o: got eob, possibly still output waiting }\r
 146         ZEND,     { x: got eob and all data flushed }\r
 147         BADCODE); { x: got error }\r
 148 \r
 149 { inflate codes private state }\r
 150 type\r
 151   pInflate_codes_state = ^inflate_codes_state;\r
 152   inflate_codes_state = record\r
 153 \r
 154     mode : inflate_codes_mode;        { current inflate_codes mode }\r
 155 \r
 156     { mode dependent information }\r
 157     len : uInt;\r
 158     sub : record                      { submode }\r
 159       Case Byte of\r
 160       0:(code : record                { if LEN or DIST, where in tree }\r
 161           tree : pInflate_huft;       { pointer into tree }\r
 162           need : uInt;                { bits needed }\r
 163          end);\r
 164       1:(lit : uInt);                 { if LIT, literal }\r
 165       2:(copy: record                 { if EXT or COPY, where and how much }\r
 166            get : uInt;                { bits to get for extra }\r
 167            dist : uInt;               { distance back to copy from }\r
 168          end);\r
 169     end;\r
 170 \r
 171     { mode independent information }\r
 172     lbits : Byte;                     { ltree bits decoded per branch }\r
 173     dbits : Byte;                     { dtree bits decoder per branch }\r
 174     ltree : pInflate_huft;            { literal/length/eob tree }\r
 175     dtree : pInflate_huft;            { distance tree }\r
 176   end;\r
 177 \r
 178 type\r
 179   check_func = function(check : uLong;\r
 180                         buf : pBytef;\r
 181                         {const buf : array of byte;}\r
 182                         len : uInt) : uLong;\r
 183 type\r
 184   inflate_block_mode =\r
 185      (ZTYPE,    { get type bits (3, including end bit) }\r
 186       LENS,     { get lengths for stored }\r
 187       STORED,   { processing stored block }\r
 188       TABLE,    { get table lengths }\r
 189       BTREE,    { get bit lengths tree for a dynamic block }\r
 190       DTREE,    { get length, distance trees for a dynamic block }\r
 191       CODES,    { processing fixed or dynamic block }\r
 192       DRY,      { output remaining window bytes }\r
 193       BLKDONE,  { finished last block, done }\r
 194       BLKBAD);  { got a data error--stuck here }\r
 195 \r
 196 type\r
 197   pInflate_blocks_state = ^inflate_blocks_state;\r
 198 \r
 199 { inflate blocks semi-private state }\r
 200   inflate_blocks_state = record\r
 201 \r
 202     mode : inflate_block_mode;     { current inflate_block mode }\r
 203 \r
 204     { mode dependent information }\r
 205     sub : record                  { submode }\r
 206     case Byte of\r
 207     0:(left : uInt);              { if STORED, bytes left to copy }\r
 208     1:(trees : record             { if DTREE, decoding info for trees }\r
 209         table : uInt;               { table lengths (14 bits) }\r
 210         index : uInt;               { index into blens (or border) }\r
 211         blens : PuIntArray;         { bit lengths of codes }\r
 212         bb : uInt;                  { bit length tree depth }\r
 213         tb : pInflate_huft;         { bit length decoding tree }\r
 214       end);\r
 215     2:(decode : record            { if CODES, current state }\r
 216         tl : pInflate_huft;\r
 217         td : pInflate_huft;         { trees to free }\r
 218         codes : pInflate_codes_state;\r
 219       end);\r
 220     end;\r
 221     last : boolean;               { true if this block is the last block }\r
 222 \r
 223     { mode independent information }\r
 224     bitk : uInt;            { bits in bit buffer }\r
 225     bitb : uLong;           { bit buffer }\r
 226     hufts : huft_ptr; {pInflate_huft;}  { single malloc for tree space }\r
 227     window : pBytef;        { sliding window }\r
 228     zend : pBytef;          { one byte after sliding window }\r
 229     read : pBytef;          { window read pointer }\r
 230     write : pBytef;         { window write pointer }\r
 231     checkfn : check_func;   { check function }\r
 232     check : uLong;          { check on output }\r
 233   end;\r
 234 \r
 235 type\r
 236   inflate_mode = (\r
 237       METHOD,   { waiting for method byte }\r
 238       FLAG,     { waiting for flag byte }\r
 239       DICT4,    { four dictionary check bytes to go }\r
 240       DICT3,    { three dictionary check bytes to go }\r
 241       DICT2,    { two dictionary check bytes to go }\r
 242       DICT1,    { one dictionary check byte to go }\r
 243       DICT0,    { waiting for inflateSetDictionary }\r
 244       BLOCKS,   { decompressing blocks }\r
 245       CHECK4,   { four check bytes to go }\r
 246       CHECK3,   { three check bytes to go }\r
 247       CHECK2,   { two check bytes to go }\r
 248       CHECK1,   { one check byte to go }\r
 249       DONE,     { finished check, done }\r
 250       BAD);     { got an error--stay here }\r
 251 \r
 252 { inflate private state }\r
 253 type\r
 254   pInternal_state = ^internal_state; { or point to a deflate_state record }\r
 255   internal_state = record\r
 256 \r
 257      mode : inflate_mode;  { current inflate mode }\r
 258 \r
 259      { mode dependent information }\r
 260      sub : record          { submode }\r
 261        case byte of\r
 262        0:(method : uInt);  { if FLAGS, method byte }\r
 263        1:(check : record   { if CHECK, check values to compare }\r
 264            was : uLong;        { computed check value }\r
 265            need : uLong;       { stream check value }\r
 266           end);\r
 267        2:(marker : uInt);  { if BAD, inflateSync's marker bytes count }\r
 268      end;\r
 269 \r
 270      { mode independent information }\r
 271      nowrap : boolean;      { flag for no wrapper }\r
 272      wbits : uInt;          { log2(window size)  (8..15, defaults to 15) }\r
 273      blocks : pInflate_blocks_state;    { current inflate_blocks state }\r
 274    end;\r
 275 \r
 276 type\r
 277   alloc_func = function(opaque : voidpf; items : uInt; size : uInt) : voidpf;\r
 278   free_func = procedure(opaque : voidpf; address : voidpf);\r
 279 \r
 280 type\r
 281   z_streamp = ^z_stream;\r
 282   z_stream = record\r
 283     next_in : pBytef;     { next input byte }\r
 284     avail_in : uInt;      { number of bytes available at next_in }\r
 285     total_in : uLong;     { total nb of input bytes read so far }\r
 286 \r
 287     next_out : pBytef;    { next output byte should be put there }\r
 288     avail_out : uInt;     { remaining free space at next_out }\r
 289     total_out : uLong;    { total nb of bytes output so far }\r
 290 \r
 291     msg : string[255];         { last error message, '' if no error }\r
 292     state : pInternal_state; { not visible by applications }\r
 293 \r
 294     zalloc : alloc_func;  { used to allocate the internal state }\r
 295     zfree : free_func;    { used to free the internal state }\r
 296     opaque : voidpf;      { private data object passed to zalloc and zfree }\r
 297 \r
 298     data_type : int;      { best guess about the data type: ascii or binary }\r
 299     adler : uLong;        { adler32 value of the uncompressed data }\r
 300     reserved : uLong;     { reserved for future use }\r
 301   end;\r
 302 \r
 303 \r
 304 {  The application must update next_in and avail_in when avail_in has\r
 305    dropped to zero. It must update next_out and avail_out when avail_out\r
 306    has dropped to zero. The application must initialize zalloc, zfree and\r
 307    opaque before calling the init function. All other fields are set by the\r
 308    compression library and must not be updated by the application.\r
 309 \r
 310    The opaque value provided by the application will be passed as the first\r
 311    parameter for calls of zalloc and zfree. This can be useful for custom\r
 312    memory management. The compression library attaches no meaning to the\r
 313    opaque value.\r
 314 \r
 315    zalloc must return Z_NULL if there is not enough memory for the object.\r
 316    On 16-bit systems, the functions zalloc and zfree must be able to allocate\r
 317    exactly 65536 bytes, but will not be required to allocate more than this\r
 318    if the symbol MAXSEG_64K is defined (see zconf.h). WARNING: On MSDOS,\r
 319    pointers returned by zalloc for objects of exactly 65536 bytes *must*\r
 320    have their offset normalized to zero. The default allocation function\r
 321    provided by this library ensures this (see zutil.c). To reduce memory\r
 322    requirements and avoid any allocation of 64K objects, at the expense of\r
 323    compression ratio, compile the library with -DMAX_WBITS=14 (see zconf.h).\r
 324 \r
 325    The fields total_in and total_out can be used for statistics or\r
 326    progress reports. After compression, total_in holds the total size of\r
 327    the uncompressed data and may be saved for use in the decompressor\r
 328    (particularly if the decompressor wants to decompress everything in\r
 329    a single step). }\r
 330 \r
 331 const  { constants }\r
 332    Z_NO_FLUSH      = 0;\r
 333    Z_PARTIAL_FLUSH = 1;\r
 334    Z_SYNC_FLUSH    = 2;\r
 335    Z_FULL_FLUSH    = 3;\r
 336    Z_FINISH        = 4;\r
 337 { Allowed flush values; see deflate() below for details }\r
 338 \r
 339    Z_OK            = 0;\r
 340    Z_STREAM_END    = 1;\r
 341    Z_NEED_DICT     = 2;\r
 342    Z_ERRNO         = (-1);\r
 343    Z_STREAM_ERROR  = (-2);\r
 344    Z_DATA_ERROR    = (-3);\r
 345    Z_MEM_ERROR     = (-4);\r
 346    Z_BUF_ERROR     = (-5);\r
 347    Z_VERSION_ERROR = (-6);\r
 348 { Return codes for the compression/decompression functions. Negative\r
 349   values are errors, positive values are used for special but normal events.}\r
 350 \r
 351    Z_NO_COMPRESSION         = 0;\r
 352    Z_BEST_SPEED             = 1;\r
 353    Z_BEST_COMPRESSION       = 9;\r
 354    Z_DEFAULT_COMPRESSION    = (-1);\r
 355 { compression levels }\r
 356 \r
 357    Z_FILTERED            = 1;\r
 358    Z_HUFFMAN_ONLY        = 2;\r
 359    Z_DEFAULT_STRATEGY    = 0;\r
 360 { compression strategy; see deflateInit2() below for details }\r
 361 \r
 362    Z_BINARY   = 0;\r
 363    Z_ASCII    = 1;\r
 364    Z_UNKNOWN  = 2;\r
 365 { Possible values of the data_type field }\r
 366 \r
 367    Z_DEFLATED   = 8;\r
 368 { The deflate compression method (the only one supported in this version) }\r
 369 \r
 370    Z_NULL  = NIL;  { for initializing zalloc, zfree, opaque }\r
 371 \r
 372   {$IFDEF GZIO}\r
 373 var\r
 374   errno : int;\r
 375   {$ENDIF}\r
 376 \r
 377         { common constants }\r
 378 \r
 379 \r
 380 { The three kinds of block type }\r
 381 const\r
 382   STORED_BLOCK = 0;\r
 383   STATIC_TREES = 1;\r
 384   DYN_TREES = 2;\r
 385 { The minimum and maximum match lengths }\r
 386 const\r
 387   MIN_MATCH = 3;\r
 388 {$ifdef MAX_MATCH_IS_258}\r
 389   MAX_MATCH = 258;\r
 390 {$else}\r
 391   MAX_MATCH = ??;    { deliberate syntax error }\r
 392 {$endif}\r
 393 \r
 394 const\r
 395   PRESET_DICT = $20; { preset dictionary flag in zlib header }\r
 396 \r
 397 \r
 398   {$IFDEF DEBUG}\r
 399   procedure Assert(cond : boolean; msg : string);\r
 400   {$ENDIF}\r
 401 \r
 402   procedure Trace(x : string);\r
 403   procedure Tracev(x : string);\r
 404   procedure Tracevv(x : string);\r
 405   procedure Tracevvv(x : string);\r
 406   procedure Tracec(c : boolean; x : string);\r
 407   procedure Tracecv(c : boolean; x : string);\r
 408 \r
 409 function zlibVersion : string;\r
 410 { The application can compare zlibVersion and ZLIB_VERSION for consistency.\r
 411   If the first character differs, the library code actually used is\r
 412   not compatible with the zlib.h header file used by the application.\r
 413   This check is automatically made by deflateInit and inflateInit. }\r
 414 \r
 415 function zError(err : int) : string;\r
 416 \r
 417 function ZALLOC (var strm : z_stream; items : uInt; size : uInt) : voidpf;\r
 418 \r
 419 procedure ZFREE (var strm : z_stream; ptr : voidpf);\r
 420 \r
 421 procedure TRY_FREE (var strm : z_stream; ptr : voidpf);\r
 422 \r
 423 const\r
 424   ZLIB_VERSION : string[10] = '1.1.2';\r
 425 \r
 426 const\r
 427   z_errbase = Z_NEED_DICT;\r
 428   z_errmsg : Array[0..9] of string[21] = { indexed by 2-zlib_error }\r
 429            ('need dictionary',     { Z_NEED_DICT       2  }\r
 430             'stream end',          { Z_STREAM_END      1  }\r
 431             '',                    { Z_OK              0  }\r
 432             'file error',          { Z_ERRNO         (-1) }\r
 433             'stream error',        { Z_STREAM_ERROR  (-2) }\r
 434             'data error',          { Z_DATA_ERROR    (-3) }\r
 435             'insufficient memory', { Z_MEM_ERROR     (-4) }\r
 436             'buffer error',        { Z_BUF_ERROR     (-5) }\r
 437             'incompatible version',{ Z_VERSION_ERROR (-6) }\r
 438             '');\r
 439 const\r
 440   z_verbose : int = 1;\r
 441 \r
 442 {$IFDEF DEBUG}\r
 443 procedure z_error (m : string);\r
 444 {$ENDIF}\r
 445 \r
 446 implementation\r
 447 \r
 448 function zError(err : int) : string;\r
 449 begin\r
 450   zError := z_errmsg[Z_NEED_DICT-err];\r
 451 end;\r
 452 \r
 453 function zlibVersion : string;\r
 454 begin\r
 455   zlibVersion := ZLIB_VERSION;\r
 456 end;\r
 457 \r
 458 procedure z_error (m : string);\r
 459 begin\r
 460   WriteLn(output, m);\r
 461   Write('Zlib - Halt...');\r
 462   ReadLn;\r
 463   Halt(1);\r
 464 end;\r
 465 \r
 466 procedure Assert(cond : boolean; msg : string);\r
 467 begin\r
 468   if not cond then\r
 469     z_error(msg);\r
 470 end;\r
 471 \r
 472 procedure Trace(x : string);\r
 473 begin\r
 474   WriteLn(x);\r
 475 end;\r
 476 \r
 477 procedure Tracev(x : string);\r
 478 begin\r
 479  if (z_verbose>0) then\r
 480    WriteLn(x);\r
 481 end;\r
 482 \r
 483 procedure Tracevv(x : string);\r
 484 begin\r
 485   if (z_verbose>1) then\r
 486     WriteLn(x);\r
 487 end;\r
 488 \r
 489 procedure Tracevvv(x : string);\r
 490 begin\r
 491   if (z_verbose>2) then\r
 492     WriteLn(x);\r
 493 end;\r
 494 \r
 495 procedure Tracec(c : boolean; x : string);\r
 496 begin\r
 497   if (z_verbose>0) and (c) then\r
 498     WriteLn(x);\r
 499 end;\r
 500 \r
 501 procedure Tracecv(c : boolean; x : string);\r
 502 begin\r
 503   if (z_verbose>1) and c then\r
 504     WriteLn(x);\r
 505 end;\r
 506 \r
 507 function ZALLOC (var strm : z_stream; items : uInt; size : uInt) : voidpf;\r
 508 begin\r
 509   ZALLOC := strm.zalloc(strm.opaque, items, size);\r
 510 end;\r
 511 \r
 512 procedure ZFREE (var strm : z_stream; ptr : voidpf);\r
 513 begin\r
 514   strm.zfree(strm.opaque, ptr);\r
 515 end;\r
 516 \r
 517 procedure TRY_FREE (var strm : z_stream; ptr : voidpf);\r
 518 begin\r
 519   {if @strm <> Z_NULL then}\r
 520     strm.zfree(strm.opaque, ptr);\r
 521 end;\r
 522 \r
 523 end.