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

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines