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 27 by tony, Tue Apr 14 13:10:23 2015 UTC vs.
Revision 47 by tony, Mon Jan 9 15:31:51 2017 UTC

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

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines