闲的没事，自己动手修改上兴3.2源代码(2)-优快云博客

本文档详细介绍了 ZLibEx 单元的功能和使用方法，包括压缩与解压缩的各种函数，如 ZCompress 和 ZDecompress 的使用，以及针对字符串和流的压缩与解压缩操作。此外还提供了对 ZLib 错误处理机制的说明。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

让咱的小马也用最新zlibex.pas

unit ZLibEx;

interface

{$I ZLibEx.inc}

uses
SysUtils, CompressionStreamUnit;

const
{** version ids ***********************************************************}

ZLIB_VERSION = '1.2.3';
ZLIB_VERNUM = $1230;

{** compression methods ***************************************************}

Z_DEFLATED = 8;

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

TZCompressionLevel = (
zcNone,
zcFastest,
zcDefault,
zcMax,
zcLevel1,
zcLevel2,
zcLevel3,
zcLevel4,
zcLevel5,
zcLevel6,
zcLevel7,
zcLevel8,
zcLevel9
);

TZStrategy = (
zsDefault,
zsFiltered,
zsHuffman,
zsRLE,
zsFixed
);

TZError = (
zeError,
zeStreamError,
zeDataError,
zeMemoryError,
zeBufferError,
zeVersionError
);

{** TZStreamRec ***********************************************************}

TZStreamRec = packed record
next_in : PChar; // 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 : PChar; // 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 : PChar; // 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 : {$ifdef Version6Plus} Int64 {$else} Longint {$endif};
FOnProgress: TNotifyEvent;

FZStream : TZStreamRec;
FBuffer : Array [Word] of Char;
protected
constructor Create(stream: TStream);

procedure DoProgress; dynamic;

property OnProgress: TNotifyEvent read FOnProgress write FOnProgress;
end;

{** TZCompressionStream ***************************************************}

TZCompressionStream = class(TCustomZStream)
private
function GetCompressionRate: Single;
public
constructor Create(dest: TStream;
compressionLevel: TZCompressionLevel = zcDefault); overload;

constructor Create(dest: TStream; compressionLevel: TZCompressionLevel;
windowBits, memLevel: Integer; strategy: TZStrategy); 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;

{** TZDecompressionStream *************************************************}

TZDecompressionStream = class(TCustomZStream)
public
constructor Create(source: TStream); overload;
constructor Create(source: TStream; windowBits: Integer); 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 OnProgress;
end;

{** 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);

{*****************************************************************************
* ZCompress2 *
* *
* pre-conditions *
* inBuffer = pointer to uncompressed data *
* inSize = size of inBuffer (bytes) *
* outBuffer = pointer (unallocated) *
* level = compression level *
* method = compression method *
* windowBits = window bits *
* memLevel = memory level *
* strategy = compression strategy *
* *
* post-conditions *
* outBuffer = pointer to compressed data (allocated) *
* outSize = size of outBuffer (bytes) *
*****************************************************************************}

procedure ZCompress2(const inBuffer: Pointer; inSize: Integer;
out outBuffer: Pointer; out outSize: Integer; level: TZCompressionLevel;
windowBits, memLevel: Integer; strategy: TZStrategy);

{*****************************************************************************
* 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);

{*****************************************************************************
* ZDecompress2 *
* *
* pre-conditions *
* inBuffer = pointer to compressed data *
* inSize = size of inBuffer (bytes) *
* outBuffer = pointer (unallocated) *
* windowBits = window bits *
* outEstimate = estimated size of uncompressed data (bytes) *
* *
* post-conditions *
* outBuffer = pointer to decompressed data (allocated) *
* outSize = size of outBuffer (bytes) *
*****************************************************************************}

procedure ZDecompress2(const inBuffer: Pointer; inSize: Integer;
out outBuffer: Pointer; out outSize: Integer; windowBits: Integer;
outEstimate: Integer = 0);

{** string routines *********************************************************}

{*****************************************************************************
* ZCompressStr *
* *
* pre-conditions *
* s = uncompressed data string *
* level = compression level *
* *
* return *
* compressed data string *
*****************************************************************************}

function ZCompressStr(const s: String;
level: TZCompressionLevel = zcDefault): String;

{*****************************************************************************
* ZCompressStrEx *
* *
* pre-conditions *
* s = uncompressed data string *
* level = compression level *
* *
* return *
* compressed data string with 4 byte (integer) header indicating *
* original uncompressed data length *
*****************************************************************************}

