ztvinflate.pas

ziptv为delphi控件

      { allocate memory }
      C := pFixed_table(ZALLOC(z, 288, SizeOf(_uInt)));
      If (C = Z_NULL) Then
      Begin
         Result := Z_MEM_ERROR;
         Exit;
      End;

      v := PuIntArray(ZALLOC(z, 288, SizeOf(_uInt)));
      If (v = Z_NULL) Then
      Begin
         ZFREE(z, C);
         Result := Z_MEM_ERROR;
         Exit;
      End;

      { literal table }
      For k := 0 To Pred(144) Do
         C^[k] := 8;
      For k := 144 To Pred(256) Do
         C^[k] := 9;
      For k := 256 To Pred(280) Do
         C^[k] := 7;
      For k := 280 To Pred(288) Do
         C^[k] := 8;

      fixed_bl := {9; //temp} 7; //9;  v4.8.5 changed

      If is64Bit Then
         huft_build(C^, 288, 257, cplens64, cplext64, @fixed_tl, fixed_bl,
            fixed_mem, f, v^)
      Else
         huft_build(C^, 288, 257, cplens32, cplext32, @fixed_tl, fixed_bl,
            fixed_mem, f, v^);

      { distance table }
      For k := 0 To MAXDISTS - 1 Do
         C^[k] := 5;

      fixed_bd := 5;

      If is64Bit Then
         huft_build(C^, MAXDISTS, 0, cpdist64, cpdext64, @fixed_td, fixed_bd,
            fixed_mem, f, v^)
      Else
         huft_build(C^, MAXDISTS, 0, cpdist32, cpdext32, @fixed_td, fixed_bd,
            fixed_mem, f, v^);


      ZFREE(z, v);
      ZFREE(z, C);

      // **************************************************
      // if your compiler stops here during compile:
      // 	goto menu Project/Options/Compiler and check
      //    the "Assignable typed constants" checkbox.
      fixed_built := True;
      // **************************************************

   End;
   bl := fixed_bl;
   bd := fixed_bd;
   tl := fixed_tl;
   td := fixed_td;
   Result := Z_OK;
End;
//-------------------------------------------------------------

Function inflate_codes_new(bl, bd: _uInt; tl, td: phuft; Var z: ztv_stream):
	pInflate_codes_state;
Var
   C: pInflate_codes_state;
Begin
   C := pInflate_codes_state(ZALLOC(z, 1, SizeOf(inflate_codes_state)));
   If (C <> Z_NULL) Then
   Begin
      C^.mode := START;
      C^.lbits := Byte(bl);
      C^.dbits := Byte(bd);
      C^.ltree := tl;
      C^.dtree := td;
   End;
   Result := C;
End;
//-------------------------------------------------------------

Function inflate_trees_bits(
   Var C: Array Of {u_long; //}uIntf; //v6.1  { 19 code lengths }
   Var bb: {u_long; //}uIntf;  //v6.1         { bits tree desired/actual depth }
   Var tb: phuft;               			 	{ bits tree result }
   Var hp: Array Of huft;       				{ space for trees }
   Var z: ztv_stream                    	{ for messages }
   ): _int;
Var
   R: _int;
   hn: _uInt;                            	{ hufts used in space }
   v: PuIntArray;                       	{ work area for huft_build }
Begin
   hn := 0;
   v := PuIntArray(ZALLOC(z, 19, SizeOf(_uInt)));
   If (v = Z_NULL) Then
   Begin
      Result := Z_MEM_ERROR;
      Exit;
   End;

   Try

      If is64Bit Then
         R := huft_build(C, 19, 19, cplens64, cplext64,
            @tb, bb, hp, hn, v^)
      Else
         R := huft_build(C, 19, 19, cplens32, cplext32,
            @tb, bb, hp, hn, v^);

      If (R = Z_DATA_ERROR) Then
         {oversubscribed dynamic bit lengths tree}
      Else
         If (R = Z_BUF_ERROR) Or (bb = 0) Then
         Begin
         	{incomplete dynamic bit lengths tree}
            R := Z_DATA_ERROR;
         End;
   Finally
   	ZFREE(z, v);
   End;
   Result := R;
End;
//-------------------------------------------------------------

Function inflate_trees_dynamic(
   nl: {u_long; //}_uInt; //v6.1           { number of literal/length codes }
   nd: {u_long; //}_uInt; //v6.1           { number of distance codes }
   Var C: Array Of {u_long; //}uIntf; //v6.1 { that many (total) code lengths }
   Var bl: {u_long; //}uIntf; //v6.1       { literal desired/actual bit depth }
   Var bd: {u_long; //}uIntf; //v6.1       { distance desired/actual bit depth }
   Var tl: phuft;               			{ literal/length tree result }
   Var td: phuft;               			{ distance tree result }
   Var hp: Array Of huft;      			{ space for trees }
   Var z: ztv_stream                   { for messages }
   ): _int;
Var
   R: _int;
   hn: _uInt;                          { hufts used in space }
   v: PuIntArray;                      { work area for huft_build }
Begin
   hn := 0;

   { allocate work area }
   v := PuIntArray(ZALLOC(z, 288, SizeOf(_uInt)));
   If (v = Z_NULL) Then
   Begin
      Result := Z_MEM_ERROR;
      Exit;
   End;

   { build literal/length tree }
   If is64Bit Then
   	R := huft_build(C, nl, 257, cplens64, cplext64, @tl, bl, hp, hn, v^)
   Else
   	R := huft_build(C, nl, 257, cplens32, cplext32, @tl, bl, hp, hn, v^);

   If (R <> Z_OK) Or (bl = 0) Then
   Begin
      If (R = Z_DATA_ERROR) Then
         {oversubscribed literal/length tree}
      Else
         If (R <> Z_MEM_ERROR) Then
         Begin
            {incomplete literal/length tree}
            R := Z_DATA_ERROR;
         End;

      ZFREE(z, v);
      Result := R;
      Exit;
   End;

   { build distance tree }
   If is64Bit Then
      R := huft_build(PuIntArray(@C[nl])^, nd, 0,
         cpdist64, cpdext64, @td, bd, hp, hn, v^)
   Else
      R := huft_build(PuIntArray(@C[nl])^, nd, 0,
         cpdist32, cpdext32, @td, bd, hp, hn, v^);

   If (R <> Z_OK) Or ((bd = 0) And (nl > 257)) Then
   Begin
      If (R = Z_DATA_ERROR) Then
         {oversubscribed literal/length tree}
      Else
         If (R = Z_BUF_ERROR) Then
         Begin
{$IFDEF PKZIP_BUG_WORKAROUND}
            //R := Z_OK;
         End;
{$ELSE}
            {incomplete literal/length tree}
            R := Z_DATA_ERROR;
         End
         Else
         Begin
            If (R <> Z_MEM_ERROR) Then
               {empty distance tree with lengths}
               R := Z_DATA_ERROR;
         End;

      ZFREE(z, v);
      Result := R;
      Exit;
{$ENDIF}
   End;

   ZFREE(z, v);
   Result := Z_OK;
End;
//-------------------------------------------------------------

{$IFNDEF SLOW}
Function inflate_fast(bl: _uInt; bd: _uInt; tl: phuft; td: phuft;
	Var s: inflate_blocks_state; Var z: ztv_stream): _int;
Var
   t: phuft;                    				{ temporary pointer }
   e: _uInt;                             	{ extra bits or operation }
   b: u_long;                           	{ bit buffer }
   k: _uInt;                             	{ bits in bit buffer }
   p: _pBytef;                          	{ input data pointer }
   n: _uInt;                             	{ bytes available there }
   q: _pBytef;                          	{ output window write pointer }
   m: _uInt;                             	{ bytes to end of window or read pointer }
   ml: _uInt;                            	{ mask for literal/length tree }
   md: _uInt;                           	{ mask for distance tree }
   // C must be an integer... see notes for TZipKey in this function.
   C: Integer; //_uInt;                  	{ bytes to copy }
   d: _uInt;                             	{ distance back to copy from }
   R: _pBytef;                          	{ copy source pointer }

   Procedure NeedBits(j: _uInt);
   Begin
      While (k < j) Do
      Begin
         Dec(n);
         b := b Or (u_long(p^) Shl k);
         inc(p);
         inc(k, 8);
      End;
   End;

   Procedure DUMPBITS(n: Byte);
   Begin
      b := b Shr n;
      k := k - n;
   End;

   Procedure Update;
   Begin
   	//UPDBITS();
   	s.bitb := b;
      s.bitk := k;

      //UPDIN();
      z.avail_in := n;
      inc(z.total_in, ptr2int(p) - ptr2int(z.next_in));
      z.next_in := p;

      //UPDOUT();
   	s.write := q;
   End;

   //define UNGRAB //n+=(c=k>>3);p-=c;k&=7;
   Procedure UNGRAB;
   Begin
   	C := z.avail_in - n;
   	If (k Shr 3) < C Then
      	C := k Shr 3;
   	//C := k Shr 3;

      If C > 0 Then
      Begin
      	Inc(n, C);
      	Dec(p, C);
      	Dec(k, C Shl 3);
      	//k := k And 7;
      End;
   End;
Begin

   { load input, output, bit values (macro LOAD) }
   p := z.next_in;
   n := z.avail_in;
   b := s.bitb;
   k := s.bitk;
   q := s.Write;

   If ptr2int(q) < ptr2int(s.Read) Then
      m := _uInt(ptr2int(s.Read) - ptr2int(q) - 1)
   Else
      m := _uInt(ptr2int(s.zend) - ptr2int(q));

   { initialize masks }
   ml := inflate_mask[bl];
   md := inflate_mask[bd];

   { do until not enough input or output space for fast loop }
   Repeat                               { assume called with (m >= 258) and (n >= 10) }
      { get literal/length code }
{.$ifndef LocalDef64}
    	NeedBits(20);                // max bits for literal/length code
{.$else}
//    	NeedBits(bl);                // max bits for literal/length code
{.$endif}
      t := @(huft_ptr(tl)^[_uInt(b) And ml]);
      e := t^.e;

      If (e = 0) Then
      Begin
         DumpBits(t^.b);
         q^ := Byte(t^.v_n);
         inc(q);
         Dec(m);
         Continue;
      End;

      Repeat
      	DUMPBITS(t^.b);

{.$ifndef LocalDef64}
         If (e And 16 <> 0) Then
{.$else}
//         If (e And 32 <> 0) Then
{.$endif}
         Begin
            { get extra bits for length }
{.$ifndef LocalDef64}
            e := e And 15;
{.else}
//            e := e And 31;
{.$endif}
            C := t^.v_n + (_uInt(b) And inflate_mask[e]);

            DumpBits(e);
            { decode distance base of block to copy }
            NeedBits(15);

            t := @huft_ptr(td)^[_uInt(b) And md];
            e := t^.e;

            Repeat
            	DumpBits(t^.b);

               If (e And 16 <> 0) Then
               Begin

                  { get extra bits to add to distance base }
                  e := e And 15;
            		NeedBits(e);         // get extra bits (up to 13)

                  d := t^.v_n + (_uInt(b) And inflate_mask[e]);
            		DUMPBITS(e);

                  { do the copy }
                  Dec(m, C);
                  If (_uInt(ptr2int(q) - ptr2int(s.window)) >= d) Then { offset before dest }
                  Begin                 {  just copy }
                     R := q;
                     Dec(R, d);
                     q^ := R^; inc(q); inc(R); Dec(C); // minimum count is three,
                     q^ := R^; inc(q); inc(R); Dec(C); // so unroll loop a little
                  End Else Begin			 // else offset after destination
                     e := d - _uInt(ptr2int(q) - ptr2int(s.window)); { bytes from offset to end }
                     R := s.zend;
                     Dec(R, e);         { pointer to offset }
                     If (C > e) Then    { if source crosses, }
                     Begin
                        Dec(C, e);      { copy to end of window }
                        Repeat
                           q^ := R^;
                           inc(q);
                           inc(R);
                           Dec(e);
                        Until (e = 0);
                        R := s.window;  { copy rest from start of window }
                     End;
                  End;

                  Repeat                { copy all or what's left }
                     q^ := R^;
                     inc(q);
                     inc(R);
                     Dec(C);
                  //Until (C = 0);
                  Until (C <= 0);		// v6.4.3 - TZipKey brute force method causes c to be less than 0 at times.

                  break;
               End Else
                  If (e And 64 = 0) Then
                  Begin
                     inc(t, t^.v_n + (_uInt(b) And inflate_mask[e]));
                     e := t^.e;
                  End Else Begin
                  	//invalid distance code
                     UNGRAB();
                     UPDATE();
                     Result := Z_DATA_ERROR;
                     Exit;