LZScene

1
//
2
// This unit is part of the GLScene Engine https://github.com/glscene
3
//
4
{
5
  History :  
6
       16/02/11 - PREDATOR - Added support for Mac OS X. Tested on Mac OS X 10.6.5.
7
       18/05/10 - Yar - Changed to dynamic library loading for FPC (by Predator)
8
       06/05/10 - Yar - Added to GLScene (contributed by oleg matrozov)
9
   
10

11
******************************************************************************
12
*  ZLibExApi.pas                                                             *
13
*                                                                            *
14
*  copyright (c) 2000-2010 base2 technologies                                *
15
*  copyright (c) 1995-2002 Borland Software Corporation                      *
16
*                                                                            *
17
*  revision history                                                          *
18
*    2010.04.20  updated to zlib version 1.2.5                               *
19
*    2010.04.15  updated to zlib version 1.2.4                               *
20
*    2005.07.25  updated to zlib version 1.2.3                               *
21
*    2005.01.11  updated to zlib version 1.2.2                               *
22
*    2004.01.06  updated to zlib version 1.2.1                               *
23
*    2002.03.15  updated to zlib version 1.1.4                               *
24
*                                                                            *
25
*  acknowledgments                                                           *
26
*    burak kalayci                                                           *
27
*      2002.03.15  informing me about the zlib 1.1.4 update                  *
28
*      2004.01.06  informing me about the zlib 1.2.1 update                  *
29
*                                                                            *
30
*    vicente sanchez-alarcos                                                 *
31
*      2005.01.11  informing me about the zlib 1.2.2 update                  *
32
*                                                                            *
33
*    mathijs van veluw                                                       *
34
*      2005.07.25  informing me about the zlib 1.2.3 update                  *
35
*****************************************************************************}
36

37
unit GLSZLibExApi;
38

39
interface
40

41
{$I ZLibEx.inc}
42
{$I GLScene.inc}
43

44
const
45
  {** version ids ***********************************************************}
46

47

48

49
  {** compression methods ***************************************************}
50

51
  Z_DEFLATED = 8;
52

53
  {** information flags *****************************************************}
54

55
  Z_INFO_FLAG_SIZE  = $1;
56
  Z_INFO_FLAG_CRC   = $2;
57
  Z_INFO_FLAG_ADLER = $4;
58

59
  Z_INFO_NONE       = 0;
60
  Z_INFO_DEFAULT    = Z_INFO_FLAG_SIZE or Z_INFO_FLAG_CRC;
61

62
  {** flush constants *******************************************************}
63

64
  Z_NO_FLUSH      = 0;
65
  Z_PARTIAL_FLUSH = 1;
66
  Z_SYNC_FLUSH    = 2;
67
  Z_FULL_FLUSH    = 3;
68
  Z_FINISH        = 4;
69
  Z_BLOCK         = 5;
70
  Z_TREES         = 6;
71

72
  {** return codes **********************************************************}
73

74
  Z_OK            = 0;
75
  Z_STREAM_END    = 1;
76
  Z_NEED_DICT     = 2;
77
  Z_ERRNO         = (-1);
78
  Z_STREAM_ERROR  = (-2);
79
  Z_DATA_ERROR    = (-3);
80
  Z_MEM_ERROR     = (-4);
81
  Z_BUF_ERROR     = (-5);
82
  Z_VERSION_ERROR = (-6);
83

84
  {** compression levels ****************************************************}
85

86
  Z_NO_COMPRESSION      =   0;
87
  Z_BEST_SPEED          =   1;
88
  Z_BEST_COMPRESSION    =   9;
89
  Z_DEFAULT_COMPRESSION = (-1);
90

91
  {** compression strategies ************************************************}
92

93
  Z_FILTERED         = 1;
94
  Z_HUFFMAN_ONLY     = 2;
95
  Z_RLE              = 3;
96
  Z_FIXED            = 4;
97
  Z_DEFAULT_STRATEGY = 0;
98

99
  {** data types ************************************************************}
100

101
  Z_BINARY  = 0;
102
  Z_ASCII   = 1;
103
  Z_TEXT    = Z_ASCII;
104
  Z_UNKNOWN = 2;
105

106
  {** return code messages **************************************************}
107

108
  _z_errmsg: Array [0..9] of String = (
109
    'Need dictionary',      // Z_NEED_DICT      (2)
110
    'Stream end',           // Z_STREAM_END     (1)
111
    'OK',                   // Z_OK             (0)
112
    'File error',           // Z_ERRNO          (-1)
113
    'Stream error',         // Z_STREAM_ERROR   (-2)
114
    'Data error',           // Z_DATA_ERROR     (-3)
115
    'Insufficient memory',  // Z_MEM_ERROR      (-4)
116
    'Buffer error',         // Z_BUF_ERROR      (-5)
117
    'Incompatible version', // Z_VERSION_ERROR  (-6)
118
    ''
119
  );
120

121
type
122
  TZAlloc = function (opaque: Pointer; items, size: Integer): Pointer;
123
  TZFree  = procedure (opaque, block: Pointer);
124

125
  {** TZStreamRec ***********************************************************}
126

127
  TZStreamRec = packed record
128
    next_in  : Pointer;   // next input byte
129
    avail_in : Longint;   // number of bytes available at next_in
130
    total_in : Longint;   // total nb of input bytes read so far
131

132
    next_out : Pointer;   // next output byte should be put here
133
    avail_out: Longint;   // remaining free space at next_out
134
    total_out: Longint;   // total nb of bytes output so far
135

136
    msg      : Pointer;   // last error message, NULL if no error
137
    state    : Pointer;   // not visible by applications
138

139
    zalloc   : TZAlloc;   // used to allocate the internal state
140
    zfree    : TZFree;    // used to free the internal state
141
    opaque   : Pointer;   // private data object passed to zalloc and zfree
142

143
    data_type: Integer;   // best guess about the data type: ascii or binary
144
    adler    : Longint;   // adler32 value of the uncompressed data
145
    reserved : Longint;   // reserved for future use
146
  end;
147

148
{** macros ******************************************************************}
149

150
function deflateInit(var strm: TZStreamRec; level: Integer): Integer;
151
  {$ifdef Version2005Plus} inline; {$endif}
152

153
function deflateInit2(var strm: TZStreamRec; level, method, windowBits,
154
  memLevel, strategy: Integer): Integer;
155
  {$ifdef Version2005Plus} inline; {$endif}
156

157
function inflateInit(var strm: TZStreamRec): Integer;
158
  {$ifdef Version2005Plus} inline; {$endif}
159

160
function inflateInit2(var strm: TZStreamRec; windowBits: Integer): Integer;
161
  {$ifdef Version2005Plus} inline; {$endif}
162

163

164
  const
165
    {$IFDEF LINUX}
166
     libz = 'libz.so.1';
167
    {$ENDIF}
168
    {$IFDEF DARWIN}
169
     libz = '/usr/lib/libz.dylib';
170
    {$ENDIF}
171
    {$ifdef netware}  {zlib.nlm comes with netware6}
172
     libz='zlib';
173
    {$ENDIF}
174
    {$IFDEF MSWINDOWS}
175
     //Note that this is the official ZLIB1 .DLL from the http://www.zlib.net/
176
     libz='zlib1';
177
     {$ENDIF}
178

179

180
{** external routines *******************************************************}
181

182
function Initzlib : Boolean;
183
procedure Closezlib;
184
procedure ReadEntryPoints;
185
function zlibVersion(): string;
186
function ZLIB_VERSION(): PChar;
187
function zGetProcAddress(ProcName: PChar): Pointer;
188

189
var
190

191
zlibVersionpchar: function(): pchar; cdecl;
192
zErrorpchar: function (err: integer): pchar; cdecl;
193
inflateSyncPoint: function (z: TZstreamRec): integer; cdecl;
194
get_crc_table: function (): pointer; cdecl;
195

196
deflateInit_: function (var strm: TZStreamRec; level: Integer;
197
  version: PAnsiChar; recsize: Integer): Integer; cdecl;
198
deflateInit2_: function (var strm: TZStreamRec; level, method, windowBits,
199
  memLevel, strategy: Integer; version: PAnsiChar; recsize: Integer): Integer;
200
  cdecl;
201
deflate: function (var strm: TZStreamRec; flush: Integer): Integer;  cdecl;
202
deflateEnd: function (var strm: TZStreamRec): Integer; cdecl;
203
deflateReset: function (var strm: TZStreamRec): Integer; cdecl;
204

205
inflateInit_: function (var strm: TZStreamRec; version: PAnsiChar;
206
  recsize: Integer): Integer; cdecl;
207

208
inflateInit2_: function (var strm: TZStreamRec; windowBits: Integer;
209
  version: PAnsiChar; recsize: Integer): Integer ;cdecl;
210

211
inflate: function (var strm: TZStreamRec; flush: Integer): Integer; cdecl;
212

213
inflateEnd: function (var strm: TZStreamRec): Integer; cdecl;
214

215
inflateReset: function (var strm: TZStreamRec): Integer; cdecl;
216

217
adler32: function (adler: Longint; const buf; len: Integer): Longint;cdecl;
218

219
crc32: function (crc: Longint; const buf; len: Integer): Longint; cdecl;
220

221

222

223
implementation
224

225
Uses
226
  {$IFDEF GLS_LOGGING}  GLSLog, {$ENDIF}
227
  {$IFDEF MSWINDOWS}  Windows;  {$ENDIF}
228
  {$IFDEF GLS_X11_SUPPORT} x, {$ENDIF}
229
  {$IFDEF UNIX} dynlibs; {$ENDIF}
230

231
{*****************************************************************************
232
*  link zlib code                                                            *
233
*                                                                            *
234
*  bcc32 flags                                                               *
235
*    -c -O2 -Ve -X -pr -a8 -b -d -k- -vi -tWM                                *
236
*                                                                            *
237
*  note: do not reorder the following -- doing so will result in external    *
238
*  functions being undefined                                                 *
239
*****************************************************************************}
240

241

242
{** macros ******************************************************************}
243

244
function deflateInit(var strm: TZStreamRec; level: Integer): Integer;
245
begin
246
  result := deflateInit_(strm, level, ZLIB_VERSION, SizeOf(TZStreamRec));
247
end;
248

249
function deflateInit2(var strm: TZStreamRec; level, method, windowBits,
250
  memLevel, strategy: Integer): Integer;
251
begin
252
  result := deflateInit2_(strm, level, method, windowBits,
253
    memLevel, strategy, ZLIB_VERSION, SizeOf(TZStreamRec));
254
end;
255

256
function inflateInit(var strm: TZStreamRec): Integer;
257
begin
258
  result := inflateInit_(strm, ZLIB_VERSION, SizeOf(TZStreamRec));
259
end;
260

261
function inflateInit2(var strm: TZStreamRec; windowBits: Integer): Integer;
262
begin
263
  result := inflateInit2_(strm, windowBits, ZLIB_VERSION,
264
    SizeOf(TZStreamRec));
265
end;
266

267
{** external routines *******************************************************}
268

269

270
const
271
   INVALID_MODULEHANDLE = 0;
272

273
var
274
   {$IFDEF MSWINDOWS}
275
   vzHandle: HINST;//Pointer;
276
   {$ENDIF}
277
   {$IFDEF UNIX}
278
   vzHandle: TLibHandle = 0;//Pointer;
279
   {$ENDIF}
280

281
function Initzlib: Boolean;
282
begin
283
  Result := False;
284
  if (vzHandle=INVALID_MODULEHANDLE) then
285
  begin
286
     Closezlib;
287
     vzHandle := LoadLibrary(PChar(libz));
288
     if (vzHandle <> INVALID_MODULEHANDLE) then
289
      Result := True
290
     else begin
291
       if vzHandle <> INVALID_MODULEHANDLE then
292
         FreeLibrary(vzHandle);
293
      {$IFDEF GLS_GLS_LOGGING}
294
        GLSLogger.Log('ZLibEx.pas: Zlib library not loaded');
295
      {$ENDIF}
296
     end;
297
  end
298
  else Result:=True;
299
end;
300

301
procedure Closezlib;
302
begin
303
   if vzHandle<>INVALID_MODULEHANDLE then begin
304
      FreeLibrary(vzHandle);
305
      vzHandle:=INVALID_MODULEHANDLE;
306
   end;
307
end;
308

309
procedure ReadEntryPoints;
310
begin
311
  zlibVersionpchar := zGetProcAddress('zlibVersion');
312
  zErrorpchar := zGetProcAddress('zError');
313
  inflateSyncPoint := zGetProcAddress('inflateSyncPoint');
314
  get_crc_table := zGetProcAddress('get_crc_table');
315
  deflateInit_:= zGetProcAddress('deflateInit_');
316
  deflateInit2_:= zGetProcAddress('inflateInit2_');
317
  deflate:= zGetProcAddress('deflate');
318
  deflateEnd:= zGetProcAddress('deflateEnd');
319
  deflateReset:= zGetProcAddress('deflateReset');
320
  inflateInit_:= zGetProcAddress('inflateInit_');
321
  inflateInit2_:= zGetProcAddress('inflateInit2_');
322
  inflate:= zGetProcAddress('inflate');
323
  inflateEnd:= zGetProcAddress('inflateEnd');
324
  inflateReset:= zGetProcAddress('inflateReset');
325
  adler32:= zGetProcAddress('adler32');
326
  crc32:= zGetProcAddress('crc32');
327
end;
328

329
function zlibversion(): string;
330
begin
331
   zlibversion := string(zlibversionpchar);
332
end;
333

334
function ZLIB_VERSION(): PChar;
335
begin
336
  ZLIB_VERSION := zlibversionpchar;
337
end;
338

339
function zGetProcAddress(ProcName: PChar):Pointer;
340
begin
341
  result := GetProcAddress(vzHandle, ProcName);
342
end;
343

344
{** zlib function implementations *******************************************}
345

346
function zcalloc(opaque: Pointer; items, size: Integer): Pointer;
347
begin
348
  GetMem(result,items * size);
349
end;
350

351
procedure zcfree(opaque, block: Pointer);
352
begin
353
  FreeMem(block);
354
end;
355

356
{** c function implementations **********************************************}
357

358
procedure _memset(p: Pointer; b: Byte; count: Integer); cdecl;
359
begin
360
  FillChar(p^,count,b);
361
end;
362

363
procedure _memcpy(dest, source: Pointer; count: Integer); cdecl;
364
begin
365
  Move(source^,dest^,count);
366
end;
367

368
initialization
369

370

371
if Initzlib then ReadEntryPoints;
372

373

374
finalization
375

376

377
Closezlib;
378

379

380
end.
381