| {*******************************************************} |
| { } |
| { Borland Delphi Supplemental Components } |
| { ZLIB Data Compression Interface Unit } |
| { } |
| { Copyright (c) 1997,99 Borland Corporation } |
| { } |
| {*******************************************************} |
| |
| { Updated for zlib 1.2.x by Cosmin Truta <cosmint@cs.ubbcluj.ro> } |
| |
| unit ZLib; |
| |
| interface |
| |
| uses SysUtils, Classes; |
| |
| type |
| TAlloc = function (AppData: Pointer; Items, Size: Integer): Pointer; cdecl; |
| TFree = procedure (AppData, Block: Pointer); cdecl; |
| |
| // Internal structure. Ignore. |
| TZStreamRec = packed record |
| next_in: PChar; // next input byte |
| avail_in: Integer; // number of bytes available at next_in |
| total_in: Longint; // 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: Longint; // 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: Longint; // adler32 value of the uncompressed data |
| reserved: Longint; // 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); |
| |
| { 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); |
| |
| const |
| zlib_version = '1.2.6'; |
| |
| type |
| EZlibError = class(Exception); |
| ECompressionError = class(EZlibError); |
| EDecompressionError = class(EZlibError); |
| |
| implementation |
| |
| uses ZLibConst; |
| |
| 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_RLE = 3; |
| Z_DEFAULT_STRATEGY = 0; |
| |
| Z_BINARY = 0; |
| Z_ASCII = 1; |
| Z_UNKNOWN = 2; |
| |
| Z_DEFLATED = 8; |
| |
| |
| {$L adler32.obj} |
| {$L compress.obj} |
| {$L crc32.obj} |
| {$L deflate.obj} |
| {$L infback.obj} |
| {$L inffast.obj} |
| {$L inflate.obj} |
| {$L inftrees.obj} |
| {$L trees.obj} |
| {$L uncompr.obj} |
| {$L zutil.obj} |
| |
| procedure adler32; external; |
| procedure compressBound; external; |
| procedure crc32; external; |
| procedure deflateInit2_; external; |
| procedure deflateParams; external; |
| |
| function _malloc(Size: Integer): Pointer; cdecl; |
| begin |
| Result := AllocMem(Size); |
| end; |
| |
| procedure _free(Block: Pointer); cdecl; |
| begin |
| FreeMem(Block); |
| end; |
| |
| 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 zlibAllocMem(AppData: Pointer; Items, Size: Integer): Pointer; cdecl; |
| begin |
| // GetMem(Result, Items*Size); |
| Result := AllocMem(Items * Size); |
| end; |
| |
| procedure zlibFreeMem(AppData, Block: Pointer); cdecl; |
| 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); |
| 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 := 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); |
| 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_NO_FLUSH)) <> 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; |
| |
| 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 := 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.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 := 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 := 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 := FBuffer; |
| FStrmPos := FStrm.Position; |
| Progress(Self); |
| end; |
| CCheck(inflate(FZRec, 0)); |
| end; |
| Result := Count; |
| end; |
| |
| function TDecompressionStream.Write(const Buffer; Count: Longint): Longint; |
| begin |
| 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 := 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. |