ztvinflate64.pas

ziptv为delphi控件

// decompress
(**********************************************************************

 Copyright 1998-2003,  Microchip Data Systems / Carl Bunton

  Under license agreement, this source module may be used only on a
  single computer.

  No partion of this module may be reproduced, copied, revised, edited,
  distributed or transmited via electronic means except in compiled
  application format.

  Web-site:  http://www.ziptv.com
  Email:     [e-mail]

**********************************************************************)
Unit ztvInflate64;

Interface

Uses
   Windows,
   Classes,
   SysUtils,
   ztvBase,
   ztvStreams,
   ztvConsts;

{$I ZipTV.Inc}
{$DEFINE PKZIP_BUG_WORKAROUND}
{.$DEFINE ASMBLER}

Type
   TInflateProc = Packed Record
      RB: TReadBlock;
      WB: TWriteBlock;
      PP: TProgress;
      pProgressPos: pWord64;
      pCancel: pBoolean;
   End;

   //pWindowOffset = ^WindowOffset;
   //WindowOffset = Packed Record
   //   zWindow: Pointer;
   //   zEnd: Pointer;
   //   p: Pointer;
   //End;
   //
   //Var
   //	WindowPtr: pWindowOffset;

Var
   InflateProc: TInflateProc;

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

Implementation

Uses
   Dialogs,
   ztvGbls,
   Err_Msgs;

Const
   InvalidCode = 99;
   NonSimpleLookup = 0;
   {$ifndef Def64}
   EndOfBlock = 15;
   ValidCode = 16;
   {$else}
   EndOfBlock = 31;
   ValidCode = 32;
   {$endif}

