rm_bzip2.pas

胜天进销存源码,国产优秀的进销存

  FreeMem(block);
end;

// deflate compresses data

function BZ2_bzCompressInit(var strm: TBZStreamRec; blockSize100k: Integer;
  verbosity: Integer; workFactor: Integer): Integer; stdcall; external;

function BZ2_bzCompress(var strm: TBZStreamRec; action: Integer): Integer; stdcall; external;

function BZ2_bzCompressEnd(var strm: TBZStreamRec): Integer; stdcall; external;

function BZ2_bzBuffToBuffCompress(dest: Pointer; var destLen: Integer; source: Pointer;
  sourceLen, blockSize100k, verbosity, workFactor: Integer): Integer; stdcall; external;

// inflate decompresses data

function BZ2_bzDecompressInit(var strm: TBZStreamRec; verbosity: Integer;
  small: Integer): Integer; stdcall; external;

function BZ2_bzDecompress(var strm: TBZStreamRec): Integer; stdcall; external;

function BZ2_bzDecompressEnd(var strm: TBZStreamRec): Integer; stdcall; external;

function BZ2_bzBuffToBuffDecompress(dest: Pointer; var destLen: Integer; source: Pointer;
  sourceLen, small, verbosity: Integer): Integer; stdcall; external;


function bzip2AllocMem(AppData: Pointer; Items, Size: Integer): Pointer; cdecl;
begin
  GetMem(Result, Items * Size);
end;

procedure bzip2FreeMem(AppData, Block: Pointer); cdecl;
begin
  FreeMem(Block);
end;

{
function zlibCheck(code: Integer): Integer;
begin
  Result := code;
  if code < 0 then
    raise EZlibError.Create('error');    //!!
end;
}

function CCheck(code: Integer): Integer;
begin
  Result := code;
  if code < 0 then
    raise EBZCompressionError.CreateFmt('error %d', [code]); //!!
end;

function DCheck(code: Integer): Integer;
begin
  Result := code;
  if code < 0 then
    raise EBZDecompressionError.CreateFmt('error %d', [code]); //!!
end;


procedure BZCompressBuf(const InBuf: Pointer; InBytes: Integer;
  out OutBuf: Pointer; out OutBytes: Integer);
var
  strm: TBZStreamRec;
  P: Pointer;
begin
  FillChar(strm, sizeof(strm), 0);
  strm.bzalloc := bzip2AllocMem;
  strm.bzfree := bzip2FreeMem;
  OutBytes := ((InBytes + (InBytes div 10) + 12) + 255) and not 255;
  GetMem(OutBuf, OutBytes);
  try
    strm.next_in := InBuf;
    strm.avail_in := InBytes;
    strm.next_out := OutBuf;
    strm.avail_out := OutBytes;
    CCheck(BZ2_bzCompressInit(strm, 9, 0, 0));
    try
      while CCheck(BZ2_bzCompress(strm, BZ_FINISH)) <> BZ_STREAM_END do
      begin
        P := OutBuf;
        Inc(OutBytes, 256);
        ReallocMem(OutBuf, OutBytes);
        strm.next_out := PChar(Integer(OutBuf) + (Integer(strm.next_out) - Integer(P)));
        strm.avail_out := 256;
      end;
    finally
      CCheck(BZ2_bzCompressEnd(strm));
    end;
    ReallocMem(OutBuf, strm.total_out_lo32);
    OutBytes := strm.total_out_lo32;
  except
    FreeMem(OutBuf);
    raise
  end;
end;


procedure BZDecompressBuf(const InBuf: Pointer; InBytes: Integer;
  OutEstimate: Integer; out OutBuf: Pointer; out OutBytes: Integer);
var
  strm: TBZStreamRec;
  P: Pointer;
  BufInc: Integer;
begin
  FillChar(strm, sizeof(strm), 0);
  strm.bzalloc := bzip2AllocMem;
  strm.bzfree := bzip2FreeMem;
  BufInc := (InBytes + 255) and not 255;
  if OutEstimate = 0 then
    OutBytes := BufInc
  else
    OutBytes := OutEstimate;
  GetMem(OutBuf, OutBytes);
  try
    strm.next_in := InBuf;
    strm.avail_in := InBytes;
    strm.next_out := OutBuf;
    strm.avail_out := OutBytes;
    DCheck(BZ2_bzDecompressInit(strm, 0, 0));
    try
      while DCheck(BZ2_bzDecompress(strm)) <> BZ_STREAM_END do
      begin
        P := OutBuf;
        Inc(OutBytes, BufInc);
        ReallocMem(OutBuf, OutBytes);
        strm.next_out := PChar(Integer(OutBuf) + (Integer(strm.next_out) - Integer(P)));
        strm.avail_out := BufInc;
      end;
    finally
      DCheck(BZ2_bzDecompressEnd(strm));
    end;
    ReallocMem(OutBuf, strm.total_out_lo32);
    OutBytes := strm.total_out_lo32;
  except
    FreeMem(OutBuf);
    raise
  end;
end;

// TCustomBZip2Stream

constructor TCustomBZip2Stream.Create(Strm: TStream);
begin
  inherited Create;
  FStrm := Strm;
  FStrmPos := Strm.Position;
  FBZRec.bzalloc := bzip2AllocMem;
  FBZRec.bzfree := bzip2FreeMem;
end;

procedure TCustomBZip2Stream.Progress(Sender: TObject);
begin
  if Assigned(FOnProgress) then FOnProgress(Sender);
end;


// TBZCompressionStream

constructor TBZCompressionStream.Create(BlockSize100k: TBlockSize100k; Dest: TStream);
const
  BlockSizes: array[TBlockSize100k] of ShortInt = (1, 2, 3, 4, 5, 6, 7, 8, 9);
begin
  inherited Create(Dest);
  FBZRec.next_out := FBuffer;
  FBZRec.avail_out := sizeof(FBuffer);
  CCheck(BZ2_bzCompressInit(FBZRec, BlockSizes[BlockSize100k], 0, 0));
end;

destructor TBZCompressionStream.Destroy;
begin
  FBZRec.next_in := nil;
  FBZRec.avail_in := 0;
  try
    if FStrm.Position <> FStrmPos then FStrm.Position := FStrmPos;
    while (CCheck(BZ2_bzCompress(FBZRec, BZ_FINISH)) <> BZ_STREAM_END)
      and (FBZRec.avail_out = 0) do
    begin
      FStrm.WriteBuffer(FBuffer, sizeof(FBuffer));
      FBZRec.next_out := FBuffer;
      FBZRec.avail_out := sizeof(FBuffer);
    end;
    if FBZRec.avail_out < sizeof(FBuffer) then
      FStrm.WriteBuffer(FBuffer, sizeof(FBuffer) - FBZRec.avail_out);
  finally
    BZ2_bzCompressEnd(FBZRec);
  end;
  inherited Destroy;
end;

function TBZCompressionStream.Read(var Buffer; Count: Longint): Longint;
begin
  raise EBZCompressionError.Create('Invalid stream operation');
end;

function TBZCompressionStream.Write(const Buffer; Count: Longint): Longint;
begin
  FBZRec.next_in := @Buffer;
  FBZRec.avail_in := Count;
  if FStrm.Position <> FStrmPos then FStrm.Position := FStrmPos;
  while (FBZRec.avail_in > 0) do
  begin
    CCheck(BZ2_bzCompress(FBZRec, BZ_RUN));
    if FBZRec.avail_out = 0 then
    begin
      FStrm.WriteBuffer(FBuffer, sizeof(FBuffer));
      FBZRec.next_out := FBuffer;
      FBZRec.avail_out := sizeof(FBuffer);
      FStrmPos := FStrm.Position;
    end;
    Progress(Self);
  end;
  Result := Count;
end;

function TBZCompressionStream.Seek(Offset: Longint; Origin: Word): Longint;
begin
  if (Offset = 0) and (Origin = soFromCurrent) then
    Result := FBZRec.total_in_lo32
  else
    raise EBZCompressionError.Create('Invalid stream operation');
end;

function TBZCompressionStream.GetCompressionRate: Single;
begin
  if FBZRec.total_in_lo32 = 0 then
    Result := 0
  else
    Result := (1.0 - (FBZRec.total_out_lo32 / FBZRec.total_in_lo32)) * 100.0;
end;


// TDecompressionStream

constructor TBZDecompressionStream.Create(Source: TStream);
begin
  inherited Create(Source);
  FBZRec.next_in := FBuffer;
  FBZRec.avail_in := 0;
  DCheck(BZ2_bzDecompressInit(FBZRec, 0, 0));
end;

destructor TBZDecompressionStream.Destroy;
begin
  BZ2_bzDecompressEnd(FBZRec);
  inherited Destroy;
end;

function TBZDecompressionStream.Read(var Buffer; Count: Longint): Longint;
begin
  FBZRec.next_out := @Buffer;
  FBZRec.avail_out := Count;
  if FStrm.Position <> FStrmPos then FStrm.Position := FStrmPos;
  while (FBZRec.avail_out > 0) do
  begin
    if FBZRec.avail_in = 0 then
    begin
      FBZRec.avail_in := FStrm.Read(FBuffer, sizeof(FBuffer));
      if FBZRec.avail_in = 0 then
      begin
        Result := Count - FBZRec.avail_out;
        Exit;
      end;
      FBZRec.next_in := FBuffer;
      FStrmPos := FStrm.Position;
    end;
    CCheck(BZ2_bzDecompress(FBZRec));
    Progress(Self);
  end;
  Result := Count;
end;

function TBZDecompressionStream.Write(const Buffer; Count: Longint): Longint;
begin
  raise EBZDecompressionError.Create('Invalid stream operation');
end;

function TBZDecompressionStream.Seek(Offset: Longint; Origin: Word): Longint;
var
  I: Integer;
  Buf: array[0..4095] of Char;
begin
  if (Offset = 0) and (Origin = soFromBeginning) then
  begin
    DCheck(BZ2_bzDecompressEnd(FBZRec));
    DCheck(BZ2_bzDecompressInit(FBZRec, 0, 0));
    FBZRec.next_in := FBuffer;
    FBZRec.avail_in := 0;
    FStrm.Position := 0;
    FStrmPos := 0;
  end
  else if ((Offset >= 0) and (Origin = soFromCurrent)) or
    (((Offset - FBZRec.total_out_lo32) > 0) and (Origin = soFromBeginning)) then
  begin
    if Origin = soFromBeginning then Dec(Offset, FBZRec.total_out_lo32);
    if Offset > 0 then
    begin
      for I := 1 to Offset div sizeof(Buf) do
        ReadBuffer(Buf, sizeof(Buf));
      ReadBuffer(Buf, Offset mod sizeof(Buf));
    end;
  end
  else
    raise EBZDecompressionError.Create('Invalid stream operation');
  Result := FBZRec.total_out_lo32;
end;

end.