{******************************************************************************}
{                        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.