function ZCompressStrEx(const s: String;
level: TZCompressionLevel = zcDefault): String;

{*****************************************************************************
* ZCompressStr2 *
* *
* pre-conditions *
* s = uncompressed data string *
* level = compression level *
* windowBits = window bits *
* memLevel = memory level *
* strategy = compression strategy *
* *
* return *
* compressed data string *
*****************************************************************************}

function ZCompressStr2(const s: String; level: TZCompressionLevel;
windowBits, memLevel: Integer; strategy: TZStrategy): String;

function ZCompressStrWeb(const s: String): String;

{*****************************************************************************
* ZDecompressStr *
* *
* pre-conditions *
* s = compressed data string *
* *
* return *
* uncompressed data string *
*****************************************************************************}

function ZDecompressStr(const s: String): String;

{*****************************************************************************
* ZDecompressStrEx *
* *
* pre-conditions *
* s = compressed data string with 4 byte (integer) header indicating *
* original uncompressed data length *
* *
* return *
* uncompressed data string *
*****************************************************************************}

function ZDecompressStrEx(const s: String): String;

{*****************************************************************************
* ZDecompressStr2 *
* *
* pre-conditions *
* s = compressed data string *
* windowBits = window bits *
* *
* return *
* uncompressed data string *
*****************************************************************************}

function ZDecompressStr2(const s: String; windowBits: Integer): String;

{** stream routines *********************************************************}

procedure ZCompressStream(inStream, outStream: TStream;
level: TZCompressionLevel = zcDefault);

procedure ZCompressStream2(inStream, outStream: TStream;
level: TZCompressionLevel; windowBits, memLevel: Integer;
strategy: TZStrategy);

procedure ZCompressStreamWeb(inStream, outStream: TStream);

procedure ZDecompressStream(inStream, outStream: TStream);

procedure ZDecompressStream2(inStream, outStream: TStream;
windowBits: Integer);

{** checksum routines *******************************************************}

function ZAdler32(adler: Longint; const buffer; size: Integer): Longint;
function ZCrc32(crc: Longint; const buffer; size: Integer): Longint;

{****************************************************************************}

type
EZLibErrorClass = class of EZlibError;

EZLibError = class(Exception)
private
FErrorCode: Integer;
public
constructor Create(code: Integer; const dummy: String = ''); overload;
constructor Create(error: TZError; const dummy: String = ''); overload;

property ErrorCode: Integer read FErrorCode write FErrorCode;
end;

EZCompressionError = class(EZLibError);
EZDecompressionError = class(EZLibError);

implementation

{** link zlib code **********************************************************}

{$L deflate.obj}
{$L inflate.obj}
{$L inftrees.obj}
{$L infback.obj}
{$L inffast.obj}
{$L trees.obj}
{$L compress.obj}
{$L adler32.obj}
{$L crc32.obj}

{*****************************************************************************
* note: do not reorder the above -- doing so will result in external *
* functions being undefined *
*****************************************************************************}

const
{** flush constants *******************************************************}

Z_NO_FLUSH = 0;
Z_PARTIAL_FLUSH = 1;
Z_SYNC_FLUSH = 2;
Z_FULL_FLUSH = 3;
Z_FINISH = 4;
Z_BLOCK = 5;

