kpexpld.pas

一个delphi中压缩的组件VCLZip

    if (b and 1) <> 0 then                  { then literal--get eight bits }
     begin
      DUMPBITS(1,b,k);
      Dec(s);
      NEEDBITS(8,b,k);
	    slide^[w] := BYTE(b);
      Inc(w);
      if (w = WSIZE) then
       begin
        flushslide(w);
        w := 0;
        u := 0;
       end;
      DUMPBITS(8,b,k);
     end
    else                        { else distance/length }
     begin
      DUMPBITS(1,b,k);
      if which = 8 then
       begin
      	NEEDBITS(7,b,k);               { get distance low bits }
      	d := WORD(b) and $7f;
      	DUMPBITS(7,b,k);
       end
      else
       begin
      	NEEDBITS(6,b,k);               { get distance low bits }
      	d := WORD(b) and $3f;
      	DUMPBITS(6,b,k);
       end;
      NEEDBITS(WORD(bd),b,k);    { get coded distance high bits }
      t := td;
      Inc(t,(not(WORD(b))) and md);
      e := t^.e;
      if (e > 16) then
        Repeat
          if (e = 99) then
           begin
            Result := 1;
            exit;
           end;
          DUMPBITS(t^.b,b,k);
          Dec(e,16);
          NEEDBITS(e,b,k);
          t := t^.v.t;
          Inc(t,(not(WORD(b))) and mask_bits[e]);
          e := t^.e;
        Until e <= 16; 
      DUMPBITS(t^.b,b,k);
      d := w - d - t^.v.n;       { construct offset }
      NEEDBITS(WORD(bl),b,k);    { get coded length }
      t := tl;
      Inc(t,(not(WORD(b))) and ml);
      e := t^.e;
      if (e > 16) then
        Repeat
          if (e = 99) then
           begin
            Result := 1;
            exit;
           end;
          DUMPBITS(t^.b,b,k);
          Dec(e,16);
          NEEDBITS(e,b,k);
          t := t^.v.t;
          Inc(t,(not(WORD(b))) and mask_bits[e]);
          e := t^.e;
        Until e <= 16; 
      DUMPBITS(t^.b,b,k);
      n := t^.v.n;
      if (e <> 0) then                    { get length extra bits }
       begin
        NEEDBITS(8,b,k);
        Inc(n,WORD(b) and $ff);
        DUMPBITS(8,b,k);
       end;

      { do the copy }
      Dec(s,n);
      Repeat
      	d := d and (WSIZE-1);
        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
         	ZeroMemory( @(slide^[w]), e );
          Inc(w,e);
          Inc(d,e);
         end
        else
          if (w - d >= e) then      { (this test assumes unsigned short_int comparison) }
           begin
            MoveMemory(@(slide^[w]), @(slide^[d]), e);
            Inc(w,e);
            Inc(d,e);
           end
          else                  { do it slow to avoid memcpy() overlap }
            Repeat
              slide^[w] := slide^[d];
              Inc(w);
              Inc(d);
              Dec(e);
            Until e = 0;
        if (w = WSIZE) then
         begin
          flushslide(w);
          w := 0;
          u := 0;
         end;
      Until n = 0;
     end;
	 end;

  { flush out slide }
  flushslide(w);
  if csize = 0 then      { should have read csize bytes }
  	Result := 0
  else
  	Result := 5;
end;


{ Main Explode Procedure }
var
	r:		WORD;                  { return codes }
  tb:	huftptr;               { literal code table }
  tl:	huftptr;               { length code table }
  td:	huftptr;               { distance code table }
  bb:	short_int;                 { bits for tb }
  bl:	short_int;                 { bits for tl }
  bd:	short_int;                 { bits for td }
  l:		llarraytype; 			  { bit lengths for codes }

   { Tune base table sizes.  Note: I thought that to truly optimize speed,
     I would have to select different bl, bd, and bb values for different
     compressed file sizes.  I was suprised to find out the the values of
     7, 7, and 9 worked best over a very wide range of sizes, except that
     bd = 8 worked marginally better for large compressed sizes. }
begin
  bl := 7;
  if csize > 200000 then
  	bd := 8
  else
  	bd := 7;
  { With literal tree--minimum match length is 3 }
  hufts := 0;                    { initialze huft's malloc'ed }
  if (file_info.general_purpose_bit_flag and 4) <> 0 then
  begin
    bb := 9;                     { base table size for literals }
    r := get_tree(l, 256);
    if (r <> 0) then
     begin
{     	Result := r; }
        exit;
     end;
    r := huft_build(l, 256, 256, [0], [0], @tb, bb);
    if (r <> 0) then
     begin
      if (r = 1) then
        huft_free(tb);
{      Result := r; }
      exit;
     end;
    r := get_tree(l, 64);
    if (r <> 0) then
     begin
{     	Result := r; }
        exit;
     end;
    r := huft_build(l, 64, 0, cplen3, extra, @tl, bl);
    if (r <> 0) then
     begin
      if (r = 1) then
        huft_free(tl);
      huft_free(tb);
{      Result := r; }
      exit;
     end;
    r := get_tree(l, 64);
    if (r <> 0) then
     begin
{      Result := r; }
      exit;
     end;
    if (file_info.general_purpose_bit_flag and 2) <> 0 then      { true if 8K }
     begin
      r := huft_build(l, 64, 0, cpdist8, extra, @td, bd);
      if (r <> 0) then
       begin
        if (r = 1) then
          huft_free(td);
        huft_free(tl);
        huft_free(tb);
{        Result := r; }
        exit;
       end;
      {r :=} explode_lit(8, tb, tl, td, bb, bl, bd);
     end
    else                                        { else 4K }
     begin
      r := huft_build(l, 64, 0, cpdist4, extra, @td, bd);
      if (r <> 0) then
       begin
        if (r = 1) then
          huft_free(td);
        huft_free(tl);
        huft_free(tb);
{        Result := r; }
        exit;
       end;
      {r :=} explode_lit(4, tb, tl, td, bb, bl, bd);
     end;
    huft_free(td);
    huft_free(tl);
    huft_free(tb);
   end
  else
  { No literal tree--minimum match length is 2 }
   begin
    r := get_tree(l, 64);
    if (r <> 0) then
     begin
{      Result := r; }
      exit;
     end;
    r := huft_build(l, 64, 0, cplen2, extra, @tl, bl);
    if (r <> 0) then
     begin
      if (r = 1) then
        huft_free(tl);
{      Result := r; }
      exit;
     end;
    r := get_tree(l, 64);
    if (r <> 0) then
     begin
{      Result := r; }
      exit;
     end;
    if (file_info.general_purpose_bit_flag and 2) <> 0 then     { true if 8K }
     begin
      r := huft_build(l, 64, 0, cpdist8, extra, @td, bd);
      if (r <> 0) then
       begin
        if (r = 1) then
          huft_free(td);
        huft_free(tl);
{        Result := r; }
        exit;
       end;
      {r :=} explode_nolit(8, tl, td, bl, bd);
     end
    else                                        { else 4K }
     begin
      r := huft_build(l, 64, 0, cpdist4, extra, @td, bd);
      if (r <> 0) then
       begin
        if (r = 1) then
          huft_free(td);
        huft_free(tl);
{        Result := r; }
        exit;
       end;
      {r :=} explode_nolit(4, tl, td, bl, bd);
     end;
    huft_free(td);
    huft_free(tl);
   end;
   xFlushOutput;
{  Result := r; }
end;