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

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines