{ +-------------------------------------------------------------+ }
{ |                                                             | }
{ |   GM-Software                                               | }
{ |   ===========                                               | }
{ |                                                             | }
{ |   Project: All Projects                                     | }
{ |                                                             | }
{ |   Description: Compress/Decompress Streams. ZIP and gZIP    | }
{ |                support.                                     | }
{ |                                                             | }
{ |   Copyright (C) - 2002 - Gerrit Moeller.                    | }
{ |                                                             | }
{ |   Source code dstributed under MIT license.                 | }
{ |                                                             | }
{ |   See: https://www.gm-software.de                           | }
{ |                                                             | }
{ +-------------------------------------------------------------+ }

{$INCLUDE GMCompilerSettings.inc}

{.$DEFINE EXTERNAL_CRC}      // <- Link CRC32 from original C object code
{.$DEFINE STATIC_CRC_TABLE}  // <- use a static crc32 table instead of creating it dynamically
{.$DEFINE PASZLIB} // <- Use the pascal conversion of zlib instead of linking C object files

{$IFDEF FPC}
  {$DEFINE PASZLIB}
{$ENDIF}

{$IFDEF PASZLIB}
  {$UNDEF EXTERNAL_CRC}
{$ENDIF}

unit GMZStrm;

interface

uses {$IFNDEF JEDIAPI}Windows,{$ELSE}jwaWinType,{$ENDIF}
     GMStrDef, GMActiveX, Sysutils, GMCommon, GMIntf
     {$IFDEF PASZLIB},zbase{$ENDIF}
     {$IFDEF DELPHIVCL}, Classes{$ENDIF}
     ;

type

  TGzipTrailerInfo = (tiCrc32, tiLength);
  PGzipTrailerData = ^TGzipTrailerData;
  TGzipTrailerData = array [TGzipTrailerInfo] of LongWord;

  TAlloc = function (AppData: Pointer; Items, Size: LongWord): Pointer;
  TFree = procedure (AppData, Block: Pointer); 

  {$IFNDEF PASZLIB}
  // Data for communication with low level compress/uncompress routines
  TZStreamRec = packed record
    next_in: Pointer;     // next input byte
    avail_in: LongWord;   // number of bytes available at next_in
    total_in: LongWord;   // total nb of input bytes read so far

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

    msg: PAnsiChar;           // last error message, NULL if no error
    internal_state: Pointer;    // not visible by applications

    zalloc: TAlloc;       // used to allocate the internal state
    zfree: TFree;         // used to free the internal state
    AppData: Pointer;     // private data object passed to zalloc and zfree

    data_type: Integer;   // best guess about the data type: ascii or binary
    adler: LongWord;      // adler32 value of the uncompressed data
    reserved: LongWord;   // reserved for future use
  end;
  {$ELSE}
  TZStreamRec = z_stream;
  {$ENDIF}


  TGMCompressionStrength = (ctNone, ctFastest, ctMedium, ctMaximum);
  TGMCompressionStrategy = (cstDefault, cstFiltered, cstHuffman, cStrLE, cstFixed);

  //Z_FILTERED            = 1;
  //Z_HUFFMAN_ONLY        = 2;
  //Z_RLE                 = 3;
  //Z_FIXED               = 4;
  //Z_DEFAULT_STRATEGY    = 0;


  PZErrorDescRec = ^TZErrorDescRec;
  TZErrorDescRec = record
   Code: Integer;
   SymbolicName: AnsiString;
   Msg: AnsiString;
  end;


  PCrc32Table = ^TCRC32Table;
  TCRC32Table = array [Byte] of LongWord;


  { -------------------------------- }
  { ---- Borland Stream Classes ---- }
  { -------------------------------- }

  {$IFDEF DELPHIVCL}
  TGMZStreamBase = class(TGMIStreamAdapter);


  TGMCompressorStream = class(TGMZStreamBase)
   public
    constructor Create(const ADest: TStream;
                       const ACompression: TGMCompressionStrength = ctMaximum);

    constructor CreateGZip(const ADest: TStream;
                           const ACompression: TGMCompressionStrength = ctMaximum;
                           const AFileName: TGMString = '';
                           const AStrategy: TGMCompressionStrategy = cstDefault);
  end;


  TGMDecompressorStream = class(TGMZStreamBase)
   public
    constructor Create(const ASource: TStream);
  end;
  {$ENDIF}


  { ----------------------------------- }
  { ---- Interfaced Stream Classes ---- }
  { ----------------------------------- }

  TGMZipIStreamBase = class(TGMSequentialIStream)
   protected
    FStream: ISequentialStream;
    FZRec: TZStreamRec;
    FBuffer: Pointer;
    FCrc32CeckSum: LongWord;

   public
    constructor Create(const AStream: ISequentialStream; const AMode: LongInt; const AName: TGMString; const ARefLifeTime: Boolean = True); reintroduce; overload;
    destructor Destroy; override;
  end;


  TGMZipCompressorIStream = class(TGMZipIStreamBase)
   protected
    FWriteGZipFileFormat: Boolean;

    procedure InternalRead(pv: Pointer; cb: LongWord; var pcbRead: LongWord); override;
    procedure InternalWrite(pv: Pointer; cb: LongWord; var pcbWritten: LongWord); override;
    procedure WriteGZipFileHeader(const AFileName: AnsiString; const ACompression: TGMCompressionStrength; ALastModUTC: TDateTime);

   public
    procedure FinishCompression;

    constructor Create(const ADest: ISequentialStream;
                       const ACompression: TGMCompressionStrength = ctMaximum;
                       const ARefLifeTime: Boolean = True); reintroduce; overload;

    constructor CreateGZip(const ADest: ISequentialStream;
                           const ACompression: TGMCompressionStrength = ctMaximum;
                           const AStrategy: TGMCompressionStrategy = cstDefault;
                           const AFileName: TGMString = '';
                           const ALastModUTC: TDateTime = 0;
                           const ARefLifeTime: Boolean = True);

    destructor Destroy; override;
  end;


  TGMZipDecompressorIStream = class(TGMZipIStreamBase, IGMGetFileName)
   protected
    FFileName: TGMString;
    FHeaderSize: LongWord;
    FIsGZipFile: Boolean;
    FGZipFileTrailer: PGzipTrailerData;
    FSourceEOF: Boolean;

    procedure ReadGZipFileHeader;

    procedure InternalRead(pv: Pointer; cb: LongWord; var pcbRead: LongWord); override;
    procedure InternalWrite(pv: Pointer; cb: LongWord; var pcbWritten: LongWord); override;

   public
    constructor Create(const ASource: ISequentialStream; const ARefLifeTime: Boolean = True); reintroduce; overload;
    destructor Destroy; override;
    function GetFileName: TGMString; stdcall;
  end;


  { ---------------------------------------- }
  { ---- Compress/Decompress Exceptions ---- }
  { ---------------------------------------- }

  EGMCompressionError = class(EGMException)
   public
    constructor ObjError(const AErrorCode: Integer;
                         const AObj: TObject = nil;
                         const ARoutineName: TGMString = cDfltRoutineName;
                         const AHelpCtx: Integer = cDfltHelpCtx); reintroduce; overload;
  end;

  EGMCompressError = class(EGMCompressionError);
  EGMDecompressError = class(EGMCompressionError);


function CCheck(const ACode: Integer; const ACaller: TObject; const ACallingRoutineName: TGMString = cDfltRoutineName): Integer;
function DCheck(const ACode: Integer; const ACaller: TObject; const ACallingRoutineName: TGMString = cDfltRoutineName): Integer;


{ ------------------------------------------------- }
{ ---- External C Compress/Decompress Routines ---- }
{ ------------------------------------------------- }
{$IFNDEF PASZLIB}
function deflateInit_(var StrmRec: TZStreamRec; level: Integer; version: PAnsiChar; stream_size: Integer): Integer; external;
function deflate(var StrmRec: TZStreamRec; flush: Integer): Integer; external;
function deflateEnd(var StrmRec: TZStreamRec): Integer; external;
function deflateInit2_(var StrmRec: TZStreamRec; level, method, windowbits, memlevel, strategy: Integer; version: PAnsiChar; stream_size: Integer): Integer; external;

function inflateInit_(var StrmRec: TZStreamRec; version: PAnsiChar; recsize: Integer): Integer; external;
function inflateInit2_(var StrmRec: TZStreamRec; WindowBits: Integer; version: PAnsiChar; recsize: Integer): Integer; external;
function inflateSync(var StrmRec: TZStreamRec): Integer; external;
function inflate(var StrmRec: TZStreamRec; flush: Integer): Integer; external;
function inflateEnd(var StrmRec: TZStreamRec): Integer; external;
function inflateReset(var StrmRec: TZStreamRec): Integer; external;
{$ENDIF}

{$IFDEF EXTERNAL_CRC}  // <- will be undefined in case PASZLIB is defined
function crc32(Crc: LongWord; const Data: Pointer; const DataSize: LongWord): LongWord; cdecl; external; // <- may be not cdecl!
{$ELSE}
//function crc32(const APrevCrc: LongWord; AData: PByte; const ADataSize: LongWord): LongWord;
function crc32(APrevCrc: LongWord; AData: PByte; ADataSize: LongWord): LongWord;
{$ENDIF}


resourcestring

  RStrNoCompression = 'No compression';
  RStrFastestComression = 'Fastest compression';
  RStrMediumCompression = 'Medium compression';
  RStrMaximumCompression = 'Maximum compression';

  RStrSuccess = 'compression successful';
  RStrStreamEnd = 'stream end';
  RStrNeedDic = 'need dictionary';
  RStrFileError = 'file error';
  RStrStreamError = 'stream error';
  RStrDataError = 'data error';
  RStrMemoryError = 'insufficient memory';
  RStrBufferError = 'buffer error';
  RStrVersionError = 'incompatible version';


const

  zlib_Version = '1.2.3';

  gzfText = $1;
  gzfHdrCrc = $2;
  gzfExtra = $4;
  gzfName = $8;
  gzfComment = $10;

  {$IFNDEF PASZLIB}
  Z_NO_FLUSH      = 0;
  Z_PARTIAL_FLUSH = 1;
  Z_SYNC_FLUSH    = 2;
  Z_FULL_FLUSH    = 3;
  Z_FINISH        = 4;

  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;

  Z_NO_COMPRESSION       =  0;
  Z_BEST_SPEED           =  1;
  Z_BEST_COMPRESSION     =  9;
  Z_DEFAULT_COMPRESSION  = -1;

  Z_BINARY   = 0;
  Z_ASCII    = 1;
  Z_UNKNOWN  = 2;

  Z_DEFLATED = 8;

  MAX_WBITS = 15;
  DEF_MEM_LEVEL = 8;
  {$ENDIF}
  Z_OS_WIN_FAT = 0;

  cGZipSignature: Word = $8b1f; // <- swapped byte order
  cGZipFileTrailerSize = SizeOf(TGzipTrailerData); // 2 * SizeOf(LongWord); // CRC & Length
  cCompressBufferSize: LongWord = cDfltCopyBufferSize; // $10000; // <- 64 KB
  CComprLevels: array [TGMCompressionStrength] of ShortInt = (Z_NO_COMPRESSION, Z_BEST_SPEED, Z_DEFAULT_COMPRESSION, Z_BEST_COMPRESSION);


{$IFNDEF EXTERNAL_CRC}
{$IFDEF STATIC_CRC_TABLE}
  CRC32Table: array [Byte] of LongWord =
   ( $00000000, $77073096, $EE0E612C, $990951BA, $076DC419,
     $706AF48F, $E963A535, $9E6495A3, $0EDB8832, $79DCB8A4,
     $E0D5E91E, $97D2D988, $09B64C2B, $7EB17CBD, $E7B82D07,
     $90BF1D91, $1DB71064, $6AB020F2, $F3B97148, $84BE41DE,
     $1ADAD47D, $6DDDE4EB, $F4D4B551, $83D385C7, $136C9856,
     $646BA8C0, $FD62F97A, $8A65C9EC, $14015C4F, $63066CD9,
     $FA0F3D63, $8D080DF5, $3B6E20C8, $4C69105E, $D56041E4,
     $A2677172, $3C03E4D1, $4B04D447, $D20D85FD, $A50AB56B,
     $35B5A8FA, $42B2986C, $DBBBC9D6, $ACBCF940, $32D86CE3,
     $45DF5C75, $DCD60DCF, $ABD13D59, $26D930AC, $51DE003A,
     $C8D75180, $BFD06116, $21B4F4B5, $56B3C423, $CFBA9599,
     $B8BDA50F, $2802B89E, $5F058808, $C60CD9B2, $B10BE924,
     $2F6F7C87, $58684C11, $C1611DAB, $B6662D3D, $76DC4190,
     $01DB7106, $98D220BC, $EFD5102A, $71B18589, $06B6B51F,
     $9FBFE4A5, $E8B8D433, $7807C9A2, $0F00F934, $9609A88E,
     $E10E9818, $7F6A0DBB, $086D3D2D, $91646C97, $E6635C01,
     $6B6B51F4, $1C6C6162, $856530D8, $F262004E, $6C0695ED,
     $1B01A57B, $8208F4C1, $F50FC457, $65B0D9C6, $12B7E950,
     $8BBEB8EA, $FCB9887C, $62DD1DDF, $15DA2D49, $8CD37CF3,
     $FBD44C65, $4DB26158, $3AB551CE, $A3BC0074, $D4BB30E2,
     $4ADFA541, $3DD895D7, $A4D1C46D, $D3D6F4FB, $4369E96A,
     $346ED9FC, $AD678846, $DA60B8D0, $44042D73, $33031DE5,
     $AA0A4C5F, $DD0D7CC9, $5005713C, $270241AA, $BE0B1010,
     $C90C2086, $5768B525, $206F85B3, $B966D409, $CE61E49F,
     $5EDEF90E, $29D9C998, $B0D09822, $C7D7A8B4, $59B33D17,
     $2EB40D81, $B7BD5C3B, $C0BA6CAD, $EDB88320, $9ABFB3B6,
     $03B6E20C, $74B1D29A, $EAD54739, $9DD277AF, $04DB2615,
     $73DC1683, $E3630B12, $94643B84, $0D6D6A3E, $7A6A5AA8,
     $E40ECF0B, $9309FF9D, $0A00AE27, $7D079EB1, $F00F9344,
     $8708A3D2, $1E01F268, $6906C2FE, $F762575D, $806567CB,
     $196C3671, $6E6B06E7, $FED41B76, $89D32BE0, $10DA7A5A,
     $67DD4ACC, $F9B9DF6F, $8EBEEFF9, $17B7BE43, $60B08ED5,
     $D6D6A3E8, $A1D1937E, $38D8C2C4, $4FDFF252, $D1BB67F1,
     $A6BC5767, $3FB506DD, $48B2364B, $D80D2BDA, $AF0A1B4C,
     $36034AF6, $41047A60, $DF60EFC3, $A867DF55, $316E8EEF,
     $4669BE79, $CB61B38C, $BC66831A, $256FD2A0, $5268E236,
     $CC0C7795, $BB0B4703, $220216B9, $5505262F, $C5BA3BBE,
     $B2BD0B28, $2BB45A92, $5CB36A04, $C2D7FFA7, $B5D0CF31,
     $2CD99E8B, $5BDEAE1D, $9B64C2B0, $EC63F226, $756AA39C,
     $026D930A, $9C0906A9, $EB0E363F, $72076785, $05005713,
     $95BF4A82, $E2B87A14, $7BB12BAE, $0CB61B38, $92D28E9B,
     $E5D5BE0D, $7CDCEFB7, $0BDBDF21, $86D3D2D4, $F1D4E242,
     $68DDB3F8, $1FDA836E, $81BE16CD, $F6B9265B, $6FB077E1,
     $18B74777, $88085AE6, $FF0F6A70, $66063BCA, $11010B5C,
     $8F659EFF, $F862AE69, $616BFFD3, $166CCF45, $A00AE278,
     $D70DD2EE, $4E048354, $3903B3C2, $A7672661, $D06016F7,
     $4969474D, $3E6E77DB, $AED16A4A, $D9D65ADC, $40DF0B66,
     $37D83BF0, $A9BCAE53, $DEBB9EC5, $47B2CF7F, $30B5FFE9,
     $BDBDF21C, $CABAC28A, $53B39330, $24B4A3A6, $BAD03605,
     $CDD70693, $54DE5729, $23D967BF, $B3667A2E, $C4614AB8,
     $5D681B02, $2A6F2B94, $B40BBE37, $C30C8EA1, $5A05DF1B,
     $2D02EF8D
   );
{$ENDIF}   
{$ENDIF}


var

  gComressionTypeNames: array [TGMCompressionStrength] of AnsiString = (RStrNoCompression, RStrFastestComression, RStrMediumCompression, RStrMaximumCompression);
  gZErrorDescs: array [0..8] of TZErrorDescRec = (
   (Code: Z_OK; SymbolicName: 'Z_OK'; MSg: RStrSuccess),
   (Code: Z_STREAM_END; SymbolicName: 'Z_STREAM_END'; MSg: RStrStreamEnd),
   (Code: Z_NEED_DICT; SymbolicName: 'Z_NEED_DICT'; MSg: RStrNeedDic),
   (Code: Z_ERRNO; SymbolicName: 'Z_ERRNO'; MSg: RStrFileError),
   (Code: Z_STREAM_ERROR; SymbolicName: 'Z_STREAM_ERROR'; MSg: RStrStreamError),
   (Code: Z_DATA_ERROR; SymbolicName: 'Z_DATA_ERROR'; MSg: RStrDataError),
   (Code: Z_MEM_ERROR; SymbolicName: 'Z_MEM_ERROR'; MSg: RStrMemoryError),
   (Code: Z_BUF_ERROR; SymbolicName: 'Z_BUF_ERROR'; MSg: RStrBufferError),
   (Code: Z_VERSION_ERROR; SymbolicName: 'Z_VERSION_ERROR'; MSg: RStrVersionError));

       

implementation

{$IFDEF JEDIAPI}uses jwaWinError{$IFDEF PASZLIB}, zinflate, zdeflate{$ENDIF};{$ELSE}
{$IFDEF PASZLIB}uses zinflate, zdeflate;{$ENDIF}
{$ENDIF}

{$IFNDEF PASZLIB}
{$IFDEF DELPHI5}
  {$L deflate.obj}
  {$L inflate.obj}
  {$L inftrees.obj}
  {$L inffast.obj}
  {$L trees.obj}
  {$L adler32.obj}
  {$IFDEF EXTERNAL_CRC}
  {$L crc32.obj}
  {$ENDIF}
{$ELSE}
  {$IFDEF WIN32}
    {$linklib C:\codetyphon\CodeOcean\0_libraries\zengl\msvcrt\i386\libmsvcrt.a}
    {$L C:\codetyphon\CodeOcean\ZenGL\xlib\zlib\i386-win32\deflate.obj}
    {$L C:\codetyphon\CodeOcean\ZenGL\xlib\zlib\i386-win32\inflate.obj}
    {$L C:\codetyphon\CodeOcean\ZenGL\xlib\zlib\i386-win32\inftrees.obj}
    {$L C:\codetyphon\CodeOcean\ZenGL\xlib\zlib\i386-win32\inffast.obj}
    {$L C:\codetyphon\CodeOcean\ZenGL\xlib\zlib\i386-win32\trees.obj}
    {$L C:\codetyphon\CodeOcean\ZenGL\xlib\zlib\i386-win32\adler32.obj}
    {$IFDEF EXTERNAL_CRC}
    {$L C:\codetyphon\CodeOcean\ZenGL\xlib\zlib\i386-win32\crc32.obj}
    {$ENDIF}

    // C:\codetyphon\typhon\components\pl_Indy\source\ZLib\i386-Win32-ZLib\
  {$ENDIF}
  {$IFDEF WIN64}
    {$linklib C:\codetyphon\CodeOcean\0_libraries\zengl\msvcrt\x86_64\libmsvcrt.a}
    {$L C:\codetyphon\typhon\components\pl_Indy\source\ZLib\x86_64-Win64-ZLib\adler32.obj}
    {$L C:\codetyphon\typhon\components\pl_Indy\source\ZLib\x86_64-Win64-ZLib\compress.obj}
    {$L C:\codetyphon\typhon\components\pl_Indy\source\ZLib\x86_64-Win64-ZLib\deflate.obj}
    {$L C:\codetyphon\typhon\components\pl_Indy\source\ZLib\x86_64-Win64-ZLib\infback.obj}
    {$L C:\codetyphon\typhon\components\pl_Indy\source\ZLib\x86_64-Win64-ZLib\inffast.obj}
    {$L C:\codetyphon\typhon\components\pl_Indy\source\ZLib\x86_64-Win64-ZLib\inflate.obj}
    {$L C:\codetyphon\typhon\components\pl_Indy\source\ZLib\x86_64-Win64-ZLib\inftrees.obj}
    {$L C:\codetyphon\typhon\components\pl_Indy\source\ZLib\x86_64-Win64-ZLib\trees.obj}
    //{$L C:\codetyphon\typhon\components\pl_Indy\source\ZLib\x86_64-Win64-ZLib\uncompr.obj}
    {$L C:\codetyphon\typhon\components\pl_Indy\source\ZLib\x86_64-Win64-ZLib\zutil.obj}
    {$IFDEF EXTERNAL_CRC}
    {$L C:\codetyphon\typhon\components\pl_Indy\source\ZLib\x86_64-Win64-ZLib\crc32.obj}
    {$ENDIF}
  {$ENDIF}
{$ENDIF}
{$ENDIF}


resourcestring

  RStrCompressionErrorFmt = 'ZLIB Compression Error (%d), %s, Message: %s';
  RStrUnknownErrorCode = 'Unknown ZLIB Error Code: %d';

  RStrInvalidCrc = 'Incorrect ZLIB crc32 checksum';
  RStrIncorrectSrcLen = 'Incorrect uncompressed data length';


var
  {$IFNDEF PASZLIB}
  // external C symbol, but we will use above error GMMessages from resource strings
  _z_errmsg: array [0..9] of PAnsiChar = (nil, nil, nil, nil, nil, nil, nil, nil, nil, nil);
  {$ENDIF}
  {$IFNDEF EXTERNAL_CRC}
  {$IFNDEF STATIC_CRC_TABLE}
  vCSCreateCrc32Table: IGMCriticalSection = nil;
  vCRC32Table: AnsiString = ''; // <- used to store the crc32 table
  {$ENDIF}
  {$ENDIF}


{ ------------------------------------- }
{ ---- Routines called from C-code ---- }
{ ------------------------------------- }
{$IFNDEF PASZLIB}
{$IFNDEF FPC}
procedure _memset(P: Pointer; B: Byte; count: Integer); cdecl;
begin
  FillChar(P^, count, B);
end;

procedure _memcpy(dest, source: Pointer; count: Integer); cdecl;
begin
  System.Move(source^, dest^, count);
end;

function compressBound(sourceLen: LongWord): LongWord; cdecl;
begin
  Result := sourceLen + (sourceLen shr 12) + (sourceLen shr 14) + 11;
end;
{$ENDIF}

function zcalloc(opaque: Pointer; items, size: LongWord): Pointer;
begin
  GetMem(Result,items * size);
end;

procedure zcfree(opaque, block: Pointer);
begin
  FreeMem(block);
end;
{$ENDIF}


{ ------------------------- }
{ ---- Global Routines ---- }
{ ------------------------- }

function CCheck(const ACode: Integer; const ACaller: TObject; const ACallingRoutineName: TGMString): Integer;
begin
  Result := ACode;
  if ACode < 0 then raise EGMCompressError.ObjError(ACode, ACaller, ACallingRoutineName);
end;

function DCheck(const ACode: Integer; const ACaller: TObject; const ACallingRoutineName: TGMString): Integer;
begin
  Result := ACode;
  if ACode < 0 then raise EGMDecompressError.ObjError(ACode, ACaller, ACallingRoutineName);
end;

{$IFNDEF EXTERNAL_CRC}
{$IFNDEF STATIC_CRC_TABLE}
function BuildCrc32Table: PCrc32Table;
var i, j: Integer; c: LongWord;
begin
  if vCSCreateCrc32Table <> nil then vCSCreateCrc32Table.EnterCriticalSection;
  try
   if Length(vCRC32Table) = 0 then
    begin
     SetLength(vCRC32Table, SizeOf(TCRC32Table)); // <- we store the crc32 table in an Ansi-String which will be freed by compiler generated code automatically
     Result := PCrc32Table(PAnsiChar(vCRC32Table));
     for i:=0 to 255 do
      begin
       c := i;
       for j:=0 to 7 do if c and 1 <> 0 then c := $edb88320 xor (c shr 1) else c := c shr 1;
       Result[i] := c;
      end;
    end
   else Result := PCrc32Table(PAnsiChar(vCRC32Table));
  finally
   if vCSCreateCrc32Table <> nil then vCSCreateCrc32Table.LeaveCriticalSection;
  end;
end;
{$ENDIF}

//function crc32(const APrevCrc: LongWord; AData: PByte; const ADataSize: LongWord): LongWord;
//var i: LongWord; crc32Table: PCrc32Table;
//begin
//{$IFDEF STATIC_CRC_TABLE}
//  crc32Table := @CRC32Table;
//{$ELSE}
//  crc32Table := BuildCrc32Table;
//{$ENDIF}
//
//  if AData = nil then begin Result := 0; Exit; end;
//  Result := APrevCrc xor $ffffffff;
//  for i:=1 to ADataSize do // <- for loop is a little faster than while loop
//   begin
//    Result := crc32Table[Byte(Result mod $100) xor AData^] xor (Result div $100);
//    Inc(AData);
//   end;
//  Result := Result xor $ffffffff;
//end;
//{$ENDIF}

function crc32(APrevCrc: LongWord; AData: PByte; ADataSize: LongWord): LongWord;
var crc32Table: PCrc32Table;
begin
  if AData = nil then begin Result := 0; Exit; end;

  {$IFDEF STATIC_CRC_TABLE}
    crc32Table := @CRC32Table;
  {$ELSE}
    crc32Table := BuildCrc32Table;
  {$ENDIF}

  APrevCrc := APrevCrc xor $FFFFFFFF;
  while (ADataSize >= 8) do
   begin
    APrevCrc := crc32Table[(APrevCrc xor AData^) and $ff] xor (APrevCrc shr 8);
    Inc(AData);
    APrevCrc := crc32Table[(APrevCrc xor AData^) and $ff] xor (APrevCrc shr 8);
    Inc(AData);
    APrevCrc := crc32Table[(APrevCrc xor AData^) and $ff] xor (APrevCrc shr 8);
    Inc(AData);
    APrevCrc := crc32Table[(APrevCrc xor AData^) and $ff] xor (APrevCrc shr 8);
    Inc(AData);
    APrevCrc := crc32Table[(APrevCrc xor AData^) and $ff] xor (APrevCrc shr 8);
    Inc(AData);
    APrevCrc := crc32Table[(APrevCrc xor AData^) and $ff] xor (APrevCrc shr 8);
    Inc(AData);
    APrevCrc := crc32Table[(APrevCrc xor AData^) and $ff] xor (APrevCrc shr 8);
    Inc(AData);
    APrevCrc := crc32Table[(APrevCrc xor AData^) and $ff] xor (APrevCrc shr 8);
    Inc(AData);
    Dec(ADataSize, 8);
   end;

  while (ADataSize > 0) do
   begin
    APrevCrc := crc32Table[(APrevCrc xor AData^) and $ff] xor (APrevCrc shr 8);
    Inc(AData);
    Dec(ADataSize);
   end;

  Result := APrevCrc xor $FFFFFFFF;
end;
{$ENDIF}


{ ----------------------------- }
{ ---- EGMCompressionError ---- }
{ ----------------------------- }

constructor EGMCompressionError.ObjError(const AErrorCode: Integer;
                                         const AObj: TObject = nil;
                                         const ARoutineName: TGMString = cDfltRoutineName;
                                         const AHelpCtx: Integer = cDfltHelpCtx);
var i: Integer; PErrDesc: PZErrorDescRec;
begin
  PErrDesc := nil;
  for i:=Low(gZErrorDescs) to High(gZErrorDescs) do
    if AErrorCode = gZErrorDescs[i].Code then begin PErrDesc := @gZErrorDescs[i]; Break; end;

  if PErrDesc = nil then
   inherited ObjError(GMFormat(RStrUnknownErrorCode, [AErrorCode]), AObj, ARoutineName, svError, AHelpCtx)
  else
   inherited ObjError(GMFormat(RStrCompressionErrorFmt, [AErrorCode, PErrDesc.SymbolicName, PErrDesc.Msg]), AObj, ARoutineName, svError, AHelpCtx);
end;


{ ----------------------------- }
{ ---- TGMCompressorStream ---- }
{ ----------------------------- }

{$IFDEF DELPHIVCL}
constructor TGMCompressorStream.Create(const ADest: TStream;
                                       const ACompression: TGMCompressionStrength = ctMaximum);
begin
  inherited Create(TGMZipCompressorIStream.Create(TGMStreamAdapter.Create(ADest, False), ACompression, True));
end;

constructor TGMCompressorStream.CreateGZip(const ADest: TStream;
                                           const ACompression: TGMCompressionStrength;
                                           const AfileName: TGMString;
                                           const AStrategy: TGMCompressionStrategy);
begin
  inherited Create(TGMZipCompressorIStream.CreateGZip(TGMStreamAdapter.Create(ADest, False), ACompression, AStrategy, AfileName, True));
end;
{$ENDIF}


{ ------------------------------- }
{ ---- TGMDecompressorStream ---- }
{ ------------------------------- }

{$IFDEF DELPHIVCL}
constructor TGMDecompressorStream.Create(const ASource: TStream);
const cStrMethodName = 'Create';
begin
  inherited Create(TGMZipDecompressorIStream.Create(TGMStreamAdapter.Create(ASource, False)));
end;
{$ENDIF}


{ --------------------------- }
{ ---- TGMZipIStreamBase ---- }
{ --------------------------- }

constructor TGMZipIStreamBase.Create(const AStream: ISequentialStream; const AMode: LongInt; const AName: TGMString; const ARefLifeTime: Boolean = True);
begin
  Assert(AStream <> nil);
  inherited Create(AMode, AName, ARefLifeTime);
  FStream := AStream;
  FCrc32CeckSum := crc32(0, nil, 0);
  GetMem(FBuffer, cCompressBufferSize);
  {$IFNDEF PASZLIB}
  FZRec.zalloc := zcalloc;
  FZRec.zfree := zcfree;
  {$ENDIF}
end;

destructor TGMZipIStreamBase.Destroy;
begin
  if FBuffer <> nil then FreeMem(FBuffer);
  inherited Destroy;
end;


{ ----------------------------------- }
{ ---- TGMZipDecompressorIStream ---- }
{ ----------------------------------- }

constructor TGMZipDecompressorIStream.Create(const ASource: ISequentialStream; const ARefLifeTime: Boolean = True);
const cStrMethodName = 'Create';
begin
  inherited Create(ASource, STGM_READ, '', ARefLifeTime);
  GMHrCheckObj(FStream.Read(FBuffer, SizeOf(cGZipSignature), PLongInt(@FHeaderSize)), Self, cStrMethodName);

  if FHeaderSize = SizeOf(cGZipSignature) then
   begin
    FIsGZipFile := Word(FBuffer^) = cGZipSignature;
    if FIsGZipFile then begin FHeaderSize := 0; ReadGZipFileHeader; end;
   end;

  if FIsGZipFile then
   DCheck(inflateInit2_(FZRec, -MAX_WBITS, zlib_version, sizeof(FZRec)), Self, cStrMethodName)
  else
   DCheck(inflateInit_({$IFDEF PASZLIB}@{$ENDIF}FZRec, zlib_version, sizeof(FZRec)), Self, cStrMethodName);
end;

destructor TGMZipDecompressorIStream.Destroy;
begin
  try
   inflateEnd(FZRec);
   if FGZipFileTrailer <> nil then Dispose(FGZipFileTrailer);
  except end;
  inherited Destroy;
end;

function TGMZipDecompressorIStream.GetFileName: TGMString; stdcall;
begin
  Result := FFileName;
end;

procedure TGMZipDecompressorIStream.ReadGZipFileHeader;
const cStrMethodName = 'TGMZipDecompressorIStream.ReadGZipFileHeader';
var comprMethod, flags, xFlag, OSCode, ch: Byte; time: LongInt; wLen, crc16: Word; bufStr: AnsiString;
begin
  GMSafeIStreamRead(FStream, @comprMethod, SizeOf(comprMethod), cStrMethodName);
  GMSafeIStreamRead(FStream, @flags, SizeOf(flags), cStrMethodName);
  GMSafeIStreamRead(FStream, @time, SizeOf(time), cStrMethodName);
  GMSafeIStreamRead(FStream, @xFlag, SizeOf(xFlag), cStrMethodName);
  GMSafeIStreamRead(FStream, @OSCode, SizeOf(OSCode), cStrMethodName);

  if flags and gzfExtra <> 0 then
   begin
    GMSafeIStreamRead(FStream, @wLen, SizeOf(wLen), cStrMethodName);
    SetLength(bufStr, wLen);
    GMSafeIStreamRead(FStream, PAnsiChar(bufStr), wLen, cStrMethodName);
    SetLength(bufStr, 0); // <- Discard the extra data
   end;

  if flags and gzfName <> 0 then
   begin
    FFileName := '';
    repeat
     GMSafeIStreamRead(FStream, @ch, SizeOf(ch), cStrMethodName);
     if ch <> 0 then FFileName := FFileName + Chr(ch);
    until ch = 0;
   end;

  if flags and gzfComment <> 0 then
   repeat
    GMSafeIStreamRead(FStream, @ch, SizeOf(ch), cStrMethodName);
   until ch = 0;

  if flags and gzfHdrCrc <> 0 then
    GMSafeIStreamRead(FStream, @crc16, SizeOf(crc16), cStrMethodName);
    {ToDo: Check header CRC}
end;

procedure TGMZipDecompressorIStream.InternalRead(pv: Pointer; cb: LongWord; var pcbRead: LongWord);
const cStrMethodName = 'Read';
var N: LongWord;
begin
  FZRec.next_out := pv;
  FZRec.avail_out := cb;
  repeat
   if (FZRec.avail_in = 0) and not FSourceEOF then
    begin
     if FGZipFileTrailer <> nil then
      begin
       System.Move(FGZipFileTrailer^, FBuffer^, cGZipFileTrailerSize);
       Inc(FHeaderSize, cGZipFileTrailerSize);
      end;

     GMHrCheckObj(FStream.Read(GMAddPtr(FBuffer, FHeaderSize), cCompressBufferSize - FHeaderSize, PLongInt(@FZRec.avail_in)), Self, cStrMethodName);
     Inc(FZRec.avail_in, FHeaderSize);

     if FIsGZipFile then
      begin
       if FGZipFileTrailer = nil then New(FGZipFileTrailer);
       GMHrCheckObj(FStream.Read(FGZipFileTrailer, cGZipFileTrailerSize, PLongInt(@N)), Self, cStrMethodName);
       if N < cGZipFileTrailerSize then
        begin
         FSourceEOF := True;
         System.Move(FGZipFileTrailer^, GMAddPtr(FGZipFileTrailer, cGZipFileTrailerSize - N)^, N);
         System.Move(GMAddPtr(FBuffer, FZRec.avail_in - cGZipFileTrailerSize + N)^, FGZipFileTrailer^, cGZipFileTrailerSize - N);
         FZRec.avail_in := Max(0, FZRec.avail_in - cGZipFileTrailerSize - N);
        end;
      end
     else if FZRec.avail_in < cCompressBufferSize then FSourceEOF := True;

     FHeaderSize := 0;
     FZRec.next_in := FBuffer;
    end;
   {if FZRec.avail_in > 0 then} DCheck(inflate(FZRec, 0), Self, cStrMethodName);
  until (FZRec.avail_out = 0) or FSourceEOF;

  if FIsGZipFile then
   begin
    if FZRec.avail_out < LongWord(cb) then FCrc32CeckSum := crc32(FCrc32CeckSum, pv, LongWord(cb) - FZRec.avail_out);
    if (FGZipFileTrailer <> nil) and (FZRec.avail_out > 0) then // <- end of uncompressing
     begin
      if FCrc32CeckSum <> FGZipFileTrailer^[tiCrc32] then raise EGMException.ObjError(RStrInvalidCrc, Self, cStrMethodName);
      if FZRec.total_out <> FGZipFileTrailer^[tiLength] then raise EGMException.ObjError(RStrIncorrectSrcLen, Self, cStrMethodName);
     end;
   end;

  pcbRead := LongWord(cb) - FZRec.avail_out;
end;

procedure TGMZipDecompressorIStream.InternalWrite(pv: Pointer; cb: LongWord; var pcbWritten: LongWord);
begin
  raise EGMHrException.ObjError(STG_E_INVALIDFUNCTION, [], Self, 'InternalWrite');
end;


{ --------------------------------- }
{ ---- TGMZipCompressorIStream ---- }
{ --------------------------------- }

constructor TGMZipCompressorIStream.Create(const ADest: ISequentialStream;
                                           const ACompression: TGMCompressionStrength = ctMaximum;
                                           const ARefLifeTime: Boolean = True);
const cStrMethodName = 'Create';
begin
  inherited Create(ADest, STGM_WRITE, '', ARefLifeTime);
  FZRec.next_out := FBuffer;
  FZRec.avail_out := cCompressBufferSize;
  CCheck(deflateInit_({$IFDEF PASZLIB}@{$ENDIF}FZRec, CComprLevels[ACompression], zlib_version, sizeof(FZRec)), Self, cStrMethodName);
end;

constructor TGMZipCompressorIStream.CreateGZip(const ADest: ISequentialStream;
                                               const ACompression: TGMCompressionStrength;
                                               const AStrategy: TGMCompressionStrategy;
                                               const AFileName: TGMString;
                                               const ALastModUTC: TDateTime;
                                               const ARefLifeTime: Boolean);
const cStrMethodName = 'CreateGZip';
begin
  inherited Create(ADest, STGM_WRITE, AFileName, ARefLifeTime);
  FWriteGZipFileFormat := True;
  FZRec.next_out := FBuffer;
  FZRec.avail_out := cCompressBufferSize;
  CCheck(deflateInit2_(FZRec, CComprLevels[ACompression], Z_DEFLATED, -MAX_WBITS, DEF_MEM_LEVEL, Ord(AStrategy), zlib_version, sizeof(FZRec)), Self, cStrMethodName);
  WriteGZipFileHeader(AFileName, ACompression, ALastModUTC);
end;

destructor TGMZipCompressorIStream.Destroy;
const cStrMethodName = 'TGMZipCompressorIStream.Destroy';
var sizeInBytes: LongWord;
begin
  try
   FinishCompression;
   if FWriteGZipFileFormat then
    begin
     GMSafeIStreamWrite(FStream, @FCrc32CeckSum, SizeOf(FCrc32CeckSum), cStrMethodName);
     sizeInBytes := FZRec.total_in;
     GMSafeIStreamWrite(FStream, @sizeInBytes, SizeOf(sizeInBytes), cStrMethodName);
    end;
  except end;
  inherited Destroy;
end;

procedure TGMZipCompressorIStream.WriteGZipFileHeader(const AFileName: AnsiString; const ACompression: TGMCompressionStrength; ALastModUTC: TDateTime);
type TGZipHeader = packed record
                    FileID_1: Byte;
                    FileID_2: Byte;
                    CompressionMethod: Byte;
                    Flags: Byte;
                    LastMod: LongWord;
                    ExtraFlags: Byte;
                    OS: Byte;
                   end;

const cStrMethodName = 'WriteGZipFileHeader';
      cName: array [Boolean] of Byte = (0, gzfName);
      cType: array [TGMCompressionStrength] of BYte = (0, 4, 0, 2);

var gzHeader: TGZipHeader; // array [0..9] of Byte;
begin
  //FillChar(gzHeader, SizeOf(gzHeader), 0);

  if ALastModUTC = 0 then ALastModUTC := GMLocalTimeToUTC(Now);

  gzHeader.FileID_1 := $1f;
  gzHeader.FileID_2 := $8b;
  gzHeader.CompressionMethod := Z_DEFLATED;
  gzHeader.Flags := cName[Length(AFileName) > 0];
  gzHeader.LastMod := GMUnixTimeFromDateTime(ALastModUTC);
  gzHeader.ExtraFlags := cType[ACompression];
  gzHeader.OS := Z_OS_WIN_FAT;

  //gzHeader[0] := $1f;
  //gzHeader[1] := $8b;
  //gzHeader[2] := Z_DEFLATED;
  //gzHeader[3] := cName[Length(AFileName) > 0];
  //gzHeader[8] := cType[ACompression];
  //gzHeader[9] := Z_OS_WIN_FAT;
  //
  //Move(DateTimeToUnixTime(GMLocalTimeToUTC(Now)), gzHeader[4], SizeOf(LongWord));

  GMSafeIStreamWrite(FStream, @gzHeader, SizeOf(gzHeader), cStrMethodName);
  if Length(AFileName) > 0 then GMSafeIStreamWrite(FStream, PAnsiChar(AFileName), Length(AFileName)+1, cStrMethodName);
  {ToDo: Add gzHeader checksum}
end;

procedure TGMZipCompressorIStream.FinishCompression;
const cStrMethodName = 'FinishCompression';
var code: Integer;
begin
  FZRec.next_in := nil;
  FZRec.avail_in := 0;
  try
   repeat
    code := CCheck(deflate(FZRec, Z_FINISH), Self, cStrMethodName);
    GMSafeIStreamWrite(FStream, FBuffer, cCompressBufferSize - FZRec.avail_out, cStrMethodName);
    FZRec.avail_out := cCompressBufferSize;
    FZRec.next_out := FBuffer;
   until code = Z_STREAM_END; // -> or (FZRec.avail_out > 0);
  finally
   deflateEnd(FZRec);
  end;
end;

procedure TGMZipCompressorIStream.InternalWrite(pv: Pointer; cb: LongWord; var pcbWritten: LongWord);
const cStrMethodName = 'InternalWrite';
begin
  FZRec.next_in := pv;
  FZRec.avail_in := cb;

  if FWriteGZipFileFormat then FCrc32CeckSum := crc32(FCrc32CeckSum, pv, cb);

  while (FZRec.avail_in > 0) do
   begin
    CCheck(deflate(FZRec, 0), Self, cStrMethodName);
    if FZRec.avail_out = 0 then
     begin
      GMSafeIStreamWrite(FStream, FBuffer, cCompressBufferSize - FZRec.avail_out, cStrMethodName);
      FZRec.avail_out := cCompressBufferSize;
      FZRec.next_out := FBuffer;
     end;
   end;

  pcbWritten := LongWord(cb) - FZRec.avail_in;
end;

procedure TGMZipCompressorIStream.InternalRead(pv: Pointer; cb: LongWord; var pcbRead: LongWord);
begin
  raise EGMHrException.ObjError(STG_E_INVALIDFUNCTION, [], Self, 'InternalRead');
end;


initialization

{$IFNDEF EXTERNAL_CRC}
{$IFNDEF STATIC_CRC_TABLE}
  vCSCreateCrc32Table := TGMCriticalSection.Create(True);
{$ENDIF}
{$ENDIF}

end.