{ $Log:  K:\Entwicklung\Shared Files\Packages\IBO_TST\Source\IB_OleContainer.pas.z
{
{   Rev 1.7    09.10.2001 22:31:05  stt
{ (09.10.2001) Delphi 6 compatible hinzugefügt
}
{
{   Rev 1.6    09.10.2001 19:15:04  stt
{ Delphi 6 kompatibel gemacht
}
{
{   Rev 1.5    31.05.2001 11:58:51  stt
{ DragAcceptFiles nun in der Methode CreateHandle
}
{
{   Rev 1.4    30.05.2001 23:12:47  stt
{ Drag&Drop Funktionalität implementiert
}
{
{   Rev 1.3    30.01.2001 22:41:14  stt
{ CompressedSize, DecompressedSize => ReadOnly
}
{
{   Rev 1.2    29.01.2001 16:53:57  stt
{ Setting FDataLink.ControlIsModified was improved
}
{
{   Rev 1.1    29.01.2001 16:45:32  stt
}
{
{   Rev 1.0    29.01.2001 10:20:30  stt
{ Initial check in v1.0
}
{}

{$INCLUDE IB_Directives.inc}

unit IB_OleContainer;
{
----------------------------------------------------------------
TIB_OleContainer - IBO data aware OLE-Container with optional ZLib compression
(c) 2001 by Thomas Steinmaurer
E-Mail: iblogmanager@aon.at

30.01.2001: v1.0 (Initial release)

30.05.2001: v1.1
Enhancements:
1) Drag&Drop files from the Explorer implemented. If more than one file is dropped then only the first file is processed!

New Properties introduced:
    AcceptFiles: True (Default) => Files from the explorer can be dropped; False => Files from the explorer can't be dropped
New Events introduced:
    OnDropFileError: Fired if an error occured during dropping files from the explorer
    OnDropFile: Fired each time a file is dropped from the explorer;
                LinkToObject (True => Link; False (Default) => Embedded); Iconic (True => OLE-Object shown as icon; False (Default))

(09.10.2001) Delphi 6 compatible


This component is Freeware. Please distribute always the whole component unchanged.
If you find bugs or have any suggestions, please send me an E-Mail. Thanks!

The use of this component is at your own risk. I do not take any responsibility for any damages.

See also: IB LogManager - The Logging Tool for Interbase/Firebird

WWW:        http://www.equitania.de/interbase/iblogmanager/start.htm    (German)
            http://www.equitania.de/interbase/iblogmanager/default.htm  (English)
Newsgroups: news://victory.equitania.de/interbase.iblogmanager.de       (German)
            news://victory.equitania.de/interbase.iblogmanager.en       (English)
eGroups:    http://www.egroups.com/group/iblogmanager
E-Mail:     iblogmanager@aon.at

----------------------------------------------------------------
published properties:
    property AutoDisplay: BLOB data is loaded automatically. Otherwise use the methode LoadObject
    proeprty AcceptFiles: True (Default) => Files from the explorer can be dropped; False => Files from the explorer can't be dropped
    property Compressionlevel: ZLib compression level (clNone, clFastest, clDefault, clMax)
    property DataField: Link to BLOB column (TIB_Column)
    property DataSource: Link to TIB_DataSource

published events:
    property OnBeforeCompress: Fired before BLOB data is written
    property OnAfterCompress: Fired after BLOB data was written
    property OnBeforeDecrompess: Fired before BLOB data is read
    property OnAfterDecompress: Fired after BLOB data was read
    property OnCompressError: Fired if an error occured during BLOB data writing
    property OnDecompressError: Fired if an error occured during BLOB data reading
    property OnDecompress: Fired each time a block (BUFFER size: DECROMPESSIONBUFFER) of the BLOB data was decompressed
    property OnDropFileError: Fired if an error occured during dropping files from the explorer
    property OnDropFile: Fired each time a file is dropped from the explorer

Methods:

    procedure LoadObject: Decompress BLOB data and put into the OLE-Container
    procedure CopyToClipboard: Copy OLE data to the clipboard
    procedure CutToClipboard: Cut OLE data to the clipboard
    procedure PasteFromClipboard: Paste OLE data from the clipboard

public properties (read-only)

    CompressedSize: Size of compressed BLOB data
    DecompressedSize: Size of decompressed BLOB data
----------------------------------------------------------------
}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  OleCtnrs,

{$IFDEF IBO_VCL70_OR_GREATER}
  zlib,
{$ENDIF}

  IB_FieldDataLink, IB_Components, IB_Session, Shellapi;

const
  DECROMPESSIONBUFFER = 65535; (* 64K Buffer decompression size *)

{$IFNDEF IBO_VCL70_OR_GREATER}
type
  TAlloc = function (AppData: Pointer; Items, Size: Integer): Pointer;
  TFree = procedure (AppData, Block: Pointer);

  // Internal structure.  Ignore.
  TZStreamRec = packed record
    next_in: PChar;       // next input byte
    avail_in: Integer;    // number of bytes available at next_in
    total_in: Integer;    // total nb of input bytes read so far

    next_out: PChar;      // next output byte should be put here
    avail_out: Integer;   // remaining free space at next_out
    total_out: Integer;   // total nb of bytes output so far

    msg: PChar;           // last error message, NULL if no error
    internal: Pointer;    // not visible by applications

    zalloc: TAlloc;       // used to allocate the internal state
    zfree: TFree;         // used to free the internal state
    AppData: Pointer;     // private data object passed to zalloc and zfree

    data_type: Integer;   //  best guess about the data type: ascii or binary
    adler: Integer;       // adler32 value of the uncompressed data
    reserved: Integer;    // reserved for future use
  end;

  // Abstract ancestor class
  TCustomZlibStream = class(TStream)
  private
    FStrm: TStream;
    FStrmPos: Integer;
    FOnProgress: TNotifyEvent;
    FZRec: TZStreamRec;
    FBuffer: array [Word] of Char;
  protected
    procedure Progress(Sender: TObject); dynamic;
    property OnProgress: TNotifyEvent read FOnProgress write FOnProgress;
    constructor Create(Strm: TStream);
  end;

{ TCompressionStream compresses data on the fly as data is written to it, and
  stores the compressed data to another stream.

  TCompressionStream is write-only and strictly sequential. Reading from the
  stream will raise an exception. Using Seek to move the stream pointer
  will raise an exception.

  Output data is cached internally, written to the output stream only when
  the internal output buffer is full.  All pending output data is flushed
  when the stream is destroyed.

  The Position property returns the number of uncompressed bytes of
  data that have been written to the stream so far.

  CompressionRate returns the on-the-fly percentage by which the original
  data has been compressed:  (1 - (CompressedBytes / UncompressedBytes)) * 100
  If raw data size = 100 and compressed data size = 25, the CompressionRate
  is 75%

  The OnProgress event is called each time the output buffer is filled and
  written to the output stream.  This is useful for updating a progress
  indicator when you are writing a large chunk of data to the compression
  stream in a single call.}

  TCompressionLevel = (clNone, clFastest, clDefault, clMax);

  TCompressionStream = class(TCustomZlibStream)
  private
    function GetCompressionRate: Single;
  public
    constructor Create(CompressionLevel: TCompressionLevel; Dest: TStream);
    destructor Destroy; override;
    function Read(var Buffer; Count: Longint): Longint; override;
    function Write(const Buffer; Count: Longint): Longint; override;
    function Seek(Offset: Longint; Origin: Word): Longint; override;
    property CompressionRate: Single read GetCompressionRate;
    property OnProgress;
  end;

{ TDecompressionStream decompresses data on the fly as data is read from it.

  Compressed data comes from a separate source stream.  TDecompressionStream
  is read-only and unidirectional; you can seek forward in the stream, but not
  backwards.  The special case of setting the stream position to zero is
  allowed.  Seeking forward decompresses data until the requested position in
  the uncompressed data has been reached.  Seeking backwards, seeking relative
  to the end of the stream, requesting the size of the stream, and writing to
  the stream will raise an exception.

  The Position property returns the number of bytes of uncompressed data that
  have been read from the stream so far.

  The OnProgress event is called each time the internal input buffer of
  compressed data is exhausted and the next block is read from the input stream.
  This is useful for updating a progress indicator when you are reading a
  large chunk of data from the decompression stream in a single call.}

  TDecompressionStream = class(TCustomZlibStream)
  public
    constructor Create(Source: TStream);
    destructor Destroy; override;
    function Read(var Buffer; Count: Longint): Longint; override;
    function Write(const Buffer; Count: Longint): Longint; override;
    function Seek(Offset: Longint; Origin: Word): Longint; override;
    property OnProgress;
  end;

{ CompressBuf compresses data, buffer to buffer, in one call.
   In: InBuf = ptr to compressed data
       InBytes = number of bytes in InBuf
  Out: OutBuf = ptr to newly allocated buffer containing decompressed data
       OutBytes = number of bytes in OutBuf   }
procedure CompressBuf(const InBuf: Pointer; InBytes: Integer;
                      out OutBuf: Pointer; out OutBytes: Integer);


{ DecompressBuf decompresses data, buffer to buffer, in one call.
   In: InBuf = ptr to compressed data
       InBytes = number of bytes in InBuf
       OutEstimate = zero, or est. size of the decompressed data
  Out: OutBuf = ptr to newly allocated buffer containing decompressed data
       OutBytes = number of bytes in OutBuf   }
procedure DecompressBuf(const InBuf: Pointer; InBytes: Integer;
 OutEstimate: Integer; out OutBuf: Pointer; out OutBytes: Integer);

const
  zlib_version = '1.1.3';

type
  EZlibError = class(Exception);
  ECompressionError = class(EZlibError);
  EDecompressionError = class(EZlibError);

function adler32(adler: Integer; buf: PChar; len: Integer): Integer;
{$ENDIF}

type
  TDecompressEvent = procedure (Sender: TObject; DecompressedBytes: LongInt) of object;
  TDropFileEvent = procedure (Sender: TObject; var LinkToObject, Iconic: Boolean) of object;

  TIB_OleContainer = class(TOleContainer)
  private
    { Private-Deklarationen }
    FCompressedSize: LongInt;
    FDecompressedSize: LongInt;
    FDataLink: TIB_FieldDataLink;
    FAutoDisplay: Boolean;
    FCompressionLevel: TCompressionLevel;
    FChangedFromLoadObject: Boolean;
    FOnBeforeCompress: TNotifyEvent;
    FOnAfterCompress: TNotifyEvent;
    FOnBeforeDecompress: TNotifyEvent;
    FOnAfterDecompress: TNotifyEvent;
    FOnCompressError: TNotifyEvent;
    FOnDecompressError: TNotifyEvent;
    FOnDecompress: TDecompressEvent;
    FOnDropFileError: TNotifyEvent;
    FOnDropFile: TDropFileEvent;
    FAcceptFiles: Boolean;
    procedure SetAutoDisplay(const Value: Boolean);
    procedure SetAcceptFiles(const Value: Boolean);
    procedure SetCompressionLevel(const Value: TCompressionLevel);
    function  GetDataField : String;
    procedure SetDataField(const Value : String);
    function  GetDataSource : TIB_DataSource;
    procedure SetDataSource(Value : TIB_DataSource);
    function GetColumn: TIB_Column;
    procedure IB_StateChanged( Sender: TIB_DataLink; IB_DataSource: TIB_DataSource );
    procedure IB_ModifyingChanged( Sender: TIB_DataLink; IB_DataSource: TIB_DataSource );
    procedure IB_DataChange( Sender: TIB_DataLink; IB_DataSource: TIB_DataSource; IB_Field: TIB_Column );
    procedure IB_UpdateData( Sender: TIB_DataLink; IB_DataSource: TIB_DataSource; IB_Field: TIB_Column );
    procedure CMExit(var Message: TCMExit); message CM_EXIT;
    procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
    function GetCompressedSize: LongInt;
    function GetDecompressedSize: LongInt;
  protected
    { Protected-Deklarationen }
    procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure WMCut(var Message: TMessage); message WM_CUT;
    procedure WMCopy(var Message: TMessage); message WM_COPY;
    procedure WMPaste(var Message: TMessage); message WM_PASTE;
    procedure WMDROPFILES (var Msg: TMessage); message WM_DROPFILES;     
    procedure Changed; override;
    procedure SysStateChanged;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyPress(var Key: Char); override;
    procedure CreateHandle; override;    
  public
    { Public-Deklarationen }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; Override;
    property Field: TIB_Column read GetColumn;
    property CompressedSize: LongInt read GetCompressedSize;
    property DecompressedSize: LongInt read GetDecompressedSize;
    procedure LoadObject;
    procedure CopyToClipboard;
    procedure CutToClipboard;
    procedure PasteFromClipboard;
  published
    { Published-Deklarationen }
    property AutoDisplay: Boolean read FAutoDisplay write SetAutoDisplay default True;
    property AcceptFiles: Boolean read FAcceptFiles write SetAcceptFiles default True;
    property Compressionlevel: TCompressionLevel read FCompressionLevel write SetCompressionLevel default clDefault;
    property DataField: String read GetDataField write SetDataField;
    property DataSource: TIB_DataSource read GetDataSource write SetDataSource;
    property OnBeforeCompress: TNotifyEvent read FOnBeforeCompress write FOnBeforeCompress;
    property OnAfterCompress: TNotifyEvent read FOnAfterCompress write FOnAfterCompress;
    property OnBeforeDecrompess: TNotifyEvent read FOnBeforeDecompress write FOnBeforeDecompress;
    property OnAfterDecompress: TNotifyEvent read FOnAfterDecompress write FOnAfterDecompress;
    property OnCompressError: TNotifyEvent read FOnCompressError write FOnCompressError;
    property OnDecompressError: TNotifyEvent read FOnDecompressError write FOnDecompressError;
    property OnDecompress: TDecompressEvent read FOnDecompress write FOnDecompress;
    property OnDropFileError: TNotifyEvent read FOnDropFileError write FOnDropFileError;
    property OnDropFile: TDropFileEvent read FOnDropFile write FOnDropFile;
  end;

implementation

{$IFNDEF IBO_VCL70_OR_GREATER}
const
  Z_NO_FLUSH      = 0;
  Z_PARTIAL_FLUSH = 1;
  Z_SYNC_FLUSH    = 2;
  Z_FULL_FLUSH    = 3;
  Z_FINISH        = 4;

  Z_OK            = 0;
  Z_STREAM_END    = 1;
  Z_NEED_DICT     = 2;
  Z_ERRNO         = (-1);
  Z_STREAM_ERROR  = (-2);
  Z_DATA_ERROR    = (-3);
  Z_MEM_ERROR     = (-4);
  Z_BUF_ERROR     = (-5);
  Z_VERSION_ERROR = (-6);

  Z_NO_COMPRESSION       =   0;
  Z_BEST_SPEED           =   1;
  Z_BEST_COMPRESSION     =   9;
  Z_DEFAULT_COMPRESSION  = (-1);

  Z_FILTERED            = 1;
  Z_HUFFMAN_ONLY        = 2;
  Z_DEFAULT_STRATEGY    = 0;

  Z_BINARY   = 0;
  Z_ASCII    = 1;
  Z_UNKNOWN  = 2;

  Z_DEFLATED = 8;

  _z_errmsg: array[0..9] of PChar = (
    'need dictionary',      // Z_NEED_DICT      (2)
    'stream end',           // Z_STREAM_END     (1)
    '',                     // Z_OK             (0)
    'file error',           // Z_ERRNO          (-1)
    'stream error',         // Z_STREAM_ERROR   (-2)
    'data error',           // Z_DATA_ERROR     (-3)
    'insufficient memory',  // Z_MEM_ERROR      (-4)
    'buffer error',         // Z_BUF_ERROR      (-5)
    'incompatible version', // Z_VERSION_ERROR  (-6)
    ''
  );

{$L deflate.obj}
{$L inflate.obj}
{$L inftrees.obj}
{$L trees.obj}
{$L adler32.obj}
{$L infblock.obj}
{$L infcodes.obj}
{$L infutil.obj}
{$L inffast.obj}

procedure _tr_init; external;
procedure _tr_tally; external;
procedure _tr_flush_block; external;
procedure _tr_align; external;
procedure _tr_stored_block; external;
function adler32; external;
procedure inflate_blocks_new; external;
procedure inflate_blocks; external;
procedure inflate_blocks_reset; external;
procedure inflate_blocks_free; external;
procedure inflate_set_dictionary; external;
procedure inflate_trees_bits; external;
procedure inflate_trees_dynamic; external;
procedure inflate_trees_fixed; external;
procedure inflate_codes_new; external;
procedure inflate_codes; external;
procedure inflate_codes_free; external;
procedure _inflate_mask; external;
procedure inflate_flush; external;
procedure inflate_fast; 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;



// deflate compresses data
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;

// inflate decompresses data
function inflateInit_(var strm: TZStreamRec; version: PChar;
  recsize: Integer): Integer; external;
function inflate(var strm: TZStreamRec; flush: Integer): Integer; external;
function inflateEnd(var strm: TZStreamRec): Integer; external;
function inflateReset(var strm: TZStreamRec): Integer; external;


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

procedure zcfree(AppData, Block: Pointer);
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 ECompressionError.Create('error'); //!!
end;

function DCheck(code: Integer): Integer;
begin
  Result := code;
  if code < 0 then
    raise EDecompressionError.Create('error');  //!!
end;

procedure CompressBuf(const InBuf: Pointer; InBytes: Integer;
                      out OutBuf: Pointer; out OutBytes: Integer);
var
  strm: TZStreamRec;
  P: Pointer;
begin
  FillChar(strm, sizeof(strm), 0);
  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(deflateInit_(strm, Z_BEST_COMPRESSION, zlib_version, sizeof(strm)));
    try
      while CCheck(deflate(strm, Z_FINISH)) <> Z_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(deflateEnd(strm));
    end;
    ReallocMem(OutBuf, strm.total_out);
    OutBytes := strm.total_out;
  except
    FreeMem(OutBuf);
    raise
  end;
end;


procedure DecompressBuf(const InBuf: Pointer; InBytes: Integer;
  OutEstimate: Integer; out OutBuf: Pointer; out OutBytes: Integer);
var
  strm: TZStreamRec;
  P: Pointer;
  BufInc: Integer;
begin
  FillChar(strm, sizeof(strm), 0);
  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(inflateInit_(strm, zlib_version, sizeof(strm)));
    try
      while DCheck(inflate(strm, Z_FINISH)) <> Z_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(inflateEnd(strm));
    end;
    ReallocMem(OutBuf, strm.total_out);
    OutBytes := strm.total_out;
  except
    FreeMem(OutBuf);
    raise
  end;
end;


// TCustomZlibStream

constructor TCustomZLibStream.Create(Strm: TStream);
begin
  inherited Create;
  FStrm := Strm;
  FStrmPos := Strm.Position;
end;

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


// TCompressionStream

constructor TCompressionStream.Create(CompressionLevel: TCompressionLevel;
  Dest: TStream);
const
  Levels: array [TCompressionLevel] of ShortInt =
    (Z_NO_COMPRESSION, Z_BEST_SPEED, Z_DEFAULT_COMPRESSION, Z_BEST_COMPRESSION);
begin
  inherited Create(Dest);
  FZRec.next_out := FBuffer;
  FZRec.avail_out := sizeof(FBuffer);
  CCheck(deflateInit_(FZRec, Levels[CompressionLevel], zlib_version, sizeof(FZRec)));
end;

destructor TCompressionStream.Destroy;
begin
  FZRec.next_in := nil;
  FZRec.avail_in := 0;
  try
    if FStrm.Position <> FStrmPos then FStrm.Position := FStrmPos;
    while (CCheck(deflate(FZRec, Z_FINISH)) <> Z_STREAM_END)
      and (FZRec.avail_out = 0) do
    begin
      FStrm.WriteBuffer(FBuffer, sizeof(FBuffer));
      FZRec.next_out := FBuffer;
      FZRec.avail_out := sizeof(FBuffer);
    end;
    if FZRec.avail_out < sizeof(FBuffer) then
      FStrm.WriteBuffer(FBuffer, sizeof(FBuffer) - FZRec.avail_out);
  finally
    deflateEnd(FZRec);
  end;
  inherited Destroy;
end;

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

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

function TCompressionStream.Seek(Offset: Longint; Origin: Word): Longint;
begin
  if (Offset = 0) and (Origin = soFromCurrent) then
    Result := FZRec.total_in
  else
    raise ECompressionError.Create('Invalid stream operation');
end;

function TCompressionStream.GetCompressionRate: Single;
begin
  if FZRec.total_in = 0 then
    Result := 0
  else
    Result := (1.0 - (FZRec.total_out / FZRec.total_in)) * 100.0;
end;


// TDecompressionStream

constructor TDecompressionStream.Create(Source: TStream);
begin
  inherited Create(Source);
  FZRec.next_in := FBuffer;
  FZRec.avail_in := 0;
  DCheck(inflateInit_(FZRec, zlib_version, sizeof(FZRec)));
end;

destructor TDecompressionStream.Destroy;
begin
  inflateEnd(FZRec);
  inherited Destroy;
end;

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

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

function TDecompressionStream.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(inflateReset(FZRec));
    FZRec.next_in := FBuffer;
    FZRec.avail_in := 0;
    FStrm.Position := 0;
    FStrmPos := 0;
  end
  else if ( (Offset >= 0) and (Origin = soFromCurrent)) or
          ( ((Offset - FZRec.total_out) > 0) and (Origin = soFromBeginning)) then
  begin
    if Origin = soFromBeginning then Dec(Offset, FZRec.total_out);
    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 EDecompressionError.Create('Invalid stream operation');
  Result := FZRec.total_out;
end;
{$ENDIF}

{ TIB_OleContainer }

procedure TIB_OleContainer.Changed;
begin
  FDataLink.ControlIsModified := not FChangedFromLoadObject and FDataLink.Modify;
  inherited;
end;

procedure TIB_OleContainer.CMExit(var Message: TCMExit);
begin
  FDataLink.UpdateRecord;
  Invalidate;
  inherited;
end;

procedure TIB_OleContainer.CMGetDataLink(var Message: TMessage);
begin
  Message.Result := Integer(FDataLink);
end;

procedure TIB_OleContainer.CopyToClipboard;
begin
  if State <> osEmpty then Copy;
end;

constructor TIB_OleContainer.Create(AOwner: TComponent);
begin
  inherited;
  FAutoDisplay := True;
  FAcceptFiles := True;
  FCompressionLevel := clDefault;
  FDataLink := TIB_FieldDataLink.Create(self);
  FDataLink.Control := Self;
  FDataLink.OnStateChanged := IB_StateChanged;
  FDataLink.OnEditingChanged := IB_ModifyingChanged;
  FDataLink.OnDataChange := IB_DataChange;
  FDataLink.OnUpdateData := IB_UpdateData;
end;

(* This is needed to prevent rarely AV during design time. Thanks to Harald Klomann *)
procedure TIB_OleContainer.CreateHandle;
begin
  inherited CreateHandle;
  DragAcceptFiles(Handle, FAcceptFiles);
end;
(* END *)

procedure TIB_OleContainer.CutToClipboard;
begin
  if State <> osEmpty then begin
    CopyToClipboard;
    DestroyObject;
  end;
end;

destructor TIB_OleContainer.Destroy;
begin
  FDataLink.OnStateChanged := nil;
  FDataLink.OnDataChange := nil;
  FDataLink.OnEditingChanged := nil;
  FDataLink.OnUpdateData := nil;
  FDataLink.Free;
  inherited Destroy;
end;

function TIB_OleContainer.GetColumn: TIB_Column;
begin
  Result := FDataLink.Field;
end;

function TIB_OleContainer.GetCompressedSize: LongInt;
begin
  Result := FCompressedSize;
end;

function TIB_OleContainer.GetDataField: String;
begin
  Result := FDataLink.FieldName;
end;

function TIB_OleContainer.GetDataSource: TIB_DataSource;
begin
  Result := FDataLink.DataSource;
end;

function TIB_OleContainer.GetDecompressedSize: LongInt;
begin
  Result := FDecompressedSize;
end;

procedure TIB_OleContainer.IB_DataChange(Sender: TIB_DataLink; IB_DataSource: TIB_DataSource; IB_Field: TIB_Column);
begin
  if Assigned(IB_Field) and IB_Field.IsBlob then begin
    if FAutoDisplay then begin
      LoadObject;
    end else begin
      if State <> osEmpty then DestroyObject;
    end;
  end;
end;

procedure TIB_OleContainer.IB_ModifyingChanged(Sender: TIB_DataLink; IB_DataSource: TIB_DataSource);
begin
//  inherited Enabled := not Sender.Editing;
end;

procedure TIB_OleContainer.IB_StateChanged(Sender: TIB_DataLink; IB_DataSource: TIB_DataSource);
begin
  SysStateChanged;
end;

procedure TIB_OleContainer.IB_UpdateData(Sender: TIB_DataLink; IB_DataSource: TIB_DataSource; IB_Field: TIB_Column);
var
  BlobStream,
  OleStream: TStream;
  ZLibStream: TCustomZLibStream;
begin
  if State <> osEmpty then
  begin
    try
      FCompressedSize := 0; FDecompressedSize := 0;
      if Assigned( FOnBeforeCompress ) then
        FOnBeforeCompress( Self );
      BlobStream := Sender.Dataset.CreateBlobStream( IB_Field, bsmWrite );
      try
        OleStream := TMemoryStream.Create;
        try
          SaveToStream( OleStream );

          BlobStream.Position := 0;
          ZLibStream := TCompressionStream.Create( FCompressionLevel,
                                                   BlobStream );
          try
            ZLibStream.CopyFrom( OleStream, 0 );
          finally
            FCompressedSize := BlobStream.Size;
            FDecompressedSize := OleStream.Size;
            ZLibStream.Free;
          end;
        finally
          OleStream.Free;
        end;
      finally
        BlobStream.Free;
      end;
      if Assigned(FOnAfterCompress) then FOnAfterCompress(Self);
    except
      if Assigned(FOnCompressError) then FOnCompressError(Self);
    end;
  end else begin
    FDataLink.Field.Clear;
  end;
end;

procedure TIB_OleContainer.KeyDown(var Key: Word; Shift: TShiftState);
begin
  inherited KeyDown(Key, Shift);
  case Key of
    VK_INSERT: begin
      if ssShift in Shift then PasteFromClipBoard else
      if ssCtrl in Shift then CopyToClipBoard;
    end;
    VK_DELETE: begin
      if ssShift in Shift then begin
        CutToClipBoard;
      end else begin
        if (State <> osEmpty) and FDataLink.Modify then DestroyObject;
      end;
    end;
  end;
end;

procedure TIB_OleContainer.KeyPress(var Key: Char);
begin
  inherited KeyPress(Key);
  case Key of
    ^X: CutToClipBoard;
    ^C: CopyToClipBoard;
    ^V: PasteFromClipBoard;
  end;
end;

procedure TIB_OleContainer.LoadObject;
var
  BlobStream, OleStream: TStream;
  ZLibStream: TCustomZlibStream;
  i: Longint;
  ZLibBuffer: array [0..DECROMPESSIONBUFFER] of Byte;
  DecompressedBytes: LongInt;
begin
  try
    FChangedFromLoadObject := True;
    FCompressedSize := 0; FDecompressedSize := 0;
    if Assigned(FOnBeforeDecompress) then FOnBeforeDecompress(Self);
    BlobStream := FDataLink.Dataset.CreateBlobStream(FDataLink.Field, bsmRead);
    FCompressedSize := BlobStream.Size;
    try
      if BlobStream.Size > 0 then
      begin
        OleStream := TMemoryStream.Create;
        try
          ZLibStream := TDecompressionStream.Create(BlobStream);
          try
            DecompressedBytes := 0;
            repeat
              i := ZLibStream.Read(ZLibBuffer, SizeOf(ZLibBuffer));
              INC(DecompressedBytes, i);
              if Assigned(FOnDecompress) then FOnDecompress(Self, DecompressedBytes);
              if i <> 0 then OleStream.WriteBuffer(ZLibBuffer, i);
            until i = 0;
            OleStream.Position := 0;
            FDecompressedSize := OleStream.Size;
            LoadFromStream(OleStream);
          finally
            ZLibStream.Free;
          end;
        finally
          OleStream.Free;
        end;
      end
      else
      begin
        DestroyObject;
      end;
    finally
      FChangedFromLoadObject := False;
      BlobStream.Free;
    end;
    if Assigned(FOnAfterDecompress) then FOnAfterDecompress(Self);
  except
    if Assigned(FOnDecompressError) then FOnDecompressError(self);
  end;
end;

procedure TIB_OleContainer.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (FDataLink <> nil) and (AComponent = DataSource) then DataSource := nil;
end;

procedure TIB_OleContainer.PasteFromClipboard;
begin
  if CanPaste then begin
    Paste;
  end;
end;

procedure TIB_OleContainer.SetAcceptFiles(const Value: Boolean);
begin
 if FAcceptFiles <> Value then begin
   FAcceptFiles := Value;
   DragAcceptFiles(Handle, FAcceptFiles);
 end;
end;

procedure TIB_OleContainer.SetAutoDisplay(const Value: Boolean);
begin
  if FAutoDisplay <> Value then begin
    FAutoDisplay := Value;
    if FAutoDisplay then LoadObject;
  end;
end;

procedure TIB_OleContainer.SetCompressionLevel(const Value: TCompressionLevel);
begin
  FCompressionLevel := Value;
end;

procedure TIB_OleContainer.SetDataField(const Value: String);
begin
  FDataLink.FieldName := Value;
end;

procedure TIB_OleContainer.SetDataSource(Value: TIB_DataSource);
begin
  FDataLink.DataSource := Value;
end;

procedure TIB_OleContainer.SysStateChanged;
begin
  if FDataLink.ColorScheme then begin
    inherited Color := FDataLink.Color;
  end;
end;

procedure TIB_OleContainer.WMCopy(var Message: TMessage);
begin
  CopyToClipboard;
end;

procedure TIB_OleContainer.WMCut(var Message: TMessage);
begin
  CutToClipboard;
end;

procedure TIB_OleContainer.WMDROPFILES(var Msg: TMessage);
var size: integer;
    fileName: PChar;
    LinkToObject, Iconic: Boolean;
begin
  inherited;
  size := DragQueryFile(Msg.WParam, 0 , nil, 0) + 1;
  fileName := StrAlloc(size);
  try
    Screen.Cursor := crHourGlass;
    try
      DragQueryFile(Msg.WParam, 0, fileName, size);
      LinkToObject := False; Iconic := False;
      if Assigned(FOnDropFile) then FOnDropFile(self, LinkToObject, Iconic);
      if LinkToObject then CreateLinkToFile(StrPas(fileName), Iconic) else CreateObjectFromFile(StrPas(fileName), Iconic);
    finally
      StrDispose(fileName);
      DragFinish(Msg.WParam);
      Screen.Cursor := crDefault;
    end;
  except
    if Assigned(FOnDropFileError) then FOnDropFileError(Self);
  end;
end;

procedure TIB_OleContainer.WMLButtonDblClk(var Message: TWMLButtonDblClk);
begin
  if (not FAutoDisplay) and (State = osEmpty) then begin
    LoadObject;
  end else begin
    inherited;
  end;
end;

procedure TIB_OleContainer.WMPaste(var Message: TMessage);
begin
  PasteFromClipboard;
end;


end.
