frxzlib.pas

报表源码 FastReport 3 is new generation of the report generators components. It consists of report engin

{*****************************************************************************
* ZLibEx.pas (zlib 1.2.1) *
* *
* copyright (c) 2002-2003 Roberto Della Pasqua (www.dellapasqua.com) *
* copyright (c) 2000-2002 base2 technologies (www.base2ti.com) *
* copyright (c) 1997 Borland International (www.borland.com) *
* *
* revision history *
* 2003.12.18 updated with latest zlib 1.2.1 (see www.zlib.org) *
* obj's compiled with fastest speed optimizations (bcc 5.6.4) *
* (hint:see basm newsgroup about a Move RTL fast replacement) *
* Thanks to Cosmin Truta for the pascal zlib reference *
* *
* 2002.11.02 ZSendToBrowser:deflate algorithm for HTTP1.1 compression *
* 2002.10.24 ZFastCompressString and ZFastDecompressString:300% faster *
* 2002.10.15 recompiled zlib 1.1.4 c sources with speed optimizations *
* (and targeting 686+cpu) and changes to accomodate Borland *
* standards (C++v5.6 compiler) *
* 2002.10.15 optimized move mem for not aligned structures (strings,etc)*
* 2002.10.15 little changes to avoid system unique string calls *
* *
* 2002.03.15 updated to zlib version 1.1.4 *
* 2001.11.27 enhanced TZDecompressionStream.Read to adjust source *
* stream position upon end of compression data *
* fixed endless loop in TZDecompressionStream.Read when *
* destination count was greater than uncompressed data *
* 2001.10.26 renamed unit to integrate "nicely" with delphi 6 *
* 2000.11.24 added soFromEnd condition to TZDecompressionStream.Seek *
* added ZCompressStream and ZDecompressStream *
* 2000.06.13 optimized, fixed, rewrote, and enhanced the zlib.pas unit *
* included on the delphi cd (zlib version 1.1.3) *
* *
* acknowledgements *
* erik turner Z*Stream routines *
* david bennion finding the nastly little endless loop quirk with the *
* TZDecompressionStream.Read method *
* burak kalayci informing me about the zlib 1.1.4 update *
*****************************************************************************}

unit frxZLib;

interface

uses
  Windows,
  Sysutils,
  Classes;

const
  ZLIB_VERSION = '1.2.1';

type
  TZAlloc = function(opaque:Pointer; items, size:Integer):Pointer;
  TZFree = procedure(opaque, block:Pointer);
  TZCompressionLevel = (zcNone, zcFastest, zcDefault, zcMax);

  {** TZStreamRec ***********************************************************}

  TZStreamRec = packed record
    next_in:PChar; // next input byte
    avail_in:Longint; // 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:Longint; // 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
    state:Pointer; // not visible by applications
    zalloc:TZAlloc; // used to allocate the internal state
    zfree:TZFree; // used to free the internal state
    opaque: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;

  {** TCustomZStream ********************************************************}

  TCustomZStream = class(TStream)
  private
    FStream:TStream;
    FStreamPos:Integer;
    FOnProgress:TNotifyEvent;
    FZStream:TZStreamRec;
    FBuffer:array[Word] of Char;
  protected
    constructor Create(stream:TStream);
    procedure DoProgress; dynamic;
    property OnProgress:TNotifyEvent read FOnProgress write FOnProgress;
  end;

  {** TZCompressionStream ***************************************************}

  TZCompressionStream = class(TCustomZStream)
  private
    function GetCompressionRate:Single;
  public
    constructor Create(dest:TStream; compressionLevel:TZCompressionLevel = zcDefault);
    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;

  {** TZDecompressionStream *************************************************}

  TZDecompressionStream = class(TCustomZStream)
  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;

{** zlib public routines ****************************************************}

{*****************************************************************************
* ZCompress *
* *
* pre-conditions *
* inBuffer = pointer to uncompressed data *
* inSize = size of inBuffer (bytes) *
* outBuffer = pointer (unallocated) *
* level = compression level *
* *
* post-conditions *
* outBuffer = pointer to compressed data (allocated) *
* outSize = size of outBuffer (bytes) *
*****************************************************************************}

