ViewVC Help

View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing

root/public/ibx/trunk/runtime/IBDatabase.pas

Comparing ibx/trunk/runtime/IBDatabase.pas (file contents):
Revision 5 by tony, Fri Feb 18 16:26:16 2011 UTC vs.
Revision 143 by tony, Fri Feb 23 12:11:21 2018 UTC

#	Line 24 | Line 24
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 - 2018                                               }
31	+	{                                                                        }
32		{************************************************************************}
33
34		unit IBDatabase;
35
36		{$Mode Delphi}
37
38	+	{$codepage UTF8}
39	+
40		interface
41
42		uses
43	<	{$IFDEF LINUX }
37	<	unix,
38	<	{$ELSE}
39	<	{$DEFINE HAS_SQLMONITOR}
43	>	{$IFDEF WINDOWS }
44		Windows,
45	+	{$ELSE}
46	+	unix,
47		{$ENDIF}
48	<	Dialogs, Controls, StdCtrls, SysUtils, Classes, Forms, ExtCtrls, IBHeader, IBExternals, DB,
43	<	IB, DBLoginDlg;
48	>	SysUtils, Classes, FPTimer, IBExternals, DB, IB, CustApp, IBTypes;
49
50		const
51		DPBPrefix = 'isc_dpb_';
#	Line 111 | Line 116 | const
116		'set_db_readonly',
117		'set_db_sql_dialect',
118		'gfix_attach',
119	<	'gstat_attach'
120	<	);
119	>	'gstat_attach',
120	>	'set_db_charset',
121	>	'gsec_attach',
122	>	'address_path' ,
123	>	'process_id',
124	>	'no_db_triggers',
125	>	'trusted_auth',
126	>	'process_name',
127	>	'trusted_role',
128	>	'org_filename',
129	>	'utf8_ilename',
130	>	'ext_call_depth',
131	>	'auth_block',
132	>	'client_version',
133	>	'remote_protocol',
134	>	'host_name',
135	>	'os_user',
136	>	'specific_auth_data',
137	>	'auth_plugin_list',
138	>	'auth_plugin_name',
139	>	'config',
140	>	'nolinger',
141	>	'reset_icu',
142	>	'map_attach'
143	>	);
144
145		TPBPrefix = 'isc_tpb_';
146		TPBConstantNames: array[1..isc_tpb_last_tpb_constant] of string = (
#	Line 135 | Line 163 | const
163		'rec_version',
164		'no_rec_version',
165		'restart_requests',
166	<	'no_auto_undo'
166	>	'no_auto_undo',
167	>	'lock_timeout'
168		);
169
170		type
#	Line 151 | Line 180 | type
180		{ TIBDatabase }
181		TIBDataBase = class(TCustomConnection)
182		private
183	+	FAttachment: IAttachment;
184	+	FCreateDatabase: boolean;
185	+	FCreateIfNotExists: boolean;
186	+	FAllowStreamedConnected: boolean;
187		FHiddenPassword: string;
188	<	FIBLoaded: Boolean;
188	>	FOnCreateDatabase: TNotifyEvent;
189		FOnLogin: TIBDatabaseLoginEvent;
190	+	FSQLHourGlass: Boolean;
191		FTraceFlags: TTraceFlags;
158	–	FDBSQLDialect: Integer;
192		FSQLDialect: Integer;
193		FOnDialectDowngradeWarning: TNotifyEvent;
161	–	FCanTimeout: Boolean;
194		FSQLObjects: TList;
195		FTransactions: TList;
196		FDBName: TIBFileName;
197		FDBParams: TStrings;
198		FDBParamsChanged: Boolean;
167	–	FDPB: PChar;
168	–	FDPBLength: Short;
169	–	FHandle: TISC_DB_HANDLE;
170	–	FHandleIsShared: Boolean;
199		FOnIdleTimer: TNotifyEvent;
200		FDefaultTransaction: TIBTransaction;
201		FInternalTransaction: TIBTransaction;
202	<	FStreamedConnected: Boolean;
175	<	FTimer: TTimer;
202	>	FTimer: TFPTimer;
203		FUserNames: TStringList;
204		FDataSets: TList;
205	+	FLoginCalled: boolean;
206	+	FUseDefaultSystemCodePage: boolean;
207		procedure EnsureInactive;
208	+	function GetAuthenticationMethod: string;
209		function GetDBSQLDialect: Integer;
210	<	function GetSQLDialect: Integer;
210	>	function GetDefaultCharSetID: integer;
211	>	function GetDefaultCharSetName: AnsiString;
212	>	function GetDefaultCodePage: TSystemCodePage;
213	>	function GetRemoteProtocol: string;
214		procedure SetSQLDialect(const Value: Integer);
215		procedure ValidateClientSQLDialect;
216		procedure DBParamsChange(Sender: TObject);
217		procedure DBParamsChanging(Sender: TObject);
218		function GetSQLObject(Index: Integer): TIBBase;
219		function GetSQLObjectCount: Integer;
187	–	function GetDBParamByDPB(const Idx: Integer): String;
220		function GetIdleTimer: Integer;
221		function GetTransaction(Index: Integer): TIBTransaction;
222		function GetTransactionCount: Integer;
223	<	function Login: Boolean;
223	>	function Login(var aDatabaseName: string): Boolean;
224		procedure SetDatabaseName(const Value: TIBFileName);
225		procedure SetDBParamByDPB(const Idx: Integer; Value: String);
226		procedure SetDBParams(Value: TStrings);
#	Line 205 | Line 237 | type
237		procedure DoConnect; override;
238		procedure DoDisconnect; override;
239		function GetConnected: Boolean; override;
240	<	procedure Loaded; override;
240	>	procedure CheckStreamConnect;
241	>	procedure HandleException(Sender: TObject);
242		procedure Notification( AComponent: TComponent; Operation: TOperation); override;
243		function GetDataset(Index : longint) : TDataset; override;
244		function GetDataSetCount : Longint; override;
245	<
245	>	procedure ReadState(Reader: TReader); override;
246	>	procedure SetConnected (Value : boolean); override;
247		public
248		constructor Create(AOwner: TComponent); override;
249		destructor Destroy; override;
#	Line 217 | Line 251 | type
251		procedure CloseDataSets;
252		procedure CheckActive;
253		procedure CheckInactive;
254	<	procedure CreateDatabase;
254	>	procedure CreateDatabase; overload;
255	>	procedure CreateDatabase(createDatabaseSQL: string); overload;
256		procedure DropDatabase;
257		procedure ForceClose;
258		procedure GetFieldNames(const TableName: string; List: TStrings);
#	Line 225 | Line 260 | type
260		function IndexOfDBConst(st: String): Integer;
261		function TestConnected: Boolean;
262		procedure CheckDatabaseName;
228	–	function Call(ErrCode: ISC_STATUS; RaiseError: Boolean): ISC_STATUS;
263		function AddTransaction(TR: TIBTransaction): Integer;
264		function FindTransaction(TR: TIBTransaction): Integer;
265		function FindDefaultTransaction(): TIBTransaction;
266		procedure RemoveTransaction(Idx: Integer);
267		procedure RemoveTransactions;
234	–	procedure SetHandle(Value: TISC_DB_HANDLE);
268
269	<	property Handle: TISC_DB_HANDLE read FHandle;
269	>	property Attachment: IAttachment read FAttachment;
270	>	property DBSQLDialect : Integer read GetDBSQLDialect;
271		property IsReadOnly: Boolean read GetIsReadOnly;
238	–	property DBParamByDPB[const Idx: Integer]: String read GetDBParamByDPB
239	–	write SetDBParamByDPB;
272		property SQLObjectCount: Integer read GetSQLObjectCount;
273		property SQLObjects[Index: Integer]: TIBBase read GetSQLObject;
242	–	property HandleIsShared: Boolean read FHandleIsShared;
274		property TransactionCount: Integer read GetTransactionCount;
275		property Transactions[Index: Integer]: TIBTransaction read GetTransaction;
276		property InternalTransaction: TIBTransaction read FInternalTransaction;
277	+	property DefaultCharSetName: AnsiString read GetDefaultCharSetName;
278	+	property DefaultCharSetID: integer read GetDefaultCharSetID;
279	+	property DefaultCodePage: TSystemCodePage read GetDefaultCodePage;
280	+	property AuthenticationMethod: string read GetAuthenticationMethod;
281	+	property RemoteProtocol: string read GetRemoteProtocol;
282
283		published
284		property Connected;
285	<	property StreamedConnected;
285	>	property CreateIfNotExists: boolean read FCreateIfNotExists write FCreateIfNotExists;
286	>	property AllowStreamedConnected: boolean read FAllowStreamedConnected
287	>	write FAllowStreamedConnected;
288		property DatabaseName: TIBFileName read FDBName write SetDatabaseName;
289		property Params: TStrings read FDBParams write SetDBParams;
290		property LoginPrompt default True;
291		property DefaultTransaction: TIBTransaction read FDefaultTransaction
292		write SetDefaultTransaction;
293		property IdleTimer: Integer read GetIdleTimer write SetIdleTimer;
294	<	property SQLDialect : Integer read GetSQLDialect write SetSQLDialect default 3;
295	<	property DBSQLDialect : Integer read FDBSQLDialect;
294	>	property SQLDialect : Integer read FSQLDialect write SetSQLDialect default 3;
295	>	property SQLHourGlass: Boolean read FSQLHourGlass write FSQLHourGlass default true;
296		property TraceFlags: TTraceFlags read FTraceFlags write FTraceFlags;
297	+	property UseDefaultSystemCodePage: boolean read FUseDefaultSystemCodePage
298	+	write FUseDefaultSystemCodePage;
299		property AfterConnect;
300		property AfterDisconnect;
301		property BeforeConnect;
302		property BeforeDisconnect;
303	+	property OnCreateDatabase: TNotifyEvent read FOnCreateDatabase write FOnCreateDatabase;
304		property OnLogin: TIBDatabaseLoginEvent read FOnLogin write FOnLogin;
305		property OnIdleTimer: TNotifyEvent read FOnIdleTimer write FOnIdleTimer;
306		property OnDialectDowngradeWarning: TNotifyEvent read FOnDialectDowngradeWarning write FOnDialectDowngradeWarning;
307		end;
308
309	<	{ TIBTransaction }
309	>	TDefaultEndAction = TARollback..TACommit;
310
311	<	TTransactionAction         = (TARollback, TACommit, TARollbackRetaining, TACommitRetaining);
311	>	{ TIBTransaction }
312
313		TIBTransaction = class(TComponent)
314		private
315	<	FIBLoaded: Boolean;
316	<	FCanTimeout         : Boolean;
315	>	FTransactionIntf: ITransaction;
316	>	FAfterDelete: TNotifyEvent;
317	>	FAfterEdit: TNotifyEvent;
318	>	FAfterExecQuery: TNotifyEvent;
319	>	FAfterInsert: TNotifyEvent;
320	>	FAfterPost: TNotifyEvent;
321	>	FAfterTransactionEnd: TNotifyEvent;
322	>	FBeforeTransactionEnd: TNotifyEvent;
323		FDatabases          : TList;
324	+	FOnStartTransaction: TNotifyEvent;
325		FSQLObjects         : TList;
326		FDefaultDatabase    : TIBDatabase;
279	–	FHandle             : TISC_TR_HANDLE;
280	–	FHandleIsShared     : Boolean;
327		FOnIdleTimer          : TNotifyEvent;
328		FStreamedActive     : Boolean;
329	<	FTPB                : PChar;
330	<	FTPBLength          : Short;
331	<	FTimer              : TTimer;
286	<	FDefaultAction      : TTransactionAction;
329	>	FTPB                : ITPB;
330	>	FTimer              : TFPTimer;
331	>	FDefaultAction      : TDefaultEndAction;
332		FTRParams           : TStrings;
333		FTRParamsChanged    : Boolean;
334	+	FInEndTransaction   : boolean;
335	+	FEndAction          : TTransactionAction;
336	+	procedure DoBeforeTransactionEnd;
337	+	procedure DoAfterTransactionEnd;
338	+	procedure DoOnStartTransaction;
339	+	procedure DoAfterExecQuery(Sender: TObject);
340	+	procedure DoAfterEdit(Sender: TObject);
341	+	procedure DoAfterDelete(Sender: TObject);
342	+	procedure DoAfterInsert(Sender: TObject);
343	+	procedure DoAfterPost(Sender: TObject);
344		procedure EnsureNotInTransaction;
345		procedure EndTransaction(Action: TTransactionAction; Force: Boolean);
346		function GetDatabase(Index: Integer): TIBDatabase;
#	Line 296 | Line 351 | type
351		function GetIdleTimer: Integer;
352		procedure BeforeDatabaseDisconnect(DB: TIBDatabase);
353		procedure SetActive(Value: Boolean);
299	–	procedure SetDefaultAction(Value: TTransactionAction);
354		procedure SetDefaultDatabase(Value: TIBDatabase);
355		procedure SetIdleTimer(Value: Integer);
356		procedure SetTRParams(Value: TStrings);
#	Line 309 | Line 363 | type
363
364		protected
365		procedure Loaded; override;
312	–	procedure SetHandle(Value: TISC_TR_HANDLE);
366		procedure Notification( AComponent: TComponent; Operation: TOperation); override;
367
368		public
369		constructor Create(AOwner: TComponent); override;
370		destructor Destroy; override;
318	–	function Call(ErrCode: ISC_STATUS; RaiseError: Boolean): ISC_STATUS;
371		procedure Commit;
372		procedure CommitRetaining;
373		procedure Rollback;
#	Line 327 | Line 379 | type
379		function AddDatabase(db: TIBDatabase): Integer;
380		function FindDatabase(db: TIBDatabase): Integer;
381		function FindDefaultDatabase: TIBDatabase;
382	+	function GetEndAction: TTransactionAction;
383		procedure RemoveDatabase(Idx: Integer);
384		procedure RemoveDatabases;
385		procedure CheckDatabasesInList;
#	Line 335 | Line 388 | type
388		property Databases[Index: Integer]: TIBDatabase read GetDatabase;
389		property SQLObjectCount: Integer read GetSQLObjectCount;
390		property SQLObjects[Index: Integer]: TIBBase read GetSQLObject;
338	–	property Handle: TISC_TR_HANDLE read FHandle;
339	–	property HandleIsShared: Boolean read FHandleIsShared;
391		property InTransaction: Boolean read GetInTransaction;
392	<	property TPB: PChar read FTPB;
393	<	property TPBLength: Short read FTPBLength;
392	>	property TransactionIntf: ITransaction read FTransactionIntf;
393	>	property TPB: ITPB read FTPB;
394		published
395		property Active: Boolean read GetInTransaction write SetActive;
396		property DefaultDatabase: TIBDatabase read FDefaultDatabase
397		write SetDefaultDatabase;
398		property IdleTimer: Integer read GetIdleTimer write SetIdleTimer default 0;
399	<	property DefaultAction: TTransactionAction read FDefaultAction write SetDefaultAction default taCommit;
399	>	property DefaultAction: TDefaultEndAction read FDefaultAction write FDefaultAction default taCommit;
400		property Params: TStrings read FTRParams write SetTRParams;
401		property OnIdleTimer: TNotifyEvent read FOnIdleTimer write FOnIdleTimer;
402	<	end;
402	>	property BeforeTransactionEnd: TNotifyEvent read FBeforeTransactionEnd
403	>	write FBeforeTransactionEnd;
404	>	property AfterTransactionEnd: TNotifyEvent read FAfterTransactionEnd
405	>	write FAfterTransactionEnd;
406	>	property OnStartTransaction: TNotifyEvent read FOnStartTransaction
407	>	write FOnStartTransaction;
408	>	property AfterExecQuery: TNotifyEvent read FAfterExecQuery
409	>	write FAfterExecQuery;
410	>	property AfterEdit: TNotifyEvent read FAfterEdit write FAfterEdit;
411	>	property AfterDelete: TNotifyEvent read FAfterDelete write FAfterDelete;
412	>	property AfterInsert: TNotifyEvent read FAfterInsert write FAfterInsert;
413	>	property AfterPost: TNotifyEvent read FAfterPost write FAfterPost;
414	>	end;
415	>
416	>	TTransactionEndEvent = procedure(Sender:TObject; Action: TTransactionAction) of object;
417	>	TBeforeDatabaseConnectEvent = procedure (Sender: TObject; DBParams: TStrings;
418	>	var DBName: string) of object;
419
420		{ TIBBase }
421
#	Line 357 | Line 424 | type
424		connections. }
425		TIBBase = class(TObject)
426		protected
427	+	FBeforeDatabaseConnect: TBeforeDatabaseConnectEvent;
428		FDatabase: TIBDatabase;
429		FIndexInDatabase: Integer;
430		FTransaction: TIBTransaction;
#	Line 364 | Line 432 | type
432		FOwner: TObject;
433		FBeforeDatabaseDisconnect: TNotifyEvent;
434		FAfterDatabaseDisconnect: TNotifyEvent;
435	+	FAfterDatabaseConnect: TNotifyEvent;
436		FOnDatabaseFree: TNotifyEvent;
437	<	FBeforeTransactionEnd: TNotifyEvent;
437	>	FBeforeTransactionEnd: TTransactionEndEvent;
438		FAfterTransactionEnd: TNotifyEvent;
439		FOnTransactionFree: TNotifyEvent;
440
441	+	procedure DoBeforeDatabaseConnect(DBParams: TStrings;
442	+	var DBName: string); virtual;
443	+	procedure DoAfterDatabaseConnect; virtual;
444		procedure DoBeforeDatabaseDisconnect; virtual;
445		procedure DoAfterDatabaseDisconnect; virtual;
446		procedure DoDatabaseFree; virtual;
447	<	procedure DoBeforeTransactionEnd; virtual;
447	>	procedure DoBeforeTransactionEnd(Action: TTransactionAction); virtual;
448		procedure DoAfterTransactionEnd; virtual;
449		procedure DoTransactionFree; virtual;
378	–	function GetDBHandle: PISC_DB_HANDLE; virtual;
379	–	function GetTRHandle: PISC_TR_HANDLE; virtual;
450		procedure SetDatabase(Value: TIBDatabase); virtual;
451		procedure SetTransaction(Value: TIBTransaction); virtual;
452		public
#	Line 384 | Line 454 | type
454		destructor Destroy; override;
455		procedure CheckDatabase; virtual;
456		procedure CheckTransaction; virtual;
457	+	procedure DoAfterExecQuery(Sender: TObject); virtual;
458	+	procedure DoAfterEdit(Sender: TObject); virtual;
459	+	procedure DoAfterDelete(Sender: TObject); virtual;
460	+	procedure DoAfterInsert(Sender: TObject); virtual;
461	+	procedure DoAfterPost(Sender: TObject); virtual;
462	+	procedure HandleException(Sender: TObject);
463	+	procedure SetCursor;
464	+	procedure RestoreCursor;
465		public
466	+	property BeforeDatabaseConnect: TBeforeDatabaseConnectEvent read FBeforeDatabaseConnect
467	+	write FBeforeDatabaseConnect;
468	+	property AfterDatabaseConnect: TNotifyEvent read FAfterDatabaseConnect
469	+	write FAfterDatabaseConnect;
470		property BeforeDatabaseDisconnect: TNotifyEvent read FBeforeDatabaseDisconnect
471		write FBeforeDatabaseDisconnect;
472		property AfterDatabaseDisconnect: TNotifyEvent read FAfterDatabaseDisconnect
473		write FAfterDatabaseDisconnect;
474		property OnDatabaseFree: TNotifyEvent read FOnDatabaseFree write FOnDatabaseFree;
475	<	property BeforeTransactionEnd: TNotifyEvent read FBeforeTransactionEnd write FBeforeTransactionEnd;
475	>	property BeforeTransactionEnd: TTransactionEndEvent read FBeforeTransactionEnd write FBeforeTransactionEnd;
476		property AfterTransactionEnd: TNotifyEvent read FAfterTransactionEnd write FAfterTransactionEnd;
477		property OnTransactionFree: TNotifyEvent read FOnTransactionFree write FOnTransactionFree;
478		property Database: TIBDatabase read FDatabase
479		write SetDatabase;
398	–	property DBHandle: PISC_DB_HANDLE read GetDBHandle;
480		property Owner: TObject read FOwner;
400	–	property TRHandle: PISC_TR_HANDLE read GetTRHandle;
481		property Transaction: TIBTransaction read FTransaction
482		write SetTransaction;
483		end;
484
485	<	procedure GenerateDPB(sl: TStrings; var DPB: string; var DPBLength: Short);
486	<	procedure GenerateTPB(sl: TStrings; var TPB: string; var TPBLength: Short);
485	>	function GenerateDPB(sl: TStrings): IDPB;
486	>	function GenerateTPB(sl: TStrings): ITPB;
487
488
489		implementation
490
491	<	uses IBIntf,{$IFDEF HAS_SQLMONITOR}IBSQLMonitor,{$ENDIF} IBCustomDataSet, IBDatabaseInfo, IBSQL, IBUtils, typInfo;
491	>	uses  IBSQLMonitor, IBCustomDataSet, IBDatabaseInfo, IBSQL, IBUtils,
492	>	typInfo, FBMessages, IBErrorCodes {$IFDEF WINDOWS}, Windirs {$ENDIF};
493
494		{ TIBDatabase }
495
496	<	constructor TIBDatabase.Create(AOwner: TComponent);
496	>	constructor TIBDataBase.Create(AOwner: TComponent);
497		begin
498		inherited Create(AOwner);
418	–	FIBLoaded := False;
419	–	CheckIBLoaded;
420	–	FIBLoaded := True;
499		LoginPrompt := True;
500		FSQLObjects := TList.Create;
501		FTransactions := TList.Create;
502		FDBName := '';
503		FDBParams := TStringList.Create;
504	+	FSQLHourGlass := true;
505	+	if (AOwner <> nil) and
506	+	(AOwner is TCustomApplication) and
507	+	TCustomApplication(AOWner).ConsoleApplication then
508	+	LoginPrompt := false;
509		FDBParamsChanged := True;
510		TStringList(FDBParams).OnChange := DBParamsChange;
511		TStringList(FDBParams).OnChanging := DBParamsChanging;
429	–	FDPB := nil;
430	–	FHandle := nil;
512		FUserNames := nil;
513		FInternalTransaction := TIBTransaction.Create(self);
514		FInternalTransaction.DefaultDatabase := Self;
515	<	FTimer := TTimer.Create(Self);
515	>	FTimer := TFPTimer.Create(Self);
516		FTimer.Enabled := False;
517		FTimer.Interval := 0;
518		FTimer.OnTimer := TimeoutConnection;
438	–	FDBSQLDialect := 1;
519		FSQLDialect := 3;
520		FTraceFlags := [];
521		FDataSets := TList.Create;
522	+	CheckStreamConnect;
523		end;
524
525	<	destructor TIBDatabase.Destroy;
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;
461	<	FDBParams.Free;
462	<	FSQLObjects.Free;
463	<	FUserNames.Free;
464	<	FTransactions.Free;
465	<	end;
529	>	IdleTimer := 0;
530	>	if FAttachment <> nil then
531	>	ForceClose;
532	>	for i := 0 to FSQLObjects.Count - 1 do
533	>	if FSQLObjects[i] <> nil then
534	>	SQLObjects[i].DoDatabaseFree;
535	>	RemoveSQLObjects;
536	>	RemoveTransactions;
537	>	FInternalTransaction.Free;
538	>	FDBParams.Free;
539	>	FSQLObjects.Free;
540	>	FUserNames.Free;
541	>	FTransactions.Free;
542		FDataSets.Free;
543		inherited Destroy;
544		end;
545
546	<	function TIBDatabase.Call(ErrCode: ISC_STATUS;
471	<	RaiseError: Boolean): ISC_STATUS;
472	<	begin
473	<	result := ErrCode;
474	<	FCanTimeout := False;
475	<	if RaiseError and (ErrCode > 0) then
476	<	IBDataBaseError;
477	<	end;
478	<
479	<	procedure TIBDatabase.CheckActive;
546	>	procedure TIBDataBase.CheckActive;
547		begin
548		if StreamedConnected and (not Connected) then
549		Loaded;
550	<	if FHandle = nil then
550	>	if FAttachment = nil then
551		IBError(ibxeDatabaseClosed, [nil]);
552		end;
553
554	<	procedure TIBDatabase.EnsureInactive;
554	>	procedure TIBDataBase.EnsureInactive;
555		begin
556		if csDesigning in ComponentState then
557		begin
558	<	if FHandle <> nil then
558	>	if FAttachment <> nil then
559		Close;
560		end
561		end;
562
563	<	procedure TIBDatabase.CheckInactive;
563	>	function TIBDataBase.GetAuthenticationMethod: string;
564	>	begin
565	>	CheckActive;
566	>	Result := Attachment.GetAuthenticationMethod;
567	>	end;
568	>
569	>	procedure TIBDataBase.CheckInactive;
570		begin
571	<	if FHandle <> nil then
571	>	if FAttachment <> nil then
572		IBError(ibxeDatabaseOpen, [nil]);
573		end;
574
575	<	procedure TIBDatabase.CheckDatabaseName;
575	>	procedure TIBDataBase.CheckDatabaseName;
576		begin
577	<	if (FDBName = '') then
577	>	if (Trim(FDBName) = '') then
578		IBError(ibxeDatabaseNameMissing, [nil]);
579		end;
580
581	<	function TIBDatabase.AddSQLObject(ds: TIBBase): Integer;
581	>	function TIBDataBase.AddSQLObject(ds: TIBBase): Integer;
582		begin
583		result := 0;
584		if (ds.Owner is TIBCustomDataSet) then
585	<	{$IFDEF LINUX}
513	<	FDataSets.Add(TDataSet(ds.Owner));
514	<	{$ELSE}
515	<	RegisterClient(TDataSet(ds.Owner));
516	<	{$ENDIF}
585	>	FDataSets.Add(ds.Owner);
586		while (result < FSQLObjects.Count) and (FSQLObjects[result] <> nil) do
587		Inc(result);
588		if (result = FSQLObjects.Count) then
#	Line 522 | Line 591 | begin
591		FSQLObjects[result] := ds;
592		end;
593
594	<	function TIBDatabase.AddTransaction(TR: TIBTransaction): Integer;
594	>	function TIBDataBase.AddTransaction(TR: TIBTransaction): Integer;
595		begin
596		result := FindTransaction(TR);
597		if result <> -1 then
#	Line 539 | Line 608 | begin
608		FTransactions[result] := TR;
609		end;
610
611	<	procedure TIBDatabase.DoDisconnect;
611	>	procedure TIBDataBase.DoDisconnect;
612		begin
613		if Connected then
614		InternalClose(False);
546	–	FDBSQLDialect := 1;
615		end;
616
617	<	procedure TIBDatabase.CreateDatabase;
550	<	var
551	<	tr_handle: TISC_TR_HANDLE;
617	>	procedure TIBDataBase.CreateDatabase;
618		begin
619		CheckInactive;
620	<	tr_handle := nil;
621	<	Call(
622	<	isc_dsql_execute_immediate(StatusVector, @FHandle, @tr_handle, 0,
557	<	PChar('CREATE DATABASE ''' + FDBName + ''' ' + {do not localize}
558	<	Params.Text), SQLDialect, nil),
559	<	True);
620	>	CheckDatabaseName;
621	>	FCreateDatabase := true;
622	>	Connected := true;
623		end;
624
625	<	procedure TIBDatabase.DropDatabase;
625	>	procedure TIBDataBase.CreateDatabase(createDatabaseSQL: string);
626	>	begin
627	>	CheckInactive;
628	>	FAttachment := FirebirdAPI.CreateDatabase(createDatabaseSQL,SQLDialect);
629	>	FDBName := Attachment.GetConnectString;
630	>	if assigned(FOnCreateDatabase) and (FAttachment <> nil) then
631	>	OnCreateDatabase(self);
632	>	end;
633	>
634	>	procedure TIBDataBase.DropDatabase;
635		begin
636		CheckActive;
637	<	Call(isc_drop_database(StatusVector, @FHandle), True);
637	>	FAttachment.DropDatabase;
638	>	FAttachment := nil;
639		end;
640
641	<	procedure TIBDatabase.DBParamsChange(Sender: TObject);
641	>	procedure TIBDataBase.DBParamsChange(Sender: TObject);
642		begin
643		FDBParamsChanged := True;
644		end;
645
646	<	procedure TIBDatabase.DBParamsChanging(Sender: TObject);
646	>	procedure TIBDataBase.DBParamsChanging(Sender: TObject);
647		begin
648		EnsureInactive;
649		CheckInactive;
650		end;
651
652	<	function TIBDatabase.FindTransaction(TR: TIBTransaction): Integer;
652	>	function TIBDataBase.FindTransaction(TR: TIBTransaction): Integer;
653		var
654		i: Integer;
655		begin
#	Line 589 | Line 662 | begin
662		end;
663		end;
664
665	<	function TIBDatabase.FindDefaultTransaction(): TIBTransaction;
665	>	function TIBDataBase.FindDefaultTransaction(): TIBTransaction;
666		var
667		i: Integer;
668		begin
#	Line 607 | Line 680 | begin
680		end;
681		end;
682
683	<	procedure TIBDatabase.ForceClose;
683	>	procedure TIBDataBase.ForceClose;
684		begin
685		if Connected then
686		InternalClose(True);
687		end;
688
689	<	function TIBDatabase.GetConnected: Boolean;
689	>	function TIBDataBase.GetConnected: Boolean;
690		begin
691	<	result := FHandle <> nil;
691	>	result := (FAttachment <> nil) and FAttachment.IsConnected;
692		end;
693
694	<	function TIBDatabase.GetSQLObject(Index: Integer): TIBBase;
694	>	function TIBDataBase.GetSQLObject(Index: Integer): TIBBase;
695		begin
696		result := FSQLObjects[Index];
697		end;
698
699	<	function TIBDatabase.GetSQLObjectCount: Integer;
699	>	function TIBDataBase.GetSQLObjectCount: Integer;
700		var
701		i: Integer;
702		begin
#	Line 632 | Line 705 | begin
705		Inc(result);
706		end;
707
708	<	function TIBDatabase.GetDBParamByDPB(const Idx: Integer): String;
636	<	var
637	<	ConstIdx, EqualsIdx: Integer;
638	<	begin
639	<	if (Idx > 0) and (Idx <= isc_dpb_last_dpb_constant) then
640	<	begin
641	<	ConstIdx := IndexOfDBConst(DPBConstantNames[Idx]);
642	<	if ConstIdx = -1 then
643	<	result := ''
644	<	else
645	<	begin
646	<	result := Params[ConstIdx];
647	<	EqualsIdx := Pos('=', result); {mbcs ok}
648	<	if EqualsIdx = 0 then
649	<	result := ''
650	<	else
651	<	result := Copy(result, EqualsIdx + 1, Length(result));
652	<	end;
653	<	end
654	<	else
655	<	result := '';
656	<	end;
657	<
658	<	function TIBDatabase.GetIdleTimer: Integer;
708	>	function TIBDataBase.GetIdleTimer: Integer;
709		begin
710		result := FTimer.Interval;
711		end;
712
713	<	function TIBDatabase.GetTransaction(Index: Integer): TIBTransaction;
713	>	function TIBDataBase.GetTransaction(Index: Integer): TIBTransaction;
714		begin
715		result := FTransactions[Index];
716		end;
717
718	<	function TIBDatabase.GetTransactionCount: Integer;
718	>	function TIBDataBase.GetTransactionCount: Integer;
719		var
720		i: Integer;
721		begin
#	Line 675 | Line 725 | begin
725		Inc(result);
726		end;
727
728	<	function TIBDatabase.IndexOfDBConst(st: String): Integer;
728	>	function TIBDataBase.IndexOfDBConst(st: String): Integer;
729		var
730		i, pos_of_str: Integer;
731		begin
#	Line 691 | Line 741 | begin
741		end;
742		end;
743
744	<	procedure TIBDatabase.InternalClose(Force: Boolean);
744	>	procedure TIBDataBase.InternalClose(Force: Boolean);
745		var
746		i: Integer;
747		begin
#	Line 720 | Line 770 | begin
770		end;
771		end;
772
773	<	if (not HandleIsShared) and
774	<	(Call(isc_detach_database(StatusVector, @FHandle), False) > 0) and
725	<	(not Force) then
726	<	IBDataBaseError
727	<	else
728	<	begin
729	<	FHandle := nil;
730	<	FHandleIsShared := False;
731	<	end;
773	>	FAttachment.Disconnect(Force);
774	>	FAttachment := nil;
775
733	–	{$IFDEF HAS_SQLMONITOR}
776		if not (csDesigning in ComponentState) then
777		MonitorHook.DBDisconnect(Self);
736	–	{$ENDIF}
778
779		for i := 0 to FSQLObjects.Count - 1 do
780		if FSQLObjects[i] <> nil then
781		SQLObjects[i].DoAfterDatabaseDisconnect;
782		end;
783
784	<	procedure TIBDatabase.Loaded;
784	>	procedure TIBDataBase.CheckStreamConnect;
785		var
786		i: integer;
787		begin
788		try
789	<	if StreamedConnected and (not Connected) then
789	>	if not (csDesigning in ComponentState) and StreamedConnected and (not Connected) then
790		begin
750	–	inherited Loaded;
791		for i := 0 to FTransactions.Count - 1 do
792		if  FTransactions[i] <> nil then
793		begin
#	Line 763 | Line 803 | begin
803		(FDefaultTransaction.FStreamedActive) and
804		(not FDefaultTransaction.InTransaction) then
805		FDefaultTransaction.StartTransaction;
806	<	FStreamedConnected := False;
806	>	StreamedConnected := False;
807		end;
808		except
809		if csDesigning in ComponentState then
810	<	Application.HandleException(Self)
810	>	HandleException(Self)
811		else
812		raise;
813		end;
814		end;
815
816	<	procedure TIBDatabase.Notification( AComponent: TComponent;
817	<	Operation: TOperation);
816	>	procedure TIBDataBase.HandleException(Sender: TObject);
817	>	var aParent: TComponent;
818	>	begin
819	>	aParent := Owner;
820	>	while aParent <> nil do
821	>	begin
822	>	if aParent is TCustomApplication then
823	>	begin
824	>	TCustomApplication(aParent).HandleException(Sender);
825	>	Exit;
826	>	end;
827	>	aParent := aParent.Owner;
828	>	end;
829	>	SysUtils.ShowException(ExceptObject,ExceptAddr);
830	>	end;
831	>
832	>	procedure TIBDataBase.Notification(AComponent: TComponent;
833	>	Operation: TOperation);
834		var
835		i: Integer;
836		begin
#	Line 788 | Line 844 | begin
844		end;
845		end;
846
847	<	function TIBDatabase.Login: Boolean;
847	>	function TIBDataBase.Login(var aDatabaseName: string): Boolean;
848		var
849		IndexOfUser, IndexOfPassword: Integer;
850		Username, Password, OldPassword: String;
#	Line 812 | Line 868 | var
868		end;
869
870		begin
871	<	if Assigned(FOnLogin) then
871	>	Result := false;
872	>	if FLoginCalled then Exit;
873	>	FLoginCalled := true;
874	>	try
875	>	if Assigned(FOnLogin) and not (csDesigning in ComponentState) then
876		begin
877		result := True;
878		LoginParams := TStringList.Create;
#	Line 820 | Line 880 | begin
880		LoginParams.Assign(Params);
881		FOnLogin(Self, LoginParams);
882		Params.Assign (LoginParams);
883	+	aDatabaseName := FDBName;
884		HidePassword;
885		finally
886		LoginParams.Free;
887		end;
888		end
889		else
890	+	if assigned(IBGUIInterface) then
891		begin
892		IndexOfUser := IndexOfDBConst(DPBConstantNames[isc_dpb_user_name]);
893		if IndexOfUser <> -1 then
#	Line 840 | Line 902 | begin
902		Length(Params[IndexOfPassword]));
903		OldPassword := password;
904		end;
905	<	result := LoginDialogEx(DatabaseName, Username, Password, False);
905	>
906	>	result := IBGUIInterface.LoginDialogEx(aDatabaseName, Username, Password, False);
907		if result then
908		begin
909	<	if IndexOfUser = -1 then
910	<	Params.Add(DPBConstantNames[isc_dpb_user_name] + '=' + Username)
911	<	else
912	<	Params[IndexOfUser] := DPBConstantNames[isc_dpb_user_name] +
909	>	if Username <> '' then
910	>	begin
911	>	if IndexOfUser = -1 then
912	>	Params.Add(DPBConstantNames[isc_dpb_user_name] + '=' + Username)
913	>	else
914	>	Params[IndexOfUser] := DPBConstantNames[isc_dpb_user_name] +
915		'=' + Username;
916	+	end
917	+	else
918	+	if IndexOfUser <> -1 then
919	+	Params.Delete(IndexOfUser);
920		if (Password = OldPassword) then
921		FHiddenPassword := ''
922		else
#	Line 857 | Line 926 | begin
926		HidePassword;
927		end;
928		end;
929	+	end
930	+	else
931	+	if LoginPrompt then
932	+	IBError(ibxeNoLoginDialog,[]);
933	+	finally
934	+	FLoginCalled := false
935		end;
936		end;
937
938	<	procedure TIBDatabase.DoConnect;
938	>	procedure TIBDataBase.DoConnect;
939	>
940	>	function ExpandDBName(aDBName: string): string;
941	>	const
942	>	TmpPrefix = '$TEMP$';
943	>	DataPrefix = '$DATADIR$';
944	>	var
945	>	LocalDirName: string;
946	>	begin
947	>	if Pos(TmpPrefix,aDBName) = 1 then
948	>	begin
949	>	system.Delete(aDBName,1,Length(TmpPrefix));
950	>	Result := GetTempDir + aDBName
951	>	end
952	>	else
953	>	if Pos(DataPrefix,aDBName) = 1 then
954	>	begin
955	>	system.Delete(aDBName,1,Length(DataPrefix));
956	>	if Sysutils.VendorName <> '' then
957	>	LocalDirName :=  Sysutils.VendorName
958	>	else
959	>	LocalDirName :=  'IBX';
960	>	{$IFDEF UNIX}
961	>	LocalDirName := GetUserDir + '.' + LocalDirName;
962	>	{$ENDIF}
963	>	{$IFDEF WINDOWS}
964	>	LocalDirName := GetWindowsSpecialDir(CSIDL_LOCAL_APPDATA) + LocalDirName;
965	>	{$ENDIF}
966	>	CreateDir(LocalDirName);
967	>	Result := LocalDirName + DirectorySeparator + aDBName;
968	>	end
969	>	else
970	>	Result := aDBName;
971	>	end;
972	>
973		var
865	–	DPB: String;
974		TempDBParams: TStrings;
975	<
975	>	I: integer;
976	>	aDBName: string;
977	>	Status: IStatus;
978	>	CharSetID: integer;
979	>	CharSetName: AnsiString;
980	>	DPB: IDPB;
981	>	PW: IDPBItem;
982		begin
983	+	DPB := nil;
984		CheckInactive;
985		CheckDatabaseName;
986		if (not LoginPrompt) and (FHiddenPassword <> '') then
#	Line 874 | Line 989 | begin
989		FDBParamsChanged := True;
990		end;
991		{ Use builtin login prompt if requested }
992	<	if LoginPrompt and not Login then
992	>	aDBName := ExpandDBName(FDBName);
993	>
994	>	if (LoginPrompt or (csDesigning in ComponentState)) and not Login(aDBName) then
995		IBError(ibxeOperationCancelled, [nil]);
996	<	{ Generate a new DPB if necessary }
997	<	if (FDBParamsChanged) then
998	<	begin
999	<	FDBParamsChanged := False;
1000	<	if (not LoginPrompt) or (FHiddenPassword = '') then
1001	<	GenerateDPB(FDBParams, DPB, FDPBLength)
1002	<	else
1003	<	begin
1004	<	TempDBParams := TStringList.Create;
1005	<	try
1006	<	TempDBParams.Assign(FDBParams);
1007	<	TempDBParams.Add('password=' + FHiddenPassword);
1008	<	GenerateDPB(TempDBParams, DPB, FDPBLength);
1009	<	finally
1010	<	TempDBParams.Free;
1011	<	end;
1012	<	end;
1013	<	IBAlloc(FDPB, 0, FDPBLength);
1014	<	Move(DPB[1], FDPB[0], FDPBLength);
996	>
997	>	TempDBParams := TStringList.Create;
998	>	try
999	>	TempDBParams.Assign(FDBParams);
1000	>	{$ifdef UNIX}
1001	>	{See below for WINDOWS UseDefaultSystemCodePage}
1002	>	if UseDefaultSystemCodePage then
1003	>	TempDBParams.Values['lc_ctype'] :='UTF8';
1004	>	{$endif}
1005	>	{Opportunity to override defaults}
1006	>	for i := 0 to FSQLObjects.Count - 1 do
1007	>	begin
1008	>	if FSQLObjects[i] <> nil then
1009	>	SQLObjects[i].DoBeforeDatabaseConnect(TempDBParams,aDBName);
1010	>	end;
1011	>
1012	>	repeat
1013	>	{ Generate a new DPB if necessary }
1014	>	if (DPB = nil) or FDBParamsChanged or (TempDBParams.Text <> FDBParams.Text) then
1015	>	begin
1016	>	FDBParamsChanged := False;
1017	>	if (not LoginPrompt and not (csDesigning in ComponentState)) or (FHiddenPassword = '') then
1018	>	DPB := GenerateDPB(TempDBParams)
1019	>	else
1020	>	begin
1021	>	TempDBParams.Values['password'] := FHiddenPassword;
1022	>	DPB := GenerateDPB(TempDBParams);
1023	>	end;
1024	>	end;
1025	>
1026	>	if FCreateDatabase then
1027	>	begin
1028	>	FCreateDatabase := false;
1029	>	DPB.Add(isc_dpb_set_db_SQL_dialect).AsByte := SQLDialect; {create with this SQL Dialect}
1030	>	FAttachment := FirebirdAPI.CreateDatabase(aDBName,DPB, false);
1031	>	if FAttachment = nil then
1032	>	DPB := nil;
1033	>	if assigned(FOnCreateDatabase) and (FAttachment <> nil) then
1034	>	OnCreateDatabase(self);
1035	>	end
1036	>	else
1037	>	FAttachment := FirebirdAPI.OpenDatabase(aDBName,DPB,false);
1038	>
1039	>	if FAttachment = nil then
1040	>	begin
1041	>	Status := FirebirdAPI.GetStatus;
1042	>	{$IFDEF UNIX}
1043	>	if GetProtocol(aDBName) = Local then
1044	>	begin
1045	>	if ((Status.GetSQLCode = -901) and (Status.GetIBErrorCode = isc_random)) {Access permissions on firebird temp}
1046	>	or
1047	>	((Status.GetSQLCode = -902) and (Status.GetIBErrorCode = isc_sys_request)) {Security DB Problem}
1048	>	or
1049	>	((Status.GetSQLCode = -902) and (Status.GetIBErrorCode = isc_psw_attach)) {Security DB Problem}
1050	>	or
1051	>	((Status.GetSQLCode = -904) and (Status.GetIBErrorCode = isc_lock_dir_access)) {Lock File Problem}
1052	>	then
1053	>	begin
1054	>	aDBName := 'localhost:' + aDBName;
1055	>	Continue;
1056	>	end
1057	>	end;
1058	>	{$ENDIF}
1059	>	if ((Status.GetSQLCode = -902) and (Status.GetIBErrorCode = isc_io_error)) {Database not found}
1060	>	and CreateIfNotExists and not (csDesigning in ComponentState) then
1061	>	FCreateDatabase := true
1062	>	else
1063	>	raise EIBInterBaseError.Create(Status);
1064	>	end;
1065	>
1066	>	if UseDefaultSystemCodePage and (FAttachment <> nil) then
1067	>	{Only now can we check the codepage in use by the Attachment.
1068	>	If not that required then re-open with required LCLType.}
1069	>	begin
1070	>	{$ifdef WINDOWS}
1071	>	if Attachment.CodePage2CharSetID(GetACP,CharSetID) then
1072	>	{$else}
1073	>	if Attachment.CodePage2CharSetID(DefaultSystemCodePage,CharSetID) then
1074	>	{$endif}
1075	>	begin
1076	>	CharSetName := Attachment.GetCharsetName(CharSetID);
1077	>	if CharSetName <> AnsiUpperCase(TempDBParams.Values['lc_ctype']) then
1078	>	begin
1079	>	TempDBParams.Values['lc_ctype'] := CharSetName;
1080	>	FDBParamsChanged := True;
1081	>	FAttachment := nil;
1082	>	end
1083	>	end
1084	>	end;
1085	>
1086	>	until FAttachment <> nil;
1087	>
1088	>	finally
1089	>	TempDBParams.Free;
1090		end;
1091	<	if Call(isc_attach_database(StatusVector, Length(FDBName),
1092	<	PChar(FDBName), @FHandle,
1093	<	FDPBLength, FDPB), False) > 0 then
1091	>	PW := Attachment.getDPB.Find(isc_dpb_password);
1092	>	if PW <> nil then PW.AsString := 'xxxxxxxx'; {Hide password}
1093	>
1094	>	if not (csDesigning in ComponentState) then
1095	>	FDBName := aDBName; {Synchronise at run time}
1096	>	ValidateClientSQLDialect;
1097	>	for i := 0 to FSQLObjects.Count - 1 do
1098		begin
1099	<	FHandle := nil;
1100	<	IBDataBaseError;
1099	>	if FSQLObjects[i] <> nil then
1100	>	SQLObjects[i].DoAfterDatabaseConnect;
1101		end;
906	–	FDBSQLDialect := GetDBSQLDialect;
907	–	ValidateClientSQLDialect;
908	–	{$IFDEF HAS_SQLMONITOR}
1102		if not (csDesigning in ComponentState) then
1103		MonitorHook.DBConnect(Self);
911	–	{$ENDIF}
1104		end;
1105
1106	<	procedure TIBDatabase.RemoveSQLObject(Idx: Integer);
1106	>	procedure TIBDataBase.RemoveSQLObject(Idx: Integer);
1107		var
1108		ds: TIBBase;
1109		begin
#	Line 921 | Line 1113 | begin
1113		FSQLObjects[Idx] := nil;
1114		ds.Database := nil;
1115		if (ds.owner is TDataSet) then
924	–	{$IFDEF LINUX}
1116		FDataSets.Remove(TDataSet(ds.Owner));
926	–	{$ELSE}
927	–	UnregisterClient(TDataSet(ds.Owner));
928	–	{$ENDIF}
1117		end;
1118		end;
1119
1120	<	procedure TIBDatabase.RemoveSQLObjects;
1120	>	procedure TIBDataBase.RemoveSQLObjects;
1121		var
1122		i: Integer;
1123		begin
#	Line 937 | Line 1125 | begin
1125		begin
1126		RemoveSQLObject(i);
1127		if (TIBBase(FSQLObjects[i]).owner is TDataSet) then
940	–	{$IFDEF LINUX}
1128		FDataSets.Remove(TDataSet(TIBBase(FSQLObjects[i]).owner));
942	–	{$ELSE}
943	–	UnregisterClient(TDataSet(TIBBase(FSQLObjects[i]).owner));
944	–	{$ENDIF}
1129		end;
1130		end;
1131
1132	<	procedure TIBDatabase.RemoveTransaction(Idx: Integer);
1132	>	procedure TIBDataBase.RemoveTransaction(Idx: Integer);
1133		var
1134		TR: TIBTransaction;
1135		begin
#	Line 959 | Line 1143 | begin
1143		end;
1144		end;
1145
1146	<	procedure TIBDatabase.RemoveTransactions;
1146	>	procedure TIBDataBase.RemoveTransactions;
1147		var
1148		i: Integer;
1149		begin
#	Line 967 | Line 1151 | begin
1151		RemoveTransaction(i);
1152		end;
1153
1154	<	procedure TIBDatabase.SetDatabaseName(const Value: TIBFileName);
1154	>	procedure TIBDataBase.SetDatabaseName( const Value: TIBFileName);
1155		begin
1156		if FDBName <> Value then
1157		begin
#	Line 977 | Line 1161 | begin
1161		end;
1162		end;
1163
1164	<	procedure TIBDatabase.SetDBParamByDPB(const Idx: Integer; Value: String);
1164	>	procedure TIBDataBase.SetDBParamByDPB( const Idx: Integer; Value: String);
1165		var
1166		ConstIdx: Integer;
1167		begin
#	Line 996 | Line 1180 | begin
1180		end;
1181		end;
1182
1183	<	procedure TIBDatabase.SetDBParams(Value: TStrings);
1183	>	procedure TIBDataBase.SetDBParams(Value: TStrings);
1184		begin
1185		FDBParams.Assign(Value);
1186		end;
1187
1188	<	procedure TIBDatabase.SetDefaultTransaction(Value: TIBTransaction);
1188	>	procedure TIBDataBase.SetDefaultTransaction(Value: TIBTransaction);
1189		var
1190		i: Integer;
1191		begin
#	Line 1019 | Line 1203 | begin
1203		FDefaultTransaction := Value;
1204		end;
1205
1206	<	procedure TIBDatabase.SetHandle(Value: TISC_DB_HANDLE);
1023	<	begin
1024	<	if HandleIsShared then
1025	<	Close
1026	<	else
1027	<	CheckInactive;
1028	<	FHandle := Value;
1029	<	FHandleIsShared := (Value <> nil);
1030	<	end;
1031	<
1032	<	procedure TIBDatabase.SetIdleTimer(Value: Integer);
1206	>	procedure TIBDataBase.SetIdleTimer(Value: Integer);
1207		begin
1208		if Value < 0 then
1209		IBError(ibxeTimeoutNegative, [nil])
#	Line 1048 | Line 1222 | begin
1222		end;
1223		end;
1224
1225	<	function TIBDatabase.TestConnected: Boolean;
1225	>	function TIBDataBase.TestConnected: Boolean;
1226		var
1227		DatabaseInfo: TIBDatabaseInfo;
1228		begin
#	Line 1069 | Line 1243 | begin
1243		end;
1244		end;
1245
1246	<	procedure TIBDatabase.TimeoutConnection(Sender: TObject);
1246	>	procedure TIBDataBase.TimeoutConnection(Sender: TObject);
1247		begin
1248		if Connected then
1249		begin
1250	<	if FCanTimeout then
1250	>	if not FAttachment.HasActivity then
1251		begin
1252		ForceClose;
1253		if Assigned(FOnIdleTimer) then
1254		FOnIdleTimer(Self);
1255		end
1082	–	else
1083	–	FCanTimeout := True;
1256		end;
1257		end;
1258
1259	<	function TIBDatabase.GetIsReadOnly: Boolean;
1259	>	function TIBDataBase.GetIsReadOnly: Boolean;
1260		var
1261		DatabaseInfo: TIBDatabaseInfo;
1262		begin
#	Line 1102 | Line 1274 | begin
1274		DatabaseInfo.Free;
1275		end;
1276
1105	–	function TIBDatabase.GetSQLDialect: Integer;
1106	–	begin
1107	–	Result := FSQLDialect;
1108	–	end;
1277
1278	<	procedure TIBDatabase.SetSQLDialect(const Value: Integer);
1278	>	procedure TIBDataBase.SetSQLDialect( const Value: Integer);
1279		begin
1280		if (Value < 1) then IBError(ibxeSQLDialectInvalid, [nil]);
1281	<	if ((FHandle = nil) or (Value <= FDBSQLDialect))  then
1281	>	if (Attachment = nil) or (Value <= DBSQLDialect)  then
1282		FSQLDialect := Value
1283		else
1284		IBError(ibxeSQLDialectInvalid, [nil]);
1285		end;
1286
1287	<	function TIBDatabase.GetDBSQLDialect: Integer;
1120	<	var
1121	<	DatabaseInfo: TIBDatabaseInfo;
1287	>	function TIBDataBase.GetDBSQLDialect: Integer;
1288		begin
1289	<	DatabaseInfo := TIBDatabaseInfo.Create(self);
1290	<	DatabaseInfo.Database := self;
1125	<	result := DatabaseInfo.DBSQLDialect;
1126	<	DatabaseInfo.Free;
1289	>	CheckActive;
1290	>	Result := Attachment.GetSQLDialect;
1291		end;
1292
1293	<	procedure TIBDatabase.ValidateClientSQLDialect;
1293	>	function TIBDataBase.GetDefaultCharSetID: integer;
1294		begin
1295	<	if (FDBSQLDialect < FSQLDialect) then
1295	>	if (Attachment <> nil) and Attachment.HasDefaultCharSet then
1296	>	Result := Attachment.GetDefaultCharSetID
1297	>	else
1298	>	Result := 0;
1299	>	end;
1300	>
1301	>	function TIBDataBase.GetDefaultCharSetName: AnsiString;
1302	>	begin
1303	>	if Attachment <> nil then
1304	>	Result := Attachment.GetCharsetName(DefaultCharSetID)
1305	>	else
1306	>	Result := '';
1307	>	end;
1308	>
1309	>	function TIBDataBase.GetDefaultCodePage: TSystemCodePage;
1310	>	begin
1311	>	if Attachment <> nil then
1312	>	Attachment.CharSetID2CodePage(DefaultCharSetID,Result)
1313	>	else
1314	>	Result := CP_NONE;
1315	>	end;
1316	>
1317	>	function TIBDataBase.GetRemoteProtocol: string;
1318	>	begin
1319	>	CheckActive;
1320	>	Result := Attachment.GetRemoteProtocol;
1321	>	end;
1322	>
1323	>	procedure TIBDataBase.ValidateClientSQLDialect;
1324	>	begin
1325	>	if (DBSQLDialect < FSQLDialect) then
1326		begin
1327	<	FSQLDialect := FDBSQLDialect;
1327	>	FSQLDialect := DBSQLDialect;
1328		if Assigned (FOnDialectDowngradeWarning) then
1329		FOnDialectDowngradeWarning(self);
1330		end;
1331		end;
1332
1333	<	procedure TIBDatabase.ApplyUpdates(const DataSets: array of TDataSet);
1333	>	procedure TIBDataBase.ApplyUpdates( const DataSets: array of TDataSet);
1334		var
1335		I: Integer;
1336		DS: TIBCustomDataSet;
#	Line 1162 | Line 1356 | begin
1356		TR.CommitRetaining;
1357		end;
1358
1359	<	procedure TIBDatabase.CloseDataSets;
1359	>	procedure TIBDataBase.CloseDataSets;
1360		var
1361		i: Integer;
1362		begin
#	Line 1171 | Line 1365 | begin
1365		DataSets[i].close;
1366		end;
1367
1368	<	function TIBDatabase.GetDataset(Index : longint) : TDataset;
1368	>	function TIBDataBase.GetDataset(Index: longint): TDataset;
1369		begin
1370		if (Index >= 0) and (Index < FDataSets.Count) then
1371		Result := TDataSet(FDataSets[Index])
#	Line 1179 | Line 1373 | begin
1373		raise Exception.Create('Invalid Index to DataSets');
1374		end;
1375
1376	<	function TIBDatabase.GetDataSetCount : Longint;
1376	>	function TIBDataBase.GetDataSetCount: Longint;
1377		begin
1378		Result := FDataSets.Count;
1379		end;
1380
1381	<	procedure TIBDatabase.GetFieldNames(const TableName: string; List: TStrings);
1381	>	procedure TIBDataBase.ReadState(Reader: TReader);
1382	>	begin
1383	>	FDBParams.Clear;
1384	>	inherited ReadState(Reader);
1385	>	end;
1386	>
1387	>	procedure TIBDataBase.SetConnected(Value: boolean);
1388	>	begin
1389	>	if StreamedConnected and not AllowStreamedConnected then
1390	>	begin
1391	>	StreamedConnected := false;
1392	>	Value := false
1393	>	end;
1394	>	inherited SetConnected(Value);
1395	>	end;
1396	>
1397	>	procedure TIBDataBase.GetFieldNames( const TableName: string; List: TStrings);
1398		var
1399		Query: TIBSQL;
1400		begin
#	Line 1200 | Line 1410 | begin
1410		Query.Database := Self;
1411		Query.Transaction := FInternalTransaction;
1412		Query.SQL.Text := 'Select R.RDB$FIELD_NAME ' + {do not localize}
1413	<	'from RDB$RELATION_FIELDS R, RDB$FIELDS F ' + {do not localize}
1413	>	'from RDB$RELATION_FIELDS R ' + {do not localize}
1414		'where R.RDB$RELATION_NAME = ' + {do not localize}
1415	<	'''' +
1416	<	FormatIdentifierValue(SQLDialect, TableName) +
1207	<	''' ' +
1208	<	'and R.RDB$FIELD_SOURCE = F.RDB$FIELD_NAME '; {do not localize}
1415	>	'''' + ExtractIdentifier(DBSQLDialect, TableName) +
1416	>	''' and Exists(Select * From RDB$FIELDS F Where R.RDB$FIELD_SOURCE = F.RDB$FIELD_NAME)' ; {do not localize}
1417		Query.Prepare;
1418		Query.ExecQuery;
1419		with List do
#	Line 1213 | Line 1421 | begin
1421		BeginUpdate;
1422		try
1423		Clear;
1424	<	while (not Query.EOF) and (Query.Next <> nil) do
1425	<	List.Add(TrimRight(Query.Current.ByName('RDB$FIELD_NAME').AsString)); {do not localize}
1424	>	while (not Query.EOF) and Query.Next  do
1425	>	List.Add(TrimRight(Query.FieldByName('RDB$FIELD_NAME').AsString)); {do not localize}
1426		finally
1427		EndUpdate;
1428		end;
#	Line 1225 | Line 1433 | begin
1433		end;
1434		end;
1435
1436	<	procedure TIBDatabase.GetTableNames(List: TStrings; SystemTables: Boolean);
1436	>	procedure TIBDataBase.GetTableNames(List: TStrings; SystemTables: Boolean);
1437		var
1438		Query : TIBSQL;
1439		begin
#	Line 1253 | Line 1461 | begin
1461		BeginUpdate;
1462		try
1463		Clear;
1464	<	while (not Query.EOF) and (Query.Next <> nil) do
1465	<	List.Add(TrimRight(Query.Current[0].AsString));
1464	>	while (not Query.EOF) and Query.Next  do
1465	>	List.Add(TrimRight(Query.Fields[0].AsString));
1466		finally
1467		EndUpdate;
1468		end;
#	Line 1271 | Line 1479 | end;
1479		constructor TIBTransaction.Create(AOwner: TComponent);
1480		begin
1481		inherited Create(AOwner);
1274	–	FIBLoaded := False;
1275	–	CheckIBLoaded;
1276	–	FIBLoaded := True;
1277	–	CheckIBLoaded;
1482		FDatabases := TList.Create;
1483		FSQLObjects := TList.Create;
1280	–	FHandle := nil;
1484		FTPB := nil;
1282	–	FTPBLength := 0;
1485		FTRParams := TStringList.Create;
1486		FTRParamsChanged := True;
1487		TStringList(FTRParams).OnChange := TRParamsChange;
1488		TStringList(FTRParams).OnChanging := TRParamsChanging;
1489	<	FTimer := TTimer.Create(Self);
1489	>	FTimer := TFPTimer.Create(Self);
1490		FTimer.Enabled := False;
1491		FTimer.Interval := 0;
1492		FTimer.OnTimer := TimeoutTransaction;
#	Line 1295 | Line 1497 | destructor TIBTransaction.Destroy;
1497		var
1498		i: Integer;
1499		begin
1500	<	if FIBLoaded then
1501	<	begin
1502	<	if InTransaction then
1503	<	EndTransaction(FDefaultAction, True);
1504	<	for i := 0 to FSQLObjects.Count - 1 do
1505	<	if FSQLObjects[i] <> nil then
1506	<	SQLObjects[i].DoTransactionFree;
1507	<	RemoveSQLObjects;
1508	<	RemoveDatabases;
1509	<	FreeMem(FTPB);
1510	<	FTPB := nil;
1309	<	FTRParams.Free;
1310	<	FSQLObjects.Free;
1311	<	FDatabases.Free;
1312	<	end;
1500	>	if InTransaction then
1501	>	EndTransaction(FDefaultAction, True);
1502	>	for i := 0 to FSQLObjects.Count - 1 do
1503	>	if FSQLObjects[i] <> nil then
1504	>	SQLObjects[i].DoTransactionFree;
1505	>	RemoveSQLObjects;
1506	>	RemoveDatabases;
1507	>	FTPB := nil;
1508	>	FTRParams.Free;
1509	>	FSQLObjects.Free;
1510	>	FDatabases.Free;
1511		inherited Destroy;
1512		end;
1513
1316	–	function TIBTransaction.Call(ErrCode: ISC_STATUS;
1317	–	RaiseError: Boolean): ISC_STATUS;
1318	–	var
1319	–	i: Integer;
1320	–	begin
1321	–	result := ErrCode;
1322	–	for i := 0 to FDatabases.Count - 1 do if FDatabases[i] <> nil then
1323	–	Databases[i].FCanTimeout := False;
1324	–	FCanTimeout := False;
1325	–	if RaiseError and (result > 0) then
1326	–	IBDataBaseError;
1327	–	end;
1328	–
1514		procedure TIBTransaction.CheckDatabasesInList;
1515		begin
1516		if GetDatabaseCount = 0 then
#	Line 1336 | Line 1521 | procedure TIBTransaction.CheckInTransact
1521		begin
1522		if FStreamedActive and (not InTransaction) then
1523		Loaded;
1524	<	if (FHandle = nil) then
1524	>	if (TransactionIntf = nil) then
1525		IBError(ibxeNotInTransaction, [nil]);
1526		end;
1527
1528	+	procedure TIBTransaction.DoBeforeTransactionEnd;
1529	+	begin
1530	+	if Assigned(FBeforeTransactionEnd) then
1531	+	FBeforeTransactionEnd(self);
1532	+	end;
1533	+
1534	+	procedure TIBTransaction.DoAfterTransactionEnd;
1535	+	begin
1536	+	if Assigned(FAfterTransactionEnd) then
1537	+	FAfterTransactionEnd(self);
1538	+	end;
1539	+
1540	+	procedure TIBTransaction.DoOnStartTransaction;
1541	+	begin
1542	+	if assigned(FOnStartTransaction) then
1543	+	OnStartTransaction(self);
1544	+	end;
1545	+
1546	+	procedure TIBTransaction.DoAfterExecQuery(Sender: TObject);
1547	+	begin
1548	+	if assigned(FAfterExecQuery) then
1549	+	AfterExecQuery(Sender);
1550	+	end;
1551	+
1552	+	procedure TIBTransaction.DoAfterEdit(Sender: TObject);
1553	+	begin
1554	+	if assigned(FAfterEdit) then
1555	+	AfterEdit(Sender);
1556	+	end;
1557	+
1558	+	procedure TIBTransaction.DoAfterDelete(Sender: TObject);
1559	+	begin
1560	+	if assigned(FAfterDelete) then
1561	+	AfterDelete(Sender);
1562	+	end;
1563	+
1564	+	procedure TIBTransaction.DoAfterInsert(Sender: TObject);
1565	+	begin
1566	+	if assigned(FAfterInsert) then
1567	+	AfterInsert(Sender);
1568	+	end;
1569	+
1570	+	procedure TIBTransaction.DoAfterPost(Sender: TObject);
1571	+	begin
1572	+	if assigned(FAfterPost) then
1573	+	AfterPost(Sender);
1574	+	end;
1575	+
1576		procedure TIBTransaction.EnsureNotInTransaction;
1577		begin
1578		if csDesigning in ComponentState then
1579		begin
1580	<	if FHandle <> nil then
1580	>	if TransactionIntf <> nil then
1581		Rollback;
1582		end;
1583		end;
1584
1585		procedure TIBTransaction.CheckNotInTransaction;
1586		begin
1587	<	if (FHandle <> nil) then
1587	>	if (TransactionIntf <> nil) and  TransactionIntf.InTransaction then
1588		IBError(ibxeInTransaction, [nil]);
1589		end;
1590
#	Line 1360 | Line 1593 | var
1593		i: Integer;
1594		NilFound: Boolean;
1595		begin
1596	+	EnsureNotInTransaction;
1597	+	CheckNotInTransaction;
1598	+	FTransactionIntf := nil;
1599	+
1600		i := FindDatabase(db);
1601		if i <> -1 then
1602		begin
#	Line 1410 | Line 1647 | end;
1647		procedure TIBTransaction.EndTransaction(Action: TTransactionAction;
1648		Force: Boolean);
1649		var
1413	–	status: ISC_STATUS;
1650		i: Integer;
1651		begin
1652		CheckInTransaction;
1653	+	if FInEndTransaction then Exit;
1654	+	FInEndTransaction := true;
1655	+	FEndAction := Action;
1656	+	try
1657		case Action of
1658		TARollback, TACommit:
1659		begin
1660	<	if (HandleIsShared) and
1661	<	(Action <> FDefaultAction) and
1662	<	(not Force) then
1663	<	IBError(ibxeCantEndSharedTransaction, [nil]);
1660	>	try
1661	>	DoBeforeTransactionEnd;
1662	>	except on E: EIBInterBaseError do
1663	>	begin
1664	>	if not Force then
1665	>	raise;
1666	>	end;
1667	>	end;
1668	>
1669		for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then
1670	<	SQLObjects[i].DoBeforeTransactionEnd;
1670	>	try
1671	>	SQLObjects[i].DoBeforeTransactionEnd(Action);
1672	>	except on E: EIBInterBaseError do
1673	>	begin
1674	>	if not Force then
1675	>	raise;
1676	>	end;
1677	>	end;
1678	>
1679		if InTransaction then
1680		begin
1681	<	if HandleIsShared then
1682	<	begin
1430	<	FHandle := nil;
1431	<	FHandleIsShared := False;
1432	<	status := 0;
1433	<	end
1681	>	if (Action = TARollback) then
1682	>	FTransactionIntf.Rollback(Force)
1683		else
1684	<	if (Action = TARollback) then
1685	<	status := Call(isc_rollback_transaction(StatusVector, @FHandle), False)
1686	<	else
1687	<	status := Call(isc_commit_transaction(StatusVector, @FHandle), False);
1688	<	if ((Force) and (status > 0)) then
1689	<	status := Call(isc_rollback_transaction(StatusVector, @FHandle), False);
1690	<	if Force then
1691	<	FHandle := nil
1692	<	else
1693	<	if (status > 0) then
1694	<	IBDataBaseError;
1695	<	for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then
1696	<	SQLObjects[i].DoAfterTransactionEnd;
1684	>	try
1685	>	FTransactionIntf.Commit;
1686	>	except on E: EIBInterBaseError do
1687	>	begin
1688	>	if Force then
1689	>	FTransactionIntf.Rollback(Force)
1690	>	else
1691	>	raise;
1692	>	end;
1693	>	end;
1694	>
1695	>	for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then
1696	>	try
1697	>	SQLObjects[i].DoAfterTransactionEnd;
1698	>	except on E: EIBInterBaseError do
1699	>	begin
1700	>	if not Force then
1701	>	raise;
1702	>	end;
1703	>	end;
1704	>	try
1705	>	DoAfterTransactionEnd;
1706	>	except on E: EIBInterBaseError do
1707	>	begin
1708	>	if not Force then
1709	>	raise;
1710	>	end;
1711	>	end;
1712		end;
1713		end;
1714		TACommitRetaining:
1715	<	Call(isc_commit_retaining(StatusVector, @FHandle), True);
1715	>	FTransactionIntf.CommitRetaining;
1716	>
1717		TARollbackRetaining:
1718	<	Call(isc_rollback_retaining(StatusVector, @FHandle), True);
1718	>	FTransactionIntf.RollbackRetaining;
1719		end;
1455	–	{$IFDEF HAS_SQLMONITOR}
1720		if not (csDesigning in ComponentState) then
1721		begin
1722		case Action of
#	Line 1466 | Line 1730 | begin
1730		MonitorHook.TRRollbackRetaining(Self);
1731		end;
1732		end;
1733	<	{$ENDIF}
1733	>	finally
1734	>	FInEndTransaction := false
1735	>	end;
1736		end;
1737
1738		function TIBTransaction.GetDatabase(Index: Integer): TIBDatabase;
#	Line 1501 | Line 1767 | end;
1767
1768		function TIBTransaction.GetInTransaction: Boolean;
1769		begin
1770	<	result := (FHandle <> nil);
1770	>	result := (TransactionIntf <> nil) and TransactionIntf.InTransaction;
1771		end;
1772
1773		function TIBTransaction.FindDatabase(db: TIBDatabase): Integer;
#	Line 1534 | Line 1800 | begin
1800		end;
1801		end;
1802
1803	+	function TIBTransaction.GetEndAction: TTransactionAction;
1804	+	begin
1805	+	if FInEndTransaction then
1806	+	Result := FEndAction
1807	+	else
1808	+	IBError(ibxeIB60feature, [nil])
1809	+	end;
1810	+
1811
1812		function TIBTransaction.GetIdleTimer: Integer;
1813		begin
#	Line 1549 | Line 1823 | procedure TIBTransaction.BeforeDatabaseD
1823		begin
1824		if InTransaction then
1825		EndTransaction(FDefaultAction, True);
1826	+	FTransactionIntf := nil;
1827		end;
1828
1829		procedure TIBTransaction.RemoveDatabase(Idx: Integer);
#	Line 1557 | Line 1832 | var
1832		begin
1833		if ((Idx >= 0) and (FDatabases[Idx] <> nil)) then
1834		begin
1835	+	EnsureNotInTransaction;
1836	+	CheckNotInTransaction;
1837	+	FTransactionIntf := nil;
1838	+
1839		DB := Databases[Idx];
1840		FDatabases[Idx] := nil;
1841		DB.RemoveTransaction(DB.FindTransaction(Self));
#	Line 1569 | Line 1848 | procedure TIBTransaction.RemoveDatabases
1848		var
1849		i: Integer;
1850		begin
1851	+	EnsureNotInTransaction;
1852	+	CheckNotInTransaction;
1853	+	FTransactionIntf := nil;
1854	+
1855		for i := 0 to FDatabases.Count - 1 do if FDatabases[i] <> nil then
1856		RemoveDatabase(i);
1857		end;
#	Line 1615 | Line 1898 | begin
1898		Rollback;
1899		end;
1900
1618	–	procedure TIBTransaction.SetDefaultAction(Value: TTransactionAction);
1619	–	begin
1620	–	(*  if (Value = taRollbackRetaining) and (GetIBClientVersion < 6) then
1621	–	IBError(ibxeIB60feature, [nil]);*)
1622	–	FDefaultAction := Value;
1623	–	end;
1624	–
1901		procedure TIBTransaction.SetDefaultDatabase(Value: TIBDatabase);
1902		var
1903		i: integer;
#	Line 1639 | Line 1915 | begin
1915		for i := 0 to FSQLObjects.Count - 1 do
1916		if (FSQLObjects[i] <> nil) and
1917		(TIBBase(FSQLObjects[i]).Database = nil) then
1918	<	SetOrdProp(TIBBase(FSQLObjects[i]).Owner, 'Database', Integer(Value));
1918	>	SetObjectProp(TIBBase(FSQLObjects[i]).Owner, 'Database', Value);
1919		end;
1920		FDefaultDatabase := Value;
1921		end;
1922
1647	–	procedure TIBTransaction.SetHandle(Value: TISC_TR_HANDLE);
1648	–	begin
1649	–	if (HandleIsShared) then
1650	–	EndTransaction(DefaultAction, True)
1651	–	else
1652	–	CheckNotInTransaction;
1653	–	FHandle := Value;
1654	–	FHandleIsShared := (Value <> nil);
1655	–	end;
1656	–
1923		procedure TIBTransaction.Notification( AComponent: TComponent;
1924		Operation: TOperation);
1925		var
#	Line 1695 | Line 1961 | end;
1961
1962		procedure TIBTransaction.StartTransaction;
1963		var
1698	–	pteb: PISC_TEB_ARRAY;
1699	–	TPB: String;
1964		i: Integer;
1965	+	Attachments: array of IAttachment;
1966	+	ValidDatabaseCount: integer;
1967		begin
1968		CheckNotInTransaction;
1969		CheckDatabasesInList;
1970	+	if TransactionIntf <> nil then
1971	+	begin
1972	+	TransactionIntf.Start(DefaultAction);
1973	+	Exit;
1974	+	end;
1975	+
1976		for i := 0 to FDatabases.Count - 1 do
1977		if  FDatabases[i] <> nil then
1978		begin
1979		with TIBDatabase(FDatabases[i]) do
1980		if not Connected then
1981	<	if FStreamedConnected then
1981	>	if StreamedConnected then
1982		begin
1983		Open;
1984	<	FStreamedConnected := False;
1984	>	StreamedConnected := False;
1985		end
1986		else
1987		IBError(ibxeDatabaseClosed, [nil]);
#	Line 1717 | Line 1989 | begin
1989		if FTRParamsChanged then
1990		begin
1991		FTRParamsChanged := False;
1992	<	GenerateTPB(FTRParams, TPB, FTPBLength);
1721	<	if FTPBLength > 0 then
1722	<	begin
1723	<	IBAlloc(FTPB, 0, FTPBLength);
1724	<	Move(TPB[1], FTPB[0], FTPBLength);
1725	<	end;
1992	>	FTPB :=  GenerateTPB(FTRParams);
1993		end;
1994
1995	<	pteb := nil;
1996	<	IBAlloc(pteb, 0, DatabaseCount * SizeOf(TISC_TEB));
1997	<	try
1998	<	for i := 0 to DatabaseCount - 1 do if Databases[i] <> nil then
1999	<	begin
2000	<	pteb^[i].db_handle := @(Databases[i].Handle);
2001	<	pteb^[i].tpb_length := FTPBLength;
2002	<	pteb^[i].tpb_address := FTPB;
2003	<	end;
2004	<	if Call(isc_start_multiple(StatusVector, @FHandle,
2005	<	DatabaseCount, PISC_TEB(pteb)), False) > 0 then
2006	<	begin
2007	<	FHandle := nil;
2008	<	IBDataBaseError;
1742	<	end;
1743	<	{$IFDEF HAS_SQLMONITOR}
1744	<	if not (csDesigning in ComponentState) then
1745	<	MonitorHook.TRStart(Self);
1746	<	{$ENDIF}
1747	<	finally
1748	<	FreeMem(pteb);
1995	>	ValidDatabaseCount := 0;
1996	>	for i := 0 to DatabaseCount - 1 do
1997	>	if Databases[i] <> nil then Inc(ValidDatabaseCount);
1998	>
1999	>	if ValidDatabaseCount = 1 then
2000	>	FTransactionIntf := Databases[0].Attachment.StartTransaction(FTPB,DefaultAction)
2001	>	else
2002	>	begin
2003	>	SetLength(Attachments,ValidDatabaseCount);
2004	>	for i := 0 to DatabaseCount - 1 do
2005	>	if Databases[i] <> nil then
2006	>	Attachments[i] := Databases[i].Attachment;
2007	>
2008	>	FTransactionIntf := FirebirdAPI.StartTransaction(Attachments,FTPB,DefaultAction);
2009		end;
2010	+
2011	+	if not (csDesigning in ComponentState) then
2012	+	MonitorHook.TRStart(Self);
2013	+	DoOnStartTransaction;
2014		end;
2015
2016		procedure TIBTransaction.TimeoutTransaction(Sender: TObject);
2017		begin
2018		if InTransaction then
2019		begin
2020	<	if FCanTimeout then
2020	>	if not TransactionIntf.HasActivity then
2021		begin
2022		EndTransaction(FDefaultAction, True);
2023		if Assigned(FOnIdleTimer) then
2024		FOnIdleTimer(Self);
2025		end
1762	–	else
1763	–	FCanTimeout := True;
2026		end;
2027		end;
2028
#	Line 1773 | Line 2035 | procedure TIBTransaction.TRParamsChangin
2035		begin
2036		EnsureNotInTransaction;
2037		CheckNotInTransaction;
2038	+	FTransactionIntf := nil;
2039		end;
2040
2041		{ TIBBase }
#	Line 1788 | Line 2051 | begin
2051		inherited Destroy;
2052		end;
2053
2054	+	procedure TIBBase.HandleException(Sender: TObject);
2055	+	begin
2056	+	if assigned(Database) then
2057	+	Database.HandleException(Sender)
2058	+	else
2059	+	SysUtils.ShowException(ExceptObject,ExceptAddr);
2060	+	end;
2061	+
2062	+	procedure TIBBase.SetCursor;
2063	+	begin
2064	+	if Assigned(Database) and not Database.SQLHourGlass then
2065	+	Exit;
2066	+	if assigned(IBGUIInterface) then
2067	+	IBGUIInterface.SetCursor;
2068	+	end;
2069	+
2070	+	procedure TIBBase.RestoreCursor;
2071	+	begin
2072	+	if Assigned(Database) and not Database.SQLHourGlass then
2073	+	Exit;
2074	+	if assigned(IBGUIInterface) then
2075	+	IBGUIInterface.RestoreCursor;
2076	+	end;
2077	+
2078		procedure TIBBase.CheckDatabase;
2079		begin
2080		if (FDatabase = nil) then
#	Line 1802 | Line 2089 | begin
2089		FTransaction.CheckInTransaction;
2090		end;
2091
2092	<	function TIBBase.GetDBHandle: PISC_DB_HANDLE;
2092	>	procedure TIBBase.DoBeforeDatabaseConnect(DBParams: TStrings; var DBName: string
2093	>	);
2094		begin
2095	<	CheckDatabase;
2096	<	result := @FDatabase.Handle;
2095	>	if assigned(FBeforeDatabaseConnect) then
2096	>	BeforeDatabaseConnect(self,DBParams,DBName);
2097		end;
2098
2099	<	function TIBBase.GetTRHandle: PISC_TR_HANDLE;
2099	>	procedure TIBBase.DoAfterDatabaseConnect;
2100		begin
2101	<	CheckTransaction;
2102	<	result := @FTransaction.Handle;
2101	>	if assigned(FAfterDatabaseConnect) then
2102	>	AfterDatabaseConnect(self);
2103		end;
2104
2105		procedure TIBBase.DoBeforeDatabaseDisconnect;
#	Line 1834 | Line 2122 | begin
2122		SetTransaction(nil);
2123		end;
2124
2125	<	procedure TIBBase.DoBeforeTransactionEnd;
2125	>	procedure TIBBase.DoBeforeTransactionEnd(Action: TTransactionAction);
2126		begin
2127		if Assigned(BeforeTransactionEnd) then
2128	<	BeforeTransactionEnd(Self);
2128	>	BeforeTransactionEnd(Self,Action);
2129		end;
2130
2131		procedure TIBBase.DoAfterTransactionEnd;
#	Line 1853 | Line 2141 | begin
2141		FTransaction := nil;
2142		end;
2143
2144	+	procedure TIBBase.DoAfterExecQuery(Sender: TObject);
2145	+	begin
2146	+	if FTransaction <> nil then
2147	+	FTransaction.DoAfterExecQuery(Sender);
2148	+	end;
2149	+
2150	+	procedure TIBBase.DoAfterEdit(Sender: TObject);
2151	+	begin
2152	+	if FTransaction <> nil then
2153	+	FTransaction.DoAfterEdit(Sender);
2154	+	end;
2155	+
2156	+	procedure TIBBase.DoAfterDelete(Sender: TObject);
2157	+	begin
2158	+	if FTransaction <> nil then
2159	+	FTransaction.DoAfterDelete(Sender);
2160	+	end;
2161	+
2162	+	procedure TIBBase.DoAfterInsert(Sender: TObject);
2163	+	begin
2164	+	if FTransaction <> nil then
2165	+	FTransaction.DoAfterInsert(Sender);
2166	+	end;
2167	+
2168	+	procedure TIBBase.DoAfterPost(Sender: TObject);
2169	+	begin
2170	+	if FTransaction <> nil then
2171	+	FTransaction.DoAfterPost(Sender);
2172	+	end;
2173	+
2174		procedure TIBBase.SetDatabase(Value: TIBDatabase);
2175		begin
2176		if (FDatabase <> nil) then
#	Line 1885 | Line 2203 | end;
2203		parameter buffer, and return it and its length
2204		in DPB and DPBLength, respectively. }
2205
2206	<	procedure GenerateDPB(sl: TStrings; var DPB: string; var DPBLength: Short);
2206	>	function GenerateDPB(sl: TStrings): IDPB;
2207		var
2208	<	i, j, pval: Integer;
2208	>	i, j: Integer;
2209		DPBVal: UShort;
2210		ParamName, ParamValue: string;
2211		begin
2212	<	{ The DPB is initially empty, with the exception that
1895	<	the DPB version must be the first byte of the string. }
1896	<	DPBLength := 1;
1897	<	DPB := Char(isc_dpb_version1);
2212	>	Result := FirebirdAPI.AllocateDPB;
2213
2214		{Iterate through the textual database parameters, constructing
2215		a DPB on-the-fly }
#	Line 1928 | Line 2243 | begin
2243		case DPBVal of
2244		isc_dpb_user_name, isc_dpb_password, isc_dpb_password_enc,
2245		isc_dpb_sys_user_name, isc_dpb_license, isc_dpb_encrypt_key,
2246	<	isc_dpb_lc_messages, isc_dpb_lc_ctype,
2246	>	isc_dpb_lc_messages, isc_dpb_lc_ctype, isc_dpb_page_size,
2247		isc_dpb_sql_role_name, isc_dpb_sql_dialect:
2248		begin
2249		if DPBVal = isc_dpb_sql_dialect then
2250		ParamValue[1] := Char(Ord(ParamValue[1]) - 48);
2251	<	DPB := DPB +
1937	<	Char(DPBVal) +
1938	<	Char(Length(ParamValue)) +
1939	<	ParamValue;
1940	<	Inc(DPBLength, 2 + Length(ParamValue));
2251	>	Result.Add(DPBVal).SetAsString(ParamValue);
2252		end;
2253	+
2254		isc_dpb_num_buffers, isc_dpb_dbkey_scope, isc_dpb_force_write,
2255		isc_dpb_no_reserve, isc_dpb_damaged, isc_dpb_verify:
2256	<	begin
2257	<	DPB := DPB +
1946	<	Char(DPBVal) +
1947	<	#1 +
1948	<	Char(StrToInt(ParamValue));
1949	<	Inc(DPBLength, 3);
1950	<	end;
2256	>	Result.Add(DPBVal).SetAsByte(byte(ParamValue[1]));
2257	>
2258		isc_dpb_sweep:
2259	<	begin
2260	<	DPB := DPB +
1954	<	Char(DPBVal) +
1955	<	#1 +
1956	<	Char(isc_dpb_records);
1957	<	Inc(DPBLength, 3);
1958	<	end;
2259	>	Result.Add(DPBVal).SetAsByte(isc_dpb_records);
2260	>
2261		isc_dpb_sweep_interval:
2262	<	begin
2263	<	pval := StrToInt(ParamValue);
1962	<	DPB := DPB +
1963	<	Char(DPBVal) +
1964	<	#4 +
1965	<	PChar(@pval)[0] +
1966	<	PChar(@pval)[1] +
1967	<	PChar(@pval)[2] +
1968	<	PChar(@pval)[3];
1969	<	Inc(DPBLength, 6);
1970	<	end;
2262	>	Result.Add(DPBVal).SetAsInteger(StrToInt(ParamValue));
2263	>
2264		isc_dpb_activate_shadow, isc_dpb_delete_shadow, isc_dpb_begin_log,
2265	<	isc_dpb_quit_log:
2266	<	begin
1974	<	DPB := DPB +
1975	<	Char(DPBVal) +
1976	<	#1 + #0;
1977	<	Inc(DPBLength, 3);
1978	<	end;
2265	>	isc_dpb_map_attach, isc_dpb_quit_log:
2266	>	Result.Add(DPBVal).SetAsByte(0);
2267		else
2268		begin
2269		if (DPBVal > 0) and
#	Line 1993 | Line 2281 | end;
2281		of the transaction parameters, generate a transaction
2282		parameter buffer, and return it and its length in
2283		TPB and TPBLength, respectively. }
2284	<	procedure GenerateTPB(sl: TStrings; var TPB: string; var TPBLength: Short);
2284	>	function GenerateTPB(sl: TStrings): ITPB;
2285		var
2286	<	i, j, TPBVal, ParamLength: Integer;
2286	>	i, j, TPBVal: Integer;
2287		ParamName, ParamValue: string;
2288		begin
2289	<	TPB := '';
2002	<	if (sl.Count = 0) then
2003	<	TPBLength := 0
2004	<	else
2005	<	begin
2006	<	TPBLength := sl.Count + 1;
2007	<	TPB := TPB + Char(isc_tpb_version3);
2008	<	end;
2289	>	Result := FirebirdAPI.AllocateTPB;
2290		for i := 0 to sl.Count - 1 do
2291		begin
2292		if (Trim(sl[i]) =  '') then
2012	–	begin
2013	–	Dec(TPBLength);
2293		Continue;
2294	<	end;
2294	>
2295		if (Pos('=', sl[i]) = 0) then {mbcs ok}
2296		ParamName := LowerCase(sl[i]) {mbcs ok}
2297		else
#	Line 2036 | Line 2315 | begin
2315		isc_tpb_concurrency, isc_tpb_shared, isc_tpb_wait, isc_tpb_nowait,
2316		isc_tpb_read, isc_tpb_write, isc_tpb_ignore_limbo,
2317		isc_tpb_read_committed, isc_tpb_rec_version, isc_tpb_no_rec_version:
2318	<	TPB := TPB + Char(TPBVal);
2318	>	Result.Add(TPBVal);
2319	>
2320		isc_tpb_lock_read, isc_tpb_lock_write:
2321	<	begin
2322	<	TPB := TPB + Char(TPBVal);
2043	<	{ Now set the string parameter }
2044	<	ParamLength := Length(ParamValue);
2045	<	Inc(TPBLength, ParamLength + 1);
2046	<	TPB := TPB + Char(ParamLength) + ParamValue;
2047	<	end;
2321	>	Result.Add(TPBVal).SetAsString(ParamValue);
2322	>
2323		else
2324		begin
2325		if (TPBVal > 0) and

Diff Legend

–	Removed lines
+	Added lines
<	Changed lines
>	Changed lines