cannam@128: {*******************************************************} cannam@128: { } cannam@128: { Borland Delphi Supplemental Components } cannam@128: { ZLIB Data Compression Interface Unit } cannam@128: { } cannam@128: { Copyright (c) 1997,99 Borland Corporation } cannam@128: { } cannam@128: {*******************************************************} cannam@128: cannam@128: { Updated for zlib 1.2.x by Cosmin Truta } cannam@128: cannam@128: unit ZLib; cannam@128: cannam@128: interface cannam@128: cannam@128: uses SysUtils, Classes; cannam@128: cannam@128: type cannam@128: TAlloc = function (AppData: Pointer; Items, Size: Integer): Pointer; cdecl; cannam@128: TFree = procedure (AppData, Block: Pointer); cdecl; cannam@128: cannam@128: // Internal structure. Ignore. cannam@128: TZStreamRec = packed record cannam@128: next_in: PChar; // next input byte cannam@128: avail_in: Integer; // number of bytes available at next_in cannam@128: total_in: Longint; // total nb of input bytes read so far cannam@128: cannam@128: next_out: PChar; // next output byte should be put here cannam@128: avail_out: Integer; // remaining free space at next_out cannam@128: total_out: Longint; // total nb of bytes output so far cannam@128: cannam@128: msg: PChar; // last error message, NULL if no error cannam@128: internal: Pointer; // not visible by applications cannam@128: cannam@128: zalloc: TAlloc; // used to allocate the internal state cannam@128: zfree: TFree; // used to free the internal state cannam@128: AppData: Pointer; // private data object passed to zalloc and zfree cannam@128: cannam@128: data_type: Integer; // best guess about the data type: ascii or binary cannam@128: adler: Longint; // adler32 value of the uncompressed data cannam@128: reserved: Longint; // reserved for future use cannam@128: end; cannam@128: cannam@128: // Abstract ancestor class cannam@128: TCustomZlibStream = class(TStream) cannam@128: private cannam@128: FStrm: TStream; cannam@128: FStrmPos: Integer; cannam@128: FOnProgress: TNotifyEvent; cannam@128: FZRec: TZStreamRec; cannam@128: FBuffer: array [Word] of Char; cannam@128: protected cannam@128: procedure Progress(Sender: TObject); dynamic; cannam@128: property OnProgress: TNotifyEvent read FOnProgress write FOnProgress; cannam@128: constructor Create(Strm: TStream); cannam@128: end; cannam@128: cannam@128: { TCompressionStream compresses data on the fly as data is written to it, and cannam@128: stores the compressed data to another stream. cannam@128: cannam@128: TCompressionStream is write-only and strictly sequential. Reading from the cannam@128: stream will raise an exception. Using Seek to move the stream pointer cannam@128: will raise an exception. cannam@128: cannam@128: Output data is cached internally, written to the output stream only when cannam@128: the internal output buffer is full. All pending output data is flushed cannam@128: when the stream is destroyed. cannam@128: cannam@128: The Position property returns the number of uncompressed bytes of cannam@128: data that have been written to the stream so far. cannam@128: cannam@128: CompressionRate returns the on-the-fly percentage by which the original cannam@128: data has been compressed: (1 - (CompressedBytes / UncompressedBytes)) * 100 cannam@128: If raw data size = 100 and compressed data size = 25, the CompressionRate cannam@128: is 75% cannam@128: cannam@128: The OnProgress event is called each time the output buffer is filled and cannam@128: written to the output stream. This is useful for updating a progress cannam@128: indicator when you are writing a large chunk of data to the compression cannam@128: stream in a single call.} cannam@128: cannam@128: cannam@128: TCompressionLevel = (clNone, clFastest, clDefault, clMax); cannam@128: cannam@128: TCompressionStream = class(TCustomZlibStream) cannam@128: private cannam@128: function GetCompressionRate: Single; cannam@128: public cannam@128: constructor Create(CompressionLevel: TCompressionLevel; Dest: TStream); cannam@128: destructor Destroy; override; cannam@128: function Read(var Buffer; Count: Longint): Longint; override; cannam@128: function Write(const Buffer; Count: Longint): Longint; override; cannam@128: function Seek(Offset: Longint; Origin: Word): Longint; override; cannam@128: property CompressionRate: Single read GetCompressionRate; cannam@128: property OnProgress; cannam@128: end; cannam@128: cannam@128: { TDecompressionStream decompresses data on the fly as data is read from it. cannam@128: cannam@128: Compressed data comes from a separate source stream. TDecompressionStream cannam@128: is read-only and unidirectional; you can seek forward in the stream, but not cannam@128: backwards. The special case of setting the stream position to zero is cannam@128: allowed. Seeking forward decompresses data until the requested position in cannam@128: the uncompressed data has been reached. Seeking backwards, seeking relative cannam@128: to the end of the stream, requesting the size of the stream, and writing to cannam@128: the stream will raise an exception. cannam@128: cannam@128: The Position property returns the number of bytes of uncompressed data that cannam@128: have been read from the stream so far. cannam@128: cannam@128: The OnProgress event is called each time the internal input buffer of cannam@128: compressed data is exhausted and the next block is read from the input stream. cannam@128: This is useful for updating a progress indicator when you are reading a cannam@128: large chunk of data from the decompression stream in a single call.} cannam@128: cannam@128: TDecompressionStream = class(TCustomZlibStream) cannam@128: public cannam@128: constructor Create(Source: TStream); cannam@128: destructor Destroy; override; cannam@128: function Read(var Buffer; Count: Longint): Longint; override; cannam@128: function Write(const Buffer; Count: Longint): Longint; override; cannam@128: function Seek(Offset: Longint; Origin: Word): Longint; override; cannam@128: property OnProgress; cannam@128: end; cannam@128: cannam@128: cannam@128: cannam@128: { CompressBuf compresses data, buffer to buffer, in one call. cannam@128: In: InBuf = ptr to compressed data cannam@128: InBytes = number of bytes in InBuf cannam@128: Out: OutBuf = ptr to newly allocated buffer containing decompressed data cannam@128: OutBytes = number of bytes in OutBuf } cannam@128: procedure CompressBuf(const InBuf: Pointer; InBytes: Integer; cannam@128: out OutBuf: Pointer; out OutBytes: Integer); cannam@128: cannam@128: cannam@128: { DecompressBuf decompresses data, buffer to buffer, in one call. cannam@128: In: InBuf = ptr to compressed data cannam@128: InBytes = number of bytes in InBuf cannam@128: OutEstimate = zero, or est. size of the decompressed data cannam@128: Out: OutBuf = ptr to newly allocated buffer containing decompressed data cannam@128: OutBytes = number of bytes in OutBuf } cannam@128: procedure DecompressBuf(const InBuf: Pointer; InBytes: Integer; cannam@128: OutEstimate: Integer; out OutBuf: Pointer; out OutBytes: Integer); cannam@128: cannam@128: { DecompressToUserBuf decompresses data, buffer to buffer, in one call. cannam@128: In: InBuf = ptr to compressed data cannam@128: InBytes = number of bytes in InBuf cannam@128: Out: OutBuf = ptr to user-allocated buffer to contain decompressed data cannam@128: BufSize = number of bytes in OutBuf } cannam@128: procedure DecompressToUserBuf(const InBuf: Pointer; InBytes: Integer; cannam@128: const OutBuf: Pointer; BufSize: Integer); cannam@128: cannam@128: const cannam@128: zlib_version = '1.2.8'; cannam@128: cannam@128: type cannam@128: EZlibError = class(Exception); cannam@128: ECompressionError = class(EZlibError); cannam@128: EDecompressionError = class(EZlibError); cannam@128: cannam@128: implementation cannam@128: cannam@128: uses ZLibConst; cannam@128: cannam@128: const cannam@128: Z_NO_FLUSH = 0; cannam@128: Z_PARTIAL_FLUSH = 1; cannam@128: Z_SYNC_FLUSH = 2; cannam@128: Z_FULL_FLUSH = 3; cannam@128: Z_FINISH = 4; cannam@128: cannam@128: Z_OK = 0; cannam@128: Z_STREAM_END = 1; cannam@128: Z_NEED_DICT = 2; cannam@128: Z_ERRNO = (-1); cannam@128: Z_STREAM_ERROR = (-2); cannam@128: Z_DATA_ERROR = (-3); cannam@128: Z_MEM_ERROR = (-4); cannam@128: Z_BUF_ERROR = (-5); cannam@128: Z_VERSION_ERROR = (-6); cannam@128: cannam@128: Z_NO_COMPRESSION = 0; cannam@128: Z_BEST_SPEED = 1; cannam@128: Z_BEST_COMPRESSION = 9; cannam@128: Z_DEFAULT_COMPRESSION = (-1); cannam@128: cannam@128: Z_FILTERED = 1; cannam@128: Z_HUFFMAN_ONLY = 2; cannam@128: Z_RLE = 3; cannam@128: Z_DEFAULT_STRATEGY = 0; cannam@128: cannam@128: Z_BINARY = 0; cannam@128: Z_ASCII = 1; cannam@128: Z_UNKNOWN = 2; cannam@128: cannam@128: Z_DEFLATED = 8; cannam@128: cannam@128: cannam@128: {$L adler32.obj} cannam@128: {$L compress.obj} cannam@128: {$L crc32.obj} cannam@128: {$L deflate.obj} cannam@128: {$L infback.obj} cannam@128: {$L inffast.obj} cannam@128: {$L inflate.obj} cannam@128: {$L inftrees.obj} cannam@128: {$L trees.obj} cannam@128: {$L uncompr.obj} cannam@128: {$L zutil.obj} cannam@128: cannam@128: procedure adler32; external; cannam@128: procedure compressBound; external; cannam@128: procedure crc32; external; cannam@128: procedure deflateInit2_; external; cannam@128: procedure deflateParams; external; cannam@128: cannam@128: function _malloc(Size: Integer): Pointer; cdecl; cannam@128: begin cannam@128: Result := AllocMem(Size); cannam@128: end; cannam@128: cannam@128: procedure _free(Block: Pointer); cdecl; cannam@128: begin cannam@128: FreeMem(Block); cannam@128: end; cannam@128: cannam@128: procedure _memset(P: Pointer; B: Byte; count: Integer); cdecl; cannam@128: begin cannam@128: FillChar(P^, count, B); cannam@128: end; cannam@128: cannam@128: procedure _memcpy(dest, source: Pointer; count: Integer); cdecl; cannam@128: begin cannam@128: Move(source^, dest^, count); cannam@128: end; cannam@128: cannam@128: cannam@128: cannam@128: // deflate compresses data cannam@128: function deflateInit_(var strm: TZStreamRec; level: Integer; version: PChar; cannam@128: recsize: Integer): Integer; external; cannam@128: function deflate(var strm: TZStreamRec; flush: Integer): Integer; external; cannam@128: function deflateEnd(var strm: TZStreamRec): Integer; external; cannam@128: cannam@128: // inflate decompresses data cannam@128: function inflateInit_(var strm: TZStreamRec; version: PChar; cannam@128: recsize: Integer): Integer; external; cannam@128: function inflate(var strm: TZStreamRec; flush: Integer): Integer; external; cannam@128: function inflateEnd(var strm: TZStreamRec): Integer; external; cannam@128: function inflateReset(var strm: TZStreamRec): Integer; external; cannam@128: cannam@128: cannam@128: function zlibAllocMem(AppData: Pointer; Items, Size: Integer): Pointer; cdecl; cannam@128: begin cannam@128: // GetMem(Result, Items*Size); cannam@128: Result := AllocMem(Items * Size); cannam@128: end; cannam@128: cannam@128: procedure zlibFreeMem(AppData, Block: Pointer); cdecl; cannam@128: begin cannam@128: FreeMem(Block); cannam@128: end; cannam@128: cannam@128: {function zlibCheck(code: Integer): Integer; cannam@128: begin cannam@128: Result := code; cannam@128: if code < 0 then cannam@128: raise EZlibError.Create('error'); //!! cannam@128: end;} cannam@128: cannam@128: function CCheck(code: Integer): Integer; cannam@128: begin cannam@128: Result := code; cannam@128: if code < 0 then cannam@128: raise ECompressionError.Create('error'); //!! cannam@128: end; cannam@128: cannam@128: function DCheck(code: Integer): Integer; cannam@128: begin cannam@128: Result := code; cannam@128: if code < 0 then cannam@128: raise EDecompressionError.Create('error'); //!! cannam@128: end; cannam@128: cannam@128: procedure CompressBuf(const InBuf: Pointer; InBytes: Integer; cannam@128: out OutBuf: Pointer; out OutBytes: Integer); cannam@128: var cannam@128: strm: TZStreamRec; cannam@128: P: Pointer; cannam@128: begin cannam@128: FillChar(strm, sizeof(strm), 0); cannam@128: strm.zalloc := zlibAllocMem; cannam@128: strm.zfree := zlibFreeMem; cannam@128: OutBytes := ((InBytes + (InBytes div 10) + 12) + 255) and not 255; cannam@128: GetMem(OutBuf, OutBytes); cannam@128: try cannam@128: strm.next_in := InBuf; cannam@128: strm.avail_in := InBytes; cannam@128: strm.next_out := OutBuf; cannam@128: strm.avail_out := OutBytes; cannam@128: CCheck(deflateInit_(strm, Z_BEST_COMPRESSION, zlib_version, sizeof(strm))); cannam@128: try cannam@128: while CCheck(deflate(strm, Z_FINISH)) <> Z_STREAM_END do cannam@128: begin cannam@128: P := OutBuf; cannam@128: Inc(OutBytes, 256); cannam@128: ReallocMem(OutBuf, OutBytes); cannam@128: strm.next_out := PChar(Integer(OutBuf) + (Integer(strm.next_out) - Integer(P))); cannam@128: strm.avail_out := 256; cannam@128: end; cannam@128: finally cannam@128: CCheck(deflateEnd(strm)); cannam@128: end; cannam@128: ReallocMem(OutBuf, strm.total_out); cannam@128: OutBytes := strm.total_out; cannam@128: except cannam@128: FreeMem(OutBuf); cannam@128: raise cannam@128: end; cannam@128: end; cannam@128: cannam@128: cannam@128: procedure DecompressBuf(const InBuf: Pointer; InBytes: Integer; cannam@128: OutEstimate: Integer; out OutBuf: Pointer; out OutBytes: Integer); cannam@128: var cannam@128: strm: TZStreamRec; cannam@128: P: Pointer; cannam@128: BufInc: Integer; cannam@128: begin cannam@128: FillChar(strm, sizeof(strm), 0); cannam@128: strm.zalloc := zlibAllocMem; cannam@128: strm.zfree := zlibFreeMem; cannam@128: BufInc := (InBytes + 255) and not 255; cannam@128: if OutEstimate = 0 then cannam@128: OutBytes := BufInc cannam@128: else cannam@128: OutBytes := OutEstimate; cannam@128: GetMem(OutBuf, OutBytes); cannam@128: try cannam@128: strm.next_in := InBuf; cannam@128: strm.avail_in := InBytes; cannam@128: strm.next_out := OutBuf; cannam@128: strm.avail_out := OutBytes; cannam@128: DCheck(inflateInit_(strm, zlib_version, sizeof(strm))); cannam@128: try cannam@128: while DCheck(inflate(strm, Z_NO_FLUSH)) <> Z_STREAM_END do cannam@128: begin cannam@128: P := OutBuf; cannam@128: Inc(OutBytes, BufInc); cannam@128: ReallocMem(OutBuf, OutBytes); cannam@128: strm.next_out := PChar(Integer(OutBuf) + (Integer(strm.next_out) - Integer(P))); cannam@128: strm.avail_out := BufInc; cannam@128: end; cannam@128: finally cannam@128: DCheck(inflateEnd(strm)); cannam@128: end; cannam@128: ReallocMem(OutBuf, strm.total_out); cannam@128: OutBytes := strm.total_out; cannam@128: except cannam@128: FreeMem(OutBuf); cannam@128: raise cannam@128: end; cannam@128: end; cannam@128: cannam@128: procedure DecompressToUserBuf(const InBuf: Pointer; InBytes: Integer; cannam@128: const OutBuf: Pointer; BufSize: Integer); cannam@128: var cannam@128: strm: TZStreamRec; cannam@128: begin cannam@128: FillChar(strm, sizeof(strm), 0); cannam@128: strm.zalloc := zlibAllocMem; cannam@128: strm.zfree := zlibFreeMem; cannam@128: strm.next_in := InBuf; cannam@128: strm.avail_in := InBytes; cannam@128: strm.next_out := OutBuf; cannam@128: strm.avail_out := BufSize; cannam@128: DCheck(inflateInit_(strm, zlib_version, sizeof(strm))); cannam@128: try cannam@128: if DCheck(inflate(strm, Z_FINISH)) <> Z_STREAM_END then cannam@128: raise EZlibError.CreateRes(@sTargetBufferTooSmall); cannam@128: finally cannam@128: DCheck(inflateEnd(strm)); cannam@128: end; cannam@128: end; cannam@128: cannam@128: // TCustomZlibStream cannam@128: cannam@128: constructor TCustomZLibStream.Create(Strm: TStream); cannam@128: begin cannam@128: inherited Create; cannam@128: FStrm := Strm; cannam@128: FStrmPos := Strm.Position; cannam@128: FZRec.zalloc := zlibAllocMem; cannam@128: FZRec.zfree := zlibFreeMem; cannam@128: end; cannam@128: cannam@128: procedure TCustomZLibStream.Progress(Sender: TObject); cannam@128: begin cannam@128: if Assigned(FOnProgress) then FOnProgress(Sender); cannam@128: end; cannam@128: cannam@128: cannam@128: // TCompressionStream cannam@128: cannam@128: constructor TCompressionStream.Create(CompressionLevel: TCompressionLevel; cannam@128: Dest: TStream); cannam@128: const cannam@128: Levels: array [TCompressionLevel] of ShortInt = cannam@128: (Z_NO_COMPRESSION, Z_BEST_SPEED, Z_DEFAULT_COMPRESSION, Z_BEST_COMPRESSION); cannam@128: begin cannam@128: inherited Create(Dest); cannam@128: FZRec.next_out := FBuffer; cannam@128: FZRec.avail_out := sizeof(FBuffer); cannam@128: CCheck(deflateInit_(FZRec, Levels[CompressionLevel], zlib_version, sizeof(FZRec))); cannam@128: end; cannam@128: cannam@128: destructor TCompressionStream.Destroy; cannam@128: begin cannam@128: FZRec.next_in := nil; cannam@128: FZRec.avail_in := 0; cannam@128: try cannam@128: if FStrm.Position <> FStrmPos then FStrm.Position := FStrmPos; cannam@128: while (CCheck(deflate(FZRec, Z_FINISH)) <> Z_STREAM_END) cannam@128: and (FZRec.avail_out = 0) do cannam@128: begin cannam@128: FStrm.WriteBuffer(FBuffer, sizeof(FBuffer)); cannam@128: FZRec.next_out := FBuffer; cannam@128: FZRec.avail_out := sizeof(FBuffer); cannam@128: end; cannam@128: if FZRec.avail_out < sizeof(FBuffer) then cannam@128: FStrm.WriteBuffer(FBuffer, sizeof(FBuffer) - FZRec.avail_out); cannam@128: finally cannam@128: deflateEnd(FZRec); cannam@128: end; cannam@128: inherited Destroy; cannam@128: end; cannam@128: cannam@128: function TCompressionStream.Read(var Buffer; Count: Longint): Longint; cannam@128: begin cannam@128: raise ECompressionError.CreateRes(@sInvalidStreamOp); cannam@128: end; cannam@128: cannam@128: function TCompressionStream.Write(const Buffer; Count: Longint): Longint; cannam@128: begin cannam@128: FZRec.next_in := @Buffer; cannam@128: FZRec.avail_in := Count; cannam@128: if FStrm.Position <> FStrmPos then FStrm.Position := FStrmPos; cannam@128: while (FZRec.avail_in > 0) do cannam@128: begin cannam@128: CCheck(deflate(FZRec, 0)); cannam@128: if FZRec.avail_out = 0 then cannam@128: begin cannam@128: FStrm.WriteBuffer(FBuffer, sizeof(FBuffer)); cannam@128: FZRec.next_out := FBuffer; cannam@128: FZRec.avail_out := sizeof(FBuffer); cannam@128: FStrmPos := FStrm.Position; cannam@128: Progress(Self); cannam@128: end; cannam@128: end; cannam@128: Result := Count; cannam@128: end; cannam@128: cannam@128: function TCompressionStream.Seek(Offset: Longint; Origin: Word): Longint; cannam@128: begin cannam@128: if (Offset = 0) and (Origin = soFromCurrent) then cannam@128: Result := FZRec.total_in cannam@128: else cannam@128: raise ECompressionError.CreateRes(@sInvalidStreamOp); cannam@128: end; cannam@128: cannam@128: function TCompressionStream.GetCompressionRate: Single; cannam@128: begin cannam@128: if FZRec.total_in = 0 then cannam@128: Result := 0 cannam@128: else cannam@128: Result := (1.0 - (FZRec.total_out / FZRec.total_in)) * 100.0; cannam@128: end; cannam@128: cannam@128: cannam@128: // TDecompressionStream cannam@128: cannam@128: constructor TDecompressionStream.Create(Source: TStream); cannam@128: begin cannam@128: inherited Create(Source); cannam@128: FZRec.next_in := FBuffer; cannam@128: FZRec.avail_in := 0; cannam@128: DCheck(inflateInit_(FZRec, zlib_version, sizeof(FZRec))); cannam@128: end; cannam@128: cannam@128: destructor TDecompressionStream.Destroy; cannam@128: begin cannam@128: FStrm.Seek(-FZRec.avail_in, 1); cannam@128: inflateEnd(FZRec); cannam@128: inherited Destroy; cannam@128: end; cannam@128: cannam@128: function TDecompressionStream.Read(var Buffer; Count: Longint): Longint; cannam@128: begin cannam@128: FZRec.next_out := @Buffer; cannam@128: FZRec.avail_out := Count; cannam@128: if FStrm.Position <> FStrmPos then FStrm.Position := FStrmPos; cannam@128: while (FZRec.avail_out > 0) do cannam@128: begin cannam@128: if FZRec.avail_in = 0 then cannam@128: begin cannam@128: FZRec.avail_in := FStrm.Read(FBuffer, sizeof(FBuffer)); cannam@128: if FZRec.avail_in = 0 then cannam@128: begin cannam@128: Result := Count - FZRec.avail_out; cannam@128: Exit; cannam@128: end; cannam@128: FZRec.next_in := FBuffer; cannam@128: FStrmPos := FStrm.Position; cannam@128: Progress(Self); cannam@128: end; cannam@128: CCheck(inflate(FZRec, 0)); cannam@128: end; cannam@128: Result := Count; cannam@128: end; cannam@128: cannam@128: function TDecompressionStream.Write(const Buffer; Count: Longint): Longint; cannam@128: begin cannam@128: raise EDecompressionError.CreateRes(@sInvalidStreamOp); cannam@128: end; cannam@128: cannam@128: function TDecompressionStream.Seek(Offset: Longint; Origin: Word): Longint; cannam@128: var cannam@128: I: Integer; cannam@128: Buf: array [0..4095] of Char; cannam@128: begin cannam@128: if (Offset = 0) and (Origin = soFromBeginning) then cannam@128: begin cannam@128: DCheck(inflateReset(FZRec)); cannam@128: FZRec.next_in := FBuffer; cannam@128: FZRec.avail_in := 0; cannam@128: FStrm.Position := 0; cannam@128: FStrmPos := 0; cannam@128: end cannam@128: else if ( (Offset >= 0) and (Origin = soFromCurrent)) or cannam@128: ( ((Offset - FZRec.total_out) > 0) and (Origin = soFromBeginning)) then cannam@128: begin cannam@128: if Origin = soFromBeginning then Dec(Offset, FZRec.total_out); cannam@128: if Offset > 0 then cannam@128: begin cannam@128: for I := 1 to Offset div sizeof(Buf) do cannam@128: ReadBuffer(Buf, sizeof(Buf)); cannam@128: ReadBuffer(Buf, Offset mod sizeof(Buf)); cannam@128: end; cannam@128: end cannam@128: else cannam@128: raise EDecompressionError.CreateRes(@sInvalidStreamOp); cannam@128: Result := FZRec.total_out; cannam@128: end; cannam@128: cannam@128: cannam@128: end.