ztvdeflate.pas

ziptv为delphi控件

      And s^.hash_mask;

   For n := 0 To Length - MIN_MATCH Do
   Begin
      INSERT_STRING(s^, n, hash_head);
   End;

   Result := Z_OK;
End;
//-------------------------------------------------------------

{Function _deflateParams( Var strm: ztv_stream; level: _int; strategy: _int ): _int;
Var
   s: deflate_state_ptr;
   func: compress_func;
   err: _int;
Begin
   err := Z_OK;
   If ( strm.state = Z_NULL ) Then
   Begin
      Result := Z_STREAM_ERROR;
      Exit;
   End;

   s := deflate_state_ptr( strm.state );

   If ( level = Z_DEFAULT_COMPRESSION ) Then
      level := ztvDeflateN;

   If ( level < 0 ) Or ( level > 9 ) Or ( strategy < 0 )
      Or ( strategy > Z_HUFFMAN_ONLY ) Then
   Begin
      Result := Z_STREAM_ERROR;
      Exit;
   End;

   func := configuration_table[s^.level].func;

   If ( @func <> @configuration_table[level].func ) And ( strm.total_in <> 0 ) Then
      err := _deflate( strm, Z_PARTIAL_FLUSH );

   If ( s^.level <> level ) Then
   Begin
      s^.level := level;
      s^.max_lazy_match := configuration_table[level].max_lazy;
      s^.good_match := configuration_table[level].good_length;
      s^.nice_match := configuration_table[level].nice_length;
      s^.max_chain_length := configuration_table[level].max_chain;
   End;

   s^.strategy := strategy;
   Result := err;
End;}
//-------------------------------------------------------------

Procedure putShortMSB(Var s: deflate_state; b: word);
Begin
   s.pending_buf^[s.pending] := Byte(b Shr 8);
   inc(s.pending);
   s.pending_buf^[s.pending] := Byte(b And $FF);
   inc(s.pending);
End;
//-------------------------------------------------------------

Procedure flush_pending(Var strm: ztv_stream);
Var
   Len: _unsigned;
   s: deflate_state_ptr;
Begin
   s := deflate_state_ptr(strm.state);
   Len := s^.pending;

   If (Len > strm.avail_out) Then
      Len := strm.avail_out;

   If (Len = 0) Then
      Exit;

   CopyMem(@s^.pending_out^, @strm.next_out^, Len);

   inc(strm.next_out, Len);
   inc(s^.pending_out, Len);
   strm.total_out := strm.total_out + Len;
   Dec(strm.avail_out, Len);
   Dec(s^.pending, Len);

   If (s^.pending = 0) Then
      s^.pending_out := _pBytef(s^.pending_buf);

End;
//-------------------------------------------------------------

Procedure send_bits(Var s: deflate_state;
   value: _int;                         { value to send }
   Length: _int);                       { number of bits }
Begin
{$IFOPT Q+}{$Q-}{$DEFINE NoOverflowCheck}{$ENDIF}
{$IFOPT R+}{$R-}{$DEFINE NoRangeCheck}{$ENDIF}
   If (s.bi_valid > _int(BUF_SIZE) - Length) Then
   Begin
      s.bi_buf := s.bi_buf Or _int(value Shl s.bi_valid);
      s.pending_buf^[s.pending] := uch(s.bi_buf And $FF);
      inc(s.pending);
      s.pending_buf^[s.pending] := uch(ush(s.bi_buf) Shr 8);
      ;
      inc(s.pending);

      s.bi_buf := ush(value) Shr (BUF_SIZE - s.bi_valid);
      inc(s.bi_valid, Length - BUF_SIZE);
   End
   Else
   Begin
      s.bi_buf := s.bi_buf Or _int(value Shl s.bi_valid);
      inc(s.bi_valid, Length);
   End;
{$IFDEF NoOverflowCheck}{$Q+}{$UNDEF NoOverflowCheck}{$ENDIF}
{$IFDEF NoRangeCheck}{$Q+}{$UNDEF NoRangeCheck}{$ENDIF}
End;
//-------------------------------------------------------------

