jclcompression.pas

East make Tray Icon in delphi

function TJclZLibCompressStream.Flush: Integer;
begin
  Result := 0;

  if FDeflateInitialized then
  begin
    ZLibRecord.next_in := nil;
    ZLibRecord.avail_in := 0;

    while (ZLibCheck(deflate(ZLibRecord, Z_FINISH)) <> Z_STREAM_END) and
      (ZLibRecord.avail_out = 0) do
    begin
      FStream.WriteBuffer(FBuffer^, FBufferSize);
      Progress(Self);

      ZLibRecord.next_out := FBuffer;
      ZLibRecord.avail_out := FBufferSize;
      Inc(Result, FBufferSize);
    end;

    if ZLibRecord.avail_out < FBufferSize then
    begin
      FStream.WriteBuffer(FBuffer^, FBufferSize-ZLibRecord.avail_out);
      Progress(Self);
      Inc(Result, FBufferSize - ZLibRecord.avail_out);
      ZLibRecord.next_out := FBuffer;
      ZLibRecord.avail_out := FBufferSize;
    end;
  end;
end;

function TJclZLibCompressStream.Seek(Offset: Longint; Origin: Word): Longint;
begin
  if (Offset = 0) and (Origin = soFromCurrent) then
   Result := ZLibRecord.total_in
  else
  if (Offset = 0) and (Origin = soFromBeginning) and (ZLibRecord.total_in = 0) then
    Result := 0
  else
    Result := inherited Seek(Offset, Origin);
end;

procedure TJclZLibCompressStream.SetWindowBits(Value: Integer);
begin
  FWindowBits := Value;
end;

procedure TJclZLibCompressStream.SetMethod(Value: Integer);
begin
  FMethod := Value;
end;

procedure TJclZLibCompressStream.SetStrategy(Value: Integer);
begin
  FStrategy := Value;
  if FDeflateInitialized then
    ZLibCheck(deflateParams(ZLibRecord, FCompressionLevel, FStrategy));
end;

procedure TJclZLibCompressStream.SetMemLevel(Value: Integer);
begin
  FMemLevel := Value;
end;

procedure TJclZLibCompressStream.SetCompressionLevel(Value: Integer);
begin
  FCompressionLevel := Value;
  if FDeflateInitialized then
    ZLibCheck(deflateParams(ZLibRecord, FCompressionLevel, FStrategy));
end;

procedure TJclZLibCompressStream.Reset;
begin
  if FDeflateInitialized then
  begin
    Flush;
    ZLibCheck(deflateReset(ZLibRecord));
  end;
end;


//=== {  TJclZLibDecompressionStream } =======================================

constructor TJclZLibDecompressStream.Create(Source: TStream; WindowBits: Integer = DEF_WBITS);
begin
  inherited Create(Source);

  // Initialize ZLib StreamRecord
  with ZLibRecord do
  begin
    zalloc := nil; // Use build-in memory allocation functionality
    zfree := nil;
    next_in := nil;
    avail_in := 0;
    next_out := FBuffer;
    avail_out := FBufferSize;
  end;

  FInflateInitialized := False;
  FWindowBits := WindowBits;
end;

destructor TJclZLibDecompressStream.Destroy;
begin
  if FInflateInitialized then
  begin
    FStream.Seek(-ZLibRecord.avail_in, soFromCurrent);
    ZLibCheck(inflateEnd(ZLibRecord));
  end;

  inherited Destroy;
end;

function TJclZLibDecompressStream.Read(var Buffer; Count: Longint): Longint;
begin
  if not FInflateInitialized then
  begin
    ZLibCheck(InflateInit2(ZLibRecord, FWindowBits));
    FInflateInitialized := True;
  end;

  ZLibRecord.next_out := @Buffer;
  ZLibRecord.avail_out := Count;

  while ZLibRecord.avail_out > 0 do     // as long as we have data
  begin
    if ZLibRecord.avail_in = 0 then
    begin
      ZLibRecord.avail_in := FStream.Read(FBuffer^, FBufferSize);

      if ZLibRecord.avail_in = 0 then
      begin
        Result := Count - Longint(ZLibRecord.avail_out);
        Exit;
      end;

      ZLibRecord.next_in := FBuffer;
    end;

    if ZLibRecord.avail_in > 0 then
    begin
      ZLibCheck(inflate(ZLibRecord, Z_NO_FLUSH));
      Progress(Self);
    end;
  end;

  Result := Count;
