pack.pas

PEZIP捆绑壳delphi源代码 一份不错的源码

unit Pack;

interface

procedure CompressBuff(const InBuff: Pointer; InBytes: Cardinal;
  out OutBuff: Pointer; out OutBytes: Cardinal);

implementation

const
  Z_BEST_SPEED           =   1;
  Z_BEST_COMPRESSION     =   9;
  Z_DEFAULT_COMPRESSION  =  -1;

const
  zlib_version = '1.0.4';

type
  TAlloc = function (AppData: Pointer; Items, Size: Integer): Pointer; register;
  TFree = procedure (AppData, Block: Pointer); register;

  TZStreamRec = packed record
    next_in: PChar;
    avail_in: Integer;
    total_in: Integer;
    next_out: PChar;
    avail_out: Integer;
    total_out: Integer;
    msg: PChar;
    internal: Pointer;
    zalloc: TAlloc;
    zfree: TFree;
    AppData: Pointer;
    data_type: Integer;
    adler: Integer;
    reserved: Integer;  
  end;

{$L obj\deflate.obj}
{$L obj\trees.obj}
{$L obj\adler32.obj}

procedure _tr_init; external;
procedure _tr_tally; external;
procedure _tr_flush_block; external;
procedure _tr_align; external;
procedure _tr_stored_block; external;
procedure adler32; external;

procedure _memset(P: Pointer; B: Byte; count: Integer); cdecl;
begin
  FillChar(P^, count, B);
end;

procedure _memcpy(dest, source: Pointer; count: Integer); cdecl;
begin
  Move(source^, dest^, count);
end;

function deflateInit_(var strm: TZStreamRec; level: Integer; version: PChar;
  recsize: Integer): Integer; external;
function deflate(var strm: TZStreamRec; flush: Integer): Integer; external;
function deflateEnd(var strm: TZStreamRec): Integer; external;

function AllocMem(Size: Cardinal): Pointer;
begin
  GetMem(Result, Size);
  FillChar(Result^, Size, 0);
end;

function zlibAllocMem(AppData: Pointer; Items, Size: Integer): Pointer; register;
begin
  Result:= AllocMem(Items * Size);
end;

procedure zlibFreeMem(AppData, Block: Pointer); register;
begin
  FreeMem(Block);
end;

procedure CompressBuff(const InBuff: Pointer; InBytes: Cardinal;
  out OutBuff: Pointer; out OutBytes: Cardinal);
var
  strm: TZStreamRec;
  P: Pointer;
begin
  FillChar(strm, SizeOf(strm), 0);
  strm.zalloc:= zlibAllocMem;
  strm.zfree:= zlibFreeMem;
  OutBytes:= ((InBytes + (InBytes div 10) + 12) + 255) and not 255;
  GetMem(OutBuff, OutBytes);
  try
    strm.next_in:= InBuff;
    strm.avail_in:= InBytes;
    strm.next_out:= OutBuff;
    strm.avail_out:= OutBytes;
    deflateInit_(strm, Z_DEFAULT_COMPRESSION, zlib_version, SizeOf(strm));
    try
      while deflate(strm, 4) <> 1 do
      begin
        P := OutBuff;
        Inc(OutBytes, 256);
        ReallocMem(OutBuff, OutBytes);
        strm.next_out:= PChar(Integer(OutBuff) + (Integer(strm.next_out) - Integer(P)));
        strm.avail_out:= 256;
      end;
    finally
      deflateEnd(strm);
    end;
    ReallocMem(OutBuff, strm.total_out);
    OutBytes:= strm.total_out;
  except
    FreeMem(OutBuff);
  end;
end;

end.