Chip 2001 September/Chip_2001-09_cd1.bin/zkuste/delphi/unity/d5/JRZIP.ZIP/Zlib/Zlib.pas

Pascal/Delphi Source File | 2000-04-03 | 18KB | 523 lines

Unit Zlib;


{ Original:
   zlib.h -- interface of the 'zlib' general purpose compression library
  version 1.1.0, Feb 24th, 1998

  Copyright (C) 1995-1998 Jean-loup Gailly and Mark Adler

  This software is provided 'as-is', without any express or implied
  warranty.  In no event will the authors 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.

  Jean-loup Gailly        Mark Adler
  [e-mail]          [e-mail]


  The data format used by the zlib library is described by RFCs (Request for
  Comments) 1950 to 1952 in the files ftp://ds.internic.net/rfc/rfc1950.txt
  (zlib format), rfc1951.txt (deflate format) and rfc1952.txt (gzip format).


  Pascal tranlastion
  Copyright (C) 1998 by Jacques Nomssi Nzali
  For conditions of distribution and use, see copyright notice in readme.txt
}

interface

{$I zconf.inc}

uses
  zutil;

{ zconf.h -- configuration of the zlib compression library }
{ zutil.c -- target dependent utility functions for the compression library }

{ The 'zlib' compression library provides in-memory compression and
  decompression functions, including integrity checks of the uncompressed
  data.  This version of the library supports only one compression method
  (deflation) but other algorithms will be added later and will have the same
  stream interface.

     Compression can be done in a single step if the buffers are large
  enough (for example if an input file is mmap'ed), or can be done by
  repeated calls of the compression function.  In the latter case, the
  application must provide more input and/or consume the output
  (providing more output space) before each call.

     The library also supports reading and writing files in gzip (.gz) format
  with an interface similar to that of stdio.

     The library does not install any signal handler. The decoder checks
  the consistency of the compressed data, so the library should never
  crash even in case of corrupted input. }



{ Compile with -DMAXSEG_64K if the alloc function cannot allocate more
  than 64k bytes at a time (needed on systems with 16-bit int). }

{ Maximum value for memLevel in deflateInit2 }
{$ifdef MAXSEG_64K}
  {$IFDEF VER70}
  const
    MAX_MEM_LEVEL = 7;
    DEF_MEM_LEVEL = MAX_MEM_LEVEL;  { default memLevel }
  {$ELSE}
  const
    MAX_MEM_LEVEL = 8;
    DEF_MEM_LEVEL = MAX_MEM_LEVEL;  { default memLevel }
  {$ENDIF}
{$else}
const
  MAX_MEM_LEVEL = 9;
  DEF_MEM_LEVEL = 8; { if MAX_MEM_LEVEL > 8 }
{$endif}

{ Maximum value for windowBits in deflateInit2 and inflateInit2 }
const
{$IFDEF VER70}
  MAX_WBITS = 14; { 32K LZ77 window }
{$ELSE}
  MAX_WBITS = 15; { 32K LZ77 window }
{$ENDIF}

{ default windowBits for decompression. MAX_WBITS is for compression only }
const
  DEF_WBITS = MAX_WBITS;

{ The memory requirements for deflate are (in bytes):
            1 shl (windowBits+2)   +  1 shl (memLevel+9)
 that is: 128K for windowBits=15  +  128K for memLevel = 8  (default values)
 plus a few kilobytes for small objects. For example, if you want to reduce
 the default memory requirements from 256K to 128K, compile with
     DMAX_WBITS=14 DMAX_MEM_LEVEL=7
 Of course this will generally degrade compression (there's no free lunch).

 The memory requirements for inflate are (in bytes) 1 shl windowBits
 that is, 32K for windowBits=15 (default value) plus a few kilobytes
 for small objects. }


{ Huffman code lookup table entry--this entry is four bytes for machines
  that have 16-bit pointers (e.g. PC's in the small or medium model). }

type
  pInflate_huft = ^inflate_huft;
  inflate_huft = Record
    Exop,             { number of extra bits or operation }
    bits : Byte;      { number of bits in this code or subcode }
    {pad : uInt;}       { pad structure to a power of 2 (4 bytes for }
                      {  16-bit, 8 bytes for 32-bit int's) }
    base : uInt;      { literal, length base, or distance base }
                      { or table offset }
  End;

type
  huft_field = Array[0..(MaxMemBlock div SizeOf(inflate_huft))-1] of inflate_huft;
  huft_ptr = ^huft_field;
type
  ppInflate_huft = ^pInflate_huft;

type
  inflate_codes_mode = ( { waiting for "i:"=input, "o:"=output, "x:"=nothing }
        START,    { x: set up for LEN }
        LEN,      { i: get length/literal/eob next }
        LENEXT,   { i: getting length extra (have base) }
        DIST,     { i: get distance next }
        DISTEXT,  { i: getting distance extra }
        COPY,     { o: copying bytes in window, waiting for space }
        LIT,      { o: got literal, waiting for output space }
        WASH,     { o: got eob, possibly still output waiting }
        ZEND,     { x: got eob and all data flushed }
        BADCODE); { x: got error }

{ inflate codes private state }
type
  pInflate_codes_state = ^inflate_codes_state;
  inflate_codes_state = record

    mode : inflate_codes_mode;        { current inflate_codes mode }

    { mode dependent information }
    len : uInt;
    sub : record                      { submode }
      Case Byte of
      0:(code : record                { if LEN or DIST, where in tree }
          tree : pInflate_huft;       { pointer into tree }
          need : uInt;                { bits needed }
         end);
      1:(lit : uInt);                 { if LIT, literal }
      2:(copy: record                 { if EXT or COPY, where and how much }
           get : uInt;                { bits to get for extra }
           dist : uInt;               { distance back to copy from }
         end);
    end;

    { mode independent information }
    lbits : Byte;                     { ltree bits decoded per branch }
    dbits : Byte;                     { dtree bits decoder per branch }
    ltree : pInflate_huft;            { literal/length/eob tree }
    dtree : pInflate_huft;            { distance tree }
  end;

type
  check_func = function(check : uLong;
                        buf : pBytef;
                        {const buf : array of byte;}
                    len : uInt) : uLong;
type
  inflate_block_mode =
     (ZTYPE,    { get type bits (3, including end bit) }
      LENS,     { get lengths for stored }
      STORED,   { processing stored block }
      TABLE,    { get table lengths }
      BTREE,    { get bit lengths tree for a dynamic block }
      DTREE,    { get length, distance trees for a dynamic block }
      CODES,    { processing fixed or dynamic block }
      DRY,      { output remaining window bytes }
      BLKDONE,  { finished last block, done }
      BLKBAD);  { got a data error--stuck here }

type
  pInflate_blocks_state = ^inflate_blocks_state;

{ inflate blocks semi-private state }
  inflate_blocks_state = record

    mode : inflate_block_mode;     { current inflate_block mode }

    { mode dependent information }
    sub : record                  { submode }
    case Byte of
    0:(left : uInt);              { if STORED, bytes left to copy }
    1:(trees : record             { if DTREE, decoding info for trees }
        table : uInt;               { table lengths (14 bits) }
        index : uInt;               { index into blens (or border) }
        blens : PuIntArray;         { bit lengths of codes }
        bb : uInt;                  { bit length tree depth }
        tb : pInflate_huft;         { bit length decoding tree }
      end);
    2:(decode : record            { if CODES, current state }
        tl : pInflate_huft;
        td : pInflate_huft;         { trees to free }
        codes : pInflate_codes_state;
      end);
    end;
    last : boolean;               { true if this block is the last block }

    { mode independent information }
    bitk : uInt;            { bits in bit buffer }
    bitb : uLong;           { bit buffer }
    hufts : huft_ptr; {pInflate_huft;}  { single malloc for tree space }
    window : pBytef;        { sliding window }
    zend : pBytef;          { one byte after sliding window }
    read : pBytef;          { window read pointer }
    write : pBytef;         { window write pointer }
    checkfn : check_func;   { check function }
    check : uLong;          { check on output }
  end;

type
  inflate_mode = (
      METHOD,   { waiting for method byte }
      FLAG,     { waiting for flag byte }
      DICT4,    { four dictionary check bytes to go }
      DICT3,    { three dictionary check bytes to go }
      DICT2,    { two dictionary check bytes to go }
      DICT1,    { one dictionary check byte to go }
      DICT0,    { waiting for inflateSetDictionary }
      BLOCKS,   { decompressing blocks }
      CHECK4,   { four check bytes to go }
      CHECK3,   { three check bytes to go }
      CHECK2,   { two check bytes to go }
      CHECK1,   { one check byte to go }
      DONE,     { finished check, done }
      BAD);     { got an error--stay here }

{ inflate private state }
type
  pInternal_state = ^internal_state; { or point to a deflate_state record }
  internal_state = record

     mode : inflate_mode;  { current inflate mode }

     { mode dependent information }
     sub : record          { submode }
       case byte of
       0:(method : uInt);  { if FLAGS, method byte }
       1:(check : record   { if CHECK, check values to compare }
           was : uLong;        { computed check value }
           need : uLong;       { stream check value }
          end);
       2:(marker : uInt);  { if BAD, inflateSync's marker bytes count }
     end;

     { mode independent information }
     nowrap : boolean;      { flag for no wrapper }
     wbits : uInt;          { log2(window size)  (8..15, defaults to 15) }
     blocks : pInflate_blocks_state;    { current inflate_blocks state }
   end;

type
  alloc_func = function(opaque : voidpf; items : uInt; size : uInt) : voidpf;
  free_func = procedure(opaque : voidpf; address : voidpf);

type
  z_streamp = ^z_stream;
  z_stream = record
    next_in : pBytef;     { next input byte }
    avail_in : uInt;      { number of bytes available at next_in }
    total_in : uLong;     { total nb of input bytes read so far }

    next_out : pBytef;    { next output byte should be put there }
    avail_out : uInt;     { remaining free space at next_out }
    total_out : uLong;    { total nb of bytes output so far }

    msg : string[255];         { last error message, '' if no error }
    state : pInternal_state; { not visible by applications }

    zalloc : alloc_func;  { used to allocate the internal state }
    zfree : free_func;    { used to free the internal state }
    opaque : voidpf;      { private data object passed to zalloc and zfree }

    data_type : int;      { best guess about the data type: ascii or binary }
    adler : uLong;        { adler32 value of the uncompressed data }
    reserved : uLong;     { reserved for future use }
  end;


{  The application must update next_in and avail_in when avail_in has
   dropped to zero. It must update next_out and avail_out when avail_out
   has dropped to zero. The application must initialize zalloc, zfree and
   opaque before calling the init function. All other fields are set by the
   compression library and must not be updated by the application.

   The opaque value provided by the application will be passed as the first
   parameter for calls of zalloc and zfree. This can be useful for custom
   memory management. The compression library attaches no meaning to the
   opaque value.

   zalloc must return Z_NULL if there is not enough memory for the object.
   On 16-bit systems, the functions zalloc and zfree must be able to allocate
   exactly 65536 bytes, but will not be required to allocate more than this
   if the symbol MAXSEG_64K is defined (see zconf.h). WARNING: On MSDOS,
   pointers returned by zalloc for objects of exactly 65536 bytes *must*
   have their offset normalized to zero. The default allocation function
   provided by this library ensures this (see zutil.c). To reduce memory
   requirements and avoid any allocation of 64K objects, at the expense of
   compression ratio, compile the library with -DMAX_WBITS=14 (see zconf.h).

   The fields total_in and total_out can be used for statistics or
   progress reports. After compression, total_in holds the total size of
   the uncompressed data and may be saved for use in the decompressor
   (particularly if the decompressor wants to decompress everything in
   a single step). }

const  { constants }
   Z_NO_FLUSH      = 0;
   Z_PARTIAL_FLUSH = 1;
   Z_SYNC_FLUSH    = 2;
   Z_FULL_FLUSH    = 3;
   Z_FINISH        = 4;
{ Allowed flush values; see deflate() below for details }

   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);
{ Return codes for the compression/decompression functions. Negative
  values are errors, positive values are used for special but normal events.}

   Z_NO_COMPRESSION         = 0;
   Z_BEST_SPEED             = 1;
   Z_BEST_COMPRESSION       = 9;
   Z_DEFAULT_COMPRESSION    = (-1);
{ compression levels }

   Z_FILTERED            = 1;
   Z_HUFFMAN_ONLY        = 2;
   Z_DEFAULT_STRATEGY    = 0;
{ compression strategy; see deflateInit2() below for details }

   Z_BINARY   = 0;
   Z_ASCII    = 1;
   Z_UNKNOWN  = 2;
{ Possible values of the data_type field }

   Z_DEFLATED   = 8;
{ The deflate compression method (the only one supported in this version) }

   Z_NULL  = NIL;  { for initializing zalloc, zfree, opaque }

  {$IFDEF GZIO}
var
  errno : int;
  {$ENDIF}

        { common constants }


{ The three kinds of block type }
const
  STORED_BLOCK = 0;
  STATIC_TREES = 1;
  DYN_TREES = 2;
{ The minimum and maximum match lengths }
const
  MIN_MATCH = 3;
{$ifdef MAX_MATCH_IS_258}
  MAX_MATCH = 258;
{$else}
  MAX_MATCH = ??;    { deliberate syntax error }
{$endif}

const
  PRESET_DICT = $20; { preset dictionary flag in zlib header }


  {$IFDEF DEBUG}
//  procedure Assert(cond : boolean; msg : string);
  {$ENDIF}

  procedure Trace(x : string);
  procedure Tracev(x : string);
  procedure Tracevv(x : string);
  procedure Tracevvv(x : string);
  procedure Tracec(c : boolean; x : string);
  procedure Tracecv(c : boolean; x : string);

function zlibVersion : string;
{ The application can compare zlibVersion and ZLIB_VERSION for consistency.
  If the first character differs, the library code actually used is
  not compatible with the zlib.h header file used by the application.
  This check is automatically made by deflateInit and inflateInit. }

function zError(err : int) : string;

function ZALLOC (var strm : z_stream; items : uInt; size : uInt) : voidpf;

procedure ZFREE (var strm : z_stream; ptr : voidpf);

procedure TRY_FREE (var strm : z_stream; ptr : voidpf);

const
  ZLIB_VERSION : string[10] = '1.1.2';

const
  z_errbase = Z_NEED_DICT;
  z_errmsg : Array[0..9] of string[21] = { indexed by 2-zlib_error }
           ('need dictionary',     { Z_NEED_DICT       2  }
            'stream end',          { Z_STREAM_END      1  }
            '',                    { Z_OK              0  }
            'file error',          { Z_ERRNO         (-1) }
            'stream error',        { Z_STREAM_ERROR  (-2) }
            'data error',          { Z_DATA_ERROR    (-3) }
            'insufficient memory', { Z_MEM_ERROR     (-4) }
            'buffer error',        { Z_BUF_ERROR     (-5) }
            'incompatible version',{ Z_VERSION_ERROR (-6) }
            '');
const
  z_verbose : int = 1;

{$IFDEF DEBUG}
procedure z_error (m : string);
{$ENDIF}

implementation

function zError(err : int) : string;
begin
  zError := z_errmsg[Z_NEED_DICT-err];
end;

function zlibVersion : string;
begin
  zlibVersion := ZLIB_VERSION;
end;

//procedure z_error (m : string);
//begin
//  WriteLn(output, m);
//  Write('Zlib - Halt...');
//  ReadLn;
//  Halt(1);
//end;

//procedure Assert(cond : boolean; msg : string);
//begin
//  if not cond then
//    z_error(msg);
//end;

procedure Trace(x : string);
begin
  WriteLn(x);
end;

procedure Tracev(x : string);
begin
 if (z_verbose>0) then
   WriteLn(x);
end;

procedure Tracevv(x : string);
begin
  if (z_verbose>1) then
    WriteLn(x);
end;

procedure Tracevvv(x : string);
begin
  if (z_verbose>2) then
    WriteLn(x);
end;

procedure Tracec(c : boolean; x : string);
begin
  if (z_verbose>0) and (c) then
    WriteLn(x);
end;

procedure Tracecv(c : boolean; x : string);
begin
  if (z_verbose>1) and c then
    WriteLn(x);
end;

function ZALLOC (var strm : z_stream; items : uInt; size : uInt) : voidpf;
begin
  ZALLOC := strm.zalloc(strm.opaque, items, size);
end;

procedure ZFREE (var strm : z_stream; ptr : voidpf);
begin
  strm.zfree(strm.opaque, ptr);
end;

procedure TRY_FREE (var strm : z_stream; ptr : voidpf);
begin
  {if @strm <> Z_NULL then}
    strm.zfree(strm.opaque, ptr);
end;

end.