Const
   Border: Array[0..18] Of Byte =       { Order of the bit length code lengths }
   (16, 17, 18, 0, 8, 7, 9, 6, 10, 5, 11, 4, 12, 3, 13, 2, 14, 1, 15);

   (* Tables for deflate from PKZIP's appnote.txt. *)
   cplens64: Array[0..30] Of Word =     //Def64
   	(3, 4, 5, 6, 7, 8, 9, 10, 11, 13, 15, 17, 19, 23, 27, 31,
      35, 43, 51, 59, 67, 83, 99, 115, 131, 163, 195, 227, 3, 0, 0);
   cplens: Array[0..30] Of Word =       (* Copy lengths for literal codes 257..285 *)
   	(3, 4, 5, 6, 7, 8, 9, 10, 11, 13, 15, 17, 19, 23, 27, 31,
      35, 43, 51, 59, 67, 83, 99, 115, 131, 163, 195, 227, 258, 0, 0);

   (* note: see note #13 above about the 258 in this list. *)
   cpdist64: Array[0..31] Of Word = //Def64    { Copy offsets for distance codes 0..31 }
   (1, 2, 3, 4, 5, 7, 9, 13, 17, 25, 33, 49, 65, 97, 129, 193, 257,
      385, 513, 769, 1025, 1537, 2049, 3073, 4097, 6145, 8193, 12289,
      16385, 24577, 32769, 49153);
   cpdist: Array[0..29] Of Word =       (* Copy offsets for distance codes 0..29 *)
   (1, 2, 3, 4, 5, 7, 9, 13, 17, 25, 33, 49, 65, 97, 129, 193, 257,
      385, 513, 769, 1025, 1537, 2049, 3073, 4097, 6145, 8193, 12289,
      16385, 24577);

   cplext64: Array[0..30] Of Word {Byte} = //Def64
   (0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 2, 2, 2, 2,
      3, 3, 3, 3, 4, 4, 4, 4, 5, 5, 5, 5, 16, InvalidCode, InvalidCode);
   cplext: Array[0..30] Of Word {Byte} = (* Extra bits for literal codes 257..285 *)
   (0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 2, 2, 2, 2,
      3, 3, 3, 3, 4, 4, 4, 4, 5, 5, 5, 5, 0, InvalidCode, InvalidCode);

   cpdext64: Array[0..31] Of Word {Byte} = //Def64    { Extra bits for distance codes }
   (0, 0, 0, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 5, 6, 6,
      7, 7, 8, 8, 9, 9, 10, 10, 11, 11, 12, 12, 13, 13,
      14, 14);
   cpdext: Array[0..29] Of Word {Byte} = (* Extra bits for distance codes *)
   (0, 0, 0, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 5, 6, 6,
      7, 7, 8, 8, 9, 9, 10, 10, 11, 11, 12, 12, 13, 13);

   {b and mask_bits[i] gets lower i bits out of i}
   mask_bits: Array[0..16] Of Word =
      ($0000, $0001, $0003, $0007, $000F, $001F, $003F, $007F,
      $00FF, $01FF, $03FF, $07FF, $0FFF, $1FFF, $3FFF, $7FFF,
      $FFFF);

Var
   ReadProc: TReadBlock;
   WriteProc: TWriteBlock;
   ProgressProc: TProgress;
   pProgressPos: pWord64;
   pCancel: pBoolean;
   Bytes_To_Go: Int64;

   Infile: TStream32;
   Outfile: TStream32;
   InflateRec: TInflateRec;

   hufttype: Word;     // explode
   AdditionalBitsInTable: Byte;

Const                                   {codes returned by huft_build}
   huft_complete = 0;                   {complete tree}
   huft_incomplete = 1;                 {incomplete tree <- sufficient in some cases!}
   huft_error = 2;                      {bad tree constructed}
   huft_outofmem = 3;                   {not enough memory}

Const
   unzip_Ok = 0;
   unzip_WriteErr = -2;
   unzip_ReadErr = -3;
   unzip_ZipFileErr = -4;
   unzip_UserAbort = -5;

Const
   MaxMax = 31 * 1024;
   INBUFSIZ = 32768; //High(Word); //1024 * 4;   {Size of input buffer (4kb) }
   lbits: Integer = 9;
   dbits: Integer = 6;
   b_max = 16;
   n_max = 288;
   BMAX = 16;

Type
   PushList = ^ushlist;
   ushlist = Array[0..MaxMax] Of ush;   {only pseudo-size!!}
   PioBuf = ^Iobuf;
   Iobuf = Array[0..INBUFSIZ - 1] Of Byte;

Type
   pphuft = ^phuft;
   phuft = ^huft;
   phuftlist = ^HuftList;
   huft = Record
      e{exop},                        	 { number of extra bits or operation 				}
      b{bits}: Byte;                    { number of bits in this code or subcode 		}
      //pad : uInt;                     { pad structure to a power of 2 (4 bytes for 	}
                                        { 16-bit, 8 bytes for 32-bit int's) 				}
      v_n{base}: ush;						 { literal, length base, or distance base 		}
      v_t: phuftlist;                   { Linked List 											}
   End;
   HuftList = Array[0..SizeOf(Huft) * 1024{8190}] Of huft;

Var
   WSIZE: Integer;
   Slide: PChar;                        { sliding dictionary for unzipping					}
   Inbuf: Iobuf;                        { input buffer											}
   Inpos,
   	ReadPos: Integer;                 { position in input buffer, position read from file}
   w: Integer; //Word; Def64            { current position in slide							}
   b: Longint;                          { bit buffer												}
   k: Byte;                             { bits in bit buffer									}
   ReachedSize: Int64;                  { number of bytes read from zipfile				}
   zipEOF: Boolean;                     { read over end of zip section for this file	}

//-------------------------------------------------------------

Procedure huft_free(t: phuftlist);
Var
   p, q: phuftlist;
   z: Integer;
Begin
   p := Pointer(t);
   While p <> Nil Do
   Begin
      dec(Longint(p), SizeOf(huft));
      q := p^[0].v_t;
      z := p^[0].v_n;                   { size in bytes, required by TP }
      FreeMem(p, (z + 1) * SizeOf(huft));
      p := q
   End;
End;
//-------------------------------------------------------------

Procedure DumpBits(n: Byte);
Begin
   {$ifndef asmbler}
   b := b Shr n;
   k := k - n;
   {$else}
   Asm
      mov cl, n
      mov ax, li.lo ( b )
      mov dx, li.hi ( b )

      mov ch, cl
      OR ch, ch
      jz @finished
      @rotate :
      SHR dx, 1           					 {Lower Bit in Carry}
      rcr ax, 1
      Dec ch
      jnz @rotate
      @finished :
      mov li.lo ( b ), ax
      mov li.hi ( b ), dx
      sub k, cl
   End;
   {$endif}
End;
//-------------------------------------------------------------

//Flush w bytes directly from slide to file
Function Flush(w: Word32): Boolean;
Var
   n: Integer;
   ProgressByFile,
      ProgressByArchive: Byte;
Begin
   dec(InflateProc.pProgressPos^, w);
   dec(Bytes_To_Go, w);

   n := WriteProc(Outfile, Slide[0], False, 32, w, dtData);
   Result := (Word32(n) = w);

   Try
      ProgressByFile :=
         ztvGbls.CalcProgress64(
         InflateRec.UnpackedSize - Bytes_To_Go,
         InflateRec.UnpackedSize);

      ProgressByArchive :=
         ztvGbls.CalcProgress64(
         InflateRec.TotalArchiveSize - pProgressPos^,
         InflateRec.TotalArchiveSize);

      ProgressProc(ProgressByFile, ProgressByArchive);
   Except
      //On e: exception Do ShowMessage( e.message )
   End;
End;
//-------------------------------------------------------------

Procedure ReadBuf;
Begin
   If ReachedSize > InflateRec.PackedSize + 2 Then
   Begin                                {+2: last code is smaller than requested!}
      ReadPos := SizeOf(Inbuf);         {Simulates reading -> no blocking}
      zipEOF := True
   End
   Else
   Begin
      If InflateRec.PackedSize - ReachedSize < INBUFSIZ Then
         ReadPos := ReadProc(Infile, Nil, Inbuf, (InflateRec.BitFlag And 1) = 1,
            0, InflateRec.PackedSize - ReachedSize, dtData)
      Else
         ReadPos := ReadProc(Infile, Nil, Inbuf, (InflateRec.BitFlag And 1) = 1,
            0, INBUFSIZ, dtData);

      If (ReadPos = 0) Then
      Begin                             {readpos=0: kein Fehler gemeldet!!!}
         ReadPos := SizeOf(Inbuf);      {Simulates reading -> CRC error}
         zipEOF := True;
      End;

      Inc(ReachedSize, ReadPos);
      dec(ReadPos);                     {Reason: index of inbuf starts at 0}
   End;
   Inpos := 0;
End;
//-------------------------------------------------------------

Procedure NeedBits(n: Byte);
Var
   nb: Longint;
Begin
   {$ifndef asmbler}
   While k < n Do
   Begin
      If Inpos > ReadPos Then
         ReadBuf();
      nb := Inbuf[Inpos];
      Inc(Inpos);
      b := b Or nb Shl k;
      Inc(k, 8);
   End;
   {$else}
   Asm
    mov si, offset inbuf
    mov ch, n
    mov cl, k
    mov bx, inpos    {bx=inpos}
@again :
    cmp cl, ch
    JAE @finished   {k>=n -> finished}
    cmp bx, readpos
    jg @readbuf
@fullbuf :
    mov al, [ si + bx ]  {dx:ax=nb}
    XOR ah, ah
    XOR dx, dx
    cmp cl, 8      {cl>=8 -> shift into DX or directly by 1 byte}
    JAE @bigger8
    SHL ax, cl     {normal shifting!}
    jmp @continue
@bigger8 :
    mov di, cx     {save cx}
    mov ah, al     {shift by 8}
    XOR al, al
    sub cl, 8      {8 bits shifted}
@rotate :
    OR cl, cl
    jz @continue1  {all shifted -> finished}
    SHL ah, 1      {al ist empty!}
    rcl dx, 1
    Dec cl
    jmp @rotate
@continue1 :
    mov cx, di
@continue :
    OR li.hi ( b ), dx {b=b or nb shl k}
    OR li.lo ( b ), ax
    inc bx         {inpos}
    add cl, 8      {inc k by 8 Bits}
    jmp @again

@readbuf :
    push si
    push cx
    call readbuf   {readbuf not critical, called only every 2000 bytes}
    pop cx
    pop si
    mov bx, inpos  {new inpos}
    jmp @fullbuf

@finished :
    mov k, cl
    mov inpos, bx
   End;
   {$endif}
End;
//-------------------------------------------------------------

Function huft_build(b: pWord; n: Word; s: Word; d, e: PushList; t: pphuft; Var m:
   Integer): Integer;
Var
   a: Word;                             { counter for codes of length k }
   c: Array[0..b_max + 1] Of Word;      { bit length count table }
   f: Word;                             { i repeats in table every f entries }
   g,                                   { max. code length }
   h: Integer;                          { table level }
   i: Word;                             { counter, current code }
   j: Word;                             { counter }
   k: Integer;                          { number of bits in current code }
   p: pWord;                            { pointer into c, b and v }
   q: phuftlist;                        { points to current table }
   r: huft;                             { table entry for structure assignment }
   u: Array[0..b_max] Of phuftlist;     { table stack }
   v: Array[0..n_max] Of Word;          { values in order of bit length }
   w: Integer;                          { bits before this table }
   x: Array[0..b_max + 1] Of Word;      { bit offsets, then code stack }
   l: Array[-1..b_max + 1] Of Word;     { l[h] bits in table of level h }
   xp: pWord;                           { pointer into x }
   y: Integer;                          { number of dummy codes added }
   z: Word;                             { number of entries in current table }
   TryAgain: Boolean;                   { boolean for loop }
   pt: phuft;                           { for test against bad input }
   el: Word;                            { length of eob code=code 256 }
Begin
   If n > 256 Then
      el := pWord(Longint(b) + 256 * SizeOf(Word))^
   Else
      el := BMAX;

   {generate counts for each bit length}
   FillChar(c, SizeOf(c), #0);
   p := b;
   i := n;                              {p points to array of word}

   Repeat
      If p^ > b_max Then
      Begin
         t^ := Nil;
         m := 0;
         Result := huft_error;
         exit
      End;
      Inc(c[p^]);
      Inc(Longint(p), SizeOf(Word));    {point to next item}
      dec(i);
   Until i = 0;

   If c[0] = n Then
   Begin
      t^ := Nil;
      m := 0;
      Result := huft_complete;
      exit
   End;

   {find minimum and maximum length, bound m by those}
   j := 1;
   While (j <= b_max) And (c[j] = 0) Do
      Inc(j);

   k := j;

   If m < j Then
      m := j;

   i := b_max;
   While (i > 0) And (c[i] = 0) Do
      dec(i);

   g := i;

   If m > i Then
      m := i;

   {adjust last length count to fill out codes, if needed}
   y := 1 Shl j;
   While j < i Do
   Begin
      y := y - c[j];
      If y < 0 Then
      Begin
         Result := huft_error;
         exit
      End;
      y := y Shl 1;
      Inc(j);
   End;

   dec(y, c[i]);
   If y < 0 Then
   Begin
      Result := huft_error;
      exit
   End;

   Inc(c[i], y);

   {generate starting offsets into the value table for each length}
   x[1] := 0;
   j := 0;
   p := pWord(@c);
   Inc(Longint(p), SizeOf(Word));
   xp := pWord(@x);
   Inc(Longint(xp), 2 * SizeOf(Word));
   dec(i);

   While i <> 0 Do
   Begin
      Inc(j, p^);
      xp^ := j;
      Inc(Longint(p), 2);
      Inc(Longint(xp), 2);
      dec(i);
   End;

   {make table of values in order of bit length}
   p := b;
   i := 0;
   Repeat
      j := p^;
      Inc(Longint(p), SizeOf(Word));
      If j <> 0 Then
      Begin
         v[x[j]] := i;
         Inc(x[j]);
      End;
      Inc(i);
   Until i >= n;

   {generate huffman codes and for each, make the table entries}
   x[0] := 0; i := 0;
   p := pWord(@v);
   h := -1;
   l[-1] := 0;
   w := 0;
   u[0] := Nil;
   q := Nil;
   z := 0;

   {go through the bit lengths (k already is bits in shortest code)}
   For k := k To g Do
   Begin
      For a := c[k] Downto 1 Do
      Begin
         {here i is the huffman code of length k bits for value p^}
         While k > w + l[h] Do
         Begin
            Inc(w, l[h]);               {length of tables to this position}
            Inc(h);
            z := g - w;

            If z > m Then
               z := m;

            j := k - w;
            f := 1 Shl j;