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

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines