fibmiscellaneous.pas

FIBPlus is a component suite intended for work with InterBase. It is direct, fast and flexible Inter

{***************************************************************}
{ FIBPlus - component library for direct access to Firebird and }
{ InterBase databases                                           }
{                                                               }
{    FIBPlus is based in part on the product                    }
{    Free IB Components, written by Gregory H. Deatz for        }
{    Hoagland, Longo, Moran, Dunst & Doukas Company.            }
{    mailto:[e-mail]                                    }
{                                                               }
{    Copyright (c) 1998-2007 Devrace Ltd.                       }
{    Written by Serge Buzadzhy ([e-mail])               }
{                                                               }
{ ------------------------------------------------------------- }
{    FIBPlus home page: http://www.fibplus.com/                 }
{    FIBPlus support  : http://www.devrace.com/support/         }
{ ------------------------------------------------------------- }
{                                                               }
{  Please see the file License.txt for full license information }
{***************************************************************}


unit FIBMiscellaneous;


interface

{$I FIBPlus.inc}
uses
 {$IFDEF WINDOWS}  Windows, {$ENDIF}
 {$IFDEF LINUX}  Types,Libc  , {$ENDIF}
  SysUtils, Classes, ibase,IB_Intf,IB_Externals,
  DB, fib, FIBDatabase, FIBQuery, StdFuncs,IB_ErrorCodes ;

const
  DefaultBlobSegmentSize = High(Word);

type
  (* TFIBBlobStream *)
  TFIBBlobStream = class(TStream)
  private
    FDatabase:TFIBDatabase;
    FTransaction:TFIBTransaction;
    FUpdateTransaction:TFIBTransaction;
    FBlobID: TISC_QUAD;
    FBlobMaxSegmentSize,           // Maximum segment size
    FBlobNumSegments,              // How many segments?
    FBlobSize: Long;               // Blob size
    FOldBlobSize: Long;
    FBlobType: Short;              // 0 = segmented, 1 = streamed.
    FBlobSubType: Long;  // ivan_ra
    FBuffer: PChar;
    FOldBuffer: PChar;
    FBlobInitialized: Boolean;     // Has the blob been "opened" yet?
    FBlobHandle: TISC_BLOB_HANDLE;
    FMode: TBlobStreamMode;        // (bmRead, bmWrite, bmReadWrite);
    FModified: Boolean;            // When finalize is called, does it need to do anything?
    FPosition: Long;              // The current position in the stream.

    FBlobStreamList:TList;
    FIndexInList:integer;
    FFieldNo    :integer;
    FNeedSaveOldBuffer :boolean;
    FTableName:string;
    FFieldName:string;
    FKeyValues:TDynArray;
    FLoadedFromCache:boolean;
    FIsClientField:boolean;
    FCharSet:integer;
    function GetUpdateTRHandle: PISC_TR_HANDLE;
    function GetRecKeyValuesAsStr:string;
  protected
    procedure DoOnDatabaseFree(Sender:TObject);
    procedure CreateBlob;
    procedure EnsureBlobInitialized;
    procedure GetBlobInfo;
    function  GetDatabase: TFIBDatabase;
    function  GetDBHandle: PISC_DB_HANDLE;
    function  GetTransaction: TFIBTransaction;
    function  GetUpdateTransaction: TFIBTransaction;
    function  GetTRHandle: PISC_TR_HANDLE;
    procedure CheckHandles(ReadTransaction:boolean=True);
    procedure OpenBlob;
    procedure SetBlobID(const Value: TISC_QUAD);
    procedure ReplaceBlobID(const Value: TISC_QUAD);
    procedure SetDatabase(Value: TFIBDatabase);
    procedure SetMode(Value: TBlobStreamMode);
    procedure SetTransaction(Value: TFIBTransaction);
    procedure SetUpdateTransaction(Value: TFIBTransaction);
    function  GetAsString: string;
    procedure SaveOldBuffer;
  public
    constructor CreateNew(aFieldNo:integer;aBlobStreamList:TList;
         const aTableName:string = '';
         const aFieldName:string = '';
         PKeyValues:PDynArray=nil
    );
    constructor Create;
    procedure InternalSetCharSet(Value:integer); // Internal Use only
    destructor Destroy; override;
    function  Call(ErrCode: ISC_STATUS; RaiseError: Boolean): ISC_STATUS;
    procedure CheckReadable;
    procedure CheckWritable;
    procedure DoFinalize(ClearModified, ForceWrite:Boolean);
    procedure Finalize;
    procedure CloseBlob;
    procedure Cancel;
    procedure FreeOldBuffer;
    procedure DeInitialize;
    function  LoadFromFile(const Filename: string;IsCacheFile:boolean=False):boolean;
    function  LoadFromStream(Stream: TStream;IsCacheStream:boolean=False):boolean;
    function  Read(var Buffer; Count: Longint): Longint; override;
    function  ReadOldBuffer(var Buffer; Count: Longint): Longint;
    function  GenerateSwapFileName(ForceDir:boolean):string;
    procedure SaveToSwapFile;
    procedure SaveToFile(const Filename: string;FullInfo:boolean=False);
    procedure SaveToStream(Stream: TStream;IsCacheStream:boolean=False);
    function  Seek(Offset: Longint; Origin: Word): Longint; override;
    function  SeekInOldBuffer(Offset: Longint; Origin: Word): Longint;     
    procedure SetSize(NewSize: Long); override;
    procedure Truncate;
    function  Write(const Buffer; Count: Longint): Longint; override;
    // properties
    property BlobInitialized:boolean read FBlobInitialized;
    property Handle: TISC_BLOB_HANDLE read FBlobHandle;
    property BlobHandle: TISC_BLOB_HANDLE read FBlobHandle;    
    property BlobID: TISC_QUAD read FBlobID write SetBlobID;
    property BlobMaxSegmentSize: Long read FBlobMaxSegmentSize;
    property BlobNumSegments: Long read FBlobNumSegments;
    property BlobSize: Long read FBlobSize;
    property BlobType: Short read FBlobType;
    property BlobSubType: Long read FBlobSubType write FBlobSubType;    // ivan_ra    
    property Database: TFIBDatabase read GetDatabase write SetDatabase;
    property DBHandle: PISC_DB_HANDLE read GetDBHandle;
    property Mode: TBlobStreamMode read FMode write SetMode;
    property Modified: Boolean read FModified;
    property Transaction: TFIBTransaction read GetTransaction write SetTransaction;
    property UpdateTransaction: TFIBTransaction read GetUpdateTransaction write SetUpdateTransaction;
    property TRHandle: PISC_TR_HANDLE read GetTRHandle;
    property UpdateTRHandle: PISC_TR_HANDLE read GetUpdateTRHandle;
    property AsString:string read GetAsString;
    property FieldNo :integer read FFieldNo;
    property IndexInList:integer read FIndexInList;

    property FieldName:string read FFieldName write FFieldName;
    property TableName:string read FTableName write FTableName;
    property RecordKeyValues:TDynArray read FKeyValues write FKeyValues;
    property IsClientField:boolean read FIsClientField write FIsClientField;
  end;
// Blob routine functions

  procedure GetBlobInfo(ClientLibrary:IIbClientLibrary; hBlobHandle: PISC_BLOB_HANDLE;
    var NumSegments, MaxSegmentSize, TotalSize: Long; var BlobType: Short);
  procedure ReadBlob(ClientLibrary:IIbClientLibrary; hBlobHandle: PISC_BLOB_HANDLE; var Buffer: PChar;
    var BlobSize: Long);
  procedure WriteBlob(ClientLibrary:IIbClientLibrary; hBlobHandle: PISC_BLOB_HANDLE; Buffer: PChar;
    BlobSize: Long);

  function BlobExist(ClientLibrary:IIbClientLibrary; DBHandle:TISC_DB_HANDLE;
   TRHandle:TISC_TR_HANDLE;blob_id : TISC_QUAD
  ):boolean;

{$IFDEF WINDOWS}
type
  (* TFIBOutputDelimitedFile *)
  TFIBOutputDelimitedFile = class(TFIBBatchOutputStream)
  protected
    FHandle: THandle;
    FOutputTitles: Boolean;
    FColDelimiter,
    FRowDelimiter: string;
  public
    destructor Destroy; override;
    procedure ReadyStream; override;
    function WriteColumns: Boolean; override;
    property ColDelimiter: string read FColDelimiter write FColDelimiter;
    property OutputTitles: Boolean read FOutputTitles
                                   write FOutputTitles;
    property RowDelimiter: string read FRowDelimiter write FRowDelimiter;
  end;

  (* TFIBInputDelimitedFile *)
  TFIBInputDelimitedFile = class(TFIBBatchInputStream)
  protected
    FColDelimiter,
    FRowDelimiter: string;
    FEOF: Boolean;
    FFile: TFileStream;
    FLookAhead: Char;
    FReadBlanksAsNull: Boolean;
    FSkipTitles: Boolean;
  public
    destructor Destroy; override;
    function GetColumn(var Col: string): Integer;
    function ReadParameters: Boolean; override;
    procedure ReadyStream; override;
    property ColDelimiter: string read FColDelimiter write FColDelimiter;
    property ReadBlanksAsNull: Boolean read FReadBlanksAsNull
                                       write FReadBlanksAsNull;
    property RowDelimiter: string read FRowDelimiter write FRowDelimiter;
    property SkipTitles: Boolean read FSkipTitles write FSkipTitles;
  end;

  (* TFIBOutputRawFile *)
  TFIBOutputRawFile = class(TFIBBatchOutputStream)
  protected
    FHandle: THandle;
    FVersion:integer;
  public
    constructor Create;
    constructor CreateEx(aVersion:integer);
    destructor Destroy; override;
    procedure  ReadyStream; override;
    function   WriteColumns: Boolean; override;
  end;

 (* TFIBInputRawFile *)
  TFIBInputRawFile = class(TFIBBatchInputStream)
  protected
    FHandle: THandle;
    FVersion:Char;
    FMap:TList;
    SkippedLen:array of integer;
  public
    destructor Destroy; override;
    function  ReadParameters: Boolean; override;
    procedure ReadyStream; override;
  end;

{$ENDIF}
var
  NullQUID:TISC_QUAD;