{*****************************************************************************
* ZLibEx.pas *
* *
* copyright (c) 2000-2002 base2 technologies *
* copyright (c) 1997 Borland International *
* *
* revision history *
* 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 ZLibEx;
interface
uses
Sysutils, Classes;
const
ZLIB_VERSION = '1.1.4';
type
TZAlloc = function (opaque: Pointer; items, size: Integer): Pointer;
TZFree = procedure (opaque, block: Pointer);
TZCompressionLevel = (zcNone, zcFastest, zcDefault, zcMax);
{** 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 : Integer;
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);
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);
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);
{*****************************************************************************
* 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): String;
function ZDecompressStr(const s: String): String;
{** stream routines *********************************************************}
procedure ZCompressStream(inStream, outStream: TStream;
level: TZCompressionLevel = zcDefault);
procedure ZDecompressStream(inStream, outStream: TStream);
{****************************************************************************}
type
EZLibError = class(Exception);
EZCompressionError = class(EZLibError);
EZDecompressionError = class(EZLibError);
implementation
{** link zlib code **********************************************************}
{$L deflate.obj}
{$L inflate.obj}
{$L infblock.obj}
{$L inftrees.obj}
{$L infcodes.obj}
{$L infutil.obj}
{$L inffast.obj}
{$L trees.obj}
{$L adler32.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;
{** 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)
'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)
''
);
ZLevels: array [TZCompressionLevel] of Shortint = (
Z_NO_COMPRESSION,
Z_BEST_SPEED,
Z_DEFAULT_COMPRESSION,
Z_BEST_COMPRESSION
);
SZInvalid = 'Invalid ZStream operation!';
{** deflate routines ********************************************************}
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 routines ********************************************************}
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;
{** 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(_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 := 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 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 := 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;
{** 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 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;
{** stream routines *********************************************************}
procedure ZCompressStream(inStream, outStream: TStream;
level: TZCompressionLevel);
const
bufferSize = 32768;
var
zstream : TZStreamRec;
zresult : Integer;
inBuffer : Array [0..bufferSize-1] of Char;
outBuffer: Array [0..bufferSize-1] of Char;
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 ZDecompressStream(inStream, outStream: TStream);
const
bufferSize = 32768;
var
zstream : TZStreamRec;
zresult : Integer;
inBuffer : Array [0..bufferSize-1] of Char;
outBuffer: Array [0..bufferSize-1] of Char;
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;
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;
end.
ZLibEx.pas
最新推荐文章于 2021-02-27 00:38:54 发布