982 lines
31 KiB
ObjectPascal
982 lines
31 KiB
ObjectPascal
{*****************************************************************************
|
|
* ZLib.pas (zlib 1.2.3) *
|
|
* *
|
|
* copyright (c) 2002-2005 Roberto Della Pasqua (www.dellapasqua.com) *
|
|
* copyright (c) 2000-2002 base2 technologies (www.base2ti.com) *
|
|
* copyright (c) 1997 Borland International (www.borland.com) *
|
|
* *
|
|
* revision history *
|
|
* 2008.02.15 updated to be interface compatible with old codegear zlib *
|
|
* while not changing new zlib 1.2.3 interface *
|
|
* 2006.04.21 updated with latest Borland C++ 2006 SP2 *
|
|
* 2005.02.03 updated with latest zlib 1.2.2, thanks to Fabio Dell'Aria *
|
|
* (www.eurekalog.com) for provide me the compiled objects *
|
|
* zlib is compiled without crc32-compressBound *
|
|
* 2003.12.18 updated with latest zlib 1.2.1 (see www.zlib.org) *
|
|
* obj's compiled with fastest speed optimizations (bcc 5.6.4) *
|
|
* (hint:see basm newsgroup about a Move RTL fast replacement) *
|
|
* Thanks to Cosmin Truta for the pascal zlib reference *
|
|
* *
|
|
* 2002.11.02 ZSendToBrowser: deflate algorithm for HTTP1.1 compression *
|
|
* 2002.10.24 ZFastCompressString and ZFastDecompressString:300% faster *
|
|
* 2002.10.15 recompiled zlib 1.1.4 c sources with speed optimizations *
|
|
* (and targeting 686+ cpu) and changes to accomodate Borland *
|
|
* standards (C++ v5.6 compiler) *
|
|
* 2002.10.15 optimized move mem for not aligned structures (strings,etc)*
|
|
* 2002.10.15 little changes to avoid system unique string calls *
|
|
* *
|
|
* 2002.03.15 updated to zlib version 1.1.4 *
|
|
* 2001.11.27 enhanced TZDecompressionStream.Read to adjust source *
|
|
* stream position upon end of compression data *
|
|
* fixed endless loop in TZDecompressionStream.Read when *
|
|
* destination count was greater than uncompressed data *
|
|
* 2001.10.26 renamed unit to integrate "nicely" with delphi 6 *
|
|
* 2000.11.24 added soFromEnd condition to TZDecompressionStream.Seek *
|
|
* added ZCompressStream and ZDecompressStream *
|
|
* 2000.06.13 optimized, fixed, rewrote, and enhanced the zlib.pas unit *
|
|
* included on the delphi cd (zlib version 1.1.3) *
|
|
* *
|
|
* acknowledgements *
|
|
* erik turner Z*Stream routines *
|
|
* david bennion finding the nastly little endless loop quirk with the *
|
|
* TZDecompressionStream.Read method *
|
|
* burak kalayci informing me about the zlib 1.1.4 update *
|
|
*****************************************************************************}
|
|
|
|
unit zlib_external deprecated;
|
|
|
|
{$MESSAGE WARN 'Модуль zlib_external устарел, ипользуйте директиву USE_ZLIB_EX и обновленные модули ZLib, см. пункт 11 Readme.txt'}
|
|
|
|
interface
|
|
|
|
uses
|
|
Windows,
|
|
Sysutils,
|
|
Classes;
|
|
|
|
const
|
|
ZLIB_VERSION = '1.2.3'; //do not localize
|
|
|
|
type
|
|
{$IF NOT DEFINED(TBytes)}
|
|
TBytes = array of Byte;
|
|
{$IFEND}
|
|
|
|
TZAlloc = function(opaque: Pointer; items, size: Integer): Pointer;
|
|
TZFree = procedure(opaque, block: Pointer);
|
|
TZCompressionLevel = (zcNone, zcFastest, zcDefault, zcMax);
|
|
|
|
// CG: Define old enum for compression level
|
|
TCompressionLevel = (clNone = Integer(zcNone), clFastest, clDefault, clMax);
|
|
|
|
{** TZStreamRec ***********************************************************}
|
|
|
|
TZStreamRec = packed record
|
|
next_in: PAnsiChar; // next input byte
|
|
avail_in: Longint; // number of bytes available at next_in
|
|
total_in: Longint; // total nb of input bytes read so far
|
|
next_out: PAnsiChar; // next output byte should be put here
|
|
avail_out: Longint; // remaining free space at next_out
|
|
total_out: Longint; // total nb of bytes output so far
|
|
msg: PAnsiChar; // last error message, NULL if no error
|
|
state: Pointer; // not visible by applications
|
|
zalloc: TZAlloc; // used to allocate the internal state
|
|
zfree: TZFree; // used to free the internal state
|
|
opaque: Pointer; // private data object passed to zalloc and zfree
|
|
data_type: Integer; // best guess about the data type: ascii or binary
|
|
adler: Longint; // adler32 value of the uncompressed data
|
|
reserved: Longint; // reserved for future use
|
|
end;
|
|
|
|
{** TCustomZStream ********************************************************}
|
|
|
|
TCustomZStream = class(TStream)
|
|
private
|
|
FStream: TStream;
|
|
FStreamPos: Int64;
|
|
FOnProgress: TNotifyEvent;
|
|
FZStream: TZStreamRec;
|
|
FBuffer: array[Word] of AnsiChar;
|
|
protected
|
|
constructor Create(stream: TStream);
|
|
procedure DoProgress; dynamic;
|
|
property OnProgress: TNotifyEvent read FOnProgress write FOnProgress;
|
|
end;
|
|
|
|
// CG: Add alias of classname to old Zlib classname
|
|
TCustomZLibStream = TCustomZStream;
|
|
|
|
{** TZCompressionStream ***************************************************}
|
|
|
|
TZCompressionStream = class(TCustomZStream)
|
|
private
|
|
function GetCompressionRate: Single;
|
|
public
|
|
constructor Create(dest: TStream; compressionLevel: TZCompressionLevel = zcDefault); overload;
|
|
// CG: Add overloaded constructor for old parameter type and order
|
|
constructor Create(compressionLevel: TCompressionLevel; dest: TStream); overload;
|
|
destructor Destroy; override;
|
|
function Read(var buffer; count: Longint): Longint; override;
|
|
function Write(const buffer; count: Longint): Longint; override;
|
|
function Seek(offset: Longint; origin: Word): Longint; override;
|
|
property CompressionRate: Single read GetCompressionRate;
|
|
property OnProgress;
|
|
end;
|
|
|
|
// CG: Add alias of classname to old Zlib classname
|
|
TCompressionStream = TZCompressionStream;
|
|
|
|
{** TZDecompressionStream *************************************************}
|
|
|
|
TZDecompressionStream = class(TCustomZStream)
|
|
public
|
|
constructor Create(source: TStream);
|
|
destructor Destroy; override;
|
|
function Read(var buffer; count: Longint): Longint; override;
|
|
function Write(const buffer; count: Longint): Longint; override;
|
|
function Seek(offset: Longint; origin: Word): Longint; override;
|
|
property OnProgress;
|
|
end;
|
|
|
|
// CG: Add alias of classname to old Zlib classname
|
|
TDecompressionStream = TZDecompressionStream;
|
|
|
|
{** zlib public routines ****************************************************}
|
|
|
|
{*****************************************************************************
|
|
* ZCompress *
|
|
* *
|
|
* pre-conditions *
|
|
* inBuffer = pointer to uncompressed data *
|
|
* inSize = size of inBuffer (bytes) *
|
|
* outBuffer = pointer (unallocated) *
|
|
* level = compression level *
|
|
* *
|
|
* post-conditions *
|
|
* outBuffer = pointer to compressed data (allocated) *
|
|
* outSize = size of outBuffer (bytes) *
|
|
*****************************************************************************}
|
|
|
|
procedure ZCompress(const inBuffer: Pointer; inSize: Integer;
|
|
out outBuffer: Pointer; out outSize: Integer;
|
|
level: TZCompressionLevel = zcDefault); overload;
|
|
|
|
// CG: Add overload to take old enum type
|
|
procedure ZCompress(const inBuffer: Pointer; inSize: Integer;
|
|
out outBuffer: Pointer; out outSize: Integer;
|
|
level: TCompressionLevel); overload;
|
|
{$IF CompilerVersion >= 19}inline;{$IFEND}
|
|
|
|
{*****************************************************************************
|
|
* ZDecompress *
|
|
* *
|
|
* pre-conditions *
|
|
* inBuffer = pointer to compressed data *
|
|
* inSize = size of inBuffer (bytes) *
|
|
* outBuffer = pointer (unallocated) *
|
|
* outEstimate = estimated size of uncompressed data (bytes) *
|
|
* *
|
|
* post-conditions *
|
|
* outBuffer = pointer to decompressed data (allocated) *
|
|
* outSize = size of outBuffer (bytes) *
|
|
*****************************************************************************}
|
|
|
|
procedure ZDecompress(const inBuffer: Pointer; inSize: Integer;
|
|
out outBuffer: Pointer; out outSize: Integer; outEstimate: Integer = 0);
|
|
|
|
{** string routines *********************************************************}
|
|
|
|
function ZCompressStr(const s: string; level: TZCompressionLevel = zcDefault): TBytes; overload;
|
|
// CG: Add overload to take old enum type
|
|
function ZCompressStr(const s: string; level: TCompressionLevel): TBytes; overload;
|
|
{$IF CompilerVersion >= 19}inline;{$IFEND}
|
|
|
|
function ZDecompressStr(const s: TBytes): string;
|
|
|
|
{** stream routines *********************************************************}
|
|
|
|
procedure ZCompressStream(inStream, outStream: TStream;
|
|
level: TZCompressionLevel = zcDefault); overload;
|
|
// CG: Add overload to take old enum type
|
|
procedure ZCompressStream(inStream, outStream: TStream;
|
|
level: TCompressionLevel); overload;
|
|
{$IF CompilerVersion >= 19}inline;{$IFEND}
|
|
|
|
procedure ZDecompressStream(inStream, outStream: TStream);
|
|
|
|
// CG: Routines from old version of ZLib required for CodeGear backwards compatability
|
|
function zlibAllocMem(AppData: Pointer; Items, Size: Integer): Pointer;
|
|
procedure zlibFreeMem(AppData, Block: Pointer);
|
|
|
|
{** export routines ********************************************************}
|
|
|
|
function adler32(adler: LongInt; const buf: PChar; len: Integer): LongInt;
|
|
procedure MoveI32(const Source; var Dest; Count: Integer);
|
|
procedure ZSendToBrowser(var s: string);
|
|
function deflateInit_(var strm: TZStreamRec; level: Integer; version: PChar; recsize: Integer): Integer;
|
|
function DeflateInit2_(var strm: TZStreamRec; level: integer; method: integer; windowBits: integer; memLevel: integer; strategy: integer; version: PChar; recsize: integer): integer;
|
|
function deflate(var strm: TZStreamRec; flush: Integer): Integer;
|
|
function deflateEnd(var strm: TZStreamRec): Integer;
|
|
function inflateInit_(var strm: TZStreamRec; version: PChar; recsize: Integer): Integer;
|
|
function inflateInit2_(var strm: TZStreamRec; windowBits: integer; version: PChar; recsize: integer): integer;
|
|
function inflate(var strm: TZStreamRec; flush: Integer): Integer;
|
|
function inflateEnd(var strm: TZStreamRec): Integer;
|
|
function inflateReset(var strm: TZStreamRec): Integer;
|
|
|
|
type
|
|
EZLibError = class(Exception);
|
|
EZCompressionError = class(EZLibError);
|
|
EZDecompressionError = class(EZLibError);
|
|
|
|
const
|
|
{** flush constants *******************************************************}
|
|
|
|
Z_NO_FLUSH = 0;
|
|
Z_PARTIAL_FLUSH = 1;
|
|
Z_SYNC_FLUSH = 2;
|
|
Z_FULL_FLUSH = 3;
|
|
Z_FINISH = 4;
|
|
|
|
{** return codes **********************************************************}
|
|
|
|
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);
|
|
|
|
{** compression levels ****************************************************}
|
|
|
|
Z_NO_COMPRESSION = 0;
|
|
Z_BEST_SPEED = 1;
|
|
Z_BEST_COMPRESSION = 9;
|
|
Z_DEFAULT_COMPRESSION = (-1);
|
|
|
|
{** compression strategies ************************************************}
|
|
|
|
Z_FILTERED = 1;
|
|
Z_HUFFMAN_ONLY = 2;
|
|
Z_DEFAULT_STRATEGY = 0;
|
|
|
|
{** data types ************************************************************}
|
|
|
|
Z_BINARY = 0;
|
|
Z_ASCII = 1;
|
|
Z_UNKNOWN = 2;
|
|
|
|
{** compression methods ***************************************************}
|
|
|
|
Z_DEFLATED = 8;
|
|
|
|
{** return code messages **************************************************}
|
|
|
|
_z_errmsg: array[0..9] of PChar = (
|
|
'need dictionary', // Z_NEED_DICT (2) //do not localize
|
|
'stream end', // Z_STREAM_END (1) //do not localize
|
|
'', // Z_OK (0) //do not localize
|
|
'file error', // Z_ERRNO (-1) //do not localize
|
|
'stream error', // Z_STREAM_ERROR (-2) //do not localize
|
|
'data error', // Z_DATA_ERROR (-3) //do not localize
|
|
'insufficient memory', // Z_MEM_ERROR (-4)//do not localize
|
|
'buffer error', // Z_BUF_ERROR (-5) //do not localize
|
|
'incompatible version', // Z_VERSION_ERROR (-6)//do not localize
|
|
''//do not localize
|
|
);
|
|
|
|
ZLevels: array[TZCompressionLevel] of Shortint = (
|
|
Z_NO_COMPRESSION,
|
|
Z_BEST_SPEED,
|
|
Z_DEFAULT_COMPRESSION,
|
|
Z_BEST_COMPRESSION
|
|
);
|
|
|
|
SZInvalid = 'Invalid ZStream operation!';
|
|
|
|
implementation
|
|
|
|
const
|
|
zlib_d2010 = 'zlib_d2010.dll';
|
|
|
|
//{** link zlib 1.2.3 **************************************************************}
|
|
//{** bcc32 -c -6 -O2 -Ve -X -pr -a8 -b -d -k- -vi -tWM -r -RT- -ff *.c **}
|
|
//
|
|
//{$L Zlib/adler32.obj}
|
|
//{$L Zlib/deflate.obj}
|
|
//{$L Zlib/infback.obj}
|
|
//{$L Zlib/inffast.obj}
|
|
//{$L Zlib/inflate.obj}
|
|
//{$L Zlib/inftrees.obj}
|
|
//{$L Zlib/trees.obj}
|
|
//{$L Zlib/compress.obj}
|
|
//{$L Zlib/crc32.obj}
|
|
|
|
{*****************************************************************************
|
|
* note: do not reorder the above -- doing so will result in external *
|
|
* functions being undefined *
|
|
*****************************************************************************}
|
|
|
|
{*********************** Peter Morris not aligned move **********************}
|
|
|
|
procedure MoveI32(const Source; var Dest; Count: Integer); register;
|
|
asm
|
|
cmp ECX,0
|
|
Je @JustQuit
|
|
push ESI
|
|
push EDI
|
|
mov ESI, EAX
|
|
mov EDI, EDX
|
|
@Loop:
|
|
Mov AL, [ESI]
|
|
Inc ESI
|
|
mov [EDI], AL
|
|
Inc EDI
|
|
Dec ECX
|
|
Jnz @Loop
|
|
pop EDI
|
|
pop ESI
|
|
@JustQuit:
|
|
end;
|
|
{****************************************************************************}
|
|
|
|
{** deflate routines ********************************************************}
|
|
|
|
function deflateInit_(var strm: TZStreamRec; level: Integer; version: PChar;
|
|
recsize: Integer): Integer; external zlib_d2010;
|
|
|
|
function DeflateInit2_(var strm: TZStreamRec; level: integer; method: integer; windowBits: integer;
|
|
memLevel: integer; strategy: integer; version: PChar; recsize: integer): integer; external zlib_d2010;
|
|
|
|
function deflate(var strm: TZStreamRec; flush: Integer): Integer;
|
|
external zlib_d2010;
|
|
|
|
function deflateEnd(var strm: TZStreamRec): Integer; external zlib_d2010;
|
|
|
|
{** inflate routines ********************************************************}
|
|
|
|
function inflateInit_(var strm: TZStreamRec; version: PChar;
|
|
recsize: Integer): Integer; external zlib_d2010;
|
|
|
|
function inflateInit2_(var strm: TZStreamRec; windowBits: integer;
|
|
version: PChar; recsize: integer): integer; external zlib_d2010;
|
|
|
|
function inflate(var strm: TZStreamRec; flush: Integer): Integer;
|
|
external zlib_d2010;
|
|
|
|
function inflateEnd(var strm: TZStreamRec): Integer; external zlib_d2010;
|
|
|
|
function inflateReset(var strm: TZStreamRec): Integer; external zlib_d2010;
|
|
|
|
{** utility routines *******************************************************}
|
|
|
|
function adler32; external zlib_d2010;
|
|
//function crc32; external;
|
|
//function compressBound; external;
|
|
|
|
{** zlib function implementations *******************************************}
|
|
|
|
function zcalloc(opaque: Pointer; items, size: Integer): Pointer;
|
|
begin
|
|
GetMem(result, items * size);
|
|
end;
|
|
|
|
procedure zcfree(opaque, block: Pointer);
|
|
begin
|
|
FreeMem(block);
|
|
end;
|
|
|
|
{** c function implementations **********************************************}
|
|
|
|
procedure _memset(p: Pointer; b: Byte; count: Integer); cdecl;
|
|
begin
|
|
FillChar(p^, count, b);
|
|
end;
|
|
|
|
procedure _memcpy(dest, source: Pointer; count: Integer); cdecl;
|
|
begin
|
|
Move(source^, dest^, count);
|
|
end;
|
|
|
|
function _malloc(Size: Integer): Pointer; cdecl;
|
|
begin
|
|
GetMem(Result, Size);
|
|
end;
|
|
|
|
procedure _free(Block: Pointer); cdecl;
|
|
begin
|
|
FreeMem(Block);
|
|
end;
|
|
|
|
{** custom zlib routines ****************************************************}
|
|
|
|
function DeflateInit(var stream: TZStreamRec; level: Integer): Integer;
|
|
begin
|
|
result := DeflateInit_(stream, level, ZLIB_VERSION, SizeOf(TZStreamRec));
|
|
end;
|
|
|
|
function DeflateInit2(var stream: TZStreamRec; level, method, windowBits,
|
|
memLevel, strategy: Integer): Integer;
|
|
begin
|
|
result := DeflateInit2_(stream, level, method, windowBits, memLevel, strategy, ZLIB_VERSION, SizeOf(TZStreamRec));
|
|
end;
|
|
|
|
function InflateInit(var stream: TZStreamRec): Integer;
|
|
begin
|
|
result := InflateInit_(stream, ZLIB_VERSION, SizeOf(TZStreamRec));
|
|
end;
|
|
|
|
function InflateInit2(var stream: TZStreamRec; windowBits: Integer): Integer;
|
|
begin
|
|
result := InflateInit2_(stream, windowBits, ZLIB_VERSION, SizeOf(TZStreamRec));
|
|
end;
|
|
|
|
{****************************************************************************}
|
|
|
|
function ZCompressCheck(code: Integer): Integer;
|
|
begin
|
|
result := code;
|
|
|
|
if code < 0 then
|
|
begin
|
|
raise EZCompressionError.Create(_z_errmsg[2 - code]);
|
|
end;
|
|
end;
|
|
|
|
function ZDecompressCheck(code: Integer): Integer;
|
|
begin
|
|
Result := code;
|
|
|
|
if code < 0 then
|
|
begin
|
|
raise EZDecompressionError.Create(_z_errmsg[2 - code]);
|
|
end;
|
|
end;
|
|
|
|
procedure ZCompress(const inBuffer: Pointer; inSize: Integer;
|
|
out outBuffer: Pointer; out outSize: Integer;
|
|
level: TZCompressionLevel);
|
|
const
|
|
delta = 256;
|
|
var
|
|
zstream: TZStreamRec;
|
|
begin
|
|
FillChar(zstream, SizeOf(TZStreamRec), 0);
|
|
|
|
outSize := ((inSize + (inSize div 10) + 12) + 255) and not 255;
|
|
GetMem(outBuffer, outSize);
|
|
|
|
try
|
|
zstream.next_in := inBuffer;
|
|
zstream.avail_in := inSize;
|
|
zstream.next_out := outBuffer;
|
|
zstream.avail_out := outSize;
|
|
|
|
ZCompressCheck(DeflateInit(zstream, ZLevels[level]));
|
|
|
|
try
|
|
while ZCompressCheck(deflate(zstream, Z_FINISH)) <> Z_STREAM_END do
|
|
begin
|
|
Inc(outSize, delta);
|
|
ReallocMem(outBuffer, outSize);
|
|
|
|
zstream.next_out := PAnsiChar(Integer(outBuffer) + zstream.total_out);
|
|
zstream.avail_out := delta;
|
|
end;
|
|
finally
|
|
ZCompressCheck(deflateEnd(zstream));
|
|
end;
|
|
|
|
ReallocMem(outBuffer, zstream.total_out);
|
|
outSize := zstream.total_out;
|
|
except
|
|
FreeMem(outBuffer);
|
|
raise;
|
|
end;
|
|
end;
|
|
|
|
procedure ZCompress(const inBuffer: Pointer; inSize: Integer;
|
|
out outBuffer: Pointer; out outSize: Integer;
|
|
level: TCompressionLevel);
|
|
begin
|
|
ZCompress(inBuffer, inSize, outBuffer, outSize, TZCompressionLevel(Integer(level)));
|
|
end;
|
|
|
|
procedure ZCompress2(const inBuffer: Pointer; inSize: Integer;
|
|
out outBuffer: Pointer; out outSize: Integer);
|
|
const
|
|
delta = 256;
|
|
var
|
|
zstream: TZStreamRec;
|
|
begin
|
|
FillChar(zstream, SizeOf(TZStreamRec), 0);
|
|
|
|
outSize := ((inSize + (inSize div 10) + 12) + 255) and not 255;
|
|
GetMem(outBuffer, outSize);
|
|
|
|
try
|
|
zstream.next_in := inBuffer;
|
|
zstream.avail_in := inSize;
|
|
zstream.next_out := outBuffer;
|
|
zstream.avail_out := outSize;
|
|
|
|
ZCompressCheck(DeflateInit2(zstream, 1, 8, -15, 9, 0));
|
|
|
|
try
|
|
while ZCompressCheck(deflate(zstream, Z_FINISH)) <> Z_STREAM_END do
|
|
begin
|
|
Inc(outSize, delta);
|
|
ReallocMem(outBuffer, outSize);
|
|
|
|
zstream.next_out := PAnsiChar(Integer(outBuffer) + zstream.total_out);
|
|
zstream.avail_out := delta;
|
|
end;
|
|
finally
|
|
ZCompressCheck(deflateEnd(zstream));
|
|
end;
|
|
|
|
ReallocMem(outBuffer, zstream.total_out);
|
|
outSize := zstream.total_out;
|
|
except
|
|
FreeMem(outBuffer);
|
|
raise;
|
|
end;
|
|
end;
|
|
|
|
procedure ZDecompress(const inBuffer: Pointer; inSize: Integer;
|
|
out outBuffer: Pointer; out outSize: Integer; outEstimate: Integer);
|
|
var
|
|
zstream: TZStreamRec;
|
|
delta: Integer;
|
|
begin
|
|
FillChar(zstream, SizeOf(TZStreamRec), 0);
|
|
|
|
delta := (inSize + 255) and not 255;
|
|
|
|
if outEstimate = 0 then outSize := delta
|
|
else outSize := outEstimate;
|
|
|
|
GetMem(outBuffer, outSize);
|
|
|
|
try
|
|
zstream.next_in := inBuffer;
|
|
zstream.avail_in := inSize;
|
|
zstream.next_out := outBuffer;
|
|
zstream.avail_out := outSize;
|
|
|
|
ZDecompressCheck(InflateInit(zstream));
|
|
|
|
try
|
|
while ZDecompressCheck(inflate(zstream, Z_NO_FLUSH)) <> Z_STREAM_END do
|
|
begin
|
|
Inc(outSize, delta);
|
|
ReallocMem(outBuffer, outSize);
|
|
|
|
zstream.next_out := PAnsiChar(Integer(outBuffer) + zstream.total_out);
|
|
zstream.avail_out := delta;
|
|
end;
|
|
finally
|
|
ZDecompressCheck(inflateEnd(zstream));
|
|
end;
|
|
|
|
ReallocMem(outBuffer, zstream.total_out);
|
|
outSize := zstream.total_out;
|
|
except
|
|
FreeMem(outBuffer);
|
|
raise;
|
|
end;
|
|
end;
|
|
|
|
{** string routines *********************************************************}
|
|
|
|
function ZCompressStr(const s: string; level: TZCompressionLevel): TBytes;
|
|
var
|
|
buffer: Pointer;
|
|
size: Integer;
|
|
begin
|
|
ZCompress(PChar(s), Length(s) * SizeOf(Char), buffer, size, level);
|
|
SetLength(result, size);
|
|
Move(buffer^, pointer(result)^, size);
|
|
FreeMem(buffer);
|
|
end;
|
|
|
|
function ZCompressStr(const s: string; level: TCompressionLevel): TBytes;
|
|
begin
|
|
Result := ZCompressStr(s, TZCompressionLevel(Integer(level)));
|
|
end;
|
|
|
|
{$IF NOT DECLARED(ByteLength)}
|
|
function ByteLength(const S: string): Integer;
|
|
begin
|
|
Result := Length(S) * SizeOf(Char);
|
|
end;
|
|
{$IFEND}
|
|
|
|
procedure ZSendToBrowser(var s: string);
|
|
var
|
|
outBuf: Pointer;
|
|
outBytes: Integer;
|
|
begin
|
|
ZCompress2(pointer(s), ByteLength(s), outBuf, outBytes);
|
|
SetLength(s, outBytes);
|
|
Move(pointer(outBuf)^, pointer(s)^, outBytes);
|
|
FreeMem(outBuf);
|
|
end;
|
|
|
|
function ZDecompressStr(const s: TBytes): string;
|
|
var
|
|
buffer: Pointer;
|
|
size: Integer;
|
|
begin
|
|
ZDecompress(Pointer(s), Length(s), buffer, size);
|
|
SetLength(result, size div SizeOf(Char));
|
|
Move(buffer^, pointer(result)^, size);
|
|
FreeMem(buffer);
|
|
end;
|
|
|
|
{** stream routines *********************************************************}
|
|
|
|
procedure ZCompressStream(inStream, outStream: TStream;
|
|
level: TZCompressionLevel);
|
|
const
|
|
bufferSize = 32768;
|
|
var
|
|
zstream: TZStreamRec;
|
|
zresult: Integer;
|
|
inBuffer: array[0..bufferSize - 1] of AnsiChar;
|
|
outBuffer: array[0..bufferSize - 1] of AnsiChar;
|
|
inSize: Integer;
|
|
outSize: Integer;
|
|
begin
|
|
FillChar(zstream, SizeOf(TZStreamRec), 0);
|
|
|
|
ZCompressCheck(DeflateInit(zstream, ZLevels[level]));
|
|
|
|
inSize := inStream.Read(inBuffer, bufferSize);
|
|
|
|
while inSize > 0 do
|
|
begin
|
|
zstream.next_in := inBuffer;
|
|
zstream.avail_in := inSize;
|
|
|
|
repeat
|
|
zstream.next_out := outBuffer;
|
|
zstream.avail_out := bufferSize;
|
|
|
|
ZCompressCheck(deflate(zstream, Z_NO_FLUSH));
|
|
|
|
// outSize := zstream.next_out - outBuffer;
|
|
outSize := bufferSize - zstream.avail_out;
|
|
|
|
outStream.Write(outBuffer, outSize);
|
|
until (zstream.avail_in = 0) and (zstream.avail_out > 0);
|
|
|
|
inSize := inStream.Read(inBuffer, bufferSize);
|
|
end;
|
|
|
|
repeat
|
|
zstream.next_out := outBuffer;
|
|
zstream.avail_out := bufferSize;
|
|
|
|
zresult := ZCompressCheck(deflate(zstream, Z_FINISH));
|
|
|
|
// outSize := zstream.next_out - outBuffer;
|
|
outSize := bufferSize - zstream.avail_out;
|
|
|
|
outStream.Write(outBuffer, outSize);
|
|
until (zresult = Z_STREAM_END) and (zstream.avail_out > 0);
|
|
|
|
ZCompressCheck(deflateEnd(zstream));
|
|
end;
|
|
|
|
procedure ZCompressStream(inStream, outStream: TStream;
|
|
level: TCompressionLevel);
|
|
begin
|
|
ZCompressStream(inStream, outStream, TZCompressionLevel(Integer(level)))
|
|
end;
|
|
|
|
procedure ZDecompressStream(inStream, outStream: TStream);
|
|
const
|
|
bufferSize = 32768;
|
|
var
|
|
zstream: TZStreamRec;
|
|
zresult: Integer;
|
|
inBuffer: array[0..bufferSize - 1] of AnsiChar;
|
|
outBuffer: array[0..bufferSize - 1] of AnsiChar;
|
|
inSize: Integer;
|
|
outSize: Integer;
|
|
begin
|
|
FillChar(zstream, SizeOf(TZStreamRec), 0);
|
|
|
|
ZCompressCheck(InflateInit(zstream));
|
|
|
|
inSize := inStream.Read(inBuffer, bufferSize);
|
|
|
|
while inSize > 0 do
|
|
begin
|
|
zstream.next_in := inBuffer;
|
|
zstream.avail_in := inSize;
|
|
|
|
repeat
|
|
zstream.next_out := outBuffer;
|
|
zstream.avail_out := bufferSize;
|
|
|
|
ZCompressCheck(inflate(zstream, Z_NO_FLUSH));
|
|
|
|
// outSize := zstream.next_out - outBuffer;
|
|
outSize := bufferSize - zstream.avail_out;
|
|
|
|
outStream.Write(outBuffer, outSize);
|
|
until (zstream.avail_in = 0) and (zstream.avail_out > 0);
|
|
|
|
inSize := inStream.Read(inBuffer, bufferSize);
|
|
end;
|
|
|
|
repeat
|
|
zstream.next_out := outBuffer;
|
|
zstream.avail_out := bufferSize;
|
|
|
|
zresult := ZCompressCheck(inflate(zstream, Z_FINISH));
|
|
|
|
// outSize := zstream.next_out - outBuffer;
|
|
outSize := bufferSize - zstream.avail_out;
|
|
|
|
outStream.Write(outBuffer, outSize);
|
|
until (zresult = Z_STREAM_END) and (zstream.avail_out > 0);
|
|
|
|
ZCompressCheck(inflateEnd(zstream));
|
|
end;
|
|
|
|
{** TCustomZStream **********************************************************}
|
|
|
|
constructor TCustomZStream.Create(stream: TStream);
|
|
begin
|
|
inherited Create;
|
|
FStream := stream;
|
|
FStreamPos := stream.Position;
|
|
end;
|
|
|
|
procedure TCustomZStream.DoProgress;
|
|
begin
|
|
if Assigned(FOnProgress) then FOnProgress(Self);
|
|
end;
|
|
|
|
{** TZCompressionStream *****************************************************}
|
|
|
|
constructor TZCompressionStream.Create(dest: TStream;
|
|
compressionLevel: TZCompressionLevel);
|
|
begin
|
|
inherited Create(dest);
|
|
|
|
FZStream.next_out := FBuffer;
|
|
FZStream.avail_out := SizeOf(FBuffer);
|
|
|
|
ZCompressCheck(DeflateInit(FZStream, ZLevels[compressionLevel]));
|
|
end;
|
|
|
|
constructor TZCompressionStream.Create(compressionLevel: TCompressionLevel; dest: TStream);
|
|
begin
|
|
Create(dest, TZCompressionLevel(Byte(compressionLevel)));
|
|
end;
|
|
|
|
destructor TZCompressionStream.Destroy;
|
|
begin
|
|
FZStream.next_in := nil;
|
|
FZStream.avail_in := 0;
|
|
|
|
try
|
|
if FStream.Position <> FStreamPos then FStream.Position := FStreamPos;
|
|
|
|
while ZCompressCheck(deflate(FZStream, Z_FINISH)) <> Z_STREAM_END do
|
|
begin
|
|
FStream.WriteBuffer(FBuffer, SizeOf(FBuffer) - FZStream.avail_out);
|
|
|
|
FZStream.next_out := FBuffer;
|
|
FZStream.avail_out := SizeOf(FBuffer);
|
|
end;
|
|
|
|
if FZStream.avail_out < SizeOf(FBuffer) then
|
|
begin
|
|
FStream.WriteBuffer(FBuffer, SizeOf(FBuffer) - FZStream.avail_out);
|
|
end;
|
|
finally
|
|
deflateEnd(FZStream);
|
|
end;
|
|
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TZCompressionStream.Read(var buffer; count: Longint): Longint;
|
|
begin
|
|
raise EZCompressionError.Create(SZInvalid);
|
|
end;
|
|
|
|
function TZCompressionStream.Write(const buffer; count: Longint): Longint;
|
|
begin
|
|
FZStream.next_in := @buffer;
|
|
FZStream.avail_in := count;
|
|
|
|
if FStream.Position <> FStreamPos then FStream.Position := FStreamPos;
|
|
|
|
while FZStream.avail_in > 0 do
|
|
begin
|
|
ZCompressCheck(deflate(FZStream, Z_NO_FLUSH));
|
|
|
|
if FZStream.avail_out = 0 then
|
|
begin
|
|
FStream.WriteBuffer(FBuffer, SizeOf(FBuffer));
|
|
|
|
FZStream.next_out := FBuffer;
|
|
FZStream.avail_out := SizeOf(FBuffer);
|
|
|
|
FStreamPos := FStream.Position;
|
|
|
|
DoProgress;
|
|
end;
|
|
end;
|
|
|
|
result := Count;
|
|
end;
|
|
|
|
function TZCompressionStream.Seek(offset: Longint; origin: Word): Longint;
|
|
begin
|
|
if (offset = 0) and (origin = soFromCurrent) then
|
|
begin
|
|
result := FZStream.total_in;
|
|
end
|
|
else raise EZCompressionError.Create(SZInvalid);
|
|
end;
|
|
|
|
function TZCompressionStream.GetCompressionRate: Single;
|
|
begin
|
|
if FZStream.total_in = 0 then result := 0
|
|
else result := (1.0 - (FZStream.total_out / FZStream.total_in)) * 100.0;
|
|
end;
|
|
|
|
{** TZDecompressionStream ***************************************************}
|
|
|
|
constructor TZDecompressionStream.Create(source: TStream);
|
|
begin
|
|
inherited Create(source);
|
|
FZStream.next_in := FBuffer;
|
|
FZStream.avail_in := 0;
|
|
ZDecompressCheck(InflateInit(FZStream));
|
|
end;
|
|
|
|
destructor TZDecompressionStream.Destroy;
|
|
begin
|
|
inflateEnd(FZStream);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TZDecompressionStream.Read(var buffer; count: Longint): Longint;
|
|
var
|
|
zresult: Integer;
|
|
begin
|
|
FZStream.next_out := @buffer;
|
|
FZStream.avail_out := count;
|
|
|
|
if FStream.Position <> FStreamPos then FStream.Position := FStreamPos;
|
|
|
|
zresult := Z_OK;
|
|
|
|
while (FZStream.avail_out > 0) and (zresult <> Z_STREAM_END) do
|
|
begin
|
|
if FZStream.avail_in = 0 then
|
|
begin
|
|
FZStream.avail_in := FStream.Read(FBuffer, SizeOf(FBuffer));
|
|
|
|
if FZStream.avail_in = 0 then
|
|
begin
|
|
result := count - FZStream.avail_out;
|
|
|
|
Exit;
|
|
end;
|
|
|
|
FZStream.next_in := FBuffer;
|
|
FStreamPos := FStream.Position;
|
|
|
|
DoProgress;
|
|
end;
|
|
|
|
zresult := ZDecompressCheck(inflate(FZStream, Z_NO_FLUSH));
|
|
end;
|
|
|
|
if (zresult = Z_STREAM_END) and (FZStream.avail_in > 0) then
|
|
begin
|
|
FStream.Position := FStream.Position - FZStream.avail_in;
|
|
FStreamPos := FStream.Position;
|
|
|
|
FZStream.avail_in := 0;
|
|
end;
|
|
|
|
result := count - FZStream.avail_out;
|
|
end;
|
|
|
|
function TZDecompressionStream.Write(const Buffer; Count: Longint): Longint;
|
|
begin
|
|
raise EZDecompressionError.Create(SZInvalid);
|
|
end;
|
|
|
|
function TZDecompressionStream.Seek(Offset: Longint; Origin: Word): Longint;
|
|
var
|
|
buf: array[0..8191] of Char;
|
|
i: Integer;
|
|
begin
|
|
if (offset = 0) and (origin = soFromBeginning) then
|
|
begin
|
|
ZDecompressCheck(inflateReset(FZStream));
|
|
|
|
FZStream.next_in := FBuffer;
|
|
FZStream.avail_in := 0;
|
|
|
|
FStream.Position := 0;
|
|
FStreamPos := 0;
|
|
end
|
|
else if ((offset >= 0) and (origin = soFromCurrent)) or
|
|
(((offset - FZStream.total_out) > 0) and (origin = soFromBeginning)) then
|
|
begin
|
|
if origin = soFromBeginning then Dec(offset, FZStream.total_out);
|
|
|
|
if offset > 0 then
|
|
begin
|
|
for i := 1 to offset div SizeOf(buf) do ReadBuffer(buf, SizeOf(buf));
|
|
ReadBuffer(buf, offset mod SizeOf(buf));
|
|
end;
|
|
end
|
|
else if (offset = 0) and (origin = soFromEnd) then
|
|
begin
|
|
while Read(buf, SizeOf(buf)) > 0 do ;
|
|
end
|
|
else raise EZDecompressionError.Create(SZInvalid);
|
|
|
|
result := FZStream.total_out;
|
|
end;
|
|
|
|
function zlibAllocMem(AppData: Pointer; Items, Size: Integer): Pointer;
|
|
{$IFDEF MSWINDOWS}
|
|
register;
|
|
{$ENDIF}
|
|
{$IFDEF LINUX}
|
|
cdecl;
|
|
{$ENDIF}
|
|
begin
|
|
Result := AllocMem(Items * Size);
|
|
end;
|
|
|
|
procedure zlibFreeMem(AppData, Block: Pointer);
|
|
{$IFDEF MSWINDOWS}
|
|
register;
|
|
{$ENDIF}
|
|
{$IFDEF LINUX}
|
|
cdecl;
|
|
{$ENDIF}
|
|
begin
|
|
FreeMem(Block);
|
|
end;
|
|
|
|
end.
|
|
|