end;

function TJclZLibDecompressStream.Seek(Offset: Longint; Origin: Word): Longint;
begin
   if (Offset = 0) and (Origin = soFromCurrent) then
    Result := ZLibRecord.total_out
   else
     Result := inherited Seek(Offset, Origin);
end;

procedure TJclZLibDecompressStream.SetWindowBits(Value: Integer);
begin
  FWindowBits := Value;
end;

//=== { TJclBZLibCompressionStream } =========================================
(*
{ Error checking helper }

function BZIP2LibCheck(const ErrCode: Integer): Integer;
begin
  Result := ErrCode;

  if ErrCode < 0 then
  begin
    case ErrCode of
      Z_ERRNO:         raise EJclCompressionError.CreateRes(@RsCompressionZLibZErrNo);
      Z_STREAM_ERROR:  raise EJclCompressionError.CreateRes(@RsCompressionZLibZStreamError);
      Z_DATA_ERROR:    raise EJclCompressionError.CreateRes(@RsCompressionZLibZDataError);
      Z_MEM_ERROR:     raise EJclCompressionError.CreateRes(@RsCompressionZLibZMemError);
      Z_BUF_ERROR:     raise EJclCompressionError.CreateRes(@RsCompressionZLibZBufError);
      Z_VERSION_ERROR: raise EJclCompressionError.CreateRes(@RsCompressionZLibZVersionError);
    else
      raise EJclCompressionError.CreateRes(@RsCompressionZLibError);
    end;
  end;
end;

constructor TJclBZIP2CompressStream.Create(Destination: TStream; CompressionLevel: TJclCompressionLevel);
begin
  inherited Create(Destination);

  Assert(FBuffer <> nil);
  Assert(FBufferSize > 0);

  // Initialize ZLib StreamRecord
  with BZLibRecord do
  begin
    bzalloc   := nil; // Use build-in memory allocation functionality
    bzfree    := nil;
    next_in   := nil;
    avail_in  := 0;
    next_out  := FBuffer;
    avail_out := FBufferSize;

  end;

  FDeflateInitialized := False;
end;

destructor TJclBZIP2CompressStream.Destroy;
begin
  Flush;
  if FDeflateInitialized then
    BZIP2LibCheck(BZ2_bzCompressEnd(@BZLibRecord));

  inherited Destroy;
end;

function TJclBZIP2CompressStream.Write(const Buffer; Count: Longint): Longint;
begin
  if not FDeflateInitialized then
  begin
    BZIP2LibCheck(BZ2_bzCompressInit(@BZLibRecord,9,0,0));
    FDeflateInitialized := True;
  end;

  BZLibRecord.next_in := @Buffer;
  BZLibRecord.avail_in := Count;

  while BZLibRecord.avail_in > 0 do
  begin
    BZIP2LibCheck(BZ2_bzCompress(@BZLibRecord, BZ_RUN));

    if BZLibRecord.avail_out = 0 then   // Output buffer empty. Write to stream and go on...
    begin
      FStream.WriteBuffer(FBuffer^, FBufferSize);
      Progress(Self);
      BZLibRecord.next_out := FBuffer;
      BZLibRecord.avail_out := FBufferSize;
    end;
  end;

  Result := Count;
end;

function TJclBZIP2CompressStream.Flush: Integer;
begin
    Result := 0;

    if FDeflateInitialized then
    begin
      BZLibRecord.next_in := nil;
      BZLibRecord.avail_in := 0;

      while (BZIP2LibCheck(BZ2_bzCompress(@BZLibRecord, BZ_FLUSH)) <> Z_STREAM_END) and (BZLibRecord.avail_out = 0) do
      begin
        FStream.WriteBuffer(FBuffer^, FBufferSize);
        Progress(Self);
        
        BZLibRecord.next_out := FBuffer;
        BZLibRecord.avail_out := FBufferSize;
        Result := Result + FBufferSize;
      end;

      if BZLibRecord.avail_out < FBufferSize then
      begin
        FStream.WriteBuffer(FBuffer^, FBufferSize-BZLibRecord.avail_out);
        Progress(Self);
        Result := Result + FBufferSize-BZLibRecord.avail_out;
        BZLibRecord.next_out := FBuffer;
        BZLibRecord.avail_out := FBufferSize;
      end;
    end;
end;

function TJclBZIP2CompressStream.Seek(Offset: Longint; Origin: Word): Longint;
begin
   if (Offset = 0) and (Origin = soFromCurrent) then
    Result := BZLibRecord.total_in_lo32
   else
   if (Offset = 0) and (Origin = soFromBeginning) and (BZLibRecord.total_in_lo32 = 0) then
       Result := 0
   else
     Result := inherited Seek(Offset, Origin);
end;

//=== { TJclZLibDecompressionStream } ========================================

constructor TJclBZIP2DecompressStream.Create(Source: TStream);
begin
  inherited Create(Source);

  // Initialize ZLib StreamRecord
  with BZLibRecord do
  begin
    bzalloc   := nil; // Use build-in memory allocation functionality
    bzfree    := nil;
    opaque    := nil;
    next_in   := nil;
    state     := nil;
    avail_in  := 0;
    next_out  := FBuffer;
    avail_out := FBufferSize;
  end;

  FInflateInitialized := False;
end;

destructor TJclBZIP2DecompressStream.Destroy;
begin
  if FInflateInitialized then
  begin
    FStream.Seek(-BZLibRecord.avail_in, soFromCurrent);
    BZIP2LibCheck(BZ2_bzDecompressEnd(@BZLibRecord));
  end;

  inherited Destroy;
end;

function TJclBZIP2DecompressStream.Read(var Buffer; Count: Longint): Longint;
var
  avail_out_ctr: Integer;

begin
  if not FInflateInitialized then
  begin
    BZIP2LibCheck(BZ2_bzDecompressInit(@BZLibRecord,0,0));
    FInflateInitialized := True;
  end;

  BZLibRecord.next_out := @Buffer;
  BZLibRecord.avail_out := Count;
  avail_out_ctr := Count;

  while avail_out_ctr > 0 do     // as long as we have data
  begin
    if BZLibRecord.avail_in = 0 then
    begin
      BZLibRecord.avail_in := FStream.Read(FBuffer^, FBufferSize);
      if BZLibRecord.avail_in = 0 then
      begin
        Result := Count - avail_out_ctr;
        Exit;
      end;

      BZLibRecord.next_in := FBuffer;
    end;


    if BZLibRecord.avail_in > 0 then
    begin
      BZIP2LibCheck(BZ2_bzDecompress(@BZLibRecord));
      avail_out_ctr := Count - BZLibRecord.avail_out;
    end
  end;

  Result := Count;
end;

function TJclBZIP2DecompressStream.Seek(Offset: Longint; Origin: Word): Longint;
begin
   if (Offset = 0) and (Origin = soFromCurrent) then
    Result := BZLibRecord.total_out_lo32
   else
     Result := inherited Seek(Offset, Origin);
end;
*)

// History:
// $Log: JclCompression.pas,v $
// Revision 1.8  2005/03/08 08:33:15  marquardt
// overhaul of exceptions and resourcestrings, minor style cleaning
//
// Revision 1.7  2005/02/27 14:55:25  marquardt
// changed overloaded constructors to constructor with default parameter (BCB friendly)
//
// Revision 1.6  2005/02/24 16:34:39  marquardt
// remove divider lines, add section lines (unfinished)
//
// Revision 1.5  2005/02/24 07:36:24  marquardt
// resolved the compiler warnings, style cleanup, removed code from JclContainerIntf.pas
//
// Revision 1.4  2004/11/17 03:24:43  mthoma
// Just noticed that I checked in the wrong version... this one is bugfixed and contains
//  $date and $log
//

end.