{ +-------------------------------------------------------------+ } { | | } { | GM-Software | } { | =========== | } { | | } { | Project: All Projects | } { | | } { | Description: Compress/Decompress Streams. ZIP and gZIP | } { | support. | } { | | } { | Copyright (C) - 2002 - Gerrit Moeller. | } { | | } { | Source code distributed 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 FillByte(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); 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); begin inherited Create(ASource, STGM_READ, '', ARefLifeTime); GMHrCheckObj(FStream.Read(FBuffer, SizeOf(cGZipSignature), PLongInt(@FHeaderSize)), Self, {$I %CurrentRoutine%}); 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, {$I %CurrentRoutine%}) else DCheck(inflateInit_({$IFDEF PASZLIB}@{$ENDIF}FZRec, zlib_version, sizeof(FZRec)), Self, {$I %CurrentRoutine%}); 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; var comprMethod, flags, xFlag, OSCode, ch: Byte; time: LongInt; wLen, crc16: Word; bufStr: AnsiString; begin GMSafeIStreamRead(FStream, @comprMethod, SizeOf(comprMethod), {$I %CurrentRoutine%}); GMSafeIStreamRead(FStream, @flags, SizeOf(flags), {$I %CurrentRoutine%}); GMSafeIStreamRead(FStream, @time, SizeOf(time), {$I %CurrentRoutine%}); GMSafeIStreamRead(FStream, @xFlag, SizeOf(xFlag), {$I %CurrentRoutine%}); GMSafeIStreamRead(FStream, @OSCode, SizeOf(OSCode), {$I %CurrentRoutine%}); if flags and gzfExtra <> 0 then begin GMSafeIStreamRead(FStream, @wLen, SizeOf(wLen), {$I %CurrentRoutine%}); SetLength(bufStr, wLen); GMSafeIStreamRead(FStream, PAnsiChar(bufStr), wLen, {$I %CurrentRoutine%}); SetLength(bufStr, 0); // <- Discard the extra data end; if flags and gzfName <> 0 then begin FFileName := ''; repeat GMSafeIStreamRead(FStream, @ch, SizeOf(ch), {$I %CurrentRoutine%}); if ch <> 0 then FFileName := FFileName + Chr(ch); until ch = 0; end; if flags and gzfComment <> 0 then repeat GMSafeIStreamRead(FStream, @ch, SizeOf(ch), {$I %CurrentRoutine%}); until ch = 0; if flags and gzfHdrCrc <> 0 then GMSafeIStreamRead(FStream, @crc16, SizeOf(crc16), {$I %CurrentRoutine%}); {ToDo: Check header CRC} end; procedure TGMZipDecompressorIStream.InternalRead(pv: Pointer; cb: LongWord; var pcbRead: LongWord); 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, {$I %CurrentRoutine%}); Inc(FZRec.avail_in, FHeaderSize); if FIsGZipFile then begin if FGZipFileTrailer = nil then New(FGZipFileTrailer); GMHrCheckObj(FStream.Read(FGZipFileTrailer, cGZipFileTrailerSize, PLongInt(@N)), Self, {$I %CurrentRoutine%}); 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, {$I %CurrentRoutine%}); 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, {$I %CurrentRoutine%}); if FZRec.total_out <> FGZipFileTrailer^[tiLength] then raise EGMException.ObjError(RStrIncorrectSrcLen, Self, {$I %CurrentRoutine%}); 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, {$I %CurrentRoutine%}); end; { --------------------------------- } { ---- TGMZipCompressorIStream ---- } { --------------------------------- } constructor TGMZipCompressorIStream.Create(const ADest: ISequentialStream; const ACompression: TGMCompressionStrength = ctMaximum; const ARefLifeTime: Boolean = True); 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, {$I %CurrentRoutine%}); end; constructor TGMZipCompressorIStream.CreateGZip(const ADest: ISequentialStream; const ACompression: TGMCompressionStrength; const AStrategy: TGMCompressionStrategy; const AFileName: TGMString; const ALastModUTC: TDateTime; const ARefLifeTime: Boolean); 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, {$I %CurrentRoutine%}); WriteGZipFileHeader(AFileName, ACompression, ALastModUTC); end; destructor TGMZipCompressorIStream.Destroy; var sizeInBytes: LongWord; begin try FinishCompression; if FWriteGZipFileFormat then begin GMSafeIStreamWrite(FStream, @FCrc32CeckSum, SizeOf(FCrc32CeckSum), {$I %CurrentRoutine%}); sizeInBytes := FZRec.total_in; GMSafeIStreamWrite(FStream, @sizeInBytes, SizeOf(sizeInBytes), {$I %CurrentRoutine%}); 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 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 //FillByte(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), {$I %CurrentRoutine%}); if Length(AFileName) > 0 then GMSafeIStreamWrite(FStream, PAnsiChar(AFileName), Length(AFileName)+1, {$I %CurrentRoutine%}); {ToDo: Add gzHeader checksum} end; procedure TGMZipCompressorIStream.FinishCompression; var code: Integer; begin FZRec.next_in := nil; FZRec.avail_in := 0; try repeat code := CCheck(deflate(FZRec, Z_FINISH), Self, {$I %CurrentRoutine%}); GMSafeIStreamWrite(FStream, FBuffer, cCompressBufferSize - FZRec.avail_out, {$I %CurrentRoutine%}); 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); 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, {$I %CurrentRoutine%}); if FZRec.avail_out = 0 then begin GMSafeIStreamWrite(FStream, FBuffer, cCompressBufferSize - FZRec.avail_out, {$I %CurrentRoutine%}); 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, {$I %CurrentRoutine%}); end; initialization {$IFNDEF EXTERNAL_CRC} {$IFNDEF STATIC_CRC_TABLE} vCSCreateCrc32Table := TGMCriticalSection.Create(True); {$ENDIF} {$ENDIF} end.