mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-26 12:29:10 +02:00
+ Added .gz file stream support
This commit is contained in:
parent
e5cb5e30a1
commit
1f7b7a1143
@ -1,388 +1,447 @@
|
||||
unit zstream;
|
||||
|
||||
interface
|
||||
|
||||
uses Sysutils, Classes,zlib;
|
||||
|
||||
type
|
||||
// Error reporting.
|
||||
|
||||
EZlibError = class(Exception);
|
||||
ECompressionError = class(EZlibError);
|
||||
EDecompressionError = class(EZlibError);
|
||||
|
||||
TCustomZlibStream = class(TStream)
|
||||
private
|
||||
FStrm: TStream;
|
||||
FStrmPos: Integer;
|
||||
FOnProgress: TNotifyEvent;
|
||||
FZRec: TZStream;
|
||||
FBuffer: array [Word] of Char;
|
||||
protected
|
||||
procedure Progress(Sender: TObject); dynamic;
|
||||
property OnProgress: TNotifyEvent read FOnProgress write FOnProgress;
|
||||
constructor Create(Strm: TStream);
|
||||
end;
|
||||
|
||||
TCompressionLevel = (clNone, clFastest, clDefault, clMax);
|
||||
|
||||
TCompressionStream = class(TCustomZlibStream)
|
||||
private
|
||||
function GetCompressionRate: extended;
|
||||
public
|
||||
constructor Create(CompressionLevel: TCompressionLevel; Dest: TStream);
|
||||
destructor Destroy; override;
|
||||
function CompressionCheck(code: Integer): Integer;
|
||||
procedure CompressBuf(const InBuf: Pointer; InBytes: Integer;
|
||||
var OutBuf: Pointer; var OutBytes: Integer);
|
||||
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: extended read GetCompressionRate;
|
||||
property OnProgress;
|
||||
end;
|
||||
|
||||
TDecompressionStream = class(TCustomZlibStream)
|
||||
public
|
||||
constructor Create(Source: TStream);
|
||||
destructor Destroy; override;
|
||||
function DecompressionCheck(code: Integer): Integer;
|
||||
procedure DecompressBuf(const InBuf: Pointer; InBytes: Integer;
|
||||
OutEstimate: Integer; var OutBuf: Pointer; var OutBytes: Integer);
|
||||
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;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
Const
|
||||
ErrorStrings : array [0..6] of string =
|
||||
unit zstream;
|
||||
|
||||
interface
|
||||
|
||||
uses Sysutils, Classes,zlib;
|
||||
{$H+}
|
||||
|
||||
type
|
||||
// Error reporting.
|
||||
|
||||
EZlibError = class(Exception);
|
||||
ECompressionError = class(EZlibError);
|
||||
EDecompressionError = class(EZlibError);
|
||||
|
||||
TCustomZlibStream = class(TStream)
|
||||
private
|
||||
FStrm: TStream;
|
||||
FStrmPos: Integer;
|
||||
FOnProgress: TNotifyEvent;
|
||||
FZRec: TZStream;
|
||||
FBuffer: array [Word] of Char;
|
||||
protected
|
||||
procedure Progress(Sender: TObject); dynamic;
|
||||
property OnProgress: TNotifyEvent read FOnProgress write FOnProgress;
|
||||
constructor Create(Strm: TStream);
|
||||
end;
|
||||
|
||||
TCompressionLevel = (clNone, clFastest, clDefault, clMax);
|
||||
|
||||
TCompressionStream = class(TCustomZlibStream)
|
||||
private
|
||||
function GetCompressionRate: extended;
|
||||
function CompressionCheck(code: Integer): Integer;
|
||||
procedure CompressBuf(const InBuf: Pointer; InBytes: Integer;
|
||||
var OutBuf: Pointer; var OutBytes: Integer);
|
||||
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: extended read GetCompressionRate;
|
||||
property OnProgress;
|
||||
end;
|
||||
|
||||
TDecompressionStream = class(TCustomZlibStream)
|
||||
private
|
||||
function DecompressionCheck(code: Integer): Integer;
|
||||
procedure DecompressBuf(const InBuf: Pointer; InBytes: Integer;
|
||||
OutEstimate: Integer; var OutBuf: Pointer; var OutBytes: Integer);
|
||||
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;
|
||||
|
||||
TGZOpenMode = (gzOpenRead,gzOpenWrite);
|
||||
|
||||
TGZFileStream = Class(TStream)
|
||||
Private
|
||||
FOpenMode : TGZOpenmode;
|
||||
FFIle : gzfile;
|
||||
Public
|
||||
Constructor Create(FileName: String;FileMode: TGZOpenMode);
|
||||
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;
|
||||
end;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
Const
|
||||
ErrorStrings : array [0..6] of string =
|
||||
('Unknown error %d','Z_ERRNO','Z_STREAM_ERROR',
|
||||
'Z_DATA_ERROR','Z_MEM_ERROR','Z_BUF_ERROR','Z_VERSION_ERROR');
|
||||
|
||||
Type PLongint = ^Longint;
|
||||
|
||||
Function DGetmem (Size : Longint) : pointer;
|
||||
begin
|
||||
Inc(Size,SizeOf(Longint));
|
||||
GetMem(Result,Size);
|
||||
If Result<>Nil then
|
||||
begin
|
||||
Plongint(Result)^:=Size;
|
||||
Inc(Result,SizeOf(Integer));
|
||||
end;
|
||||
end;
|
||||
|
||||
Procedure DFreeMem(P : Pointer);
|
||||
begin
|
||||
// Get Stored length
|
||||
Dec(P,SizeOf(Integer));
|
||||
FreeMem(P,Plongint(P)^);
|
||||
end;
|
||||
|
||||
Procedure DReallocMem (var P : Pointer; NewSize : Longint);
|
||||
// Reallocates memory pointed to by P.
|
||||
Var T : pointer;
|
||||
OldSize : longint;
|
||||
begin
|
||||
// Should raise an exception if no memory.
|
||||
T:=DGetMem(NewSize);
|
||||
OldSize:=PLongint(P-SizeOf(Integer))^;
|
||||
If oldSize<NewSize then
|
||||
Move(P^,T^,OldSize)
|
||||
else
|
||||
Move(P^,T^,NewSize);
|
||||
DFreeMem(P);
|
||||
end;
|
||||
|
||||
function zlibAllocMem(AppData: Pointer; Items, Size: Integer): Pointer;cdecl;
|
||||
begin
|
||||
Result:=DGetMem(Items*Size);
|
||||
end;
|
||||
|
||||
procedure zlibFreeMem(AppData, Block: Pointer);cdecl;
|
||||
begin
|
||||
DFreeMem(Block);
|
||||
end;
|
||||
|
||||
|
||||
procedure TCompressionStream.CompressBuf(const InBuf: Pointer; InBytes: Integer;
|
||||
var OutBuf: Pointer; var OutBytes: Integer);
|
||||
var
|
||||
strm: TZStream;
|
||||
P: Pointer;
|
||||
oldout : longint;
|
||||
begin
|
||||
FillChar(strm, sizeof(strm), 0);
|
||||
strm.zalloc := @zlibAllocMem;
|
||||
strm.zfree := @zlibFreeMem;
|
||||
OutBytes := ((InBytes + (InBytes div 10) + 12) + 255) and not 255;
|
||||
OutBuf:=DGetMem(OutBytes);
|
||||
try
|
||||
strm.next_in := InBuf;
|
||||
strm.avail_in := InBytes;
|
||||
strm.next_out := OutBuf;
|
||||
strm.avail_out := OutBytes;
|
||||
CompressionCheck(deflateInit_(strm, Z_BEST_COMPRESSION, zlibversion, sizeof(strm)));
|
||||
try
|
||||
while CompressionCheck(deflate(strm, Z_FINISH)) <> Z_STREAM_END do
|
||||
begin
|
||||
P := OutBuf;
|
||||
Inc(OutBytes, 256);
|
||||
DReallocMem(OutBuf,OutBytes);
|
||||
strm.next_out := PChar(Integer(OutBuf) + (Integer(strm.next_out) - Integer(P)));
|
||||
strm.avail_out := 256;
|
||||
end;
|
||||
finally
|
||||
CompressionCheck(deflateEnd(strm));
|
||||
end;
|
||||
DReallocMem(OutBuf,strm.total_out);
|
||||
OutBytes := strm.total_out;
|
||||
except
|
||||
DFreeMem(OutBuf);
|
||||
raise;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure TDecompressionStream.DecompressBuf(const InBuf: Pointer; InBytes: Integer;
|
||||
OutEstimate: Integer; var OutBuf: Pointer; var OutBytes: Integer);
|
||||
var
|
||||
strm: TZStream;
|
||||
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;
|
||||
OutBuf:=DGetMem(OutBytes);
|
||||
try
|
||||
strm.next_in := InBuf;
|
||||
strm.avail_in := InBytes;
|
||||
strm.next_out := OutBuf;
|
||||
strm.avail_out := OutBytes;
|
||||
DecompressionCheck(inflateInit_(strm, zlibversion, sizeof(strm)));
|
||||
try
|
||||
while DecompressionCheck(inflate(strm, Z_FINISH)) <> Z_STREAM_END do
|
||||
begin
|
||||
P := OutBuf;
|
||||
Inc(OutBytes, BufInc);
|
||||
DReallocMem(OutBuf, OutBytes);
|
||||
strm.next_out := PChar(Integer(OutBuf) + (Integer(strm.next_out) - Integer(P)));
|
||||
strm.avail_out := BufInc;
|
||||
end;
|
||||
finally
|
||||
DecompressionCheck(inflateEnd(strm));
|
||||
end;
|
||||
DReallocMem(OutBuf, strm.total_out);
|
||||
OutBytes := strm.total_out;
|
||||
except
|
||||
DFreeMem(OutBuf);
|
||||
raise;
|
||||
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 := FBuffer;
|
||||
FZRec.avail_out := sizeof(FBuffer);
|
||||
CompressionCheck(deflateInit_(FZRec, Levels[CompressionLevel], zlibversion, 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 (CompressionCheck(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.CompressionCheck(code: Integer): Integer;
|
||||
begin
|
||||
Result := code;
|
||||
if (code < 0) then
|
||||
if code < -6 then
|
||||
raise ECompressionError.CreateFmt(Errorstrings[0],[Code])
|
||||
else
|
||||
raise ECompressionError.Create(ErrorStrings[Abs(Code)]);
|
||||
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
|
||||
CompressionCheck(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: extended;
|
||||
begin
|
||||
Result:=0.0;
|
||||
{ With FZrec do
|
||||
if total_in = 0 then
|
||||
GetCompressionRate:=0.0
|
||||
else
|
||||
GetCompressionRate:=1.0E2*(1.0E0-(total_out/total_in));
|
||||
}
|
||||
end;
|
||||
|
||||
|
||||
// TDecompressionStream
|
||||
|
||||
constructor TDecompressionStream.Create(Source: TStream);
|
||||
begin
|
||||
inherited Create(Source);
|
||||
FZRec.next_in := FBuffer;
|
||||
FZRec.avail_in := 0;
|
||||
DecompressionCheck(inflateInit_(FZRec, zlibversion, sizeof(FZRec)));
|
||||
end;
|
||||
|
||||
destructor TDecompressionStream.Destroy;
|
||||
begin
|
||||
inflateEnd(FZRec);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
function TDecompressionStream.DecompressionCheck(code: Integer): Integer;
|
||||
begin
|
||||
Result := code;
|
||||
If Code<0 then
|
||||
if code < -6 then
|
||||
raise EDecompressionError.CreateFmt(Errorstrings[0],[Code])
|
||||
else
|
||||
raise EDecompressionError.Create(ErrorStrings[Abs(Code)]);
|
||||
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;
|
||||
DeCompressionCheck(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
|
||||
DecompressionCheck(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.
|
||||
'Z_DATA_ERROR','Z_MEM_ERROR','Z_BUF_ERROR','Z_VERSION_ERROR');
|
||||
SCouldntOpenFile = 'Couldn''t open file : %s';
|
||||
SReadOnlyStream = 'Decompression streams are read-only';
|
||||
SWriteOnlyStream = 'Compression streams are write-only';
|
||||
SSeekError = 'Compression stream seek error';
|
||||
SInvalidSeek = 'Invalid Compression seek operation';
|
||||
|
||||
Type PLongint = ^Longint;
|
||||
|
||||
Function DGetmem (Size : Longint) : pointer;
|
||||
begin
|
||||
Inc(Size,SizeOf(Longint));
|
||||
GetMem(Result,Size);
|
||||
If Result<>Nil then
|
||||
begin
|
||||
Plongint(Result)^:=Size;
|
||||
Inc(Result,SizeOf(Integer));
|
||||
end;
|
||||
end;
|
||||
|
||||
Procedure DFreeMem(P : Pointer);
|
||||
begin
|
||||
// Get Stored length
|
||||
Dec(P,SizeOf(Integer));
|
||||
FreeMem(P,Plongint(P)^);
|
||||
end;
|
||||
|
||||
Procedure DReallocMem (var P : Pointer; NewSize : Longint);
|
||||
// Reallocates memory pointed to by P.
|
||||
Var T : pointer;
|
||||
OldSize : longint;
|
||||
begin
|
||||
// Should raise an exception if no memory.
|
||||
T:=DGetMem(NewSize);
|
||||
OldSize:=PLongint(P-SizeOf(Integer))^;
|
||||
If oldSize<NewSize then
|
||||
Move(P^,T^,OldSize)
|
||||
else
|
||||
Move(P^,T^,NewSize);
|
||||
DFreeMem(P);
|
||||
end;
|
||||
|
||||
function zlibAllocMem(AppData: Pointer; Items, Size: Integer): Pointer;cdecl;
|
||||
begin
|
||||
Result:=DGetMem(Items*Size);
|
||||
end;
|
||||
|
||||
procedure zlibFreeMem(AppData, Block: Pointer);cdecl;
|
||||
begin
|
||||
DFreeMem(Block);
|
||||
end;
|
||||
|
||||
|
||||
procedure TCompressionStream.CompressBuf(const InBuf: Pointer; InBytes: Integer;
|
||||
var OutBuf: Pointer; var OutBytes: Integer);
|
||||
var
|
||||
strm: TZStream;
|
||||
P: Pointer;
|
||||
oldout : longint;
|
||||
begin
|
||||
FillChar(strm, sizeof(strm), 0);
|
||||
strm.zalloc := @zlibAllocMem;
|
||||
strm.zfree := @zlibFreeMem;
|
||||
OutBytes := ((InBytes + (InBytes div 10) + 12) + 255) and not 255;
|
||||
OutBuf:=DGetMem(OutBytes);
|
||||
try
|
||||
strm.next_in := InBuf;
|
||||
strm.avail_in := InBytes;
|
||||
strm.next_out := OutBuf;
|
||||
strm.avail_out := OutBytes;
|
||||
CompressionCheck(deflateInit_(strm, Z_BEST_COMPRESSION, zlibversion, sizeof(strm)));
|
||||
try
|
||||
while CompressionCheck(deflate(strm, Z_FINISH)) <> Z_STREAM_END do
|
||||
begin
|
||||
P := OutBuf;
|
||||
Inc(OutBytes, 256);
|
||||
DReallocMem(OutBuf,OutBytes);
|
||||
strm.next_out := PChar(Integer(OutBuf) + (Integer(strm.next_out) - Integer(P)));
|
||||
strm.avail_out := 256;
|
||||
end;
|
||||
finally
|
||||
CompressionCheck(deflateEnd(strm));
|
||||
end;
|
||||
DReallocMem(OutBuf,strm.total_out);
|
||||
OutBytes := strm.total_out;
|
||||
except
|
||||
DFreeMem(OutBuf);
|
||||
raise;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure TDecompressionStream.DecompressBuf(const InBuf: Pointer; InBytes: Integer;
|
||||
OutEstimate: Integer; var OutBuf: Pointer; var OutBytes: Integer);
|
||||
var
|
||||
strm: TZStream;
|
||||
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;
|
||||
OutBuf:=DGetMem(OutBytes);
|
||||
try
|
||||
strm.next_in := InBuf;
|
||||
strm.avail_in := InBytes;
|
||||
strm.next_out := OutBuf;
|
||||
strm.avail_out := OutBytes;
|
||||
DecompressionCheck(inflateInit_(strm, zlibversion, sizeof(strm)));
|
||||
try
|
||||
while DecompressionCheck(inflate(strm, Z_FINISH)) <> Z_STREAM_END do
|
||||
begin
|
||||
P := OutBuf;
|
||||
Inc(OutBytes, BufInc);
|
||||
DReallocMem(OutBuf, OutBytes);
|
||||
strm.next_out := PChar(Integer(OutBuf) + (Integer(strm.next_out) - Integer(P)));
|
||||
strm.avail_out := BufInc;
|
||||
end;
|
||||
finally
|
||||
DecompressionCheck(inflateEnd(strm));
|
||||
end;
|
||||
DReallocMem(OutBuf, strm.total_out);
|
||||
OutBytes := strm.total_out;
|
||||
except
|
||||
DFreeMem(OutBuf);
|
||||
raise;
|
||||
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 := FBuffer;
|
||||
FZRec.avail_out := sizeof(FBuffer);
|
||||
CompressionCheck(deflateInit_(FZRec, Levels[CompressionLevel], zlibversion, 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 (CompressionCheck(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.CompressionCheck(code: Integer): Integer;
|
||||
begin
|
||||
Result := code;
|
||||
if (code < 0) then
|
||||
if code < -6 then
|
||||
raise ECompressionError.CreateFmt(Errorstrings[0],[Code])
|
||||
else
|
||||
raise ECompressionError.Create(ErrorStrings[Abs(Code)]);
|
||||
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
|
||||
CompressionCheck(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(SInvalidSeek);
|
||||
end;
|
||||
|
||||
function TCompressionStream.GetCompressionRate: extended;
|
||||
begin
|
||||
Result:=0.0;
|
||||
{ With FZrec do
|
||||
if total_in = 0 then
|
||||
GetCompressionRate:=0.0
|
||||
else
|
||||
GetCompressionRate:=1.0E2*(1.0E0-(total_out/total_in));
|
||||
}
|
||||
end;
|
||||
|
||||
|
||||
// TDecompressionStream
|
||||
|
||||
constructor TDecompressionStream.Create(Source: TStream);
|
||||
begin
|
||||
inherited Create(Source);
|
||||
FZRec.next_in := FBuffer;
|
||||
FZRec.avail_in := 0;
|
||||
DecompressionCheck(inflateInit_(FZRec, zlibversion, sizeof(FZRec)));
|
||||
end;
|
||||
|
||||
destructor TDecompressionStream.Destroy;
|
||||
begin
|
||||
inflateEnd(FZRec);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
function TDecompressionStream.DecompressionCheck(code: Integer): Integer;
|
||||
begin
|
||||
Result := code;
|
||||
If Code<0 then
|
||||
if code < -6 then
|
||||
raise EDecompressionError.CreateFmt(Errorstrings[0],[Code])
|
||||
else
|
||||
raise EDecompressionError.Create(ErrorStrings[Abs(Code)]);
|
||||
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;
|
||||
DeCompressionCheck(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
|
||||
DecompressionCheck(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(SInvalidSeek);
|
||||
Result := FZRec.total_out;
|
||||
end;
|
||||
|
||||
// TGZFileStream
|
||||
|
||||
Constructor TGZFileStream.Create(FileName: String;FileMode: TGZOpenMode);
|
||||
|
||||
Const OpenStrings : array[TGZOpenMode] of pchar = ('rb','wb');
|
||||
|
||||
begin
|
||||
FOpenMode:=FileMode;
|
||||
FFile:=gzopen (Pchar(FileName),Openstrings[FileMode]);
|
||||
If FFile=Nil then
|
||||
Raise ezlibError.CreateFmt (SCouldntOpenFIle,[FileName]);
|
||||
end;
|
||||
|
||||
Destructor TGZFileStream.Destroy;
|
||||
begin
|
||||
gzclose(FFile);
|
||||
Inherited Destroy;
|
||||
end;
|
||||
|
||||
Function TGZFileStream.Read(Var Buffer; Count : longint): longint;
|
||||
begin
|
||||
If FOpenMode=gzOpenWrite then
|
||||
Raise ezliberror.create(SWriteOnlyStream);
|
||||
Result:=gzRead(FFile,@Buffer,Count);
|
||||
end;
|
||||
|
||||
function TGZFileStream.Write(const Buffer; Count: Longint): Longint;
|
||||
begin
|
||||
If FOpenMode=gzOpenRead then
|
||||
Raise EzlibError.Create(SReadonlyStream);
|
||||
Result:=gzWrite(FFile,@Buffer,Count);
|
||||
end;
|
||||
|
||||
function TGZFileStream.Seek(Offset: Longint; Origin: Word): Longint;
|
||||
begin
|
||||
Result:=gzseek(FFile,Offset,Origin);
|
||||
If Result=-1 then
|
||||
Raise eZlibError.Create(SSeekError);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
Loading…
Reference in New Issue
Block a user