diff --git a/fcl/inc/zstream.pp b/fcl/inc/zstream.pp index 5e5caf7b16..c347b7170f 100644 --- a/fcl/inc/zstream.pp +++ b/fcl/inc/zstream.pp @@ -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 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 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.