3033 lines
92 KiB
ObjectPascal
3033 lines
92 KiB
ObjectPascal
{******************************************************************************}
|
|
{ UNIFIED INTERBASE (UIB) }
|
|
{ }
|
|
{ Project JEDI Code Library (JCL) }
|
|
{ }
|
|
{ The contents of this file are subject to the Mozilla Public License Version }
|
|
{ 1.1 (the "License"); you may not use this file except in compliance with the }
|
|
{ License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ }
|
|
{ }
|
|
{ Software distributed under the License is distributed on an "AS IS" basis, }
|
|
{ WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for }
|
|
{ the specific language governing rights and limitations under the License. }
|
|
{ }
|
|
{ The Initial Developer of the Original Code is documented in the accompanying }
|
|
{ help file JCL.chm. Portions created by these individuals are Copyright (C) }
|
|
{ 2003 of these individuals. }
|
|
{ }
|
|
{ Unit owner: Henri Gourvest }
|
|
{ Last modified: September 21, 2003 }
|
|
{ }
|
|
{******************************************************************************}
|
|
|
|
{ @abstract(UIB Visual components.)
|
|
@author(Henri Gourvest: hgourvest@progdigy.com)
|
|
@lastmod(Jan 16, 2003)}
|
|
|
|
unit JvUIB;
|
|
|
|
{$I jvcl.inc}
|
|
{$I JvUIB.inc}
|
|
|
|
(*------------------------------------------------------------------------------
|
|
This is a cascading programming style.
|
|
|
|
..............oOo...............................oOo.........oOo.................
|
|
States | Operations | Commands | Components
|
|
..............oOo...............................oOo.........oOo.................
|
|
qsDataBase | BeginDataBase(L) | | TUIBDataBase
|
|
--------------------------------------------------------------------------------
|
|
qsTransaction | |-> BeginTransaction | | TUIBTransaction
|
|
--------------------------------------------------------------------------------
|
|
qsExecImme | |-> BeginExecImme .........|.[ExecSQL] | TUIBQuery
|
|
qsStatement | |-> BeginStatement | |
|
|
qsPrepare | | |-> BeginPrepare | |
|
|
qsExecute | | | |-> BeginExecute |.[Execute] |
|
|
| | | | |-> Next ......|.[Open] |
|
|
| | | | | | | |
|
|
| R <- E E E E E | [Fields] |
|
|
| | | | | | |
|
|
qsExecute | | | |<- EndExecute |.[Close] |
|
|
qsPrepare | | |<- EndPrepare | |
|
|
qsStatement | |<- EndStatement | |
|
|
-------------------------------------------------------------------------------
|
|
qsTransaction | EndTransaction | | TUIBTransaction
|
|
..............oOo...............................oOo.........oOo.................
|
|
LEGEND
|
|
E = Except
|
|
R = Raise
|
|
-> = Call
|
|
------------------------------------------------------------------------------*)
|
|
|
|
interface
|
|
uses
|
|
{$IFDEF USEJVCL}
|
|
{$IFDEF UNITVERSIONING}
|
|
JclUnitVersioning,
|
|
{$ENDIF UNITVERSIONING}
|
|
{$ENDIF USEJVCL}
|
|
{$IFDEF MSWINDOWS}
|
|
Windows,
|
|
{$ENDIF MSWINDOWS}
|
|
{$IFDEF USEJVCL}
|
|
JvComponentBase,
|
|
{$ENDIF USEJVCL}
|
|
Classes, SysUtils, SyncObjs, JvUIBLib, JvUIBase, JvUIBSQLParser, JvUIBConst;
|
|
|
|
type
|
|
|
|
{Oo.........................................................................oO
|
|
TJvUIBComponent
|
|
|
|
Synchronise Databases, Transactions and Queries.
|
|
|
|
TUIBLibrary | TUIBDatabase | TUIBTransaction | TUIBQuery
|
|
==========================================================================
|
|
Lock <---------|------------------|------------------|-----------------o
|
|
| Lock <-----------|------------------|---------------o
|
|
| | Lock <-----------|-------------o
|
|
| | | Lock <--o
|
|
| | | UnLock <--o
|
|
| | UnLock <---------|-------------o
|
|
| UnLock <---------|------------------|---------------o
|
|
UnLock <-------|------------------|------------------|-----------------o
|
|
|
|
Note: With Interbase 7, no need to synchronise anything but removing
|
|
Synchronisation you have exactly the same performance than IB6.01 with
|
|
Synchronisation on a single CPU !
|
|
|
|
Oo.........................................................................oO}
|
|
|
|
{ All UIB components inherith from this class to encapsulate Critical Sections.
|
|
Critical Sections make UIB THread Safe. }
|
|
{$IFDEF USEJVCL}
|
|
TJvUIBComponent = class(TJvComponent)
|
|
{$ELSE}
|
|
TJvUIBComponent = class(TComponent)
|
|
{$ENDIF USEJVCL}
|
|
private
|
|
FCriticalsection: TCriticalSection;
|
|
public
|
|
{ @exclude }
|
|
constructor Create(AOwner: TComponent); override;
|
|
{ @exclude }
|
|
destructor Destroy; override;
|
|
{ Lock the critical Section. }
|
|
procedure Lock; virtual;
|
|
{ UnLock the critical Section. }
|
|
procedure UnLock; virtual;
|
|
end;
|
|
|
|
// Forward declarations
|
|
TJvUIBTransaction = class;
|
|
TJvUIBQuery = class;
|
|
TJvUIBStatement = class;
|
|
TJvUIBDataBase = class;
|
|
|
|
{ The list of MetaData Objects returned by TJvUIBDatabase.GetMetadata function. }
|
|
TMetaDataOptions = class(TPersistent)
|
|
private
|
|
FObjects: TOIDDatabases;
|
|
FTables: TOIDTables;
|
|
FViews: TOIDViews;
|
|
FProcedures: TOIDProcedures;
|
|
FUDFs: TOIDUDFs;
|
|
FSysInfos: boolean;
|
|
public
|
|
{ @exclude }
|
|
constructor Create;
|
|
published
|
|
{ Metadata objects (Procedure, Generator, Exception, UDF, Role). }
|
|
property Objects: TOIDDatabases read FObjects write FObjects default ALLObjects;
|
|
{ Table properties (TableField, Primary, Foreign, TableTrigger, Unique, Index, Check)}
|
|
property Tables: TOIDTables read FTables write FTables default ALLTables;
|
|
{ View properties (Fields & Triggers)}
|
|
property Views: TOIDViews read FViews write FViews default AllViews;
|
|
{ Procedure properties (input & output parametters). }
|
|
property Procedures: TOIDProcedures read FProcedures write FProcedures default AllProcedures;
|
|
{ UDFs properties (Fields). }
|
|
property UDFs: TOIDUDFs read FUDFs write FUDFs default AllUDFs;
|
|
{ Include System tables, triggers and domains. }
|
|
property SysInfos: boolean read FSysInfos write FSysInfos default False;
|
|
end;
|
|
|
|
TJvUIBDataBase = class(TJvUIBComponent)
|
|
private
|
|
FLibrary: TUIBLibrary;
|
|
FLiBraryName: TFileName;
|
|
FDbHandle: IscDbHandle;
|
|
FHandleShared: boolean;
|
|
FParams: TStrings;
|
|
FDatabaseName: TFileName;
|
|
FAfterConnect: TNotifyEvent;
|
|
FAfterDisconnect: TNotifyEvent;
|
|
FBeforeConnect: TNotifyEvent;
|
|
FBeforeDisconnect: TNotifyEvent;
|
|
FTransactions: TList;
|
|
FOnConnectionLost: TNotifyEvent;
|
|
FExceptions: TList;
|
|
FMetadata: TObject;
|
|
FMetaDataOptions: TMetaDataOptions;
|
|
function ReadParamString(Param: String; Default: String = ''): String;
|
|
procedure WriteParamString(Param: String; Value: String);
|
|
function ReadParamInteger(Param: String; Default: Integer): Integer;
|
|
procedure WriteParamInteger(Param: String; Value: Integer);
|
|
procedure SetParams(const Value: TStrings);
|
|
procedure SetDatabaseName(const Value: TFileName);
|
|
procedure SetConnected(const Value: Boolean);
|
|
function GetConnected: Boolean;
|
|
procedure SetSQLDialect(const Value: Integer);
|
|
function GetSQLDialect: Integer;
|
|
function GetCharacterSet: TCharacterSet;
|
|
procedure SetCharacterSet(const Value: TCharacterSet);
|
|
function GetPassWord: string;
|
|
function GetUserName: string;
|
|
procedure SetPassWord(const Value: string);
|
|
procedure SetUserName(const Value: string);
|
|
procedure AddTransaction(Transaction: TJvUIBTransaction);
|
|
procedure RemoveTransaction(Transaction: TJvUIBTransaction);
|
|
procedure ClearTransactions;
|
|
procedure CloseTransactions;
|
|
procedure SetDbHandle(const Value: IscDbHandle);
|
|
procedure SetLibraryName(const Lib: TFileName);
|
|
function GetTransactions(const Index: Cardinal): TJvUIBTransaction;
|
|
function GetTransactionsCount: Cardinal;
|
|
function GetSegmentSize: Word;
|
|
procedure SetSegmentSize(const Value: Word);
|
|
protected
|
|
procedure DoOnConnectionLost(Lib: TUIBLibrary); virtual;
|
|
procedure DoOnGetDBExceptionClass(Number: Integer; out Excep: EUIBExceptionClass); virtual;
|
|
public
|
|
{ Constructor method. }
|
|
constructor Create(AOwner: TComponent); override;
|
|
{ Destructor method. }
|
|
destructor Destroy; override;
|
|
{ Execute a SQL statement without the need to have the database connected,
|
|
it is usefull to create a database by SQL. }
|
|
procedure ExecuteImmediate(const Statement: string);
|
|
{ Remove all Interbase Exception class registered using 'RegistedException'. }
|
|
procedure ClearExceptions;
|
|
{ Associate an Interbase Exception with a Delphi exception, ID is the Exception Identifier number. }
|
|
procedure RegisterException(Excpt: EUIBExceptionClass; ID: Integer); overload;
|
|
{ Associate an Interbase Exception with a Delphi exception, Name is the Interbase Exception name. }
|
|
function RegisterException(Excpt: EUIBExceptionClass; const Name: string): Integer; overload;
|
|
{ Remove the Registered Exception number. }
|
|
procedure UnRegisterException(Number: Integer);
|
|
{ Remove the Registered Exception class. }
|
|
procedure UnRegisterExceptions(Excpt: EUIBExceptionClass);
|
|
{ Create a database with a default page size of 2048. }
|
|
procedure CreateDatabase(PageSize: Integer = 2048);
|
|
{ Return a TMetaDatabase class corresponding to the current connection. }
|
|
function GetMetadata(Refresh: boolean = False): TObject;
|
|
{ The DbHandle can be used to share the current connection with other Interbase components like IBX. }
|
|
property DbHandle: IscDbHandle read FDbHandle write SetDbHandle;
|
|
{ Determine if the DbHandle is initialized by another component. }
|
|
property IsHandleShared : Boolean read FHandleShared;
|
|
{ List all transactions connected to the database component. }
|
|
property Transactions[const Index: Cardinal]: TJvUIBTransaction read GetTransactions;
|
|
{ Number of connected transactions. }
|
|
property TransactionsCount: Cardinal read GetTransactionsCount;
|
|
{ Can be used to access the low level API. }
|
|
property Lib: TUIBLibrary read FLibrary;
|
|
published
|
|
{ DataBase connection parametters. }
|
|
property Params: TStrings read FParams write SetParams;
|
|
{ Database file name. }
|
|
property DatabaseName: TFileName read FDatabaseName write SetDatabaseName;
|
|
{ Connect or disconnect a database. }
|
|
property Connected: Boolean read GetConnected write SetConnected default False;
|
|
{ The SQL dialect gives access to DSQL features, set the dialect to 1 or 3.
|
|
Dialect 3 gives access to features introduced in InterBase 6. }
|
|
property SQLDialect: Integer read GetSQLDialect write SetSQLDialect default 3;
|
|
{ Character set to be utilized. }
|
|
property CharacterSet: TCharacterSet read GetCharacterSet write SetCharacterSet default csNONE;
|
|
{ Set the user name. Default = SYSDBA. }
|
|
property UserName: string read GetUserName write SetUserName;
|
|
{ Set the Password. Default = masterkey. }
|
|
property PassWord: string read GetPassWord write SetPassWord;
|
|
{ Define wich library the connection use.}
|
|
property LibraryName: TFileName read FLiBraryName write SetLibraryName;
|
|
{ This event occur after the component is connected to database. }
|
|
property AfterConnect: TNotifyEvent read FAfterConnect write FAfterConnect;
|
|
{ This event occur before the component is connected to database. }
|
|
property BeforeConnect: TNotifyEvent read FBeforeConnect write FBeforeConnect;
|
|
{ This event occur after the component is disconnected from database. }
|
|
property AfterDisconnect: TNotifyEvent read FAfterDisconnect write FAfterDisconnect;
|
|
{ This event occur before the component is disconnected from database. }
|
|
property BeforeDisconnect: TNotifyEvent read FBeforeDisconnect write FBeforeDisconnect;
|
|
{ When connection lost, Database, Transactions and Queries are automatically closed.
|
|
Only one exception is raised to terminate the current stack and this event occur. }
|
|
property OnConnectionLost: TNotifyEvent read FOnConnectionLost write FOnConnectionLost;
|
|
{ The blob segment size used to write in database, this parametter depend on hard drive. }
|
|
property SegmentSize: Word read GetSegmentSize write SetSegmentSize default 16*1024;
|
|
{ The list of MetaData Objects returned by GetMetadata. }
|
|
property MetaDataOptions: TMetaDataOptions read FMetaDataOptions;
|
|
end;
|
|
|
|
{ Describe how a transaction is closed. }
|
|
TEndTransMode = (
|
|
etmDefault, // Use default Transaction Action
|
|
etmStayIn, // keep transaction without commit or rollback
|
|
etmCommit, // commit transaction
|
|
etmCommitRetaining, // commit transaction and keep transaction handle
|
|
etmRollback, // rollback transaction
|
|
etmRollbackRetaining // rollback transaction and keep transaction handle
|
|
);
|
|
|
|
{ Indicate the Query state.
|
|
order is important ! }
|
|
TQueryState = (
|
|
qsDataBase, // have a database handle
|
|
qsTransaction, // have a transaction handle
|
|
qsExecImme, // Query executed immediately without the need of statement handle
|
|
qsStatement, // have a statement handle
|
|
qsPrepare, // Query prepared
|
|
qsExecute // Query executed
|
|
);
|
|
|
|
{Oo.......................................................................oO
|
|
TUIBTransaction
|
|
Oo.......................................................................oO}
|
|
|
|
// Transaction parameters
|
|
TTransParam = (
|
|
{ prevents a transaction from accessing tables if they are written to by
|
|
other transactions.}
|
|
tpConsistency,
|
|
{ allows concurrent transactions to read and write shared data. }
|
|
tpConcurrency,
|
|
{ Concurrent, shared access of a specified table among all transactions. }
|
|
tpShared,
|
|
{ Concurrent, restricted access of a specified table. }
|
|
tpProtected,
|
|
tpExclusive,
|
|
{ Specifies that the transaction is to wait until the conflicting resource
|
|
is released before retrying an operation [Default]. }
|
|
tpWait,
|
|
{ Specifies that the transaction is not to wait for the resource to be
|
|
released, but instead, should return an update conflict error immediately. }
|
|
tpNowait,
|
|
{ Read-only access mode that allows a transaction only to select data from tables. }
|
|
tpRead,
|
|
{ Read-write access mode of that allows a transaction to select, insert,
|
|
update, and delete table data [Default]. }
|
|
tpWrite,
|
|
{ Read-only access of a specified table. Use in conjunction with tpShared,
|
|
tpProtected, and tpExclusive to establish the lock option. }
|
|
tpLockRead,
|
|
{ Read-write access of a specified table. Use in conjunction with tpShared,
|
|
tpProtected, and tpExclusive to establish the lock option [Default]. }
|
|
tpLockWrite,
|
|
tpVerbTime,
|
|
tpCommitTime,
|
|
tpIgnoreLimbo,
|
|
{ Unlike a concurrency transaction, a read committed transaction sees changes
|
|
made and committed by transactions that were active after this transaction started. }
|
|
tpReadCommitted,
|
|
tpAutoCommit,
|
|
{ Enables an tpReadCommitted transaction to read only the latest committed
|
|
version of a record. }
|
|
tpRecVersion,
|
|
tpNoRecVersion,
|
|
tpRestartRequests,
|
|
tpNoAutoUndo
|
|
);
|
|
|
|
{ Set of transaction parameters. }
|
|
TTransParams = set of TTransParam;
|
|
{This evenet occur before to end the transaction, you can change the ETM parametter.}
|
|
TOnEndTransaction = procedure(Sender: TObject; var Mode: TEndTransMode) of object;
|
|
|
|
{ The Transaction component. }
|
|
TJvUIBTransaction = class(TJvUIBComponent)
|
|
private
|
|
FDataBase: TJvUIBDataBase;
|
|
FDataBases: TList;
|
|
FTrHandle: IscTrHandle;
|
|
FSQLComponent: TList;
|
|
FStatements: Integer;
|
|
FOptions : TTransParams;
|
|
FLockRead : string;
|
|
FLockWrite : string;
|
|
FSQLDialect: Integer;
|
|
FOnStartTransaction: TNotifyEvent;
|
|
FOnEndTransaction: TOnEndTransaction;
|
|
FAutoRetain: boolean;
|
|
FAutoStart: boolean;
|
|
FAutoStop: boolean;
|
|
FDefaultAction: TEndTransMode;
|
|
function GetInTransaction: Boolean;
|
|
function TPB: string;
|
|
function GetOptions: TTransParams;
|
|
procedure SetOptions(const Value: TTransParams);
|
|
function GetLockRead: string;
|
|
function GetLockWrite: string;
|
|
procedure SetLockRead(const Value: string);
|
|
procedure SetLockWrite(const Value: string);
|
|
function GetDataBase: TJvUIBDataBase;
|
|
procedure BeginDataBase;
|
|
procedure BeginTransaction(Auto: boolean = True);
|
|
function EndTransaction(ETM: TEndTransMode; From: TJvUIBStatement;
|
|
Auto: boolean): boolean;
|
|
procedure AddSQLComponent(Component: TJvUIBStatement);
|
|
procedure RemoveSQLComponent(Component: TJvUIBStatement);
|
|
procedure ClearSQLComponents;
|
|
procedure Close(const Mode: TEndTransMode; Auto: boolean);
|
|
function GetStatements(const Index: Integer): TJvUIBStatement;
|
|
function GetStatementsCount: Integer;
|
|
procedure ClearDataBases;
|
|
function GetDatabases(const Index: Integer): TJvUIBDataBase;
|
|
function GetDatabasesCount: Integer;
|
|
function GetAutoRetain: boolean;
|
|
procedure SetAutoRetain(const Value: boolean);
|
|
procedure SetDefaultAction(const Value: TEndTransMode);
|
|
protected
|
|
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
|
procedure SetDataBase(const ADatabase: TJvUIBDataBase); virtual;
|
|
public
|
|
{ Constructor method. }
|
|
constructor Create(AOwner: TComponent); override;
|
|
{ Destructor method.}
|
|
destructor Destroy; override;
|
|
{ cf TjvUIBComponent.Lock }
|
|
procedure Lock; override;
|
|
{ cf TjvUIBComponent.UnLock }
|
|
procedure UnLock; override;
|
|
{ Add a database to the transaction. }
|
|
procedure AddDataBase(ADataBase: TJvUIBDataBase);
|
|
{ Remove a database from a transaction. }
|
|
procedure RemoveDatabase(ADataBase: TJvUIBDataBase); overload;
|
|
{ Remove a database from a transaction. }
|
|
procedure RemoveDatabase(Index: Integer); overload;
|
|
{Start Transaction.}
|
|
Procedure StartTransaction;
|
|
{Commit transaction.}
|
|
procedure Commit;
|
|
{Commit transaction but keep transaction handle.}
|
|
procedure CommitRetaining;
|
|
{Rollback transaction.}
|
|
procedure RollBack;
|
|
{Rollback transaction but keep transaction handle.}
|
|
procedure RollBackRetaining;
|
|
{Indicate if the transaction is active.}
|
|
{$IFDEF IB71_UP}
|
|
{ Interbase 7.1 spceficic, Release a savepoint.
|
|
On Firebird 1.5 this must be call by SQL.}
|
|
procedure SavepointRelease(const Name: string);
|
|
{ Interbase 7.1 spceficic, RollBack a savepoint.
|
|
On Firebird 1.5 this must be call by SQL.}
|
|
procedure SavepointRollback(const Name: string; Option: Word = 0);
|
|
{ Interbase 7.1 spceficic, Start a savepoint.
|
|
On Firebird 1.5 this must be call by SQL.}
|
|
procedure SavepointStart(const Name: string);
|
|
{$ENDIF IB71_UP}
|
|
property InTransaction: Boolean read GetInTransaction;
|
|
{Transaction handle.}
|
|
property TrHandle: IscTrHandle read FTrHandle;
|
|
{ Queries connected to this transaction.}
|
|
property Statements[const Index: Integer]: TJvUIBStatement read GetStatements;
|
|
{ Number of Queries connected to this transaction.}
|
|
property StatementsCount: Integer read GetStatementsCount;
|
|
{ Get all databases attached to the transaction. }
|
|
property Databases[const Index: Integer]: TJvUIBDataBase read GetDatabases;
|
|
{ How many databases attached to the transaction. }
|
|
property DatabasesCount: Integer read GetDatabasesCount;
|
|
published
|
|
{Database connection.}
|
|
property DataBase : TJvUIBDataBase read GetDataBase write SetDataBase;
|
|
{Transaction parametters.}
|
|
property Options : TTransParams read GetOptions write SetOptions default [tpConcurrency,tpWait,tpWrite];
|
|
{List of the tables to lock for read, tpLockRead option must set. ex: 'Table1;Table2'}
|
|
property LockRead : string read GetLockRead write SetLockRead;
|
|
{List of the tables to lock for write, tpLockWrite option must set. ex: 'Table1;Table2'}
|
|
property LockWrite : string read GetLockWrite write SetLockWrite;
|
|
{This event occur after a transaction is started.}
|
|
property OnStartTransaction: TNotifyEvent read FOnStartTransaction write FOnStartTransaction;
|
|
{This evenet occur before to end the transaction, you can change the ETM parametter.}
|
|
property OnEndTransaction: TOnEndTransaction read FOnEndTransaction write FOnEndTransaction;
|
|
{If false, commit and rollback close all connected statements and finally close transaction.
|
|
If True, commit and rollback are modified to commitretaining or rollbackretaining if at least one statement is open.}
|
|
property AutoRetain: boolean read GetAutoRetain write SetAutoRetain default False;
|
|
{If True, transaction automatically started when needed.
|
|
if False you must explicitely call "starttransaction".}
|
|
property AutoStart: boolean read FAutoStart write FAutoStart default True;
|
|
{default = false, if True you need to close transaction explicitly.}
|
|
property AutoStop: boolean read FAutoStop write FAutoStop default True;
|
|
{Transaction default action if closed automaticaly, commit or rollback only.}
|
|
property DefaultAction: TEndTransMode read FDefaultAction write SetDefaultAction default etmCommit;
|
|
end;
|
|
|
|
{ Simple query component. }
|
|
TJvUIBStatement = class(TJvUIBComponent)
|
|
private
|
|
FCurrentState: TQueryState;
|
|
FTransaction: TJvUIBTransaction;
|
|
FDataBase: TJvUIBDataBase;
|
|
FStHandle: IscStmtHandle;
|
|
FOnError: TEndTransMode;
|
|
FCursorName: string;
|
|
FSQLResult: TSQLResult;
|
|
FCachedFetch: boolean;
|
|
FFetchBlobs: boolean;
|
|
FBufferChunks: Cardinal;
|
|
FQuickScript: boolean;
|
|
FSQL: TStrings;
|
|
FParsedSQL: string;
|
|
FParameter: TSQLParams;
|
|
FParseParams: boolean;
|
|
FOnClose: TNotifyEvent;
|
|
FStatementType: TUIBStatementType;
|
|
FUseCursor: boolean;
|
|
function GetPlan: string;
|
|
function GetStatementType: TUIBStatementType;
|
|
procedure SetSQL(const Value: TStrings);
|
|
procedure DoSQLChange(Sender: TObject);
|
|
function GetFields: TSQLResult;
|
|
function GetEof: boolean;
|
|
function FindDataBase: TJvUIBDataBase;
|
|
function GetRowsAffected: Cardinal;
|
|
function GetBof: boolean;
|
|
protected
|
|
procedure SetTransaction(const Transaction: TJvUIBTransaction); virtual;
|
|
procedure SetDataBase(ADataBase: TJvUIBDataBase);
|
|
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
|
|
|
procedure BeginTransaction; virtual;
|
|
procedure BeginStatement; virtual;
|
|
procedure BeginPrepare; virtual;
|
|
procedure BeginExecute; virtual;
|
|
procedure BeginExecImme; virtual;
|
|
|
|
procedure EndTransaction(const ETM: TEndTransMode; Auto: boolean); virtual;
|
|
procedure EndStatement(const ETM: TEndTransMode; Auto: boolean); virtual;
|
|
procedure EndPrepare(const ETM: TEndTransMode; Auto: boolean); virtual;
|
|
procedure EndExecute(const ETM: TEndTransMode; Auto: boolean); virtual;
|
|
procedure EndExecImme(const ETM: TEndTransMode; Auto: boolean); virtual;
|
|
|
|
procedure InternalNext; virtual;
|
|
procedure InternalPrior; virtual;
|
|
procedure InternalClose(const Mode: TEndTransMode; Auto: boolean); virtual;
|
|
|
|
function ParamsClass: TSQLParamsClass; virtual;
|
|
function ResultClass: TSQLResultClass; virtual;
|
|
|
|
procedure InternalGetBlobSize(sqlda: TSQLDA; const Index: Word; out Size: Cardinal);
|
|
procedure InternalReadBlob(sqlda: TSQLDA; const Index: Word; Stream: TStream); overload;
|
|
procedure InternalReadBlob(sqlda: TSQLDA; const Index: Word; var str: string); overload;
|
|
procedure InternalReadBlob(sqlda: TSQLDA; const Index: Word; var Value: Variant); overload;
|
|
procedure InternalReadBlob(sqlda: TSQLDA; const Index: Word; Buffer: Pointer); overload;
|
|
|
|
property QuickScript: boolean read FQuickScript write FQuickScript default False;
|
|
|
|
public
|
|
{ Constructor method. }
|
|
constructor Create(AOwner: TComponent); override;
|
|
{ Destructor method. }
|
|
destructor Destroy; override;
|
|
{ cf TJvUIBComponent.Lock }
|
|
procedure Lock; override;
|
|
{ cf TJvUIBComponent.UnLock }
|
|
procedure UnLock; override;
|
|
{ Close the statement. You can commit or rollback the transaction when closing. }
|
|
procedure Close(const Mode: TEndTransMode = etmStayIn); virtual;
|
|
{ Fetch all records returned by the query. }
|
|
procedure CloseCursor;
|
|
procedure FetchAll;
|
|
{ Open the query and fetch the first record if FetchFirst = true. }
|
|
procedure Open(FetchFirst: boolean = True);
|
|
{ Prepare the query. }
|
|
procedure Prepare;
|
|
{ Execute the query. }
|
|
procedure Execute;
|
|
{ Execute the query or the script (QuickScript = true) immediately. }
|
|
procedure ExecSQL;
|
|
{ Get the next record. }
|
|
procedure Next;
|
|
{ Get the prior record. }
|
|
procedure Prior;
|
|
{ Get the last record. }
|
|
procedure Last;
|
|
{ Get the first record. }
|
|
procedure First;
|
|
{ Read a the blob in a stream by index. }
|
|
procedure ReadBlob(const Index: Word; Stream: TStream); overload;
|
|
{ Read a the blob in a string by index. }
|
|
procedure ReadBlob(const Index: Word; var str: string); overload;
|
|
{ Read a the blob in a Variant by index. }
|
|
procedure ReadBlob(const Index: Word; var Value: Variant); overload;
|
|
{ Read a the blob in a PREALLOCATED buffer by index. }
|
|
procedure ReadBlob(const Index: Word; Buffer: Pointer); overload;
|
|
{ Read a the blob in a stream by name. }
|
|
procedure ReadBlob(const name: string; Stream: TStream); overload;
|
|
{ Read a the blob in a string by name. }
|
|
procedure ReadBlob(const name: string; var str: string); overload;
|
|
{ Read a the blob in a Variant by name. }
|
|
procedure ReadBlob(const name: string; var Value: Variant); overload;
|
|
{ Read a the blob in a PREALLOCATED buffer by name. }
|
|
procedure ReadBlob(const name: string; Buffer: Pointer); overload;
|
|
|
|
{ The the blob value of a parametter using a Stream. }
|
|
procedure ParamsSetBlob(const Index: Word; Stream: TStream); overload;
|
|
{ The the blob value of a parametter using a string. }
|
|
procedure ParamsSetBlob(const Index: Word; var str: string); overload;
|
|
{ The the blob value of a parametter using a Buffer. }
|
|
procedure ParamsSetBlob(const Index: Word; Buffer: Pointer; Size: Cardinal); overload;
|
|
|
|
{ The the blob value of a parametter using a Stream. }
|
|
procedure ParamsSetBlob(const Name: string; Stream: TStream); overload;
|
|
{ The the blob value of a parametter using a string. }
|
|
procedure ParamsSetBlob(const Name: string; var str: string); overload;
|
|
{ The the blob value of a parametter using a Buffer. }
|
|
procedure ParamsSetBlob(const Name: string; Buffer: Pointer; Size: Cardinal); overload;
|
|
|
|
{ Get the the blob size of the current record. }
|
|
function FieldBlobSize(const Index: Word): Cardinal;
|
|
{ Get the blob size of the corresonding parametter. }
|
|
function ParamBlobSize(const Index: Word): Cardinal;
|
|
|
|
{ The internal statement handle. }
|
|
property StHandle: IscStmtHandle read FStHandle;
|
|
{ Use fields to read the current record. }
|
|
property Fields: TSQLResult read GetFields;
|
|
{ use Params to set parametters, the param names are set dynamically
|
|
parsing the SQL query, by default the param values are null string.
|
|
The first time you set a parametter value, the field type is defined. }
|
|
property Params: TSQLParams read FParameter;
|
|
{ All UIB statements declare a unique cursor name, another query can use
|
|
this cursor to modify the current cursor, this feature is for unidirectionnal
|
|
statements !!.<br>
|
|
ex: UPDATE proj_dept_budget SET projected_budget = :value WHERE CURRENT OF %s; }
|
|
property CursorName: string read FCursorName;
|
|
{ Indicate the current state of the query. }
|
|
property CurrentState: TQueryState read FCurrentState;
|
|
{ if true there isn't anymore record to fetch. }
|
|
property Eof: boolean read GetEof;
|
|
property Bof: boolean read GetBof;
|
|
{ @exclude }
|
|
property ParseParams: boolean read FParseParams write FParseParams;
|
|
{ The plan used internally by interbase (the query must be prepared). }
|
|
property Plan: string read GetPlan;
|
|
{ Get the current statement type (the query must be prepared). }
|
|
property StatementType: TUIBStatementType read GetStatementType;
|
|
{ Return the number of rows affected by the query (stInsert, stUpdate or stDelete). }
|
|
property RowsAffected: Cardinal read GetRowsAffected;
|
|
property UseCursor: boolean read FUseCursor write FUseCursor default True;
|
|
published
|
|
{ The sql query. }
|
|
property SQL: TStrings read FSQL write SetSQL;
|
|
{ Transaction of the query. }
|
|
property Transaction: TJvUIBTransaction read FTransaction write SetTransaction;
|
|
{ Connected database, in most cases you don't need to set this property, it is
|
|
only needed if the transaction concern more than one database. }
|
|
property DataBase: TJvUIBDataBase read FDataBase write SetDataBase;
|
|
{ If an error occur, this action is applied to the connected transaction. }
|
|
property OnError: TEndTransMode read FOnError write FOnError default etmRollback;
|
|
{ If true all record are saved in memory. }
|
|
property CachedFetch: boolean read FCachedFetch write FCachedFetch default True;
|
|
{ If true the blob data is fetched with the record. }
|
|
property FetchBlobs: boolean read FFetchBlobs write FFetchBlobs default False;
|
|
{ Use BufferChunks to get or set the number of records for which the query
|
|
allocates buffer space at any time. When the querys buffer is full,
|
|
trying to fetch an additional record causes the dataset to reallocate
|
|
the buffer so that it has enough memory to hold an additional BufferChunks
|
|
records. <br>
|
|
Note: When CachedFetch is False, BufferChunks has no meaning. }
|
|
property BufferChunks: Cardinal read FBufferChunks write FBufferChunks default 1000;
|
|
{ OnClose event. }
|
|
property OnClose: TNotifyEvent read FOnClose write FOnClose;
|
|
end;
|
|
|
|
{Oo.......................................................................oO
|
|
TUIBQuery
|
|
Oo.......................................................................oO}
|
|
{ The query component. }
|
|
TJvUIBQuery = class(TJvUIBStatement)
|
|
public
|
|
{ Helper method to buid the SQL query needed to execute the stored procedure.
|
|
Input data type found using this method. }
|
|
procedure BuildStoredProc(const StoredProc: string);
|
|
published
|
|
{ If true you can use this component as a fast script component where each line is a query.
|
|
You must use the ExecSQL method ! }
|
|
property QuickScript;
|
|
end;
|
|
|
|
{ Parsing event, occur on each query executed. }
|
|
TOnParse = procedure(Sender: TObject; NodeType: TSQLNodeType;
|
|
const Statement: string; Position, Count: Integer) of object;
|
|
|
|
{ The script component. }
|
|
TJvUIBScript = class(TJvUIBComponent)
|
|
private
|
|
FQuery: TJvUIBQuery;
|
|
FScript: TStrings;
|
|
FAutoDDL: boolean;
|
|
FOnParse: TOnParse;
|
|
procedure SetTransaction(const Value: TJvUIBTransaction);
|
|
function GetTransaction: TJvUIBTransaction;
|
|
procedure SetScript(const Value: TStrings);
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure ExecuteScript;
|
|
published
|
|
property Transaction: TJvUIBTransaction read GetTransaction write SetTransaction;
|
|
property Script: TStrings read FScript write SetScript;
|
|
property AutoDDL: boolean read FAutoDDL write FAutoDDL default True;
|
|
property OnParse: TOnParse read FOnParse write FOnParse;
|
|
end;
|
|
|
|
TUIBProtocol = (
|
|
proLocalHost,
|
|
proTCPIP,
|
|
proNetBEUI
|
|
);
|
|
|
|
TJvUIBService = class(TJvUIBComponent)
|
|
private
|
|
FLibrary: TUIBLibrary;
|
|
FLiBraryName: string;
|
|
FUserName: string;
|
|
FPassWord: string;
|
|
FHost : string;
|
|
FProtocol: TUIBProtocol;
|
|
FHandle : IscSvcHandle;
|
|
procedure BeginService;
|
|
procedure EndService;
|
|
function CreateSPB: string; virtual;
|
|
procedure SetLibraryName(const Lib: String);
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
published
|
|
property UserName: string read FUserName write FUserName;
|
|
property PassWord: string read FPassWord write FPassWord;
|
|
property Host: string read FHost write FHost;
|
|
property Protocol: TUIBProtocol read FProtocol write FProtocol default proLocalHost;
|
|
{ Define wich library the connection use.}
|
|
property LibraryName: string read FLiBraryName write SetLibraryName;
|
|
end;
|
|
|
|
TVerboseEvent = procedure(Sender: TObject; Message: string) of object;
|
|
|
|
|
|
TJvUIBBackupRestore = class(TJvUIBService)
|
|
private
|
|
FBackupFiles: TStrings;
|
|
FDatabase: TFileName;
|
|
FOnVerbose: TVerboseEvent;
|
|
procedure SetBackupFiles(const Value: TStrings);
|
|
function CreateStartSPB: string; virtual; abstract;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure Run;
|
|
published
|
|
property BackupFiles: TStrings read FBackupFiles write SetBackupFiles;
|
|
property Database: TFileName read FDatabase write FDatabase;
|
|
property OnVerbose: TVerboseEvent read FOnVerbose write FOnVerbose;
|
|
end;
|
|
|
|
TBackupOption = (boIgnoreChecksums, boIgnoreLimbo, boMetadataOnly,
|
|
boNoGarbageCollection, boOldMetadataDesc, boNonTransportable,
|
|
boConvertExtTables, boExpand);
|
|
TBackupOptions = set of TBackupOption;
|
|
|
|
TJvUIBBackup = class(TJvUIBBackupRestore)
|
|
private
|
|
FOptions: TBackupOptions;
|
|
function CreateStartSPB: string; override;
|
|
published
|
|
property Options: TBackupOptions read FOptions write FOptions default [];
|
|
end;
|
|
|
|
TRestoreOption = (roDeactivateIndexes, roNoShadow, roNoValidityCheck,
|
|
roOneRelationAtATime, roReplace, roCreateNewDB, roUseAllSpace
|
|
{$IFDEF IB71_UP},roValidate{$ENDIF});
|
|
|
|
TRestoreOptions = set of TRestoreOption;
|
|
|
|
TJvUIBRestore = class(TJvUIBBackupRestore)
|
|
private
|
|
FOptions: TRestoreOptions;
|
|
FPageSize: Cardinal;
|
|
function CreateStartSPB: string; override;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
published
|
|
property Options: TRestoreOptions read FOptions write FOptions default [roCreateNewDB];
|
|
property PageSize: Cardinal read FPageSize write FPageSize default 0;
|
|
end;
|
|
|
|
{$IFDEF USEJVCL}
|
|
{$IFDEF UNITVERSIONING}
|
|
const
|
|
UnitVersioning: TUnitVersionInfo = (
|
|
RCSfile: '$URL: https://jvcl.svn.sourceforge.net/svnroot/jvcl/tags/JVCL3_32/run/JvUIB.pas $';
|
|
Revision: '$Revision: 10612 $';
|
|
Date: '$Date: 2006-05-19 21:04:09 +0200 (ven., 19 mai 2006) $';
|
|
LogPath: 'JVCL\run'
|
|
);
|
|
{$ENDIF UNITVERSIONING}
|
|
{$ENDIF USEJVCL}
|
|
|
|
implementation
|
|
|
|
uses
|
|
Math,
|
|
JvUIBMetaData;
|
|
|
|
type
|
|
PExceptionInfo = ^TExceptionInfo;
|
|
TExceptionInfo = record
|
|
ExepClass: EUIBExceptionClass;
|
|
ID: Integer;
|
|
end;
|
|
|
|
{ TJvUIBDataBase }
|
|
|
|
procedure TJvUIBDataBase.AddTransaction(Transaction: TJvUIBTransaction);
|
|
begin
|
|
if (FTransactions = nil) then FTransactions := TList.Create;
|
|
FTransactions.Add(Transaction);
|
|
end;
|
|
|
|
procedure TJvUIBDataBase.ClearTransactions;
|
|
begin
|
|
while (FTransactions <> nil) do
|
|
TJvUIBTransaction(FTransactions.Last).RemoveDatabase(Self);
|
|
end;
|
|
|
|
procedure TJvUIBDataBase.CloseTransactions;
|
|
var i: Integer;
|
|
begin
|
|
if (FTransactions <> nil) then
|
|
for i := 0 to FTransactions.Count - 1 do
|
|
TJvUIBTransaction(FTransactions.Items[i]).Close(etmDefault, True);
|
|
end;
|
|
|
|
constructor TJvUIBDataBase.Create(AOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
FLibrary := TUIBLibrary.Create;
|
|
FLiBraryName := GetClientLibrary;
|
|
FLibrary.OnConnectionLost := DoOnConnectionLost;
|
|
FLibrary.OnGetDBExceptionClass := DoOnGetDBExceptionClass;
|
|
FDbHandle := nil;
|
|
FHandleShared := False;
|
|
FParams := TStringList.Create;
|
|
SQLDialect := 3;
|
|
CharacterSet := csNONE;
|
|
WriteParamString('sql_role_name', '');
|
|
FExceptions := TList.Create;
|
|
FMetadata := nil;
|
|
FMetaDataOptions := TMetaDataOptions.Create;
|
|
end;
|
|
|
|
destructor TJvUIBDataBase.Destroy;
|
|
begin
|
|
Lock;
|
|
try
|
|
Connected := False;
|
|
ClearTransactions;
|
|
TStringList(FParams).Free;
|
|
ClearExceptions;
|
|
FExceptions.Free;
|
|
FLibrary.Free;
|
|
FMetaDataOptions.Free;
|
|
finally
|
|
UnLock;
|
|
end;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TJvUIBDataBase.DoOnConnectionLost(Lib: TUIBLibrary);
|
|
begin
|
|
Lib.RaiseErrors := False;
|
|
try
|
|
Connected := False;
|
|
finally
|
|
Lib.RaiseErrors := True;
|
|
if Assigned(FOnConnectionLost) then
|
|
FOnConnectionLost(Self);
|
|
end;
|
|
end;
|
|
|
|
function TJvUIBDataBase.GetCharacterSet: TCharacterSet;
|
|
var
|
|
i: TCharacterSet;
|
|
S: String;
|
|
begin
|
|
S := trim(UpperCase(ReadParamString('lc_ctype', 'NONE')));
|
|
Result := csNONE;
|
|
for i := low(TCharacterSet) to high(TCharacterSet) do
|
|
if (S = CharacterSetStr[i]) then
|
|
begin
|
|
Result := i;
|
|
Break;
|
|
end;
|
|
end;
|
|
|
|
function TJvUIBDataBase.GetConnected: Boolean;
|
|
begin
|
|
Lock;
|
|
try
|
|
result := FDbHandle <> nil;
|
|
finally
|
|
UnLock;
|
|
end;
|
|
end;
|
|
|
|
function TJvUIBDataBase.GetPassWord: string;
|
|
begin
|
|
result := ReadParamString('password');
|
|
end;
|
|
|
|
function TJvUIBDataBase.GetSQLDialect: Integer;
|
|
begin
|
|
try
|
|
Result := ReadParamInteger('sql_dialect', 3);
|
|
except
|
|
WriteParamInteger('sql_dialect', 3);
|
|
raise;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvUIBDataBase.ExecuteImmediate(const Statement: string);
|
|
begin
|
|
FLibrary.Load(FLiBraryName);
|
|
FLibrary.DSQLExecuteImmediate(Statement, SQLDialect);
|
|
end;
|
|
|
|
procedure TJvUIBDataBase.CreateDatabase(PageSize: Integer = 2048);
|
|
var TrHandle: IscTrHandle;
|
|
const
|
|
CreateDb = 'CREATE DATABASE ''%s'' USER ''%s'' PASSWORD ''%s'' '+
|
|
'PAGE_SIZE %d DEFAULT CHARACTER SET %s';
|
|
begin
|
|
TrHandle := nil;
|
|
Connected := False;
|
|
FLibrary.Load(FLiBraryName);
|
|
FLibrary.DSQLExecuteImmediate(FDbHandle, TrHandle,
|
|
Format(CreateDb, [DatabaseName, UserName, PassWord, PageSize,
|
|
CharacterSetStr[CharacterSet]]), SQLDialect);
|
|
end;
|
|
|
|
function TJvUIBDataBase.GetUserName: string;
|
|
begin
|
|
result := ReadParamString('user_name');
|
|
end;
|
|
|
|
function TJvUIBDataBase.ReadParamInteger(Param: String;
|
|
Default: Integer): Integer;
|
|
begin
|
|
Result := StrToInt(ReadParamString(Param, IntToStr(Default)));
|
|
end;
|
|
|
|
function TJvUIBDataBase.ReadParamString(Param, Default: String): String;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Lock;
|
|
try
|
|
I := FParams.IndexOfName(Param);
|
|
if I >= 0 then
|
|
begin
|
|
Result := Copy(FParams[I], Length(Param) + 2, Maxint);
|
|
Exit;
|
|
end;
|
|
Result := Default;
|
|
finally
|
|
UnLock;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvUIBDataBase.RemoveTransaction(Transaction: TJvUIBTransaction);
|
|
begin
|
|
if (FTransactions <> nil) then
|
|
begin
|
|
FTransactions.Remove(Transaction);
|
|
if FTransactions.Count = 0 then
|
|
begin
|
|
FTransactions.Free;
|
|
FTransactions := nil;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvUIBDataBase.SetCharacterSet(const Value: TCharacterSet);
|
|
begin
|
|
WriteParamString('lc_ctype', CharacterSetStr[Value]);
|
|
end;
|
|
|
|
procedure TJvUIBDataBase.SetConnected(const Value: Boolean);
|
|
begin
|
|
if (Value = Connected) then Exit;
|
|
Lock;
|
|
try
|
|
with FLibrary do
|
|
case Value of
|
|
True :
|
|
begin
|
|
if Assigned(BeforeConnect) then BeforeConnect(Self);
|
|
FLibrary.Load(FLiBraryName);
|
|
if not FHandleShared then
|
|
AttachDatabase(FDatabaseName, FDbHandle, FParams.Text, BreakLine);
|
|
if Assigned(AfterConnect) then AfterConnect(Self);
|
|
end;
|
|
False :
|
|
begin
|
|
if Assigned(BeforeDisconnect) then BeforeDisconnect(Self);
|
|
CloseTransactions;
|
|
if FMetadata <> nil then
|
|
FreeAndNil(FMetadata);
|
|
if FHandleShared then
|
|
begin
|
|
FDbHandle := nil;
|
|
FHandleShared := False;
|
|
end else
|
|
DetachDatabase(FDbHandle);
|
|
if Assigned(AfterDisconnect) then AfterDisconnect(Self);
|
|
end;
|
|
end;
|
|
finally
|
|
UnLock;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvUIBDataBase.SetDatabaseName(const Value: TFileName);
|
|
begin
|
|
FDatabaseName := Value;
|
|
if (csDesigning in ComponentState) then
|
|
Connected := False;
|
|
end;
|
|
|
|
procedure TJvUIBDataBase.SetDbHandle(const Value: IscDbHandle);
|
|
begin
|
|
if (FDbHandle = nil) or ((FDbHandle <> nil) and FHandleShared) then
|
|
begin
|
|
FLibrary.Load(FLiBraryName);
|
|
FDbHandle := Value;
|
|
FHandleShared := (FDbHandle <> nil);
|
|
end else
|
|
raise Exception.Create(EUIB_DBHANDLEALLREADYSET);
|
|
end;
|
|
|
|
procedure TJvUIBDataBase.SetLibraryName(const Lib: TFileName);
|
|
begin
|
|
SetConnected(False);
|
|
FLibrary.UnLoad;
|
|
FLiBraryName := Lib;
|
|
end;
|
|
|
|
function TJvUIBDataBase.GetTransactions(const Index: Cardinal): TJvUIBTransaction;
|
|
begin
|
|
if FTransactions <> nil then
|
|
Result := FTransactions.Items[Index] else
|
|
raise EListError.CreateFmt(EUIB_INDEXERROR,[Index]);
|
|
end;
|
|
|
|
function TJvUIBDataBase.GetTransactionsCount: Cardinal;
|
|
begin
|
|
if FTransactions <> nil then
|
|
Result := FTransactions.Count else
|
|
Result := 0;
|
|
end;
|
|
|
|
procedure TJvUIBDataBase.SetParams(const Value: TStrings);
|
|
begin
|
|
FParams.Assign(Value);
|
|
end;
|
|
|
|
procedure TJvUIBDataBase.SetPassWord(const Value: string);
|
|
begin
|
|
WriteParamString('password', Value);
|
|
end;
|
|
|
|
procedure TJvUIBDataBase.SetSQLDialect(const Value: Integer);
|
|
begin
|
|
WriteParamInteger('sql_dialect', Value);
|
|
end;
|
|
|
|
procedure TJvUIBDataBase.SetUserName(const Value: string);
|
|
begin
|
|
WriteParamString('user_name', Value);
|
|
end;
|
|
|
|
procedure TJvUIBDataBase.WriteParamInteger(Param: String; Value: Integer);
|
|
begin
|
|
WriteParamString(Param, IntToStr(Value));
|
|
end;
|
|
|
|
procedure TJvUIBDataBase.WriteParamString(Param, Value: String);
|
|
var
|
|
I: Integer;
|
|
S: string;
|
|
begin
|
|
Lock;
|
|
try
|
|
S := Param + '=' + Value;
|
|
I := FParams.IndexOfName(Param);
|
|
if I >= 0 then
|
|
FParams[I] := S
|
|
else
|
|
FParams.Add(S);
|
|
finally
|
|
UnLock;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvUIBDataBase.ClearExceptions;
|
|
var i: Integer;
|
|
begin
|
|
for i := 0 to FExceptions.Count - 1 do
|
|
FreeMem(FExceptions[i]);
|
|
FExceptions.Clear;
|
|
end;
|
|
|
|
procedure TJvUIBDataBase.RegisterException(Excpt: EUIBExceptionClass;
|
|
ID: Integer);
|
|
var
|
|
ExcepInfo: PExceptionInfo;
|
|
i: Integer;
|
|
begin
|
|
for i := 0 to FExceptions.Count - 1 do
|
|
if PExceptionInfo(FExceptions[i]).ID = ID then
|
|
raise Exception.CreateFmt(EUIB_EXPTIONREGISTERED, [ID]);
|
|
GetMem(ExcepInfo, SizeOf(TExceptionInfo));
|
|
ExcepInfo.ExepClass := Excpt;
|
|
ExcepInfo.ID := ID;
|
|
FExceptions.Add(ExcepInfo);
|
|
end;
|
|
|
|
function TJvUIBDataBase.RegisterException(Excpt: EUIBExceptionClass;
|
|
const Name: string): Integer;
|
|
var
|
|
Transaction: TJvUIBTransaction;
|
|
Query: TJvUIBQuery;
|
|
begin
|
|
Result := -1;
|
|
Transaction := TJvUIBTransaction.Create(nil);
|
|
Query := TJvUIBQuery.Create(nil);
|
|
try
|
|
Transaction.DataBase := Self;
|
|
Query.Transaction := Transaction;
|
|
Query.CachedFetch := False;
|
|
Query.SQL.Text := 'SELECT RDB$EXCEPTION_NUMBER FROM RDB$EXCEPTIONS WHERE RDB$EXCEPTION_NAME = ?';
|
|
Query.Params.AsString[0] := UpperCase(Name);
|
|
Query.Open;
|
|
if not Query.Eof then
|
|
begin
|
|
Result := Query.Fields.AsInteger[0];
|
|
RegisterException(Excpt, Result);
|
|
end;
|
|
Query.Close(etmCommit);
|
|
if (Result = - 1) then
|
|
raise Exception.CreateFmt(EUIB_EXCEPTIONNOTFOUND, [Name]);
|
|
finally
|
|
Query.Free;
|
|
Transaction.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvUIBDataBase.UnRegisterException(Number: Integer);
|
|
var i: Integer;
|
|
begin
|
|
for i := 0 to FExceptions.Count - 1 do
|
|
if PExceptionInfo(FExceptions[i]).ID = Number then
|
|
begin
|
|
FreeMem(FExceptions[i]);
|
|
FExceptions.Delete(i);
|
|
Break;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvUIBDataBase.UnRegisterExceptions(Excpt: EUIBExceptionClass);
|
|
var i: Integer;
|
|
begin
|
|
i := 0;
|
|
while i < FExceptions.Count do
|
|
begin
|
|
if (PExceptionInfo(FExceptions[i]).ExepClass = Excpt) then
|
|
begin
|
|
FreeMem(FExceptions[i]);
|
|
FExceptions.Delete(i);
|
|
end else
|
|
inc(i);
|
|
end;
|
|
end;
|
|
|
|
procedure TJvUIBDataBase.DoOnGetDBExceptionClass(Number: Integer; out Excep: EUIBExceptionClass);
|
|
var i: Integer;
|
|
begin
|
|
for i := 0 to FExceptions.Count - 1 do
|
|
if (PExceptionInfo(FExceptions[i]).ID = Number) then
|
|
begin
|
|
Excep := PExceptionInfo(FExceptions[i]).ExepClass;
|
|
Exit;
|
|
end;
|
|
Excep := EUIBException;
|
|
end;
|
|
|
|
function TJvUIBDataBase.GetMetadata(Refresh: boolean = False): TObject;
|
|
var
|
|
Transaction: TJvUIBTransaction;
|
|
begin
|
|
if Refresh and (FMetadata <> nil) then
|
|
FreeAndNil(FMetadata);
|
|
if (FMetadata = nil) then
|
|
begin
|
|
Transaction := TJvUIBTransaction.Create(nil);
|
|
try
|
|
Transaction.Database := Self;
|
|
FMetadata := TMetaDataBase.Create(nil, -1);
|
|
with TMetaDataBase(FMetadata) do
|
|
begin
|
|
OIDDatabases := FMetaDataOptions.Objects;
|
|
OIDTables := FMetaDataOptions.Tables;
|
|
OIDViews := FMetaDataOptions.Views;
|
|
OIDProcedures := FMetaDataOptions.Procedures;
|
|
OIDUDFs := FMetaDataOptions.UDFs;
|
|
SysInfos := FMetaDataOptions.FSysInfos
|
|
end;
|
|
try
|
|
TMetaDataBase(FMetadata).LoadFromDatabase(Transaction);
|
|
Transaction.Commit;
|
|
except
|
|
FreeAndNil(FMetadata);
|
|
raise;
|
|
end;
|
|
finally
|
|
Transaction.Free;
|
|
end;
|
|
end;
|
|
Result := FMetadata;
|
|
end;
|
|
|
|
function TJvUIBDataBase.GetSegmentSize: Word;
|
|
begin
|
|
Result := FLibrary.SegMentSize;
|
|
end;
|
|
|
|
procedure TJvUIBDataBase.SetSegmentSize(const Value: Word);
|
|
begin
|
|
FLibrary.SegMentSize := Value;
|
|
end;
|
|
|
|
{ TJvUIBStatement }
|
|
|
|
procedure TJvUIBStatement.SetTransaction(const Transaction: TJvUIBTransaction);
|
|
begin
|
|
if (FTransaction <> Transaction) then
|
|
begin
|
|
if (FTransaction <> nil) then
|
|
begin
|
|
if FTransaction.AutoRetain then
|
|
InternalClose(etmDefault, True) else
|
|
InternalClose(etmStayIn, True);
|
|
FTransaction.RemoveSQLComponent(Self);
|
|
end;
|
|
FTransaction := Transaction;
|
|
if (Transaction <> nil) then
|
|
Transaction.AddSQLComponent(Self);
|
|
FCurrentState := qsDataBase;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvUIBStatement.SetDataBase(ADataBase: TJvUIBDataBase);
|
|
begin
|
|
if (FDataBase <> ADataBase) then
|
|
begin
|
|
if (FTransaction <> nil) then
|
|
begin
|
|
if FTransaction.AutoRetain then
|
|
InternalClose(etmDefault, True) else
|
|
InternalClose(etmStayIn, True);
|
|
end;
|
|
FDataBase := ADataBase;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvUIBStatement.BeginTransaction;
|
|
begin
|
|
if FTransaction <> nil then
|
|
FTransaction.BeginTransaction else
|
|
raise Exception.Create(EUIB_TRANSACTIONNOTDEF);
|
|
FCurrentState := qsTransaction;
|
|
end;
|
|
|
|
procedure TJvUIBStatement.Close(const Mode: TEndTransMode);
|
|
begin
|
|
// if Mode = etmStayIn then
|
|
// CloseCursor else
|
|
InternalClose(Mode, False);
|
|
end;
|
|
|
|
procedure TJvUIBStatement.Open(FetchFirst: boolean = True);
|
|
begin
|
|
// if you reopen the same query I Close
|
|
// the cursor, clean sql result and
|
|
// execute the query again to save
|
|
// the prepare time !
|
|
if (FCurrentState = qsExecute) then
|
|
CloseCursor;
|
|
|
|
if FetchFirst then
|
|
InternalNext else
|
|
BeginExecute;
|
|
end;
|
|
|
|
procedure TJvUIBStatement.Next;
|
|
begin
|
|
if (FCurrentState <> qsExecute) then
|
|
raise Exception.Create(EUIB_MUSTBEOPEN);
|
|
InternalNext;
|
|
end;
|
|
|
|
procedure TJvUIBStatement.Prior;
|
|
begin
|
|
InternalPrior;
|
|
end;
|
|
|
|
procedure TJvUIBStatement.Last;
|
|
begin
|
|
|
|
FetchAll;
|
|
end;
|
|
|
|
procedure TJvUIBStatement.First;
|
|
begin
|
|
if (FSQLResult <> nil) and
|
|
(FSQLResult.RecordCount > 0) and
|
|
(FSQLResult.CurrentRecord <> 0) then
|
|
FSQLResult.CurrentRecord := 0;
|
|
end;
|
|
|
|
procedure TJvUIBStatement.FetchAll;
|
|
begin
|
|
while not Eof do Next;
|
|
end;
|
|
|
|
procedure TJvUIBStatement.Execute;
|
|
begin
|
|
BeginExecute;
|
|
end;
|
|
|
|
procedure TJvUIBStatement.ExecSQL;
|
|
begin
|
|
BeginExecImme;
|
|
end;
|
|
|
|
procedure TJvUIBStatement.Prepare;
|
|
begin
|
|
if (FCurrentState < qsPrepare) then
|
|
BeginPrepare
|
|
end;
|
|
|
|
procedure TJvUIBStatement.InternalNext;
|
|
begin
|
|
if (FCurrentState < qsExecute) then
|
|
BeginExecute;
|
|
if ((Fields.CurrentRecord + 1) < Fields.RecordCount) then
|
|
begin
|
|
Fields.CurrentRecord := Fields.CurrentRecord + 1;
|
|
end else
|
|
begin
|
|
Lock;
|
|
try
|
|
with FindDataBase.FLibrary do
|
|
try
|
|
if FSQLResult.FetchBlobs then
|
|
DSQLFetchWithBlobs(FindDataBase.FDbHandle,
|
|
FTransaction.FTrHandle, FStHandle, FTransaction.FSQLDialect, FSQLResult) else
|
|
DSQLFetch(FStHandle, FTransaction.FSQLDialect, FSQLResult);
|
|
except
|
|
if FOnError <> etmStayIn then
|
|
EndExecute(FOnError, False);
|
|
raise;
|
|
end;
|
|
finally
|
|
UnLock;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvUIBStatement.InternalPrior;
|
|
begin
|
|
if Fields.CachedFetch then
|
|
begin
|
|
if Fields.CurrentRecord > 0 then
|
|
Fields.CurrentRecord := Fields.CurrentRecord - 1;
|
|
end else
|
|
raise Exception.Create(EUIB_CACHEDFETCHNOTSET);
|
|
end;
|
|
|
|
procedure TJvUIBStatement.EndTransaction(const ETM: TEndTransMode; Auto: boolean);
|
|
begin
|
|
if FTransaction <> nil then
|
|
begin
|
|
if FTransaction.EndTransaction(ETM, Self, Auto) then
|
|
FCurrentState := qsDataBase;
|
|
end else
|
|
raise Exception.Create(EUIB_TRANSACTIONNOTDEF);
|
|
end;
|
|
|
|
procedure TJvUIBStatement.BeginStatement;
|
|
begin
|
|
BeginTransaction;
|
|
Lock;
|
|
try
|
|
with FindDataBase.FLibrary do
|
|
try
|
|
FStHandle := nil;
|
|
DSQLAllocateStatement(FindDataBase.FDbHandle, FStHandle);
|
|
except
|
|
EndTransaction(FOnError, False);
|
|
raise;
|
|
end;
|
|
inc(FTransaction.FStatements);
|
|
finally
|
|
UnLock;
|
|
end;
|
|
FCurrentState := qsStatement;
|
|
end;
|
|
|
|
procedure TJvUIBStatement.EndStatement(const ETM: TEndTransMode; Auto: boolean);
|
|
begin
|
|
Lock;
|
|
try
|
|
with FindDataBase.FLibrary do
|
|
DSQLFreeStatement(FStHandle, DSQL_drop);
|
|
|
|
FStHandle := nil;
|
|
Dec(FTransaction.FStatements);
|
|
finally
|
|
UnLock;
|
|
end;
|
|
FCurrentState := qsTransaction;
|
|
if (ETM <> etmStayIn) then
|
|
EndTransaction(ETM, Auto);
|
|
|
|
if Assigned(FOnClose) then
|
|
FOnClose(Self);
|
|
end;
|
|
|
|
procedure TJvUIBStatement.BeginPrepare;
|
|
begin
|
|
if (FStHandle = nil) then BeginStatement;
|
|
FSQLResult := ResultClass.Create(0, FCachedFetch, FFetchBlobs, FBufferChunks);
|
|
Lock;
|
|
try
|
|
with FindDataBase.FLibrary do
|
|
try
|
|
if (FQuickScript or (not FParseParams)) then
|
|
FStatementType := DSQLPrepare(FTransaction.FTrHandle, FStHandle,
|
|
FSQL.Text, FTransaction.FSQLDialect, FSQLResult) else
|
|
FStatementType := DSQLPrepare(FTransaction.FTrHandle, FStHandle,
|
|
FParsedSQL, FTransaction.FSQLDialect, FSQLResult);
|
|
FCursorName := 'C' + inttostr(Integer(FStHandle));
|
|
if FUseCursor then
|
|
DSQLSetCursorName(FStHandle, FCursorName);
|
|
except
|
|
FSQLResult.Free;
|
|
FSQLResult := nil;
|
|
EndStatement(FOnError, False);
|
|
raise;
|
|
end;
|
|
finally
|
|
UnLock;
|
|
end;
|
|
FCurrentState := qsPrepare;
|
|
end;
|
|
|
|
procedure TJvUIBStatement.EndPrepare(const ETM: TEndTransMode; Auto: boolean);
|
|
begin
|
|
FSQLResult.Free;
|
|
FSQLResult := nil;
|
|
FCurrentState := qsStatement;
|
|
EndStatement(ETM, Auto);
|
|
end;
|
|
|
|
procedure TJvUIBStatement.BeginExecute;
|
|
begin
|
|
if (FSQLResult = nil) then BeginPrepare;
|
|
Lock;
|
|
try
|
|
with FindDataBase.FLibrary do
|
|
try
|
|
if (FStatementType = stExecProcedure) then
|
|
DSQLExecute2(FTransaction.FTrHandle, FStHandle,
|
|
FTransaction.FSQLDialect, FParameter, FSQLResult) else
|
|
DSQLExecute(FTransaction.FTrHandle, FStHandle,
|
|
FTransaction.FSQLDialect, FParameter);
|
|
except
|
|
if (FOnError <> etmStayIn) then
|
|
EndPrepare(FOnError, False);
|
|
raise;
|
|
end;
|
|
finally
|
|
UnLock;
|
|
end;
|
|
FCurrentState := qsExecute;
|
|
end;
|
|
|
|
procedure TJvUIBStatement.EndExecute(const ETM: TEndTransMode; Auto: boolean);
|
|
begin
|
|
FCurrentState := qsPrepare;
|
|
EndPrepare(ETM, Auto);
|
|
end;
|
|
|
|
procedure TJvUIBStatement.BeginExecImme;
|
|
var
|
|
I: Integer;
|
|
procedure ExecuteQuery(const AQuery: String; Params: TSQLParams);
|
|
begin
|
|
if (Trim(AQuery) = '') then exit;
|
|
Lock;
|
|
try
|
|
with FindDataBase.FLibrary do
|
|
try
|
|
DSQLExecuteImmediate(FindDataBase.FDbHandle, FTransaction.FTrHandle,
|
|
AQuery, FTransaction.FSQLDialect, Params);
|
|
except
|
|
if (FOnError <> etmStayIn) then
|
|
EndExecImme(FOnError, False);
|
|
raise;
|
|
end;
|
|
finally
|
|
UnLock;
|
|
end;
|
|
end;
|
|
begin
|
|
BeginTransaction;
|
|
if FQuickScript then
|
|
for i := 0 to FSQL.Count - 1 do
|
|
begin
|
|
ExecuteQuery(FSQL.Strings[i], nil);
|
|
end else
|
|
if FParseParams then
|
|
ExecuteQuery(FParsedSQL, FParameter) else
|
|
ExecuteQuery(FSQL.Text, FParameter);
|
|
FCurrentState := qsExecImme;
|
|
end;
|
|
|
|
procedure TJvUIBStatement.EndExecImme(const ETM: TEndTransMode; Auto: boolean);
|
|
begin
|
|
FCurrentState := qsTransaction;
|
|
if (ETM <> etmStayIn) then
|
|
EndTransaction(ETM, Auto);
|
|
end;
|
|
|
|
function TJvUIBStatement.ParamsClass: TSQLParamsClass;
|
|
begin
|
|
Result := TSQLParams;
|
|
end;
|
|
|
|
function TJvUIBStatement.ResultClass: TSQLResultClass;
|
|
begin
|
|
Result := TSQLResult;
|
|
end;
|
|
|
|
procedure TJvUIBStatement.Lock;
|
|
begin
|
|
inherited;
|
|
Ftransaction.Lock;
|
|
end;
|
|
|
|
procedure TJvUIBStatement.UnLock;
|
|
begin
|
|
Ftransaction.UnLock;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TJvUIBStatement.SetSQL(const Value: TStrings);
|
|
begin
|
|
FSQL.Assign(Value);
|
|
end;
|
|
|
|
function TJvUIBStatement.GetPlan: string;
|
|
begin
|
|
Lock;
|
|
try
|
|
if (FCurrentState < qsPrepare) then
|
|
Raise Exception.Create(EUIB_MUSTBEPREPARED)else
|
|
Result := FindDataBase.FLibrary.DSQLInfoPlan(FStHandle);
|
|
finally
|
|
UnLock
|
|
end;
|
|
end;
|
|
|
|
function TJvUIBStatement.GetStatementType: TUIBStatementType;
|
|
begin
|
|
if (FCurrentState < qsPrepare) then
|
|
Raise Exception.Create(EUIB_MUSTBEPREPARED)else
|
|
Result := FStatementType;
|
|
end;
|
|
|
|
procedure TJvUIBStatement.DoSQLChange(Sender: TObject);
|
|
begin
|
|
InternalClose(etmStayIn, True);
|
|
if (not FQuickScript or FParseParams) then
|
|
FParsedSQL := FParameter.Parse(FSQL.Text);
|
|
end;
|
|
|
|
function TJvUIBStatement.GetFields: TSQLResult;
|
|
begin
|
|
if (FSQLResult = nil) then
|
|
raise Exception.Create(EUIB_QUERYNOTOPEN);
|
|
Result := FSQLResult;
|
|
end;
|
|
|
|
function TJvUIBStatement.GetEof: boolean;
|
|
begin
|
|
if Assigned(FSQLResult) then
|
|
Result := FSQLResult.Eof else
|
|
Result := True;
|
|
end;
|
|
|
|
function TJvUIBStatement.GetBof: boolean;
|
|
begin
|
|
if Assigned(FSQLResult) then
|
|
Result := FSQLResult.Bof else
|
|
Result := True;
|
|
end;
|
|
|
|
function TJvUIBStatement.FindDataBase: TJvUIBDataBase;
|
|
begin
|
|
if FDataBase <> nil then
|
|
result := FDataBase else
|
|
if FTransaction <> nil then
|
|
result := FTransaction.FDataBase else
|
|
raise Exception.Create(EUIB_DATABASENOTDEF);
|
|
end;
|
|
|
|
procedure TJvUIBStatement.Notification(AComponent: TComponent; Operation: TOperation);
|
|
begin
|
|
inherited Notification(AComponent, Operation);
|
|
if ((AComponent = FTransaction) and (Operation = opRemove)) then
|
|
SetTransaction(nil);
|
|
if ((AComponent = FDataBase) and (Operation = opRemove)) then
|
|
SetDataBase(nil);
|
|
end;
|
|
|
|
constructor TJvUIBStatement.Create(AOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
FUseCursor := True;
|
|
FCurrentState := qsDataBase;
|
|
if (AOwner is TJvUIBTransaction) then
|
|
Transaction := TJvUIBTransaction(AOwner) else
|
|
FTransaction := nil;
|
|
FSQL := TStringList.Create;
|
|
TStringList(FSQL).OnChange := DoSQLChange;
|
|
FCachedFetch := True;
|
|
FetchBlobs := False;
|
|
FQuickScript := False;
|
|
FOnError := etmRollback;
|
|
FParameter := ParamsClass.Create;
|
|
FCursorName := '';
|
|
FBufferChunks := 1000;
|
|
FParseParams := True;
|
|
end;
|
|
|
|
destructor TJvUIBStatement.Destroy;
|
|
begin
|
|
FSQL.Free;
|
|
FParameter.Free;
|
|
FParameter := nil;
|
|
SetTransaction(nil);
|
|
inherited;
|
|
end;
|
|
|
|
procedure TJvUIBStatement.ReadBlob(const Index: Word; var Str: string);
|
|
begin
|
|
if Fields.FetchBlobs then
|
|
Fields.ReadBlob(Index, Str) else
|
|
InternalReadBlob(Fields, Index, str);
|
|
end;
|
|
|
|
procedure TJvUIBStatement.ReadBlob(const Index: Word; Stream: TStream);
|
|
begin
|
|
if Fields.FetchBlobs then
|
|
Fields.ReadBlob(Index, Stream) else
|
|
InternalReadBlob(Fields, Index, Stream);
|
|
end;
|
|
|
|
procedure TJvUIBStatement.ReadBlob(const Index: Word; var Value: Variant);
|
|
begin
|
|
if Fields.FetchBlobs then
|
|
Fields.ReadBlob(Index, Value) else
|
|
InternalReadBlob(Fields, Index, Value);
|
|
end;
|
|
|
|
procedure TJvUIBStatement.ReadBlob(const name: string; Stream: TStream);
|
|
begin
|
|
ReadBlob(Fields.GetFieldIndex(name), Stream);
|
|
end;
|
|
|
|
procedure TJvUIBStatement.ReadBlob(const name: string; var str: string);
|
|
begin
|
|
ReadBlob(Fields.GetFieldIndex(name), str);
|
|
end;
|
|
|
|
procedure TJvUIBStatement.ReadBlob(const name: string; var Value: Variant);
|
|
begin
|
|
ReadBlob(Fields.GetFieldIndex(name), Value);
|
|
end;
|
|
|
|
procedure TJvUIBStatement.ParamsSetBlob(const Index: Word; Stream: TStream);
|
|
var BlobHandle: IscBlobHandle;
|
|
begin
|
|
if (FCurrentState < qsTransaction) then
|
|
BeginTransaction;
|
|
BlobHandle := nil;
|
|
Lock;
|
|
with FindDataBase.FLibrary do
|
|
try
|
|
Params.AsQuad[Index] := BlobCreate(FindDataBase.FDbHandle,
|
|
FTransaction.FTrHandle, BlobHandle);
|
|
try
|
|
BlobWriteStream(BlobHandle, Stream);
|
|
finally
|
|
BlobClose(BlobHandle);
|
|
end;
|
|
finally
|
|
UnLock;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvUIBStatement.ParamsSetBlob(const Index: Word; var str: string);
|
|
var BlobHandle: IscBlobHandle;
|
|
begin
|
|
if (FCurrentState < qsTransaction) then
|
|
BeginTransaction;
|
|
BlobHandle := nil;
|
|
Lock;
|
|
with FindDataBase.FLibrary do
|
|
try
|
|
Params.AsQuad[Index] := BlobCreate(FindDataBase.FDbHandle,
|
|
FTransaction.FTrHandle, BlobHandle);
|
|
try
|
|
BlobWriteString(BlobHandle, str);
|
|
finally
|
|
BlobClose(BlobHandle);
|
|
end;
|
|
finally
|
|
UnLock;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvUIBStatement.ParamsSetBlob(const Index: Word; Buffer: Pointer;
|
|
Size: Cardinal);
|
|
var BlobHandle: IscBlobHandle;
|
|
begin
|
|
if (FCurrentState < qsTransaction) then
|
|
BeginTransaction;
|
|
BlobHandle := nil;
|
|
Lock;
|
|
with FindDataBase.FLibrary do
|
|
try
|
|
Params.AsQuad[Index] := BlobCreate(FindDataBase.FDbHandle,
|
|
FTransaction.FTrHandle, BlobHandle);
|
|
try
|
|
BlobWriteSegment(BlobHandle, Size, Buffer);
|
|
finally
|
|
BlobClose(BlobHandle);
|
|
end;
|
|
finally
|
|
UnLock;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvUIBStatement.ParamsSetBlob(const Name: string; Stream: TStream);
|
|
var BlobHandle: IscBlobHandle;
|
|
begin
|
|
if (FCurrentState < qsTransaction) then
|
|
BeginTransaction;
|
|
BlobHandle := nil;
|
|
Lock;
|
|
with FindDataBase.FLibrary do
|
|
try
|
|
Params.ByNameAsQuad[Name] := BlobCreate(FindDataBase.FDbHandle,
|
|
FTransaction.FTrHandle, BlobHandle);
|
|
try
|
|
BlobWriteStream(BlobHandle, Stream);
|
|
finally
|
|
BlobClose(BlobHandle);
|
|
end;
|
|
finally
|
|
UnLock;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvUIBStatement.ParamsSetBlob(const Name: string; var str: string);
|
|
var BlobHandle: IscBlobHandle;
|
|
begin
|
|
if (FCurrentState < qsTransaction) then
|
|
BeginTransaction;
|
|
BlobHandle := nil;
|
|
Lock;
|
|
with FindDataBase.FLibrary do
|
|
try
|
|
Params.ByNameAsQuad[Name] := BlobCreate(FindDataBase.FDbHandle,
|
|
FTransaction.FTrHandle, BlobHandle);
|
|
try
|
|
BlobWriteString(BlobHandle, str);
|
|
finally
|
|
BlobClose(BlobHandle);
|
|
end;
|
|
finally
|
|
UnLock;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvUIBStatement.ParamsSetBlob(const Name: string; Buffer: Pointer;
|
|
Size: Cardinal);
|
|
var BlobHandle: IscBlobHandle;
|
|
begin
|
|
if (FCurrentState < qsTransaction) then
|
|
BeginTransaction;
|
|
BlobHandle := nil;
|
|
Lock;
|
|
with FindDataBase.FLibrary do
|
|
try
|
|
Params.ByNameAsQuad[Name] := BlobCreate(FindDataBase.FDbHandle,
|
|
FTransaction.FTrHandle, BlobHandle);
|
|
try
|
|
BlobWriteSegment(BlobHandle, Size, Buffer);
|
|
finally
|
|
BlobClose(BlobHandle);
|
|
end;
|
|
finally
|
|
UnLock;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvUIBStatement.InternalReadBlob(sqlda: TSQLDA; const Index: Word;
|
|
Stream: TStream);
|
|
var
|
|
BlobHandle: IscBlobHandle;
|
|
begin
|
|
if (not sqlda.IsBlob[Index]) then
|
|
raise EUIBConvertError.Create(EUIB_CASTERROR);
|
|
if (not sqlda.IsNull[Index]) then
|
|
begin
|
|
Lock;
|
|
with FindDataBase.FLibrary do
|
|
try
|
|
BlobHandle := nil;
|
|
BlobOpen(FindDataBase.FDbHandle, FTransaction.FTrHandle,
|
|
BlobHandle, sqlda.AsQuad[Index]);
|
|
try
|
|
BlobSaveToStream(BlobHandle, Stream);
|
|
finally
|
|
BlobClose(BlobHandle);
|
|
end;
|
|
finally
|
|
UnLock;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvUIBStatement.InternalReadBlob(sqlda: TSQLDA; const Index: Word;
|
|
var str: string);
|
|
var
|
|
BlobHandle: IscBlobHandle;
|
|
begin
|
|
if (not sqlda.IsBlob[Index]) then
|
|
raise EUIBConvertError.Create(EUIB_CASTERROR);
|
|
if sqlda.IsNull[Index] then
|
|
str := '' else
|
|
begin
|
|
Lock;
|
|
with FindDataBase.FLibrary do
|
|
try
|
|
BlobHandle := nil;
|
|
BlobOpen(FindDataBase.FDbHandle, FTransaction.FTrHandle,
|
|
BlobHandle, sqlda.AsQuad[Index]);
|
|
try
|
|
BlobReadString(BlobHandle, str);
|
|
finally
|
|
BlobClose(BlobHandle);
|
|
end;
|
|
finally
|
|
UnLock;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvUIBStatement.InternalReadBlob(sqlda: TSQLDA; const Index: Word;
|
|
var Value: Variant);
|
|
var
|
|
BlobHandle: IscBlobHandle;
|
|
begin
|
|
if (not sqlda.IsBlob[Index]) then
|
|
raise EUIBConvertError.Create(EUIB_CASTERROR);
|
|
if (not sqlda.IsNull[Index]) then
|
|
begin
|
|
Lock;
|
|
with FindDataBase.FLibrary do
|
|
try
|
|
BlobHandle := nil;
|
|
BlobOpen(FindDataBase.FDbHandle, FTransaction.FTrHandle,
|
|
BlobHandle, sqlda.AsQuad[Index]);
|
|
try
|
|
BlobReadVariant(BlobHandle, Value);
|
|
finally
|
|
BlobClose(BlobHandle);
|
|
end;
|
|
finally
|
|
UnLock;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvUIBStatement.InternalClose(const Mode: TEndTransMode;
|
|
Auto: boolean);
|
|
begin
|
|
case FCurrentState of
|
|
qsStatement : EndStatement(Mode, Auto);
|
|
qsExecImme : EndExecImme(Mode, Auto);
|
|
qsPrepare : EndPrepare(Mode, Auto);
|
|
qsExecute : EndExecute(Mode, Auto);
|
|
end;
|
|
end;
|
|
|
|
procedure TJvUIBStatement.InternalGetBlobSize(sqlda: TSQLDA; const Index: Word; out Size: Cardinal);
|
|
var
|
|
BlobHandle: IscBlobHandle;
|
|
begin
|
|
if (not sqlda.IsBlob[Index]) then
|
|
raise EUIBConvertError.Create(EUIB_CASTERROR);
|
|
if (not sqlda.IsNull[Index]) then
|
|
begin
|
|
Lock;
|
|
with FindDataBase.FLibrary do
|
|
try
|
|
BlobHandle := nil;
|
|
BlobOpen(FindDataBase.FDbHandle, FTransaction.FTrHandle,
|
|
BlobHandle, sqlda.AsQuad[Index]);
|
|
try
|
|
BlobSize(BlobHandle, Size);
|
|
finally
|
|
BlobClose(BlobHandle);
|
|
end;
|
|
finally
|
|
UnLock;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TJvUIBStatement.FieldBlobSize(const Index: Word): Cardinal;
|
|
begin
|
|
if Fields.FetchBlobs then
|
|
Result := Fields.GetBlobSize(Index) else
|
|
InternalGetBlobSize(Fields, Index, Result);
|
|
end;
|
|
|
|
function TJvUIBStatement.ParamBlobSize(const Index: Word): Cardinal;
|
|
begin
|
|
InternalGetBlobSize(Params, Index, Result);
|
|
end;
|
|
|
|
procedure TJvUIBStatement.ReadBlob(const Index: Word; Buffer: Pointer);
|
|
begin
|
|
if Fields.FetchBlobs then
|
|
Fields.ReadBlob(Index, Buffer) else
|
|
InternalReadBlob(Fields, Index, Buffer);
|
|
end;
|
|
|
|
procedure TJvUIBStatement.ReadBlob(const name: string; Buffer: Pointer);
|
|
begin
|
|
ReadBlob(Fields.GetFieldIndex(name), Buffer);
|
|
end;
|
|
|
|
procedure TJvUIBStatement.InternalReadBlob(sqlda: TSQLDA;
|
|
const Index: Word; Buffer: Pointer);
|
|
var
|
|
BlobHandle: IscBlobHandle;
|
|
begin
|
|
if (not sqlda.IsBlob[Index]) then
|
|
raise EUIBConvertError.Create(EUIB_CASTERROR);
|
|
if sqlda.IsNull[Index] then
|
|
Exit else
|
|
begin
|
|
Lock;
|
|
with FindDataBase.FLibrary do
|
|
try
|
|
BlobHandle := nil;
|
|
BlobOpen(FindDataBase.FDbHandle, FTransaction.FTrHandle,
|
|
BlobHandle, sqlda.AsQuad[Index]);
|
|
try
|
|
BlobReadSizedBuffer(BlobHandle, Buffer);
|
|
finally
|
|
BlobClose(BlobHandle);
|
|
end;
|
|
finally
|
|
UnLock;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TJvUIBStatement.GetRowsAffected: Cardinal;
|
|
begin
|
|
Result := 0;
|
|
Lock;
|
|
try
|
|
if (FCurrentState < qsPrepare) then
|
|
Raise Exception.Create(EUIB_MUSTBEPREPARED)else
|
|
Result := FindDataBase.FLibrary.DSQLInfoRowsAffected(FStHandle, FStatementType);
|
|
finally
|
|
UnLock
|
|
end;
|
|
end;
|
|
|
|
procedure TJvUIBStatement.CloseCursor;
|
|
begin
|
|
if (FCurrentState = qsExecute) then
|
|
begin
|
|
Lock;
|
|
try
|
|
try
|
|
FSQLResult.ClearRecords;
|
|
with FindDataBase.FLibrary do
|
|
DSQLFreeStatement(FStHandle, DSQL_close);
|
|
except
|
|
InternalClose(FOnError, False);
|
|
raise;
|
|
end;
|
|
FCurrentState := qsPrepare;
|
|
finally
|
|
UnLock;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{ TJvUIBQuery }
|
|
|
|
procedure TJvUIBQuery.BuildStoredProc(const StoredProc: string);
|
|
var
|
|
i, r: Integer;
|
|
Str: string;
|
|
begin
|
|
InternalClose(etmStayIn, True);
|
|
r := 0;
|
|
TStringList(FSQL).OnChange := nil;
|
|
try
|
|
Params.Clear;
|
|
FParsedSQL :=
|
|
'SELECT RDB$FIELD_TYPE, RDB$PARAMETER_NAME, RDB$FIELD_SCALE, RDB$PARAMETER_TYPE '+
|
|
'FROM RDB$PROCEDURE_PARAMETERS PRM JOIN RDB$FIELDS FLD ON '+
|
|
'PRM.RDB$FIELD_SOURCE = FLD.RDB$FIELD_NAME '+
|
|
'WHERE '+
|
|
'PRM.RDB$PROCEDURE_NAME = ''' + UpperCase(StoredProc) + ''' '+
|
|
'ORDER BY RDB$PARAMETER_TYPE, PRM.RDB$PARAMETER_NUMBER';
|
|
Open;
|
|
try
|
|
while not Eof do
|
|
begin
|
|
with Fields do
|
|
if AsSmallint[3] = 0 then
|
|
begin
|
|
if AsSmallint[2] < 0 then
|
|
begin
|
|
case Fields.AsSmallint[0] of
|
|
blr_short: Params.AddFieldType(Trim(AsString[1]), uftNumeric, - AsSmallint[2], 4);
|
|
blr_long : Params.AddFieldType(Trim(AsString[1]), uftNumeric, - AsSmallint[2], 7);
|
|
blr_int64,
|
|
blr_quad,
|
|
blr_double: Params.AddFieldType(Trim(AsString[1]), uftNumeric, - AsSmallint[2], 15);
|
|
else
|
|
Raise Exception.Create(EUIB_UNEXPECTEDERROR);
|
|
end;
|
|
end else
|
|
case Fields.AsSmallint[0] of
|
|
blr_text,
|
|
blr_text2,
|
|
blr_varying,
|
|
blr_varying2,
|
|
blr_cstring,
|
|
blr_cstring2 : Params.AddFieldType(Trim(AsString[1]), uftChar);
|
|
blr_float,
|
|
blr_d_float : Params.AddFieldType(Trim(AsString[1]), uftFloat);
|
|
blr_short : Params.AddFieldType(Trim(AsString[1]), uftSmallint);
|
|
blr_long : Params.AddFieldType(Trim(AsString[1]), uftInteger);
|
|
blr_quad : Params.AddFieldType(Trim(AsString[1]), uftQuad);
|
|
blr_double : Params.AddFieldType(Trim(AsString[1]), uftDoublePrecision);
|
|
blr_timestamp : Params.AddFieldType(Trim(AsString[1]), uftTimestamp);
|
|
blr_blob,
|
|
blr_blob_id : Params.AddFieldType(Trim(AsString[1]), uftBlob);
|
|
blr_sql_date : Params.AddFieldType(Trim(AsString[1]), uftDate);
|
|
blr_sql_time : Params.AddFieldType(Trim(AsString[1]), uftTime);
|
|
blr_int64 : Params.AddFieldType(Trim(AsString[1]), uftInt64);
|
|
{$IFDEF IB7_UP}
|
|
blr_boolean_dtype : Params.AddFieldType(Trim(AsString[1]), uftBoolean);
|
|
{$ENDIF IB7_UP}
|
|
else
|
|
// shouldn't occur but ...
|
|
raise Exception.Create(EUIB_UNEXPECTEDERROR);
|
|
end
|
|
end else
|
|
inc(r);
|
|
Next;
|
|
end;
|
|
if (Params.FieldCount > 0) then
|
|
begin
|
|
FParsedSQL := ' (';
|
|
Str := ' (';
|
|
for i := 0 to Params.FieldCount - 1 do
|
|
begin
|
|
FParsedSQL := FParsedSQL + '?,';
|
|
Str := Str + ':'+ Params.FieldName[i] +','
|
|
end;
|
|
FParsedSQL[Length(FParsedSQL)] := ')';
|
|
Str[Length(Str)] := ')';
|
|
if r > 0 then
|
|
begin
|
|
FParsedSQL := 'SELECT * FROM ' + StoredProc + FParsedSQL;
|
|
FSQL.Text := 'SELECT * FROM ' + StoredProc + Str;
|
|
end else
|
|
begin
|
|
FParsedSQL := 'EXECUTE PROCEDURE ' + StoredProc + FParsedSQL;
|
|
FSQL.Text := 'EXECUTE PROCEDURE ' + StoredProc + Str;
|
|
end;
|
|
end else
|
|
begin
|
|
if r > 0 then
|
|
FParsedSQL := 'SELECT * FROM ' + StoredProc else
|
|
FParsedSQL := 'EXECUTE PROCEDURE ' + StoredProc;
|
|
FSQL.Text := FParsedSQL;
|
|
end;
|
|
except
|
|
FParsedSQL := '';
|
|
Params.Clear;
|
|
InternalClose(FOnError, False);
|
|
raise;
|
|
end;
|
|
finally
|
|
InternalClose(etmStayIn, True);
|
|
TStringList(FSQL).OnChange := DoSQLChange;
|
|
end;
|
|
end;
|
|
|
|
{ TJvUIBTransaction }
|
|
|
|
constructor TJvUIBTransaction.Create(AOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
FOptions := [tpConcurrency,tpWait,tpWrite];
|
|
FTrHandle := nil;
|
|
FStatements := 0;
|
|
FDataBases := TList.Create;
|
|
FAutoRetain := False;
|
|
FAutoStart := True;
|
|
FAutoStop := True;
|
|
FDefaultAction := etmCommit;
|
|
end;
|
|
|
|
destructor TJvUIBTransaction.Destroy;
|
|
begin
|
|
ClearSQLComponents;
|
|
Close(etmDefault, True);
|
|
ClearDataBases;
|
|
FDataBases.Free;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TJvUIBTransaction.Notification(AComponent: TComponent; Operation: TOperation);
|
|
begin
|
|
inherited Notification(AComponent, Operation);
|
|
if ((AComponent is TJvUIBDataBase) and (Operation = opRemove)) then
|
|
RemoveDatabase(TJvUIBDataBase(AComponent));
|
|
end;
|
|
|
|
procedure TJvUIBTransaction.SetDataBase(const ADatabase: TJvUIBDataBase);
|
|
begin
|
|
RemoveDatabase(FDataBase);
|
|
AddDataBase(ADatabase);
|
|
FDataBase := ADatabase;
|
|
end;
|
|
|
|
procedure TJvUIBTransaction.Close(const Mode: TEndTransMode; Auto: boolean);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
lock;
|
|
try
|
|
if (FStatements > 0) and (FSQLComponent <> nil) then
|
|
for i := 0 to FSQLComponent.Count -1 do
|
|
TJvUIBQuery(FSQLComponent.Items[i]).InternalClose(etmStayIn, Auto);
|
|
finally
|
|
UnLock;
|
|
end;
|
|
EndTransaction(Mode, nil, Auto);
|
|
end;
|
|
|
|
function TJvUIBTransaction.GetStatements(const Index: Integer): TJvUIBStatement;
|
|
begin
|
|
if FSQLComponent <> nil then
|
|
Result := FSQLComponent.Items[Index] else
|
|
raise EListError.CreateFmt(EUIB_INDEXERROR,[Index]);
|
|
end;
|
|
|
|
function TJvUIBTransaction.GetStatementsCount: Integer;
|
|
begin
|
|
if FSQLComponent <> nil then
|
|
Result := FSQLComponent.Count else
|
|
Result := 0;
|
|
end;
|
|
|
|
procedure TJvUIBTransaction.ClearDataBases;
|
|
var i: Integer;
|
|
begin
|
|
FDataBase := nil;
|
|
for i := 0 to FDataBases.Count - 1 do
|
|
TJvUIBDataBase(FDataBases[i]).RemoveTransaction(Self);
|
|
FDataBases.Clear;
|
|
end;
|
|
|
|
function TJvUIBTransaction.GetDatabases(const Index: Integer): TJvUIBDataBase;
|
|
begin
|
|
Result := FDataBases[Index];
|
|
end;
|
|
|
|
function TJvUIBTransaction.GetDatabasesCount: Integer;
|
|
begin
|
|
Result := FDataBases.Count;
|
|
end;
|
|
|
|
procedure TJvUIBTransaction.BeginDataBase;
|
|
var i: Integer;
|
|
begin
|
|
if (FDataBase = nil) then raise Exception.Create(EUIB_DATABASENOTDEF);
|
|
for i := 0 to FDataBases.Count - 1 do
|
|
TJvUIBDataBase(FDataBases[i]).Connected := True;
|
|
end;
|
|
|
|
procedure TJvUIBTransaction.BeginTransaction(Auto: boolean = True);
|
|
type
|
|
TEBDynArray = array of TISCTEB;
|
|
var
|
|
Buffer: Pointer;
|
|
i: Integer;
|
|
ATPB: string;
|
|
begin
|
|
BeginDataBase;
|
|
Lock;
|
|
try
|
|
with FDataBase.FLibrary do
|
|
if (FTrHandle = nil) then
|
|
begin
|
|
If Auto and (not FAutoStart) then
|
|
raise EUIBException.Create(EUIB_EXPLICITTRANS);
|
|
|
|
if FDataBases.Count = 1 then
|
|
begin
|
|
TransactionStart(FTrHandle, FDataBase.FDbHandle, TPB);
|
|
end else
|
|
begin
|
|
GetMem(Buffer, SizeOf(TISCTEB) * FDataBases.Count);
|
|
try
|
|
ATPB := TPB;
|
|
for i := 0 to FDataBases.Count - 1 do
|
|
with TEBDynArray(Buffer)[i] do
|
|
begin
|
|
Handle := @TJvUIBDatabase(FDataBases[i]).FDbHandle;
|
|
Len := Length(ATPB);
|
|
Address := PChar(ATPB);
|
|
end;
|
|
TransactionStartMultiple(FTrHandle, FDataBases.Count, Buffer);
|
|
finally
|
|
FreeMem(Buffer);
|
|
end;
|
|
end;
|
|
if Assigned(FOnStartTransaction) then
|
|
FOnStartTransaction(Self);
|
|
end;
|
|
finally
|
|
UnLock;
|
|
end;
|
|
end;
|
|
|
|
function TJvUIBTransaction.EndTransaction(ETM: TEndTransMode; From: TJvUIBStatement;
|
|
Auto: boolean): boolean;
|
|
var i: Integer;
|
|
begin
|
|
Result := False;
|
|
// don't lock if it is not necessary
|
|
if (ETM = etmStayIn) then Exit;
|
|
Lock;
|
|
try
|
|
// Default Action
|
|
if (ETM = etmDefault) then ETM := FDefaultAction;
|
|
if (FTrHandle <> nil) then
|
|
with FDataBase.FLibrary do
|
|
try
|
|
if Assigned(FOnEndTransaction) then
|
|
FOnEndTransaction(Self, ETM);
|
|
{ If there is Statements alive I must keep handle only if FAutoRetain = True.}
|
|
if (FStatements > 0) and FAutoRetain then
|
|
case ETM of
|
|
etmCommit : ETM := etmCommitRetaining;
|
|
etmRollback : ETM := etmRollbackRetaining;
|
|
end else
|
|
if (ETM in [etmCommit, etmRollback]) then
|
|
begin
|
|
if (FStatements > 0) and (FSQLComponent <> nil) then
|
|
for i := 0 to FSQLComponent.Count -1 do
|
|
if (From <> FSQLComponent.Items[i]) then
|
|
TJvUIBQuery(FSQLComponent.Items[i]).InternalClose(etmStayIn, Auto);
|
|
end;
|
|
|
|
Assert( FAutoStop or (not Auto), EUIB_NOAUTOSTOP);
|
|
|
|
case ETM of
|
|
etmCommit :
|
|
begin
|
|
TransactionCommit(FTrHandle);
|
|
Result := True;
|
|
end;
|
|
etmCommitRetaining : TransactionCommitRetaining(FTrHandle);
|
|
etmRollback :
|
|
begin
|
|
TransactionRollback(FTrHandle);
|
|
Result := True;
|
|
end;
|
|
etmRollbackRetaining : TransactionRollbackRetaining(FTrHandle);
|
|
end;
|
|
except
|
|
case ETM of
|
|
etmCommit, etmRollback :
|
|
TransactionRollback(FTrHandle);
|
|
etmCommitRetaining, etmRollbackRetaining :
|
|
TransactionRollbackRetaining(FTrHandle);
|
|
end;
|
|
raise;
|
|
end;
|
|
finally
|
|
UnLock;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvUIBTransaction.AddSQLComponent(Component: TJvUIBStatement);
|
|
begin
|
|
if (FSQLComponent = nil) then
|
|
FSQLComponent := TList.Create;
|
|
FSQLComponent.Add(Component);
|
|
end;
|
|
|
|
procedure TJvUIBTransaction.ClearSQLComponents;
|
|
begin
|
|
while (FSQLComponent <> nil) do
|
|
TJvUIBQuery(FSQLComponent.Last).SetTransaction(nil);
|
|
end;
|
|
|
|
procedure TJvUIBTransaction.RemoveSQLComponent(Component: TJvUIBStatement);
|
|
begin
|
|
if (FSQLComponent <> nil) then
|
|
begin
|
|
FSQLComponent.Remove(Component);
|
|
if (FSQLComponent.Count = 0) then
|
|
begin
|
|
FSQLComponent.Free;
|
|
FSQLComponent := nil;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvUIBTransaction.Lock;
|
|
var i: Integer;
|
|
begin
|
|
inherited;
|
|
for i := 0 to FDataBases.Count - 1 do
|
|
TJvUIBDataBase(FDataBases[i]).Lock;
|
|
end;
|
|
|
|
procedure TJvUIBTransaction.UnLock;
|
|
var i: Integer;
|
|
begin
|
|
for i := 0 to FDataBases.Count - 1 do
|
|
TJvUIBDataBase(FDataBases[i]).UnLock;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TJvUIBTransaction.AddDataBase(ADataBase: TJvUIBDataBase);
|
|
var i: Integer;
|
|
begin
|
|
if (ADataBase <> nil) then
|
|
begin
|
|
for i := 0 to FDataBases.Count - 1 do
|
|
if FDataBases[i] = ADataBase then
|
|
Exit;
|
|
Close(etmDefault, True);
|
|
FDataBases.Add(ADataBase);
|
|
ADataBase.AddTransaction(Self);
|
|
FSQLDialect := ADatabase.SQLDialect;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvUIBTransaction.RemoveDatabase(ADataBase: TJvUIBDataBase);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
if (ADataBase <> nil) then
|
|
begin
|
|
if ADataBase = FDataBase then
|
|
FDataBase := nil;
|
|
for i := 0 to FDataBases.Count - 1 do
|
|
if FDataBases[i] = ADataBase then
|
|
begin
|
|
Close(etmDefault, True);
|
|
ADataBase.RemoveTransaction(Self);
|
|
FDataBases.Delete(i);
|
|
Exit;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvUIBTransaction.RemoveDatabase(Index: Integer);
|
|
begin
|
|
with TJvUIBDataBase(FDataBases[Index]) do
|
|
begin
|
|
Close(etmDefault, True);
|
|
RemoveTransaction(Self);
|
|
FDataBases.Delete(Index);
|
|
end;
|
|
end;
|
|
|
|
procedure TJvUIBTransaction.Commit;
|
|
begin
|
|
EndTransaction(etmCommit, nil, False);
|
|
end;
|
|
|
|
procedure TJvUIBTransaction.CommitRetaining;
|
|
begin
|
|
EndTransaction(etmCommitRetaining, nil, False);
|
|
end;
|
|
|
|
procedure TJvUIBTransaction.RollBack;
|
|
begin
|
|
EndTransaction(etmRollback, nil, False);
|
|
end;
|
|
|
|
procedure TJvUIBTransaction.RollBackRetaining;
|
|
begin
|
|
EndTransaction(etmRollbackRetaining, nil, False);
|
|
end;
|
|
|
|
{$IFDEF IB71_UP}
|
|
procedure TJvUIBTransaction.SavepointRelease(const Name: string);
|
|
begin
|
|
BeginTransaction;
|
|
FDataBase.FLibrary.SavepointRelease(FTrHandle, Name);
|
|
end;
|
|
|
|
procedure TJvUIBTransaction.SavepointRollback(const Name: string; Option: Word = 0);
|
|
begin
|
|
BeginTransaction;
|
|
FDataBase.FLibrary.SavepointRollback(FTrHandle, Name, Option);
|
|
end;
|
|
|
|
procedure TJvUIBTransaction.SavepointStart(const Name: string);
|
|
begin
|
|
BeginTransaction;
|
|
FDataBase.FLibrary.SavepointStart(FTrHandle, Name);
|
|
end;
|
|
{$ENDIF IB71_UP}
|
|
|
|
function TJvUIBTransaction.GetInTransaction: Boolean;
|
|
begin
|
|
Lock;
|
|
try
|
|
Result := (FTrHandle <> nil);
|
|
finally
|
|
UnLock;
|
|
end;
|
|
end;
|
|
|
|
function TJvUIBTransaction.TPB: string;
|
|
var
|
|
tp: TTransParam;
|
|
procedure ParseStrOption(const code: Char; const Value: string);
|
|
var
|
|
P, Start: PChar;
|
|
S: string;
|
|
begin
|
|
P := Pointer(Value);
|
|
if P <> nil then
|
|
while P^ <> #0 do
|
|
begin
|
|
Start := P;
|
|
while not (P^ in [#0, ';']) do Inc(P);
|
|
if (P - Start) > 0 then
|
|
begin
|
|
SetString(S, Start, P - Start);
|
|
Result := Result + code + Char(P - Start) + S;
|
|
end;
|
|
if P^ =';' then inc(P);
|
|
end;
|
|
end;
|
|
begin
|
|
if FOptions = [tpConcurrency,tpWait,tpWrite] then
|
|
result := ''
|
|
else
|
|
begin
|
|
Result := isc_tpb_version3;
|
|
for tp := Low(TTransParam) to High(TTransParam) do
|
|
if (tp in FOptions) then
|
|
begin
|
|
case tp of
|
|
tpLockRead : ParseStrOption(Char(Ord(tp)+1), FLockRead);
|
|
tpLockWrite: ParseStrOption(Char(Ord(tp)+1), FLockWrite);
|
|
else
|
|
Result := Result + Char(Ord(tp)+1);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TJvUIBTransaction.GetOptions: TTransParams;
|
|
begin
|
|
Lock;
|
|
try
|
|
Result := FOptions;
|
|
finally
|
|
UnLock;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvUIBTransaction.SetOptions(const Value: TTransParams);
|
|
begin
|
|
Lock;
|
|
try
|
|
FOptions := Value;
|
|
finally
|
|
UnLock;
|
|
end;
|
|
end;
|
|
|
|
function TJvUIBTransaction.GetLockRead: string;
|
|
begin
|
|
Lock;
|
|
try
|
|
Result := FLockRead;
|
|
finally
|
|
UnLock;
|
|
end;
|
|
end;
|
|
|
|
function TJvUIBTransaction.GetLockWrite: string;
|
|
begin
|
|
Lock;
|
|
try
|
|
Result := FLockWrite;
|
|
finally
|
|
UnLock;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvUIBTransaction.SetLockRead(const Value: string);
|
|
begin
|
|
Lock;
|
|
try
|
|
FLockRead := Value;
|
|
finally
|
|
UnLock;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvUIBTransaction.SetLockWrite(const Value: string);
|
|
begin
|
|
Lock;
|
|
try
|
|
FLockWrite := Value;
|
|
finally
|
|
UnLock;
|
|
end;
|
|
end;
|
|
|
|
function TJvUIBTransaction.GetDataBase: TJvUIBDataBase;
|
|
begin
|
|
Lock;
|
|
try
|
|
Result := FDataBase;
|
|
finally
|
|
UnLock;
|
|
end;
|
|
end;
|
|
|
|
function TJvUIBTransaction.GetAutoRetain: boolean;
|
|
begin
|
|
Lock;
|
|
try
|
|
Result := FAutoRetain;
|
|
finally
|
|
UnLock;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvUIBTransaction.SetAutoRetain(const Value: boolean);
|
|
begin
|
|
Lock;
|
|
try
|
|
FAutoRetain := Value;
|
|
finally
|
|
UnLock;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvUIBTransaction.StartTransaction;
|
|
begin
|
|
BeginTransaction(False);
|
|
end;
|
|
|
|
procedure TJvUIBTransaction.SetDefaultAction(const Value: TEndTransMode);
|
|
begin
|
|
Assert(Value in [etmCommit, etmRollBack], 'Commit or Rollback only.');
|
|
FDefaultAction := Value;
|
|
end;
|
|
|
|
{ TJvUIBComponent }
|
|
|
|
constructor TJvUIBComponent.Create(AOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
FCriticalsection := TCriticalSection.Create;
|
|
end;
|
|
|
|
destructor TJvUIBComponent.Destroy;
|
|
begin
|
|
FCriticalsection.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TJvUIBComponent.Lock;
|
|
begin
|
|
{$IFDEF UIBTHREADSAFE}
|
|
FCriticalsection.Enter;
|
|
{$ENDIF UIBTHREADSAFE}
|
|
end;
|
|
|
|
procedure TJvUIBComponent.UnLock;
|
|
begin
|
|
{$IFDEF UIBTHREADSAFE}
|
|
FCriticalsection.Leave;
|
|
{$ENDIF UIBTHREADSAFE}
|
|
end;
|
|
|
|
{ TJvUIBService }
|
|
|
|
procedure TJvUIBService.BeginService;
|
|
begin
|
|
FLibrary.Load(FLiBraryName);
|
|
case FProtocol of
|
|
proLocalHost : FLibrary.ServiceAttach('service_mgr', FHandle, CreateSPB);
|
|
proTCPIP : FLibrary.ServiceAttach(Fhost + ':service_mgr', FHandle, CreateSPB);
|
|
proNetBEUI : FLibrary.ServiceAttach('\\'+ Fhost + '\service_mgr', FHandle, CreateSPB);
|
|
end;
|
|
end;
|
|
|
|
constructor TJvUIBService.Create(AOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
FLibrary := TUIBLibrary.Create;
|
|
FLiBraryName := GDS32DLL;
|
|
FProtocol := proLocalHost;
|
|
FHandle := nil;
|
|
end;
|
|
|
|
destructor TJvUIBService.Destroy;
|
|
begin
|
|
inherited;
|
|
FLibrary.Free;
|
|
end;
|
|
|
|
function TJvUIBService.CreateSPB: string;
|
|
procedure AddString(id: char; var Str: string);
|
|
begin
|
|
if (Str <> '') then
|
|
Result := Result + id + Char(length(Str)) + Str;
|
|
end;
|
|
begin
|
|
Result := isc_spb_version + isc_spb_current_version;
|
|
AddString(isc_spb_user_name, FUserName);
|
|
AddString(isc_spb_password, FPassWord);
|
|
end;
|
|
|
|
procedure TJvUIBService.SetLibraryName(const Lib: String);
|
|
begin
|
|
FLibrary.UnLoad;
|
|
FLiBraryName := Lib;
|
|
end;
|
|
|
|
procedure TJvUIBService.EndService;
|
|
begin
|
|
FLibrary.ServiceDetach(FHandle);
|
|
end;
|
|
|
|
{ TJvUIBBackupRestore }
|
|
|
|
constructor TJvUIBBackupRestore.Create(AOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
FBackupFiles := TStringList.Create;
|
|
end;
|
|
|
|
destructor TJvUIBBackupRestore.Destroy;
|
|
begin
|
|
FBackupFiles.Free;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TJvUIBBackupRestore.SetBackupFiles(const Value: TStrings);
|
|
begin
|
|
FBackupFiles.Assign(Value);
|
|
end;
|
|
|
|
procedure TJvUIBBackupRestore.Run;
|
|
var
|
|
Buffer: string;
|
|
Len: Word;
|
|
begin
|
|
BeginService;
|
|
try
|
|
FLibrary.ServiceStart(FHandle, CreateStartSPB);
|
|
if Assigned(FOnVerbose) then
|
|
begin
|
|
SetLength(Buffer, 1024);
|
|
while true do
|
|
begin
|
|
FLibrary.ServiceQuery(FHandle, '', isc_info_svc_line, Buffer);
|
|
if (Buffer[1] <> isc_info_svc_line) then
|
|
raise Exception.Create(EUIB_UNEXPECTEDERROR);
|
|
Len := PWord(@Buffer[2])^;
|
|
if len > 0 then
|
|
FOnVerbose(self, copy(Buffer, 4, len)) else
|
|
Break;
|
|
end;
|
|
end;
|
|
finally
|
|
EndService;
|
|
end;
|
|
end;
|
|
|
|
{ TJvUIBBackup }
|
|
|
|
function TJvUIBBackup.CreateStartSPB: string;
|
|
var
|
|
Len: Word;
|
|
i: Integer;
|
|
FileName: string;
|
|
FileLength: Integer;
|
|
function GetValue(Index: Integer): string;
|
|
begin
|
|
if Index >= 0 then
|
|
Result := Copy(FBackupFiles.Strings[Index], Length(FBackupFiles.Names[Index]) + 2, MaxInt) else
|
|
Result := '';
|
|
end;
|
|
begin
|
|
// backup service ibservices
|
|
Result := isc_action_svc_backup;
|
|
|
|
// DB Name
|
|
Result := Result + isc_spb_dbname;
|
|
Len := Length(FDatabase);
|
|
Result := Result + PChar(@Len)[0] + PChar(@Len)[1];
|
|
Result := Result + FDatabase;
|
|
|
|
for i := 0 to FBackupFiles.Count - 1 do
|
|
begin
|
|
FileName := FBackupFiles.Names[i];
|
|
if FileName = '' then
|
|
FileName := FBackupFiles[i];
|
|
if FileName <> '' then
|
|
begin
|
|
// Backup file
|
|
Result := Result + isc_spb_bkp_file;
|
|
Len := Length(FileName);
|
|
Result := Result + PChar(@Len)[0] + PChar(@Len)[1];
|
|
Result := Result + FileName;
|
|
// Backup file length
|
|
if TryStrToInt(GetValue(i), FileLength) then
|
|
begin
|
|
Result := Result + isc_spb_bkp_length;
|
|
Result := Result + PChar(@FileLength)[0] + PChar(@FileLength)[1] +
|
|
PChar(@FileLength)[2] + PChar(@FileLength)[3];
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
if assigned(FOnVerbose) then
|
|
Result := Result + isc_spb_verbose;
|
|
|
|
if (FOptions <> []) then
|
|
Result := Result + isc_spb_options + PChar(@FOptions)^ + #0#0#0;
|
|
end;
|
|
|
|
{ TJvUIBRestore }
|
|
|
|
constructor TJvUIBRestore.Create(AOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
FOptions := [roCreateNewDB];
|
|
FPageSize := 0;
|
|
end;
|
|
|
|
function TJvUIBRestore.CreateStartSPB: string;
|
|
var
|
|
Len: Word;
|
|
i: Integer;
|
|
FileName: string;
|
|
Opts: Cardinal;
|
|
begin
|
|
// backup service ibservices
|
|
Result := isc_action_svc_restore;
|
|
|
|
for i := 0 to FBackupFiles.Count - 1 do
|
|
begin
|
|
FileName := FBackupFiles[i];
|
|
if FileName <> '' then
|
|
begin
|
|
// Backup file
|
|
Result := Result + isc_spb_bkp_file;
|
|
Len := Length(FileName);
|
|
Result := Result + PChar(@Len)[0] + PChar(@Len)[1];
|
|
Result := Result + FileName;
|
|
end;
|
|
end;
|
|
|
|
// DB Name
|
|
Result := Result + isc_spb_dbname;
|
|
Len := Length(FDatabase);
|
|
Result := Result + PChar(@Len)[0] + PChar(@Len)[1];
|
|
Result := Result + FDatabase;
|
|
|
|
if assigned(FOnVerbose) then
|
|
Result := Result + isc_spb_verbose;
|
|
|
|
if (FOptions <> []) then
|
|
begin
|
|
Opts := PByte(@FOptions)^ shl 8;
|
|
Result := Result + isc_spb_options + PChar(@Opts)[0] +
|
|
PChar(@Opts)[1] + PChar(@Opts)[2] + PChar(@Opts)[3];
|
|
end;
|
|
|
|
if FPageSize > 0 then
|
|
Result := Result + isc_spb_res_page_size + PChar(@FPageSize)[0] +
|
|
PChar(@FPageSize)[1] + PChar(@FPageSize)[2] + PChar(@FPageSize)[3];
|
|
end;
|
|
|
|
|
|
{ TJvUIBScript }
|
|
constructor TJvUIBScript.Create(AOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
FQuery := TJvUIBQuery.Create(nil);
|
|
FQuery.ParseParams := False;
|
|
FScript := TStringList.Create;
|
|
FAutoDDL := True;
|
|
end;
|
|
|
|
destructor TJvUIBScript.Destroy;
|
|
begin
|
|
FQuery.Free;
|
|
FScript.Free;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TJvUIBScript.ExecuteScript;
|
|
var
|
|
FStream: TStringStream;
|
|
Lexer: TUIBLexer;
|
|
Grammar: TUIBGrammar;
|
|
i, k: Integer;
|
|
j: TCharacterSet;
|
|
Dialect: Integer;
|
|
TrHandle: IscTrHandle;
|
|
|
|
procedure CheckDatabase;
|
|
begin
|
|
if (Transaction = nil) then
|
|
raise Exception.Create(EUIB_TRANSACTIONNOTDEF);
|
|
end;
|
|
|
|
function Statement: string;
|
|
var p: Integer;
|
|
begin
|
|
with Grammar.RootNode.Nodes[i] do
|
|
begin
|
|
p := PosFrom.Pos;
|
|
FStream.Seek(p, soFromBeginning);
|
|
Result := FStream.ReadString(PosTo.Pos - p);
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
FStream := TStringStream.Create(FScript.Text);
|
|
Lexer := TUIBLexer.Create(FStream);
|
|
Grammar := TUIBGrammar.Create(Lexer);
|
|
try
|
|
if (Grammar.yyparse = 0) and (Grammar.RootNode <> nil) then
|
|
begin
|
|
for i := 0 to Grammar.RootNode.NodesCount - 1 do
|
|
begin
|
|
if Assigned(FOnParse) then
|
|
FOnParse(self, Grammar.RootNode.Nodes[i].NodeType, Statement, i,
|
|
Grammar.RootNode.NodesCount);
|
|
case Grammar.RootNode.Nodes[i].NodeType of
|
|
NodeSetSqlDialect:
|
|
begin
|
|
CheckDatabase;
|
|
if TryStrToInt(Grammar.RootNode.Nodes[i].Value, Dialect) then
|
|
FQuery.FindDataBase.SQLDialect := Dialect else
|
|
raise Exception.Create(EUIB_PARSESQLDIALECT);
|
|
end;
|
|
NodeSetNames:
|
|
begin
|
|
CheckDatabase;
|
|
for j := low(TCharacterSet) to high(TCharacterSet) do
|
|
begin
|
|
if (CompareText(CharacterSetStr[j], Grammar.RootNode.Nodes[i].Value) = 0) then
|
|
begin
|
|
FQuery.FindDataBase.CharacterSet := j;
|
|
Break;
|
|
end;
|
|
raise Exception.Create(EUIB_PARSESETNAMES);
|
|
end;
|
|
end;
|
|
NodeCreateDatabase:
|
|
begin
|
|
CheckDatabase;
|
|
FQuery.FindDataBase.Connected := False;
|
|
TrHandle := nil;
|
|
with FQuery.FindDataBase do
|
|
begin
|
|
FLibrary.Load(FLiBraryName);
|
|
// I MUST provide the real DB Handle (not nil)
|
|
// because altering forein key can fail otherwise.
|
|
FQuery.FindDataBase.Lock;
|
|
try
|
|
FLibrary.DSQLExecuteImmediate(
|
|
FDbHandle, TrHandle, Statement, SQLDialect);
|
|
finally
|
|
FQuery.FindDataBase.UnLock;
|
|
end;
|
|
end;
|
|
with Grammar.RootNode.Nodes[i].Nodes[0] do
|
|
for k := 0 to NodesCount - 1 do
|
|
case Nodes[k].NodeType of
|
|
NodeName : FQuery.FindDataBase.DatabaseName :=
|
|
copy(Nodes[k].Value ,2, Length(Nodes[k].Value) - 2);
|
|
NodeUsername : FQuery.FindDataBase.UserName :=
|
|
copy(Nodes[k].Value ,2, Length(Nodes[k].Value) - 2);
|
|
NodePassWord : FQuery.FindDataBase.PassWord :=
|
|
copy(Nodes[k].Value ,2, Length(Nodes[k].Value) - 2);
|
|
end;
|
|
end;
|
|
NodeConnect:
|
|
with FQuery.FindDataBase do
|
|
begin
|
|
Connected := False;
|
|
with Grammar.RootNode.Nodes[i] do
|
|
begin
|
|
DatabaseName := copy(Nodes[0].Value ,2, Length(Nodes[0].Value) - 2);
|
|
UserName := copy(Nodes[1].Value ,2, Length(Nodes[1].Value) - 2);
|
|
PassWord := copy(Nodes[2].Value ,2, Length(Nodes[2].Value) - 2);
|
|
end;
|
|
Connected := True;
|
|
end;
|
|
NodeSetAutoDDL:
|
|
begin
|
|
if UpperCase(Grammar.RootNode.Nodes[i].Value) = 'ON' then FAutoDDL := True else
|
|
if UpperCase(Grammar.RootNode.Nodes[i].Value) = 'OFF' then FAutoDDL := False else
|
|
raise Exception.Create(EUIB_BADAUTODLL);
|
|
end;
|
|
NodeCommit:
|
|
begin
|
|
Transaction.Commit;
|
|
end;
|
|
NodeRollback:
|
|
begin
|
|
Transaction.RollBack;
|
|
end;
|
|
{$IFDEF IB71_UP}
|
|
NodeSavepointSet:
|
|
Transaction.SavepointStart(Grammar.RootNode.Nodes[i].Nodes[0].Value);
|
|
NodeSavepointRelease:
|
|
Transaction.SavepointRelease(Grammar.RootNode.Nodes[i].Nodes[0].Value);
|
|
NodeSavepointUndo:
|
|
Transaction.SavepointRollback(Grammar.RootNode.Nodes[i].Nodes[0].Value);
|
|
{$ENDIF IB71_UP}
|
|
NodeSelect, // perhaps a select statement execute a procedure ...
|
|
NodeInsert,
|
|
NodeDeleteSearched,
|
|
NodeDeletePositioned,
|
|
NodeUpdateSearched,
|
|
NodeUpdatePositioned:
|
|
begin
|
|
FQuery.SQL.Text := trim(Statement);
|
|
FQuery.ExecSQL;
|
|
FQuery.Close(etmStayIn);
|
|
end;
|
|
else
|
|
// DDL ...
|
|
FQuery.SQL.Text := trim(Statement);
|
|
FQuery.ExecSQL; // faster for ddl
|
|
if FAutoDDL then
|
|
FQuery.Close(etmCommit) else
|
|
FQuery.Close(etmStayIn);
|
|
|
|
end;
|
|
end;
|
|
end else
|
|
raise EUIBParser.Create(Lexer.yylineno, Lexer.yycolno);
|
|
finally
|
|
FQuery.Close(etmStayIn);
|
|
//Transaction.Commit;
|
|
Grammar.Free;
|
|
Lexer.yyinput := nil;
|
|
FStream.Free;
|
|
Lexer.Free;
|
|
end;
|
|
end;
|
|
|
|
function TJvUIBScript.GetTransaction: TJvUIBTransaction;
|
|
begin
|
|
Result := FQuery.Transaction;
|
|
end;
|
|
|
|
procedure TJvUIBScript.SetScript(const Value: TStrings);
|
|
begin
|
|
FScript.Assign(Value);
|
|
end;
|
|
|
|
procedure TJvUIBScript.SetTransaction(const Value: TJvUIBTransaction);
|
|
begin
|
|
FQuery.Transaction := Value;
|
|
end;
|
|
|
|
{ TMetaDataOptions }
|
|
|
|
constructor TMetaDataOptions.Create;
|
|
begin
|
|
inherited;
|
|
FObjects := ALLOBjects;
|
|
FTables := ALLTables;
|
|
FViews := ALLViews;
|
|
FProcedures := ALLProcedures;
|
|
FUDFs := ALLUDFs;
|
|
FSysInfos := False;
|
|
end;
|
|
|
|
{$IFDEF USEJVCL}
|
|
{$IFDEF UNITVERSIONING}
|
|
initialization
|
|
RegisterUnitVersion(HInstance, UnitVersioning);
|
|
|
|
finalization
|
|
UnregisterUnitVersion(HInstance);
|
|
{$ENDIF UNITVERSIONING}
|
|
{$ENDIF USEJVCL}
|
|
|
|
end.
|