PageRenderTime 37ms CodeModel.GetById 13ms app.highlight 12ms RepoModel.GetById 1ms app.codeStats 1ms

/Gedemin/IBX/IBDatabase.pas

http://gedemin.googlecode.com/
Pascal | 2276 lines | 1958 code | 164 blank | 154 comment | 238 complexity | 742150ae1c849dd259184b9b54b98409 MD5 | raw file

Large files files are truncated, but you can click here to view the full file

   1{************************************************************************}
   2{                                                                        }
   3{       Borland Delphi Visual Component Library                          }
   4{       InterBase Express core components                                }
   5{                                                                        }
   6{       Copyright (c) 1998-2001 Borland Software Corporation             }
   7{                                                                        }
   8{    InterBase Express is based in part on the product                   }
   9{    Free IB Components, written by Gregory H. Deatz for                 }
  10{    Hoagland, Longo, Moran, Dunst & Doukas Company.                     }
  11{    Free IB Components is used under license.                           }
  12{                                                                        }
  13{    The contents of this file are subject to the InterBase              }
  14{    Public License Version 1.0 (the "License"); you may not             }
  15{    use this file except in compliance with the License. You may obtain }
  16{    a copy of the License at http://www.borland.com/interbase/IPL.html  }
  17{    Software distributed under the License is distributed on            }
  18{    an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either              }
  19{    express or implied. See the License for the specific language       }
  20{    governing rights and limitations under the License.                 }
  21{    The Original Code was created by InterBase Software Corporation     }
  22{       and its successors.                                              }
  23{    Portions created by Borland Software Corporation are Copyright      }
  24{       (C) Borland Software Corporation. All Rights Reserved.           }
  25{    Contributor(s): Jeff Overcash                                       }
  26{                                                                        }
  27{************************************************************************}
  28
  29unit IBDatabase;
  30
  31interface
  32
  33uses
  34  Windows, Dialogs, Controls, StdCtrls, SysUtils, Classes, Forms, ExtCtrls,
  35  IBHeader, IBExternals, DB, IB;
  36
  37const
  38  DPBPrefix = 'isc_dpb_';
  39  DPBConstantNames: array[1..isc_dpb_last_dpb_constant] of string = (
  40    'cdd_pathname',
  41    'allocation',
  42    'journal',
  43    'page_size',
  44    'num_buffers',
  45    'buffer_length',
  46    'debug',
  47    'garbage_collect',
  48    'verify',
  49    'sweep',
  50    'enable_journal',
  51    'disable_journal',
  52    'dbkey_scope',
  53    'number_of_users',
  54    'trace',
  55    'no_garbage_collect',
  56    'damaged',
  57    'license',
  58    'sys_user_name',
  59    'encrypt_key',
  60    'activate_shadow',
  61    'sweep_interval',
  62    'delete_shadow',
  63    'force_write',
  64    'begin_log',
  65    'quit_log',
  66    'no_reserve',
  67    'user_name',
  68    'password',
  69    'password_enc',
  70    'sys_user_name_enc',
  71    'interp',
  72    'online_dump',
  73    'old_file_size',
  74    'old_num_files',
  75    'old_file',
  76    'old_start_page',
  77    'old_start_seqno',
  78    'old_start_file',
  79    'drop_walfile',
  80    'old_dump_id',
  81    'wal_backup_dir',
  82    'wal_chkptlen',
  83    'wal_numbufs',
  84    'wal_bufsize',
  85    'wal_grp_cmt_wait',
  86    'lc_messages',
  87    'lc_ctype',
  88    'cache_manager',
  89    'shutdown',
  90    'online',
  91    'shutdown_delay',
  92    'reserved',
  93    'overwrite',
  94    'sec_attach',
  95    'disable_wal',
  96    'connect_timeout',
  97    'dummy_packet_interval',
  98    'gbak_attach',
  99    'sql_role_name',
 100    'set_page_buffers',
 101    'working_directory',
 102    'sql_dialect',
 103    'set_db_readonly',
 104    'set_db_sql_dialect',
 105    'gfix_attach',
 106    'gstat_attach'
 107  );
 108
 109  TPBPrefix = 'isc_tpb_';
 110  TPBConstantNames: array[1..isc_tpb_last_tpb_constant] of string = (
 111    'consistency',
 112    'concurrency',
 113    'shared',
 114    'protected',
 115    'exclusive',
 116    'wait',
 117    'nowait',
 118    'read',
 119    'write',
 120    'lock_read',
 121    'lock_write',
 122    'verb_time',
 123    'commit_time',
 124    'ignore_limbo',
 125    'read_committed',
 126    'autocommit',
 127    'rec_version',
 128    'no_rec_version',
 129    'restart_requests',
 130    'no_auto_undo'
 131  );
 132
 133type
 134
 135  TIBDatabase = class;
 136  TIBTransaction = class;
 137  TIBBase = class;
 138
 139  TIBDatabaseLoginEvent = procedure(Database: TIBDatabase;
 140    LoginParams: TStrings) of object;
 141
 142  IIBEventNotifier = interface
 143  ['{9427DE09-46F7-4E1D-8B92-C1F88B47BF6D}']
 144    procedure RegisterEvents;
 145    procedure UnRegisterEvents;
 146    function GetAutoRegister: Boolean;
 147  end;
 148
 149  TIBSchema = class(TObject)
 150  public
 151    procedure FreeNodes; virtual; abstract;
 152    function Has_DEFAULT_VALUE(Relation, Field : String) : Boolean; virtual; abstract;
 153    function Has_COMPUTED_BLR(Relation, Field : String) : Boolean; virtual; abstract;
 154    //!!!
 155    function Get_DEFAULT_VALUE(Relation, Field : String) : String; virtual; abstract;
 156    //!!!
 157  end;
 158
 159  TIBFileName = type string;
 160  { TIBDatabase }
 161  TIBDataBase = class(TCustomConnection)
 162  private
 163    FHiddenPassword: string;
 164    FIBLoaded: Boolean;
 165    FOnLogin: TIBDatabaseLoginEvent;
 166    FTraceFlags: TTraceFlags;
 167    FDBSQLDialect: Integer;
 168    FSQLDialect: Integer;
 169    FOnDialectDowngradeWarning: TNotifyEvent;
 170    FCanTimeout: Boolean;
 171    FSQLObjects: TList;
 172    FTransactions: TList;
 173    FDBName: TIBFileName;
 174    FDBParams: TStrings;
 175    FDBParamsChanged: Boolean;
 176    FDPB: PChar;
 177    FDPBLength: Short;
 178    FHandle: TISC_DB_HANDLE;
 179    FHandleIsShared: Boolean;
 180    FOnIdleTimer: TNotifyEvent;
 181    FDefaultTransaction: TIBTransaction;
 182    FInternalTransaction: TIBTransaction;
 183    FTimer: TTimer;
 184    FUserNames: TStringList;
 185    FEventNotifiers : TList;
 186    FAllowStreamedConnected: Boolean;
 187    FSchema : TIBSchema;
 188    procedure EnsureInactive;
 189    function GetDBSQLDialect: Integer;
 190    function GetSQLDialect: Integer;
 191    procedure SetSQLDialect(const Value: Integer);
 192    procedure ValidateClientSQLDialect;
 193    procedure DBParamsChange(Sender: TObject);
 194    procedure DBParamsChanging(Sender: TObject);
 195    function GetSQLObject(Index: Integer): TIBBase;
 196    function GetSQLObjectCount: Integer;
 197    function GetDBParamByDPB(const Idx: Integer): String;
 198    function GetIdleTimer: Integer;
 199    function GetTransaction(Index: Integer): TIBTransaction;
 200    function GetTransactionCount: Integer;
 201    function Login: Boolean;
 202    procedure SetDatabaseName(const Value: TIBFileName);
 203    procedure SetDBParamByDPB(const Idx: Integer; Value: String);
 204    procedure SetDBParams(Value: TStrings);
 205    procedure SetDefaultTransaction(Value: TIBTransaction);
 206    procedure SetIdleTimer(Value: Integer);
 207    procedure TimeoutConnection(Sender: TObject);
 208    function GetIsReadOnly: Boolean;
 209    function AddSQLObject(ds: TIBBase): Integer;
 210    procedure RemoveSQLObject(Idx: Integer);
 211    procedure RemoveSQLObjects;
 212    procedure InternalClose(Force: Boolean);
 213
 214  protected
 215    procedure DoConnect; override;
 216    procedure DoDisconnect; override;
 217    function GetConnected: Boolean; override;
 218    procedure Loaded; override;
 219    procedure Notification( AComponent: TComponent; Operation: TOperation); override;
 220
 221    function GetLongDBInfo(DBInfoCommand: Integer): Long;
 222    function GetProtectLongDBInfo(DBInfoCommand: Integer;var Success:boolean): Long;
 223//Firebird Info
 224    function GetFBVersion: String;
 225    function GetODSMinorVersion: Long;
 226    function GetODSMajorVersion: Long;
 227//Versions
 228  private
 229    FServerMajorVersion: Integer;
 230    FServerMinorVersion: Integer;
 231    FServerRelease: Integer;
 232    FServerBuild: Integer;
 233    procedure FillServerVersions;
 234    function GetVersion: String;
 235    function GetServerMajorVersion: Integer;
 236    function GetServerMinorVersion: Integer;
 237    function GetServerRelease: Integer;
 238    function GetServerBuild: Integer;
 239  public
 240    constructor Create(AOwner: TComponent); override;
 241    destructor Destroy; override;
 242    procedure AddEventNotifier(Notifier : IIBEventNotifier);
 243    procedure RemoveEventNotifier(Notifier : IIBEventNotifier);
 244    procedure ApplyUpdates(const DataSets: array of TDataSet);
 245    procedure CloseDataSets;
 246    procedure CheckActive;
 247    procedure CheckInactive;
 248    procedure CreateDatabase;
 249    procedure DropDatabase;
 250    procedure ForceClose;
 251    procedure GetFieldNames(const TableName: string; List: TStrings);
 252    procedure GetTableNames(List: TStrings; SystemTables: Boolean = False);
 253    function IndexOfDBConst(st: String): Integer;
 254    function TestConnected: Boolean;
 255    procedure CheckDatabaseName;
 256    function Call(ErrCode: ISC_STATUS; RaiseError: Boolean): ISC_STATUS;
 257    function AddTransaction(TR: TIBTransaction): Integer;
 258    function FindTransaction(TR: TIBTransaction): Integer;
 259    function FindDefaultTransaction(): TIBTransaction;
 260    procedure RemoveTransaction(Idx: Integer);
 261    procedure RemoveTransactions;
 262    procedure SetHandle(Value: TISC_DB_HANDLE);
 263
 264    property Handle: TISC_DB_HANDLE read FHandle;
 265    property IsReadOnly: Boolean read GetIsReadOnly;
 266    property DBParamByDPB[const Idx: Integer]: String read GetDBParamByDPB
 267                                                      write SetDBParamByDPB;
 268    property SQLObjectCount: Integer read GetSQLObjectCount;
 269    property SQLObjects[Index: Integer]: TIBBase read GetSQLObject;
 270    property HandleIsShared: Boolean read FHandleIsShared;
 271    property TransactionCount: Integer read GetTransactionCount;
 272    property Transactions[Index: Integer]: TIBTransaction read GetTransaction;
 273    property InternalTransaction: TIBTransaction read FInternalTransaction;
 274
 275    property FBVersion: String read GetFBVersion;
 276    property Version: String read GetVersion;
 277    property ServerMajorVersion: Integer read GetServerMajorVersion;
 278    property ServerMinorVersion: Integer read GetServerMinorVersion;
 279    property ServerBuild: Integer read GetServerBuild;
 280    property ServerRelease: Integer read GetServerRelease;
 281    property ODSMinorVersion: Long read GetODSMinorVersion;
 282    property ODSMajorVersion: Long read GetODSMajorVersion;
 283    {Schema functions}
 284    function Has_DEFAULT_VALUE(Relation, Field : String) : Boolean;
 285    function Has_COMPUTED_BLR(Relation, Field : String) : Boolean;
 286    //!!!
 287    function Get_DEFAULT_VALUE(Relation, Field : String) : String;
 288    //!!!
 289    procedure FlushSchema;
 290    function IsFirebirdConnect: Boolean;
 291    function IsFirebird25Connect: Boolean;
 292
 293  published
 294    property Connected;
 295    property DatabaseName: TIBFileName read FDBName write SetDatabaseName;
 296    property Params: TStrings read FDBParams write SetDBParams;
 297    property LoginPrompt default True;
 298    property DefaultTransaction: TIBTransaction read FDefaultTransaction
 299                                                 write SetDefaultTransaction;
 300    property IdleTimer: Integer read GetIdleTimer write SetIdleTimer default 0;
 301    property SQLDialect : Integer read GetSQLDialect write SetSQLDialect default 3;
 302    property DBSQLDialect : Integer read FDBSQLDialect;
 303    property TraceFlags: TTraceFlags read FTraceFlags write FTraceFlags default [];
 304    property AllowStreamedConnected : Boolean read FAllowStreamedConnected write FAllowStreamedConnected default true;
 305    property AfterConnect;
 306    property AfterDisconnect;
 307    property BeforeConnect;
 308    property BeforeDisconnect;
 309    property OnLogin: TIBDatabaseLoginEvent read FOnLogin write FOnLogin;
 310    property OnIdleTimer: TNotifyEvent read FOnIdleTimer write FOnIdleTimer;
 311    property OnDialectDowngradeWarning: TNotifyEvent read FOnDialectDowngradeWarning write FOnDialectDowngradeWarning;
 312  end;
 313
 314  { TIBTransaction }
 315
 316  TTransactionAction = (TARollback, TACommit, TARollbackRetaining, TACommitRetaining);
 317  TAutoStopAction = (saNone, saRollback, saCommit, saRollbackRetaining, saCommitRetaining);
 318
 319  TIBTransaction = class(TComponent)
 320  private
 321    FIBLoaded: Boolean;
 322    FCanTimeout         : Boolean;
 323    FDatabases          : TList;
 324    FSQLObjects         : TList;
 325    FDefaultDatabase    : TIBDatabase;
 326    FHandle             : TISC_TR_HANDLE;
 327    FHandleIsShared     : Boolean;
 328    FOnIdleTimer          : TNotifyEvent;
 329    FStreamedActive     : Boolean;
 330    FTPB                : PChar;
 331    FTPBLength          : Short;
 332    FTimer              : TTimer;
 333    FDefaultAction      : TTransactionAction;
 334    FTRParams           : TStrings;
 335    FTRParamsChanged    : Boolean;
 336    FAutoStopAction: TAutoStopAction;
 337    procedure EnsureNotInTransaction;
 338    procedure EndTransaction(Action: TTransactionAction; Force: Boolean);
 339    function GetDatabase(Index: Integer): TIBDatabase;
 340    function GetDatabaseCount: Integer;
 341    function GetSQLObject(Index: Integer): TIBBase;
 342    function GetSQLObjectCount: Integer;
 343    function GetInTransaction: Boolean;
 344    function GetIdleTimer: Integer;
 345    procedure BeforeDatabaseDisconnect(DB: TIBDatabase);
 346    procedure SetActive(Value: Boolean);
 347    procedure SetDefaultAction(Value: TTransactionAction);
 348    procedure SetDefaultDatabase(Value: TIBDatabase);
 349    procedure SetIdleTimer(Value: Integer);
 350    procedure SetTRParams(Value: TStrings);
 351    procedure TimeoutTransaction(Sender: TObject);
 352    procedure TRParamsChange(Sender: TObject);
 353    procedure TRParamsChanging(Sender: TObject);
 354    function AddSQLObject(ds: TIBBase): Integer;
 355    procedure RemoveSQLObject(Idx: Integer);
 356    procedure RemoveSQLObjects;
 357
 358  protected
 359    procedure Loaded; override;
 360    procedure SetHandle(Value: TISC_TR_HANDLE);
 361    procedure Notification( AComponent: TComponent; Operation: TOperation); override;
 362
 363  public
 364    constructor Create(AOwner: TComponent); override;
 365    destructor Destroy; override;
 366    function Call(ErrCode: ISC_STATUS; RaiseError: Boolean): ISC_STATUS;
 367    procedure Commit;
 368    procedure CommitRetaining;
 369    procedure Rollback;
 370    procedure RollbackRetaining;
 371    procedure StartTransaction;
 372    procedure CheckInTransaction;
 373    procedure CheckNotInTransaction;
 374    procedure CheckAutoStop;
 375
 376    procedure ExecSQLImmediate(const SQLText: String);
 377    procedure SetSavePoint(const SavePointName: String);
 378    procedure RollBackToSavePoint(const SavePointName: String);
 379    procedure ReleaseSavePoint(const SavePointName: String);
 380
 381    function AddDatabase(db: TIBDatabase): Integer;
 382    function FindDatabase(db: TIBDatabase): Integer;
 383    function FindDefaultDatabase: TIBDatabase;
 384    procedure RemoveDatabase(Idx: Integer);
 385    procedure RemoveDatabases;
 386    procedure CheckDatabasesInList;
 387    function MainDatabase: TIBDatabase;
 388
 389    property DatabaseCount: Integer read GetDatabaseCount;
 390    property Databases[Index: Integer]: TIBDatabase read GetDatabase;
 391    property SQLObjectCount: Integer read GetSQLObjectCount;
 392    property SQLObjects[Index: Integer]: TIBBase read GetSQLObject;
 393    property Handle: TISC_TR_HANDLE read FHandle;
 394    property HandleIsShared: Boolean read FHandleIsShared;
 395    property InTransaction: Boolean read GetInTransaction;
 396    property TPB: PChar read FTPB;
 397    property TPBLength: Short read FTPBLength;
 398  published
 399    property Active: Boolean read GetInTransaction write SetActive;
 400    property DefaultDatabase: TIBDatabase read FDefaultDatabase
 401                                           write SetDefaultDatabase;
 402    property IdleTimer: Integer read GetIdleTimer write SetIdleTimer default 0;
 403//    property DefaultAction: TTransactionAction read FDefaultAction write SetDefaultAction default taCommit;
 404    property DefaultAction: TTransactionAction read FDefaultAction write SetDefaultAction default taRollback;
 405    property Params: TStrings read FTRParams write SetTRParams;
 406    property AutoStopAction : TAutoStopAction read FAutoStopAction write FAutoStopAction;
 407    property OnIdleTimer: TNotifyEvent read FOnIdleTimer write FOnIdleTimer;
 408  end;
 409
 410  { TIBBase }
 411
 412  { Virtually all components in IB are "descendents" of TIBBase.
 413    It is to more easily manage the database and transaction
 414    connections. }
 415  TIBBase = class(TObject)
 416  protected
 417    FDatabase: TIBDatabase;
 418    FIndexInDatabase: Integer;
 419    FTransaction: TIBTransaction;
 420    FIndexInTransaction: Integer;
 421    FOwner: TObject;
 422    FBeforeDatabaseDisconnect: TNotifyEvent;
 423    FAfterDatabaseDisconnect: TNotifyEvent;
 424    FOnDatabaseFree: TNotifyEvent;
 425    FBeforeTransactionEnd: TNotifyEvent;
 426    FAfterTransactionEnd: TNotifyEvent;
 427    FOnTransactionFree: TNotifyEvent;
 428
 429    procedure DoBeforeDatabaseDisconnect; virtual;
 430    procedure DoAfterDatabaseDisconnect; virtual;
 431    procedure DoDatabaseFree; virtual;
 432    procedure DoBeforeTransactionEnd; virtual;
 433    procedure DoAfterTransactionEnd; virtual;
 434    procedure DoTransactionFree; virtual;
 435    function GetDBHandle: PISC_DB_HANDLE; virtual;
 436    function GetTRHandle: PISC_TR_HANDLE; virtual;
 437    procedure SetDatabase(Value: TIBDatabase); virtual;
 438    procedure SetTransaction(Value: TIBTransaction); virtual;
 439  public
 440    constructor Create(AOwner: TObject);
 441    destructor Destroy; override;
 442    procedure CheckDatabase; virtual;
 443    procedure CheckTransaction; virtual;
 444  public
 445    property BeforeDatabaseDisconnect: TNotifyEvent read FBeforeDatabaseDisconnect
 446                                                   write FBeforeDatabaseDisconnect;
 447    property AfterDatabaseDisconnect: TNotifyEvent read FAfterDatabaseDisconnect
 448                                                  write FAfterDatabaseDisconnect;
 449    property OnDatabaseFree: TNotifyEvent read FOnDatabaseFree write FOnDatabaseFree;
 450    property BeforeTransactionEnd: TNotifyEvent read FBeforeTransactionEnd write FBeforeTransactionEnd;
 451    property AfterTransactionEnd: TNotifyEvent read FAfterTransactionEnd write FAfterTransactionEnd;
 452    property OnTransactionFree: TNotifyEvent read FOnTransactionFree write FOnTransactionFree;
 453    property Database: TIBDatabase read FDatabase
 454                                    write SetDatabase;
 455    property DBHandle: PISC_DB_HANDLE read GetDBHandle;
 456    property Owner: TObject read FOwner;
 457    property TRHandle: PISC_TR_HANDLE read GetTRHandle;
 458    property Transaction: TIBTransaction read FTransaction
 459                                          write SetTransaction;
 460  end;
 461
 462procedure GenerateDPB(sl: TStrings; var DPB: string; var DPBLength: Short);
 463procedure GenerateTPB(sl: TStrings; var TPB: string; var TPBLength: Short);
 464
 465
 466implementation
 467
 468uses IBIntf, IBCustomDataSet, IBDatabaseInfo, IBSQL, IBUtils,
 469     typInfo, DBLogDlg, IBErrorCodes
 470     {$IFDEF GEDEMIN}
 471     ,at_classes, IBSQLCache, IBSQLMonitor_Gedemin
 472     {$ELSE}
 473     , IBSQLMonitor
 474     {$ENDIF}
 475     ;
 476
 477//!!!! added by Andreik
 478{
 479var
 480  GetFieldNamesCache: TStringList;
 481  GetFieldNamesCacheDatabaseName: String;
 482}
 483
 484{
 485procedure ClearGetFieldNamesCache;
 486var
 487  I: Integer;
 488  P: PString;
 489begin
 490  if GetFieldNamesCache <> nil then
 491  begin
 492    for I := 0 to GetFieldNamesCache.Count - 1 do
 493    begin
 494      P := PString(GetFieldNamesCache.Objects[I]);
 495      Finalize(P^);
 496      Dispose(P);
 497    end;
 498    GetFieldNamesCache.Clear;
 499  end;
 500end;
 501}
 502//!!!!
 503
 504type
 505
 506  TFieldNode = class(TObject)
 507  public
 508    FieldName : String;
 509    COMPUTED_BLR : Boolean;
 510    DEFAULT_VALUE : boolean;
 511    //!!!
 512    DEFAULT_VALUE_SOURCE: String
 513    //!!!
 514  end;
 515
 516  TSchema = class(TIBSchema)
 517  private
 518    FRelations : TStringList;
 519    FQuery : TIBSQL;
 520    function Add_Node(Relation, Field : String) : TFieldNode;
 521  public
 522    constructor Create(ADatabase : TIBDatabase);
 523    destructor Destroy; override;
 524    procedure FreeNodes; override;
 525    function Has_DEFAULT_VALUE(Relation, Field : String) : Boolean; override;
 526    function Has_COMPUTED_BLR(Relation, Field : String) : Boolean; override;
 527    //!!!
 528    function Get_DEFAULT_VALUE(Relation, Field : String) : String; override;
 529    //!!!
 530  end;
 531
 532{ TIBDatabase }
 533
 534constructor TIBDatabase.Create(AOwner: TComponent);
 535begin
 536  inherited Create(AOwner);
 537  FIBLoaded := False;
 538  CheckIBLoaded;
 539  FIBLoaded := True;
 540  LoginPrompt := True;
 541  FSQLObjects := TList.Create;
 542  FTransactions := TList.Create;
 543  FDBName := '';
 544  FDBParams := TStringList.Create;
 545  FDBParamsChanged := True;
 546  TStringList(FDBParams).OnChange := DBParamsChange;
 547  TStringList(FDBParams).OnChanging := DBParamsChanging;
 548  FDPB := nil;
 549  FHandle := nil;
 550  FUserNames := nil;
 551  FInternalTransaction := TIBTransaction.Create(self);
 552  FInternalTransaction.DefaultDatabase := Self;
 553  FDBSQLDialect := 3;
 554  FSQLDialect := 3;
 555  FTraceFlags := [];
 556  FEventNotifiers := TList.Create;
 557  FAllowStreamedConnected := true;
 558  FSchema := TSchema.Create(self);
 559  FServerMajorVersion := -1;
 560  FServerMinorVersion := -1;
 561  FServerBuild :=-1;
 562end;
 563
 564destructor TIBDatabase.Destroy;
 565var
 566  i: Integer;
 567begin
 568  if FIBLoaded then
 569  begin
 570    IdleTimer := 0;
 571    if FHandle <> nil then
 572    try
 573      Close;
 574    except
 575      ForceClose;
 576    end;
 577    for i := 0 to FSQLObjects.Count - 1 do
 578      if FSQLObjects[i] <> nil then
 579        SQLObjects[i].DoDatabaseFree;
 580    RemoveSQLObjects;
 581    RemoveTransactions;
 582    FInternalTransaction.Free;
 583    FreeMem(FDPB);
 584    FDPB := nil;
 585    FDBParams.Free;
 586    FSQLObjects.Free;
 587    FUserNames.Free;
 588    FTransactions.Free;
 589    FEventNotifiers.Free;
 590    FSchema.Free;
 591  end;
 592  inherited Destroy;
 593end;
 594
 595(*
 596function TIBDatabase.Call(ErrCode: ISC_STATUS;
 597  RaiseError: Boolean): ISC_STATUS;
 598begin
 599  result := ErrCode;
 600  FCanTimeout := False;
 601  {Handle when the Error is due to a Database disconnect.  Call the
 602  OnConnectionLost if it exists.}
 603  if RaiseError and CheckStatusVector([isc_lost_db_connection]) then
 604    ForceClose;
 605  if RaiseError and (ErrCode > 0) then
 606    IBDataBaseError;
 607end;
 608*)
 609
 610function TIBDatabase.Call(ErrCode: ISC_STATUS;
 611  RaiseError: Boolean): ISC_STATUS;
 612var
 613  sqlcode: Long;
 614  IBErrorCode: Long;
 615  local_buffer: array[0..IBHugeLocalBufferLength - 1] of char;
 616  usr_msg: string;
 617  status_vector: PISC_STATUS;
 618  IBDataBaseErrorMessages: TIBDataBaseErrorMessages;
 619
 620  procedure SaveDataBaseError;
 621  begin
 622    usr_msg := '';
 623
 624    { Get a local reference to the status vector.
 625      Get a local copy of the IBDataBaseErrorMessages options.
 626      Get the SQL error code }
 627    status_vector := StatusVector;
 628    IBErrorCode := StatusVectorArray[1];
 629    IBDataBaseErrorMessages := GetIBDataBaseErrorMessages;
 630    sqlcode := isc_sqlcode(status_vector);
 631
 632    if (ShowSQLCode in IBDataBaseErrorMessages) then
 633      usr_msg := usr_msg + 'SQLCODE: ' + IntToStr(sqlcode); {do not localize}
 634    Exclude(IBDataBaseErrorMessages, ShowSQLMessage);
 635    if (ShowSQLMessage in IBDataBaseErrorMessages) then
 636    begin
 637      isc_sql_interprete(sqlcode, local_buffer, IBLocalBufferLength);
 638      if (ShowSQLCode in IBDataBaseErrorMessages) then
 639        usr_msg := usr_msg + CRLF;
 640      usr_msg := usr_msg + string(local_buffer);
 641    end;
 642
 643    if (ShowIBMessage in IBDataBaseErrorMessages) then
 644    begin
 645      if (ShowSQLCode in IBDataBaseErrorMessages) or
 646         (ShowSQLMessage in IBDataBaseErrorMessages) then
 647        usr_msg := usr_msg + CRLF;
 648      while (isc_interprete(local_buffer, @status_vector) > 0) do
 649      begin
 650        if (usr_msg <> '') and (usr_msg[Length(usr_msg)] <> LF) then
 651          usr_msg := usr_msg + CRLF;
 652        usr_msg := usr_msg + string(local_buffer);
 653      end;
 654    end;
 655    if (usr_msg <> '') and (usr_msg[Length(usr_msg)] = '.') then
 656      Delete(usr_msg, Length(usr_msg), 1);
 657  end;
 658
 659{const
 660  DBNLength = 1024;
 661var
 662  DBN: array[0..DBNLength] of Char;}
 663begin
 664  {while (CheckStatusVector([isc_lost_db_connection])
 665    or CheckStatusVector([isc_net_read_err]) or CheckStatusVector([isc_net_write_err])) do
 666  begin
 667    if MessageBox(0,
 668      '???????? ?????????? ? ????? ??????.'#13#10 +
 669      '?????????? ????????? ????????????',
 670      '????????!',
 671      MB_YESNO or MB_ICONEXCLAMATION or MB_TASKMODAL) = IDNO then
 672    begin
 673      break;
 674    end;
 675
 676    if Length(FDBName) <= DBNLength then
 677      StrPCopy(DBN, FDBName)
 678    else
 679      StrPCopy(DBN, Copy(FDBName, 1, DBNLength));
 680    FHandle := nil;
 681    if isc_attach_database(StatusVector, StrLen(DBN), DBN, @FHandle,
 682      FDPBLength, FDPB) = 0 then
 683    begin
 684      Abort;
 685    end;
 686  end;}
 687
 688  result := ErrCode;
 689  FCanTimeout := False;
 690  {Handle when the Error is due to a Database disconnect.  Call the
 691  OnConnectionLost if it exists.}
 692  if RaiseError and (CheckStatusVector([isc_lost_db_connection]) or
 693                     CheckStatusVector([isc_net_read_err]) or
 694                     CheckStatusVector([isc_net_write_err])) then
 695  begin
 696    SaveDataBaseError;
 697    ForceClose;
 698    MonitorHook.SendError(IntToStr(sqlcode) + ' ' + IntToStr(IBErrorCode) + ' ' + usr_msg, self);
 699    raise EIBInterBaseError.Create(sqlcode, IBErrorCode, usr_msg);
 700  end;
 701  if RaiseError and (ErrCode > 0) then
 702    IBDataBaseError;
 703end;
 704
 705procedure TIBDatabase.CheckActive;
 706begin
 707  if StreamedConnected and (not Connected) then
 708    Loaded;
 709  if FHandle = nil then
 710    IBError(ibxeDatabaseClosed, [nil]);
 711end;
 712
 713procedure TIBDatabase.EnsureInactive;
 714begin
 715  if csDesigning in ComponentState then
 716  begin
 717    if FHandle <> nil then
 718      Close;
 719  end
 720end;
 721
 722procedure TIBDatabase.CheckInactive;
 723begin
 724  if FHandle <> nil then
 725    IBError(ibxeDatabaseOpen, [nil]);
 726end;
 727
 728procedure TIBDatabase.CheckDatabaseName;
 729begin
 730  if (FDBName = '') then
 731    IBError(ibxeDatabaseNameMissing, [nil]);
 732end;
 733
 734function TIBDatabase.AddSQLObject(ds: TIBBase): Integer;
 735begin
 736  result := 0;
 737  if (ds.Owner is TIBCustomDataSet) then
 738      RegisterClient(TDataSet(ds.Owner));
 739  while (result < FSQLObjects.Count) and (FSQLObjects[result] <> nil) do
 740    Inc(result);
 741  if (result = FSQLObjects.Count) then
 742    FSQLObjects.Add(ds)
 743  else
 744    FSQLObjects[result] := ds;
 745end;
 746
 747function TIBDatabase.AddTransaction(TR: TIBTransaction): Integer;
 748begin
 749  result := FindTransaction(TR);
 750  if result <> -1 then
 751  begin
 752    result := -1;
 753    exit;
 754  end;
 755  result := 0;
 756  while (result < FTransactions.Count) and (FTransactions[result] <> nil) do
 757    Inc(result);
 758  if (result = FTransactions.Count) then
 759    FTransactions.Add(TR)
 760  else
 761    FTransactions[result] := TR;
 762end;
 763
 764procedure TIBDatabase.DoDisconnect;
 765var
 766  i : Integer;
 767begin
 768  for i := 0 to FEventNotifiers.Count - 1 do
 769    IIBEventNotifier(FEventNotifiers[i]).UnRegisterEvents;
 770  if Connected then
 771    InternalClose(False);
 772  FDBSQLDialect := 1;
 773end;
 774
 775procedure TIBDatabase.CreateDatabase;
 776var
 777  tr_handle: TISC_TR_HANDLE;
 778begin
 779  CheckInactive;
 780  tr_handle := nil;
 781  Call(
 782    isc_dsql_execute_immediate(StatusVector, @FHandle, @tr_handle, 0,
 783                               PChar('CREATE DATABASE ''' + FDBName + ''' ' + {do not localize}
 784                               Params.Text), SQLDialect, nil),
 785    True);
 786end;
 787
 788procedure TIBDatabase.DropDatabase;
 789begin
 790  CheckActive;
 791  Call(isc_drop_database(StatusVector, @FHandle), True);
 792end;
 793
 794procedure TIBDatabase.DBParamsChange(Sender: TObject);
 795begin
 796  FDBParamsChanged := True;
 797end;
 798
 799procedure TIBDatabase.DBParamsChanging(Sender: TObject);
 800begin
 801  EnsureInactive;
 802  CheckInactive;
 803end;
 804
 805function TIBDatabase.FindTransaction(TR: TIBTransaction): Integer;
 806var
 807  i: Integer;
 808begin
 809  result := -1;
 810  for i := 0 to FTransactions.Count - 1 do
 811    if TR = Transactions[i] then
 812    begin
 813      result := i;
 814      break;
 815    end;
 816end;
 817
 818function TIBDatabase.FindDefaultTransaction(): TIBTransaction;
 819var
 820  i: Integer;
 821begin
 822  result := FDefaultTransaction;
 823  if result = nil then
 824  begin
 825    for i := 0 to FTransactions.Count - 1 do
 826      if (Transactions[i] <> nil) and
 827        (TIBTransaction(Transactions[i]).DefaultDatabase = self) and
 828        (TIBTransaction(Transactions[i]) <> FInternalTransaction) then
 829       begin
 830         result := TIBTransaction(Transactions[i]);
 831         break;
 832       end;
 833  end;
 834end;
 835
 836procedure TIBDatabase.ForceClose;
 837var
 838  OldHandle: Pointer;
 839begin
 840  if Connected then
 841  begin
 842    OldHandle := FHandle;
 843    try
 844      FHandle := nil;
 845      if Assigned(BeforeDisconnect) then
 846        BeforeDisconnect(Self);
 847      SendConnectEvent(False);
 848    finally
 849      FHandle := OldHandle;
 850    end;
 851    InternalClose(True);
 852    if Assigned(AfterDisconnect) then
 853      AfterDisconnect(Self);
 854  end;
 855end;
 856
 857function TIBDatabase.GetConnected: Boolean;
 858begin
 859  result := FHandle <> nil;
 860end;
 861
 862function TIBDatabase.GetSQLObject(Index: Integer): TIBBase;
 863begin
 864  result := FSQLObjects[Index];
 865end;
 866
 867function TIBDatabase.GetSQLObjectCount: Integer;
 868var
 869  i: Integer;
 870begin
 871  result := 0;
 872  for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then
 873    Inc(result);
 874end;
 875
 876function TIBDatabase.GetDBParamByDPB(const Idx: Integer): String;
 877var
 878  ConstIdx, EqualsIdx: Integer;
 879begin
 880  if (Idx > 0) and (Idx <= isc_dpb_last_dpb_constant) then
 881  begin
 882    ConstIdx := IndexOfDBConst(DPBConstantNames[Idx]);
 883    if ConstIdx = -1 then
 884      result := ''
 885    else
 886    begin
 887      result := Params[ConstIdx];
 888      EqualsIdx := Pos('=', result); {mbcs ok}
 889      if EqualsIdx = 0 then
 890        result := ''
 891      else
 892        result := Copy(result, EqualsIdx + 1, Length(result));
 893    end;
 894  end
 895  else
 896    result := '';
 897end;
 898
 899function TIBDatabase.GetIdleTimer: Integer;
 900begin
 901  if Assigned(FTimer) then
 902    Result := FTimer.Interval
 903  else
 904    Result := 0;
 905end;
 906
 907function TIBDatabase.GetTransaction(Index: Integer): TIBTransaction;
 908begin
 909  result := FTransactions[Index];
 910end;
 911
 912function TIBDatabase.GetTransactionCount: Integer;
 913var
 914  i: Integer;
 915begin
 916  result := 0;
 917  for i := 0 to FTransactions.Count - 1 do
 918    if FTransactions[i] <> nil then
 919      Inc(result);
 920end;
 921
 922function TIBDatabase.IndexOfDBConst(st: String): Integer;
 923var
 924  i, pos_of_str: Integer;
 925begin
 926  result := -1;
 927  for i := 0 to Params.Count - 1 do
 928  begin
 929    pos_of_str := Pos(st, AnsiLowerCase(Params[i])); {mbcs ok}
 930    if (pos_of_str = 1) or (pos_of_str = Length(DPBPrefix) + 1) then
 931    begin
 932      result := i;
 933      break;
 934    end;
 935  end;
 936end;
 937
 938procedure TIBDatabase.InternalClose(Force: Boolean);
 939var
 940  i: Integer;
 941  oldHandle : TISC_DB_HANDLE;
 942begin
 943  CheckActive;
 944
 945  { If we are being forced close this is normally an abnormal connection loss.
 946    The underlying datasets will need to know that connection is not active
 947    the underlying objects are told the connection is going away }
 948  if Force then
 949  begin
 950    oldHandle := FHandle;
 951    FHandle := nil;
 952  end
 953  else
 954    oldHandle := nil;
 955
 956  for i := 0 to FSQLObjects.Count - 1 do
 957  begin
 958    try
 959      if FSQLObjects[i] <> nil then
 960        SQLObjects[i].DoBeforeDatabaseDisconnect;
 961    except
 962      if not Force then
 963        raise;
 964    end;
 965  end;
 966  { Tell all connected transactions that we're disconnecting.
 967    This is so transactions can commit/rollback, accordingly
 968  }
 969  for i := 0 to FTransactions.Count - 1 do
 970  begin
 971    try
 972      if FTransactions[i] <> nil then
 973        Transactions[i].BeforeDatabaseDisconnect(Self);
 974    except
 975      if not Force then
 976        raise;
 977    end;
 978  end;
 979
 980  if Force then
 981    FHandle := oldHandle;
 982
 983  {$IFDEF GEDEMIN}
 984  if _IBSQLCache <> nil then
 985    _IBSQLCache.Flush;
 986  {$ENDIF}
 987
 988  if not (csDesigning in ComponentState) then
 989    MonitorHook.DBDisconnect(Self);
 990
 991  if (not HandleIsShared) and
 992     (Call(isc_detach_database(StatusVector, @FHandle), False) > 0) and
 993     (not Force) then
 994    IBDataBaseError
 995  else
 996  begin
 997    FHandle := nil;
 998    FHandleIsShared := False;
 999  end;
1000
1001  for i := 0 to FSQLObjects.Count - 1 do
1002    if FSQLObjects[i] <> nil then
1003      SQLObjects[i].DoAfterDatabaseDisconnect;
1004end;
1005
1006procedure TIBDatabase.Loaded;
1007var
1008  i: integer;
1009begin
1010  try
1011    If (not FAllowStreamedConnected) and
1012       (not (csDesigning in ComponentState)) then
1013    begin
1014      StreamedConnected := false;
1015      for i := 0 to FTransactions.Count - 1 do
1016        if  FTransactions[i] <> nil then
1017          with TIBTransaction(FTransactions[i]) do
1018            FStreamedActive := False;
1019    end;
1020    if StreamedConnected and (not Connected) then
1021    begin
1022      inherited Loaded;
1023      for i := 0 to FTransactions.Count - 1 do
1024        if  FTransactions[i] <> nil then
1025        begin
1026          with TIBTransaction(FTransactions[i]) do
1027            if not Active then
1028              if FStreamedActive and not InTransaction then
1029              begin
1030                StartTransaction;
1031                FStreamedActive := False;
1032              end;
1033        end;
1034      if (FDefaultTransaction <> nil) and
1035         (FDefaultTransaction.FStreamedActive) and
1036         (not FDefaultTransaction.InTransaction) then
1037        FDefaultTransaction.StartTransaction;
1038      StreamedConnected := False;
1039    end;
1040  except
1041    if csDesigning in ComponentState then
1042      Application.HandleException(Self)
1043    else
1044      raise;
1045  end;
1046end;
1047
1048procedure TIBDatabase.Notification( AComponent: TComponent;
1049                                        Operation: TOperation);
1050var
1051  i: Integer;
1052begin
1053  inherited Notification( AComponent, Operation);
1054  if (Operation = opRemove) and (AComponent = FDefaultTransaction) then
1055  begin
1056    i := FindTransaction(FDefaultTransaction);
1057    if (i <> -1) then
1058      RemoveTransaction(i);
1059    FDefaultTransaction := nil;
1060  end;
1061end;
1062
1063function TIBDatabase.Login: Boolean;
1064var
1065  IndexOfUser, IndexOfPassword: Integer;
1066  Username, Password, OldPassword: String;
1067  LoginParams: TStrings;
1068
1069  procedure HidePassword;
1070  var
1071    I: Integer;
1072    IndexAt: Integer;
1073  begin
1074    IndexAt := 0;
1075    for I := 0 to Params.Count -1 do
1076      if Pos('password', LowerCase(Trim(Params.Names[i]))) = 1 then {mbcs ok}
1077      begin
1078        FHiddenPassword := Params.Values[Params.Names[i]];
1079        IndexAt := I;
1080        break;
1081      end;
1082    if IndexAt <> 0 then
1083      Params.Delete(IndexAt);
1084  end;
1085
1086begin
1087  if Assigned(FOnLogin) then
1088  begin
1089    result := True;
1090    LoginParams := TStringList.Create;
1091    try
1092      LoginParams.Assign(Params);
1093      FOnLogin(Self, LoginParams);
1094      Params.Assign(LoginParams);
1095      HidePassword;
1096    finally
1097      LoginParams.Free;
1098    end;
1099  end
1100  else
1101  begin
1102    IndexOfUser := IndexOfDBConst(DPBConstantNames[isc_dpb_user_name]);
1103    if IndexOfUser <> -1 then
1104      Username := Copy(Params[IndexOfUser],
1105                                         Pos('=', Params[IndexOfUser]) + 1, {mbcs ok}
1106                                         Length(Params[IndexOfUser]));
1107    IndexOfPassword := IndexOfDBConst(DPBConstantNames[isc_dpb_password]);
1108    if IndexOfPassword <> -1 then
1109    begin
1110      Password := Copy(Params[IndexOfPassword],
1111                                         Pos('=', Params[IndexOfPassword]) + 1, {mbcs ok}
1112                                         Length(Params[IndexOfPassword]));
1113      OldPassword := password;
1114    end;
1115    result := LoginDialogEx(DatabaseName, Username, Password, False);
1116    if result then
1117    begin
1118      if IndexOfUser = -1 then
1119        Params.Add(DPBConstantNames[isc_dpb_user_name] + '=' + Username)
1120      else
1121        Params[IndexOfUser] := DPBConstantNames[isc_dpb_user_name] +
1122                                 '=' + Username;
1123      if (Password = OldPassword) then
1124        FHiddenPassword := ''
1125      else
1126      begin
1127        //!!!b
1128        //FHiddenPassword := Password;
1129        //if OldPassword <> '' then
1130        //  HidePassword;
1131        if IndexOfPassword = -1 then
1132          Params.Add(DPBConstantNames[isc_dpb_password] + '=' + Password)
1133        else
1134          Params[IndexOfPassword] := DPBConstantNames[isc_dpb_password] +
1135                                   '=' + Password;
1136        FHiddenPassword := Password;
1137        //!!!e
1138      end;
1139    end;
1140  end;
1141end;
1142
1143procedure TIBDatabase.DoConnect;
1144const
1145  DBNLength = 1024;
1146var
1147  DPB: String;
1148  TempDBParams: TStrings;
1149  i : Integer;
1150  DBN: array[0..DBNLength] of Char;
1151begin
1152  CheckInactive;
1153  CheckDatabaseName;
1154  if (not LoginPrompt) and (FHiddenPassword <> '') then
1155  begin
1156    FHiddenPassword := '';
1157    FDBParamsChanged := True;
1158  end;
1159  { Use builtin login prompt if requested }
1160  if LoginPrompt and not Login then
1161    IBError(ibxeOperationCancelled, [nil]);
1162  { Generate a new DPB if necessary }
1163  if (FDBParamsChanged) then
1164  begin
1165    FDBParamsChanged := False;
1166    if (not LoginPrompt) or (FHiddenPassword = '') then
1167      GenerateDPB(FDBParams, DPB, FDPBLength)
1168    else
1169    begin
1170      TempDBParams := TStringList.Create;
1171      try
1172       TempDBParams.Assign(FDBParams);
1173       TempDBParams.Add('password=' + FHiddenPassword);
1174       GenerateDPB(TempDBParams, DPB, FDPBLength);
1175      finally
1176       TempDBParams.Free;
1177      end;
1178    end;
1179    IBAlloc(FDPB, 0, FDPBLength);
1180    Move(DPB[1], FDPB[0], FDPBLength);
1181  end;
1182  if Length(FDBName) <= DBNLength then
1183    StrPCopy(DBN, FDBName)
1184  else
1185    StrPCopy(DBN, Copy(FDBName, 1, DBNLength));
1186  if Call(isc_attach_database(StatusVector, StrLen(DBN),
1187                         DBN, @FHandle,
1188                         FDPBLength, FDPB), False) > 0 then
1189  begin
1190    FHandle := nil;
1191    IBDataBaseError;
1192  end;
1193  FDBSQLDialect := GetDBSQLDialect;
1194  ValidateClientSQLDialect;
1195  if not (csDesigning in ComponentState) then
1196    MonitorHook.DBConnect(Self);
1197  for i := 0 to FEventNotifiers.Count - 1 do
1198    if IIBEventNotifier(FEventNotifiers[i]).GetAutoRegister then
1199      IIBEventNotifier(FEventNotifiers[i]).RegisterEvents;
1200end;
1201
1202procedure TIBDatabase.RemoveSQLObject(Idx: Integer);
1203var
1204  ds: TIBBase;
1205begin
1206  if (Idx >= 0) and (FSQLObjects[Idx] <> nil) then
1207  begin
1208    ds := SQLObjects[Idx];
1209    FSQLObjects[Idx] := nil;
1210    ds.Database := nil;
1211    if (ds.owner is TDataSet) then
1212      UnregisterClient(TDataSet(ds.Owner));
1213  end;
1214end;
1215
1216procedure TIBDatabase.RemoveSQLObjects;
1217var
1218  i: Integer;
1219begin
1220  for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then
1221  begin
1222    RemoveSQLObject(i);
1223    if (TIBBase(FSQLObjects[i]).owner is TDataSet) then
1224      UnregisterClient(TDataSet(TIBBase(FSQLObjects[i]).owner));
1225  end;
1226end;
1227
1228procedure TIBDatabase.RemoveTransaction(Idx: Integer);
1229var
1230  TR: TIBTransaction;
1231begin
1232  if ((Idx >= 0) and (FTransactions[Idx] <> nil)) then
1233  begin
1234    TR := Transactions[Idx];
1235    FTransactions[Idx] := nil;
1236    TR.RemoveDatabase(TR.FindDatabase(Self));
1237    if TR = FDefaultTransaction then
1238      FDefaultTransaction := nil;
1239  end;
1240end;
1241
1242procedure TIBDatabase.RemoveTransactions;
1243var
1244  i: Integer;
1245begin
1246  for i := 0 to FTransactions.Count - 1 do if FTransactions[i] <> nil then
1247    RemoveTransaction(i);
1248end;
1249
1250procedure TIBDatabase.SetDatabaseName(const Value: TIBFileName);
1251begin
1252  if FDBName <> Value then
1253  begin
1254    EnsureInactive;
1255    CheckInactive;
1256    {$IFDEF GEDEMIN}
1257    if Pos(':', Value) = 0 then
1258      FDBName := ExtractFilePath(Application.EXEName) + Value
1259    else
1260      FDBName := Value;
1261    {$ELSE}
1262    FDBName := Value;
1263    {$ENDIF}
1264    FSchema.FreeNodes;
1265  end;
1266end;
1267
1268procedure TIBDatabase.SetDBParamByDPB(const Idx: Integer; Value: String);
1269var
1270  ConstIdx: Integer;
1271begin
1272  ConstIdx := IndexOfDBConst(DPBConstantNames[Idx]);
1273  if (Value = '') then
1274  begin
1275    if ConstIdx <> -1 then
1276      Params.Delete(ConstIdx);
1277  end
1278  else
1279  begin
1280    if (ConstIdx = -1) then
1281      Params.Add(DPBConstantNames[Idx] + '=' + Value)
1282    else
1283      Params[ConstIdx] := DPBConstantNames[Idx] + '=' + Value;
1284  end;
1285end;
1286
1287procedure TIBDatabase.SetDBParams(Value: TStrings);
1288begin
1289  FDBParams.Assign(Value);
1290end;
1291
1292procedure TIBDatabase.SetDefaultTransaction(Value: TIBTransaction);
1293var
1294  i: Integer;
1295begin
1296  if (FDefaultTransaction <> nil) and (FDefaultTransaction <> Value) then
1297  begin
1298    i := FindTransaction(FDefaultTransaction);
1299    if (i <> -1) and (FDefaultTransaction.DefaultDatabase <> self) then
1300      RemoveTransaction(i);
1301  end;
1302  if (Value <> nil) and (FDefaultTransaction <> Value) then
1303  begin
1304    Value.AddDatabase(Self);
1305    AddTransaction(Value);
1306  end;
1307  FDefaultTransaction := Value;
1308end;
1309
1310procedure TIBDatabase.SetHandle(Value: TISC_DB_HANDLE);
1311begin
1312  if HandleIsShared then
1313    Close
1314  else
1315    CheckInactive;
1316  FHandle := Value;
1317  FHandleIsShared := (Value <> nil);
1318end;
1319
1320procedure TIBDatabase.SetIdleTimer(Value: Integer);
1321begin
1322  if Value < 0 then
1323    IBError(ibxeTimeoutNegative, [nil])
1324  else
1325    if (Value = 0) then
1326      FreeAndNil(FTimer)
1327    else
1328      if (Value > 0) then
1329      begin
1330        if not Assigned(FTimer) then
1331        begin
1332          FTimer := TTimer.Create(Self);
1333          FTimer.Enabled := False;
1334          FTimer.Interval := 0;
1335          FTimer.OnTimer := TimeoutConnection;
1336        end;
1337        FTimer.Interval := Value;
1338        if not (csDesigning in ComponentState) then
1339          FTimer.Enabled := True;
1340      end;
1341end;
1342
1343function TIBDatabase.TestConnected: Boolean;
1344var
1345  DatabaseInfo: TIBDatabaseInfo;
1346begin
1347  result := Connected;
1348  if result then
1349  begin
1350    DatabaseInfo := TIBDatabaseInfo.Create(self);
1351    try
1352      DatabaseInfo.Database := self;
1353      { poke the server to see if connected }
1354      if DatabaseInfo.BaseLevel = 0 then ;
1355      DatabaseInfo.Free;
1356    except
1357      DatabaseInfo.Free;
1358      ForceClose;
1359      result := False;
1360    end;
1361  end;
1362end;
1363
1364procedure TIBDatabase.TimeoutConnection(Sender: TObject);
1365begin
1366  if Connected then
1367  begin
1368    if FCanTimeout then
1369    begin
1370      ForceClose;
1371      if Assigned(FOnIdleTimer) then
1372        FOnIdleTimer(Self);
1373    end
1374    else
1375      FCanTimeout := True;
1376  end;
1377end;
1378
1379function TIBDatabase.GetIsReadOnly: Boolean;
1380var
1381  DatabaseInfo: TIBDatabaseInfo;
1382begin
1383  DatabaseInfo := TIBDatabaseInfo.Create(self);
1384  DatabaseInfo.Database := self;
1385  if (DatabaseInfo.ODSMajorVersion < 10) then
1386    result := false
1387  else
1388  begin
1389    if (DatabaseInfo.ReadOnly = 0) then
1390      result := false
1391    else
1392      result := true;
1393  end;
1394  DatabaseInfo.Free;
1395end;
1396
1397function TIBDatabase.GetSQLDialect: Integer;
1398begin
1399  Result := FSQLDialect;
1400end;
1401
1402procedure TIBDatabase.SetSQLDialect(const Value: Integer);
1403begin
1404  if (Value < 1) then IBError(ibxeSQLDialectInvalid, [nil]);
1405  if ((FHandle = nil) or (Value <= FDBSQLDialect))  then
1406    FSQLDialect := Value
1407  else
1408    IBError(ibxeSQLDialectInvalid, [nil]);
1409end;
1410
1411function TIBDatabase.GetDBSQLDialect: Integer;
1412var
1413  DatabaseInfo: TIBDatabaseInfo;
1414begin
1415  DatabaseInfo := TIBDatabaseInfo.Create(self);
1416  DatabaseInfo.Database := self;
1417  result := DatabaseInfo.DBSQLDialect;
1418  DatabaseInfo.Free;
1419end;
1420
1421procedure TIBDatabase.ValidateClientSQLDialect;
1422begin
1423  if (FDBSQLDialect < FSQLDialect) then
1424  begin
1425    FSQLDialect := FDBSQLDialect;
1426    if Assigned (FOnDialectDowngradeWarning) then
1427      FOnDialectDowngradeWarning(self);
1428  end;
1429end;
1430
1431procedure TIBDatabase.ApplyUpdates(const DataSets: array of TDataSet);
1432var
1433  I: Integer;
1434  DS: TIBCustomDataSet;
1435  TR: TIBTransaction;
1436begin
1437  TR := nil;
1438  for I := 0 to High(DataSets) do
1439  begin
1440    DS := TIBCustomDataSet(DataSets[I]);
1441    if DS.Database <> Self then
1442      IBError(ibxeUpdateWrongDB, [nil]);
1443    if TR = nil then
1444      TR := DS.Transaction;
1445    if (DS.Transaction <> TR) or (TR = nil) then
1446      IBError(ibxeUpdateWrongTR, [nil]);
1447  end;
1448  TR.CheckInTransaction;
1449  for I := 0 to High(DataSets) do
1450  begin
1451    DS := TIBCustomDataSet(DataSets[I]);
1452    DS.ApplyUpdates;
1453  end;
1454  TR.CommitRetaining;
1455end;
1456
1457procedure TIBDatabase.CloseDataSets;
1458var
1459  i: Integer;
1460begin
1461  for i := 0 to DataSetCount - 1 do
1462    if (DataSets[i] <> nil) then
1463      DataSets[i].close;
1464end;
1465
1466procedure TIBDatabase.GetFieldNames(const TableName: string; List: TStrings);
1467var
1468  Query: TIBSQL;
1469  //!!!!
1470  //P: PString;
1471  //!!!!
1472  {$IFDEF GEDEMIN}
1473  I: Integer;
1474  R: TatRelation;
1475  {$ENDIF}
1476begin
1477  if TableName = '' then
1478    IBError(ibxeNoTableName, [nil]);
1479
1480  {$IFDEF GEDEMIN}
1481  if Assigned(atDatabase) then
1482  begin
1483    R := atDatabase.Relations.ByRelationName(TableName);
1484    if Assigned(R) then
1485    begin
1486      with List do
1487      begin
1488        BeginUpdate;
1489        try
1490          Clear;
1491          for I := 0 to R.RelationFields.Count - 1 do
1492            List.Add(R.RelationFields[I].FieldName);
1493        finally
1494          EndUpdate;
1495        end;
1496      end;
1497      exit;
1498    end;
1499  end;
1500  {$ENDIF}
1501
1502  if not Connected then
1503    Open;
1504
1505  if not FInternalTransaction.Active then
1506    FInternalTransaction.StartTransaction;
1507  Query := TIBSQL.Create(self);
1508  try
1509    Query.GoToFirstRecordOnExecute := False;
1510    Query.Database := Self;
1511    Query.Transaction := FInternalTransaction;
1512    Query.SQL.Text := 'Select R.RDB$FIELD_NAME ' + {do not localize}
1513      'from RDB$RELATION_FIELDS R, RDB$FIELDS F ' + {do not localize}
1514      'where R.RDB$RELATION_NAME = ' + {do not localize}
1515      '''' +
1516      FormatIdentifierValue(SQLDialect, TableName) +
1517      ''' ' +
1518      'and R.RDB$FIELD_SOURCE = F.RDB$FIELD_NAME ' + {do not localize}
1519      'ORDER BY R.RDB$FIELD_NAME'; {do not localize}
1520    Query.Prepare;
1521    Query.ExecQuery;
1522    with List do
1523    begin
1524      BeginUpdate;
1525      try
1526        Clear;
1527        while (not Query.EOF) and (Query.Next <> nil) do
1528          List.Add(TrimRight(Query.Current.ByName('RDB$FIELD_NAME').AsString)); {do not localize}
1529      finally
1530        EndUpdate;
1531      end;
1532    end;
1533  finally
1534    Query.free;
1535    FInternalTransaction.Commit;
1536  end;
1537end;
1538
1539procedure TIBDatabase.GetTableNames(List: TStrings; SystemTables: Boolean);
1540var
1541  Query : TIBSQL;
1542begin
1543  if not (csReading in ComponentState) then
1544  begin
1545    if not Connected then
1546      Open;
1547    if not FInternalTransaction.Active then
1548      FInternalTransaction.StartTransaction;
1549    Query := TIBSQL.Create(self);
1550    try
1551      Query.GoToFirstRecordOnExecute := False;
1552      Query.Database := Self;
1553      Query.Transaction := FInternalTransaction;
1554      if SystemTables then
1555        Query.SQL.Text := 'Select RDB$RELATION_NAME from RDB$RELATIONS ' + {do not localize}
1556                          ' where RDB$VIEW_BLR is NULL ' + {do not localize}
1557                          'ORDER BY RDB$RELATION_NAME' {do not localize}
1558      else
1559        Query.SQL.Text := 'Select RDB$RELATION_NAME from RDB$RELATIONS ' + {do not localize}
1560                          ' where RDB$VIEW_BLR is NULL and RDB$SYSTEM_FLAG = 0 ' + {do not localize}
1561                          'ORDER BY RDB$RELATION_NAME'; {do not localize}
1562      Query.Prepare;
1563      Query.ExecQuery;
1564      with List do
1565      begin
1566        BeginUpdate;
1567        try
1568          Clear;
1569          while (not Query.EOF) and (Query.Next <> nil) do
1570            List.Add(TrimRight(Query.Current[0].AsString));
1571        finally
1572          EndUpdate;
1573        end;
1574      end;
1575    finally
1576      Query.Free;
1577      FInternalTransaction.Commit;
1578    end;
1579  end;
1580end;
1581
1582procedure TIBDataBase.AddEventNotifier(Notifier: IIBEventNotifier);
1583begin
1584  FEventNotifiers.Add(Pointer(Notifier));
1585end;
1586
1587procedure TIBDataBase.RemoveEventNotifier(Notifier: IIBEventNotifier);
1588var
1589  Index : Integer;
1590begin
1591  Index := FEventNotifiers.IndexOf(Pointer(Notifier));
1592  if Index >= 0 then
1593    FEventNotifiers.Delete(Index);
1594end;
1595
1596//FireBird
1597
1598{???? ?????? FireBird ??? Yaffil, ?? ???????? ?? ?????? ??????}
1599function TIBDatabase.GetFBVersion: String;
1600var
1601  local_buffer: array[0..IBBigLocalBufferLength - 1] of Char;
1602  DBInfoCommand: Char;
1603begin
1604  CheckActive;
1605  DBInfoCommand := Char(frb_info_firebird_version);
1606  Call(isc_database_info(StatusVector, @FHandle, 1, @DBInfoCommand,
1607                        IBLocalBufferLength, local_buffer), True);
1608  if DBInfoCommand = local_buffer[0] then
1609  begin
1610     local_buffer[5 + Int(local_buffer[4])] := #0;
1611     Result := PChar(@local_buffer[5]);
1612  end else
1613    Result:= '';
1614end;
1615
1616function TIBDatabase.GetVersion: String;
1617var
1618  local_buffer: array[0..IBBigLocalBufferLength - 1] of Char;
1619  DBInfoCommand: Char;
1620begin
1621  DBInfoCommand := Char(isc_info_version);
1622
1623  Call(isc_database_info(StatusVector, @FHandle, 1, @DBInfoCommand,
1624                        IBBigLocalBufferLength, local_buffer), True);
1625  local_buffer[5 + Int(local_buffer[4])] := #0;
1626  Result := PChar(@local_buffer[5]);
1627end;
1628
1629procedure TIBDatabase.FillServerVersions;
1630var
1631  VersionStr: String;
1632  tmpstr: String;
1633  i: Integer;
1634  PVersion: PInteger;
1635begin
1636  CheckActive;
1637  if FServerMajorVersion = -1 then
1638  begin
1639    if IsFirebirdConnect then
1640      VersionStr := FBVersion
1641    else
1642      VersionStr := Version;
1643    tmpStr := '';
1644    i := 5;
1645    PVersion := @FServerMajorVersion;
1646    while i< Length(VersionStr) do
1647    begin
1648      if VersionStr[i] in ['0'..'9'] then
1649        tmpStr := tmpStr + VersionStr[i]
1650      else begin
1651        if Length(tmpStr) > 0 then
1652          PVersion^ := StrToInt(tmpStr)
1653        else
1654          PVersion^ := 0;
1655        tmpStr := '';
1656        if PVersion = @FServerMajorVersion then
1657          PVersion := @FServerMinorVersion
1658        else if PVersion = @FServerMinorVersion then
1659          PVersion := @FServerRelease
1660        else if PVersion = @FServerRelease then
1661          PVersion := @FServerBuild
1662      else
1663        Break;
1664      end;
1665      Inc(i);
1666    end;
1667  end;
1668end;
1669
1670function TIBDatabase.GetServerMajorVersion: integer;
1671begin
1672  FillServerVersions;
1673  Result := FServerMajorVersion;
1674end;
1675
1676function TIBDatab…

Large files files are truncated, but you can click here to view the full file