procedure ZCompress(const inBuffer:Pointer; inSize:Integer;
  out outBuffer:Pointer; out outSize:Integer;
  level:TZCompressionLevel = zcDefault);

{*****************************************************************************
* ZDecompress *
* *
* pre-conditions *
* inBuffer = pointer to compressed data *
* inSize = size of inBuffer (bytes) *
* outBuffer = pointer (unallocated) *
* outEstimate = estimated size of uncompressed data (bytes) *
* *
* post-conditions *
* outBuffer = pointer to decompressed data (allocated) *
* outSize = size of outBuffer (bytes) *
*****************************************************************************}

procedure ZDecompress(const inBuffer:Pointer; inSize:Integer;
  out outBuffer:Pointer; out outSize:Integer; outEstimate:Integer = 0);

{** utility routines ********************************************************}

function adler32(adler:LongInt; const buf:PChar; len:Integer):LongInt;
function crc32(crc:LongInt; const buf:PChar; len:Integer):LongInt;
function compressBound(sourceLen:LongInt):LongInt;

{****************************************************************************}

type
  EZLibError = class(Exception);
  EZCompressionError = class(EZLibError);
  EZDecompressionError = class(EZLibError);

implementation

{** link zlib 1.2.1 **************************************************************}
{** bcc32 flags:-c-6-O2-Ve-X--pr-a8-b-d-k--vi-tWM-r-RT--DFASTEST **}

{$L adler32.zobj}
{$L compress.zobj}
{$L crc32.zobj}
{$L deflate.zobj}
{$L infback.zobj}
{$L inffast.zobj}
{$L inflate.zobj}
{$L inftrees.zobj}
{$L trees.zobj}

{*****************************************************************************
* note:do not reorder the above--doing so will result in external *
* functions being undefined *
*****************************************************************************}

const
  {** flush constants *******************************************************}

  Z_NO_FLUSH = 0;
  Z_FINISH = 4;

  {** return codes **********************************************************}

  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);

  {** compression levels ****************************************************}

  Z_NO_COMPRESSION = 0;
  Z_BEST_SPEED = 1;
  Z_BEST_COMPRESSION = 9;
  Z_DEFAULT_COMPRESSION = (-1);

  {** compression methods ***************************************************}

  Z_DEFLATED = 8;

  {** return code messages **************************************************}

  _z_errmsg:array[0..9] of PChar = (
    'need dictionary', // Z_NEED_DICT (2)
    'stream end', // Z_STREAM_END (1)
    '', // Z_OK (0)
    'file error', // Z_ERRNO (-1)
    'stream error', // Z_STREAM_ERROR (-2)
    'data error', // Z_DATA_ERROR (-3)
    'insufficient memory', // Z_MEM_ERROR (-4)
    'buffer error', // Z_BUF_ERROR (-5)
    'incompatible version', // Z_VERSION_ERROR (-6)
    ''
    );

  ZLevels:array[TZCompressionLevel] of Shortint = (
    Z_NO_COMPRESSION,
    Z_BEST_SPEED,
    Z_DEFAULT_COMPRESSION,
    Z_BEST_COMPRESSION
    );

  SZInvalid = 'Invalid ZStream operation!';

{** deflate routines ********************************************************}

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 routines ********************************************************}

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;

{** utility routines *******************************************************}

function adler32; external;
function crc32; external;
function compressBound; external;

{** zlib function implementations *******************************************}

function zcalloc(opaque:Pointer; items, size:Integer):Pointer;
begin
  GetMem(result, items * size);
end;

procedure zcfree(opaque, block:Pointer);
begin
  FreeMem(block);
end;

{** c function implementations **********************************************}

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;

{** custom zlib routines ****************************************************}

function DeflateInit(var stream:TZStreamRec; level:Integer):Integer;
begin
  result:= DeflateInit_(stream, level, ZLIB_VERSION, SizeOf(TZStreamRec));
end;

function InflateInit(var stream:TZStreamRec):Integer;
begin
  result:= InflateInit_(stream, ZLIB_VERSION, SizeOf(TZStreamRec));
end;

{****************************************************************************}

function ZCompressCheck(code:Integer):Integer;
begin