rtczlib.pas

Delphi快速开发Web Server

  delta := (inSize + 255) and not 255;

  if outEstimate = 0 then outSize := delta
  else outSize := outEstimate;

  GetMem(outBuffer,outSize);

  try
    try
      zstream.next_in := inBuffer;
      zstream.avail_in := inSize;
      zstream.next_out := outBuffer;
      zstream.avail_out := outSize;

      while ZDecompressCheck(inflate(zstream,Z_NO_FLUSH)) <> Z_STREAM_END do
      begin
        Inc(outSize,delta);
        ReallocMem(outBuffer,outSize);

        zstream.next_out := PChar(Integer(outBuffer) + zstream.total_out);
        zstream.avail_out := delta;
      end;
    finally
      ZDecompressCheck(inflateEnd(zstream));
    end;

    ReallocMem(outBuffer,zstream.total_out);
    outSize := zstream.total_out;
  except
    FreeMem(outBuffer);
    raise;
  end;
end;

procedure ZCompress(const inBuffer: Pointer; inSize: Integer;
  out outBuffer: Pointer; out outSize: Integer;
  level: TZCompressionLevel);
var
  zstream: TZStreamRec;
begin
  FillChar(zstream,SizeOf(TZStreamRec),0);

  ZCompressCheck(DeflateInit(zstream,ZLevels[level]));

  ZInternalCompress(zstream,inBuffer,inSize,outBuffer,outSize);
end;

procedure ZDecompress(const inBuffer: Pointer; inSize: Integer;
  out outBuffer: Pointer; out outSize: Integer; outEstimate: Integer);
var
  zstream: TZStreamRec;
begin
  FillChar(zstream,SizeOf(TZStreamRec),0);

  ZDecompressCheck(InflateInit(zstream));

  ZInternalDecompress(zstream,inBuffer,inSize,outBuffer,outSize,outEstimate);
end;
}

{** string routines *********************************************************}

const
  delta=1024;

{$IFDEF zLibPool}
var
  CS:TRtcCritSec;
  pool:tPtrPool=nil;
  p_first,p_last:pointer;

function GetPoolBlock:pointer;
  begin
  CS.Enter;
  try
    Result:=pool.Get;
    if Result=nil then
      GetMem(Result, delta);
  finally
    CS.Leave;
    end;
  end;

procedure PutPoolBlock(p:pointer);
  begin
  CS.Enter;
  try
    if (longword(p)>=longword(p_first)) and (longword(p)<=longword(p_last)) then
      pool.Put(p)
    else
      FreeMem(p);
  finally
    CS.Leave;
    end;
  end;

procedure MakePoolBlocks;
  var
    a:integer;
  begin
  CS.Enter;
  try
    if assigned(pool) then Exit;

    pool:=tPtrPool.Create(8192);

    GetMem(p_first, delta*pool.size);
    p_last:=p_first;
    for a:=0 to pool.size-1 do
      begin
      pool.Put(p_last);
      p_last:=pointer(longint(p_last)+delta);
      end;
  finally
    CS.Leave;
    end;
  end;

procedure FreePoolBlocks;
  begin
  CS.Enter;
  try
    if assigned(pool) then
      begin
      FreeMem(p_first);
      pool.Free;
      pool:=nil;
      end;
  finally
    CS.Leave;
    end;
  end;

{$ELSE}

function GetPoolBlock:pointer;
  begin
  GetMem(Result, delta);
  end;

procedure PutPoolBlock(p:pointer);
  begin
  FreeMem(p);
  end;

procedure MakePoolBlocks;
  begin
  end;

{$ENDIF}

function ZCompress_Str(const inBuffer: String; level: TZCompressionLevel):string;
  var
    SL:array of pointer;
    loc,a,slcount:integer;
    zstream: TZStreamRec;
  begin
  FillChar(zstream, SizeOf(TZStreamRec), 0);

  MakePoolBlocks;

  Result:='';

  slcount:=0;
  SetLength(SL,32);
  try
    zstream.next_in := @inBuffer[1];
    zstream.avail_in := length(inBuffer);

    Inc(slcount);
    SL[slcount-1]:=GetPoolBlock;

    zstream.next_out := SL[slcount-1];
    zstream.avail_out := delta;

    ZCompressCheck(DeflateInit(zstream, ZLevels[level]));

    try
      while ZCompressCheck(deflate(zstream, Z_FINISH)) <> Z_STREAM_END do
      begin
        Inc(slcount);
        if slcount>length(SL) then
          SetLength(SL, length(SL)+32);
        SL[slcount-1]:=GetPoolBlock;

        zstream.next_out := SL[slcount-1];
        zstream.avail_out := delta;
      end;
    finally
      ZCompressCheck(deflateEnd(zstream));
    end;

    loc:=1;
    SetLength(Result, zstream.total_out);
    if slcount>0 then
      begin
      for a:=0 to slcount-2 do
        begin
        Move(SL[a]^,Result[loc],delta);
        Inc(loc,delta);
        end;
      Move(SL[slcount-1]^,Result[loc], length(Result)-loc+1);
      end;
  finally
    if slcount>0 then
      for a:=0 to slcount-1 do
        begin
        PutPoolBlock(SL[a]);
        SL[a]:=nil;
        end;
    SetLength(SL,0);
    end;
  end;

function ZDecompress_Str(const inBuffer: String; inSize:integer):string;
  var
    SL:array of pointer;
    loc,a,slcount:integer;
    zstream: TZStreamRec;
  begin
  if inSize=0 then
    inSize:=length(inBuffer)
  else if inSize>length(inBuffer) then
    raise Exception.Create('Error! Can not decompress more than received.');

  FillChar(zstream, SizeOf(TZStreamRec), 0);

  MakePoolBlocks;

  Result:='';

  slcount:=0;
  SetLength(SL, 32);
  try
    zstream.next_in := @inBuffer[1];
    zstream.avail_in := inSize;

    Inc(slcount);
    SL[slcount-1]:=GetPoolBlock;

    zstream.next_out := SL[slcount-1];
    zstream.avail_out := delta;

    ZDecompressCheck(InflateInit(zstream));

    try
      while ZDecompressCheck(inflate(zstream, Z_NO_FLUSH)) <> Z_STREAM_END do
      begin
        Inc(slcount);
        if slcount>length(SL) then
          SetLength(SL, length(SL)+32);
        SL[slcount-1]:=GetPoolBlock;

        zstream.next_out := SL[slcount-1];
        zstream.avail_out := delta;
      end;
    finally
      ZDecompressCheck(inflateEnd(zstream));
    end;

    loc:=1;
    SetLength(Result, zstream.total_out);
    if slcount>0 then
      begin
      for a:=0 to slcount-2 do
        begin
        Move(SL[a]^,Result[loc],delta);
        Inc(loc,delta);
        end;
      Move(SL[slcount-1]^,Result[loc], length(Result)-loc+1);
      end;
  finally
    if slcount>0 then
      for a:=0 to slcount-1 do
        begin
        PutPoolBlock(SL[a]);
        SL[a]:=nil;
        end;
    SetLength(SL,0);
    end;
  end;

{** EZLibError **************************************************************}

class function EZLibError.New(code: Integer):EZLibError;
  begin
  Result:=Create(_z_errmsg[2 - code]);
  end;

{$IFDEF zLibPool}
initialization
CS:=TRtcCritSec.Create;
finalization
FreePoolBlocks;
Garbage(CS);
{$ENDIF}
end.