ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/IBDatabase.pas
(Generate patch)

Comparing ibx/trunk/runtime/IBDatabase.pas (file contents):
Revision 29 by tony, Sat May 9 11:37:49 2015 UTC vs.
Revision 45 by tony, Tue Dec 6 10:33:46 2016 UTC

# Line 1 | Line 1
1 < {************************************************************************}
2 < {                                                                        }
3 < {       Borland Delphi Visual Component Library                          }
4 < {       InterBase Express core components                                }
5 < {                                                                        }
6 < {       Copyright (c) 1998-2000 Inprise 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            }
16 < {    may obtain a copy of the License at http://www.Inprise.com/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 Inprise Corporation are Copyright (C) Inprise   }
24 < {       Corporation. All Rights Reserved.                                }
25 < {    Contributor(s): Jeff Overcash                                       }
26 < {                                                                        }
27 < {    IBX For Lazarus (Firebird Express)                                  }
28 < {    Contributor: Tony Whyman, MWA Software http://www.mwasoftware.co.uk }
29 < {    Portions created by MWA Software are copyright McCallum Whyman      }
30 < {    Associates Ltd 2011                                                 }
31 < {                                                                        }
32 < {************************************************************************}
33 <
34 < unit IBDatabase;
35 <
36 < {$Mode Delphi}
37 <
38 < interface
39 <
40 < uses
41 < {$IFDEF WINDOWS }
42 <  Windows,
43 < {$ELSE}
44 <  unix,
45 < {$ENDIF}
46 <  Dialogs, Controls, StdCtrls, SysUtils, Classes, Forms, ExtCtrls, IBHeader, IBExternals, DB,
47 <  IB, DBLoginDlg;
48 <
49 < const
50 <  DPBPrefix = 'isc_dpb_';
51 <  DPBConstantNames: array[1..isc_dpb_last_dpb_constant] of string = (
52 <    'cdd_pathname',
53 <    'allocation',
54 <    'journal',
55 <    'page_size',
56 <    'num_buffers',
57 <    'buffer_length',
58 <    'debug',
59 <    'garbage_collect',
60 <    'verify',
61 <    'sweep',
62 <    'enable_journal',
63 <    'disable_journal',
64 <    'dbkey_scope',
65 <    'number_of_users',
66 <    'trace',
67 <    'no_garbage_collect',
68 <    'damaged',
69 <    'license',
70 <    'sys_user_name',
71 <    'encrypt_key',
72 <    'activate_shadow',
73 <    'sweep_interval',
74 <    'delete_shadow',
75 <    'force_write',
76 <    'begin_log',
77 <    'quit_log',
78 <    'no_reserve',
79 <    'user_name',
80 <    'password',
81 <    'password_enc',
82 <    'sys_user_name_enc',
83 <    'interp',
84 <    'online_dump',
85 <    'old_file_size',
86 <    'old_num_files',
87 <    'old_file',
88 <    'old_start_page',
89 <    'old_start_seqno',
90 <    'old_start_file',
91 <    'drop_walfile',
92 <    'old_dump_id',
93 <    'wal_backup_dir',
94 <    'wal_chkptlen',
95 <    'wal_numbufs',
96 <    'wal_bufsize',
97 <    'wal_grp_cmt_wait',
98 <    'lc_messages',
99 <    'lc_ctype',
100 <    'cache_manager',
101 <    'shutdown',
102 <    'online',
103 <    'shutdown_delay',
104 <    'reserved',
105 <    'overwrite',
106 <    'sec_attach',
107 <    'disable_wal',
108 <    'connect_timeout',
109 <    'dummy_packet_interval',
110 <    'gbak_attach',
111 <    'sql_role_name',
112 <    'set_page_buffers',
113 <    'working_directory',
114 <    'sql_dialect',
115 <    'set_db_readonly',
116 <    'set_db_sql_dialect',
117 <    'gfix_attach',
118 <    'gstat_attach'
119 <  );
120 <
121 <  TPBPrefix = 'isc_tpb_';
122 <  TPBConstantNames: array[1..isc_tpb_last_tpb_constant] of string = (
123 <    'consistency',
124 <    'concurrency',
125 <    'shared',
126 <    'protected',
127 <    'exclusive',
128 <    'wait',
129 <    'nowait',
130 <    'read',
131 <    'write',
132 <    'lock_read',
133 <    'lock_write',
134 <    'verb_time',
135 <    'commit_time',
136 <    'ignore_limbo',
137 <    'read_committed',
138 <    'autocommit',
139 <    'rec_version',
140 <    'no_rec_version',
141 <    'restart_requests',
142 <    'no_auto_undo'
143 <  );
144 <
145 < type
146 <
147 <  TIBDatabase = class;
148 <  TIBTransaction = class;
149 <  TIBBase = class;
150 <
151 <  TIBDatabaseLoginEvent = procedure(Database: TIBDatabase;
152 <    LoginParams: TStrings) of object;
153 <
154 <  TIBFileName = type string;
155 <  { TIBDatabase }
156 <  TIBDataBase = class(TCustomConnection)
157 <  private
158 <    FAllowStreamedConnected: boolean;
159 <    FHiddenPassword: string;
160 <    FIBLoaded: Boolean;
161 <    FOnLogin: TIBDatabaseLoginEvent;
162 <    FSQLHourGlass: Boolean;
163 <    FTraceFlags: TTraceFlags;
164 <    FDBSQLDialect: Integer;
165 <    FSQLDialect: Integer;
166 <    FOnDialectDowngradeWarning: TNotifyEvent;
167 <    FCanTimeout: Boolean;
168 <    FSQLObjects: TList;
169 <    FTransactions: TList;
170 <    FDBName: TIBFileName;
171 <    FDBParams: TStrings;
172 <    FDBParamsChanged: Boolean;
173 <    FDPB: PChar;
174 <    FDPBLength: Short;
175 <    FHandle: TISC_DB_HANDLE;
176 <    FHandleIsShared: Boolean;
177 <    FOnIdleTimer: TNotifyEvent;
178 <    FDefaultTransaction: TIBTransaction;
179 <    FInternalTransaction: TIBTransaction;
180 <    FStreamedConnected: Boolean;
181 <    FTimer: TTimer;
182 <    FUserNames: TStringList;
183 <    FDataSets: TList;
184 <    FLoginCalled: boolean;
185 <    FCharSetSizes: array of integer;
186 <    procedure EnsureInactive;
187 <    function GetDBSQLDialect: Integer;
188 <    function GetSQLDialect: Integer;
189 <    procedure SetSQLDialect(const Value: Integer);
190 <    procedure ValidateClientSQLDialect;
191 <    procedure DBParamsChange(Sender: TObject);
192 <    procedure DBParamsChanging(Sender: TObject);
193 <    function GetSQLObject(Index: Integer): TIBBase;
194 <    function GetSQLObjectCount: Integer;
195 <    function GetDBParamByDPB(const Idx: Integer): String;
196 <    function GetIdleTimer: Integer;
197 <    function GetTransaction(Index: Integer): TIBTransaction;
198 <    function GetTransactionCount: Integer;
199 <    function Login: Boolean;
200 <    procedure LoadCharSetInfo;
201 <    procedure SetDatabaseName(const Value: TIBFileName);
202 <    procedure SetDBParamByDPB(const Idx: Integer; Value: String);
203 <    procedure SetDBParams(Value: TStrings);
204 <    procedure SetDefaultTransaction(Value: TIBTransaction);
205 <    procedure SetIdleTimer(Value: Integer);
206 <    procedure TimeoutConnection(Sender: TObject);
207 <    function GetIsReadOnly: Boolean;
208 <    function AddSQLObject(ds: TIBBase): Integer;
209 <    procedure RemoveSQLObject(Idx: Integer);
210 <    procedure RemoveSQLObjects;
211 <    procedure InternalClose(Force: Boolean);
212 <
213 <  protected
214 <    procedure DoConnect; override;
215 <    procedure DoDisconnect; override;
216 <    function GetConnected: Boolean; override;
217 <    procedure CheckStreamConnect;
218 <    procedure Notification( AComponent: TComponent; Operation: TOperation); override;
219 <    function GetDataset(Index : longint) : TDataset; override;
220 <    function GetDataSetCount : Longint; override;
221 <    procedure ReadState(Reader: TReader); override;
222 <    procedure SetConnected (Value : boolean); override;
223 <  public
224 <    constructor Create(AOwner: TComponent); override;
225 <    destructor Destroy; override;
226 <    procedure ApplyUpdates(const DataSets: array of TDataSet);
227 <    procedure CloseDataSets;
228 <    procedure CheckActive;
229 <    procedure CheckInactive;
230 <    procedure CreateDatabase;
231 <    procedure DropDatabase;
232 <    procedure ForceClose;
233 <    procedure GetFieldNames(const TableName: string; List: TStrings);
234 <    procedure GetTableNames(List: TStrings; SystemTables: Boolean = False);
235 <    function IndexOfDBConst(st: String): Integer;
236 <    function TestConnected: Boolean;
237 <    procedure CheckDatabaseName;
238 <    function Call(ErrCode: ISC_STATUS; RaiseError: Boolean): ISC_STATUS;
239 <    function AddTransaction(TR: TIBTransaction): Integer;
240 <    function FindTransaction(TR: TIBTransaction): Integer;
241 <    function FindDefaultTransaction(): TIBTransaction;
242 <    procedure RemoveTransaction(Idx: Integer);
243 <    procedure RemoveTransactions;
244 <    procedure SetHandle(Value: TISC_DB_HANDLE);
245 <
246 <    property Handle: TISC_DB_HANDLE read FHandle;
247 <    property IsReadOnly: Boolean read GetIsReadOnly;
248 <    property DBParamByDPB[const Idx: Integer]: String read GetDBParamByDPB
249 <                                                      write SetDBParamByDPB;
250 <    property SQLObjectCount: Integer read GetSQLObjectCount;
251 <    property SQLObjects[Index: Integer]: TIBBase read GetSQLObject;
252 <    property HandleIsShared: Boolean read FHandleIsShared;
253 <    property TransactionCount: Integer read GetTransactionCount;
254 <    property Transactions[Index: Integer]: TIBTransaction read GetTransaction;
255 <    property InternalTransaction: TIBTransaction read FInternalTransaction;
256 <
257 <  published
258 <    property Connected;
259 <    property AllowStreamedConnected: boolean read FAllowStreamedConnected
260 <             write FAllowStreamedConnected;
261 <    property DatabaseName: TIBFileName read FDBName write SetDatabaseName;
262 <    property Params: TStrings read FDBParams write SetDBParams;
263 <    property LoginPrompt default True;
264 <    property DefaultTransaction: TIBTransaction read FDefaultTransaction
265 <                                                 write SetDefaultTransaction;
266 <    property IdleTimer: Integer read GetIdleTimer write SetIdleTimer;
267 <    property SQLDialect : Integer read GetSQLDialect write SetSQLDialect default 3;
268 <    property SQLHourGlass: Boolean read FSQLHourGlass write FSQLHourGlass default true;
269 <    property DBSQLDialect : Integer read FDBSQLDialect;
270 <    property TraceFlags: TTraceFlags read FTraceFlags write FTraceFlags;
271 <    property AfterConnect;
272 <    property AfterDisconnect;
273 <    property BeforeConnect;
274 <    property BeforeDisconnect;
275 <    property OnLogin: TIBDatabaseLoginEvent read FOnLogin write FOnLogin;
276 <    property OnIdleTimer: TNotifyEvent read FOnIdleTimer write FOnIdleTimer;
277 <    property OnDialectDowngradeWarning: TNotifyEvent read FOnDialectDowngradeWarning write FOnDialectDowngradeWarning;
278 <  end;
279 <
280 <  { TIBTransaction }
281 <
282 <  TTransactionAction         = (TARollback, TACommit, TARollbackRetaining, TACommitRetaining);
283 <
284 <  TIBTransaction = class(TComponent)
285 <  private
286 <    FAfterDelete: TNotifyEvent;
287 <    FAfterEdit: TNotifyEvent;
288 <    FAfterExecQuery: TNotifyEvent;
289 <    FAfterInsert: TNotifyEvent;
290 <    FAfterPost: TNotifyEvent;
291 <    FAfterTransactionEnd: TNotifyEvent;
292 <    FBeforeTransactionEnd: TNotifyEvent;
293 <    FIBLoaded: Boolean;
294 <    FCanTimeout         : Boolean;
295 <    FDatabases          : TList;
296 <    FOnStartTransaction: TNotifyEvent;
297 <    FSQLObjects         : TList;
298 <    FDefaultDatabase    : TIBDatabase;
299 <    FHandle             : TISC_TR_HANDLE;
300 <    FHandleIsShared     : Boolean;
301 <    FOnIdleTimer          : TNotifyEvent;
302 <    FStreamedActive     : Boolean;
303 <    FTPB                : PChar;
304 <    FTPBLength          : Short;
305 <    FTimer              : TTimer;
306 <    FDefaultAction      : TTransactionAction;
307 <    FTRParams           : TStrings;
308 <    FTRParamsChanged    : Boolean;
309 <    FInEndTransaction   : boolean;
310 <    FEndAction          : TTransactionAction;
311 <    procedure DoBeforeTransactionEnd;
312 <    procedure DoAfterTransactionEnd;
313 <    procedure DoOnStartTransaction;
314 <    procedure DoAfterExecQuery(Sender: TObject);
315 <    procedure DoAfterEdit(Sender: TObject);
316 <    procedure DoAfterDelete(Sender: TObject);
317 <    procedure DoAfterInsert(Sender: TObject);
318 <    procedure DoAfterPost(Sender: TObject);
319 <    procedure EnsureNotInTransaction;
320 <    procedure EndTransaction(Action: TTransactionAction; Force: Boolean);
321 <    function GetDatabase(Index: Integer): TIBDatabase;
322 <    function GetDatabaseCount: Integer;
323 <    function GetSQLObject(Index: Integer): TIBBase;
324 <    function GetSQLObjectCount: Integer;
325 <    function GetInTransaction: Boolean;
326 <    function GetIdleTimer: Integer;
327 <    procedure BeforeDatabaseDisconnect(DB: TIBDatabase);
328 <    procedure SetActive(Value: Boolean);
329 <    procedure SetDefaultAction(Value: TTransactionAction);
330 <    procedure SetDefaultDatabase(Value: TIBDatabase);
331 <    procedure SetIdleTimer(Value: Integer);
332 <    procedure SetTRParams(Value: TStrings);
333 <    procedure TimeoutTransaction(Sender: TObject);
334 <    procedure TRParamsChange(Sender: TObject);
335 <    procedure TRParamsChanging(Sender: TObject);
336 <    function AddSQLObject(ds: TIBBase): Integer;
337 <    procedure RemoveSQLObject(Idx: Integer);
338 <    procedure RemoveSQLObjects;
339 <
340 <  protected
341 <    procedure Loaded; override;
342 <    procedure SetHandle(Value: TISC_TR_HANDLE);
343 <    procedure Notification( AComponent: TComponent; Operation: TOperation); override;
344 <
345 <  public
346 <    constructor Create(AOwner: TComponent); override;
347 <    destructor Destroy; override;
348 <    function Call(ErrCode: ISC_STATUS; RaiseError: Boolean): ISC_STATUS;
349 <    procedure Commit;
350 <    procedure CommitRetaining;
351 <    procedure Rollback;
352 <    procedure RollbackRetaining;
353 <    procedure StartTransaction;
354 <    procedure CheckInTransaction;
355 <    procedure CheckNotInTransaction;
356 <
357 <    function AddDatabase(db: TIBDatabase): Integer;
358 <    function FindDatabase(db: TIBDatabase): Integer;
359 <    function FindDefaultDatabase: TIBDatabase;
360 <    function GetEndAction: TTransactionAction;
361 <    procedure RemoveDatabase(Idx: Integer);
362 <    procedure RemoveDatabases;
363 <    procedure CheckDatabasesInList;
364 <
365 <    property DatabaseCount: Integer read GetDatabaseCount;
366 <    property Databases[Index: Integer]: TIBDatabase read GetDatabase;
367 <    property SQLObjectCount: Integer read GetSQLObjectCount;
368 <    property SQLObjects[Index: Integer]: TIBBase read GetSQLObject;
369 <    property Handle: TISC_TR_HANDLE read FHandle;
370 <    property HandleIsShared: Boolean read FHandleIsShared;
371 <    property InTransaction: Boolean read GetInTransaction;
372 <    property TPB: PChar read FTPB;
373 <    property TPBLength: Short read FTPBLength;
374 <  published
375 <    property Active: Boolean read GetInTransaction write SetActive;
376 <    property DefaultDatabase: TIBDatabase read FDefaultDatabase
377 <                                           write SetDefaultDatabase;
378 <    property IdleTimer: Integer read GetIdleTimer write SetIdleTimer default 0;
379 <    property DefaultAction: TTransactionAction read FDefaultAction write SetDefaultAction default taCommit;
380 <    property Params: TStrings read FTRParams write SetTRParams;
381 <    property OnIdleTimer: TNotifyEvent read FOnIdleTimer write FOnIdleTimer;
382 <    property BeforeTransactionEnd: TNotifyEvent read FBeforeTransactionEnd
383 <                                             write FBeforeTransactionEnd;
384 <    property AfterTransactionEnd: TNotifyEvent read FAfterTransactionEnd
385 <                                            write FAfterTransactionEnd;
386 <    property OnStartTransaction: TNotifyEvent read FOnStartTransaction
387 <                                              write FOnStartTransaction;
388 <    property AfterExecQuery: TNotifyEvent read FAfterExecQuery
389 <                                              write FAfterExecQuery;
390 <    property AfterEdit: TNotifyEvent read FAfterEdit write FAfterEdit;
391 <    property AfterDelete: TNotifyEvent read FAfterDelete write FAfterDelete;
392 <    property AfterInsert: TNotifyEvent read FAfterInsert write FAfterInsert;
393 <    property AfterPost: TNotifyEvent read FAfterPost write FAfterPost;
394 <  end;
395 <
396 <  TTransactionEndEvent = procedure(Sender:TObject; Action: TTransactionAction) of object;
397 <  TBeforeDatabaseConnectEvent = procedure (Sender: TObject; DBParams: TStrings;
398 <                              var DBName: string) of object;
399 <
400 <  { TIBBase }
401 <
402 <  { Virtually all components in IB are "descendents" of TIBBase.
403 <    It is to more easily manage the database and transaction
404 <    connections. }
405 <  TIBBase = class(TObject)
406 <  protected
407 <    FBeforeDatabaseConnect: TBeforeDatabaseConnectEvent;
408 <    FDatabase: TIBDatabase;
409 <    FIndexInDatabase: Integer;
410 <    FTransaction: TIBTransaction;
411 <    FIndexInTransaction: Integer;
412 <    FOwner: TObject;
413 <    FBeforeDatabaseDisconnect: TNotifyEvent;
414 <    FAfterDatabaseDisconnect: TNotifyEvent;
415 <    FAfterDatabaseConnect: TNotifyEvent;
416 <    FOnDatabaseFree: TNotifyEvent;
417 <    FBeforeTransactionEnd: TTransactionEndEvent;
418 <    FAfterTransactionEnd: TNotifyEvent;
419 <    FOnTransactionFree: TNotifyEvent;
420 <
421 <    procedure DoBeforeDatabaseConnect(DBParams: TStrings;
422 <                              var DBName: string); virtual;
423 <    procedure DoAfterDatabaseConnect; virtual;
424 <    procedure DoBeforeDatabaseDisconnect; virtual;
425 <    procedure DoAfterDatabaseDisconnect; virtual;
426 <    procedure DoDatabaseFree; virtual;
427 <    procedure DoBeforeTransactionEnd(Action: TTransactionAction); virtual;
428 <    procedure DoAfterTransactionEnd; virtual;
429 <    procedure DoTransactionFree; virtual;
430 <    function GetDBHandle: PISC_DB_HANDLE; virtual;
431 <    function GetTRHandle: PISC_TR_HANDLE; virtual;
432 <    procedure SetDatabase(Value: TIBDatabase); virtual;
433 <    procedure SetTransaction(Value: TIBTransaction); virtual;
434 <  public
435 <    constructor Create(AOwner: TObject);
436 <    destructor Destroy; override;
437 <    procedure CheckDatabase; virtual;
438 <    procedure CheckTransaction; virtual;
439 <    procedure DoAfterExecQuery(Sender: TObject); virtual;
440 <    procedure DoAfterEdit(Sender: TObject); virtual;
441 <    procedure DoAfterDelete(Sender: TObject); virtual;
442 <    procedure DoAfterInsert(Sender: TObject); virtual;
443 <    procedure DoAfterPost(Sender: TObject); virtual;
444 <    function GetCharSetSize(CharSetID: integer): integer;
445 <  public
446 <    property BeforeDatabaseConnect: TBeforeDatabaseConnectEvent read FBeforeDatabaseConnect
447 <                                                 write FBeforeDatabaseConnect;
448 <    property AfterDatabaseConnect: TNotifyEvent read FAfterDatabaseConnect
449 <                                                write FAfterDatabaseConnect;
450 <    property BeforeDatabaseDisconnect: TNotifyEvent read FBeforeDatabaseDisconnect
451 <                                                   write FBeforeDatabaseDisconnect;
452 <    property AfterDatabaseDisconnect: TNotifyEvent read FAfterDatabaseDisconnect
453 <                                                  write FAfterDatabaseDisconnect;
454 <    property OnDatabaseFree: TNotifyEvent read FOnDatabaseFree write FOnDatabaseFree;
455 <    property BeforeTransactionEnd: TTransactionEndEvent read FBeforeTransactionEnd write FBeforeTransactionEnd;
456 <    property AfterTransactionEnd: TNotifyEvent read FAfterTransactionEnd write FAfterTransactionEnd;
457 <    property OnTransactionFree: TNotifyEvent read FOnTransactionFree write FOnTransactionFree;
458 <    property Database: TIBDatabase read FDatabase
459 <                                    write SetDatabase;
460 <    property DBHandle: PISC_DB_HANDLE read GetDBHandle;
461 <    property Owner: TObject read FOwner;
462 <    property TRHandle: PISC_TR_HANDLE read GetTRHandle;
463 <    property Transaction: TIBTransaction read FTransaction
464 <                                          write SetTransaction;
465 <  end;
466 <
467 < procedure GenerateDPB(sl: TStrings; var DPB: string; var DPBLength: Short);
468 < procedure GenerateTPB(sl: TStrings; var TPB: string; var TPBLength: Short);
469 <
470 <
471 < implementation
472 <
473 < uses IBIntf, IBSQLMonitor, IBCustomDataSet, IBDatabaseInfo, IBSQL, IBUtils,
474 <     typInfo;
475 <
476 < { TIBDatabase }
477 <
478 < constructor TIBDataBase.Create(AOwner: TComponent);
479 < {$ifdef WINDOWS}
480 < var acp: uint;
481 < {$endif}
482 < begin
483 <  inherited Create(AOwner);
484 <  FIBLoaded := False;
485 <  CheckIBLoaded;
486 <  FIBLoaded := True;
487 <  LoginPrompt := True;
488 <  FSQLObjects := TList.Create;
489 <  FTransactions := TList.Create;
490 <  FDBName := '';
491 <  FDBParams := TStringList.Create;
492 <  FSQLHourGlass := true;
493 <  {$ifdef UNIX}
494 <  if csDesigning in ComponentState then
495 <    FDBParams.Add('lc_ctype=UTF-8');
496 <  {$else}
497 <  {$ifdef WINDOWS}
498 <  if csDesigning in ComponentState then
499 <  begin
500 <    acp := GetACP;
501 <    if (acp >= 1250) and (acp <= 1254) then
502 <      FDBParams.Values['lc_ctype'] := Format('WIN%d',[acp]);
503 <  end;
504 <  {$endif}
505 <  {$endif}
506 <  FDBParamsChanged := True;
507 <  TStringList(FDBParams).OnChange := DBParamsChange;
508 <  TStringList(FDBParams).OnChanging := DBParamsChanging;
509 <  FDPB := nil;
510 <  FHandle := nil;
511 <  FUserNames := nil;
512 <  FInternalTransaction := TIBTransaction.Create(self);
513 <  FInternalTransaction.DefaultDatabase := Self;
514 <  FTimer := TTimer.Create(Self);
515 <  FTimer.Enabled := False;
516 <  FTimer.Interval := 0;
517 <  FTimer.OnTimer := TimeoutConnection;
518 <  FDBSQLDialect := 1;
519 <  FSQLDialect := 3;
520 <  FTraceFlags := [];
521 <  FDataSets := TList.Create;
522 <  CheckStreamConnect;
523 < end;
524 <
525 < destructor TIBDataBase.Destroy;
526 < var
527 <  i: Integer;
528 < begin
529 <  if FIBLoaded then
530 <  begin
531 <    IdleTimer := 0;
532 <    if FHandle <> nil then
533 <      ForceClose;
534 <    for i := 0 to FSQLObjects.Count - 1 do
535 <      if FSQLObjects[i] <> nil then
536 <        SQLObjects[i].DoDatabaseFree;
537 <    RemoveSQLObjects;
538 <    RemoveTransactions;
539 <    FInternalTransaction.Free;
540 <    FreeMem(FDPB);
541 <    FDPB := nil;
542 <    FDBParams.Free;
543 <    FSQLObjects.Free;
544 <    FUserNames.Free;
545 <    FTransactions.Free;
546 <  end;
547 <  FDataSets.Free;
548 <  inherited Destroy;
549 < end;
550 <
551 < function TIBDataBase.Call(ErrCode: ISC_STATUS; RaiseError: Boolean
552 <   ): ISC_STATUS;
553 < begin
554 <  result := ErrCode;
555 <  FCanTimeout := False;
556 <  if RaiseError and (ErrCode > 0) then
557 <    IBDataBaseError;
558 < end;
559 <
560 < procedure TIBDataBase.CheckActive;
561 < begin
562 <  if StreamedConnected and (not Connected) then
563 <    Loaded;
564 <  if FHandle = nil then
565 <    IBError(ibxeDatabaseClosed, [nil]);
566 < end;
567 <
568 < procedure TIBDataBase.EnsureInactive;
569 < begin
570 <  if csDesigning in ComponentState then
571 <  begin
572 <    if FHandle <> nil then
573 <      Close;
574 <  end
575 < end;
576 <
577 < procedure TIBDataBase.CheckInactive;
578 < begin
579 <  if FHandle <> nil then
580 <    IBError(ibxeDatabaseOpen, [nil]);
581 < end;
582 <
583 < procedure TIBDataBase.CheckDatabaseName;
584 < begin
585 <  if (FDBName = '') then
586 <    IBError(ibxeDatabaseNameMissing, [nil]);
587 < end;
588 <
589 < function TIBDataBase.AddSQLObject(ds: TIBBase): Integer;
590 < begin
591 <  result := 0;
592 <  if (ds.Owner is TIBCustomDataSet) then
593 <    FDataSets.Add(ds.Owner);
594 <  while (result < FSQLObjects.Count) and (FSQLObjects[result] <> nil) do
595 <    Inc(result);
596 <  if (result = FSQLObjects.Count) then
597 <    FSQLObjects.Add(ds)
598 <  else
599 <    FSQLObjects[result] := ds;
600 < end;
601 <
602 < function TIBDataBase.AddTransaction(TR: TIBTransaction): Integer;
603 < begin
604 <  result := FindTransaction(TR);
605 <  if result <> -1 then
606 <  begin
607 <    result := -1;
608 <    exit;
609 <  end;
610 <  result := 0;
611 <  while (result < FTransactions.Count) and (FTransactions[result] <> nil) do
612 <    Inc(result);
613 <  if (result = FTransactions.Count) then
614 <    FTransactions.Add(TR)
615 <  else
616 <    FTransactions[result] := TR;
617 < end;
618 <
619 < procedure TIBDataBase.DoDisconnect;
620 < begin
621 <  if Connected then
622 <    InternalClose(False);
623 <  FDBSQLDialect := 1;
624 <  SetLength(FCharSetSizes,0);
625 < end;
626 <
627 < procedure TIBDataBase.CreateDatabase;
628 < var
629 <  tr_handle: TISC_TR_HANDLE;
630 < begin
631 <  CheckInactive;
632 <  tr_handle := nil;
633 <  Call(
634 <    isc_dsql_execute_immediate(StatusVector, @FHandle, @tr_handle, 0,
635 <                               PChar('CREATE DATABASE ''' + FDBName + ''' ' + {do not localize}
636 <                               Params.Text), SQLDialect, nil),
637 <    True);
638 < end;
639 <
640 < procedure TIBDataBase.DropDatabase;
641 < begin
642 <  CheckActive;
643 <  Call(isc_drop_database(StatusVector, @FHandle), True);
644 < end;
645 <
646 < procedure TIBDataBase.DBParamsChange(Sender: TObject);
647 < begin
648 <  FDBParamsChanged := True;
649 < end;
650 <
651 < procedure TIBDataBase.DBParamsChanging(Sender: TObject);
652 < begin
653 <  EnsureInactive;
654 <  CheckInactive;
655 < end;
656 <
657 < function TIBDataBase.FindTransaction(TR: TIBTransaction): Integer;
658 < var
659 <  i: Integer;
660 < begin
661 <  result := -1;
662 <  for i := 0 to FTransactions.Count - 1 do
663 <    if TR = Transactions[i] then
664 <    begin
665 <      result := i;
666 <      break;
667 <    end;
668 < end;
669 <
670 < function TIBDataBase.FindDefaultTransaction: TIBTransaction;
671 < var
672 <  i: Integer;
673 < begin
674 <  result := FDefaultTransaction;
675 <  if result = nil then
676 <  begin
677 <    for i := 0 to FTransactions.Count - 1 do
678 <      if (Transactions[i] <> nil) and
679 <        (TIBTransaction(Transactions[i]).DefaultDatabase = self) and
680 <        (TIBTransaction(Transactions[i]) <> FInternalTransaction) then
681 <       begin
682 <         result := TIBTransaction(Transactions[i]);
683 <         break;
684 <       end;
685 <  end;
686 < end;
687 <
688 < procedure TIBDataBase.ForceClose;
689 < begin
690 <  if Connected then
691 <    InternalClose(True);
692 < end;
693 <
694 < function TIBDataBase.GetConnected: Boolean;
695 < begin
696 <  result := FHandle <> nil;
697 < end;
698 <
699 < function TIBDataBase.GetSQLObject(Index: Integer): TIBBase;
700 < begin
701 <  result := FSQLObjects[Index];
702 < end;
703 <
704 < function TIBDataBase.GetSQLObjectCount: Integer;
705 < var
706 <  i: Integer;
707 < begin
708 <  result := 0;
709 <  for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then
710 <    Inc(result);
711 < end;
712 <
713 < function TIBDataBase.GetDBParamByDPB( const Idx: Integer): String;
714 < var
715 <  ConstIdx, EqualsIdx: Integer;
716 < begin
717 <  if (Idx > 0) and (Idx <= isc_dpb_last_dpb_constant) then
718 <  begin
719 <    ConstIdx := IndexOfDBConst(DPBConstantNames[Idx]);
720 <    if ConstIdx = -1 then
721 <      result := ''
722 <    else
723 <    begin
724 <      result := Params[ConstIdx];
725 <      EqualsIdx := Pos('=', result); {mbcs ok}
726 <      if EqualsIdx = 0 then
727 <        result := ''
728 <      else
729 <        result := Copy(result, EqualsIdx + 1, Length(result));
730 <    end;
731 <  end
732 <  else
733 <    result := '';
734 < end;
735 <
736 < function TIBDataBase.GetIdleTimer: Integer;
737 < begin
738 <  result := FTimer.Interval;
739 < end;
740 <
741 < function TIBDataBase.GetTransaction(Index: Integer): TIBTransaction;
742 < begin
743 <  result := FTransactions[Index];
744 < end;
745 <
746 < function TIBDataBase.GetTransactionCount: Integer;
747 < var
748 <  i: Integer;
749 < begin
750 <  result := 0;
751 <  for i := 0 to FTransactions.Count - 1 do
752 <    if FTransactions[i] <> nil then
753 <      Inc(result);
754 < end;
755 <
756 < function TIBDataBase.IndexOfDBConst(st: String): Integer;
757 < var
758 <  i, pos_of_str: Integer;
759 < begin
760 <  result := -1;
761 <  for i := 0 to Params.Count - 1 do
762 <  begin
763 <    pos_of_str := Pos(st, AnsiLowerCase(Params[i])); {mbcs ok}
764 <    if (pos_of_str = 1) or (pos_of_str = Length(DPBPrefix) + 1) then
765 <    begin
766 <      result := i;
767 <      break;
768 <    end;
769 <  end;
770 < end;
771 <
772 < procedure TIBDataBase.InternalClose(Force: Boolean);
773 < var
774 <  i: Integer;
775 < begin
776 <  CheckActive;
777 <  { Tell all connected transactions that we're disconnecting.
778 <    This is so transactions can commit/rollback, accordingly
779 <  }
780 <  for i := 0 to FTransactions.Count - 1 do
781 <  begin
782 <    try
783 <      if FTransactions[i] <> nil then
784 <        Transactions[i].BeforeDatabaseDisconnect(Self);
785 <    except
786 <      if not Force then
787 <        raise;
788 <    end;
789 <  end;
790 <  for i := 0 to FSQLObjects.Count - 1 do
791 <  begin
792 <    try
793 <      if FSQLObjects[i] <> nil then
794 <        SQLObjects[i].DoBeforeDatabaseDisconnect;
795 <    except
796 <      if not Force then
797 <        raise;
798 <    end;
799 <  end;
800 <
801 <  if (not HandleIsShared) and
802 <     (Call(isc_detach_database(StatusVector, @FHandle), False) > 0) and
803 <     (not Force) then
804 <    IBDataBaseError
805 <  else
806 <  begin
807 <    FHandle := nil;
808 <    FHandleIsShared := False;
809 <  end;
810 <
811 <  if not (csDesigning in ComponentState) then
812 <    MonitorHook.DBDisconnect(Self);
813 <
814 <  for i := 0 to FSQLObjects.Count - 1 do
815 <    if FSQLObjects[i] <> nil then
816 <      SQLObjects[i].DoAfterDatabaseDisconnect;
817 < end;
818 <
819 < procedure TIBDataBase.LoadCharSetInfo;
820 < var Query: TIBSQL;
821 <    i: integer;
822 < begin
823 <  if not FInternalTransaction.Active then
824 <    FInternalTransaction.StartTransaction;
825 <  Query := TIBSQL.Create(self);
826 <  try
827 <    Query.Database := Self;
828 <    Query.Transaction := FInternalTransaction;
829 <    Query.SQL.Text := 'Select RDB$CHARACTER_SET_ID, RDB$BYTES_PER_CHARACTER ' +
830 <                      'From RDB$CHARACTER_SETS Order by 1 DESC'; {do not localize}
831 <    Query.Prepare;
832 <    Query.ExecQuery;
833 <    if not Query.EOF then
834 <    begin
835 <      SetLength(FCharSetSizes,Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger + 1);
836 <      for i := 0 to Length(FCharSetSizes) - 1 do FCharSetSizes[i] := 1;
837 <      repeat
838 <        FCharSetSizes[Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger] :=
839 <                 Query.FieldByName('RDB$BYTES_PER_CHARACTER').AsInteger;
840 <        Query.Next;
841 <      until Query.EOF;
842 <    end;
843 <  finally
844 <    Query.free;
845 <    FInternalTransaction.Commit;
846 <  end;
847 < end;
848 <
849 < procedure TIBDataBase.CheckStreamConnect;
850 < var
851 <  i: integer;
852 < begin
853 <  try
854 <    if not (csDesigning in ComponentState) and StreamedConnected and (not Connected) then
855 <    begin
856 <      for i := 0 to FTransactions.Count - 1 do
857 <        if  FTransactions[i] <> nil then
858 <        begin
859 <          with TIBTransaction(FTransactions[i]) do
860 <            if not Active then
861 <              if FStreamedActive and not InTransaction then
862 <              begin
863 <                StartTransaction;
864 <                FStreamedActive := False;
865 <              end;
866 <        end;
867 <      if (FDefaultTransaction <> nil) and
868 <         (FDefaultTransaction.FStreamedActive) and
869 <         (not FDefaultTransaction.InTransaction) then
870 <        FDefaultTransaction.StartTransaction;
871 <      FStreamedConnected := False;
872 <    end;
873 <  except
874 <    if csDesigning in ComponentState then
875 <      Application.HandleException(Self)
876 <    else
877 <      raise;
878 <  end;
879 < end;
880 <
881 < procedure TIBDataBase.Notification(AComponent: TComponent;
882 <   Operation: TOperation);
883 < var
884 <  i: Integer;
885 < begin
886 <  inherited Notification( AComponent, Operation);
887 <  if (Operation = opRemove) and (AComponent = FDefaultTransaction) then
888 <  begin
889 <    i := FindTransaction(FDefaultTransaction);
890 <    if (i <> -1) then
891 <      RemoveTransaction(i);
892 <    FDefaultTransaction := nil;
893 <  end;
894 < end;
895 <
896 < function TIBDataBase.Login: Boolean;
897 < var
898 <  IndexOfUser, IndexOfPassword: Integer;
899 <  Username, Password, OldPassword: String;
900 <  LoginParams: TStrings;
901 <
902 <  procedure HidePassword;
903 <  var
904 <    I: Integer;
905 <    IndexAt: Integer;
906 <  begin
907 <    IndexAt := 0;
908 <    for I := 0 to Params.Count -1 do
909 <      if Pos('password', LowerCase(Trim(Params.Names[i]))) = 1 then {mbcs ok}
910 <      begin
911 <        FHiddenPassword := Params.Values[Params.Names[i]];
912 <        IndexAt := I;
913 <        break;
914 <      end;
915 <    if IndexAt <> 0 then
916 <      Params.Delete(IndexAt);
917 <  end;
918 <
919 < begin
920 <  Result := false;
921 <  if FLoginCalled then Exit;
922 <  FLoginCalled := true;
923 <  try
924 <  if Assigned(FOnLogin) and not (csDesigning in ComponentState) then
925 <  begin
926 <    result := True;
927 <    LoginParams := TStringList.Create;
928 <    try
929 <      LoginParams.Assign(Params);
930 <      FOnLogin(Self, LoginParams);
931 <      Params.Assign (LoginParams);
932 <      HidePassword;
933 <    finally
934 <      LoginParams.Free;
935 <    end;
936 <  end
937 <  else
938 <  begin
939 <    IndexOfUser := IndexOfDBConst(DPBConstantNames[isc_dpb_user_name]);
940 <    if IndexOfUser <> -1 then
941 <      Username := Copy(Params[IndexOfUser],
942 <                                         Pos('=', Params[IndexOfUser]) + 1, {mbcs ok}
943 <                                         Length(Params[IndexOfUser]));
944 <    IndexOfPassword := IndexOfDBConst(DPBConstantNames[isc_dpb_password]);
945 <    if IndexOfPassword <> -1 then
946 <    begin
947 <      Password := Copy(Params[IndexOfPassword],
948 <                                         Pos('=', Params[IndexOfPassword]) + 1, {mbcs ok}
949 <                                         Length(Params[IndexOfPassword]));
950 <      OldPassword := password;
951 <    end;
952 <    result := LoginDialogEx(DatabaseName, Username, Password, False);
953 <    if result then
954 <    begin
955 <      if IndexOfUser = -1 then
956 <        Params.Add(DPBConstantNames[isc_dpb_user_name] + '=' + Username)
957 <      else
958 <        Params[IndexOfUser] := DPBConstantNames[isc_dpb_user_name] +
959 <                                 '=' + Username;
960 <      if (Password = OldPassword) then
961 <        FHiddenPassword := ''
962 <      else
963 <      begin
964 <        FHiddenPassword := Password;
965 <        if OldPassword <> '' then
966 <          HidePassword;
967 <      end;
968 <    end;
969 <  end;
970 <  finally
971 <    FLoginCalled := false
972 <  end;
973 < end;
974 <
975 < procedure TIBDataBase.DoConnect;
976 < var
977 <  DPB: String;
978 <  TempDBParams: TStrings;
979 <  I: integer;
980 <  aDBName: string;
981 < begin
982 <  CheckInactive;
983 <  CheckDatabaseName;
984 <  if (not LoginPrompt) and (FHiddenPassword <> '') then
985 <  begin
986 <    FHiddenPassword := '';
987 <    FDBParamsChanged := True;
988 <  end;
989 <  { Use builtin login prompt if requested }
990 <  if (LoginPrompt or (csDesigning in ComponentState)) and not Login then
991 <    IBError(ibxeOperationCancelled, [nil]);
992 <
993 <  TempDBParams := TStringList.Create;
994 <  try
995 <   TempDBParams.Assign(FDBParams);
996 <   aDBName := FDBName;
997 <   {Opportuning to override defaults}
998 <   for i := 0 to FSQLObjects.Count - 1 do
999 <   begin
1000 <       if FSQLObjects[i] <> nil then
1001 <         SQLObjects[i].DoBeforeDatabaseConnect(TempDBParams,aDBName);
1002 <   end;
1003 <
1004 <   { Generate a new DPB if necessary }
1005 <   if (FDBParamsChanged or (TempDBParams.Text <> FDBParams.Text)) then
1006 <   begin
1007 <     FDBParamsChanged := False;
1008 <     if (not LoginPrompt and not (csDesigning in ComponentState)) or (FHiddenPassword = '') then
1009 <       GenerateDPB(TempDBParams, DPB, FDPBLength)
1010 <     else
1011 <     begin
1012 <        TempDBParams.Add('password=' + FHiddenPassword);
1013 <        GenerateDPB(TempDBParams, DPB, FDPBLength);
1014 <     end;
1015 <     IBAlloc(FDPB, 0, FDPBLength);
1016 <     Move(DPB[1], FDPB[0], FDPBLength);
1017 <   end;
1018 <  finally
1019 <   TempDBParams.Free;
1020 <  end;
1021 <  if Call(isc_attach_database(StatusVector, Length(aDBName),
1022 <                         PChar(aDBName), @FHandle,
1023 <                         FDPBLength, FDPB), False) > 0 then
1024 <  begin
1025 <    FHandle := nil;
1026 <    IBDataBaseError;
1027 <  end;
1028 <  if not (csDesigning in ComponentState) then
1029 <    FDBName := aDBName; {Synchronise at run time}
1030 <  FDBSQLDialect := GetDBSQLDialect;
1031 <  ValidateClientSQLDialect;
1032 <  for i := 0 to FSQLObjects.Count - 1 do
1033 <  begin
1034 <      if FSQLObjects[i] <> nil then
1035 <        SQLObjects[i].DoAfterDatabaseConnect;
1036 <  end;
1037 <  if not (csDesigning in ComponentState) then
1038 <    MonitorHook.DBConnect(Self);
1039 <  LoadCharSetInfo;
1040 < end;
1041 <
1042 < procedure TIBDataBase.RemoveSQLObject(Idx: Integer);
1043 < var
1044 <  ds: TIBBase;
1045 < begin
1046 <  if (Idx >= 0) and (FSQLObjects[Idx] <> nil) then
1047 <  begin
1048 <    ds := SQLObjects[Idx];
1049 <    FSQLObjects[Idx] := nil;
1050 <    ds.Database := nil;
1051 <    if (ds.owner is TDataSet) then
1052 <      FDataSets.Remove(TDataSet(ds.Owner));
1053 <  end;
1054 < end;
1055 <
1056 < procedure TIBDataBase.RemoveSQLObjects;
1057 < var
1058 <  i: Integer;
1059 < begin
1060 <  for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then
1061 <  begin
1062 <    RemoveSQLObject(i);
1063 <    if (TIBBase(FSQLObjects[i]).owner is TDataSet) then
1064 <      FDataSets.Remove(TDataSet(TIBBase(FSQLObjects[i]).owner));
1065 <  end;
1066 < end;
1067 <
1068 < procedure TIBDataBase.RemoveTransaction(Idx: Integer);
1069 < var
1070 <  TR: TIBTransaction;
1071 < begin
1072 <  if ((Idx >= 0) and (FTransactions[Idx] <> nil)) then
1073 <  begin
1074 <    TR := Transactions[Idx];
1075 <    FTransactions[Idx] := nil;
1076 <    TR.RemoveDatabase(TR.FindDatabase(Self));
1077 <    if TR = FDefaultTransaction then
1078 <      FDefaultTransaction := nil;
1079 <  end;
1080 < end;
1081 <
1082 < procedure TIBDataBase.RemoveTransactions;
1083 < var
1084 <  i: Integer;
1085 < begin
1086 <  for i := 0 to FTransactions.Count - 1 do if FTransactions[i] <> nil then
1087 <    RemoveTransaction(i);
1088 < end;
1089 <
1090 < procedure TIBDataBase.SetDatabaseName( const Value: TIBFileName);
1091 < begin
1092 <  if FDBName <> Value then
1093 <  begin
1094 <    EnsureInactive;
1095 <    CheckInactive;
1096 <    FDBName := Value;
1097 <  end;
1098 < end;
1099 <
1100 < procedure TIBDataBase.SetDBParamByDPB( const Idx: Integer; Value: String);
1101 < var
1102 <  ConstIdx: Integer;
1103 < begin
1104 <  ConstIdx := IndexOfDBConst(DPBConstantNames[Idx]);
1105 <  if (Value = '') then
1106 <  begin
1107 <    if ConstIdx <> -1 then
1108 <      Params.Delete(ConstIdx);
1109 <  end
1110 <  else
1111 <  begin
1112 <    if (ConstIdx = -1) then
1113 <      Params.Add(DPBConstantNames[Idx] + '=' + Value)
1114 <    else
1115 <      Params[ConstIdx] := DPBConstantNames[Idx] + '=' + Value;
1116 <  end;
1117 < end;
1118 <
1119 < procedure TIBDataBase.SetDBParams(Value: TStrings);
1120 < begin
1121 <  FDBParams.Assign(Value);
1122 < end;
1123 <
1124 < procedure TIBDataBase.SetDefaultTransaction(Value: TIBTransaction);
1125 < var
1126 <  i: Integer;
1127 < begin
1128 <  if (FDefaultTransaction <> nil) and (FDefaultTransaction <> Value) then
1129 <  begin
1130 <    i := FindTransaction(FDefaultTransaction);
1131 <    if (i <> -1) and (FDefaultTransaction.DefaultDatabase <> self) then
1132 <      RemoveTransaction(i);
1133 <  end;
1134 <  if (Value <> nil) and (FDefaultTransaction <> Value) then
1135 <  begin
1136 <    Value.AddDatabase(Self);
1137 <    AddTransaction(Value);
1138 <  end;
1139 <  FDefaultTransaction := Value;
1140 < end;
1141 <
1142 < procedure TIBDataBase.SetHandle(Value: TISC_DB_HANDLE);
1143 < begin
1144 <  if HandleIsShared then
1145 <    Close
1146 <  else
1147 <    CheckInactive;
1148 <  FHandle := Value;
1149 <  FHandleIsShared := (Value <> nil);
1150 < end;
1151 <
1152 < procedure TIBDataBase.SetIdleTimer(Value: Integer);
1153 < begin
1154 <  if Value < 0 then
1155 <    IBError(ibxeTimeoutNegative, [nil])
1156 <  else
1157 <    if (Value = 0) then
1158 <    begin
1159 <      FTimer.Enabled := False;
1160 <      FTimer.Interval := 0;
1161 <    end
1162 <    else
1163 <      if (Value > 0) then
1164 <      begin
1165 <        FTimer.Interval := Value;
1166 <        if not (csDesigning in ComponentState) then
1167 <          FTimer.Enabled := True;
1168 <      end;
1169 < end;
1170 <
1171 < function TIBDataBase.TestConnected: Boolean;
1172 < var
1173 <  DatabaseInfo: TIBDatabaseInfo;
1174 < begin
1175 <  result := Connected;
1176 <  if result then
1177 <  begin
1178 <    DatabaseInfo := TIBDatabaseInfo.Create(self);
1179 <    try
1180 <      DatabaseInfo.Database := self;
1181 <      { poke the server to see if connected }
1182 <      if DatabaseInfo.BaseLevel = 0 then ;
1183 <      DatabaseInfo.Free;
1184 <    except
1185 <      ForceClose;
1186 <      result := False;
1187 <      DatabaseInfo.Free;
1188 <    end;
1189 <  end;
1190 < end;
1191 <
1192 < procedure TIBDataBase.TimeoutConnection(Sender: TObject);
1193 < begin
1194 <  if Connected then
1195 <  begin
1196 <    if FCanTimeout then
1197 <    begin
1198 <      ForceClose;
1199 <      if Assigned(FOnIdleTimer) then
1200 <        FOnIdleTimer(Self);
1201 <    end
1202 <    else
1203 <      FCanTimeout := True;
1204 <  end;
1205 < end;
1206 <
1207 < function TIBDataBase.GetIsReadOnly: Boolean;
1208 < var
1209 <  DatabaseInfo: TIBDatabaseInfo;
1210 < begin
1211 <  DatabaseInfo := TIBDatabaseInfo.Create(self);
1212 <  DatabaseInfo.Database := self;
1213 <  if (DatabaseInfo.ODSMajorVersion < 10) then
1214 <    result := false
1215 <  else
1216 <  begin
1217 <    if (DatabaseInfo.ReadOnly = 0) then
1218 <      result := false
1219 <    else
1220 <      result := true;
1221 <  end;
1222 <  DatabaseInfo.Free;
1223 < end;
1224 <
1225 < function TIBDataBase.GetSQLDialect: Integer;
1226 < begin
1227 <  Result := FSQLDialect;
1228 < end;
1229 <
1230 <
1231 < procedure TIBDataBase.SetSQLDialect( const Value: Integer);
1232 < begin
1233 <  if (Value < 1) then IBError(ibxeSQLDialectInvalid, [nil]);
1234 <  if ((FHandle = nil) or (Value <= FDBSQLDialect))  then
1235 <    FSQLDialect := Value
1236 <  else
1237 <    IBError(ibxeSQLDialectInvalid, [nil]);
1238 < end;
1239 <
1240 < function TIBDataBase.GetDBSQLDialect: Integer;
1241 < var
1242 <  DatabaseInfo: TIBDatabaseInfo;
1243 < begin
1244 <  DatabaseInfo := TIBDatabaseInfo.Create(self);
1245 <  DatabaseInfo.Database := self;
1246 <  result := DatabaseInfo.DBSQLDialect;
1247 <  DatabaseInfo.Free;
1248 < end;
1249 <
1250 < procedure TIBDataBase.ValidateClientSQLDialect;
1251 < begin
1252 <  if (FDBSQLDialect < FSQLDialect) then
1253 <  begin
1254 <    FSQLDialect := FDBSQLDialect;
1255 <    if Assigned (FOnDialectDowngradeWarning) then
1256 <      FOnDialectDowngradeWarning(self);
1257 <  end;
1258 < end;
1259 <
1260 < procedure TIBDataBase.ApplyUpdates( const DataSets: array of TDataSet);
1261 < var
1262 <  I: Integer;
1263 <  DS: TIBCustomDataSet;
1264 <  TR: TIBTransaction;
1265 < begin
1266 <  TR := nil;
1267 <  for I := 0 to High(DataSets) do
1268 <  begin
1269 <    DS := TIBCustomDataSet(DataSets[I]);
1270 <    if DS.Database <> Self then
1271 <      IBError(ibxeUpdateWrongDB, [nil]);
1272 <    if TR = nil then
1273 <      TR := DS.Transaction;
1274 <    if (DS.Transaction <> TR) or (TR = nil) then
1275 <      IBError(ibxeUpdateWrongTR, [nil]);
1276 <  end;
1277 <  TR.CheckInTransaction;
1278 <  for I := 0 to High(DataSets) do
1279 <  begin
1280 <    DS := TIBCustomDataSet(DataSets[I]);
1281 <    DS.ApplyUpdates;
1282 <  end;
1283 <  TR.CommitRetaining;
1284 < end;
1285 <
1286 < procedure TIBDataBase.CloseDataSets;
1287 < var
1288 <  i: Integer;
1289 < begin
1290 <  for i := 0 to DataSetCount - 1 do
1291 <    if (DataSets[i] <> nil) then
1292 <      DataSets[i].close;
1293 < end;
1294 <
1295 < function TIBDataBase.GetDataset(Index: longint): TDataset;
1296 < begin
1297 <  if (Index >= 0) and (Index < FDataSets.Count) then
1298 <    Result := TDataSet(FDataSets[Index])
1299 <  else
1300 <    raise Exception.Create('Invalid Index to DataSets');
1301 < end;
1302 <
1303 < function TIBDataBase.GetDataSetCount: Longint;
1304 < begin
1305 <  Result := FDataSets.Count;
1306 < end;
1307 <
1308 < procedure TIBDataBase.ReadState(Reader: TReader);
1309 < begin
1310 <  FDBParams.Clear;
1311 <  inherited ReadState(Reader);
1312 < end;
1313 <
1314 < procedure TIBDataBase.SetConnected(Value: boolean);
1315 < begin
1316 <  if StreamedConnected and not AllowStreamedConnected then
1317 <  begin
1318 <    StreamedConnected := false;
1319 <    Value := false
1320 <  end;
1321 <  inherited SetConnected(Value);
1322 < end;
1323 <
1324 < procedure TIBDataBase.GetFieldNames( const TableName: string; List: TStrings);
1325 < var
1326 <  Query: TIBSQL;
1327 < begin
1328 <  if TableName = '' then
1329 <    IBError(ibxeNoTableName, [nil]);
1330 <  if not Connected then
1331 <    Open;
1332 <  if not FInternalTransaction.Active then
1333 <    FInternalTransaction.StartTransaction;
1334 <  Query := TIBSQL.Create(self);
1335 <  try
1336 <    Query.GoToFirstRecordOnExecute := False;
1337 <    Query.Database := Self;
1338 <    Query.Transaction := FInternalTransaction;
1339 <    Query.SQL.Text := 'Select R.RDB$FIELD_NAME ' + {do not localize}
1340 <      'from RDB$RELATION_FIELDS R, RDB$FIELDS F ' + {do not localize}
1341 <      'where R.RDB$RELATION_NAME = ' + {do not localize}
1342 <      '''' +
1343 <      FormatIdentifierValue(SQLDialect, TableName) +
1344 <      ''' ' +
1345 <      'and R.RDB$FIELD_SOURCE = F.RDB$FIELD_NAME '; {do not localize}
1346 <    Query.Prepare;
1347 <    Query.ExecQuery;
1348 <    with List do
1349 <    begin
1350 <      BeginUpdate;
1351 <      try
1352 <        Clear;
1353 <        while (not Query.EOF) and (Query.Next <> nil) do
1354 <          List.Add(TrimRight(Query.Current.ByName('RDB$FIELD_NAME').AsString)); {do not localize}
1355 <      finally
1356 <        EndUpdate;
1357 <      end;
1358 <    end;
1359 <  finally
1360 <    Query.free;
1361 <    FInternalTransaction.Commit;
1362 <  end;
1363 < end;
1364 <
1365 < procedure TIBDataBase.GetTableNames(List: TStrings; SystemTables: Boolean);
1366 < var
1367 <  Query : TIBSQL;
1368 < begin
1369 <  if not (csReading in ComponentState) then
1370 <  begin
1371 <    if not Connected then
1372 <      Open;
1373 <    if not FInternalTransaction.Active then
1374 <      FInternalTransaction.StartTransaction;
1375 <    Query := TIBSQL.Create(self);
1376 <    try
1377 <      Query.GoToFirstRecordOnExecute := False;
1378 <      Query.Database := Self;
1379 <      Query.Transaction := FInternalTransaction;
1380 <      if SystemTables then
1381 <        Query.SQL.Text := 'Select RDB$RELATION_NAME from RDB$RELATIONS' + {do not localize}
1382 <                          ' where RDB$VIEW_BLR is NULL' {do not localize}
1383 <      else
1384 <        Query.SQL.Text := 'Select RDB$RELATION_NAME from RDB$RELATIONS' + {do not localize}
1385 <                          ' where RDB$VIEW_BLR is NULL and RDB$SYSTEM_FLAG = 0'; {do not localize}
1386 <      Query.Prepare;
1387 <      Query.ExecQuery;
1388 <      with List do
1389 <      begin
1390 <        BeginUpdate;
1391 <        try
1392 <          Clear;
1393 <          while (not Query.EOF) and (Query.Next <> nil) do
1394 <            List.Add(TrimRight(Query.Current[0].AsString));
1395 <        finally
1396 <          EndUpdate;
1397 <        end;
1398 <      end;
1399 <    finally
1400 <      Query.Free;
1401 <      FInternalTransaction.Commit;
1402 <    end;
1403 <  end;
1404 < end;
1405 <
1406 < { TIBTransaction }
1407 <
1408 < constructor TIBTransaction.Create(AOwner: TComponent);
1409 < begin
1410 <  inherited Create(AOwner);
1411 <  FIBLoaded := False;
1412 <  CheckIBLoaded;
1413 <  FIBLoaded := True;
1414 <  CheckIBLoaded;
1415 <  FDatabases := TList.Create;
1416 <  FSQLObjects := TList.Create;
1417 <  FHandle := nil;
1418 <  FTPB := nil;
1419 <  FTPBLength := 0;
1420 <  FTRParams := TStringList.Create;
1421 <  FTRParamsChanged := True;
1422 <  TStringList(FTRParams).OnChange := TRParamsChange;
1423 <  TStringList(FTRParams).OnChanging := TRParamsChanging;
1424 <  FTimer := TTimer.Create(Self);
1425 <  FTimer.Enabled := False;
1426 <  FTimer.Interval := 0;
1427 <  FTimer.OnTimer := TimeoutTransaction;
1428 <  FDefaultAction := taCommit;
1429 < end;
1430 <
1431 < destructor TIBTransaction.Destroy;
1432 < var
1433 <  i: Integer;
1434 < begin
1435 <  if FIBLoaded then
1436 <  begin
1437 <    if InTransaction then
1438 <      EndTransaction(FDefaultAction, True);
1439 <    for i := 0 to FSQLObjects.Count - 1 do
1440 <      if FSQLObjects[i] <> nil then
1441 <        SQLObjects[i].DoTransactionFree;
1442 <    RemoveSQLObjects;
1443 <    RemoveDatabases;
1444 <    FreeMem(FTPB);
1445 <    FTPB := nil;
1446 <    FTRParams.Free;
1447 <    FSQLObjects.Free;
1448 <    FDatabases.Free;
1449 <  end;
1450 <  inherited Destroy;
1451 < end;
1452 <
1453 < function TIBTransaction.Call(ErrCode: ISC_STATUS;
1454 <  RaiseError: Boolean): ISC_STATUS;
1455 < var
1456 <  i: Integer;
1457 < begin
1458 <  result := ErrCode;
1459 <  for i := 0 to FDatabases.Count - 1 do if FDatabases[i] <> nil then
1460 <    Databases[i].FCanTimeout := False;
1461 <  FCanTimeout := False;
1462 <  if RaiseError and (result > 0) then
1463 <    IBDataBaseError;
1464 < end;
1465 <
1466 < procedure TIBTransaction.CheckDatabasesInList;
1467 < begin
1468 <  if GetDatabaseCount = 0 then
1469 <    IBError(ibxeNoDatabasesInTransaction, [nil]);
1470 < end;
1471 <
1472 < procedure TIBTransaction.CheckInTransaction;
1473 < begin
1474 <  if FStreamedActive and (not InTransaction) then
1475 <    Loaded;
1476 <  if (FHandle = nil) then
1477 <    IBError(ibxeNotInTransaction, [nil]);
1478 < end;
1479 <
1480 < procedure TIBTransaction.DoBeforeTransactionEnd;
1481 < begin
1482 <  if Assigned(FBeforeTransactionEnd) then
1483 <    FBeforeTransactionEnd(self);
1484 < end;
1485 <
1486 < procedure TIBTransaction.DoAfterTransactionEnd;
1487 < begin
1488 <  if Assigned(FAfterTransactionEnd) then
1489 <    FAfterTransactionEnd(self);
1490 < end;
1491 <
1492 < procedure TIBTransaction.DoOnStartTransaction;
1493 < begin
1494 <  if assigned(FOnStartTransaction) then
1495 <    OnStartTransaction(self);
1496 < end;
1497 <
1498 < procedure TIBTransaction.DoAfterExecQuery(Sender: TObject);
1499 < begin
1500 <  if assigned(FAfterExecQuery) then
1501 <    AfterExecQuery(Sender);
1502 < end;
1503 <
1504 < procedure TIBTransaction.DoAfterEdit(Sender: TObject);
1505 < begin
1506 <  if assigned(FAfterEdit) then
1507 <    AfterEdit(Sender);
1508 < end;
1509 <
1510 < procedure TIBTransaction.DoAfterDelete(Sender: TObject);
1511 < begin
1512 <  if assigned(FAfterDelete) then
1513 <    AfterDelete(Sender);
1514 < end;
1515 <
1516 < procedure TIBTransaction.DoAfterInsert(Sender: TObject);
1517 < begin
1518 <  if assigned(FAfterInsert) then
1519 <    AfterInsert(Sender);
1520 < end;
1521 <
1522 < procedure TIBTransaction.DoAfterPost(Sender: TObject);
1523 < begin
1524 <  if assigned(FAfterPost) then
1525 <    AfterPost(Sender);
1526 < end;
1527 <
1528 < procedure TIBTransaction.EnsureNotInTransaction;
1529 < begin
1530 <  if csDesigning in ComponentState then
1531 <  begin
1532 <    if FHandle <> nil then
1533 <      Rollback;
1534 <  end;
1535 < end;
1536 <
1537 < procedure TIBTransaction.CheckNotInTransaction;
1538 < begin
1539 <  if (FHandle <> nil) then
1540 <    IBError(ibxeInTransaction, [nil]);
1541 < end;
1542 <
1543 < function TIBTransaction.AddDatabase(db: TIBDatabase): Integer;
1544 < var
1545 <  i: Integer;
1546 <  NilFound: Boolean;
1547 < begin
1548 <  i := FindDatabase(db);
1549 <  if i <> -1 then
1550 <  begin
1551 <    result := i;
1552 <    exit;
1553 <  end;
1554 <  NilFound := False;
1555 <  i := 0;
1556 <  while (not NilFound) and (i < FDatabases.Count) do
1557 <  begin
1558 <    NilFound := (FDatabases[i] = nil);
1559 <    if (not NilFound) then
1560 <      Inc(i);
1561 <  end;
1562 <  if (NilFound) then
1563 <  begin
1564 <    FDatabases[i] := db;
1565 <    result := i;
1566 <  end
1567 <  else
1568 <  begin
1569 <    result := FDatabases.Count;
1570 <    FDatabases.Add(db);
1571 <  end;
1572 < end;
1573 <
1574 < function TIBTransaction.AddSQLObject(ds: TIBBase): Integer;
1575 < begin
1576 <  result := 0;
1577 <  while (result < FSQLObjects.Count) and (FSQLObjects[result] <> nil) do
1578 <    Inc(result);
1579 <  if (result = FSQLObjects.Count) then
1580 <    FSQLObjects.Add(ds)
1581 <  else
1582 <    FSQLObjects[result] := ds;
1583 < end;
1584 <
1585 < procedure TIBTransaction.Commit;
1586 < begin
1587 <  EndTransaction(TACommit, False);
1588 < end;
1589 <
1590 < procedure TIBTransaction.CommitRetaining;
1591 < begin
1592 <  EndTransaction(TACommitRetaining, False);
1593 < end;
1594 <
1595 < procedure TIBTransaction.EndTransaction(Action: TTransactionAction;
1596 <  Force: Boolean);
1597 < var
1598 <  status: ISC_STATUS;
1599 <  i: Integer;
1600 < begin
1601 <  CheckInTransaction;
1602 <  if FInEndTransaction then Exit;
1603 <  FInEndTransaction := true;
1604 <  FEndAction := Action;
1605 <  try
1606 <  case Action of
1607 <    TARollback, TACommit:
1608 <    begin
1609 <      if (HandleIsShared) and
1610 <         (Action <> FDefaultAction) and
1611 <         (not Force) then
1612 <        IBError(ibxeCantEndSharedTransaction, [nil]);
1613 <      DoBeforeTransactionEnd;
1614 <      for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then
1615 <        SQLObjects[i].DoBeforeTransactionEnd(Action);
1616 <      if InTransaction then
1617 <      begin
1618 <        if HandleIsShared then
1619 <        begin
1620 <          FHandle := nil;
1621 <          FHandleIsShared := False;
1622 <          status := 0;
1623 <        end
1624 <        else
1625 <          if (Action = TARollback) then
1626 <            status := Call(isc_rollback_transaction(StatusVector, @FHandle), False)
1627 <          else
1628 <            status := Call(isc_commit_transaction(StatusVector, @FHandle), False);
1629 <        if ((Force) and (status > 0)) then
1630 <          status := Call(isc_rollback_transaction(StatusVector, @FHandle), False);
1631 <        if Force then
1632 <          FHandle := nil
1633 <        else
1634 <          if (status > 0) then
1635 <            IBDataBaseError;
1636 <        for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then
1637 <          SQLObjects[i].DoAfterTransactionEnd;
1638 <        DoAfterTransactionEnd;
1639 <      end;
1640 <    end;
1641 <    TACommitRetaining:
1642 <      Call(isc_commit_retaining(StatusVector, @FHandle), True);
1643 <    TARollbackRetaining:
1644 <      Call(isc_rollback_retaining(StatusVector, @FHandle), True);
1645 <  end;
1646 <  if not (csDesigning in ComponentState) then
1647 <  begin
1648 <    case Action of
1649 <      TACommit:
1650 <        MonitorHook.TRCommit(Self);
1651 <      TARollback:
1652 <        MonitorHook.TRRollback(Self);
1653 <      TACommitRetaining:
1654 <        MonitorHook.TRCommitRetaining(Self);
1655 <      TARollbackRetaining:
1656 <        MonitorHook.TRRollbackRetaining(Self);
1657 <    end;
1658 <  end;
1659 <  finally
1660 <    FInEndTransaction := false
1661 <  end;
1662 < end;
1663 <
1664 < function TIBTransaction.GetDatabase(Index: Integer): TIBDatabase;
1665 < begin
1666 <  result := FDatabases[Index];
1667 < end;
1668 <
1669 < function TIBTransaction.GetDatabaseCount: Integer;
1670 < var
1671 <  i, Cnt: Integer;
1672 < begin
1673 <  result := 0;
1674 <  Cnt := FDatabases.Count - 1;
1675 <  for i := 0 to Cnt do if FDatabases[i] <> nil then
1676 <    Inc(result);
1677 < end;
1678 <
1679 < function TIBTransaction.GetSQLObject(Index: Integer): TIBBase;
1680 < begin
1681 <  result := FSQLObjects[Index];
1682 < end;
1683 <
1684 < function TIBTransaction.GetSQLObjectCount: Integer;
1685 < var
1686 <  i, Cnt: Integer;
1687 < begin
1688 <  result := 0;
1689 <  Cnt := FSQLObjects.Count - 1;
1690 <  for i := 0 to Cnt do if FSQLObjects[i] <> nil then
1691 <    Inc(result);
1692 < end;
1693 <
1694 < function TIBTransaction.GetInTransaction: Boolean;
1695 < begin
1696 <  result := (FHandle <> nil);
1697 < end;
1698 <
1699 < function TIBTransaction.FindDatabase(db: TIBDatabase): Integer;
1700 < var
1701 <  i: Integer;
1702 < begin
1703 <  result := -1;
1704 <  for i := 0 to FDatabases.Count - 1 do
1705 <    if db = TIBDatabase(FDatabases[i]) then
1706 <    begin
1707 <      result := i;
1708 <      break;
1709 <    end;
1710 < end;
1711 <
1712 < function TIBTransaction.FindDefaultDatabase: TIBDatabase;
1713 < var
1714 <  i: Integer;
1715 < begin
1716 <  result := FDefaultDatabase;
1717 <  if result = nil then
1718 <  begin
1719 <    for i := 0 to FDatabases.Count - 1 do
1720 <      if (TIBDatabase(FDatabases[i]) <> nil) and
1721 <        (TIBDatabase(FDatabases[i]).DefaultTransaction = self) then
1722 <      begin
1723 <        result := TIBDatabase(FDatabases[i]);
1724 <        break;
1725 <      end;
1726 <  end;
1727 < end;
1728 <
1729 < function TIBTransaction.GetEndAction: TTransactionAction;
1730 < begin
1731 <  if FInEndTransaction then
1732 <     Result := FEndAction
1733 <  else
1734 <     IBError(ibxeIB60feature, [nil])
1735 < end;
1736 <
1737 <
1738 < function TIBTransaction.GetIdleTimer: Integer;
1739 < begin
1740 <  result := FTimer.Interval;
1741 < end;
1742 <
1743 < procedure TIBTransaction.Loaded;
1744 < begin
1745 <  inherited Loaded;
1746 < end;
1747 <
1748 < procedure TIBTransaction.BeforeDatabaseDisconnect(DB: TIBDatabase);
1749 < begin
1750 <  if InTransaction then
1751 <    EndTransaction(FDefaultAction, True);
1752 < end;
1753 <
1754 < procedure TIBTransaction.RemoveDatabase(Idx: Integer);
1755 < var
1756 <  DB: TIBDatabase;
1757 < begin
1758 <  if ((Idx >= 0) and (FDatabases[Idx] <> nil)) then
1759 <  begin
1760 <    DB := Databases[Idx];
1761 <    FDatabases[Idx] := nil;
1762 <    DB.RemoveTransaction(DB.FindTransaction(Self));
1763 <    if DB = FDefaultDatabase then
1764 <      FDefaultDatabase := nil;
1765 <  end;
1766 < end;
1767 <
1768 < procedure TIBTransaction.RemoveDatabases;
1769 < var
1770 <  i: Integer;
1771 < begin
1772 <  for i := 0 to FDatabases.Count - 1 do if FDatabases[i] <> nil then
1773 <    RemoveDatabase(i);
1774 < end;
1775 <
1776 < procedure TIBTransaction.RemoveSQLObject(Idx: Integer);
1777 < var
1778 <  ds: TIBBase;
1779 < begin
1780 <  if ((Idx >= 0) and (FSQLObjects[Idx] <> nil)) then
1781 <  begin
1782 <    ds := SQLObjects[Idx];
1783 <    FSQLObjects[Idx] := nil;
1784 <    ds.Transaction := nil;
1785 <  end;
1786 < end;
1787 <
1788 < procedure TIBTransaction.RemoveSQLObjects;
1789 < var
1790 <  i: Integer;
1791 < begin
1792 <  for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then
1793 <    RemoveSQLObject(i);
1794 < end;
1795 <
1796 < procedure TIBTransaction.Rollback;
1797 < begin
1798 <  EndTransaction(TARollback, False);
1799 < end;
1800 <
1801 < procedure TIBTransaction.RollbackRetaining;
1802 < begin
1803 <  EndTransaction(TARollbackRetaining, False);
1804 < end;
1805 <
1806 < procedure TIBTransaction.SetActive(Value: Boolean);
1807 < begin
1808 <  if csReading in ComponentState then
1809 <    FStreamedActive := Value
1810 <  else
1811 <    if Value and not InTransaction then
1812 <      StartTransaction
1813 <    else
1814 <      if not Value and InTransaction then
1815 <        Rollback;
1816 < end;
1817 <
1818 < procedure TIBTransaction.SetDefaultAction(Value: TTransactionAction);
1819 < begin
1820 < (*  if (Value = taRollbackRetaining) and (GetIBClientVersion < 6) then
1821 <    IBError(ibxeIB60feature, [nil]);*)
1822 <  FDefaultAction := Value;
1823 < end;
1824 <
1825 < procedure TIBTransaction.SetDefaultDatabase(Value: TIBDatabase);
1826 < var
1827 <  i: integer;
1828 < begin
1829 <  if (FDefaultDatabase <> nil) and (FDefaultDatabase <> Value) then
1830 <  begin
1831 <    i := FDefaultDatabase.FindTransaction(self);
1832 <    if (i <> -1) then
1833 <      FDefaultDatabase.RemoveTransaction(i);
1834 <  end;
1835 <  if (Value <> nil) and (FDefaultDatabase <> Value) then
1836 <  begin
1837 <    Value.AddTransaction(Self);
1838 <    AddDatabase(Value);
1839 <    for i := 0 to FSQLObjects.Count - 1 do
1840 <      if (FSQLObjects[i] <> nil) and
1841 <         (TIBBase(FSQLObjects[i]).Database = nil) then
1842 <         SetObjectProp(TIBBase(FSQLObjects[i]).Owner, 'Database', Value);
1843 <  end;
1844 <  FDefaultDatabase := Value;
1845 < end;
1846 <
1847 < procedure TIBTransaction.SetHandle(Value: TISC_TR_HANDLE);
1848 < begin
1849 <  if (HandleIsShared) then
1850 <    EndTransaction(DefaultAction, True)
1851 <  else
1852 <    CheckNotInTransaction;
1853 <  FHandle := Value;
1854 <  FHandleIsShared := (Value <> nil);
1855 < end;
1856 <
1857 < procedure TIBTransaction.Notification( AComponent: TComponent;
1858 <                                        Operation: TOperation);
1859 < var
1860 <  i: Integer;
1861 < begin
1862 <  inherited Notification( AComponent, Operation);
1863 <  if (Operation = opRemove) and (AComponent = FDefaultDatabase) then
1864 <  begin
1865 <    i := FindDatabase(FDefaultDatabase);
1866 <    if (i <> -1) then
1867 <      RemoveDatabase(i);
1868 <    FDefaultDatabase := nil;
1869 <  end;
1870 < end;
1871 <
1872 < procedure TIBTransaction.SetIdleTimer(Value: Integer);
1873 < begin
1874 <  if Value < 0 then
1875 <    IBError(ibxeTimeoutNegative, [nil])
1876 <  else
1877 <    if (Value = 0) then
1878 <    begin
1879 <      FTimer.Enabled := False;
1880 <      FTimer.Interval := 0;
1881 <    end
1882 <    else
1883 <      if (Value > 0) then
1884 <      begin
1885 <        FTimer.Interval := Value;
1886 <        if not (csDesigning in ComponentState) then
1887 <          FTimer.Enabled := True;
1888 <      end;
1889 < end;
1890 <
1891 < procedure TIBTransaction.SetTRParams(Value: TStrings);
1892 < begin
1893 <  FTRParams.Assign(Value);
1894 < end;
1895 <
1896 < procedure TIBTransaction.StartTransaction;
1897 < var
1898 <  pteb: PISC_TEB_ARRAY;
1899 <  TPB: String;
1900 <  i: Integer;
1901 < begin
1902 <  CheckNotInTransaction;
1903 <  CheckDatabasesInList;
1904 <  for i := 0 to FDatabases.Count - 1 do
1905 <   if  FDatabases[i] <> nil then
1906 <   begin
1907 <     with TIBDatabase(FDatabases[i]) do
1908 <     if not Connected then
1909 <       if FStreamedConnected then
1910 <       begin
1911 <         Open;
1912 <         FStreamedConnected := False;
1913 <       end
1914 <       else
1915 <         IBError(ibxeDatabaseClosed, [nil]);
1916 <   end;
1917 <  if FTRParamsChanged then
1918 <  begin
1919 <    FTRParamsChanged := False;
1920 <    GenerateTPB(FTRParams, TPB, FTPBLength);
1921 <    if FTPBLength > 0 then
1922 <    begin
1923 <      IBAlloc(FTPB, 0, FTPBLength);
1924 <      Move(TPB[1], FTPB[0], FTPBLength);
1925 <    end;
1926 <  end;
1927 <
1928 <  pteb := nil;
1929 <  IBAlloc(pteb, 0, DatabaseCount * SizeOf(TISC_TEB));
1930 <  try
1931 <    for i := 0 to DatabaseCount - 1 do if Databases[i] <> nil then
1932 <    begin
1933 <      pteb^[i].db_handle := @(Databases[i].Handle);
1934 <      pteb^[i].tpb_length := FTPBLength;
1935 <      pteb^[i].tpb_address := FTPB;
1936 <    end;
1937 <    if Call(isc_start_multiple(StatusVector, @FHandle,
1938 <                               DatabaseCount, PISC_TEB(pteb)), False) > 0 then
1939 <    begin
1940 <      FHandle := nil;
1941 <      IBDataBaseError;
1942 <    end;
1943 <    if not (csDesigning in ComponentState) then
1944 <      MonitorHook.TRStart(Self);
1945 <  finally
1946 <    FreeMem(pteb);
1947 <  end;
1948 <  DoOnStartTransaction;
1949 < end;
1950 <
1951 < procedure TIBTransaction.TimeoutTransaction(Sender: TObject);
1952 < begin
1953 <  if InTransaction then
1954 <  begin
1955 <    if FCanTimeout then
1956 <    begin
1957 <      EndTransaction(FDefaultAction, True);
1958 <      if Assigned(FOnIdleTimer) then
1959 <        FOnIdleTimer(Self);
1960 <    end
1961 <    else
1962 <      FCanTimeout := True;
1963 <  end;
1964 < end;
1965 <
1966 < procedure TIBTransaction.TRParamsChange(Sender: TObject);
1967 < begin
1968 <  FTRParamsChanged := True;
1969 < end;
1970 <
1971 < procedure TIBTransaction.TRParamsChanging(Sender: TObject);
1972 < begin
1973 <  EnsureNotInTransaction;
1974 <  CheckNotInTransaction;
1975 < end;
1976 <
1977 < { TIBBase }
1978 < constructor TIBBase.Create(AOwner: TObject);
1979 < begin
1980 <  FOwner := AOwner;
1981 < end;
1982 <
1983 < destructor TIBBase.Destroy;
1984 < begin
1985 <  SetDatabase(nil);
1986 <  SetTransaction(nil);
1987 <  inherited Destroy;
1988 < end;
1989 <
1990 < function TIBBase.GetCharSetSize(CharSetID: integer): integer;
1991 < begin
1992 <  if (CharSetID >= 0) and (CharSetID < Length(Database.FCharSetSizes)) then
1993 <    Result := Database.FCharSetSizes[CharSetID]
1994 <  else
1995 <    Result := 1; {Unknown character set}
1996 < end;
1997 <
1998 < procedure TIBBase.CheckDatabase;
1999 < begin
2000 <  if (FDatabase = nil) then
2001 <    IBError(ibxeDatabaseNotAssigned, [nil]);
2002 <  FDatabase.CheckActive;
2003 < end;
2004 <
2005 < procedure TIBBase.CheckTransaction;
2006 < begin
2007 <  if FTransaction = nil then
2008 <    IBError(ibxeTransactionNotAssigned, [nil]);
2009 <  FTransaction.CheckInTransaction;
2010 < end;
2011 <
2012 < function TIBBase.GetDBHandle: PISC_DB_HANDLE;
2013 < begin
2014 <  CheckDatabase;
2015 <  result := @FDatabase.Handle;
2016 < end;
2017 <
2018 < function TIBBase.GetTRHandle: PISC_TR_HANDLE;
2019 < begin
2020 <  CheckTransaction;
2021 <  result := @FTransaction.Handle;
2022 < end;
2023 <
2024 < procedure TIBBase.DoBeforeDatabaseConnect(DBParams: TStrings; var DBName: string
2025 <  );
2026 < begin
2027 <  if assigned(FBeforeDatabaseConnect) then
2028 <    BeforeDatabaseConnect(self,DBParams,DBName);
2029 < end;
2030 <
2031 < procedure TIBBase.DoAfterDatabaseConnect;
2032 < begin
2033 <  if assigned(FAfterDatabaseConnect) then
2034 <    AfterDatabaseConnect(self);
2035 < end;
2036 <
2037 < procedure TIBBase.DoBeforeDatabaseDisconnect;
2038 < begin
2039 <  if Assigned(BeforeDatabaseDisconnect) then
2040 <    BeforeDatabaseDisconnect(Self);
2041 < end;
2042 <
2043 < procedure TIBBase.DoAfterDatabaseDisconnect;
2044 < begin
2045 <  if Assigned(AfterDatabaseDisconnect) then
2046 <    AfterDatabaseDisconnect(Self);
2047 < end;
2048 <
2049 < procedure TIBBase.DoDatabaseFree;
2050 < begin
2051 <  if Assigned(OnDatabaseFree) then
2052 <    OnDatabaseFree(Self);
2053 <  SetDatabase(nil);
2054 <  SetTransaction(nil);
2055 < end;
2056 <
2057 < procedure TIBBase.DoBeforeTransactionEnd(Action: TTransactionAction);
2058 < begin
2059 <  if Assigned(BeforeTransactionEnd) then
2060 <    BeforeTransactionEnd(Self,Action);
2061 < end;
2062 <
2063 < procedure TIBBase.DoAfterTransactionEnd;
2064 < begin
2065 <  if Assigned(AfterTransactionEnd) then
2066 <    AfterTransactionEnd(Self);
2067 < end;
2068 <
2069 < procedure TIBBase.DoTransactionFree;
2070 < begin
2071 <  if Assigned(OnTransactionFree) then
2072 <    OnTransactionFree(Self);
2073 <  FTransaction := nil;
2074 < end;
2075 <
2076 < procedure TIBBase.DoAfterExecQuery(Sender: TObject);
2077 < begin
2078 <  if FTransaction <> nil then
2079 <    FTransaction.DoAfterExecQuery(Sender);
2080 < end;
2081 <
2082 < procedure TIBBase.DoAfterEdit(Sender: TObject);
2083 < begin
2084 <  if FTransaction <> nil then
2085 <    FTransaction.DoAfterEdit(Sender);
2086 < end;
2087 <
2088 < procedure TIBBase.DoAfterDelete(Sender: TObject);
2089 < begin
2090 <  if FTransaction <> nil then
2091 <    FTransaction.DoAfterDelete(Sender);
2092 < end;
2093 <
2094 < procedure TIBBase.DoAfterInsert(Sender: TObject);
2095 < begin
2096 <  if FTransaction <> nil then
2097 <    FTransaction.DoAfterInsert(Sender);
2098 < end;
2099 <
2100 < procedure TIBBase.DoAfterPost(Sender: TObject);
2101 < begin
2102 <  if FTransaction <> nil then
2103 <    FTransaction.DoAfterPost(Sender);
2104 < end;
2105 <
2106 < procedure TIBBase.SetDatabase(Value: TIBDatabase);
2107 < begin
2108 <  if (FDatabase <> nil) then
2109 <    FDatabase.RemoveSQLObject(FIndexInDatabase);
2110 <  FDatabase := Value;
2111 <  if (FDatabase <> nil) then
2112 <  begin
2113 <    FIndexInDatabase := FDatabase.AddSQLObject(Self);
2114 <    if (FTransaction = nil) then
2115 <      Transaction := FDatabase.FindDefaultTransaction;
2116 <  end;
2117 < end;
2118 <
2119 < procedure TIBBase.SetTransaction(Value: TIBTransaction);
2120 < begin
2121 <  if (FTransaction <> nil) then
2122 <    FTransaction.RemoveSQLObject(FIndexInTransaction);
2123 <  FTransaction := Value;
2124 <  if (FTransaction <> nil) then
2125 <  begin
2126 <    FIndexInTransaction := FTransaction.AddSQLObject(Self);
2127 <    if (FDatabase = nil) then
2128 <      Database := FTransaction.FindDefaultDatabase;
2129 <  end;
2130 < end;
2131 <
2132 < { GenerateDPB -
2133 <  Given a string containing a textual representation
2134 <  of the database parameters, generate a database
2135 <  parameter buffer, and return it and its length
2136 <  in DPB and DPBLength, respectively. }
2137 <
2138 < procedure GenerateDPB(sl: TStrings; var DPB: string; var DPBLength: Short);
2139 < var
2140 <  i, j, pval: Integer;
2141 <  DPBVal: UShort;
2142 <  ParamName, ParamValue: string;
2143 < begin
2144 <  { The DPB is initially empty, with the exception that
2145 <    the DPB version must be the first byte of the string. }
2146 <  DPBLength := 1;
2147 <  DPB := Char(isc_dpb_version1);
2148 <
2149 <  {Iterate through the textual database parameters, constructing
2150 <   a DPB on-the-fly }
2151 <  for i := 0 to sl.Count - 1 do
2152 <  begin
2153 <    { Get the parameter's name and value from the list,
2154 <      and make sure that the name is all lowercase with
2155 <      no leading 'isc_dpb_' prefix
2156 <    }
2157 <    if (Trim(sl.Names[i]) = '') then
2158 <      continue;
2159 <    ParamName := LowerCase(sl.Names[i]); {mbcs ok}
2160 <    ParamValue := Copy(sl[i], Pos('=', sl[i]) + 1, Length(sl[i])); {mbcs ok}
2161 <    if (Pos(DPBPrefix, ParamName) = 1) then {mbcs ok}
2162 <      Delete(ParamName, 1, Length(DPBPrefix));
2163 <     { We want to translate the parameter name to some Integer
2164 <       value. We do this by scanning through a list of known
2165 <       database parameter names (DPBConstantNames, defined above) }
2166 <    DPBVal := 0;
2167 <    { Find the parameter }
2168 <    for j := 1 to isc_dpb_last_dpb_constant do
2169 <      if (ParamName = DPBConstantNames[j]) then
2170 <      begin
2171 <        DPBVal := j;
2172 <        break;
2173 <      end;
2174 <     {  A database parameter either contains a string value (case 1)
2175 <       or an Integer value (case 2)
2176 <       or no value at all (case 3)
2177 <       or an error needs to be generated (case else)  }
2178 <    case DPBVal of
2179 <      isc_dpb_user_name, isc_dpb_password, isc_dpb_password_enc,
2180 <      isc_dpb_sys_user_name, isc_dpb_license, isc_dpb_encrypt_key,
2181 <      isc_dpb_lc_messages, isc_dpb_lc_ctype,
2182 <      isc_dpb_sql_role_name, isc_dpb_sql_dialect:
2183 <      begin
2184 <        if DPBVal = isc_dpb_sql_dialect then
2185 <          ParamValue[1] := Char(Ord(ParamValue[1]) - 48);
2186 <        DPB := DPB +
2187 <               Char(DPBVal) +
2188 <               Char(Length(ParamValue)) +
2189 <               ParamValue;
2190 <        Inc(DPBLength, 2 + Length(ParamValue));
2191 <      end;
2192 <      isc_dpb_num_buffers, isc_dpb_dbkey_scope, isc_dpb_force_write,
2193 <      isc_dpb_no_reserve, isc_dpb_damaged, isc_dpb_verify:
2194 <      begin
2195 <        DPB := DPB +
2196 <               Char(DPBVal) +
2197 <               #1 +
2198 <               Char(StrToInt(ParamValue));
2199 <        Inc(DPBLength, 3);
2200 <      end;
2201 <      isc_dpb_sweep:
2202 <      begin
2203 <        DPB := DPB +
2204 <               Char(DPBVal) +
2205 <               #1 +
2206 <               Char(isc_dpb_records);
2207 <        Inc(DPBLength, 3);
2208 <      end;
2209 <      isc_dpb_sweep_interval:
2210 <      begin
2211 <        pval := StrToInt(ParamValue);
2212 <        DPB := DPB +
2213 <               Char(DPBVal) +
2214 <               #4 +
2215 <               PChar(@pval)[0] +
2216 <               PChar(@pval)[1] +
2217 <               PChar(@pval)[2] +
2218 <               PChar(@pval)[3];
2219 <        Inc(DPBLength, 6);
2220 <      end;
2221 <      isc_dpb_activate_shadow, isc_dpb_delete_shadow, isc_dpb_begin_log,
2222 <      isc_dpb_quit_log:
2223 <      begin
2224 <        DPB := DPB +
2225 <               Char(DPBVal) +
2226 <               #1 + #0;
2227 <        Inc(DPBLength, 3);
2228 <      end;
2229 <      else
2230 <      begin
2231 <        if (DPBVal > 0) and
2232 <           (DPBVal <= isc_dpb_last_dpb_constant) then
2233 <          IBError(ibxeDPBConstantNotSupported, [DPBConstantNames[DPBVal]])
2234 <        else
2235 <          IBError(ibxeDPBConstantUnknownEx, [sl.Names[i]]);
2236 <      end;
2237 <    end;
2238 <  end;
2239 < end;
2240 <
2241 < { GenerateTPB -
2242 <  Given a string containing a textual representation
2243 <  of the transaction parameters, generate a transaction
2244 <  parameter buffer, and return it and its length in
2245 <  TPB and TPBLength, respectively. }
2246 < procedure GenerateTPB(sl: TStrings; var TPB: string; var TPBLength: Short);
2247 < var
2248 <  i, j, TPBVal, ParamLength: Integer;
2249 <  ParamName, ParamValue: string;
2250 < begin
2251 <  TPB := '';
2252 <  if (sl.Count = 0) then
2253 <    TPBLength := 0
2254 <  else
2255 <  begin
2256 <    TPBLength := sl.Count + 1;
2257 <    TPB := TPB + Char(isc_tpb_version3);
2258 <  end;
2259 <  for i := 0 to sl.Count - 1 do
2260 <  begin
2261 <    if (Trim(sl[i]) =  '') then
2262 <    begin
2263 <      Dec(TPBLength);
2264 <      Continue;
2265 <    end;
2266 <    if (Pos('=', sl[i]) = 0) then {mbcs ok}
2267 <      ParamName := LowerCase(sl[i]) {mbcs ok}
2268 <    else
2269 <    begin
2270 <      ParamName := LowerCase(sl.Names[i]); {mbcs ok}
2271 <      ParamValue := Copy(sl[i], Pos('=', sl[i]) + 1, Length(sl[i])); {mbcs ok}
2272 <    end;
2273 <    if (Pos(TPBPrefix, ParamName) = 1) then {mbcs ok}
2274 <      Delete(ParamName, 1, Length(TPBPrefix));
2275 <    TPBVal := 0;
2276 <    { Find the parameter }
2277 <    for j := 1 to isc_tpb_last_tpb_constant do
2278 <      if (ParamName = TPBConstantNames[j]) then
2279 <      begin
2280 <        TPBVal := j;
2281 <        break;
2282 <      end;
2283 <    { Now act on it }
2284 <    case TPBVal of
2285 <      isc_tpb_consistency, isc_tpb_exclusive, isc_tpb_protected,
2286 <      isc_tpb_concurrency, isc_tpb_shared, isc_tpb_wait, isc_tpb_nowait,
2287 <      isc_tpb_read, isc_tpb_write, isc_tpb_ignore_limbo,
2288 <      isc_tpb_read_committed, isc_tpb_rec_version, isc_tpb_no_rec_version:
2289 <        TPB := TPB + Char(TPBVal);
2290 <      isc_tpb_lock_read, isc_tpb_lock_write:
2291 <      begin
2292 <        TPB := TPB + Char(TPBVal);
2293 <        { Now set the string parameter }
2294 <        ParamLength := Length(ParamValue);
2295 <        Inc(TPBLength, ParamLength + 1);
2296 <        TPB := TPB + Char(ParamLength) + ParamValue;
2297 <      end;
2298 <      else
2299 <      begin
2300 <        if (TPBVal > 0) and
2301 <           (TPBVal <= isc_tpb_last_tpb_constant) then
2302 <          IBError(ibxeTPBConstantNotSupported, [TPBConstantNames[TPBVal]])
2303 <        else
2304 <          IBError(ibxeTPBConstantUnknownEx, [sl.Names[i]]);
2305 <      end;
2306 <    end;
2307 <  end;
2308 < end;
2309 <
2310 < end.
2311 <
2312 <
2313 <
2314 <
2315 <
1 > {************************************************************************}
2 > {                                                                        }
3 > {       Borland Delphi Visual Component Library                          }
4 > {       InterBase Express core components                                }
5 > {                                                                        }
6 > {       Copyright (c) 1998-2000 Inprise 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            }
16 > {    may obtain a copy of the License at http://www.Inprise.com/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 Inprise Corporation are Copyright (C) Inprise   }
24 > {       Corporation. All Rights Reserved.                                }
25 > {    Contributor(s): Jeff Overcash                                       }
26 > {                                                                        }
27 > {    IBX For Lazarus (Firebird Express)                                  }
28 > {    Contributor: Tony Whyman, MWA Software http://www.mwasoftware.co.uk }
29 > {    Portions created by MWA Software are copyright McCallum Whyman      }
30 > {    Associates Ltd 2011                                                 }
31 > {                                                                        }
32 > {************************************************************************}
33 >
34 > unit IBDatabase;
35 >
36 > {$Mode Delphi}
37 >
38 > {$codepage UTF8}
39 >
40 > interface
41 >
42 > uses
43 > {$IFDEF WINDOWS }
44 >  Windows,
45 > {$ELSE}
46 >  unix,
47 > {$ENDIF}
48 >  SysUtils, Classes, FPTimer, IBExternals, DB, IB, CustApp, IBTypes;
49 >
50 > const
51 >  DPBPrefix = 'isc_dpb_';
52 >  DPBConstantNames: array[1..isc_dpb_last_dpb_constant] of string = (
53 >    'cdd_pathname',
54 >    'allocation',
55 >    'journal',
56 >    'page_size',
57 >    'num_buffers',
58 >    'buffer_length',
59 >    'debug',
60 >    'garbage_collect',
61 >    'verify',
62 >    'sweep',
63 >    'enable_journal',
64 >    'disable_journal',
65 >    'dbkey_scope',
66 >    'number_of_users',
67 >    'trace',
68 >    'no_garbage_collect',
69 >    'damaged',
70 >    'license',
71 >    'sys_user_name',
72 >    'encrypt_key',
73 >    'activate_shadow',
74 >    'sweep_interval',
75 >    'delete_shadow',
76 >    'force_write',
77 >    'begin_log',
78 >    'quit_log',
79 >    'no_reserve',
80 >    'user_name',
81 >    'password',
82 >    'password_enc',
83 >    'sys_user_name_enc',
84 >    'interp',
85 >    'online_dump',
86 >    'old_file_size',
87 >    'old_num_files',
88 >    'old_file',
89 >    'old_start_page',
90 >    'old_start_seqno',
91 >    'old_start_file',
92 >    'drop_walfile',
93 >    'old_dump_id',
94 >    'wal_backup_dir',
95 >    'wal_chkptlen',
96 >    'wal_numbufs',
97 >    'wal_bufsize',
98 >    'wal_grp_cmt_wait',
99 >    'lc_messages',
100 >    'lc_ctype',
101 >    'cache_manager',
102 >    'shutdown',
103 >    'online',
104 >    'shutdown_delay',
105 >    'reserved',
106 >    'overwrite',
107 >    'sec_attach',
108 >    'disable_wal',
109 >    'connect_timeout',
110 >    'dummy_packet_interval',
111 >    'gbak_attach',
112 >    'sql_role_name',
113 >    'set_page_buffers',
114 >    'working_directory',
115 >    'sql_dialect',
116 >    'set_db_readonly',
117 >    'set_db_sql_dialect',
118 >    'gfix_attach',
119 >    'gstat_attach',
120 >    'set_db_charset',
121 >    'gsec_attach',
122 >    'address_path' ,
123 >    'process_id',
124 >    'no_db_triggers',
125 >    'trusted_auth',
126 >    'process_name',
127 >    'trusted_role',
128 >    'org_filename',
129 >    'utf8_ilename',
130 >    'ext_call_depth'
131 >  );
132 >
133 >  TPBPrefix = 'isc_tpb_';
134 >  TPBConstantNames: array[1..isc_tpb_last_tpb_constant] of string = (
135 >    'consistency',
136 >    'concurrency',
137 >    'shared',
138 >    'protected',
139 >    'exclusive',
140 >    'wait',
141 >    'nowait',
142 >    'read',
143 >    'write',
144 >    'lock_read',
145 >    'lock_write',
146 >    'verb_time',
147 >    'commit_time',
148 >    'ignore_limbo',
149 >    'read_committed',
150 >    'autocommit',
151 >    'rec_version',
152 >    'no_rec_version',
153 >    'restart_requests',
154 >    'no_auto_undo',
155 >    'lock_timeout'
156 >  );
157 >
158 > type
159 >
160 >  TIBDatabase = class;
161 >  TIBTransaction = class;
162 >  TIBBase = class;
163 >
164 >  TIBDatabaseLoginEvent = procedure(Database: TIBDatabase;
165 >    LoginParams: TStrings) of object;
166 >
167 >  TIBFileName = type string;
168 >  { TIBDatabase }
169 >  TIBDataBase = class(TCustomConnection)
170 >  private
171 >    FAttachment: IAttachment;
172 >    FCreateDatabase: boolean;
173 >    FCreateIfNotExists: boolean;
174 >    FDefaultCharSetID: integer;
175 >    FDefaultCharSetName: RawByteString;
176 >    FDefaultCodePage: TSystemCodePage;
177 >    FDPB: IDPB;
178 >    FAllowStreamedConnected: boolean;
179 >    FHiddenPassword: string;
180 >    FOnCreateDatabase: TNotifyEvent;
181 >    FOnLogin: TIBDatabaseLoginEvent;
182 >    FSQLHourGlass: Boolean;
183 >    FTraceFlags: TTraceFlags;
184 >    FDBSQLDialect: Integer;
185 >    FSQLDialect: Integer;
186 >    FOnDialectDowngradeWarning: TNotifyEvent;
187 >    FSQLObjects: TList;
188 >    FTransactions: TList;
189 >    FDBName: TIBFileName;
190 >    FDBParams: TStrings;
191 >    FDBParamsChanged: Boolean;
192 >    FOnIdleTimer: TNotifyEvent;
193 >    FDefaultTransaction: TIBTransaction;
194 >    FInternalTransaction: TIBTransaction;
195 >    FTimer: TFPTimer;
196 >    FUserNames: TStringList;
197 >    FDataSets: TList;
198 >    FLoginCalled: boolean;
199 >    FUseDefaultSystemCodePage: boolean;
200 >    procedure EnsureInactive;
201 >    function GetDBSQLDialect: Integer;
202 >    function GetSQLDialect: Integer;
203 >    procedure SetSQLDialect(const Value: Integer);
204 >    procedure ValidateClientSQLDialect;
205 >    procedure DBParamsChange(Sender: TObject);
206 >    procedure DBParamsChanging(Sender: TObject);
207 >    function GetSQLObject(Index: Integer): TIBBase;
208 >    function GetSQLObjectCount: Integer;
209 >    function GetIdleTimer: Integer;
210 >    function GetTransaction(Index: Integer): TIBTransaction;
211 >    function GetTransactionCount: Integer;
212 >    function Login(var aDatabaseName: string): Boolean;
213 >    procedure SetDatabaseName(const Value: TIBFileName);
214 >    procedure SetDBParamByDPB(const Idx: Integer; Value: String);
215 >    procedure SetDBParams(Value: TStrings);
216 >    procedure SetDefaultTransaction(Value: TIBTransaction);
217 >    procedure SetIdleTimer(Value: Integer);
218 >    procedure TimeoutConnection(Sender: TObject);
219 >    function GetIsReadOnly: Boolean;
220 >    function AddSQLObject(ds: TIBBase): Integer;
221 >    procedure RemoveSQLObject(Idx: Integer);
222 >    procedure RemoveSQLObjects;
223 >    procedure InternalClose(Force: Boolean);
224 >
225 >  protected
226 >    procedure DoConnect; override;
227 >    procedure DoDisconnect; override;
228 >    function GetConnected: Boolean; override;
229 >    procedure CheckStreamConnect;
230 >    procedure HandleException(Sender: TObject);
231 >    procedure Notification( AComponent: TComponent; Operation: TOperation); override;
232 >    function GetDataset(Index : longint) : TDataset; override;
233 >    function GetDataSetCount : Longint; override;
234 >    procedure ReadState(Reader: TReader); override;
235 >    procedure SetConnected (Value : boolean); override;
236 >  public
237 >    constructor Create(AOwner: TComponent); override;
238 >    destructor Destroy; override;
239 >    procedure ApplyUpdates(const DataSets: array of TDataSet);
240 >    procedure CloseDataSets;
241 >    procedure CheckActive;
242 >    procedure CheckInactive;
243 >    procedure CreateDatabase;
244 >    procedure DropDatabase;
245 >    procedure ForceClose;
246 >    procedure GetFieldNames(const TableName: string; List: TStrings);
247 >    procedure GetTableNames(List: TStrings; SystemTables: Boolean = False);
248 >    function IndexOfDBConst(st: String): Integer;
249 >    function TestConnected: Boolean;
250 >    procedure CheckDatabaseName;
251 >    function AddTransaction(TR: TIBTransaction): Integer;
252 >    function FindTransaction(TR: TIBTransaction): Integer;
253 >    function FindDefaultTransaction(): TIBTransaction;
254 >    procedure RemoveTransaction(Idx: Integer);
255 >    procedure RemoveTransactions;
256 >
257 >    property Attachment: IAttachment read FAttachment;
258 >    property DBSQLDialect : Integer read FDBSQLDialect;
259 >    property IsReadOnly: Boolean read GetIsReadOnly;
260 >    property SQLObjectCount: Integer read GetSQLObjectCount;
261 >    property SQLObjects[Index: Integer]: TIBBase read GetSQLObject;
262 >    property TransactionCount: Integer read GetTransactionCount;
263 >    property Transactions[Index: Integer]: TIBTransaction read GetTransaction;
264 >    property InternalTransaction: TIBTransaction read FInternalTransaction;
265 >    property DefaultCharSetName: RawByteString read FDefaultCharSetName;
266 >    property DefaultCharSetID: integer read FDefaultCharSetID;
267 >    property DefaultCodePage: TSystemCodePage read FDefaultCodePage;
268 >
269 >  published
270 >    property Connected;
271 >    property CreateIfNotExists: boolean read FCreateIfNotExists write FCreateIfNotExists;
272 >    property AllowStreamedConnected: boolean read FAllowStreamedConnected
273 >             write FAllowStreamedConnected;
274 >    property DatabaseName: TIBFileName read FDBName write SetDatabaseName;
275 >    property Params: TStrings read FDBParams write SetDBParams;
276 >    property LoginPrompt default True;
277 >    property DefaultTransaction: TIBTransaction read FDefaultTransaction
278 >                                                 write SetDefaultTransaction;
279 >    property IdleTimer: Integer read GetIdleTimer write SetIdleTimer;
280 >    property SQLDialect : Integer read GetSQLDialect write SetSQLDialect default 3;
281 >    property SQLHourGlass: Boolean read FSQLHourGlass write FSQLHourGlass default true;
282 >    property TraceFlags: TTraceFlags read FTraceFlags write FTraceFlags;
283 >    property UseDefaultSystemCodePage: boolean read FUseDefaultSystemCodePage
284 >                                               write FUseDefaultSystemCodePage;
285 >    property AfterConnect;
286 >    property AfterDisconnect;
287 >    property BeforeConnect;
288 >    property BeforeDisconnect;
289 >    property OnCreateDatabase: TNotifyEvent read FOnCreateDatabase write FOnCreateDatabase;
290 >    property OnLogin: TIBDatabaseLoginEvent read FOnLogin write FOnLogin;
291 >    property OnIdleTimer: TNotifyEvent read FOnIdleTimer write FOnIdleTimer;
292 >    property OnDialectDowngradeWarning: TNotifyEvent read FOnDialectDowngradeWarning write FOnDialectDowngradeWarning;
293 >  end;
294 >
295 >  TDefaultEndAction = TARollback..TACommit;
296 >
297 >  { TIBTransaction }
298 >
299 >  TIBTransaction = class(TComponent)
300 >  private
301 >    FTransactionIntf: ITransaction;
302 >    FAfterDelete: TNotifyEvent;
303 >    FAfterEdit: TNotifyEvent;
304 >    FAfterExecQuery: TNotifyEvent;
305 >    FAfterInsert: TNotifyEvent;
306 >    FAfterPost: TNotifyEvent;
307 >    FAfterTransactionEnd: TNotifyEvent;
308 >    FBeforeTransactionEnd: TNotifyEvent;
309 >    FDatabases          : TList;
310 >    FOnStartTransaction: TNotifyEvent;
311 >    FSQLObjects         : TList;
312 >    FDefaultDatabase    : TIBDatabase;
313 >    FOnIdleTimer          : TNotifyEvent;
314 >    FStreamedActive     : Boolean;
315 >    FTPB                : ITPB;
316 >    FTimer              : TFPTimer;
317 >    FDefaultAction      : TDefaultEndAction;
318 >    FTRParams           : TStrings;
319 >    FTRParamsChanged    : Boolean;
320 >    FInEndTransaction   : boolean;
321 >    FEndAction          : TTransactionAction;
322 >    procedure DoBeforeTransactionEnd;
323 >    procedure DoAfterTransactionEnd;
324 >    procedure DoOnStartTransaction;
325 >    procedure DoAfterExecQuery(Sender: TObject);
326 >    procedure DoAfterEdit(Sender: TObject);
327 >    procedure DoAfterDelete(Sender: TObject);
328 >    procedure DoAfterInsert(Sender: TObject);
329 >    procedure DoAfterPost(Sender: TObject);
330 >    procedure EnsureNotInTransaction;
331 >    procedure EndTransaction(Action: TTransactionAction; Force: Boolean);
332 >    function GetDatabase(Index: Integer): TIBDatabase;
333 >    function GetDatabaseCount: Integer;
334 >    function GetSQLObject(Index: Integer): TIBBase;
335 >    function GetSQLObjectCount: Integer;
336 >    function GetInTransaction: Boolean;
337 >    function GetIdleTimer: Integer;
338 >    procedure BeforeDatabaseDisconnect(DB: TIBDatabase);
339 >    procedure SetActive(Value: Boolean);
340 >    procedure SetDefaultDatabase(Value: TIBDatabase);
341 >    procedure SetIdleTimer(Value: Integer);
342 >    procedure SetTRParams(Value: TStrings);
343 >    procedure TimeoutTransaction(Sender: TObject);
344 >    procedure TRParamsChange(Sender: TObject);
345 >    procedure TRParamsChanging(Sender: TObject);
346 >    function AddSQLObject(ds: TIBBase): Integer;
347 >    procedure RemoveSQLObject(Idx: Integer);
348 >    procedure RemoveSQLObjects;
349 >
350 >  protected
351 >    procedure Loaded; override;
352 >    procedure Notification( AComponent: TComponent; Operation: TOperation); override;
353 >
354 >  public
355 >    constructor Create(AOwner: TComponent); override;
356 >    destructor Destroy; override;
357 >    procedure Commit;
358 >    procedure CommitRetaining;
359 >    procedure Rollback;
360 >    procedure RollbackRetaining;
361 >    procedure StartTransaction;
362 >    procedure CheckInTransaction;
363 >    procedure CheckNotInTransaction;
364 >
365 >    function AddDatabase(db: TIBDatabase): Integer;
366 >    function FindDatabase(db: TIBDatabase): Integer;
367 >    function FindDefaultDatabase: TIBDatabase;
368 >    function GetEndAction: TTransactionAction;
369 >    procedure RemoveDatabase(Idx: Integer);
370 >    procedure RemoveDatabases;
371 >    procedure CheckDatabasesInList;
372 >
373 >    property DatabaseCount: Integer read GetDatabaseCount;
374 >    property Databases[Index: Integer]: TIBDatabase read GetDatabase;
375 >    property SQLObjectCount: Integer read GetSQLObjectCount;
376 >    property SQLObjects[Index: Integer]: TIBBase read GetSQLObject;
377 >    property InTransaction: Boolean read GetInTransaction;
378 >    property TransactionIntf: ITransaction read FTransactionIntf;
379 >    property TPB: ITPB read FTPB;
380 >  published
381 >    property Active: Boolean read GetInTransaction write SetActive;
382 >    property DefaultDatabase: TIBDatabase read FDefaultDatabase
383 >                                           write SetDefaultDatabase;
384 >    property IdleTimer: Integer read GetIdleTimer write SetIdleTimer default 0;
385 >    property DefaultAction: TDefaultEndAction read FDefaultAction write FDefaultAction default taCommit;
386 >    property Params: TStrings read FTRParams write SetTRParams;
387 >    property OnIdleTimer: TNotifyEvent read FOnIdleTimer write FOnIdleTimer;
388 >    property BeforeTransactionEnd: TNotifyEvent read FBeforeTransactionEnd
389 >                                             write FBeforeTransactionEnd;
390 >    property AfterTransactionEnd: TNotifyEvent read FAfterTransactionEnd
391 >                                            write FAfterTransactionEnd;
392 >    property OnStartTransaction: TNotifyEvent read FOnStartTransaction
393 >                                              write FOnStartTransaction;
394 >    property AfterExecQuery: TNotifyEvent read FAfterExecQuery
395 >                                              write FAfterExecQuery;
396 >    property AfterEdit: TNotifyEvent read FAfterEdit write FAfterEdit;
397 >    property AfterDelete: TNotifyEvent read FAfterDelete write FAfterDelete;
398 >    property AfterInsert: TNotifyEvent read FAfterInsert write FAfterInsert;
399 >    property AfterPost: TNotifyEvent read FAfterPost write FAfterPost;
400 >  end;
401 >
402 >  TTransactionEndEvent = procedure(Sender:TObject; Action: TTransactionAction) of object;
403 >  TBeforeDatabaseConnectEvent = procedure (Sender: TObject; DBParams: TStrings;
404 >                              var DBName: string) of object;
405 >
406 >  { TIBBase }
407 >
408 >  { Virtually all components in IB are "descendents" of TIBBase.
409 >    It is to more easily manage the database and transaction
410 >    connections. }
411 >  TIBBase = class(TObject)
412 >  protected
413 >    FBeforeDatabaseConnect: TBeforeDatabaseConnectEvent;
414 >    FDatabase: TIBDatabase;
415 >    FIndexInDatabase: Integer;
416 >    FTransaction: TIBTransaction;
417 >    FIndexInTransaction: Integer;
418 >    FOwner: TObject;
419 >    FBeforeDatabaseDisconnect: TNotifyEvent;
420 >    FAfterDatabaseDisconnect: TNotifyEvent;
421 >    FAfterDatabaseConnect: TNotifyEvent;
422 >    FOnDatabaseFree: TNotifyEvent;
423 >    FBeforeTransactionEnd: TTransactionEndEvent;
424 >    FAfterTransactionEnd: TNotifyEvent;
425 >    FOnTransactionFree: TNotifyEvent;
426 >
427 >    procedure DoBeforeDatabaseConnect(DBParams: TStrings;
428 >                              var DBName: string); virtual;
429 >    procedure DoAfterDatabaseConnect; virtual;
430 >    procedure DoBeforeDatabaseDisconnect; virtual;
431 >    procedure DoAfterDatabaseDisconnect; virtual;
432 >    procedure DoDatabaseFree; virtual;
433 >    procedure DoBeforeTransactionEnd(Action: TTransactionAction); virtual;
434 >    procedure DoAfterTransactionEnd; virtual;
435 >    procedure DoTransactionFree; virtual;
436 >    procedure SetDatabase(Value: TIBDatabase); virtual;
437 >    procedure SetTransaction(Value: TIBTransaction); virtual;
438 >  public
439 >    constructor Create(AOwner: TObject);
440 >    destructor Destroy; override;
441 >    procedure CheckDatabase; virtual;
442 >    procedure CheckTransaction; virtual;
443 >    procedure DoAfterExecQuery(Sender: TObject); virtual;
444 >    procedure DoAfterEdit(Sender: TObject); virtual;
445 >    procedure DoAfterDelete(Sender: TObject); virtual;
446 >    procedure DoAfterInsert(Sender: TObject); virtual;
447 >    procedure DoAfterPost(Sender: TObject); virtual;
448 >    procedure HandleException(Sender: TObject);
449 >    procedure SetCursor;
450 >    procedure RestoreCursor;
451 >  public
452 >    property BeforeDatabaseConnect: TBeforeDatabaseConnectEvent read FBeforeDatabaseConnect
453 >                                                 write FBeforeDatabaseConnect;
454 >    property AfterDatabaseConnect: TNotifyEvent read FAfterDatabaseConnect
455 >                                                write FAfterDatabaseConnect;
456 >    property BeforeDatabaseDisconnect: TNotifyEvent read FBeforeDatabaseDisconnect
457 >                                                   write FBeforeDatabaseDisconnect;
458 >    property AfterDatabaseDisconnect: TNotifyEvent read FAfterDatabaseDisconnect
459 >                                                  write FAfterDatabaseDisconnect;
460 >    property OnDatabaseFree: TNotifyEvent read FOnDatabaseFree write FOnDatabaseFree;
461 >    property BeforeTransactionEnd: TTransactionEndEvent read FBeforeTransactionEnd write FBeforeTransactionEnd;
462 >    property AfterTransactionEnd: TNotifyEvent read FAfterTransactionEnd write FAfterTransactionEnd;
463 >    property OnTransactionFree: TNotifyEvent read FOnTransactionFree write FOnTransactionFree;
464 >    property Database: TIBDatabase read FDatabase
465 >                                    write SetDatabase;
466 >    property Owner: TObject read FOwner;
467 >    property Transaction: TIBTransaction read FTransaction
468 >                                          write SetTransaction;
469 >  end;
470 >
471 > function GenerateDPB(sl: TStrings): IDPB;
472 > function GenerateTPB(sl: TStrings): ITPB;
473 >
474 >
475 > implementation
476 >
477 > uses  IBSQLMonitor, IBCustomDataSet, IBDatabaseInfo, IBSQL, IBUtils,
478 >     typInfo, FBMessages, IBErrorCodes;
479 >
480 > { TIBDatabase }
481 >
482 > constructor TIBDataBase.Create(AOwner: TComponent);
483 > begin
484 >  inherited Create(AOwner);
485 >  LoginPrompt := True;
486 >  FSQLObjects := TList.Create;
487 >  FTransactions := TList.Create;
488 >  FDBName := '';
489 >  FDBParams := TStringList.Create;
490 >  FSQLHourGlass := true;
491 >  if (AOwner <> nil) and
492 >     (AOwner is TCustomApplication) and
493 >     TCustomApplication(AOWner).ConsoleApplication then
494 >    LoginPrompt := false;
495 >  FDBParamsChanged := True;
496 >  TStringList(FDBParams).OnChange := DBParamsChange;
497 >  TStringList(FDBParams).OnChanging := DBParamsChanging;
498 >  FDPB := nil;
499 >  FUserNames := nil;
500 >  FInternalTransaction := TIBTransaction.Create(self);
501 >  FInternalTransaction.DefaultDatabase := Self;
502 >  FTimer := TFPTimer.Create(Self);
503 >  FTimer.Enabled := False;
504 >  FTimer.Interval := 0;
505 >  FTimer.OnTimer := TimeoutConnection;
506 >  FDBSQLDialect := 1;
507 >  FSQLDialect := 3;
508 >  FTraceFlags := [];
509 >  FDataSets := TList.Create;
510 >  CheckStreamConnect;
511 > end;
512 >
513 > destructor TIBDataBase.Destroy;
514 > var
515 >  i: Integer;
516 > begin
517 >  IdleTimer := 0;
518 >  if FAttachment <> nil then
519 >    ForceClose;
520 >  for i := 0 to FSQLObjects.Count - 1 do
521 >    if FSQLObjects[i] <> nil then
522 >      SQLObjects[i].DoDatabaseFree;
523 >  RemoveSQLObjects;
524 >  RemoveTransactions;
525 >  FInternalTransaction.Free;
526 >  FDPB := nil;
527 >  FDBParams.Free;
528 >  FSQLObjects.Free;
529 >  FUserNames.Free;
530 >  FTransactions.Free;
531 >  FDataSets.Free;
532 >  inherited Destroy;
533 > end;
534 >
535 > procedure TIBDataBase.CheckActive;
536 > begin
537 >  if StreamedConnected and (not Connected) then
538 >    Loaded;
539 >  if FAttachment = nil then
540 >    IBError(ibxeDatabaseClosed, [nil]);
541 > end;
542 >
543 > procedure TIBDataBase.EnsureInactive;
544 > begin
545 >  if csDesigning in ComponentState then
546 >  begin
547 >    if FAttachment <> nil then
548 >      Close;
549 >  end
550 > end;
551 >
552 > procedure TIBDataBase.CheckInactive;
553 > begin
554 >  if FAttachment <> nil then
555 >    IBError(ibxeDatabaseOpen, [nil]);
556 > end;
557 >
558 > procedure TIBDataBase.CheckDatabaseName;
559 > begin
560 >  if (Trim(FDBName) = '') then
561 >    IBError(ibxeDatabaseNameMissing, [nil]);
562 > end;
563 >
564 > function TIBDataBase.AddSQLObject(ds: TIBBase): Integer;
565 > begin
566 >  result := 0;
567 >  if (ds.Owner is TIBCustomDataSet) then
568 >    FDataSets.Add(ds.Owner);
569 >  while (result < FSQLObjects.Count) and (FSQLObjects[result] <> nil) do
570 >    Inc(result);
571 >  if (result = FSQLObjects.Count) then
572 >    FSQLObjects.Add(ds)
573 >  else
574 >    FSQLObjects[result] := ds;
575 > end;
576 >
577 > function TIBDataBase.AddTransaction(TR: TIBTransaction): Integer;
578 > begin
579 >  result := FindTransaction(TR);
580 >  if result <> -1 then
581 >  begin
582 >    result := -1;
583 >    exit;
584 >  end;
585 >  result := 0;
586 >  while (result < FTransactions.Count) and (FTransactions[result] <> nil) do
587 >    Inc(result);
588 >  if (result = FTransactions.Count) then
589 >    FTransactions.Add(TR)
590 >  else
591 >    FTransactions[result] := TR;
592 > end;
593 >
594 > procedure TIBDataBase.DoDisconnect;
595 > begin
596 >  if Connected then
597 >    InternalClose(False);
598 >  FDBSQLDialect := 1;
599 >  FDefaultCharSetName := '';
600 >  FDefaultCharSetID := 0;
601 >  FDefaultCodePage := CP_NONE;
602 > end;
603 >
604 >  procedure TIBDataBase.CreateDatabase;
605 > begin
606 >  CheckInactive;
607 >  CheckDatabaseName;
608 >  FCreateDatabase := true;
609 >  Connected := true;
610 > end;
611 >
612 > procedure TIBDataBase.DropDatabase;
613 > begin
614 >  CheckActive;
615 >  FAttachment.DropDatabase;
616 >  FAttachment := nil;
617 > end;
618 >
619 > procedure TIBDataBase.DBParamsChange(Sender: TObject);
620 > begin
621 >  FDBParamsChanged := True;
622 > end;
623 >
624 > procedure TIBDataBase.DBParamsChanging(Sender: TObject);
625 > begin
626 >  EnsureInactive;
627 >  CheckInactive;
628 > end;
629 >
630 > function TIBDataBase.FindTransaction(TR: TIBTransaction): Integer;
631 > var
632 >  i: Integer;
633 > begin
634 >  result := -1;
635 >  for i := 0 to FTransactions.Count - 1 do
636 >    if TR = Transactions[i] then
637 >    begin
638 >      result := i;
639 >      break;
640 >    end;
641 > end;
642 >
643 > function TIBDataBase.FindDefaultTransaction: TIBTransaction;
644 > var
645 >  i: Integer;
646 > begin
647 >  result := FDefaultTransaction;
648 >  if result = nil then
649 >  begin
650 >    for i := 0 to FTransactions.Count - 1 do
651 >      if (Transactions[i] <> nil) and
652 >        (TIBTransaction(Transactions[i]).DefaultDatabase = self) and
653 >        (TIBTransaction(Transactions[i]) <> FInternalTransaction) then
654 >       begin
655 >         result := TIBTransaction(Transactions[i]);
656 >         break;
657 >       end;
658 >  end;
659 > end;
660 >
661 > procedure TIBDataBase.ForceClose;
662 > begin
663 >  if Connected then
664 >    InternalClose(True);
665 > end;
666 >
667 > function TIBDataBase.GetConnected: Boolean;
668 > begin
669 >  result := (FAttachment <> nil) and FAttachment.IsConnected;
670 > end;
671 >
672 > function TIBDataBase.GetSQLObject(Index: Integer): TIBBase;
673 > begin
674 >  result := FSQLObjects[Index];
675 > end;
676 >
677 > function TIBDataBase.GetSQLObjectCount: Integer;
678 > var
679 >  i: Integer;
680 > begin
681 >  result := 0;
682 >  for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then
683 >    Inc(result);
684 > end;
685 >
686 > function TIBDataBase.GetIdleTimer: Integer;
687 > begin
688 >  result := FTimer.Interval;
689 > end;
690 >
691 > function TIBDataBase.GetTransaction(Index: Integer): TIBTransaction;
692 > begin
693 >  result := FTransactions[Index];
694 > end;
695 >
696 > function TIBDataBase.GetTransactionCount: Integer;
697 > var
698 >  i: Integer;
699 > begin
700 >  result := 0;
701 >  for i := 0 to FTransactions.Count - 1 do
702 >    if FTransactions[i] <> nil then
703 >      Inc(result);
704 > end;
705 >
706 > function TIBDataBase.IndexOfDBConst(st: String): Integer;
707 > var
708 >  i, pos_of_str: Integer;
709 > begin
710 >  result := -1;
711 >  for i := 0 to Params.Count - 1 do
712 >  begin
713 >    pos_of_str := Pos(st, AnsiLowerCase(Params[i])); {mbcs ok}
714 >    if (pos_of_str = 1) or (pos_of_str = Length(DPBPrefix) + 1) then
715 >    begin
716 >      result := i;
717 >      break;
718 >    end;
719 >  end;
720 > end;
721 >
722 > procedure TIBDataBase.InternalClose(Force: Boolean);
723 > var
724 >  i: Integer;
725 > begin
726 >  CheckActive;
727 >  { Tell all connected transactions that we're disconnecting.
728 >    This is so transactions can commit/rollback, accordingly
729 >  }
730 >  for i := 0 to FTransactions.Count - 1 do
731 >  begin
732 >    try
733 >      if FTransactions[i] <> nil then
734 >        Transactions[i].BeforeDatabaseDisconnect(Self);
735 >    except
736 >      if not Force then
737 >        raise;
738 >    end;
739 >  end;
740 >  for i := 0 to FSQLObjects.Count - 1 do
741 >  begin
742 >    try
743 >      if FSQLObjects[i] <> nil then
744 >        SQLObjects[i].DoBeforeDatabaseDisconnect;
745 >    except
746 >      if not Force then
747 >        raise;
748 >    end;
749 >  end;
750 >
751 >  FAttachment.Disconnect(Force);
752 >  FAttachment := nil;
753 >
754 >  if not (csDesigning in ComponentState) then
755 >    MonitorHook.DBDisconnect(Self);
756 >
757 >  for i := 0 to FSQLObjects.Count - 1 do
758 >    if FSQLObjects[i] <> nil then
759 >      SQLObjects[i].DoAfterDatabaseDisconnect;
760 > end;
761 >
762 > procedure TIBDataBase.CheckStreamConnect;
763 > var
764 >  i: integer;
765 > begin
766 >  try
767 >    if not (csDesigning in ComponentState) and StreamedConnected and (not Connected) then
768 >    begin
769 >      for i := 0 to FTransactions.Count - 1 do
770 >        if  FTransactions[i] <> nil then
771 >        begin
772 >          with TIBTransaction(FTransactions[i]) do
773 >            if not Active then
774 >              if FStreamedActive and not InTransaction then
775 >              begin
776 >                StartTransaction;
777 >                FStreamedActive := False;
778 >              end;
779 >        end;
780 >      if (FDefaultTransaction <> nil) and
781 >         (FDefaultTransaction.FStreamedActive) and
782 >         (not FDefaultTransaction.InTransaction) then
783 >        FDefaultTransaction.StartTransaction;
784 >      StreamedConnected := False;
785 >    end;
786 >  except
787 >    if csDesigning in ComponentState then
788 >      HandleException(Self)
789 >    else
790 >      raise;
791 >  end;
792 > end;
793 >
794 > procedure TIBDataBase.HandleException(Sender: TObject);
795 > var aParent: TComponent;
796 > begin
797 >  aParent := Owner;
798 >  while aParent <> nil do
799 >  begin
800 >    if aParent is TCustomApplication then
801 >    begin
802 >      TCustomApplication(aParent).HandleException(Sender);
803 >      Exit;
804 >    end;
805 >    aParent := aParent.Owner;
806 >  end;
807 >  SysUtils.ShowException(ExceptObject,ExceptAddr);
808 > end;
809 >
810 > procedure TIBDataBase.Notification(AComponent: TComponent;
811 >   Operation: TOperation);
812 > var
813 >  i: Integer;
814 > begin
815 >  inherited Notification( AComponent, Operation);
816 >  if (Operation = opRemove) and (AComponent = FDefaultTransaction) then
817 >  begin
818 >    i := FindTransaction(FDefaultTransaction);
819 >    if (i <> -1) then
820 >      RemoveTransaction(i);
821 >    FDefaultTransaction := nil;
822 >  end;
823 > end;
824 >
825 > function TIBDataBase.Login(var aDatabaseName: string): Boolean;
826 > var
827 >  IndexOfUser, IndexOfPassword: Integer;
828 >  Username, Password, OldPassword: String;
829 >  LoginParams: TStrings;
830 >
831 >  procedure HidePassword;
832 >  var
833 >    I: Integer;
834 >    IndexAt: Integer;
835 >  begin
836 >    IndexAt := 0;
837 >    for I := 0 to Params.Count -1 do
838 >      if Pos('password', LowerCase(Trim(Params.Names[i]))) = 1 then {mbcs ok}
839 >      begin
840 >        FHiddenPassword := Params.Values[Params.Names[i]];
841 >        IndexAt := I;
842 >        break;
843 >      end;
844 >    if IndexAt <> 0 then
845 >      Params.Delete(IndexAt);
846 >  end;
847 >
848 > begin
849 >  Result := false;
850 >  if FLoginCalled then Exit;
851 >  FLoginCalled := true;
852 >  try
853 >  if Assigned(FOnLogin) and not (csDesigning in ComponentState) then
854 >  begin
855 >    result := True;
856 >    LoginParams := TStringList.Create;
857 >    try
858 >      LoginParams.Assign(Params);
859 >      FOnLogin(Self, LoginParams);
860 >      Params.Assign (LoginParams);
861 >      aDatabaseName := FDBName;
862 >      HidePassword;
863 >    finally
864 >      LoginParams.Free;
865 >    end;
866 >  end
867 >  else
868 >  if assigned(IBGUIInterface) then
869 >  begin
870 >    IndexOfUser := IndexOfDBConst(DPBConstantNames[isc_dpb_user_name]);
871 >    if IndexOfUser <> -1 then
872 >      Username := Copy(Params[IndexOfUser],
873 >                                         Pos('=', Params[IndexOfUser]) + 1, {mbcs ok}
874 >                                         Length(Params[IndexOfUser]));
875 >    IndexOfPassword := IndexOfDBConst(DPBConstantNames[isc_dpb_password]);
876 >    if IndexOfPassword <> -1 then
877 >    begin
878 >      Password := Copy(Params[IndexOfPassword],
879 >                                         Pos('=', Params[IndexOfPassword]) + 1, {mbcs ok}
880 >                                         Length(Params[IndexOfPassword]));
881 >      OldPassword := password;
882 >    end;
883 >
884 >    result := IBGUIInterface.LoginDialogEx(aDatabaseName, Username, Password, False);
885 >    if result then
886 >    begin
887 >      if Username <> '' then
888 >      begin
889 >        if IndexOfUser = -1 then
890 >          Params.Add(DPBConstantNames[isc_dpb_user_name] + '=' + Username)
891 >        else
892 >          Params[IndexOfUser] := DPBConstantNames[isc_dpb_user_name] +
893 >                                 '=' + Username;
894 >      end
895 >      else
896 >      if IndexOfUser <> -1 then
897 >        Params.Delete(IndexOfUser);
898 >      if (Password = OldPassword) then
899 >        FHiddenPassword := ''
900 >      else
901 >      begin
902 >        FHiddenPassword := Password;
903 >        if OldPassword <> '' then
904 >          HidePassword;
905 >      end;
906 >    end;
907 >  end
908 >  else
909 >  if LoginPrompt then
910 >     IBError(ibxeNoLoginDialog,[]);
911 >  finally
912 >    FLoginCalled := false
913 >  end;
914 > end;
915 >
916 > procedure TIBDataBase.DoConnect;
917 > var
918 >  TempDBParams: TStrings;
919 >  I: integer;
920 >  aDBName: string;
921 >  Status: IStatus;
922 >  CharSetID: integer;
923 > begin
924 >  CheckInactive;
925 >  CheckDatabaseName;
926 >  if (not LoginPrompt) and (FHiddenPassword <> '') then
927 >  begin
928 >    FHiddenPassword := '';
929 >    FDBParamsChanged := True;
930 >  end;
931 >  { Use builtin login prompt if requested }
932 >  aDBName := FDBName;
933 >  if (LoginPrompt or (csDesigning in ComponentState)) and not Login(aDBName) then
934 >    IBError(ibxeOperationCancelled, [nil]);
935 >
936 >  TempDBParams := TStringList.Create;
937 >  try
938 >   TempDBParams.Assign(FDBParams);
939 >   if UseDefaultSystemCodePage then
940 >   begin
941 >     {$ifdef WINDOWS}
942 >     if FirebirdAPI.CodePage2CharSetID(GetACP,CharSetID) then
943 >       TempDBParams.Values['lc_ctype'] := FirebirdAPI.GetCharsetName(CharSetID)
944 >     {$else}
945 >     if FirebirdAPI.CodePage2CharSetID(DefaultSystemCodePage,CharSetID) then
946 >       TempDBParams.Values['lc_ctype'] := FirebirdAPI.GetCharsetName(CharSetID)
947 >     {$endif}
948 >     else
949 >       TempDBParams.Values['lc_ctype'] :='UTF8';
950 >   end;
951 >   {Opportunity to override defaults}
952 >   for i := 0 to FSQLObjects.Count - 1 do
953 >   begin
954 >       if FSQLObjects[i] <> nil then
955 >         SQLObjects[i].DoBeforeDatabaseConnect(TempDBParams,aDBName);
956 >   end;
957 >
958 >   FDefaultCharSetName := AnsiUpperCase(TempDBParams.Values['lc_ctype']);
959 >   if FDefaultCharSetName <> '' then
960 >     FirebirdAPI.CharSetName2CharSetID(FDefaultCharSetName,FDefaultCharSetID);
961 >   FirebirdAPI.CharSetID2CodePage(FDefaultCharSetID,FDefaultCodePage);
962 >   { Generate a new DPB if necessary }
963 >   if (FDBParamsChanged or (TempDBParams.Text <> FDBParams.Text)) then
964 >   begin
965 >     FDBParamsChanged := False;
966 >     if (not LoginPrompt and not (csDesigning in ComponentState)) or (FHiddenPassword = '') then
967 >       FDPB := GenerateDPB(TempDBParams)
968 >     else
969 >     begin
970 >        TempDBParams.Add('password=' + FHiddenPassword);
971 >        FDPB := GenerateDPB(TempDBParams);
972 >     end;
973 >   end;
974 >  finally
975 >   TempDBParams.Free;
976 >  end;
977 >
978 >  repeat
979 >    if FCreateDatabase then
980 >    begin
981 >      FCreateDatabase := false;
982 >      FAttachment := FirebirdAPI.CreateDatabase(aDBName,FDPB, false);
983 >      if assigned(FOnCreateDatabase) and (FAttachment <> nil) then
984 >        OnCreateDatabase(self);
985 >    end
986 >    else
987 >      FAttachment := FirebirdAPI.OpenDatabase(aDBName,FDPB,false);
988 >    if FAttachment = nil then
989 >    begin
990 >      Status := FirebirdAPI.GetStatus;
991 >      {$IFDEF UNIX}
992 >      if Pos(':',aDBName) = 0 then
993 >      begin
994 >          if ((Status.GetSQLCode = -901) and (Status.GetIBErrorCode = isc_random)) {Access permissions on firebird temp}
995 >             or
996 >             ((Status.GetSQLCode = -902) and (Status.GetIBErrorCode = isc_sys_request)) {Security DB Problem}
997 >             or
998 >             ((Status.GetSQLCode = -902) and (Status.GetIBErrorCode = isc_psw_attach)) {Security DB Problem}
999 >             or
1000 >             ((Status.GetSQLCode = -904) and (Status.GetIBErrorCode = isc_lock_dir_access)) {Lock File Problem}
1001 >             then
1002 >             begin
1003 >               aDBName := 'localhost:' + aDBName;
1004 >               Continue;
1005 >            end
1006 >      end;
1007 >      {$ENDIF}
1008 >      if ((Status.GetSQLCode = -902) and (Status.GetIBErrorCode = isc_io_error)) {Database not found}
1009 >                       and CreateIfNotExists and not (csDesigning in ComponentState) then
1010 >        FCreateDatabase := true
1011 >      else
1012 >        raise EIBInterBaseError.Create(Status);
1013 >    end;
1014 >  until FAttachment <> nil;
1015 >  if not (csDesigning in ComponentState) then
1016 >    FDBName := aDBName; {Synchronise at run time}
1017 >  FDBSQLDialect := GetDBSQLDialect;
1018 >  ValidateClientSQLDialect;
1019 >  for i := 0 to FSQLObjects.Count - 1 do
1020 >  begin
1021 >      if FSQLObjects[i] <> nil then
1022 >        SQLObjects[i].DoAfterDatabaseConnect;
1023 >  end;
1024 >  if not (csDesigning in ComponentState) then
1025 >    MonitorHook.DBConnect(Self);
1026 > end;
1027 >
1028 > procedure TIBDataBase.RemoveSQLObject(Idx: Integer);
1029 > var
1030 >  ds: TIBBase;
1031 > begin
1032 >  if (Idx >= 0) and (FSQLObjects[Idx] <> nil) then
1033 >  begin
1034 >    ds := SQLObjects[Idx];
1035 >    FSQLObjects[Idx] := nil;
1036 >    ds.Database := nil;
1037 >    if (ds.owner is TDataSet) then
1038 >      FDataSets.Remove(TDataSet(ds.Owner));
1039 >  end;
1040 > end;
1041 >
1042 > procedure TIBDataBase.RemoveSQLObjects;
1043 > var
1044 >  i: Integer;
1045 > begin
1046 >  for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then
1047 >  begin
1048 >    RemoveSQLObject(i);
1049 >    if (TIBBase(FSQLObjects[i]).owner is TDataSet) then
1050 >      FDataSets.Remove(TDataSet(TIBBase(FSQLObjects[i]).owner));
1051 >  end;
1052 > end;
1053 >
1054 > procedure TIBDataBase.RemoveTransaction(Idx: Integer);
1055 > var
1056 >  TR: TIBTransaction;
1057 > begin
1058 >  if ((Idx >= 0) and (FTransactions[Idx] <> nil)) then
1059 >  begin
1060 >    TR := Transactions[Idx];
1061 >    FTransactions[Idx] := nil;
1062 >    TR.RemoveDatabase(TR.FindDatabase(Self));
1063 >    if TR = FDefaultTransaction then
1064 >      FDefaultTransaction := nil;
1065 >  end;
1066 > end;
1067 >
1068 > procedure TIBDataBase.RemoveTransactions;
1069 > var
1070 >  i: Integer;
1071 > begin
1072 >  for i := 0 to FTransactions.Count - 1 do if FTransactions[i] <> nil then
1073 >    RemoveTransaction(i);
1074 > end;
1075 >
1076 > procedure TIBDataBase.SetDatabaseName( const Value: TIBFileName);
1077 > begin
1078 >  if FDBName <> Value then
1079 >  begin
1080 >    EnsureInactive;
1081 >    CheckInactive;
1082 >    FDBName := Value;
1083 >  end;
1084 > end;
1085 >
1086 > procedure TIBDataBase.SetDBParamByDPB( const Idx: Integer; Value: String);
1087 > var
1088 >  ConstIdx: Integer;
1089 > begin
1090 >  ConstIdx := IndexOfDBConst(DPBConstantNames[Idx]);
1091 >  if (Value = '') then
1092 >  begin
1093 >    if ConstIdx <> -1 then
1094 >      Params.Delete(ConstIdx);
1095 >  end
1096 >  else
1097 >  begin
1098 >    if (ConstIdx = -1) then
1099 >      Params.Add(DPBConstantNames[Idx] + '=' + Value)
1100 >    else
1101 >      Params[ConstIdx] := DPBConstantNames[Idx] + '=' + Value;
1102 >  end;
1103 > end;
1104 >
1105 > procedure TIBDataBase.SetDBParams(Value: TStrings);
1106 > begin
1107 >  FDBParams.Assign(Value);
1108 > end;
1109 >
1110 > procedure TIBDataBase.SetDefaultTransaction(Value: TIBTransaction);
1111 > var
1112 >  i: Integer;
1113 > begin
1114 >  if (FDefaultTransaction <> nil) and (FDefaultTransaction <> Value) then
1115 >  begin
1116 >    i := FindTransaction(FDefaultTransaction);
1117 >    if (i <> -1) and (FDefaultTransaction.DefaultDatabase <> self) then
1118 >      RemoveTransaction(i);
1119 >  end;
1120 >  if (Value <> nil) and (FDefaultTransaction <> Value) then
1121 >  begin
1122 >    Value.AddDatabase(Self);
1123 >    AddTransaction(Value);
1124 >  end;
1125 >  FDefaultTransaction := Value;
1126 > end;
1127 >
1128 > procedure TIBDataBase.SetIdleTimer(Value: Integer);
1129 > begin
1130 >  if Value < 0 then
1131 >    IBError(ibxeTimeoutNegative, [nil])
1132 >  else
1133 >    if (Value = 0) then
1134 >    begin
1135 >      FTimer.Enabled := False;
1136 >      FTimer.Interval := 0;
1137 >    end
1138 >    else
1139 >      if (Value > 0) then
1140 >      begin
1141 >        FTimer.Interval := Value;
1142 >        if not (csDesigning in ComponentState) then
1143 >          FTimer.Enabled := True;
1144 >      end;
1145 > end;
1146 >
1147 > function TIBDataBase.TestConnected: Boolean;
1148 > var
1149 >  DatabaseInfo: TIBDatabaseInfo;
1150 > begin
1151 >  result := Connected;
1152 >  if result then
1153 >  begin
1154 >    DatabaseInfo := TIBDatabaseInfo.Create(self);
1155 >    try
1156 >      DatabaseInfo.Database := self;
1157 >      { poke the server to see if connected }
1158 >      if DatabaseInfo.BaseLevel = 0 then ;
1159 >      DatabaseInfo.Free;
1160 >    except
1161 >      ForceClose;
1162 >      result := False;
1163 >      DatabaseInfo.Free;
1164 >    end;
1165 >  end;
1166 > end;
1167 >
1168 > procedure TIBDataBase.TimeoutConnection(Sender: TObject);
1169 > begin
1170 >  if Connected then
1171 >  begin
1172 >    if not FAttachment.HasActivity then
1173 >    begin
1174 >      ForceClose;
1175 >      if Assigned(FOnIdleTimer) then
1176 >        FOnIdleTimer(Self);
1177 >    end
1178 >  end;
1179 > end;
1180 >
1181 > function TIBDataBase.GetIsReadOnly: Boolean;
1182 > var
1183 >  DatabaseInfo: TIBDatabaseInfo;
1184 > begin
1185 >  DatabaseInfo := TIBDatabaseInfo.Create(self);
1186 >  DatabaseInfo.Database := self;
1187 >  if (DatabaseInfo.ODSMajorVersion < 10) then
1188 >    result := false
1189 >  else
1190 >  begin
1191 >    if (DatabaseInfo.ReadOnly = 0) then
1192 >      result := false
1193 >    else
1194 >      result := true;
1195 >  end;
1196 >  DatabaseInfo.Free;
1197 > end;
1198 >
1199 > function TIBDataBase.GetSQLDialect: Integer;
1200 > begin
1201 >  Result := FSQLDialect;
1202 > end;
1203 >
1204 >
1205 > procedure TIBDataBase.SetSQLDialect( const Value: Integer);
1206 > begin
1207 >  if (Value < 1) then IBError(ibxeSQLDialectInvalid, [nil]);
1208 >  if ((FAttachment = nil) or (Value <= FDBSQLDialect))  then
1209 >    FSQLDialect := Value
1210 >  else
1211 >    IBError(ibxeSQLDialectInvalid, [nil]);
1212 > end;
1213 >
1214 > function TIBDataBase.GetDBSQLDialect: Integer;
1215 > var
1216 >  DatabaseInfo: TIBDatabaseInfo;
1217 > begin
1218 >  DatabaseInfo := TIBDatabaseInfo.Create(self);
1219 >  DatabaseInfo.Database := self;
1220 >  result := DatabaseInfo.DBSQLDialect;
1221 >  DatabaseInfo.Free;
1222 > end;
1223 >
1224 > procedure TIBDataBase.ValidateClientSQLDialect;
1225 > begin
1226 >  if (FDBSQLDialect < FSQLDialect) then
1227 >  begin
1228 >    FSQLDialect := FDBSQLDialect;
1229 >    if Assigned (FOnDialectDowngradeWarning) then
1230 >      FOnDialectDowngradeWarning(self);
1231 >  end;
1232 > end;
1233 >
1234 > procedure TIBDataBase.ApplyUpdates( const DataSets: array of TDataSet);
1235 > var
1236 >  I: Integer;
1237 >  DS: TIBCustomDataSet;
1238 >  TR: TIBTransaction;
1239 > begin
1240 >  TR := nil;
1241 >  for I := 0 to High(DataSets) do
1242 >  begin
1243 >    DS := TIBCustomDataSet(DataSets[I]);
1244 >    if DS.Database <> Self then
1245 >      IBError(ibxeUpdateWrongDB, [nil]);
1246 >    if TR = nil then
1247 >      TR := DS.Transaction;
1248 >    if (DS.Transaction <> TR) or (TR = nil) then
1249 >      IBError(ibxeUpdateWrongTR, [nil]);
1250 >  end;
1251 >  TR.CheckInTransaction;
1252 >  for I := 0 to High(DataSets) do
1253 >  begin
1254 >    DS := TIBCustomDataSet(DataSets[I]);
1255 >    DS.ApplyUpdates;
1256 >  end;
1257 >  TR.CommitRetaining;
1258 > end;
1259 >
1260 > procedure TIBDataBase.CloseDataSets;
1261 > var
1262 >  i: Integer;
1263 > begin
1264 >  for i := 0 to DataSetCount - 1 do
1265 >    if (DataSets[i] <> nil) then
1266 >      DataSets[i].close;
1267 > end;
1268 >
1269 > function TIBDataBase.GetDataset(Index: longint): TDataset;
1270 > begin
1271 >  if (Index >= 0) and (Index < FDataSets.Count) then
1272 >    Result := TDataSet(FDataSets[Index])
1273 >  else
1274 >    raise Exception.Create('Invalid Index to DataSets');
1275 > end;
1276 >
1277 > function TIBDataBase.GetDataSetCount: Longint;
1278 > begin
1279 >  Result := FDataSets.Count;
1280 > end;
1281 >
1282 > procedure TIBDataBase.ReadState(Reader: TReader);
1283 > begin
1284 >  FDBParams.Clear;
1285 >  inherited ReadState(Reader);
1286 > end;
1287 >
1288 > procedure TIBDataBase.SetConnected(Value: boolean);
1289 > begin
1290 >  if StreamedConnected and not AllowStreamedConnected then
1291 >  begin
1292 >    StreamedConnected := false;
1293 >    Value := false
1294 >  end;
1295 >  inherited SetConnected(Value);
1296 > end;
1297 >
1298 > procedure TIBDataBase.GetFieldNames( const TableName: string; List: TStrings);
1299 > var
1300 >  Query: TIBSQL;
1301 > begin
1302 >  if TableName = '' then
1303 >    IBError(ibxeNoTableName, [nil]);
1304 >  if not Connected then
1305 >    Open;
1306 >  if not FInternalTransaction.Active then
1307 >    FInternalTransaction.StartTransaction;
1308 >  Query := TIBSQL.Create(self);
1309 >  try
1310 >    Query.GoToFirstRecordOnExecute := False;
1311 >    Query.Database := Self;
1312 >    Query.Transaction := FInternalTransaction;
1313 >    Query.SQL.Text := 'Select R.RDB$FIELD_NAME ' + {do not localize}
1314 >      'from RDB$RELATION_FIELDS R, RDB$FIELDS F ' + {do not localize}
1315 >      'where R.RDB$RELATION_NAME = ' + {do not localize}
1316 >      '''' +
1317 >      FormatIdentifierValue(SQLDialect, TableName) +
1318 >      ''' ' +
1319 >      'and R.RDB$FIELD_SOURCE = F.RDB$FIELD_NAME '; {do not localize}
1320 >    Query.Prepare;
1321 >    Query.ExecQuery;
1322 >    with List do
1323 >    begin
1324 >      BeginUpdate;
1325 >      try
1326 >        Clear;
1327 >        while (not Query.EOF) and Query.Next  do
1328 >          List.Add(TrimRight(Query.FieldByName('RDB$FIELD_NAME').AsString)); {do not localize}
1329 >      finally
1330 >        EndUpdate;
1331 >      end;
1332 >    end;
1333 >  finally
1334 >    Query.free;
1335 >    FInternalTransaction.Commit;
1336 >  end;
1337 > end;
1338 >
1339 > procedure TIBDataBase.GetTableNames(List: TStrings; SystemTables: Boolean);
1340 > var
1341 >  Query : TIBSQL;
1342 > begin
1343 >  if not (csReading in ComponentState) then
1344 >  begin
1345 >    if not Connected then
1346 >      Open;
1347 >    if not FInternalTransaction.Active then
1348 >      FInternalTransaction.StartTransaction;
1349 >    Query := TIBSQL.Create(self);
1350 >    try
1351 >      Query.GoToFirstRecordOnExecute := False;
1352 >      Query.Database := Self;
1353 >      Query.Transaction := FInternalTransaction;
1354 >      if SystemTables then
1355 >        Query.SQL.Text := 'Select RDB$RELATION_NAME from RDB$RELATIONS' + {do not localize}
1356 >                          ' where RDB$VIEW_BLR is NULL' {do not localize}
1357 >      else
1358 >        Query.SQL.Text := 'Select RDB$RELATION_NAME from RDB$RELATIONS' + {do not localize}
1359 >                          ' where RDB$VIEW_BLR is NULL and RDB$SYSTEM_FLAG = 0'; {do not localize}
1360 >      Query.Prepare;
1361 >      Query.ExecQuery;
1362 >      with List do
1363 >      begin
1364 >        BeginUpdate;
1365 >        try
1366 >          Clear;
1367 >          while (not Query.EOF) and Query.Next  do
1368 >            List.Add(TrimRight(Query.Fields[0].AsString));
1369 >        finally
1370 >          EndUpdate;
1371 >        end;
1372 >      end;
1373 >    finally
1374 >      Query.Free;
1375 >      FInternalTransaction.Commit;
1376 >    end;
1377 >  end;
1378 > end;
1379 >
1380 > { TIBTransaction }
1381 >
1382 > constructor TIBTransaction.Create(AOwner: TComponent);
1383 > begin
1384 >  inherited Create(AOwner);
1385 >  FDatabases := TList.Create;
1386 >  FSQLObjects := TList.Create;
1387 >  FTPB := nil;
1388 >  FTRParams := TStringList.Create;
1389 >  FTRParamsChanged := True;
1390 >  TStringList(FTRParams).OnChange := TRParamsChange;
1391 >  TStringList(FTRParams).OnChanging := TRParamsChanging;
1392 >  FTimer := TFPTimer.Create(Self);
1393 >  FTimer.Enabled := False;
1394 >  FTimer.Interval := 0;
1395 >  FTimer.OnTimer := TimeoutTransaction;
1396 >  FDefaultAction := taCommit;
1397 > end;
1398 >
1399 > destructor TIBTransaction.Destroy;
1400 > var
1401 >  i: Integer;
1402 > begin
1403 >  if InTransaction then
1404 >    EndTransaction(FDefaultAction, True);
1405 >  for i := 0 to FSQLObjects.Count - 1 do
1406 >    if FSQLObjects[i] <> nil then
1407 >      SQLObjects[i].DoTransactionFree;
1408 >  RemoveSQLObjects;
1409 >  RemoveDatabases;
1410 >  FTPB := nil;
1411 >  FTRParams.Free;
1412 >  FSQLObjects.Free;
1413 >  FDatabases.Free;
1414 >  inherited Destroy;
1415 > end;
1416 >
1417 > procedure TIBTransaction.CheckDatabasesInList;
1418 > begin
1419 >  if GetDatabaseCount = 0 then
1420 >    IBError(ibxeNoDatabasesInTransaction, [nil]);
1421 > end;
1422 >
1423 > procedure TIBTransaction.CheckInTransaction;
1424 > begin
1425 >  if FStreamedActive and (not InTransaction) then
1426 >    Loaded;
1427 >  if (TransactionIntf = nil) then
1428 >    IBError(ibxeNotInTransaction, [nil]);
1429 > end;
1430 >
1431 > procedure TIBTransaction.DoBeforeTransactionEnd;
1432 > begin
1433 >  if Assigned(FBeforeTransactionEnd) then
1434 >    FBeforeTransactionEnd(self);
1435 > end;
1436 >
1437 > procedure TIBTransaction.DoAfterTransactionEnd;
1438 > begin
1439 >  if Assigned(FAfterTransactionEnd) then
1440 >    FAfterTransactionEnd(self);
1441 > end;
1442 >
1443 > procedure TIBTransaction.DoOnStartTransaction;
1444 > begin
1445 >  if assigned(FOnStartTransaction) then
1446 >    OnStartTransaction(self);
1447 > end;
1448 >
1449 > procedure TIBTransaction.DoAfterExecQuery(Sender: TObject);
1450 > begin
1451 >  if assigned(FAfterExecQuery) then
1452 >    AfterExecQuery(Sender);
1453 > end;
1454 >
1455 > procedure TIBTransaction.DoAfterEdit(Sender: TObject);
1456 > begin
1457 >  if assigned(FAfterEdit) then
1458 >    AfterEdit(Sender);
1459 > end;
1460 >
1461 > procedure TIBTransaction.DoAfterDelete(Sender: TObject);
1462 > begin
1463 >  if assigned(FAfterDelete) then
1464 >    AfterDelete(Sender);
1465 > end;
1466 >
1467 > procedure TIBTransaction.DoAfterInsert(Sender: TObject);
1468 > begin
1469 >  if assigned(FAfterInsert) then
1470 >    AfterInsert(Sender);
1471 > end;
1472 >
1473 > procedure TIBTransaction.DoAfterPost(Sender: TObject);
1474 > begin
1475 >  if assigned(FAfterPost) then
1476 >    AfterPost(Sender);
1477 > end;
1478 >
1479 > procedure TIBTransaction.EnsureNotInTransaction;
1480 > begin
1481 >  if csDesigning in ComponentState then
1482 >  begin
1483 >    if TransactionIntf <> nil then
1484 >      Rollback;
1485 >  end;
1486 > end;
1487 >
1488 > procedure TIBTransaction.CheckNotInTransaction;
1489 > begin
1490 >  if (TransactionIntf <> nil) and  TransactionIntf.InTransaction then
1491 >    IBError(ibxeInTransaction, [nil]);
1492 > end;
1493 >
1494 > function TIBTransaction.AddDatabase(db: TIBDatabase): Integer;
1495 > var
1496 >  i: Integer;
1497 >  NilFound: Boolean;
1498 > begin
1499 >  EnsureNotInTransaction;
1500 >  CheckNotInTransaction;
1501 >  FTransactionIntf := nil;
1502 >
1503 >  i := FindDatabase(db);
1504 >  if i <> -1 then
1505 >  begin
1506 >    result := i;
1507 >    exit;
1508 >  end;
1509 >  NilFound := False;
1510 >  i := 0;
1511 >  while (not NilFound) and (i < FDatabases.Count) do
1512 >  begin
1513 >    NilFound := (FDatabases[i] = nil);
1514 >    if (not NilFound) then
1515 >      Inc(i);
1516 >  end;
1517 >  if (NilFound) then
1518 >  begin
1519 >    FDatabases[i] := db;
1520 >    result := i;
1521 >  end
1522 >  else
1523 >  begin
1524 >    result := FDatabases.Count;
1525 >    FDatabases.Add(db);
1526 >  end;
1527 > end;
1528 >
1529 > function TIBTransaction.AddSQLObject(ds: TIBBase): Integer;
1530 > begin
1531 >  result := 0;
1532 >  while (result < FSQLObjects.Count) and (FSQLObjects[result] <> nil) do
1533 >    Inc(result);
1534 >  if (result = FSQLObjects.Count) then
1535 >    FSQLObjects.Add(ds)
1536 >  else
1537 >    FSQLObjects[result] := ds;
1538 > end;
1539 >
1540 > procedure TIBTransaction.Commit;
1541 > begin
1542 >  EndTransaction(TACommit, False);
1543 > end;
1544 >
1545 > procedure TIBTransaction.CommitRetaining;
1546 > begin
1547 >  EndTransaction(TACommitRetaining, False);
1548 > end;
1549 >
1550 > procedure TIBTransaction.EndTransaction(Action: TTransactionAction;
1551 >  Force: Boolean);
1552 > var
1553 >  i: Integer;
1554 > begin
1555 >  CheckInTransaction;
1556 >  if FInEndTransaction then Exit;
1557 >  FInEndTransaction := true;
1558 >  FEndAction := Action;
1559 >  try
1560 >  case Action of
1561 >    TARollback, TACommit:
1562 >    begin
1563 >      DoBeforeTransactionEnd;
1564 >      for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then
1565 >        SQLObjects[i].DoBeforeTransactionEnd(Action);
1566 >      if InTransaction then
1567 >      begin
1568 >        if (Action = TARollback) then
1569 >            FTransactionIntf.Rollback(Force)
1570 >        else
1571 >        try
1572 >          FTransactionIntf.Commit;
1573 >        except on E: EIBInterBaseError do
1574 >          begin
1575 >            if Force then
1576 >              FTransactionIntf.Rollback(Force)
1577 >            else
1578 >              raise;
1579 >          end;
1580 >        end;
1581 >
1582 >        for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then
1583 >          SQLObjects[i].DoAfterTransactionEnd;
1584 >        DoAfterTransactionEnd;
1585 >      end;
1586 >    end;
1587 >    TACommitRetaining:
1588 >      FTransactionIntf.CommitRetaining;
1589 >
1590 >    TARollbackRetaining:
1591 >      FTransactionIntf.RollbackRetaining;
1592 >  end;
1593 >  if not (csDesigning in ComponentState) then
1594 >  begin
1595 >    case Action of
1596 >      TACommit:
1597 >        MonitorHook.TRCommit(Self);
1598 >      TARollback:
1599 >        MonitorHook.TRRollback(Self);
1600 >      TACommitRetaining:
1601 >        MonitorHook.TRCommitRetaining(Self);
1602 >      TARollbackRetaining:
1603 >        MonitorHook.TRRollbackRetaining(Self);
1604 >    end;
1605 >  end;
1606 >  finally
1607 >    FInEndTransaction := false
1608 >  end;
1609 > end;
1610 >
1611 > function TIBTransaction.GetDatabase(Index: Integer): TIBDatabase;
1612 > begin
1613 >  result := FDatabases[Index];
1614 > end;
1615 >
1616 > function TIBTransaction.GetDatabaseCount: Integer;
1617 > var
1618 >  i, Cnt: Integer;
1619 > begin
1620 >  result := 0;
1621 >  Cnt := FDatabases.Count - 1;
1622 >  for i := 0 to Cnt do if FDatabases[i] <> nil then
1623 >    Inc(result);
1624 > end;
1625 >
1626 > function TIBTransaction.GetSQLObject(Index: Integer): TIBBase;
1627 > begin
1628 >  result := FSQLObjects[Index];
1629 > end;
1630 >
1631 > function TIBTransaction.GetSQLObjectCount: Integer;
1632 > var
1633 >  i, Cnt: Integer;
1634 > begin
1635 >  result := 0;
1636 >  Cnt := FSQLObjects.Count - 1;
1637 >  for i := 0 to Cnt do if FSQLObjects[i] <> nil then
1638 >    Inc(result);
1639 > end;
1640 >
1641 > function TIBTransaction.GetInTransaction: Boolean;
1642 > begin
1643 >  result := (TransactionIntf <> nil) and TransactionIntf.InTransaction;
1644 > end;
1645 >
1646 > function TIBTransaction.FindDatabase(db: TIBDatabase): Integer;
1647 > var
1648 >  i: Integer;
1649 > begin
1650 >  result := -1;
1651 >  for i := 0 to FDatabases.Count - 1 do
1652 >    if db = TIBDatabase(FDatabases[i]) then
1653 >    begin
1654 >      result := i;
1655 >      break;
1656 >    end;
1657 > end;
1658 >
1659 > function TIBTransaction.FindDefaultDatabase: TIBDatabase;
1660 > var
1661 >  i: Integer;
1662 > begin
1663 >  result := FDefaultDatabase;
1664 >  if result = nil then
1665 >  begin
1666 >    for i := 0 to FDatabases.Count - 1 do
1667 >      if (TIBDatabase(FDatabases[i]) <> nil) and
1668 >        (TIBDatabase(FDatabases[i]).DefaultTransaction = self) then
1669 >      begin
1670 >        result := TIBDatabase(FDatabases[i]);
1671 >        break;
1672 >      end;
1673 >  end;
1674 > end;
1675 >
1676 > function TIBTransaction.GetEndAction: TTransactionAction;
1677 > begin
1678 >  if FInEndTransaction then
1679 >     Result := FEndAction
1680 >  else
1681 >     IBError(ibxeIB60feature, [nil])
1682 > end;
1683 >
1684 >
1685 > function TIBTransaction.GetIdleTimer: Integer;
1686 > begin
1687 >  result := FTimer.Interval;
1688 > end;
1689 >
1690 > procedure TIBTransaction.Loaded;
1691 > begin
1692 >  inherited Loaded;
1693 > end;
1694 >
1695 > procedure TIBTransaction.BeforeDatabaseDisconnect(DB: TIBDatabase);
1696 > begin
1697 >  if InTransaction then
1698 >    EndTransaction(FDefaultAction, True);
1699 >  FTransactionIntf := nil;
1700 > end;
1701 >
1702 > procedure TIBTransaction.RemoveDatabase(Idx: Integer);
1703 > var
1704 >  DB: TIBDatabase;
1705 > begin
1706 >  if ((Idx >= 0) and (FDatabases[Idx] <> nil)) then
1707 >  begin
1708 >    EnsureNotInTransaction;
1709 >    CheckNotInTransaction;
1710 >    FTransactionIntf := nil;
1711 >
1712 >    DB := Databases[Idx];
1713 >    FDatabases[Idx] := nil;
1714 >    DB.RemoveTransaction(DB.FindTransaction(Self));
1715 >    if DB = FDefaultDatabase then
1716 >      FDefaultDatabase := nil;
1717 >  end;
1718 > end;
1719 >
1720 > procedure TIBTransaction.RemoveDatabases;
1721 > var
1722 >  i: Integer;
1723 > begin
1724 >  EnsureNotInTransaction;
1725 >  CheckNotInTransaction;
1726 >  FTransactionIntf := nil;
1727 >
1728 >  for i := 0 to FDatabases.Count - 1 do if FDatabases[i] <> nil then
1729 >    RemoveDatabase(i);
1730 > end;
1731 >
1732 > procedure TIBTransaction.RemoveSQLObject(Idx: Integer);
1733 > var
1734 >  ds: TIBBase;
1735 > begin
1736 >  if ((Idx >= 0) and (FSQLObjects[Idx] <> nil)) then
1737 >  begin
1738 >    ds := SQLObjects[Idx];
1739 >    FSQLObjects[Idx] := nil;
1740 >    ds.Transaction := nil;
1741 >  end;
1742 > end;
1743 >
1744 > procedure TIBTransaction.RemoveSQLObjects;
1745 > var
1746 >  i: Integer;
1747 > begin
1748 >  for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then
1749 >    RemoveSQLObject(i);
1750 > end;
1751 >
1752 > procedure TIBTransaction.Rollback;
1753 > begin
1754 >  EndTransaction(TARollback, False);
1755 > end;
1756 >
1757 > procedure TIBTransaction.RollbackRetaining;
1758 > begin
1759 >  EndTransaction(TARollbackRetaining, False);
1760 > end;
1761 >
1762 > procedure TIBTransaction.SetActive(Value: Boolean);
1763 > begin
1764 >  if csReading in ComponentState then
1765 >    FStreamedActive := Value
1766 >  else
1767 >    if Value and not InTransaction then
1768 >      StartTransaction
1769 >    else
1770 >      if not Value and InTransaction then
1771 >        Rollback;
1772 > end;
1773 >
1774 > procedure TIBTransaction.SetDefaultDatabase(Value: TIBDatabase);
1775 > var
1776 >  i: integer;
1777 > begin
1778 >  if (FDefaultDatabase <> nil) and (FDefaultDatabase <> Value) then
1779 >  begin
1780 >    i := FDefaultDatabase.FindTransaction(self);
1781 >    if (i <> -1) then
1782 >      FDefaultDatabase.RemoveTransaction(i);
1783 >  end;
1784 >  if (Value <> nil) and (FDefaultDatabase <> Value) then
1785 >  begin
1786 >    Value.AddTransaction(Self);
1787 >    AddDatabase(Value);
1788 >    for i := 0 to FSQLObjects.Count - 1 do
1789 >      if (FSQLObjects[i] <> nil) and
1790 >         (TIBBase(FSQLObjects[i]).Database = nil) then
1791 >         SetObjectProp(TIBBase(FSQLObjects[i]).Owner, 'Database', Value);
1792 >  end;
1793 >  FDefaultDatabase := Value;
1794 > end;
1795 >
1796 > procedure TIBTransaction.Notification( AComponent: TComponent;
1797 >                                        Operation: TOperation);
1798 > var
1799 >  i: Integer;
1800 > begin
1801 >  inherited Notification( AComponent, Operation);
1802 >  if (Operation = opRemove) and (AComponent = FDefaultDatabase) then
1803 >  begin
1804 >    i := FindDatabase(FDefaultDatabase);
1805 >    if (i <> -1) then
1806 >      RemoveDatabase(i);
1807 >    FDefaultDatabase := nil;
1808 >  end;
1809 > end;
1810 >
1811 > procedure TIBTransaction.SetIdleTimer(Value: Integer);
1812 > begin
1813 >  if Value < 0 then
1814 >    IBError(ibxeTimeoutNegative, [nil])
1815 >  else
1816 >    if (Value = 0) then
1817 >    begin
1818 >      FTimer.Enabled := False;
1819 >      FTimer.Interval := 0;
1820 >    end
1821 >    else
1822 >      if (Value > 0) then
1823 >      begin
1824 >        FTimer.Interval := Value;
1825 >        if not (csDesigning in ComponentState) then
1826 >          FTimer.Enabled := True;
1827 >      end;
1828 > end;
1829 >
1830 > procedure TIBTransaction.SetTRParams(Value: TStrings);
1831 > begin
1832 >  FTRParams.Assign(Value);
1833 > end;
1834 >
1835 > procedure TIBTransaction.StartTransaction;
1836 > var
1837 >  i: Integer;
1838 >  Attachments: array of IAttachment;
1839 >  ValidDatabaseCount: integer;
1840 > begin
1841 >  CheckNotInTransaction;
1842 >  CheckDatabasesInList;
1843 >  if TransactionIntf <> nil then
1844 >  begin
1845 >    TransactionIntf.Start(DefaultAction);
1846 >    Exit;
1847 >  end;
1848 >
1849 >  for i := 0 to FDatabases.Count - 1 do
1850 >   if  FDatabases[i] <> nil then
1851 >   begin
1852 >     with TIBDatabase(FDatabases[i]) do
1853 >     if not Connected then
1854 >       if StreamedConnected then
1855 >       begin
1856 >         Open;
1857 >         StreamedConnected := False;
1858 >       end
1859 >       else
1860 >         IBError(ibxeDatabaseClosed, [nil]);
1861 >   end;
1862 >  if FTRParamsChanged then
1863 >  begin
1864 >    FTRParamsChanged := False;
1865 >    FTPB :=  GenerateTPB(FTRParams);
1866 >  end;
1867 >
1868 >  ValidDatabaseCount := 0;
1869 >  for i := 0 to DatabaseCount - 1 do
1870 >    if Databases[i] <> nil then Inc(ValidDatabaseCount);
1871 >
1872 >  if ValidDatabaseCount = 1 then
1873 >    FTransactionIntf := Databases[0].Attachment.StartTransaction(FTPB,DefaultAction)
1874 >  else
1875 >  begin
1876 >    SetLength(Attachments,ValidDatabaseCount);
1877 >    for i := 0 to DatabaseCount - 1 do
1878 >      if Databases[i] <> nil then
1879 >        Attachments[i] := Databases[i].Attachment;
1880 >
1881 >    FTransactionIntf := FirebirdAPI.StartTransaction(Attachments,FTPB,DefaultAction);
1882 >  end;
1883 >
1884 >  if not (csDesigning in ComponentState) then
1885 >      MonitorHook.TRStart(Self);
1886 >  DoOnStartTransaction;
1887 > end;
1888 >
1889 > procedure TIBTransaction.TimeoutTransaction(Sender: TObject);
1890 > begin
1891 >  if InTransaction then
1892 >  begin
1893 >    if not TransactionIntf.HasActivity then
1894 >    begin
1895 >      EndTransaction(FDefaultAction, True);
1896 >      if Assigned(FOnIdleTimer) then
1897 >        FOnIdleTimer(Self);
1898 >    end
1899 >  end;
1900 > end;
1901 >
1902 > procedure TIBTransaction.TRParamsChange(Sender: TObject);
1903 > begin
1904 >  FTRParamsChanged := True;
1905 > end;
1906 >
1907 > procedure TIBTransaction.TRParamsChanging(Sender: TObject);
1908 > begin
1909 >  EnsureNotInTransaction;
1910 >  CheckNotInTransaction;
1911 >  FTransactionIntf := nil;
1912 > end;
1913 >
1914 > { TIBBase }
1915 > constructor TIBBase.Create(AOwner: TObject);
1916 > begin
1917 >  FOwner := AOwner;
1918 > end;
1919 >
1920 > destructor TIBBase.Destroy;
1921 > begin
1922 >  SetDatabase(nil);
1923 >  SetTransaction(nil);
1924 >  inherited Destroy;
1925 > end;
1926 >
1927 > procedure TIBBase.HandleException(Sender: TObject);
1928 > begin
1929 >  if assigned(Database) then
1930 >     Database.HandleException(Sender)
1931 >  else
1932 >     SysUtils.ShowException(ExceptObject,ExceptAddr);
1933 > end;
1934 >
1935 > procedure TIBBase.SetCursor;
1936 > begin
1937 >  if Assigned(Database) and not Database.SQLHourGlass then
1938 >     Exit;
1939 >  if assigned(IBGUIInterface) then
1940 >     IBGUIInterface.SetCursor;
1941 > end;
1942 >
1943 > procedure TIBBase.RestoreCursor;
1944 > begin
1945 >  if Assigned(Database) and not Database.SQLHourGlass then
1946 >     Exit;
1947 >  if assigned(IBGUIInterface) then
1948 >     IBGUIInterface.RestoreCursor;
1949 > end;
1950 >
1951 > procedure TIBBase.CheckDatabase;
1952 > begin
1953 >  if (FDatabase = nil) then
1954 >    IBError(ibxeDatabaseNotAssigned, [nil]);
1955 >  FDatabase.CheckActive;
1956 > end;
1957 >
1958 > procedure TIBBase.CheckTransaction;
1959 > begin
1960 >  if FTransaction = nil then
1961 >    IBError(ibxeTransactionNotAssigned, [nil]);
1962 >  FTransaction.CheckInTransaction;
1963 > end;
1964 >
1965 > procedure TIBBase.DoBeforeDatabaseConnect(DBParams: TStrings; var DBName: string
1966 >  );
1967 > begin
1968 >  if assigned(FBeforeDatabaseConnect) then
1969 >    BeforeDatabaseConnect(self,DBParams,DBName);
1970 > end;
1971 >
1972 > procedure TIBBase.DoAfterDatabaseConnect;
1973 > begin
1974 >  if assigned(FAfterDatabaseConnect) then
1975 >    AfterDatabaseConnect(self);
1976 > end;
1977 >
1978 > procedure TIBBase.DoBeforeDatabaseDisconnect;
1979 > begin
1980 >  if Assigned(BeforeDatabaseDisconnect) then
1981 >    BeforeDatabaseDisconnect(Self);
1982 > end;
1983 >
1984 > procedure TIBBase.DoAfterDatabaseDisconnect;
1985 > begin
1986 >  if Assigned(AfterDatabaseDisconnect) then
1987 >    AfterDatabaseDisconnect(Self);
1988 > end;
1989 >
1990 > procedure TIBBase.DoDatabaseFree;
1991 > begin
1992 >  if Assigned(OnDatabaseFree) then
1993 >    OnDatabaseFree(Self);
1994 >  SetDatabase(nil);
1995 >  SetTransaction(nil);
1996 > end;
1997 >
1998 > procedure TIBBase.DoBeforeTransactionEnd(Action: TTransactionAction);
1999 > begin
2000 >  if Assigned(BeforeTransactionEnd) then
2001 >    BeforeTransactionEnd(Self,Action);
2002 > end;
2003 >
2004 > procedure TIBBase.DoAfterTransactionEnd;
2005 > begin
2006 >  if Assigned(AfterTransactionEnd) then
2007 >    AfterTransactionEnd(Self);
2008 > end;
2009 >
2010 > procedure TIBBase.DoTransactionFree;
2011 > begin
2012 >  if Assigned(OnTransactionFree) then
2013 >    OnTransactionFree(Self);
2014 >  FTransaction := nil;
2015 > end;
2016 >
2017 > procedure TIBBase.DoAfterExecQuery(Sender: TObject);
2018 > begin
2019 >  if FTransaction <> nil then
2020 >    FTransaction.DoAfterExecQuery(Sender);
2021 > end;
2022 >
2023 > procedure TIBBase.DoAfterEdit(Sender: TObject);
2024 > begin
2025 >  if FTransaction <> nil then
2026 >    FTransaction.DoAfterEdit(Sender);
2027 > end;
2028 >
2029 > procedure TIBBase.DoAfterDelete(Sender: TObject);
2030 > begin
2031 >  if FTransaction <> nil then
2032 >    FTransaction.DoAfterDelete(Sender);
2033 > end;
2034 >
2035 > procedure TIBBase.DoAfterInsert(Sender: TObject);
2036 > begin
2037 >  if FTransaction <> nil then
2038 >    FTransaction.DoAfterInsert(Sender);
2039 > end;
2040 >
2041 > procedure TIBBase.DoAfterPost(Sender: TObject);
2042 > begin
2043 >  if FTransaction <> nil then
2044 >    FTransaction.DoAfterPost(Sender);
2045 > end;
2046 >
2047 > procedure TIBBase.SetDatabase(Value: TIBDatabase);
2048 > begin
2049 >  if (FDatabase <> nil) then
2050 >    FDatabase.RemoveSQLObject(FIndexInDatabase);
2051 >  FDatabase := Value;
2052 >  if (FDatabase <> nil) then
2053 >  begin
2054 >    FIndexInDatabase := FDatabase.AddSQLObject(Self);
2055 >    if (FTransaction = nil) then
2056 >      Transaction := FDatabase.FindDefaultTransaction;
2057 >  end;
2058 > end;
2059 >
2060 > procedure TIBBase.SetTransaction(Value: TIBTransaction);
2061 > begin
2062 >  if (FTransaction <> nil) then
2063 >    FTransaction.RemoveSQLObject(FIndexInTransaction);
2064 >  FTransaction := Value;
2065 >  if (FTransaction <> nil) then
2066 >  begin
2067 >    FIndexInTransaction := FTransaction.AddSQLObject(Self);
2068 >    if (FDatabase = nil) then
2069 >      Database := FTransaction.FindDefaultDatabase;
2070 >  end;
2071 > end;
2072 >
2073 > { GenerateDPB -
2074 >  Given a string containing a textual representation
2075 >  of the database parameters, generate a database
2076 >  parameter buffer, and return it and its length
2077 >  in DPB and DPBLength, respectively. }
2078 >
2079 > function GenerateDPB(sl: TStrings): IDPB;
2080 > var
2081 >  i, j: Integer;
2082 >  DPBVal: UShort;
2083 >  ParamName, ParamValue: string;
2084 > begin
2085 >  Result := FirebirdAPI.AllocateDPB;
2086 >
2087 >  {Iterate through the textual database parameters, constructing
2088 >   a DPB on-the-fly }
2089 >  for i := 0 to sl.Count - 1 do
2090 >  begin
2091 >    { Get the parameter's name and value from the list,
2092 >      and make sure that the name is all lowercase with
2093 >      no leading 'isc_dpb_' prefix
2094 >    }
2095 >    if (Trim(sl.Names[i]) = '') then
2096 >      continue;
2097 >    ParamName := LowerCase(sl.Names[i]); {mbcs ok}
2098 >    ParamValue := Copy(sl[i], Pos('=', sl[i]) + 1, Length(sl[i])); {mbcs ok}
2099 >    if (Pos(DPBPrefix, ParamName) = 1) then {mbcs ok}
2100 >      Delete(ParamName, 1, Length(DPBPrefix));
2101 >     { We want to translate the parameter name to some Integer
2102 >       value. We do this by scanning through a list of known
2103 >       database parameter names (DPBConstantNames, defined above) }
2104 >    DPBVal := 0;
2105 >    { Find the parameter }
2106 >    for j := 1 to isc_dpb_last_dpb_constant do
2107 >      if (ParamName = DPBConstantNames[j]) then
2108 >      begin
2109 >        DPBVal := j;
2110 >        break;
2111 >      end;
2112 >     {  A database parameter either contains a string value (case 1)
2113 >       or an Integer value (case 2)
2114 >       or no value at all (case 3)
2115 >       or an error needs to be generated (case else)  }
2116 >    case DPBVal of
2117 >      isc_dpb_user_name, isc_dpb_password, isc_dpb_password_enc,
2118 >      isc_dpb_sys_user_name, isc_dpb_license, isc_dpb_encrypt_key,
2119 >      isc_dpb_lc_messages, isc_dpb_lc_ctype,
2120 >      isc_dpb_sql_role_name, isc_dpb_sql_dialect:
2121 >      begin
2122 >        if DPBVal = isc_dpb_sql_dialect then
2123 >          ParamValue[1] := Char(Ord(ParamValue[1]) - 48);
2124 >        Result.Add(DPBVal).SetAsString(ParamValue);
2125 >      end;
2126 >
2127 >      isc_dpb_num_buffers, isc_dpb_dbkey_scope, isc_dpb_force_write,
2128 >      isc_dpb_no_reserve, isc_dpb_damaged, isc_dpb_verify:
2129 >        Result.Add(DPBVal).SetAsByte(byte(ParamValue[1]));
2130 >
2131 >      isc_dpb_sweep:
2132 >        Result.Add(DPBVal).SetAsByte(isc_dpb_records);
2133 >
2134 >      isc_dpb_sweep_interval:
2135 >        Result.Add(DPBVal).SetAsInteger(StrToInt(ParamValue));
2136 >
2137 >      isc_dpb_activate_shadow, isc_dpb_delete_shadow, isc_dpb_begin_log,
2138 >      isc_dpb_quit_log:
2139 >        Result.Add(DPBVal).SetAsByte(0);
2140 >      else
2141 >      begin
2142 >        if (DPBVal > 0) and
2143 >           (DPBVal <= isc_dpb_last_dpb_constant) then
2144 >          IBError(ibxeDPBConstantNotSupported, [DPBConstantNames[DPBVal]])
2145 >        else
2146 >          IBError(ibxeDPBConstantUnknownEx, [sl.Names[i]]);
2147 >      end;
2148 >    end;
2149 >  end;
2150 > end;
2151 >
2152 > { GenerateTPB -
2153 >  Given a string containing a textual representation
2154 >  of the transaction parameters, generate a transaction
2155 >  parameter buffer, and return it and its length in
2156 >  TPB and TPBLength, respectively. }
2157 > function GenerateTPB(sl: TStrings): ITPB;
2158 > var
2159 >  i, j, TPBVal: Integer;
2160 >  ParamName, ParamValue: string;
2161 > begin
2162 >  Result := FirebirdAPI.AllocateTPB;
2163 >  for i := 0 to sl.Count - 1 do
2164 >  begin
2165 >    if (Trim(sl[i]) =  '') then
2166 >      Continue;
2167 >
2168 >    if (Pos('=', sl[i]) = 0) then {mbcs ok}
2169 >      ParamName := LowerCase(sl[i]) {mbcs ok}
2170 >    else
2171 >    begin
2172 >      ParamName := LowerCase(sl.Names[i]); {mbcs ok}
2173 >      ParamValue := Copy(sl[i], Pos('=', sl[i]) + 1, Length(sl[i])); {mbcs ok}
2174 >    end;
2175 >    if (Pos(TPBPrefix, ParamName) = 1) then {mbcs ok}
2176 >      Delete(ParamName, 1, Length(TPBPrefix));
2177 >    TPBVal := 0;
2178 >    { Find the parameter }
2179 >    for j := 1 to isc_tpb_last_tpb_constant do
2180 >      if (ParamName = TPBConstantNames[j]) then
2181 >      begin
2182 >        TPBVal := j;
2183 >        break;
2184 >      end;
2185 >    { Now act on it }
2186 >    case TPBVal of
2187 >      isc_tpb_consistency, isc_tpb_exclusive, isc_tpb_protected,
2188 >      isc_tpb_concurrency, isc_tpb_shared, isc_tpb_wait, isc_tpb_nowait,
2189 >      isc_tpb_read, isc_tpb_write, isc_tpb_ignore_limbo,
2190 >      isc_tpb_read_committed, isc_tpb_rec_version, isc_tpb_no_rec_version:
2191 >        Result.Add(TPBVal);
2192 >
2193 >      isc_tpb_lock_read, isc_tpb_lock_write:
2194 >        Result.Add(TPBVal).SetAsString(ParamValue);
2195 >
2196 >      else
2197 >      begin
2198 >        if (TPBVal > 0) and
2199 >           (TPBVal <= isc_tpb_last_tpb_constant) then
2200 >          IBError(ibxeTPBConstantNotSupported, [TPBConstantNames[TPBVal]])
2201 >        else
2202 >          IBError(ibxeTPBConstantUnknownEx, [sl.Names[i]]);
2203 >      end;
2204 >    end;
2205 >  end;
2206 > end;
2207 >
2208 > end.
2209 >
2210 >
2211 >
2212 >
2213 >

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines