david
e4d0fcb01d
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.RemObjects@46 b6239004-a887-0f4b-9937-50029ccdca16
433 lines
13 KiB
ObjectPascal
433 lines
13 KiB
ObjectPascal
{******************************************************************}
|
|
{ }
|
|
{ Borland Delphi Supplemental Components }
|
|
{ ZLIB Data Compression Interface Unit }
|
|
{ }
|
|
{ Copyright (c) 1997-2002 Borland Software Corporation }
|
|
{ }
|
|
{******************************************************************}
|
|
|
|
unit uROZLib;
|
|
|
|
{$IFDEF LINUX}
|
|
{$I ../../RemObjects.inc}
|
|
{$ELSE}
|
|
{$I ..\..\RemObjects.inc}
|
|
{$ENDIF LINUX}
|
|
|
|
interface
|
|
|
|
uses SysUtils, Classes, zlib;
|
|
|
|
type
|
|
// 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;
|
|
public
|
|
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);
|
|
|
|
{ DecompressToUserBuf decompresses data, buffer to buffer, in one call.
|
|
In: InBuf = ptr to compressed data
|
|
InBytes = number of bytes in InBuf
|
|
Out: OutBuf = ptr to user-allocated buffer to contain decompressed data
|
|
BufSize = number of bytes in OutBuf }
|
|
procedure DecompressToUserBuf(const InBuf: Pointer; InBytes: Integer;
|
|
const OutBuf: Pointer; BufSize: Integer);
|
|
|
|
type
|
|
EZlibError = class(Exception);
|
|
ECompressionError = class(EZlibError);
|
|
EDecompressionError = class(EZlibError);
|
|
|
|
implementation
|
|
|
|
resourcestring
|
|
sTargetBufferTooSmall = 'ZLib: Target buffer may be too small';
|
|
sInvalidStreamOp = 'ZLib: Invalid stream operation';
|
|
sError = 'ZLib: Error';
|
|
|
|
function CCheck(code: Integer): Integer;
|
|
begin
|
|
Result := code;
|
|
if code < 0 then
|
|
raise ECompressionError.Create(sError); //!!
|
|
end;
|
|
|
|
function DCheck(code: Integer): Integer;
|
|
begin
|
|
Result := code;
|
|
if code < 0 then
|
|
raise EDecompressionError.Create(sError); //!!
|
|
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);
|
|
strm.zalloc := zlibAllocMem;
|
|
strm.zfree := zlibFreeMem;
|
|
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 := pbytef(pchar(OutBuf) + (pchar(strm.next_out) - pchar(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);
|
|
strm.zalloc := zlibAllocMem;
|
|
strm.zfree := zlibFreeMem;
|
|
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 := pbytef(pchar(OutBuf) + (pchar(strm.next_out) - pchar(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;
|
|
|
|
procedure DecompressToUserBuf(const InBuf: Pointer; InBytes: Integer;
|
|
const OutBuf: Pointer; BufSize: Integer);
|
|
var
|
|
strm: TZStreamRec;
|
|
begin
|
|
FillChar(strm, sizeof(strm), 0);
|
|
strm.zalloc := zlibAllocMem;
|
|
strm.zfree := zlibFreeMem;
|
|
strm.next_in := InBuf;
|
|
strm.avail_in := InBytes;
|
|
strm.next_out := OutBuf;
|
|
strm.avail_out := BufSize;
|
|
DCheck(inflateInit_(strm, zlib_version, sizeof(strm)));
|
|
try
|
|
if DCheck(inflate(strm, Z_FINISH)) <> Z_STREAM_END then
|
|
raise EZlibError.CreateRes(@sTargetBufferTooSmall);
|
|
finally
|
|
DCheck(inflateEnd(strm));
|
|
end;
|
|
end;
|
|
|
|
// TCustomZlibStream
|
|
|
|
constructor TCustomZLibStream.Create(Strm: TStream);
|
|
begin
|
|
inherited Create;
|
|
FStrm := Strm;
|
|
FStrmPos := Strm.Position;
|
|
FZRec.zalloc := zlibAllocMem;
|
|
FZRec.zfree := zlibFreeMem;
|
|
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 := pbytef(@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 := pbytef(@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
|
|
Result := 0; // else it's warn
|
|
raise ECompressionError.CreateRes(@sInvalidStreamOp);
|
|
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 := pbytef(@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.CreateRes(@sInvalidStreamOp);
|
|
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 := pbytef(@FBuffer);
|
|
FZRec.avail_in := 0;
|
|
DCheck(inflateInit_(FZRec, zlib_version, sizeof(FZRec)));
|
|
end;
|
|
|
|
destructor TDecompressionStream.Destroy;
|
|
begin
|
|
FStrm.Seek(-FZRec.avail_in, 1);
|
|
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 := pbytef(@FBuffer);
|
|
FStrmPos := FStrm.Position;
|
|
Progress(Self);
|
|
end;
|
|
CCheck(inflate(FZRec, 0));
|
|
end;
|
|
Result := Count;
|
|
end;
|
|
|
|
function TDecompressionStream.Write(const Buffer; Count: Longint): Longint;
|
|
begin
|
|
Result := 0; // else it's warn
|
|
raise EDecompressionError.CreateRes(@sInvalidStreamOp);
|
|
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 := pbytef(@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.CreateRes(@sInvalidStreamOp);
|
|
Result := FZRec.total_out;
|
|
end;
|
|
|
|
end.
|