{*****************************************************************************
* ZLibEx.pas *
* *
* copyright (c) 2000-2007 base2 technologies *
* copyright (c) 1995-2002 Borland Software Corporation *
* *
* revision history *
* 2007.03.15 moved gzip routines to separate unit (ZLibExGZ.pas) *
* 2006.10.07 fixed EZLibError constructor for c++ builder compatibility *
* 2006.03.28 moved Z_DEFLATED to interface section *
* added custom compression levels zcLevel1 thru zcLevel9 *
* 2006.03.27 added ZCompressStreamWeb *
* 2006.03.24 added ZAdler32 and ZCrc32 *
* 2005.11.29 changed FStreamPos to Int64 for delphi 6+ *
* 2005.07.25 updated to zlib version 1.2.3 *
* 2005.03.04 modified ZInternalCompressStream loops *
* modified ZInternalDecompressStream loops *
* 2005.02.07 fixed ZInternalCompressStream loop conditions *
* fixed ZInternalDecompressStream loop conditions *
* 2005.01.11 updated to zlib version 1.2.2 *
* added ZCompressStrWeb *
* 2004.01.06 updated to zlib version 1.2.1 *
* 2003.04.14 added ZCompress2 and ZDecompress2 *
* added ZCompressStr2 and ZDecompressStr2 *
* added ZCompressStream2 and ZDecompressStream2 *
* added overloaded T*Stream constructors to support *
* InflateInit2 and DeflateInit2 *
* fixed ZDecompressStream to use ZDecompressCheck instead of *
* ZCompressCheck *
* 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) *
* *
* acknowledgments *
* erik turner *
* 2001.10.26 Z*Stream routines *
* *
* david bennion *
* 2001.11.27 finding the nastly little endless loop quirk with the *
* TZDecompressionStream.Read method *
* *
* burak kalayci *
* 2002.03.15 informing me about the zlib 1.1.4 update *
* 2004.01.06 informing me about the zlib 1.2.1 update *
* *
* vicente s醤chez-alarcos *
* 2005.01.11 informing me about the zlib 1.2.2 update *
* *
* luigi sandon *
* 2005.02.07 pointing out the missing loop condition (Z_STREAM_END) *
* in ZInternalCompressStream and *
* ZInternalDecompressStream *
* *
* ferry van genderen *
* 2005.03.04 assiting me fine tune and beta test *
* ZInternalCompressStream and ZInternalDecompressStream *
* *
* mathijs van veluw *
* 2005.07.25 informing me about the zlib 1.2.3 update *
* *
* j. rathlev *
* 2005.11.28 pointing out the FStreamPos and TStream.Position type *
* inconsitency *
* *
* anders johansen *
* 2006.10.07 pointing out the ELibError constructor incompatibility *
* with c++ builder *
*****************************************************************************}
unit ZLibEx;
interface
{$I ZLibEx.inc}
uses
SysUtils, Classes;
const
{** version ids ***********************************************************}
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;
{*****************************************************************************
* note: do not reorder the above -- doing so will result in external *
* functions being undefined *
*****************************************************************************}
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;
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;
procedure ZCompress(const inBuffer: Pointer; inSize: Integer;
out outBuffer: Pointer; out outSize: Integer;
level: TZCompressionLevel);
var
zstream: TZStreamRec;
begin
FillChar(zstream,SizeOf(TZStreamRec),0);
procedure ZDecompress(const inBuffer: Pointer; inSize: Integer;
out outBuffer: Pointer; out outSize: Integer; outEstimate: Integer);
var
zstream: TZStreamRec;
begin
FillChar(zstream,SizeOf(TZStreamRec),0);
function ZCompressStr(const s: String; level: TZCompressionLevel): String;
var
buffer: Pointer;
size : Integer;
begin
ZCompress(PChar(s),Length(s),buffer,size,level);
function ZCompressStrEx(const s: String; level: TZCompressionLevel): String;
var
buffer: Pointer;
size : Integer;
begin
ZCompress(PChar(s),Length(s),buffer,size,level);
function ZDecompressStrEx(const s: String): String;
var
buffer : Pointer;
size : Integer;
data : String;
dataSize: Integer;
begin
Move(s[1],size,SizeOf(Integer));
function ZDecompressStr2(const s: String; windowBits: Integer): String;
var
buffer: Pointer;
size : Integer;
begin
ZDecompress2(PChar(s),Length(s),buffer,size,windowBits);
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;
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));
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;
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;
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));
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);