zdeflate.pas

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

    { Return failure if the match length is less than 2: }

    if (match[0] <> scan[0]) or (match[1] <> scan[1]) then
    begin
      longest_match := MIN_MATCH-1;
      exit;
    end;

    { The check at best_len-1 can be removed because it will be made
      again later. (This heuristic is not always a win.)
      It is not necessary to compare scan[2] and match[2] since they
      are always equal when the other bytes match, given that
      the hash keys are equal and that HASH_BITS >= 8. }

    scan += 2, match += 2;
    Assert(scan^ = match^, 'match[2]?');

    { We check for insufficient lookahead only every 8th comparison;
      the 256th check will be made at strstart+258. }

    repeat
      Inc(scan); Inc(match); if scan^<>match^ then break;
      Inc(scan); Inc(match); if scan^<>match^ then break;
      Inc(scan); Inc(match); if scan^<>match^ then break;
      Inc(scan); Inc(match); if scan^<>match^ then break;
      Inc(scan); Inc(match); if scan^<>match^ then break;
      Inc(scan); Inc(match); if scan^<>match^ then break;
      Inc(scan); Inc(match); if scan^<>match^ then break;
      Inc(scan); Inc(match); if scan^<>match^ then break;
    until (ptr2int(scan) >= ptr2int(strend));

    Assert(scan <= s.window+unsigned(s.window_size-1), 'wild scan');

    len := MAX_MATCH - int(strend - scan);

    if (len < MIN_MATCH) then
    begin
      return := MIN_MATCH - 1;
      exit;
    end;

    s.match_start := cur_match;
    if len <= s.lookahead then
      longest_match := len
    else
      longest_match := s.lookahead;
end;
{$endif} { FASTEST }

{$ifdef DEBUG}
{ ===========================================================================
  Check that the match at match_start is indeed a match. }

{local}
procedure check_match(var s : deflate_state;
                      start, match : IPos;
                      length : int);
begin
  exit;
  { check that the match is indeed a match }
  if (zmemcmp(pBytef(@s.window^[match]),
              pBytef(@s.window^[start]), length) <> EQUAL) then
  begin
    WriteLn(' start ',start,', match ',match ,' length ', length);
    repeat
      Write(char(s.window^[match]), char(s.window^[start]));
      Inc(match);
      Inc(start);
      Dec(length);
    Until (length = 0);
    z_error('invalid match');
  end;
  if (z_verbose > 1) then
  begin
    Write('\\[',start-match,',',length,']');
    repeat
       Write(char(s.window^[start]));
       Inc(start);
       Dec(length);
    Until (length = 0);
  end;
end;
{$endif}

{ ===========================================================================
  Fill the window when the lookahead becomes insufficient.
  Updates strstart and lookahead.

  IN assertion: lookahead < MIN_LOOKAHEAD
  OUT assertions: strstart <= window_size-MIN_LOOKAHEAD
     At least one byte has been read, or avail_in = 0; reads are
     performed for at least two bytes (required for the zip translate_eol
     option -- not supported here). }

{local}
procedure fill_window(var s : deflate_state);
var
  {register} n, m : unsigned;
  {register} p : pPosf;
  more : unsigned;    { Amount of free space at the end of the window. }
  wsize : uInt;
