Home | History | Annotate | Line # | Download | only in pascal
zlibpas.pas revision 1.1
      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  christos   ZLIB_VERSION = '1.2.3';
     14  1.1  christos 
     15  1.1  christos type
     16  1.1  christos   alloc_func = function(opaque: Pointer; items, size: Integer): Pointer;
     17  1.1  christos                  cdecl;
     18  1.1  christos   free_func  = procedure(opaque, address: Pointer);
     19  1.1  christos                  cdecl;
     20  1.1  christos 
     21  1.1  christos   in_func    = function(opaque: Pointer; var buf: PByte): Integer;
     22  1.1  christos                  cdecl;
     23  1.1  christos   out_func   = function(opaque: Pointer; buf: PByte; size: Integer): Integer;
     24  1.1  christos                  cdecl;
     25  1.1  christos 
     26  1.1  christos   z_streamp = ^z_stream;
     27  1.1  christos   z_stream = packed record
     28  1.1  christos     next_in: PChar;       (* next input byte *)
     29  1.1  christos     avail_in: Integer;    (* number of bytes available at next_in *)
     30  1.1  christos     total_in: LongInt;    (* total nb of input bytes read so far *)
     31  1.1  christos 
     32  1.1  christos     next_out: PChar;      (* next output byte should be put there *)
     33  1.1  christos     avail_out: Integer;   (* remaining free space at next_out *)
     34  1.1  christos     total_out: LongInt;   (* total nb of bytes output so far *)
     35  1.1  christos 
     36  1.1  christos     msg: PChar;           (* last error message, NULL if no error *)
     37  1.1  christos     state: Pointer;       (* not visible by applications *)
     38  1.1  christos 
     39  1.1  christos     zalloc: alloc_func;   (* used to allocate the internal state *)
     40  1.1  christos     zfree: free_func;     (* used to free the internal state *)
     41  1.1  christos     opaque: Pointer;      (* private data object passed to zalloc and zfree *)
     42  1.1  christos 
     43  1.1  christos     data_type: Integer;   (* best guess about the data type: ascii or binary *)
     44  1.1  christos     adler: LongInt;       (* adler32 value of the uncompressed data *)
     45  1.1  christos     reserved: LongInt;    (* reserved for future use *)
     46  1.1  christos   end;
     47  1.1  christos 
     48  1.1  christos (* constants *)
     49  1.1  christos const
     50  1.1  christos   Z_NO_FLUSH      = 0;
     51  1.1  christos   Z_PARTIAL_FLUSH = 1;
     52  1.1  christos   Z_SYNC_FLUSH    = 2;
     53  1.1  christos   Z_FULL_FLUSH    = 3;
     54  1.1  christos   Z_FINISH        = 4;
     55  1.1  christos 
     56  1.1  christos   Z_OK            =  0;
     57  1.1  christos   Z_STREAM_END    =  1;
     58  1.1  christos   Z_NEED_DICT     =  2;
     59  1.1  christos   Z_ERRNO         = -1;
     60  1.1  christos   Z_STREAM_ERROR  = -2;
     61  1.1  christos   Z_DATA_ERROR    = -3;
     62  1.1  christos   Z_MEM_ERROR     = -4;
     63  1.1  christos   Z_BUF_ERROR     = -5;
     64  1.1  christos   Z_VERSION_ERROR = -6;
     65  1.1  christos 
     66  1.1  christos   Z_NO_COMPRESSION       =  0;
     67  1.1  christos   Z_BEST_SPEED           =  1;
     68  1.1  christos   Z_BEST_COMPRESSION     =  9;
     69  1.1  christos   Z_DEFAULT_COMPRESSION  = -1;
     70  1.1  christos 
     71  1.1  christos   Z_FILTERED            = 1;
     72  1.1  christos   Z_HUFFMAN_ONLY        = 2;
     73  1.1  christos   Z_RLE                 = 3;
     74  1.1  christos   Z_DEFAULT_STRATEGY    = 0;
     75  1.1  christos 
     76  1.1  christos   Z_BINARY   = 0;
     77  1.1  christos   Z_ASCII    = 1;
     78  1.1  christos   Z_UNKNOWN  = 2;
     79  1.1  christos 
     80  1.1  christos   Z_DEFLATED = 8;
     81  1.1  christos 
     82  1.1  christos (* basic functions *)
     83  1.1  christos function zlibVersion: PChar;
     84  1.1  christos function deflateInit(var strm: z_stream; level: Integer): Integer;
     85  1.1  christos function deflate(var strm: z_stream; flush: Integer): Integer;
     86  1.1  christos function deflateEnd(var strm: z_stream): Integer;
     87  1.1  christos function inflateInit(var strm: z_stream): Integer;
     88  1.1  christos function inflate(var strm: z_stream; flush: Integer): Integer;
     89  1.1  christos function inflateEnd(var strm: z_stream): Integer;
     90  1.1  christos 
     91  1.1  christos (* advanced functions *)
     92  1.1  christos function deflateInit2(var strm: z_stream; level, method, windowBits,
     93  1.1  christos                       memLevel, strategy: Integer): Integer;
     94  1.1  christos function deflateSetDictionary(var strm: z_stream; const dictionary: PChar;
     95  1.1  christos                               dictLength: Integer): Integer;
     96  1.1  christos function deflateCopy(var dest, source: z_stream): Integer;
     97  1.1  christos function deflateReset(var strm: z_stream): Integer;
     98  1.1  christos function deflateParams(var strm: z_stream; level, strategy: Integer): Integer;
     99  1.1  christos function deflateBound(var strm: z_stream; sourceLen: LongInt): LongInt;
    100  1.1  christos function deflatePrime(var strm: z_stream; bits, value: Integer): Integer;
    101  1.1  christos function inflateInit2(var strm: z_stream; windowBits: Integer): Integer;
    102  1.1  christos function inflateSetDictionary(var strm: z_stream; const dictionary: PChar;
    103  1.1  christos                               dictLength: Integer): Integer;
    104  1.1  christos function inflateSync(var strm: z_stream): Integer;
    105  1.1  christos function inflateCopy(var dest, source: z_stream): Integer;
    106  1.1  christos function inflateReset(var strm: z_stream): Integer;
    107  1.1  christos function inflateBackInit(var strm: z_stream;
    108  1.1  christos                          windowBits: Integer; window: PChar): Integer;
    109  1.1  christos function inflateBack(var strm: z_stream; in_fn: in_func; in_desc: Pointer;
    110  1.1  christos                      out_fn: out_func; out_desc: Pointer): Integer;
    111  1.1  christos function inflateBackEnd(var strm: z_stream): Integer;
    112  1.1  christos function zlibCompileFlags: LongInt;
    113  1.1  christos 
    114  1.1  christos (* utility functions *)
    115  1.1  christos function compress(dest: PChar; var destLen: LongInt;
    116  1.1  christos                   const source: PChar; sourceLen: LongInt): Integer;
    117  1.1  christos function compress2(dest: PChar; var destLen: LongInt;
    118  1.1  christos                   const source: PChar; sourceLen: LongInt;
    119  1.1  christos                   level: Integer): Integer;
    120  1.1  christos function compressBound(sourceLen: LongInt): LongInt;
    121  1.1  christos function uncompress(dest: PChar; var destLen: LongInt;
    122  1.1  christos                     const source: PChar; sourceLen: LongInt): Integer;
    123  1.1  christos 
    124  1.1  christos (* checksum functions *)
    125  1.1  christos function adler32(adler: LongInt; const buf: PChar; len: Integer): LongInt;
    126  1.1  christos function crc32(crc: LongInt; const buf: PChar; len: Integer): LongInt;
    127  1.1  christos 
    128  1.1  christos (* various hacks, don't look :) *)
    129  1.1  christos function deflateInit_(var strm: z_stream; level: Integer;
    130  1.1  christos                       const version: PChar; stream_size: Integer): Integer;
    131  1.1  christos function inflateInit_(var strm: z_stream; const version: PChar;
    132  1.1  christos                       stream_size: Integer): Integer;
    133  1.1  christos function deflateInit2_(var strm: z_stream;
    134  1.1  christos                        level, method, windowBits, memLevel, strategy: Integer;
    135  1.1  christos                        const version: PChar; stream_size: Integer): Integer;
    136  1.1  christos function inflateInit2_(var strm: z_stream; windowBits: Integer;
    137  1.1  christos                        const version: PChar; stream_size: Integer): Integer;
    138  1.1  christos function inflateBackInit_(var strm: z_stream;
    139  1.1  christos                           windowBits: Integer; window: PChar;
    140  1.1  christos                           const version: PChar; stream_size: Integer): Integer;
    141  1.1  christos 
    142  1.1  christos 
    143  1.1  christos implementation
    144  1.1  christos 
    145  1.1  christos {$L adler32.obj}
    146  1.1  christos {$L compress.obj}
    147  1.1  christos {$L crc32.obj}
    148  1.1  christos {$L deflate.obj}
    149  1.1  christos {$L infback.obj}
    150  1.1  christos {$L inffast.obj}
    151  1.1  christos {$L inflate.obj}
    152  1.1  christos {$L inftrees.obj}
    153  1.1  christos {$L trees.obj}
    154  1.1  christos {$L uncompr.obj}
    155  1.1  christos {$L zutil.obj}
    156  1.1  christos 
    157  1.1  christos function adler32; external;
    158  1.1  christos function compress; external;
    159  1.1  christos function compress2; external;
    160  1.1  christos function compressBound; external;
    161  1.1  christos function crc32; external;
    162  1.1  christos function deflate; external;
    163  1.1  christos function deflateBound; external;
    164  1.1  christos function deflateCopy; external;
    165  1.1  christos function deflateEnd; external;
    166  1.1  christos function deflateInit_; external;
    167  1.1  christos function deflateInit2_; external;
    168  1.1  christos function deflateParams; external;
    169  1.1  christos function deflatePrime; external;
    170  1.1  christos function deflateReset; external;
    171  1.1  christos function deflateSetDictionary; external;
    172  1.1  christos function inflate; external;
    173  1.1  christos function inflateBack; external;
    174  1.1  christos function inflateBackEnd; external;
    175  1.1  christos function inflateBackInit_; external;
    176  1.1  christos function inflateCopy; external;
    177  1.1  christos function inflateEnd; external;
    178  1.1  christos function inflateInit_; external;
    179  1.1  christos function inflateInit2_; external;
    180  1.1  christos function inflateReset; external;
    181  1.1  christos function inflateSetDictionary; external;
    182  1.1  christos function inflateSync; external;
    183  1.1  christos function uncompress; external;
    184  1.1  christos function zlibCompileFlags; external;
    185  1.1  christos function zlibVersion; external;
    186  1.1  christos 
    187  1.1  christos function deflateInit(var strm: z_stream; level: Integer): Integer;
    188  1.1  christos begin
    189  1.1  christos   Result := deflateInit_(strm, level, ZLIB_VERSION, sizeof(z_stream));
    190  1.1  christos end;
    191  1.1  christos 
    192  1.1  christos function deflateInit2(var strm: z_stream; level, method, windowBits, memLevel,
    193  1.1  christos                       strategy: Integer): Integer;
    194  1.1  christos begin
    195  1.1  christos   Result := deflateInit2_(strm, level, method, windowBits, memLevel, strategy,
    196  1.1  christos                           ZLIB_VERSION, sizeof(z_stream));
    197  1.1  christos end;
    198  1.1  christos 
    199  1.1  christos function inflateInit(var strm: z_stream): Integer;
    200  1.1  christos begin
    201  1.1  christos   Result := inflateInit_(strm, ZLIB_VERSION, sizeof(z_stream));
    202  1.1  christos end;
    203  1.1  christos 
    204  1.1  christos function inflateInit2(var strm: z_stream; windowBits: Integer): Integer;
    205  1.1  christos begin
    206  1.1  christos   Result := inflateInit2_(strm, windowBits, ZLIB_VERSION, sizeof(z_stream));
    207  1.1  christos end;
    208  1.1  christos 
    209  1.1  christos function inflateBackInit(var strm: z_stream;
    210  1.1  christos                          windowBits: Integer; window: PChar): Integer;
    211  1.1  christos begin
    212  1.1  christos   Result := inflateBackInit_(strm, windowBits, window,
    213  1.1  christos                              ZLIB_VERSION, sizeof(z_stream));
    214  1.1  christos end;
    215  1.1  christos 
    216  1.1  christos function _malloc(Size: Integer): Pointer; cdecl;
    217  1.1  christos begin
    218  1.1  christos   GetMem(Result, Size);
    219  1.1  christos end;
    220  1.1  christos 
    221  1.1  christos procedure _free(Block: Pointer); cdecl;
    222  1.1  christos begin
    223  1.1  christos   FreeMem(Block);
    224  1.1  christos end;
    225  1.1  christos 
    226  1.1  christos procedure _memset(P: Pointer; B: Byte; count: Integer); cdecl;
    227  1.1  christos begin
    228  1.1  christos   FillChar(P^, count, B);
    229  1.1  christos end;
    230  1.1  christos 
    231  1.1  christos procedure _memcpy(dest, source: Pointer; count: Integer); cdecl;
    232  1.1  christos begin
    233  1.1  christos   Move(source^, dest^, count);
    234  1.1  christos end;
    235  1.1  christos 
    236  1.1  christos end.
    237