zdeflate.pas

详细说明:毕业论文中关于小型宾馆管理系统的详细设计毕 业论文中关于小型宾馆...一个酒店管理系统VB+Access [学生学籍管理系统(VB+Acess).zip] - !这个是刚刚编的毕业设计,可能

                  buf : pBytef;
                  size : unsigned) : int; forward;
{$ifdef ASMV}
procedure match_init; { asm code initialization }
function longest_match(var deflate_state; cur_match : IPos) : uInt; forward;
{$else}
{local}
function longest_match(var s : deflate_state; cur_match : IPos) : uInt;
  forward;
{$endif}

{$ifdef DEBUG}
{local}
procedure check_match(var s : deflate_state;
                      start, match : IPos;
                      length : int); forward;
{$endif}

{  ==========================================================================
  local data }

const
  ZNIL = 0;
{ Tail of hash chains }

const
  TOO_FAR = 4096;
{ Matches of length 3 are discarded if their distance exceeds TOO_FAR }

const
  MIN_LOOKAHEAD = (MAX_MATCH+MIN_MATCH+1);
{ Minimum amount of lookahead, except at the end of the input file.
  See deflate.c for comments about the MIN_MATCH+1. }

{macro MAX_DIST(var s : deflate_state) : uInt;
begin
  MAX_DIST := (s.w_size - MIN_LOOKAHEAD);
end;
  In order to simplify the code, particularly on 16 bit machines, match
  distances are limited to MAX_DIST instead of WSIZE. }


{ Values for max_lazy_match, good_match and max_chain_length, depending on
  the desired pack level (0..9). The values given below have been tuned to
  exclude worst case performance for pathological files. Better values may be
  found for specific files. }

type
  config = record
   good_length : ush; { reduce lazy search above this match length }
   max_lazy : ush;    { do not perform lazy search above this match length }
   nice_length : ush; { quit search above this match length }
   max_chain : ush;
   func : compress_func;
  end;

{local}
const
  configuration_table : array[0..10-1] of config = (
{      good lazy nice chain }
{0} (good_length:0;  max_lazy:0;   nice_length:0;   max_chain:0;    func:deflate_stored),  { store only }
{1} (good_length:4;  max_lazy:4;   nice_length:8;   max_chain:4;    func:deflate_fast), { maximum speed, no lazy matches }
{2} (good_length:4;  max_lazy:5;   nice_length:16;  max_chain:8;    func:deflate_fast),
{3} (good_length:4;  max_lazy:6;   nice_length:32;  max_chain:32;   func:deflate_fast),

{4} (good_length:4;  max_lazy:4;   nice_length:16;  max_chain:16;   func:deflate_slow),  { lazy matches }
{5} (good_length:8;  max_lazy:16;  nice_length:32;  max_chain:32;   func:deflate_slow),
{6} (good_length:8;  max_lazy:16;  nice_length:128; max_chain:128;  func:deflate_slow),
{7} (good_length:8;  max_lazy:32;  nice_length:128; max_chain:256;  func:deflate_slow),
{8} (good_length:32; max_lazy:128; nice_length:258; max_chain:1024; func:deflate_slow),
{9} (good_length:32; max_lazy:258; nice_length:258; max_chain:4096; func:deflate_slow)); { maximum compression }

{ Note: the deflate() code requires max_lazy >= MIN_MATCH and max_chain >= 4
  For deflate_fast() (levels <= 3) good is ignored and lazy has a different
  meaning. }

const
  EQUAL = 0;
{ result of memcmp for equal strings }

{ ==========================================================================
  Update a hash value with the given input byte
  IN  assertion: all calls to to UPDATE_HASH are made with consecutive
     input characters, so that a running hash key can be computed from the
     previous key instead of complete recalculation each time.

macro UPDATE_HASH(s,h,c)
   h := (( (h) shl s^.hash_shift) xor (c)) and s^.hash_mask;
}

{ ===========================================================================
  Insert string str in the dictionary and set match_head to the previous head
  of the hash chain (the most recent string with same hash key). Return
  the previous length of the hash chain.
  If this file is compiled with -DFASTEST, the compression level is forced
  to 1, and no hash chains are maintained.
  IN  assertion: all calls to to INSERT_STRING are made with consecutive
     input characters and the first MIN_MATCH bytes of str are valid
     (except for the last MIN_MATCH-1 bytes of the input file). }

procedure INSERT_STRING(var s : deflate_state;
                        str : uInt;
                        var match_head : IPos);