Procedure bi_flush(Var s: deflate_state);
Begin
   If (s.bi_valid = 16) Then
   Begin
      s.pending_buf^[s.pending] := uch(s.bi_buf And $FF);
      inc(s.pending);
      s.pending_buf^[s.pending] := uch(ush(s.bi_buf) Shr 8);
      inc(s.pending);

      s.bi_buf := 0;
      s.bi_valid := 0;
   End
   Else
      If (s.bi_valid >= 8) Then
      Begin
         s.pending_buf^[s.pending] := Byte(s.bi_buf);
         inc(s.pending);
         s.bi_buf := s.bi_buf Shr 8;
         Dec(s.bi_valid, 8);
      End;
End;
//-------------------------------------------------------------

Procedure _tr_align(Var s: deflate_state);
Begin
   send_bits(s, STATIC_TREES Shl 1, 3);
   send_bits(s, static_ltree[END_BLOCK].fc.code, static_ltree[END_BLOCK].dl.Len);
   inc(s.compressed_len, longint(10));  { 3 for block type, 7 for EOB }
   bi_flush(s);

   If (1 + s.last_eob_len + 10 - s.bi_valid < 9) Then
   Begin
      send_bits(s, STATIC_TREES Shl 1, 3);
      send_bits(s, static_ltree[END_BLOCK].fc.code, static_ltree[END_BLOCK].dl.Len);
      inc(s.compressed_len, longint(10));
      bi_flush(s);
   End;
   s.last_eob_len := 7;
End;
//-------------------------------------------------------------

Procedure bi_windup(Var s: deflate_state);
Begin
   If (s.bi_valid > 8) Then
   Begin
      s.pending_buf^[s.pending] := uch(s.bi_buf And $FF);
      inc(s.pending);
      s.pending_buf^[s.pending] := uch(ush(s.bi_buf) Shr 8);
      inc(s.pending);
   End
   Else
      If (s.bi_valid > 0) Then
      Begin
         s.pending_buf^[s.pending] := Byte(s.bi_buf);
         inc(s.pending);
      End;
   s.bi_buf := 0;
   s.bi_valid := 0;
End;
//-------------------------------------------------------------

Procedure copy_block(Var s: deflate_state; Buf: pcharf; Len: _unsigned; Header: Boolean);
Begin
   bi_windup(s);                        { align on byte boundary }
   s.last_eob_len := 8;                 { enough lookahead for inflate }

   If (Header) Then
   Begin
      s.pending_buf^[s.pending] := uch(ush(Len) And $FF);

      inc(s.pending);
      s.pending_buf^[s.pending] := uch(ush(Len) Shr 8);

      inc(s.pending);
      s.pending_buf^[s.pending] := uch(ush(Not Len) And $FF);

      inc(s.pending);
      s.pending_buf^[s.pending] := uch(ush(Not Len) Shr 8);

      inc(s.pending);
   End;

   While (Len <> 0) Do
   Begin
      Dec(Len);
      s.pending_buf^[s.pending] := Buf^;
      inc(Buf);
      inc(s.pending);
   End;
End;
//-------------------------------------------------------------

Procedure _tr_stored_block(Var s: deflate_state; Buf: pcharf; stored_len: ulg;
   Eof: Boolean);
Begin
   send_bits(s, (STORED_BLOCK Shl 1) + ord(Eof), 3); { send block type }
   s.compressed_len := (s.compressed_len + 3 + 7) And ulg(Not longint(7));
   inc(s.compressed_len, (stored_len + 4) Shl 3);
   copy_block(s, Buf, _unsigned(stored_len), True); { with header }
End;
//-------------------------------------------------------------

Procedure zmemzero(destp: _pBytef; Len: _uInt);
Begin
   FillChar(destp^, Len, 0);
End;
//-------------------------------------------------------------

Function _deflate(Var strm: ztv_stream; Flush: _int): _int;
Var
   old_flush: _int;
   s: deflate_state_ptr;
   Header: word;
   level_flags: word;
   bstate: block_state;
