ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/IBDataBase.pas
Revision: 1
Committed: Mon Jul 31 16:43:00 2000 UTC (23 years, 8 months ago) by tony
Content type: text/x-pascal
File size: 54530 byte(s)
Log Message:
Borland IBX Open Source Release

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