534 lines
16 KiB
ObjectPascal
534 lines
16 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 }
|
|
|
|
unit zlib;
|
|
|
|
interface
|
|
|
|
uses Sysutils, Classes;
|
|
|
|
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;
|
|
|
|
// Abstract ancestor class
|
|
TCustomZlibStream = class(TStream)
|
|
private
|
|
FStrm: TStream;
|
|
FStrmPos: Integer;
|
|
FOnProgress: TNotifyEvent;
|
|
FZRec: TZStreamRec;
|
|
FBuffer: array [Word] of Char;
|
|
protected
|
|
procedure Progress(Sender: TObject); dynamic;
|
|
property OnProgress: TNotifyEvent read FOnProgress write FOnProgress;
|
|
constructor Create(Strm: TStream);
|
|
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);
|
|
|
|
TCompressionStream = class(TCustomZlibStream)
|
|
private
|
|
function GetCompressionRate: Single;
|
|
public
|
|
constructor Create(CompressionLevel: TCompressionLevel; Dest: 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 CompressionRate: Single read GetCompressionRate;
|
|
property OnProgress;
|
|
end;
|
|
|
|
{ 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 raise an exception.
|
|
|
|
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.}
|
|
|
|
TDecompressionStream = class(TCustomZlibStream)
|
|
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;
|
|
|
|
|
|
|
|
{ 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 }
|
|
procedure CompressBuf(const InBuf: Pointer; InBytes: Integer;
|
|
out OutBuf: Pointer; out OutBytes: Integer);
|
|
|
|
|
|
{ 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 }
|
|
procedure DecompressBuf(const InBuf: Pointer; InBytes: Integer;
|
|
OutEstimate: Integer; out OutBuf: Pointer; out OutBytes: Integer);
|
|
|
|
const
|
|
zlib_version = '1.1.3';
|
|
|
|
type
|
|
EZlibError = class(Exception);
|
|
ECompressionError = class(EZlibError);
|
|
EDecompressionError = class(EZlibError);
|
|
|
|
function adler32(adler: Integer; buf: PChar; len: Integer): Integer;
|
|
|
|
implementation
|
|
|
|
const
|
|
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)
|
|
''
|
|
);
|
|
|
|
{$L deflate.obj}
|
|
{$L inflate.obj}
|
|
{$L inftrees.obj}
|
|
{$L trees.obj}
|
|
{$L adler32.obj}
|
|
{$L infblock.obj}
|
|
{$L infcodes.obj}
|
|
{$L infutil.obj}
|
|
{$L 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;
|
|
|
|
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;
|
|
|
|
|
|
|
|
// 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;
|
|
|
|
|
|
function zcalloc(AppData: Pointer; Items, Size: Integer): Pointer;
|
|
begin
|
|
GetMem(Result, Items*Size);
|
|
end;
|
|
|
|
procedure zcfree(AppData, Block: Pointer);
|
|
begin
|
|
FreeMem(Block);
|
|
end;
|
|
|
|
function zlibCheck(code: Integer): Integer;
|
|
begin
|
|
Result := code;
|
|
if code < 0 then
|
|
raise EZlibError.Create('error'); //!!
|
|
end;
|
|
|
|
function CCheck(code: Integer): Integer;
|
|
begin
|
|
Result := code;
|
|
if code < 0 then
|
|
raise ECompressionError.Create('error'); //!!
|
|
end;
|
|
|
|
function DCheck(code: Integer): Integer;
|
|
begin
|
|
Result := code;
|
|
if code < 0 then
|
|
raise EDecompressionError.Create('error'); //!!
|
|
end;
|
|
|
|
procedure CompressBuf(const InBuf: Pointer; InBytes: Integer;
|
|
out OutBuf: Pointer; out OutBytes: Integer);
|
|
var
|
|
strm: TZStreamRec;
|
|
P: Pointer;
|
|
begin
|
|
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;
|
|
CCheck(deflateInit_(strm, Z_BEST_COMPRESSION, zlib_version, sizeof(strm)));
|
|
try
|
|
while CCheck(deflate(strm, Z_FINISH)) <> Z_STREAM_END 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;
|
|
finally
|
|
CCheck(deflateEnd(strm));
|
|
end;
|
|
ReallocMem(OutBuf, strm.total_out);
|
|
OutBytes := strm.total_out;
|
|
except
|
|
FreeMem(OutBuf);
|
|
raise
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure DecompressBuf(const InBuf: Pointer; InBytes: Integer;
|
|
OutEstimate: Integer; out OutBuf: Pointer; out OutBytes: Integer);
|
|
var
|
|
strm: TZStreamRec;
|
|
P: Pointer;
|
|
BufInc: Integer;
|
|
begin
|
|
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;
|
|
DCheck(inflateInit_(strm, zlib_version, sizeof(strm)));
|
|
try
|
|
while DCheck(inflate(strm, Z_FINISH)) <> Z_STREAM_END 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;
|
|
finally
|
|
DCheck(inflateEnd(strm));
|
|
end;
|
|
ReallocMem(OutBuf, strm.total_out);
|
|
OutBytes := strm.total_out;
|
|
except
|
|
FreeMem(OutBuf);
|
|
raise
|
|
end;
|
|
end;
|
|
|
|
|
|
// TCustomZlibStream
|
|
|
|
constructor TCustomZLibStream.Create(Strm: TStream);
|
|
begin
|
|
inherited Create;
|
|
FStrm := Strm;
|
|
FStrmPos := Strm.Position;
|
|
end;
|
|
|
|
procedure TCustomZLibStream.Progress(Sender: TObject);
|
|
begin
|
|
if Assigned(FOnProgress) then FOnProgress(Sender);
|
|
end;
|
|
|
|
|
|
// TCompressionStream
|
|
|
|
constructor TCompressionStream.Create(CompressionLevel: TCompressionLevel;
|
|
Dest: TStream);
|
|
const
|
|
Levels: array [TCompressionLevel] of ShortInt =
|
|
(Z_NO_COMPRESSION, Z_BEST_SPEED, Z_DEFAULT_COMPRESSION, Z_BEST_COMPRESSION);
|
|
begin
|
|
inherited Create(Dest);
|
|
FZRec.next_out := FBuffer;
|
|
FZRec.avail_out := sizeof(FBuffer);
|
|
CCheck(deflateInit_(FZRec, Levels[CompressionLevel], zlib_version, sizeof(FZRec)));
|
|
end;
|
|
|
|
destructor TCompressionStream.Destroy;
|
|
begin
|
|
FZRec.next_in := nil;
|
|
FZRec.avail_in := 0;
|
|
try
|
|
if FStrm.Position <> FStrmPos then FStrm.Position := FStrmPos;
|
|
while (CCheck(deflate(FZRec, Z_FINISH)) <> Z_STREAM_END)
|
|
and (FZRec.avail_out = 0) do
|
|
begin
|
|
FStrm.WriteBuffer(FBuffer, sizeof(FBuffer));
|
|
FZRec.next_out := FBuffer;
|
|
FZRec.avail_out := sizeof(FBuffer);
|
|
end;
|
|
if FZRec.avail_out < sizeof(FBuffer) then
|
|
FStrm.WriteBuffer(FBuffer, sizeof(FBuffer) - FZRec.avail_out);
|
|
finally
|
|
deflateEnd(FZRec);
|
|
end;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TCompressionStream.Read(var Buffer; Count: Longint): Longint;
|
|
begin
|
|
raise ECompressionError.Create('Invalid stream operation');
|
|
end;
|
|
|
|
function TCompressionStream.Write(const Buffer; Count: Longint): Longint;
|
|
begin
|
|
FZRec.next_in := @Buffer;
|
|
FZRec.avail_in := Count;
|
|
if FStrm.Position <> FStrmPos then FStrm.Position := FStrmPos;
|
|
while (FZRec.avail_in > 0) do
|
|
begin
|
|
CCheck(deflate(FZRec, 0));
|
|
if FZRec.avail_out = 0 then
|
|
begin
|
|
FStrm.WriteBuffer(FBuffer, sizeof(FBuffer));
|
|
FZRec.next_out := FBuffer;
|
|
FZRec.avail_out := sizeof(FBuffer);
|
|
FStrmPos := FStrm.Position;
|
|
Progress(Self);
|
|
end;
|
|
end;
|
|
Result := Count;
|
|
end;
|
|
|
|
function TCompressionStream.Seek(Offset: Longint; Origin: Word): Longint;
|
|
begin
|
|
if (Offset = 0) and (Origin = soFromCurrent) then
|
|
Result := FZRec.total_in
|
|
else
|
|
raise ECompressionError.Create('Invalid stream operation');
|
|
end;
|
|
|
|
function TCompressionStream.GetCompressionRate: Single;
|
|
begin
|
|
if FZRec.total_in = 0 then
|
|
Result := 0
|
|
else
|
|
Result := (1.0 - (FZRec.total_out / FZRec.total_in)) * 100.0;
|
|
end;
|
|
|
|
|
|
// TDecompressionStream
|
|
|
|
constructor TDecompressionStream.Create(Source: TStream);
|
|
begin
|
|
inherited Create(Source);
|
|
FZRec.next_in := FBuffer;
|
|
FZRec.avail_in := 0;
|
|
DCheck(inflateInit_(FZRec, zlib_version, sizeof(FZRec)));
|
|
end;
|
|
|
|
destructor TDecompressionStream.Destroy;
|
|
begin
|
|
inflateEnd(FZRec);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TDecompressionStream.Read(var Buffer; Count: Longint): Longint;
|
|
begin
|
|
FZRec.next_out := @Buffer;
|
|
FZRec.avail_out := Count;
|
|
if FStrm.Position <> FStrmPos then FStrm.Position := FStrmPos;
|
|
while (FZRec.avail_out > 0) do
|
|
begin
|
|
if FZRec.avail_in = 0 then
|
|
begin
|
|
FZRec.avail_in := FStrm.Read(FBuffer, sizeof(FBuffer));
|
|
if FZRec.avail_in = 0 then
|
|
begin
|
|
Result := Count - FZRec.avail_out;
|
|
Exit;
|
|
end;
|
|
FZRec.next_in := FBuffer;
|
|
FStrmPos := FStrm.Position;
|
|
Progress(Self);
|
|
end;
|
|
DCheck(inflate(FZRec, 0));
|
|
end;
|
|
Result := Count;
|
|
end;
|
|
|
|
function TDecompressionStream.Write(const Buffer; Count: Longint): Longint;
|
|
begin
|
|
raise EDecompressionError.Create('Invalid stream operation');
|
|
end;
|
|
|
|
function TDecompressionStream.Seek(Offset: Longint; Origin: Word): Longint;
|
|
var
|
|
I: Integer;
|
|
Buf: array [0..4095] of Char;
|
|
begin
|
|
if (Offset = 0) and (Origin = soFromBeginning) then
|
|
begin
|
|
DCheck(inflateReset(FZRec));
|
|
FZRec.next_in := FBuffer;
|
|
FZRec.avail_in := 0;
|
|
FStrm.Position := 0;
|
|
FStrmPos := 0;
|
|
end
|
|
else if ( (Offset >= 0) and (Origin = soFromCurrent)) or
|
|
( ((Offset - FZRec.total_out) > 0) and (Origin = soFromBeginning)) then
|
|
begin
|
|
if Origin = soFromBeginning then Dec(Offset, FZRec.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
|
|
raise EDecompressionError.Create('Invalid stream operation');
|
|
Result := FZRec.total_out;
|
|
end;
|
|
|
|
end.
|