ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/IBDatabase.pas
Revision: 29
Committed: Sat May 9 11:37:49 2015 UTC (8 years, 10 months ago) by tony
Content type: text/x-pascal
File size: 66482 byte(s)
Log Message:
Committing updates for Release R1-2-4

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