{** 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_RLE = 3;
Z_FIXED = 4;
Z_DEFAULT_STRATEGY = 0;

{** data types ************************************************************}

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

{** return code messages **************************************************}

_z_errmsg: array[0..9] of PChar = (
'need dictionary', // Z_NEED_DICT (2)
'stream end', // Z_STREAM_END (1)
'ok', // 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)
''
);

ZLevels: Array [TZCompressionLevel] of Shortint = (
Z_NO_COMPRESSION, // zcNone
Z_BEST_SPEED, // zcFastest
Z_DEFAULT_COMPRESSION, // zcDefault
Z_BEST_COMPRESSION, // zcMax
1, // zcLevel1
2, // zcLevel2
3, // zcLevel3
4, // zcLevel4
5, // zcLevel5
6, // zcLevel6
7, // zcLevel7
8, // zcLevel8
9 // zcLevel9
);

ZStrategies: Array [TZStrategy] of Shortint = (
Z_DEFAULT_STRATEGY, // zsDefault
Z_FILTERED, // zsFiltered
Z_HUFFMAN_ONLY, // zsHuffman
Z_RLE, // zsRLE
Z_FIXED // zsFixed
);

ZErrors: Array [TZError] of Shortint = (
Z_ERRNO, // zeError
Z_STREAM_ERROR, // zeStreamError
Z_DATA_ERROR, // zeDataError
Z_MEM_ERROR, // zeMemoryError
Z_BUF_ERROR, // zeBufferError
Z_VERSION_ERROR // zeVersionError
);

SZInvalid = 'Invalid ZStream operation!';

{** deflate routines ********************************************************}

function deflateInit_(var strm: TZStreamRec; level: Integer; version: PChar;
recsize: Integer): Integer;
external;

function deflateInit2_(var strm: TZStreamRec; level, method, windowBits,
memLevel, strategy: Integer; version: PChar; recsize: Integer): Integer;
external;

function deflate(var strm: TZStreamRec; flush: Integer): Integer;
external;

function deflateEnd(var strm: TZStreamRec): Integer;
external;

{** inflate routines ********************************************************}

function inflateInit_(var strm: TZStreamRec; version: PChar;
recsize: Integer): Integer;
external;

function inflateInit2_(var strm: TZStreamRec; windowBits: Integer;
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;

{** checksum routines *******************************************************}

function adler32(adler: Longint; const buf; len: Integer): Longint;
external;

function crc32(crc: Longint; const buf; len: Integer): Longint;
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;

{** 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(code);
end;
end;

function ZDecompressCheck(code: Integer): Integer;
begin
Result := code;

if code < 0 then
begin
raise EZDecompressionError.Create(code);
end;
end;

procedure ZInternalCompress(var zstream: TZStreamRec; const inBuffer: Pointer;
inSize: Integer; out outBuffer: Pointer; out outSize: Integer);
const
delta = 256;
begin
outSize := ((inSize + (inSize div 10) + 12) + 255) and not 255;
GetMem(outBuffer,outSize);

try
try
zstream.next_in := inBuffer;
zstream.avail_in := inSize;
zstream.next_out := outBuffer;
zstream.avail_out := outSize;

while ZCompressCheck(deflate(zstream,Z_FINISH)) <> Z_STREAM_END do
begin
Inc(outSize,delta);
ReallocMem(outBuffer,outSize);

zstream.next_out := PChar(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 ZInternalDecompress(zstream: TZStreamRec; const inBuffer: Pointer;
inSize: Integer; out outBuffer: Pointer; out outSize: Integer;
outEstimate: Integer);
var
delta: Integer;
begin
delta := (inSize + 255) and not 255;

if outEstimate = 0 then outSize := delta
else outSize := outEstimate;

GetMem(outBuffer,outSize);

try
try
zstream.next_in := inBuffer;
zstream.avail_in := inSize;
zstream.next_out := outBuffer;
zstream.avail_out := outSize;

while ZDecompressCheck(inflate(zstream,Z_NO_FLUSH)) <> Z_STREAM_END do
begin
Inc(outSize,delta);
ReallocMem(outBuffer,outSize);

zstream.next_out := PChar(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;

procedure ZCompress(const inBuffer: Pointer; inSize: Integer;
out outBuffer: Pointer; out outSize: Integer;
level: TZCompressionLevel);
var
zstream: TZStreamRec;
begin
FillChar(zstream,SizeOf(TZStreamRec),0);

ZCompressCheck(DeflateInit(zstream,ZLevels[level]));

ZInternalCompress(zstream,inBuffer,inSize,outBuffer,outSize);
end;

procedure ZCompress2(const inBuffer: Pointer; inSize: Integer;
out outBuffer: Pointer; out outSize: Integer; level: TZCompressionLevel;
windowBits, memLevel: Integer; strategy: TZStrategy);
var
zstream: TZStreamRec;
begin
FillChar(zstream,SizeOf(TZStreamRec),0);

ZCompressCheck(DeflateInit2(zstream,ZLevels[level],Z_DEFLATED,windowBits,
memLevel,ZStrategies[strategy]));

ZInternalCompress(zstream,inBuffer,inSize,outBuffer,outSize);
end;

procedure ZDecompress(const inBuffer: Pointer; inSize: Integer;
out outBuffer: Pointer; out outSize: Integer; outEstimate: Integer);
var
zstream: TZStreamRec;
begin
FillChar(zstream,SizeOf(TZStreamRec),0);

ZDecompressCheck(InflateInit(zstream));

ZInternalDecompress(zstream,inBuffer,inSize,outBuffer,outSize,outEstimate);
end;

procedure ZDecompress2(const inBuffer: Pointer; inSize: Integer;
out outBuffer: Pointer; out outSize: Integer; windowBits: Integer;
outEstimate: Integer);
var
zstream: TZStreamRec;
begin
FillChar(zstream,SizeOf(TZStreamRec),0);

ZDecompressCheck(InflateInit2(zstream,windowBits));

ZInternalDecompress(zstream,inBuffer,inSize,outBuffer,outSize,outEstimate);
end;

{** string routines *********************************************************}

function ZCompressStr(const s: String; level: TZCompressionLevel): String;
var
buffer: Pointer;
size : Integer;
begin
ZCompress(PChar(s),Length(s),buffer,size,level);

SetLength(result,size);
Move(buffer^,result[1],size);

FreeMem(buffer);
end;

function ZCompressStrEx(const s: String; level: TZCompressionLevel): String;
var
buffer: Pointer;
size : Integer;
begin
ZCompress(PChar(s),Length(s),buffer,size,level);

SetLength(result,size + SizeOf(Integer));

Move(buffer^,result[5],size);

size := Length(s);
Move(size,result[1],SizeOf(Integer));

FreeMem(buffer);
end;

function ZCompressStr2(const s: String; level: TZCompressionLevel;
windowBits, memLevel: Integer; strategy: TZStrategy): String;
var
buffer: Pointer;
size : Integer;
begin
ZCompress2(PChar(s),Length(s),buffer,size,level,windowBits,memLevel,
strategy);

SetLength(result,size);
Move(buffer^,result[1],size);

FreeMem(buffer);
end;

function ZCompressStrWeb(const s: String): String;
begin
result := ZCompressStr2(s,zcFastest,-15,9,zsDefault);
end;

function ZDecompressStr(const s: String): String;
var
buffer: Pointer;
size : Integer;
begin
ZDecompress(PChar(s),Length(s),buffer,size);

SetLength(result,size);
Move(buffer^,result[1],size);

FreeMem(buffer);
end;

function ZDecompressStrEx(const s: String): String;
var
buffer : Pointer;
size : Integer;
data : String;
dataSize: Integer;
begin
Move(s[1],size,SizeOf(Integer));

dataSize := Length(s) - SizeOf(Integer);

SetLength(data,dataSize);
Move(s[5],data[1],dataSize);

ZDecompress(PChar(data),dataSize,buffer,size,size);

SetLength(result,size);
Move(buffer^,result[1],size);

FreeMem(buffer);
end;

function ZDecompressStr2(const s: String; windowBits: Integer): String;
var
buffer: Pointer;
size : Integer;
begin
ZDecompress2(PChar(s),Length(s),buffer,size,windowBits);

SetLength(result,size);
Move(buffer^,result[1],size);

FreeMem(buffer);
end;

{** stream routines *********************************************************}

procedure ZInternalCompressStream(zstream: TZStreamRec; inStream,
outStream: TStream);
const
bufferSize = 32768;
var
zresult : Integer;
inBuffer : Array [0..bufferSize-1] of Char;
outBuffer: Array [0..bufferSize-1] of Char;
outSize : Integer;
begin
zresult := Z_STREAM_END;

zstream.avail_in := inStream.Read(inBuffer,bufferSize);

while zstream.avail_in > 0 do
begin
zstream.next_in := inBuffer;

repeat
zstream.next_out := outBuffer;
zstream.avail_out := bufferSize;

zresult := ZCompressCheck(deflate(zstream,Z_NO_FLUSH));

outSize := bufferSize - zstream.avail_out;

outStream.Write(outBuffer,outSize);
until (zresult = Z_STREAM_END) or (zstream.avail_in = 0);

zstream.avail_in := inStream.Read(inBuffer,bufferSize);
end;

while zresult <> Z_STREAM_END do
begin
zstream.next_out := outBuffer;
zstream.avail_out := bufferSize;

zresult := ZCompressCheck(deflate(zstream,Z_FINISH));

outSize := bufferSize - zstream.avail_out;

outStream.Write(outBuffer,outSize);
end;

ZCompressCheck(deflateEnd(zstream));
end;

procedure ZInternalDecompressStream(zstream: TZStreamRec; inStream,
outStream: TStream);
const
bufferSize = 32768;
var
zresult : Integer;
inBuffer : Array [0..bufferSize-1] of Char;
outBuffer: Array [0..bufferSize-1] of Char;
outSize : Integer;
begin
zresult := Z_STREAM_END;

zstream.avail_in := inStream.Read(inBuffer,bufferSize);

while zstream.avail_in > 0 do
begin
zstream.next_in := inBuffer;

repeat
zstream.next_out := outBuffer;
zstream.avail_out := bufferSize;

zresult := ZDecompressCheck(inflate(zstream,Z_NO_FLUSH));

outSize := bufferSize - zstream.avail_out;

outStream.Write(outBuffer,outSize);
until (zresult = Z_STREAM_END) or (zstream.avail_in = 0);

if zresult <> Z_STREAM_END then
begin
zstream.avail_in := inStream.Read(inBuffer,bufferSize);
end
else if zstream.avail_in > 0 then
begin
inStream.Position := inStream.Position - zstream.avail_in;
zstream.avail_in := 0;
end;
end;

while zresult <> Z_STREAM_END do
begin
zstream.next_out := outBuffer;
zstream.avail_out := bufferSize;

zresult := ZDecompressCheck(inflate(zstream,Z_FINISH));

outSize := bufferSize - zstream.avail_out;

outStream.Write(outBuffer,outSize);
end;

ZDecompressCheck(inflateEnd(zstream));
end;

procedure ZCompressStream(inStream, outStream: TStream;
level: TZCompressionLevel);
var
zstream: TZStreamRec;
begin
FillChar(zstream,SizeOf(TZStreamRec),0);

ZCompressCheck(DeflateInit(zstream,ZLevels[level]));

ZInternalCompressStream(zstream,inStream,outStream);
end;

procedure ZCompressStream2(inStream, outStream: TStream;
level: TZCompressionLevel; windowBits, memLevel: Integer;
strategy: TZStrategy);
var
zstream: TZStreamRec;
begin
FillChar(zstream,SizeOf(TZStreamRec),0);

ZCompressCheck(DeflateInit2(zstream,ZLevels[level],Z_DEFLATED,windowBits,
memLevel,ZStrategies[strategy]));

ZInternalCompressStream(zstream,inStream,outStream);
end;

procedure ZCompressStreamWeb(inStream, outStream: TStream);
begin
ZCompressStream2(inStream,outStream,zcFastest,-15,9,zsDefault);
end;

procedure ZDecompressStream(inStream, outStream: TStream);
var
zstream: TZStreamRec;
begin
FillChar(zstream,SizeOf(TZStreamRec),0);

ZDecompressCheck(InflateInit(zstream));

ZInternalDecompressStream(zstream,inStream,outStream);
end;

procedure ZDecompressStream2(inStream, outStream: TStream;
windowBits: Integer);
var
zstream: TZStreamRec;
begin
FillChar(zstream,SizeOf(TZStreamRec),0);

ZDecompressCheck(InflateInit2(zstream,windowBits));

ZInternalDecompressStream(zstream,inStream,outStream);
end;

{** checksum routines *******************************************************}

function ZAdler32(adler: Longint; const buffer; size: Integer): Longint;
begin
result := adler32(adler,buffer,size);
end;

function ZCrc32(crc: Longint; const buffer; size: Integer): Longint;
begin
result := crc32(crc,buffer,size);
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(dest: TStream;
compressionLevel: TZCompressionLevel; windowBits, memLevel: Integer;
strategy: TZStrategy);
begin
inherited Create(dest);

FZStream.next_out := FBuffer;
FZStream.avail_out := SizeOf(FBuffer);

ZCompressCheck(DeflateInit2(FZStream,ZLevels[compressionLevel],Z_DEFLATED,
windowBits,memLevel,ZStrategies[strategy]));
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;

constructor TZDecompressionStream.Create(source: TStream;
windowBits: Integer);
begin
inherited Create(source);

FZStream.next_in := FBuffer;
FZStream.avail_in := 0;

ZDecompressCheck(InflateInit2(FZStream,windowBits));
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;

{** EZLibError **************************************************************}

constructor EZLibError.Create(code: Integer; const dummy: String);
begin
inherited Create(_z_errmsg[2 - code]);

FErrorCode := code;
end;

constructor EZLibError.Create(error: TZError; const dummy: String);
begin
Create(ZErrors[error],dummy);
end;

end.