jvuiblib.pas

East make Tray Icon in delphi

    property FieldType[const Index: Word]: TUIBFieldType read GetFieldType;
  end;

  PPageInfo = ^TPageInfo;
  TPageInfo = packed record
    NextPage    : Pointer;
    UsageCounter: Integer;
  end;

  TMemoryPool = class
  private
    FItemSize    : Integer;
    FItemsInPage : Integer;
    FPageSize    : Integer;
    FFirstPage   : PPageInfo;
    FFreeList    : Pointer;
    FList        : TList;
    function GetCount: Integer;
    function GetItems(const Index: Integer): Pointer;
    procedure AddPage;
    procedure CleanFreeList(const PageStart : Pointer);
  public
    constructor Create(ItemSize, ItemsInPage : Integer);
    destructor Destroy; override;
    function New : Pointer;
    function PageCount : Integer;
    function PageUsageCount(const PageIndex : Integer) : Integer;
    procedure Dispose(var P: Pointer);
    function RemoveUnusedPages : Integer;

    property PageSize : Integer read FPageSize;
    property ItemsInPage : Integer read FItemsInPage;
    property ItemSize : Integer read FItemSize;
    property Items[const Index: Integer]: Pointer read GetItems;
    property Count: Integer read GetCount;
  end;

  TBlobData = packed record
    Size: Cardinal;
    Buffer: Pointer;
  end;
  TBlobDataArray = array[Word] of TBlobData;
  PBlobDataArray = ^TBlobDataArray;

  TSQLResult = class(TSQLDA)
  private
    FMemoryPool: TMemoryPool;
    FCachedFetch: boolean;
    FFetchBlobs: boolean;
    FDataBuffer: Pointer;
    FBlobArray: PBlobDataArray;
    FDataBufferLength: Word;
    FBlobsIndex: array of Word;
    FCurrentRecord: Integer;
    FBufferChunks: Cardinal;
    FScrollEOF: boolean;
    procedure AddCurrentRecord;
    procedure FreeBlobs(Buffer: Pointer);
    function GetRecordCount: Integer;
    function GetCurrentRecord: Integer;
    procedure AllocateDataBuffer;
    function GetBlobIndex(const Index: Word): Word;
    function GetEof: boolean;
    function GetUniqueRelationName: string;
    function GetBof: boolean;
  protected
    function GetAsString(const Index: Word): String; override;
    function GetAsWideString(const Index: Word): WideString; override;
    function GetAsVariant(const Index: Word): Variant; override;
  public
    constructor Create(Fields: SmallInt = 0;
      CachedFetch: Boolean = False;
      FetchBlobs: boolean = false;
      BufferChunks: Cardinal = 1000);
    destructor Destroy; override;
    procedure ClearRecords;
    procedure GetRecord(const Index: Integer);
    procedure SaveToStream(Stream: TStream);
    procedure LoadFromStream(Stream: TStream);

    procedure ReadBlob(const Index: Word; Stream: TStream); overload;
    procedure ReadBlob(const Index: Word; var str: string); overload;
    procedure ReadBlob(const Index: Word; var str: WideString); overload;
    procedure ReadBlob(const Index: Word; var Value: Variant); overload;
    procedure ReadBlob(const Index: Word; Data: Pointer); overload;
    procedure ReadBlob(const name: string; Stream: TStream); overload;
    procedure ReadBlob(const name: string; var str: string); overload;
    procedure ReadBlob(const name: string; var str: WideString); overload;
    procedure ReadBlob(const name: string; var Value: Variant); overload;
    procedure ReadBlob(const name: string; Data: Pointer); overload;

    function GetBlobSize(const Index: Word): Cardinal;

    property Eof: boolean read GetEof;
    property Bof: boolean read GetBof;

    property CachedFetch: boolean read FCachedFetch;
    property FetchBlobs: boolean read FFetchBlobs;
    property RecordCount: Integer read GetRecordCount;
    property CurrentRecord: Integer read GetCurrentRecord write GetRecord;
    property BufferChunks: Cardinal read FBufferChunks;
    property UniqueRelationName: string read GetUniqueRelationName;

    property SqlName[const Index: Word]: string read GetSqlName;
    property RelName[const Index: Word]: string read GetRelName;
    property OwnName[const Index: Word]: string read GetOwnName;
    property AliasName[const Index: Word]: string read GetAliasName;

    property AsSmallint   [const Index: Word]: Smallint   read GetAsSmallint;
    property AsInteger    [const Index: Word]: Integer    read GetAsInteger;
    property AsSingle     [const Index: Word]: Single     read GetAsSingle;
    property AsDouble     [const Index: Word]: Double     read GetAsDouble;
    property AsCurrency   [const Index: Word]: Currency   read GetAsCurrency;
    property AsInt64      [const Index: Word]: Int64      read GetAsInt64;
    property AsString     [const Index: Word]: String     read GetAsString;
    property AsWideString [const Index: Word]: WideString read GetAsWideString;
    property AsVariant    [const Index: Word]: Variant    read GetAsVariant;
    property AsDateTime   [const Index: Word]: TDateTime  read GetAsDateTime;
    property AsDate       [const Index: Word]: Integer    read GetAsDate;
    property AsTime       [const Index: Word]: Cardinal   read GetAsTime;
    property AsBoolean    [const Index: Word]: Boolean    read GetAsBoolean;

    property ByNameIsNull[const name: String]: boolean read GetByNameIsNull;
    property ByNameIsNullable[const name: String]: boolean read GetByNameIsNullable;

    property ByNameAsSmallint   [const name: String]: Smallint   read GetByNameAsSmallint;
    property ByNameAsInteger    [const name: String]: Integer    read GetByNameAsInteger;
    property ByNameAsSingle     [const name: String]: Single     read GetByNameAsSingle;
    property ByNameAsDouble     [const name: String]: Double     read GetByNameAsDouble;
    property ByNameAsCurrency   [const name: String]: Currency   read GetByNameAsCurrency;
    property ByNameAsInt64      [const name: String]: Int64      read GetByNameAsInt64;
    property ByNameAsString     [const name: String]: String     read GetByNameAsString;
    property ByNameAsWideString [const name: String]: WideString read GetByNameAsWideString;
    property ByNameAsQuad       [const name: String]: TISCQuad   read GetByNameAsQuad;
    property ByNameAsVariant    [const name: String]: Variant    read GetByNameAsVariant;
    property ByNameAsDateTime   [const name: String]: TDateTime  read GetByNameAsDateTime;
    property ByNameAsBoolean    [const name: String]: Boolean    read GetByNameAsBoolean;
    property ByNameAsDate       [const name: String]: Integer    read GetByNameAsDate;
    property ByNameAsTime       [const name: String]: Cardinal   read GetByNameAsTime;

    property Values[const name: String]: Variant read GetByNameAsVariant; default;
  end;

  TSQLResultClass = class of TSQLResult;

  TSQLParams = class(TSQLDA)
  private
    FParamCount: Word;
    procedure EncodeString(Code: Smallint; Index: Word; const str: String);
    procedure EncodeWideString(Code: Smallint; Index: Word; const str: WideString);
    function FindParam(const name: string; out Index: Word): boolean;
    function GetFieldName(const Index: Word): string;
  protected
    function AddField(const name: string): Word;
    procedure SetFieldType(const Index: Word; Size: Integer; Code: SmallInt;
      Scale: Smallint = 0);
    procedure SetIsNull(const Index: Word; const Value: boolean);

    procedure SetAsDouble(const Index: Word; const Value: Double);
    procedure SetAsCurrency(const Index: Word; const Value: Currency);
    procedure SetAsInt64(const Index: Word; const Value: Int64);
    procedure SetAsInteger(const Index: Word; const Value: Integer);
    procedure SetAsSingle(const Index: Word; const Value: Single);
    procedure SetAsSmallint(const Index: Word; const Value: Smallint);
    procedure SetAsString(const Index: Word; const Value: String);
    procedure SetAsWideString(const Index: Word; const Value: WideString);
    procedure SetAsQuad(const Index: Word; const Value: TISCQuad);
    procedure SetAsDateTime(const Index: Word; const Value: TDateTime);
    procedure SetAsBoolean(const Index: Word; const Value: Boolean);
    procedure SetAsDate(const Index: Word; const Value: Integer);
    procedure SetAsTime(const Index: Word; const Value: Cardinal);

    procedure SetByNameIsNull(const Name: String; const Value: boolean);
    procedure SetByNameAsDouble(const Name: String; const Value: Double);
    procedure SetByNameAsCurrency(const Name: String; const Value: Currency);
    procedure SetByNameAsInt64(const Name: String; const Value: Int64);
    procedure SetByNameAsInteger(const Name: String; const Value: Integer);
    procedure SetByNameAsSingle(const Name: String; const Value: Single);
    procedure SetByNameAsSmallint(const Name: String; const Value: Smallint);
    procedure SetByNameAsString(const Name: String; const Value: String);
    procedure SetByNameAsWideString(const Name: String; const Value: WideString);
    procedure SetByNameAsQuad(const Name: String; const Value: TISCQuad);
    procedure SetByNameAsDateTime(const Name: String; const Value: TDateTime);
    procedure SetByNameAsBoolean(const Name: String; const Value: boolean);
    procedure SetByNameAsDate(const Name: String; const Value: Integer);

    function GetFieldType(const Index: Word): TUIBFieldType; override;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Clear;
    function Parse(const SQL: string): string;
    function GetFieldIndex(const name: String): Word; override;

    procedure AddFieldType(const Name: string; FieldType: TUIBFieldType;
      Scale: TScale = 1; Precision: byte = 0);

    property IsNull[const Index: Word]: boolean read GetIsNull write SetIsNull;

    property AsSmallint   [const Index: Word]: Smallint   read GetAsSmallint   write SetAsSmallint;
    property AsInteger    [const Index: Word]: Integer    read GetAsInteger    write SetAsInteger;
    property AsSingle     [const Index: Word]: Single     read GetAsSingle     write SetAsSingle;
    property AsDouble     [const Index: Word]: Double     read GetAsDouble     write SetAsDouble;
    property AsCurrency   [const Index: Word]: Currency   read GetAsCurrency   write SetAsCurrency;
    property AsInt64      [const Index: Word]: Int64      read GetAsInt64      write SetAsInt64;
    property AsString     [const Index: Word]: String     read GetAsString     write SetAsString;
    property AsWideString [const Index: Word]: WideString read GetAsWideString write SetAsWideString;
    property AsQuad       [const Index: Word]: TISCQuad   read GetAsQuad       write SetAsQuad;
    property AsDateTime   [const Index: Word]: TDateTime  read GetAsDateTime   write SetAsDateTime;
    property AsBoolean    [const Index: Word]: Boolean    read GetAsBoolean    write SetAsBoolean;
    property AsDate       [const Index: Word]: Integer    read GetAsDate       write SetAsDate;
    property AsTime       [const Index: Word]: Cardinal   read GetAsTime       write SetAsTime;

    property ByNameIsNull[const name: String]: boolean read GetByNameIsNull write SetByNameIsNull;

    property ByNameAsSmallint   [const name: String]: Smallint   read GetByNameAsSmallint   write SetByNameAsSmallint;
    property ByNameAsInteger    [const name: String]: Integer    read GetByNameAsInteger    write SetByNameAsInteger;
    property ByNameAsSingle     [const name: String]: Single     read GetByNameAsSingle     write SetByNameAsSingle;
    property ByNameAsDouble     [const name: String]: Double     read GetByNameAsDouble     write SetByNameAsDouble;
    property ByNameAsCurrency   [const name: String]: Currency   read GetByNameAsCurrency   write SetByNameAsCurrency;
    property ByNameAsInt64      [const name: String]: Int64      read GetByNameAsInt64      write SetByNameAsInt64;
    property ByNameAsString     [const name: String]: String     read GetByNameAsString     write SetByNameAsString;
    property ByNameAsWideString [const name: String]: WideString read GetByNameAsWideString write SetByNameAsWideString;
    property ByNameAsQuad       [const name: String]: TISCQuad   read GetByNameAsQuad       write SetByNameAsQuad;
    property ByNameAsVariant    [const name: String]: Variant    read GetByNameAsVariant;
    property ByNameAsDateTime   [const name: String]: TDateTime  read GetByNameAsDateTime   write SetByNameAsDateTime;
    property ByNameAsBoolean    [const name: String]: Boolean    read GetByNameAsBoolean    write SetByNameAsBoolean;
    property ByNameAsDate       [const name: String]: Integer    read GetByNameAsDate       write SetByNameAsDate;

    property Values[const name: String]: Variant read GetByNameAsVariant; default;
    property FieldName[const Index: Word]: string read GetFieldName;
    property ParamCount : Word read FParamCount;
  end;

  TSQLParamsClass = class of TSQLParams;