begin
   wsize := s.w_size;
   repeat
     more := unsigned(s.window_size -ulg(s.lookahead) -ulg(s.strstart));

     { Deal with !@#$% 64K limit: }
     if (more = 0) and (s.strstart = 0) and (s.lookahead = 0) then
       more := wsize
     else
     if (more = unsigned(-1)) then
     begin
       { Very unlikely, but possible on 16 bit machine if strstart = 0
         and lookahead = 1 (input done one byte at time) }
       Dec(more);

       { If the window is almost full and there is insufficient lookahead,
         move the upper half to the lower one to make room in the upper half.}
     end
     else
       if (s.strstart >= wsize+ {MAX_DIST}wsize-MIN_LOOKAHEAD) then
       begin
         zmemcpy( pBytef(s.window), pBytef(@(s.window^[wsize])),
                 unsigned(wsize));
         Dec(s.match_start, wsize);
         Dec(s.strstart, wsize); { we now have strstart >= MAX_DIST }
         Dec(s.block_start, long(wsize));

         { Slide the hash table (could be avoided with 32 bit values
           at the expense of memory usage). We slide even when level = 0
           to keep the hash table consistent if we switch back to level > 0
           later. (Using level 0 permanently is not an optimal usage of
           zlib, so we don't care about this pathological case.) }

         n := s.hash_size;
         p := @s.head^[n];
         repeat
           Dec(p);
           m := p^;
           if (m >= wsize) then
             p^ := Pos(m-wsize)
           else
             p^ := Pos(ZNIL);
           Dec(n);
         Until (n=0);

         n := wsize;
{$ifndef FASTEST}
         p := @s.prev^[n];
         repeat
           Dec(p);
           m := p^;
           if (m >= wsize) then
             p^ := Pos(m-wsize)
           else
             p^:= Pos(ZNIL);
             { If n is not on any hash chain, prev^[n] is garbage but
               its value will never be used. }
           Dec(n);
         Until (n=0);
{$endif}
         Inc(more, wsize);
     end;
     if (s.strm^.avail_in = 0) then
       exit;

     {* If there was no sliding:
      *    strstart <= WSIZE+MAX_DIST-1 && lookahead <= MIN_LOOKAHEAD - 1 &&
      *    more == window_size - lookahead - strstart
      * => more >= window_size - (MIN_LOOKAHEAD-1 + WSIZE + MAX_DIST-1)
      * => more >= window_size - 2*WSIZE + 2
      * In the BIG_MEM or MMAP case (not yet supported),
      *   window_size == input_size + MIN_LOOKAHEAD  &&
      *   strstart + s->lookahead <= input_size => more >= MIN_LOOKAHEAD.
      * Otherwise, window_size == 2*WSIZE so more >= 2.
      * If there was sliding, more >= WSIZE. So in all cases, more >= 2. }

     {$IFDEF DEBUG}
     Assert(more >= 2, 'more < 2');
     {$ENDIF}

     n := read_buf(s.strm, pBytef(@(s.window^[s.strstart + s.lookahead])),
                  more);
     Inc(s.lookahead, n);

     { Initialize the hash value now that we have some input: }
     if (s.lookahead >= MIN_MATCH) then
     begin
       s.ins_h := s.window^[s.strstart];
       {UPDATE_HASH(s, s.ins_h, s.window[s.strstart+1]);}
       s.ins_h := ((s.ins_h shl s.hash_shift) xor s.window^[s.strstart+1])
                     and s.hash_mask;
{$ifdef MIN_MATCH <> 3}
       Call UPDATE_HASH() MIN_MATCH-3 more times
{$endif}
     end;
     { If the whole input has less than MIN_MATCH bytes, ins_h is garbage,
       but this is not important since only literal bytes will be emitted. }

   until (s.lookahead >= MIN_LOOKAHEAD) or (s.strm^.avail_in = 0);
end;

{ ===========================================================================
  Flush the current block, with given end-of-file flag.
  IN assertion: strstart is set to the end of the current match. }

procedure FLUSH_BLOCK_ONLY(var s : deflate_state; eof : boolean); {macro}
begin
  if (s.block_start >= Long(0)) then
    _tr_flush_block(s, pcharf(@s.window^[unsigned(s.block_start)]),
                    ulg(long(s.strstart) - s.block_start), eof)
  else
    _tr_flush_block(s, pcharf(Z_NULL),
                    ulg(long(s.strstart) - s.block_start), eof);

  s.block_start := s.strstart;
  flush_pending(s.strm^);
  {$IFDEF DEBUG}
  Tracev('[FLUSH]');
  {$ENDIF}
end;

{ Same but force premature exit if necessary.
macro FLUSH_BLOCK(var s : deflate_state; eof : boolean) : boolean;
var
  result : block_state;
begin
 FLUSH_BLOCK_ONLY(s, eof);
 if (s.strm^.avail_out = 0) then
 begin
   if eof then
     result := finish_started
   else
     result := need_more;
   exit;
 end;
end;
}

{ ===========================================================================
  Copy without compression as much as possible from the input stream, return
  the current block state.
  This function does not insert new strings in the dictionary since
  uncompressible data is probably not useful. This function is used
  only for the level=0 compression option.
  NOTE: this function should be optimized to avoid extra copying from
  window to pending_buf. }


{local}
function deflate_stored(var s : deflate_state; flush : int) : block_state;
{ Stored blocks are limited to 0xffff bytes, pending_buf is limited
  to pending_buf_size, and each stored block has a 5 byte header: }
var
  max_block_size : ulg;
  max_start : ulg;
begin
  max_block_size := $ffff;
  if (max_block_size > s.pending_buf_size - 5) then
    max_block_size := s.pending_buf_size - 5;

  { Copy as much as possible from input to output: }
  while TRUE do
  begin
    { Fill the window as much as possible: }
    if (s.lookahead <= 1) then
    begin
      {$IFDEF DEBUG}
      Assert( (s.strstart < s.w_size + {MAX_DIST}s.w_size-MIN_LOOKAHEAD) or
              (s.block_start >= long(s.w_size)), 'slide too late');
      {$ENDIF}
      fill_window(s);
      if (s.lookahead = 0) and (flush = Z_NO_FLUSH) then
      begin
        deflate_stored := need_more;
        exit;
      end;

      if (s.lookahead = 0) then
        break; { flush the current block }
    end;
    {$IFDEF DEBUG}
    Assert(s.block_start >= long(0), 'block gone');
    {$ENDIF}
    Inc(s.strstart, s.lookahead);
    s.lookahead := 0;

    { Emit a stored block if pending_buf will be full: }
    max_start := s.block_start + max_block_size;
    if (s.strstart = 0) or (ulg(s.strstart) >= max_start) then
    begin
      { strstart = 0 is possible when wraparound on 16-bit machine }
      s.lookahead := uInt(s.strstart - max_start);
      s.strstart := uInt(max_start);
      {FLUSH_BLOCK(s, FALSE);}
      FLUSH_BLOCK_ONLY(s, FALSE);
      if (s.strm^.avail_out = 0) then
      begin
        deflate_stored := need_more;
        exit;
      end;
    end;

    { Flush if we may have to slide, otherwise block_start may become
      negative and the data will be gone: }

    if (s.strstart - uInt(s.block_start) >= {MAX_DIST}
        s.w_size-MIN_LOOKAHEAD) then
    begin
      {FLUSH_BLOCK(s, FALSE);}
      FLUSH_BLOCK_ONLY(s, FALSE);
      if (s.strm^.avail_out = 0) then
      begin
        deflate_stored := need_more;
        exit;
      end;
    end;
  end;

  {FLUSH_BLOCK(s, flush = Z_FINISH);}
  FLUSH_BLOCK_ONLY(s, flush = Z_FINISH);
  if (s.strm^.avail_out = 0) then
  begin
    if flush = Z_FINISH then
      deflate_stored := finish_started
    else
      deflate_stored := need_more;
    exit;
  end;

  if flush = Z_FINISH then
    deflate_stored := finish_done
  else
    deflate_stored := block_done;
end;

{ ===========================================================================
  Compress as much as possible from the input stream, return the current
  block state.
  This function does not perform lazy evaluation of matches and inserts
  new strings in the dictionary only for unmatched strings or for short
  matches. It is used only for the fast compression options. }

{local}
function deflate_fast(var s : deflate_state; flush : int) : block_state;
var
  hash_head : IPos;     { head of the hash chain }
  bflush : boolean;     { set if current block must be flushed }
begin
  hash_head := ZNIL;
  while TRUE do
  begin
  { Make sure that we always have enough lookahead, except
    at the end of the input file. We need MAX_MATCH bytes
    for the next match, plus MIN_MATCH bytes to insert the
    string following the next match. }

    if (s.lookahead < MIN_LOOKAHEAD) then
    begin
      fill_window(s);
      if (s.lookahead < MIN_LOOKAHEAD) and (flush = Z_NO_FLUSH) then
      begin
        deflate_fast := need_more;