begin
{$ifdef FASTEST}
   {UPDATE_HASH(s, s.ins_h, s.window[(str) + (MIN_MATCH-1)])}
    s.ins_h := ((s.ins_h shl s.hash_shift) xor
                 (s.window^[(str) + (MIN_MATCH-1)])) and s.hash_mask;
    match_head := s.head[s.ins_h]
    s.head[s.ins_h] := Pos(str);
{$else}
   {UPDATE_HASH(s, s.ins_h, s.window[(str) + (MIN_MATCH-1)])}
    s.ins_h := ((s.ins_h shl s.hash_shift) xor
                 (s.window^[(str) + (MIN_MATCH-1)])) and s.hash_mask;

    match_head := s.head^[s.ins_h];
    s.prev^[(str) and s.w_mask] := match_head;
    s.head^[s.ins_h] := Pos(str);
{$endif}
end;

{  =========================================================================
  Initialize the hash table (avoiding 64K overflow for 16 bit systems).
  prev[] will be initialized on the fly.

macro CLEAR_HASH(s)
    s^.head[s^.hash_size-1] := ZNIL;
    zmemzero(pBytef(s^.head), unsigned(s^.hash_size-1)*sizeof(s^.head^[0]));
}

{  ======================================================================== }

function deflateInit2_(var strm : z_stream;
                       level : int;
                       method : int;
                       windowBits : int;
                       memLevel : int;
                       strategy : int;
                       const version : string;
                       stream_size : int) : int;
var
  s : deflate_state_ptr;
  noheader : int;

  overlay : pushfArray;
  { We overlay pending_buf and d_buf+l_buf. This works since the average
    output size for (length,distance) codes is <= 24 bits. }
begin
  noheader := 0;
  if (version  =  '') or (version[1] <> ZLIB_VERSION[1]) or
     (stream_size <> sizeof(z_stream)) then
  begin
    deflateInit2_ := Z_VERSION_ERROR;
    exit;
  end;
  {
  if (strm = Z_NULL) then
  begin
    deflateInit2_ := Z_STREAM_ERROR;
    exit;
  end;
  }
  { SetLength(strm.msg, 255); }
  strm.msg := '';
  if not Assigned(strm.zalloc) then
  begin
    strm.zalloc := zcalloc;
    strm.opaque := voidpf(0);
  end;
  if not Assigned(strm.zfree) then
    strm.zfree := zcfree;

  if (level  =  Z_DEFAULT_COMPRESSION) then
    level := 6;
{$ifdef FASTEST}
    level := 1;
{$endif}

  if (windowBits < 0) then { undocumented feature: suppress zlib header }
  begin
    noheader := 1;
    windowBits := -windowBits;
  end;
  if (memLevel < 1) or (memLevel > MAX_MEM_LEVEL) or (method <> Z_DEFLATED)
    or (windowBits < 8) or (windowBits > 15) or (level < 0)
    or (level > 9) or (strategy < 0) or (strategy > Z_HUFFMAN_ONLY) then
  begin
    deflateInit2_ := Z_STREAM_ERROR;
    exit;
  end;

  s := deflate_state_ptr (ZALLOC(strm, 1, sizeof(deflate_state)));
  if (s = Z_NULL) then
  begin
    deflateInit2_ := Z_MEM_ERROR;
    exit;
  end;
  strm.state := pInternal_state(s);
  s^.strm := @strm;

  s^.noheader := noheader;
  s^.w_bits := windowBits;
  s^.w_size := 1 shl s^.w_bits;
  s^.w_mask := s^.w_size - 1;

  s^.hash_bits := memLevel + 7;
  s^.hash_size := 1 shl s^.hash_bits;
  s^.hash_mask := s^.hash_size - 1;
  s^.hash_shift :=  ((s^.hash_bits+MIN_MATCH-1) div MIN_MATCH);

  s^.window := pzByteArray (ZALLOC(strm, s^.w_size, 2*sizeof(Byte)));
  s^.prev   := pzPosfArray (ZALLOC(strm, s^.w_size, sizeof(Pos)));
  s^.head   := pzPosfArray (ZALLOC(strm, s^.hash_size, sizeof(Pos)));

  s^.lit_bufsize := 1 shl (memLevel + 6); { 16K elements by default }

  overlay := pushfArray (ZALLOC(strm, s^.lit_bufsize, sizeof(ush)+2));
  s^.pending_buf := pzByteArray (overlay);
  s^.pending_buf_size := ulg(s^.lit_bufsize) * (sizeof(ush)+Long(2));

  if (s^.window = Z_NULL) or (s^.prev = Z_NULL) or (s^.head = Z_NULL)
   or (s^.pending_buf = Z_NULL) then
  begin
    {ERR_MSG(Z_MEM_ERROR);}
    strm.msg := z_errmsg[z_errbase-Z_MEM_ERROR];
    deflateEnd (strm);
    deflateInit2_ := Z_MEM_ERROR;
    exit;
  end;
  s^.d_buf := pushfArray( @overlay^[s^.lit_bufsize div sizeof(ush)] );
  s^.l_buf := puchfArray( @s^.pending_buf^[(1+sizeof(ush))*s^.lit_bufsize] );

  s^.level := level;
  s^.strategy := strategy;
  s^.method := Byte(method);

  deflateInit2_ := deflateReset(strm);