type
  TDSQLInfoData = packed record
    InfoCode: byte;
    InfoLen : Word; // isc_portable_integer convert a SmallInt to Word ??? so just say it is a word
    case byte of
      isc_info_sql_stmt_type: (StatementType: TUIBStatementType);
      isc_info_sql_get_plan : (PlanDesc     : array[0..255] of Char);
  end;

{$IFDEF IB7_UP}
  TArrayDesc = TISCArrayDescV2;
  TBlobDesc = TISCBlobDescV2;
{$ELSE}
  TArrayDesc = TISCArrayDesc;
  TBlobDesc = TISCBlobDesc;
{$ENDIF IB7_UP}

  TUIBLibrary = class;

  TStatusVector = array[0..19] of ISCStatus;
  PStatusVector = ^TStatusVector;

  TOnConnectionLost = procedure(Lib: TUIBLibrary) of object;
  TOnGetDBExceptionClass = procedure(Number: Integer; out Excep: EUIBExceptionClass) of object;
  
  TUIBLibrary = class(TUIBaseLibrary)
  private
    FStatusVector: TStatusVector;
    FOnConnectionLost: TOnConnectionLost;
    FOnGetDBExceptionClass: TOnGetDBExceptionClass;
    FRaiseErrors: boolean;
    FSegmentSize: Word;
    function GetSegmentSize: Word;
    procedure SetSegmentSize(Value: Word);
    procedure CheckUIBApiCall(const Status: ISCStatus);
  public
    constructor Create; override;

    property OnConnectionLost: TOnConnectionLost read FOnConnectionLost write FOnConnectionLost;
    property OnGetDBExceptionClass: TOnGetDBExceptionClass read FOnGetDBExceptionClass write FOnGetDBExceptionClass;
    property RaiseErrors: boolean read FRaiseErrors write FRaiseErrors default True;


    {Attaches to an existing database.
     Ex: AttachDatabase('c:\DataBase.gdb', DBHandle, 'user_name=SYSDBA; password=masterkey'); }
    procedure AttachDatabase(FileName: String; var DbHandle: IscDbHandle; Params: String; Sep: Char = ';');
    {Detaches from a database previously connected with AttachDatabase.}
    procedure DetachDatabase(var DBHandle: IscDbHandle);

    procedure TransactionStart(var TraHandle: IscTrHandle; var DbHandle: IscDbHandle; const TPB: string = '');
    procedure TransactionStartMultiple(var TraHandle: IscTrHandle; DBCount: Smallint; Vector: PISCTEB);
    procedure TransactionCommit(var TraHandle: IscTrHandle);
    procedure TransactionRollback(var TraHandle: IscTrHandle);
    procedure TransactionCommitRetaining(var TraHandle: IscTrHandle);
    procedure TransactionPrepare(var TraHandle: IscTrHandle);
    procedure TransactionRollbackRetaining(var TraHandle: IscTrHandle);
    procedure DSQLExecuteImmediate(var DBHandle: IscDbHandle; var TraHandle: IscTrHandle;
      const Statement: string; Dialect: Word; Sqlda: TSQLDA = nil); overload;
    procedure DSQLExecuteImmediate(const Statement: string; Dialect: Word; Sqlda: TSQLDA = nil); overload;
    procedure DSQLAllocateStatement(var DBHandle: IscDbHandle; var StmtHandle: IscStmtHandle);
    function DSQLPrepare(var TraHandle: IscTrHandle; var StmtHandle: IscStmtHandle;
      Statement: string; Dialect: Word; Sqlda: TSQLResult = nil): TUIBStatementType;
    procedure DSQLExecute(var TraHandle: IscTrHandle; var StmtHandle: IscStmtHandle;
      Dialect: Word; Sqlda: TSQLParams = nil);
    procedure DSQLExecute2(var TraHandle: IscTrHandle; var StmtHandle: IscStmtHandle;
      Dialect: Word; InSqlda: TSQLParams; OutSqlda: TSQLResult);
    procedure DSQLFreeStatement(var StmtHandle: IscStmtHandle; Option: Word);
    function  DSQLFetch(var StmtHandle: IscStmtHandle; Dialect: Word; Sqlda: TSQLResult): boolean;
    function  DSQLFetchWithBlobs(var DBHhandle: IscDbHandle; var TraHandle: IscTrHandle;
      var StmtHandle: IscStmtHandle; Dialect: Word; Sqlda: TSQLResult): boolean;
    procedure DSQLDescribe(var StmtHandle: IscStmtHandle; Dialect: Word; Sqlda: TSQLResult);
    procedure DSQLDescribeBind(var StmtHandle: IscStmtHandle; Dialect: Word; Sqlda: TSQLDA);
    procedure DSQLSetCursorName(var StmtHandle: IscStmtHandle; const cursor: string);
    procedure DSQLExecImmed2(var DBHhandle: IscDbHandle; var TraHandle: IscTrHandle;
      const Statement: string; dialect: Word; InSqlda, OutSqlda: TSQLDA);

    procedure DSQLInfo(var StmtHandle: IscStmtHandle; const Items: array of byte; var buffer: String);
    function  DSQLInfoPlan(var StmtHandle: IscStmtHandle): string;
    function  DSQLInfoStatementType(var StmtHandle: IscStmtHandle): TUIBStatementType;
    function  DSQLInfoRowsAffected(var StmtHandle: IscStmtHandle;
      StatementType: TUIBStatementType): Cardinal;

    procedure DDLExecute(var DBHandle: IscDbHandle; var TraHandle: IscTrHandle; const ddl: string);