kpinflt.pas

delphi实现 webservice的例子.有服务端和客户段 利用xml交互.

      l := 0;
     end
    else                        { j == 18: 11 to 138 zero length codes }
     begin
      NEEDBITS(7,b,k);
      j := 11 + (b and $7f);
      DUMPBITS(7,b,k);
      if ((i + j) > n) then
       begin
        Result := 1;
        exit;
       end;
      while (j>0) do
       begin
        ll[i] := 0;
        Inc(i);
        Dec(j);
       end;
      l := 0;
     end;
   end;  { while (i < n) do }


  { free decoding table for trees }
  huft_free(tl);


  { restore the global bit buffer }
  bb := b;
  bk := k;


  { build the decoding tables for literal/length and distance codes }
  bl := lbits;
  i := huft_build(ll, nl, 257, cplens, cplext, @tl, bl);

  if (i <> 0) then
   begin
    if (i = 1) then
      huft_free(tl);
    Result := i;                   { incomplete code set }
    exit;
   end;
  bd := dbits;
  llptr := llarrayptr(@ll[nl]); { added typecast 5/18/98  2.13 }
  i := huft_build(llptr^, nd, 0, cpdist, cpdext, @td, bd);
  if (i <> 0) then
   begin
    if (i = 1) then
      huft_free(td);
    huft_free(tl);
    Result := i;                   { incomplete code set }
    exit;
   end;

  { decompress until an end-of-block code }
  if (inflate_codes(tl, td, bl, bd) <> 0) then
   begin
    Result := 1;
     huft_free(tl);
     huft_free(td);
    exit;
   end;

  huft_free(tl);
  huft_free(td);
  Result := 0;

except
  { free the decoding tables, return }
  on EUserCanceled do
   begin
     huft_free(tl);
     huft_free(td);
     raise;
   end
  else
   begin
     huft_free(tl);
     huft_free(td);
     Result := 1;
   end;
end;

end;

{****************************************************************************}
function inflate_stored: short_int;
var
	n:		WORD;           { number of bytes in block }
	w:		WORD;           { number of bytes in block }
	b:		U_LONG;        { bit buffer }
	k:		WORD;           { number of bits in bit buffer }
  tmp:	WORD;
begin

  { make local copies of globals }
  b := bb;                       { initialize bit buffer }
  k := bk;
  w := wp;                       { initialize window position }


  { go to byte boundary }
  n := k and 7;
  DUMPBITS(n,b,k);


  { get the length and its complement }
  NEEDBITS(16,b,k);
  n := (WORD(b) and $ffff);
  DUMPBITS(16,b,k);
  NEEDBITS(16,b,k);
  tmp := WORD(((not b) and ($ffff)));
  if (n <> tmp) then
   begin
    Result := 1;
    exit;
   end;                   { error in compressed data }
  DUMPBITS(16,b,k);


  { read and output the compressed data }
  while (n <> 0) do
   begin
    NEEDBITS(8,b,k);
    slide^[w] := b;
    Inc(w);
    if (w = WSIZE) then
     begin
      flushslide(w);
      w := 0;
     end;
    DUMPBITS(8,b,k);
    Dec(n);
   end;


  { restore the globals from the locals }
  wp := w;                       { restore global window pointer }
  bb := b;                       { restore global bit buffer }
  bk := k;
  Result := 0;


end;

{****************************************************************************}
function inflate_fixed: short_int;
var
  i:			short_int;                	{ temporary variable }
  tl:		huftptr;      				{ literal/length code table }
  td:		huftptr;      				{ distance code table }
  bl:		short_int;               	{ lookup bits for tl }
  bd:		short_int;               	{ lookup bits for td }
  l:			array[0..287] of WORD;	{ length list for huft_build }
{ decompress an inflated type 1 (fixed Huffman codes) block.  We should
   either replace this with a custom decoder, or at least precompute the
   Huffman tables. }
begin
  tl := nil;
  td := nil;
  { set up literal table }
  for i := 0 to 143 do
    l[i] := 8;
  for I := 144 to 255 do
    l[i] := 9;
  for i := 256 to 279 do
    l[i] := 7;
  for i := 280 to 287 do          { make a complete, but wrong code set }
    l[i] := 8;
  bl := 7;
try
  i := huft_build(l, 288, 257, cplens, cplext, @tl, bl);
  if ( i <> 0) then
   begin
    Result := i;
    exit;
   end;

  { set up distance table }
  for i := 0 to 29 do      { make an incomplete code set }
    l[i] := 5;
  bd := 5;
  i := huft_build(l, 30, 0, cpdist, cpdext, @td, bd);
  if (i > 1) then
   begin
    huft_free(tl);
    Result := i;
    exit;
   end;

  { decompress until an end-of-block code }
  if (inflate_codes(tl, td, bl, bd) <> 0) then
   begin
    Result := 1;
     huft_free(tl);
     huft_free(td);
    exit;
   end;

  { free the decoding tables, return }
  huft_free(tl);
  huft_free(td);
  Result := 0;

except
  on EUserCanceled do
   begin
     huft_free(tl);
     huft_free(td);
     raise;
   end
  else
   begin
     huft_free(tl);
     huft_free(td);
     Result := 1;
   end;
end;
end;


{****************************************************************************}
function inflate_block(var e:short_int): short_int;
var
  t: WORD;           { block type }
  b: U_LONG;     		{ bit buffer }
  k: WORD;  			{ number of bits in bit buffer }

begin
{e = last block flag }
{ decompress an inflated block }
{ make local bit buffer }
  b := bb;
  k := bk;

  { read in last block bit }
  NEEDBITS(1,b,k);
  e := b and 1;
  DUMPBITS(1,b,k);

  { read in block type }
  NEEDBITS(2,b,k);
  t := b and 3;
  DUMPBITS(2,b,k);

  { restore the global bit buffer }
  bb := b;
  bk := k;

try
  { inflate that block type }
  if (t = 2) then
  	Result := inflate_dynamic
  else if (t = 0) then
  	Result := inflate_stored
  else if (t = 1) then
  	Result := inflate_fixed
  else { bad block type }
  	Result := 2;
except
  on EUserCanceled do
     raise
  else
     Result := 1;
end;
end;

{*********************** main inflate procedure **********************}
var
  e: short_int;                	{ last block flag }
  h: WORD;       				{ maximum struct huft's malloc'ed }
begin
{ decompress an inflated entry }
  { initialize window, bit buffer }
  wp := 0;
  bk := 0;
  bb := 0;
  lbits := 9;
  dbits := 6;
  { decompress until the last block }
  h := 0;
  Repeat
    hufts := 0;
    if (inflate_block(e) <> 0) then
      exit;
    if (hufts > h) then
      h := hufts;
  Until(e <> 0);

  { flush out slide }
  flushslide(wp);
  xFlushOutput;
end;

{$ENDIF}

{   Sat 04 Jul 1998   16:23:24  Supervisor
{ Modified ULONG to U_LONG because of ULONG
{ definition in C++ Builder.
}
{
{   Mon 27 Apr 1998   17:26:16  Supervisor
{ Modified to get rid of some memory leak
}