Home | History | Annotate | Line # | Download | only in pascal
      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