Begin

   If (Assigned(strm.cb.pCancel) And strm.cb.pCancel^) Or
      (strm.state = Z_NULL) Or
      (Flush > Z_FINISH) Or
      (Flush < 0) Then
   Begin
      Result := Z_STREAM_ERROR;
      Exit;
   End;

   s := deflate_state_ptr(strm.state);

   If (strm.next_out = Z_NULL) Or
      ((strm.next_in = Z_NULL) And (strm.avail_in <> 0)) Or
      ((s^.Status = FINISH_STATE) And (Flush <> Z_FINISH)) Then
   Begin
      Result := Z_STREAM_ERROR;
      Exit;
   End;

   If (strm.avail_out = 0) Then
   Begin
      Result := Z_BUF_ERROR;
      Exit;
   End;

   s^.strm := @strm;                    { just in case }
   old_flush := s^.last_flush;
   s^.last_flush := Flush;

   { Write the lib header }
   If (s^.Status = INIT_STATE) Then
   Begin
      Header := (Z_DEFLATED + ((s^.w_bits - 8) Shl 4)) Shl 8;
      level_flags := (s^.level - 1) Shr 1;

      If (level_flags > 3) Then
         level_flags := 3;

      Header := Header Or (level_flags Shl 6);

      If (s^.strstart <> 0) Then
         Header := Header Or PRESET_DICT;

      inc(Header, 31 - (Header Mod 31));
      s^.Status := BUSY_STATE;
      putShortMSB(s^, Header);

      { Save the adler32 of the preset dictionary: }
      If (s^.strstart <> 0) Then
      Begin
         putShortMSB(s^, word(strm.adler Shr 16));
         putShortMSB(s^, word(strm.adler And $FFFF));
      End;

      strm.adler := Long(1);
   End;

   If (s^.pending <> 0) Then
   Begin

      flush_pending(strm);
      If (strm.avail_out = 0) Then
      Begin
         s^.last_flush := -1;
         Result := Z_OK;
         Exit;
      End;

   End
   Else
      If (strm.avail_in = 0) And (Flush <= old_flush)
      And (Flush <> Z_FINISH) Then
      Begin
         Result := Z_BUF_ERROR;	//strm.msg := z_errmsg[z_errbase - Z_BUF_ERROR];
         Exit;
      End;

   If (s^.Status = FINISH_STATE) And (strm.avail_in <> 0) Then
   Begin
      Result := Z_BUF_ERROR;	//strm.msg := z_errmsg[z_errbase - Z_BUF_ERROR];
      Exit;
   End;

   If (strm.avail_in <> 0) Or (s^.lookahead <> 0)
      Or ((Flush <> Z_NO_FLUSH) And (s^.Status <> FINISH_STATE)) Then
   Begin
      bstate := configuration_table[s^.level].func(s^, Flush);

      If (bstate = finish_started) Or (bstate = finish_done) Then
         s^.Status := FINISH_STATE;

      If (bstate = need_more) Or (bstate = finish_started) Then
      Begin
         If (strm.avail_out = 0) Then
            s^.last_flush := -1;

         Result := Z_OK;
         Exit;
      End;

      If (bstate = block_done) Then
      Begin
         If (Flush = Z_PARTIAL_FLUSH) Then
            _tr_align(s^)
         Else
         Begin                          { FULL_FLUSH or SYNC_FLUSH }
            _tr_stored_block(s^, pcharf(Nil), longint(0), False);

            If (Flush = Z_FULL_FLUSH) Then
            Begin
               s^.head^[s^.hash_size - 1] := ZNIL;
               zmemzero(_pBytef(s^.head), _unsigned(s^.hash_size - 1) * SizeOf(s^.head^[0]));
            End;
         End;

         flush_pending(strm);
         If (strm.avail_out = 0) Then
         Begin
            s^.last_flush := -1;
            Result := Z_OK;
            Exit;
         End;

      End;
   End;