577 lines
19 KiB
ObjectPascal
577 lines
19 KiB
ObjectPascal
![]() |
{*******************************************************}
|
||
|
{ }
|
||
|
{ Delphi Supplemental Components }
|
||
|
{ ZLIB Data Compression Interface Unit }
|
||
|
{ }
|
||
|
{ Copyright (c) 1997 Borland International }
|
||
|
{ }
|
||
|
{*******************************************************}
|
||
|
|
||
|
{ Modified for zlib 1.1.3 by Davide Moretti <dave@rimini.com> }
|
||
|
{ Modified for KOL by Alexey Shuvalov <alekc_s@mail.ru> }
|
||
|
{ Updated to zlib 1.1.4 by Dimaxx <dimaxx@atnet.ru>}
|
||
|
|
||
|
// Important! As this unit does not use Kol_Err.pas and SysUtils.pas, there is no
|
||
|
// exceptions raised. Therefore check for errors by comparing the values returned by
|
||
|
// functions such as Read/Write/Seek with value ZLIB_ERROR.
|
||
|
|
||
|
|
||
|
//Uncomment this to enable CompressBuf & DecompressBuf procedures.
|
||
|
//!!! This procedures converted but UNTESTED and MAY BE UNSTABLE !!!
|
||
|
//{$DEFINE BUFFERPROCS}
|
||
|
|
||
|
unit KolZLib;
|
||
|
|
||
|
{$I KOLDEF.INC}
|
||
|
|
||
|
interface
|
||
|
|
||
|
uses Windows, Kol;
|
||
|
|
||
|
const
|
||
|
ZLIB_ERROR = TStrmSize (-1);
|
||
|
|
||
|
type
|
||
|
TAlloc = function (AppData: Pointer; Items, Size: Integer): Pointer;
|
||
|
TFree = procedure (AppData, Block: Pointer);
|
||
|
|
||
|
// Internal structure. Ignore.
|
||
|
TZStreamRec = packed record
|
||
|
next_in: PChar; // next input byte
|
||
|
avail_in: Integer; // number of bytes available at next_in
|
||
|
total_in: Integer; // total nb of input bytes read so far
|
||
|
|
||
|
next_out: PChar; // next output byte should be put here
|
||
|
avail_out: Integer; // remaining free space at next_out
|
||
|
total_out: Integer; // total nb of bytes output so far
|
||
|
|
||
|
msg: PChar; // last error message, NULL if no error
|
||
|
internal: 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: Integer; // adler32 value of the uncompressed data
|
||
|
reserved: Integer; // reserved for future use
|
||
|
end;
|
||
|
|
||
|
TZLibEvent = procedure (Sender: PStream) of Object;
|
||
|
|
||
|
PZLibData = ^TZLibData;
|
||
|
TZLibData = record
|
||
|
FStrm: PStream;
|
||
|
FStrmPos: Cardinal;
|
||
|
FOnProgress: TZLibEvent;
|
||
|
FZRec: TZStreamRec;
|
||
|
FBuffer: array [Word] of Char;
|
||
|
end;
|
||
|
|
||
|
{ TCompressionStream compresses data on the fly as data is written to it, and
|
||
|
stores the compressed data to another stream.
|
||
|
|
||
|
TCompressionStream is write-only and strictly sequential. Reading from the
|
||
|
stream will raise an exception. Using Seek to move the stream pointer
|
||
|
will raise an exception.
|
||
|
|
||
|
Output data is cached internally, written to the output stream only when
|
||
|
the internal output buffer is full. All pending output data is flushed
|
||
|
when the stream is destroyed.
|
||
|
|
||
|
The Position property returns the number of uncompressed bytes of
|
||
|
data that have been written to the stream so far.
|
||
|
|
||
|
CompressionRate returns the on-the-fly percentage by which the original
|
||
|
data has been compressed: (1 - (CompressedBytes / UncompressedBytes)) * 100
|
||
|
If raw data size = 100 and compressed data size = 25, the CompressionRate
|
||
|
is 75%
|
||
|
|
||
|
The OnProgress event is called each time the output buffer is filled and
|
||
|
written to the output stream. This is useful for updating a progress
|
||
|
indicator when you are writing a large chunk of data to the compression
|
||
|
stream in a single call.}
|
||
|
|
||
|
TCompressionLevel = (clNone, clFastest, clDefault, clMax);
|
||
|
|
||
|
//******************* NewCompressionStream *************************
|
||
|
// Creates new ZLib decompression stream. If ZLib initialization failed returns Nil;
|
||
|
// On Read/Write errors Read/Write functions return ZLIB_ERROR value (also for Seek).
|
||
|
|
||
|
function NewCompressionStream (CompressionLevel: TCompressionLevel; Destination: PStream; OnProgress: TZLibEvent): PStream;
|
||
|
|
||
|
{ TDecompressionStream decompresses data on the fly as data is read from it.
|
||
|
|
||
|
Compressed data comes from a separate source stream. TDecompressionStream
|
||
|
is read-only and unidirectional; you can seek forward in the stream, but not
|
||
|
backwards. The special case of setting the stream position to zero is
|
||
|
allowed. Seeking forward decompresses data until the requested position in
|
||
|
the uncompressed data has been reached. Seeking backwards, seeking relative
|
||
|
to the end of the stream, requesting the size of the stream, and writing to
|
||
|
the stream will return ZLIB_ERROR as a Result.
|
||
|
|
||
|
The Position property returns the number of bytes of uncompressed data that
|
||
|
have been read from the stream so far.
|
||
|
|
||
|
The OnProgress event is called each time the internal input buffer of
|
||
|
compressed data is exhausted and the next block is read from the input stream.
|
||
|
This is useful for updating a progress indicator when you are reading a
|
||
|
large chunk of data from the decompression stream in a single call.}
|
||
|
|
||
|
|
||
|
//******************* NewDecompressionStream *************************
|
||
|
// Creates new ZLib decompression stream. If ZLib initialization failed returns Nil;
|
||
|
// On Read/Write errors Read/Write functions return ZLIB_ERROR value (also for Seek).
|
||
|
|
||
|
function NewDecompressionStream (Source: PStream; OnProgress: TZLibEvent): PStream;
|
||
|
|
||
|
|
||
|
//******************* NewZLibXStream *************************
|
||
|
//Calls New[De]CompressionStream and returns True if Result<>Nil; Stream = Result.
|
||
|
// !!! Don't use Overload on this functions - it may cause compilation error
|
||
|
// when called with OnProgress=Nil !!!
|
||
|
|
||
|
function NewZLibDStream (var Stream: PStream; Source: PStream; OnProgress: TZLibEvent): Boolean;
|
||
|
function NewZLibCStream (var Stream: PStream; CompressionLevel: TCompressionLevel; Destination: PStream; OnProgress: TZLibEvent): Boolean;
|
||
|
|
||
|
|
||
|
{$IFDEF BUFFERPROCS}
|
||
|
{ CompressBuf compresses data, buffer to buffer, in one call.
|
||
|
In: InBuf = ptr to compressed data
|
||
|
InBytes = number of bytes in InBuf
|
||
|
Out: OutBuf = ptr to newly allocated buffer containing decompressed data
|
||
|
OutBytes = number of bytes in OutBuf }
|
||
|
|
||
|
function CompressBuf(const InBuf: Pointer; InBytes: Integer; out OutBuf: Pointer; out OutBytes: Integer): Boolean;
|
||
|
|
||
|
{ DecompressBuf decompresses data, buffer to buffer, in one call.
|
||
|
In: InBuf = ptr to compressed data
|
||
|
InBytes = number of bytes in InBuf
|
||
|
OutEstimate = zero, or est. size of the decompressed data
|
||
|
Out: OutBuf = ptr to newly allocated buffer containing decompressed data
|
||
|
OutBytes = number of bytes in OutBuf }
|
||
|
|
||
|
function DecompressBuf(const InBuf: Pointer; InBytes: Integer; OutEstimate: Integer; out OutBuf: Pointer; out OutBytes: Integer): Boolean;
|
||
|
{$ENDIF BUFFERPROCS}
|
||
|
|
||
|
const
|
||
|
ZLib_Version = '1.1.4';
|
||
|
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_FILTERED = 1;
|
||
|
Z_HUFFMAN_ONLY = 2;
|
||
|
Z_DEFAULT_STRATEGY = 0;
|
||
|
|
||
|
Z_BINARY = 0;
|
||
|
Z_ASCII = 1;
|
||
|
Z_UNKNOWN = 2;
|
||
|
|
||
|
Z_DEFLATED = 8;
|
||
|
|
||
|
_z_errmsg: array[0..9] of PChar = (
|
||
|
'need dictionary', // Z_NEED_DICT (2)
|
||
|
'stream end', // Z_STREAM_END (1)
|
||
|
'', // Z_OK (0)
|
||
|
'file error', // Z_ERRNO (-1)
|
||
|
'stream error', // Z_STREAM_ERROR (-2)
|
||
|
'data error', // Z_DATA_ERROR (-3)
|
||
|
'insufficient memory', // Z_MEM_ERROR (-4)
|
||
|
'buffer error', // Z_BUF_ERROR (-5)
|
||
|
'incompatible version', // Z_VERSION_ERROR (-6)
|
||
|
'' );
|
||
|
|
||
|
function adler32(adler: Integer; buf: PChar; len: Integer): Integer;
|
||
|
|
||
|
{$L Obj\deflate.obj}
|
||
|
{$L Obj\trees.obj}
|
||
|
{$L Obj\inflate.obj}
|
||
|
{$L Obj\inftrees.obj}
|
||
|
{$L Obj\adler32.obj}
|
||
|
{$L Obj\infblock.obj}
|
||
|
{$L Obj\infcodes.obj}
|
||
|
{$L Obj\infutil.obj}
|
||
|
{$L Obj\inffast.obj}
|
||
|
|
||
|
procedure _tr_init; external;
|
||
|
procedure _tr_tally; external;
|
||
|
procedure _tr_flush_block; external;
|
||
|
procedure _tr_align; external;
|
||
|
procedure _tr_stored_block; external;
|
||
|
function adler32; external;
|
||
|
procedure inflate_blocks_new; external;
|
||
|
procedure inflate_blocks; external;
|
||
|
procedure inflate_blocks_reset; external;
|
||
|
procedure inflate_blocks_free; external;
|
||
|
procedure inflate_set_dictionary; external;
|
||
|
procedure inflate_trees_bits; external;
|
||
|
procedure inflate_trees_dynamic; external;
|
||
|
procedure inflate_trees_fixed; external;
|
||
|
procedure inflate_codes_new; external;
|
||
|
procedure inflate_codes; external;
|
||
|
procedure inflate_codes_free; external;
|
||
|
procedure _inflate_mask; external;
|
||
|
procedure inflate_flush; external;
|
||
|
procedure inflate_fast; external;
|
||
|
|
||
|
// deflate compresses data
|
||
|
function deflateInit_(var strm: TZStreamRec; level: Integer; version: PChar; recsize: Integer): Integer; external;
|
||
|
function deflate(var strm: TZStreamRec; flush: Integer): Integer; external;
|
||
|
function deflateEnd(var strm: TZStreamRec): Integer; external;
|
||
|
|
||
|
// inflate decompresses data
|
||
|
function inflateInit_(var strm: TZStreamRec; Version: PChar; recsize: Integer): Integer; external;
|
||
|
function inflate(var strm: TZStreamRec; flush: Integer): Integer; external;
|
||
|
function inflateEnd(var strm: TZStreamRec): Integer; external;
|
||
|
function inflateReset(var strm: TZStreamRec): Integer; external;
|
||
|
|
||
|
implementation
|
||
|
|
||
|
procedure _memset(P: Pointer; B: Byte; count: Integer);cdecl;
|
||
|
begin
|
||
|
FillChar(P^, count, Char( B ));
|
||
|
end;
|
||
|
|
||
|
procedure _memcpy(dest, source: Pointer; count: Integer);cdecl;
|
||
|
begin
|
||
|
Move(source^, dest^, count);
|
||
|
end;
|
||
|
|
||
|
function zcalloc(AppData: Pointer; Items, Size: Integer): Pointer;
|
||
|
begin
|
||
|
GetMem(Result, Items*Size);
|
||
|
end;
|
||
|
|
||
|
procedure zcfree(AppData, Block: Pointer);
|
||
|
begin
|
||
|
FreeMem(Block);
|
||
|
end;
|
||
|
|
||
|
function ZCheck(Code: Integer; var Clear: Boolean): Integer;
|
||
|
begin
|
||
|
Result:=Code;
|
||
|
Clear:=Code>=0;
|
||
|
end;
|
||
|
|
||
|
{$IFDEF BUFFERPROCS}
|
||
|
function CompressBuf(const InBuf: Pointer; InBytes: Integer;
|
||
|
out OutBuf: Pointer; out OutBytes: Integer): Boolean;
|
||
|
var
|
||
|
strm: TZStreamRec;
|
||
|
P: Pointer;
|
||
|
begin
|
||
|
Result:=True;
|
||
|
FillChar(strm, SizeOf(strm), 0);
|
||
|
OutBytes := ((InBytes + (InBytes div 10) + 12) + 255) and not 255;
|
||
|
GetMem(OutBuf, OutBytes);
|
||
|
try
|
||
|
strm.next_in := InBuf;
|
||
|
strm.avail_in := InBytes;
|
||
|
strm.next_out := OutBuf;
|
||
|
strm.avail_out := OutBytes;
|
||
|
ZCheck(deflateInit_(strm, Z_BEST_COMPRESSION, zlib_version, sizeof(strm)), Result);
|
||
|
If not Result then Exit;
|
||
|
while (ZCheck(deflate(strm, Z_FINISH), Result)<>Z_STREAM_END) and Result do
|
||
|
begin
|
||
|
P := OutBuf;
|
||
|
Inc(OutBytes, 256);
|
||
|
ReallocMem(OutBuf, OutBytes);
|
||
|
strm.next_out := PChar(Integer(OutBuf) + (Integer(strm.next_out) - Integer(P)));
|
||
|
strm.avail_out := 256;
|
||
|
end;
|
||
|
If Result then ZCheck(deflateEnd(strm), Result)
|
||
|
else deflateEnd(strm);
|
||
|
If not Result then Exit;
|
||
|
ReallocMem(OutBuf, strm.total_out);
|
||
|
OutBytes := strm.total_out;
|
||
|
finally
|
||
|
If not Result then begin
|
||
|
FreeMem(OutBuf);
|
||
|
OutBuf:=nil;
|
||
|
end;
|
||
|
end;
|
||
|
end;
|
||
|
|
||
|
function DecompressBuf(const InBuf: Pointer; InBytes: Integer;
|
||
|
OutEstimate: Integer; out OutBuf: Pointer; out OutBytes: Integer): Boolean;
|
||
|
var
|
||
|
strm: TZStreamRec;
|
||
|
P: Pointer;
|
||
|
BufInc: Integer;
|
||
|
begin
|
||
|
Result:=True;
|
||
|
FillChar(strm, sizeof(strm), 0);
|
||
|
BufInc := (InBytes + 255) and not 255;
|
||
|
if OutEstimate = 0 then
|
||
|
OutBytes := BufInc
|
||
|
else
|
||
|
OutBytes := OutEstimate;
|
||
|
GetMem(OutBuf, OutBytes);
|
||
|
try
|
||
|
strm.next_in := InBuf;
|
||
|
strm.avail_in := InBytes;
|
||
|
strm.next_out := OutBuf;
|
||
|
strm.avail_out := OutBytes;
|
||
|
ZCheck(InflateInit_(strm, zlib_version, sizeof(strm)), Result);
|
||
|
If not Result then Exit;
|
||
|
while (ZCheck(Inflate(strm, Z_FINISH), Result) <> Z_STREAM_END) and Result do
|
||
|
begin
|
||
|
P := OutBuf;
|
||
|
Inc(OutBytes, BufInc);
|
||
|
ReallocMem(OutBuf, OutBytes);
|
||
|
strm.next_out := PChar(Integer(OutBuf) + (Integer(strm.next_out) - Integer(P)));
|
||
|
strm.avail_out := BufInc;
|
||
|
end;
|
||
|
If Result then ZCheck(inflateEnd(strm), Result)
|
||
|
else InflateEnd(strm);
|
||
|
If not Result Then Exit;
|
||
|
ReallocMem(OutBuf, strm.total_out);
|
||
|
OutBytes := strm.total_out;
|
||
|
finally
|
||
|
If not Result then begin
|
||
|
FreeMem(OutBuf);
|
||
|
OutBuf:=nil;
|
||
|
end;
|
||
|
end;
|
||
|
end;
|
||
|
{$ENDIF BUFFERPROCS}
|
||
|
|
||
|
// Dummy methods
|
||
|
procedure DummySetSize(Strm: PStream; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Value: TStrmSize);
|
||
|
asm
|
||
|
end;
|
||
|
|
||
|
function DummyReadWrite (Strm: PStream; var Buffer; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Count: TStrmSize): TStrmSize;
|
||
|
begin
|
||
|
Result:=ZLIB_ERROR;
|
||
|
end;
|
||
|
|
||
|
function DummyGetSize(Strm: PStream): TStrmSize;
|
||
|
begin
|
||
|
Result:=ZLIB_ERROR;
|
||
|
end;
|
||
|
|
||
|
// CompressStream methods
|
||
|
function CZLibWriteStream(Strm: PStream; var Buffer; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Count: TStrmSize): TStrmSize;
|
||
|
var
|
||
|
Check: Boolean;
|
||
|
begin
|
||
|
Result:=ZLIB_ERROR;
|
||
|
With PZlibData (Strm.Methods.fCustom)^ do begin
|
||
|
FZRec.next_in := @Buffer;
|
||
|
FZRec.avail_in := Count;
|
||
|
If FStrm.Position <> FStrmPos then FStrm.Position := FStrmPos;
|
||
|
While (FZRec.avail_in > 0) do begin
|
||
|
ZCheck(deflate(FZRec, 0), Check);
|
||
|
If not Check then Exit;
|
||
|
If FZRec.avail_out = 0 then begin
|
||
|
If FStrm.Write (FBuffer, SizeOf(FBuffer))<>SizeOf(FBuffer) then Exit;
|
||
|
FZRec.next_out := FBuffer;
|
||
|
FZRec.avail_out := SizeOf(FBuffer);
|
||
|
FStrmPos := FStrm.Position;
|
||
|
If Assigned (fOnProgress) then
|
||
|
fOnProgress (Strm);
|
||
|
end;
|
||
|
end;
|
||
|
end;
|
||
|
Result := Count;
|
||
|
end;
|
||
|
|
||
|
function CZLibSeekStream(Strm: PStream; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Offset: TStrmMove; Origin: TMoveMethod): TStrmSize;
|
||
|
begin
|
||
|
If (Offset = 0) and (Origin=spCurrent) then Result:=PZlibData (Strm.Methods.fCustom).FZRec.total_in
|
||
|
else Result:=ZLIB_ERROR;
|
||
|
end;
|
||
|
|
||
|
procedure CZLibCloseStream(Strm: PStream);
|
||
|
var
|
||
|
Check: Boolean;
|
||
|
begin
|
||
|
With PZlibData (Strm.Methods.fCustom)^ do begin
|
||
|
FZRec.next_in := nil;
|
||
|
FZRec.avail_in := 0;
|
||
|
try
|
||
|
If FStrm.Position <> FStrmPos then FStrm.Position := FStrmPos;
|
||
|
while (ZCheck(deflate(FZRec, Z_FINISH), Check) <> Z_STREAM_END) and (FZRec.avail_out = 0) do begin
|
||
|
If not Check then Exit;
|
||
|
If FStrm.Write (FBuffer, SizeOf(FBuffer))<>SizeOf(FBuffer) then Exit;
|
||
|
FZRec.next_out := FBuffer;
|
||
|
FZRec.avail_out := sizeof(FBuffer);
|
||
|
end;
|
||
|
If FZRec.avail_out < SizeOf(FBuffer) then
|
||
|
FStrm.Write (FBuffer, SizeOf(FBuffer) - FZRec.avail_out)
|
||
|
finally
|
||
|
deflateEnd(FZRec);
|
||
|
Dispose (PZLibData (Strm.Methods.fCustom));
|
||
|
end;
|
||
|
end;
|
||
|
end;
|
||
|
|
||
|
// DecompressStream methods
|
||
|
procedure DZLibCloseStream(Strm: PStream);
|
||
|
begin
|
||
|
InflateEnd(PZLibData (Strm.Methods.fCustom).FZRec);
|
||
|
Dispose (PZLibData (Strm.Methods.fCustom));
|
||
|
end;
|
||
|
|
||
|
function DZLibSeekStream(Strm: PStream; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Offset: TStrmMove; Origin: TMoveMethod): TStrmSize;
|
||
|
var
|
||
|
I: Integer;
|
||
|
Buf: array [0..4095] of Char;
|
||
|
Check: Boolean;
|
||
|
Off: TStrmMove;
|
||
|
begin
|
||
|
Result:=ZLIB_ERROR;
|
||
|
Off := Offset;
|
||
|
With PZlibData (Strm.Methods.fCustom)^ do begin
|
||
|
If (Off=0) and (Origin=spBegin) then begin
|
||
|
ZCheck(InflateReset(FZRec), Check);
|
||
|
If not Check then Exit;
|
||
|
FZRec.next_in := FBuffer;
|
||
|
FZRec.avail_in := 0;
|
||
|
FStrm.Position := 0;
|
||
|
FStrmPos := 0;
|
||
|
end
|
||
|
else If ((Off>=0) and (Origin=spCurrent)) or (((Off-FZRec.total_out)>0) and (Origin=spBegin)) then begin
|
||
|
If Origin=spBegin then Dec(Off, FZRec.total_out);
|
||
|
If Off>0 then begin
|
||
|
for I:=1 to Off div SizeOf(Buf) do
|
||
|
If Strm.Read(Buf, SizeOf(Buf))=ZLIB_ERROR then Exit;
|
||
|
If Strm.Read(Buf, Off mod SizeOf(Buf))=ZLIB_ERROR then Exit;
|
||
|
end;
|
||
|
end else Exit;
|
||
|
Result:=FZRec.total_out;
|
||
|
end;
|
||
|
end;
|
||
|
|
||
|
function DZLibReadStream (Strm: PStream; var Buffer; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Count: TStrmSize): TStrmSize;
|
||
|
var
|
||
|
Check: Boolean;
|
||
|
D: PZLibData;
|
||
|
begin
|
||
|
Result:=ZLIB_ERROR;
|
||
|
D := PZlibData (Strm.Methods.fCustom);
|
||
|
D.FZRec.next_out := @Buffer;
|
||
|
D.FZRec.avail_out := Count;
|
||
|
If D.FStrm.Position <> D.FStrmPos then
|
||
|
D.FStrm.Position := D.FStrmPos;
|
||
|
While (D.FZRec.avail_out > 0) do begin
|
||
|
If D.FZRec.avail_in = 0 then begin
|
||
|
D.FZRec.avail_in := D.FStrm.Read(D.FBuffer, SizeOf(D.FBuffer));
|
||
|
If D.FZRec.avail_in = 0 then begin
|
||
|
Result := Count - DWord(D.FZRec.avail_out);
|
||
|
Exit;
|
||
|
end;
|
||
|
D.FZRec.next_in := D.FBuffer;
|
||
|
D.FStrmPos := D.FStrm.Position;
|
||
|
If Assigned (D.fOnProgress) then
|
||
|
D.fOnProgress (Strm);
|
||
|
end;
|
||
|
ZCheck(Inflate(D.FZRec, 0), Check);
|
||
|
If not Check then Exit;
|
||
|
end;
|
||
|
Result:=Count;
|
||
|
end;
|
||
|
|
||
|
const
|
||
|
BaseCZlibMethods: TStreamMethods = (
|
||
|
fSeek: CZLibSeekStream;
|
||
|
fGetSiz: DummyGetSize;
|
||
|
fSetSiz: DummySetSize;
|
||
|
fRead: DummyReadWrite;
|
||
|
fWrite: CZLibWriteStream;
|
||
|
fClose: CZLibCloseStream;
|
||
|
fCustom: nil; );
|
||
|
|
||
|
BaseDZlibMethods: TStreamMethods = (
|
||
|
fSeek: DZLibSeekStream;
|
||
|
fGetSiz: DummyGetSize;
|
||
|
fSetSiz: DummySetSize;
|
||
|
fRead: DZLibReadStream;
|
||
|
fWrite: DummyReadWrite;
|
||
|
fClose: DZLibCloseStream;
|
||
|
fCustom: nil; );
|
||
|
|
||
|
function NewDecompressionStream (Source: PStream; OnProgress: TZLibEvent): PStream;
|
||
|
var
|
||
|
Inited: Boolean;
|
||
|
ZLibData: PZLibData;
|
||
|
begin
|
||
|
New (ZLibData);
|
||
|
With ZLibData^ do begin
|
||
|
FillChar(FZRec, SizeOf(FZRec), #0);
|
||
|
FOnProgress:=OnProgress;
|
||
|
FStrm:=Source;
|
||
|
FStrmPos:=Source.Position;
|
||
|
FZRec.next_in := FBuffer;
|
||
|
FZRec.avail_in := 0;
|
||
|
ZCheck(InflateInit_(FZRec, ZLib_Version, SizeOf(FZRec)), Inited);
|
||
|
end;
|
||
|
If Inited then begin
|
||
|
Result:=_NewStream (BaseDZlibMethods);
|
||
|
Result.Methods.fCustom:=ZLibData;
|
||
|
end else begin
|
||
|
Dispose (ZLibData);
|
||
|
Result:=nil;
|
||
|
end;
|
||
|
end;
|
||
|
|
||
|
function NewCompressionStream (CompressionLevel: TCompressionLevel; Destination: PStream; OnProgress: TZLibEvent): PStream;
|
||
|
const
|
||
|
Levels: array [TCompressionLevel] of ShortInt = (Z_NO_COMPRESSION, Z_BEST_SPEED, Z_DEFAULT_COMPRESSION, Z_BEST_COMPRESSION);
|
||
|
var
|
||
|
Inited: Boolean;
|
||
|
ZLibData: PZLibData;
|
||
|
begin
|
||
|
New (ZLibData);
|
||
|
With ZLibData^ do begin
|
||
|
FillChar(FZRec, SizeOf(FZRec), #0);
|
||
|
FOnProgress:=OnProgress;
|
||
|
FStrm:=Destination;
|
||
|
FStrmPos:=Destination.Position;
|
||
|
FZRec.next_out := FBuffer;
|
||
|
FZRec.avail_out := SizeOf(FBuffer);
|
||
|
ZCheck(deflateInit_(FZRec, Levels[CompressionLevel], ZLib_Version, SizeOf(FZRec)), Inited);
|
||
|
end;
|
||
|
If Inited then begin
|
||
|
Result:=_NewStream (BaseCZlibMethods);
|
||
|
Result.Methods.fCustom:=ZLibData;
|
||
|
end else begin
|
||
|
Dispose (ZLibData);
|
||
|
Result:=nil;
|
||
|
end;
|
||
|
end;
|
||
|
|
||
|
function NewZLibDStream (var Stream: PStream; Source: PStream; OnProgress: TZLibEvent): boolean;
|
||
|
begin
|
||
|
Stream:=NewDecompressionStream (Source, OnProgress);
|
||
|
Result:=Assigned (Stream);
|
||
|
end;
|
||
|
|
||
|
function NewZLibCStream (var Stream: PStream; CompressionLevel: TCompressionLevel; Destination: PStream; OnProgress: TZLibEvent): boolean;
|
||
|
begin
|
||
|
Stream:=NewCompressionStream (CompressionLevel, Destination, OnProgress);
|
||
|
Result:=Assigned (Stream);
|
||
|
end;
|
||
|
|
||
|
end.
|
||
|
|