ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/IBDatabase.pas
Revision: 35
Committed: Tue Jan 26 14:38:47 2016 UTC (8 years, 2 months ago) by tony
Content type: text/x-pascal
File size: 66668 byte(s)
Log Message:
Committing updates for Release R1-3-2

File Contents

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