ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/IBDatabase.pas
Revision: 23
Committed: Fri Mar 13 10:26:52 2015 UTC (9 years ago) by tony
Content type: text/x-pascal
File size: 60949 byte(s)
Log Message:
Committing updates for Release R1-2-1

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