ztvinflate64.pas

ziptv为delphi控件

                  Inc(w, e);
                  Inc(d, e);
               End
               Else
                  Repeat
                     Slide[w] := Slide[d];
                     Inc(w);
                     Inc(d);
                     dec(e);
                  Until e = 0;

            If w = WSIZE Then
            Begin
               If Not Flush(w) Then
               Begin
                  Result := unzip_WriteErr;
                  exit
               End;
               w := 0; u := 0;
            End;
         Until n = 0;
      End;
   End;

   If pCancel^ Then
      Result := unzip_UserAbort
   Else
      If Not Flush(w) Then
         Result := unzip_WriteErr
      Else
         If zipEOF Then
            Result := unzip_ReadErr
         Else
            Result := unzip_Ok;
End;
//-------------------------------------------------------------

Function explode_nolit8(tl, td: phuftlist; bl, bd: Integer): Integer;
Var
   s: Longint;
   e: Word;
   n, d: Word;
   w: Word;
   t: phuft;
   ml, md: Word;
   u: Word;

Begin
   b := 0; k := 0; w := 0;
   u := 1;
   ml := mask_bits[bl];
   md := mask_bits[bd];
   s := InflateRec.UnpackedSize;
   While (s > 0) And Not (pCancel^ Or zipEOF) Do
   Begin
      NeedBits(1);
      If (b And 1) <> 0 Then
      Begin                             {Literal}
         DumpBits(1);
         dec(s);
         NeedBits(8);
         Slide[w] := Char(b);
         Inc(w);
         If w = WSIZE Then
         Begin
            If Not Flush(w) Then
            Begin
               Result := unzip_WriteErr;
               exit
            End;
            w := 0; u := 0;
         End;
         DumpBits(8);
      End
      Else
      Begin
         DumpBits(1);
         NeedBits(7);
         d := b And $7F;
         DumpBits(7);
         NeedBits(bd);
         t := @td^[(Not b) And md];
         e := t^.e;
         If e > 16 Then
            Repeat
               If e = 99 Then
               Begin
                  Result := unzip_ZipFileErr;
                  exit
               End;
               DumpBits(t^.b);
               dec(e, 16);
               NeedBits(e);
               t := @t^.v_t^[(Not b) And mask_bits[e]];
               e := t^.e;
            Until e <= 16;
         DumpBits(t^.b);

         d := w - d - t^.v_n;
         NeedBits(bl);
         t := @tl^[(Not b) And ml];
         e := t^.e;
         If e > 16 Then
            Repeat
               If e = 99 Then
               Begin
                  Result := unzip_ZipFileErr;
                  exit
               End;
               DumpBits(t^.b);
               dec(e, 16);
               NeedBits(e);
               t := @t^.v_t^[(Not b) And mask_bits[e]];
               e := t^.e;
            Until e <= 16;

         DumpBits(t^.b);

         n := t^.v_n;
         If e <> 0 Then
         Begin
            NeedBits(8);
            Inc(n, b And $FF);
            DumpBits(8);
         End;
         dec(s, n);
         Repeat
            d := d And pred(WSIZE);
            If d > w Then
               e := WSIZE - d
            Else
               e := WSIZE - w;
            If e > n Then
               e := n;
            dec(n, e);
            If (u <> 0) And (w <= d) Then
            Begin
               FillChar(Slide[w], e, #0);
               Inc(w, e);
               Inc(d, e);
            End
            Else
               If (w - d >= e) Then
               Begin
                  Move(Slide[d], Slide[w], e);
                  Inc(w, e);
                  Inc(d, e);
               End
               Else
                  Repeat
                     Slide[w] := Slide[d];
                     Inc(w);
                     Inc(d);
                     dec(e);
                  Until e = 0;

            If w = WSIZE Then
            Begin
               If Not Flush(w) Then
               Begin
                  Result := unzip_WriteErr;
                  exit
               End;
               w := 0; u := 0;
            End;
         Until n = 0;
      End;
   End;
   
   If pCancel^ Then
      Result := unzip_UserAbort
   Else
      If Not Flush(w) Then
         Result := unzip_WriteErr
      Else
         If zipEOF Then
            Result := unzip_ReadErr
         Else
            Result := unzip_Ok;
End;
//-------------------------------------------------------------

Function explode_nolit4(tl, td: phuftlist; bl, bd: Integer): Integer;
Var
   s: Longint;
   e: Word;
   n, d: Word;
   w: Word;
   t: phuft;
   ml, md: Word;
   u: Word;

Begin
   b := 0; k := 0; w := 0;
   u := 1;
   ml := mask_bits[bl];
   md := mask_bits[bd];
   s := InflateRec.UnpackedSize;
   While (s > 0) And Not (pCancel^ Or zipEOF) Do
   Begin
      NeedBits(1);
      If (b And 1) <> 0 Then
      Begin                             {Literal}
         DumpBits(1);
         dec(s);
         NeedBits(8);
         Slide[w] := Char(b);
         Inc(w);

         If w = WSIZE Then
         Begin
            If Not Flush(w) Then
            Begin
               Result := unzip_WriteErr;
               exit
            End;
            w := 0; u := 0;
         End;
         DumpBits(8);
      End
      Else
      Begin
         DumpBits(1);
         NeedBits(6);
         d := b And $3F;
         DumpBits(6);
         NeedBits(bd);
         t := @td^[(Not b) And md];
         e := t^.e;
         If e > 16 Then
            Repeat
               If e = 99 Then
               Begin
                  Result := unzip_ZipFileErr;
                  exit
               End;
               DumpBits(t^.b);
               dec(e, 16);
               NeedBits(e);
               t := @t^.v_t^[(Not b) And mask_bits[e]];
               e := t^.e;
            Until e <= 16;
         DumpBits(t^.b);
         d := w - d - t^.v_n;
         NeedBits(bl);
         t := @tl^[(Not b) And ml];
         e := t^.e;
         If e > 16 Then
            Repeat
               If e = 99 Then
               Begin
                  Result := unzip_ZipFileErr;
                  exit
               End;
               DumpBits(t^.b);
               dec(e, 16);
               NeedBits(e);
               t := @t^.v_t^[(Not b) And mask_bits[e]];
               e := t^.e;
            Until e <= 16;

         DumpBits(t^.b);
         n := t^.v_n;
         If e <> 0 Then
         Begin
            NeedBits(8);
            Inc(n, b And $FF);
            DumpBits(8);
         End;
         dec(s, n);
         Repeat
            d := d And pred(WSIZE);
            If d > w Then
               e := WSIZE - d
            Else
               e := WSIZE - w;
            If e > n Then
               e := n;
            dec(n, e);
            If (u <> 0) And (w <= d) Then
            Begin
               FillChar(Slide[w], e, #0);
               Inc(w, e);
               Inc(d, e);
            End
            Else
               If (w - d >= e) Then
               Begin
                  Move(Slide[d], Slide[w], e);
                  Inc(w, e);
                  Inc(d, e);
               End
               Else
                  Repeat
                     Slide[w] := Slide[d];
                     Inc(w);
                     Inc(d);
                     dec(e);
                  Until e = 0;

            If w = WSIZE Then
            Begin
               If Not Flush(w) Then
               Begin
                  Result := unzip_WriteErr;
                  exit
               End;
               w := 0; u := 0;
            End;
         Until n = 0;
      End;
   End;

   If pCancel^ Then
      Result := unzip_UserAbort
   Else
      If Not Flush(w) Then
         Result := unzip_WriteErr
      Else
         If zipEOF Then
            Result := unzip_ReadErr
         Else
            Result := unzip_Ok;
End;
//-------------------------------------------------------------

Function Explode(Inf: TStream32; Var Outf: TStream32;
   IR: TInflateRec; ABIT: Byte; InflateProc: TInflateProc): Boolean;

   Function _Explode: Integer;
   Var
      r: Integer;
      tb, tl, td: phuftlist;
      bb, bl, bd: Integer;
      l: Array[0..255] Of Word;
   Begin
      Inpos := 0;
      ReadPos := -1;                    {Nothing read in}
      ReachedSize := 0;
      zipEOF := False;

      bl := 7;
      If InflateRec.PackedSize > 200000 Then
         bd := 8
      Else
         bd := 7;

      If hufttype And 4 <> 0 Then
      Begin
         bb := 9;

         r := GetTree(@l[0], 256);
         If r <> 0 Then
         Begin
            Result := unzip_ZipFileErr;
            exit
         End;

         r := huft_build(pWord(@l), 256, 256, Nil, Nil, pphuft(@tb), bb);
         If r <> 0 Then
         Begin
            If r = huft_incomplete Then
               huft_free(tb);
            Result := unzip_ZipFileErr;
            exit
         End;

         r := GetTree(@l[0], 64);
         If r <> 0 Then
         Begin
            huft_free(tb);
            Result := unzip_ZipFileErr;
            exit
         End;

         r := huft_build(pWord(@l), 64, 0, PushList(@cplen3), PushList(@extra),
            pphuft(@tl), bl);
         If r <> 0 Then
         Begin
            If r = huft_incomplete Then
               huft_free(tl);
            huft_free(tb);
            Result := unzip_ZipFileErr;
            exit
         End;

         r := GetTree(@l[0], 64);
         If r <> 0 Then
         Begin
            huft_free(tb);
            huft_free(tl);
            Result := unzip_ZipFileErr;
            exit
         End;

         If hufttype And 2 <> 0 Then
         Begin                          {8k}
            r := huft_build(pWord(@l), 64, 0, PushList(@cpdist8), PushList(@extra),
               pphuft(@td), bd);
            If r <> 0 Then
            Begin
               If r = huft_incomplete Then
                  huft_free(td);
               huft_free(tb);
               huft_free(tl);
               Result := unzip_ZipFileErr;
               exit
            End;
            r := explode_lit8(tb, tl, td, bb, bl, bd);
         End
         Else
         Begin
            r := huft_build(pWord(@l), 64, 0, PushList(@cpdist4), PushList(@extra),
               pphuft(@td), bd);
            If r <> 0 Then
            Begin
               If r = huft_incomplete Then
                  huft_free(td);
               huft_free(tb);
               huft_free(tl);
               Result := unzip_ZipFileErr;
               exit
            End;
            r := explode_lit4(tb, tl, td, bb, bl, bd);
         End;
         huft_free(td);
         huft_free(tl);
         huft_free(tb);
      End
      Else
      Begin                             {No literal tree}

         r := GetTree(@l[0], 64);
         If r <> 0 Then
         Begin
            Result := unzip_ZipFileErr;
            exit
         End;

         r := huft_build(pWord(@l), 64, 0, PushList(@cplen2), PushList(@extra),
            pphuft(@tl), bl);
         If r <> 0 Then
         Begin
            If r = huft_incomplete Then
               huft_free(tl);
            Result := unzip_ZipFileErr;
            exit
         End;

         r := GetTree(@l[0], 64);
         If r <> 0 Then
         Begin
            huft_free(tl);
            Result := unzip_ZipFileErr;
            exit
         End;

         If hufttype And 2 <> 0 Then
         Begin                          {8k}
            r := huft_build(pWord(@l), 64, 0, PushList(@cpdist8), PushList(@extra),
               pphuft(@td), bd);
            If r <> 0 Then
            Begin
               If r = huft_incomplete Then
                  huft_free(td);
               huft_free(tl);
               Result := unzip_ZipFileErr;
               exit
            End;
            r := explode_nolit8(tl, td, bl, bd);
         End
         Else
         Begin
            r := huft_build(pWord(@l), 64, 0, PushList(@cpdist4), PushList(@extra),
               pphuft(@td), bd);
            If r <> 0 Then
            Begin
               If r = huft_incomplete Then
                  huft_free(td);
               huft_free(tl);
               Result := unzip_ZipFileErr;
               exit
            End;
            r := explode_nolit4(tl, td, bl, bd);
         End;
         huft_free(td);
         huft_free(tl);
      End;
      Result := r;
   End;

Begin
   WSIZE := 32768;
   Infile := Inf;
   Outfile := Outf;
	AdditionalBitsInTable := ABIT;

   ReadProc := InflateProc.RB;
   WriteProc := InflateProc.WB;
   ProgressProc := InflateProc.PP;
   pProgressPos := InflateProc.pProgressPos;
   pCancel := InflateProc.pCancel;

   InflateRec := IR;
	HuftType := InflateRec.BitFlag;
   Bytes_To_Go := InflateRec.UnpackedSize;

   GetMem(Slide, WSIZE);
   Try
      Result := _Explode() > 0;
   Finally
      FreeMem(Slide, WSIZE);
   End;
End;
//-------------------------------------------------------------
//-------------------------------------------------------------
//
// Explode()  ...end
//
//-------------------------------------------------------------
//-------------------------------------------------------------


End.