end;

{  ========================================================================= }

function deflateInit2(var strm : z_stream;
                      level : int;
                      method : int;
                      windowBits : int;
                      memLevel : int;
                      strategy : int) : int;
{ a macro }
begin
  deflateInit2 := deflateInit2_(strm, level, method, windowBits,
                   memLevel, strategy, ZLIB_VERSION, sizeof(z_stream));
end;

{  ========================================================================= }

function deflateInit_(strm : z_streamp;
                      level : int;
                      const version : string;
                      stream_size : int) : int;
begin
  if (strm = Z_NULL) then
    deflateInit_ := Z_STREAM_ERROR
  else
    deflateInit_ := deflateInit2_(strm^, level, Z_DEFLATED, MAX_WBITS,
                   DEF_MEM_LEVEL, Z_DEFAULT_STRATEGY, version, stream_size);
  { To do: ignore strm^.next_in if we use it as window }
end;

{  ========================================================================= }

function deflateInit(var strm : z_stream; level : int) : int;
{ deflateInit is a macro to allow checking the zlib version
  and the compiler's view of z_stream: }
begin
  deflateInit := deflateInit2_(strm, level, Z_DEFLATED, MAX_WBITS,
         DEF_MEM_LEVEL, Z_DEFAULT_STRATEGY, ZLIB_VERSION, sizeof(z_stream));
end;

{  ======================================================================== }
function deflateSetDictionary (var strm : z_stream;
                               dictionary : pBytef;
                               dictLength : uInt) : int;
var
  s : deflate_state_ptr;
  length : uInt;
  n : uInt;
  hash_head : IPos;
var
  MAX_DIST : uInt;  {macro}
begin
  length := dictLength;
  hash_head := 0;

  if {(@strm  =  Z_NULL) or}
     (strm.state  =  Z_NULL) or (dictionary  =  Z_NULL)
    or (deflate_state_ptr(strm.state)^.status <> INIT_STATE) then
  begin
    deflateSetDictionary := Z_STREAM_ERROR;
    exit;
  end;

  s := deflate_state_ptr(strm.state);
  strm.adler := adler32(strm.adler, dictionary, dictLength);

  if (length < MIN_MATCH) then
  begin
    deflateSetDictionary := Z_OK;
    exit;
  end;
  MAX_DIST := (s^.w_size - MIN_LOOKAHEAD);
  if (length > MAX_DIST) then
  begin
    length := MAX_DIST;
{$ifndef USE_DICT_HEAD}
    Inc(dictionary, dictLength - length);  { use the tail of the dictionary }
{$endif}
  end;

  zmemcpy( pBytef(s^.window), dictionary, length);
  s^.strstart := length;
  s^.block_start := long(length);

  { Insert all strings in the hash table (except for the last two bytes).
    s^.lookahead stays null, so s^.ins_h will be recomputed at the next
    call of fill_window. }

  s^.ins_h := s^.window^[0];
  {UPDATE_HASH(s, s^.ins_h, s^.window[1]);}
  s^.ins_h := ((s^.ins_h shl s^.hash_shift) xor (s^.window^[1]))
              and s^.hash_mask;

  for n := 0 to length - MIN_MATCH do
  begin
    INSERT_STRING(s^, n, hash_head);
  end;
  {if (hash_head <> 0) then
    hash_head := 0;  - to make compiler happy }
  deflateSetDictionary := Z_OK;
end;

{  ======================================================================== }
function deflateReset (var strm : z_stream) : int;
var
  s : deflate_state_ptr;
begin
  if {(@strm = Z_NULL) or}
   (strm.state = Z_NULL)
   or (not Assigned(strm.zalloc)) or (not Assigned(strm.zfree)) then
  begin
    deflateReset := Z_STREAM_ERROR;
    exit;
  end;

  strm.total_out := 0;
  strm.total_in := 0;
  strm.msg := '';      { use zfree if we ever allocate msg dynamically }
  strm.data_type := Z_UNKNOWN;

  s := deflate_state_ptr(strm.state);
  s^.pending := 0;
  s^.pending_out := pBytef(s^.pending_buf);

  if (s^.noheader < 0) then
  begin
    s^.noheader := 0; { was set to -1 by deflate(..., Z_FINISH); }