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 62 by tony, Wed Apr 12 09:19:59 2017 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                                                 }
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'
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		);
132
133		TPBPrefix = 'isc_tpb_';
#	Line 135 | Line 151 | const
151		'rec_version',
152		'no_rec_version',
153		'restart_requests',
154	<	'no_auto_undo'
154	>	'no_auto_undo',
155	>	'lock_timeout'
156		);
157
158		type
#	Line 151 | Line 168 | type
168		{ TIBDatabase }
169		TIBDataBase = class(TCustomConnection)
170		private
171	+	FAttachment: IAttachment;
172	+	FCreateDatabase: boolean;
173	+	FCreateIfNotExists: boolean;
174	+	FDefaultCharSetID: integer;
175	+	FDefaultCharSetName: RawByteString;
176	+	FDefaultCodePage: TSystemCodePage;
177	+	FDPB: IDPB;
178	+	FAllowStreamedConnected: boolean;
179		FHiddenPassword: string;
180	<	FIBLoaded: Boolean;
180	>	FOnCreateDatabase: TNotifyEvent;
181		FOnLogin: TIBDatabaseLoginEvent;
182	+	FSQLHourGlass: Boolean;
183		FTraceFlags: TTraceFlags;
184		FDBSQLDialect: Integer;
185		FSQLDialect: Integer;
186		FOnDialectDowngradeWarning: TNotifyEvent;
161	–	FCanTimeout: Boolean;
187		FSQLObjects: TList;
188		FTransactions: TList;
189		FDBName: TIBFileName;
190		FDBParams: TStrings;
191		FDBParamsChanged: Boolean;
167	–	FDPB: PChar;
168	–	FDPBLength: Short;
169	–	FHandle: TISC_DB_HANDLE;
170	–	FHandleIsShared: Boolean;
192		FOnIdleTimer: TNotifyEvent;
193		FDefaultTransaction: TIBTransaction;
194		FInternalTransaction: TIBTransaction;
195	<	FStreamedConnected: Boolean;
175	<	FTimer: TTimer;
195	>	FTimer: TFPTimer;
196		FUserNames: TStringList;
197		FDataSets: TList;
198	+	FLoginCalled: boolean;
199	+	FUseDefaultSystemCodePage: boolean;
200		procedure EnsureInactive;
201		function GetDBSQLDialect: Integer;
202		function GetSQLDialect: Integer;
#	Line 184 | Line 206 | type
206		procedure DBParamsChanging(Sender: TObject);
207		function GetSQLObject(Index: Integer): TIBBase;
208		function GetSQLObjectCount: Integer;
187	–	function GetDBParamByDPB(const Idx: Integer): String;
209		function GetIdleTimer: Integer;
210		function GetTransaction(Index: Integer): TIBTransaction;
211		function GetTransactionCount: Integer;
212	<	function Login: Boolean;
212	>	function Login(var aDatabaseName: string): Boolean;
213		procedure SetDatabaseName(const Value: TIBFileName);
214		procedure SetDBParamByDPB(const Idx: Integer; Value: String);
215		procedure SetDBParams(Value: TStrings);
#	Line 205 | Line 226 | type
226		procedure DoConnect; override;
227		procedure DoDisconnect; override;
228		function GetConnected: Boolean; override;
229	<	procedure Loaded; override;
229	>	procedure CheckStreamConnect;
230	>	procedure HandleException(Sender: TObject);
231		procedure Notification( AComponent: TComponent; Operation: TOperation); override;
232		function GetDataset(Index : longint) : TDataset; override;
233		function GetDataSetCount : Longint; override;
234	<
234	>	procedure ReadState(Reader: TReader); override;
235	>	procedure SetConnected (Value : boolean); override;
236		public
237		constructor Create(AOwner: TComponent); override;
238		destructor Destroy; override;
#	Line 217 | Line 240 | type
240		procedure CloseDataSets;
241		procedure CheckActive;
242		procedure CheckInactive;
243	<	procedure CreateDatabase;
243	>	procedure CreateDatabase; overload;
244	>	procedure CreateDatabase(createDatabaseSQL: string); overload;
245		procedure DropDatabase;
246		procedure ForceClose;
247		procedure GetFieldNames(const TableName: string; List: TStrings);
#	Line 225 | Line 249 | type
249		function IndexOfDBConst(st: String): Integer;
250		function TestConnected: Boolean;
251		procedure CheckDatabaseName;
228	–	function Call(ErrCode: ISC_STATUS; RaiseError: Boolean): ISC_STATUS;
252		function AddTransaction(TR: TIBTransaction): Integer;
253		function FindTransaction(TR: TIBTransaction): Integer;
254		function FindDefaultTransaction(): TIBTransaction;
255		procedure RemoveTransaction(Idx: Integer);
256		procedure RemoveTransactions;
234	–	procedure SetHandle(Value: TISC_DB_HANDLE);
257
258	<	property Handle: TISC_DB_HANDLE read FHandle;
258	>	property Attachment: IAttachment read FAttachment;
259	>	property DBSQLDialect : Integer read FDBSQLDialect;
260		property IsReadOnly: Boolean read GetIsReadOnly;
238	–	property DBParamByDPB[const Idx: Integer]: String read GetDBParamByDPB
239	–	write SetDBParamByDPB;
261		property SQLObjectCount: Integer read GetSQLObjectCount;
262		property SQLObjects[Index: Integer]: TIBBase read GetSQLObject;
242	–	property HandleIsShared: Boolean read FHandleIsShared;
263		property TransactionCount: Integer read GetTransactionCount;
264		property Transactions[Index: Integer]: TIBTransaction read GetTransaction;
265		property InternalTransaction: TIBTransaction read FInternalTransaction;
266	+	property DefaultCharSetName: RawByteString read FDefaultCharSetName;
267	+	property DefaultCharSetID: integer read FDefaultCharSetID;
268	+	property DefaultCodePage: TSystemCodePage read FDefaultCodePage;
269
270		published
271		property Connected;
272	<	property StreamedConnected;
272	>	property CreateIfNotExists: boolean read FCreateIfNotExists write FCreateIfNotExists;
273	>	property AllowStreamedConnected: boolean read FAllowStreamedConnected
274	>	write FAllowStreamedConnected;
275		property DatabaseName: TIBFileName read FDBName write SetDatabaseName;
276		property Params: TStrings read FDBParams write SetDBParams;
277		property LoginPrompt default True;
#	Line 254 | Line 279 | type
279		write SetDefaultTransaction;
280		property IdleTimer: Integer read GetIdleTimer write SetIdleTimer;
281		property SQLDialect : Integer read GetSQLDialect write SetSQLDialect default 3;
282	<	property DBSQLDialect : Integer read FDBSQLDialect;
282	>	property SQLHourGlass: Boolean read FSQLHourGlass write FSQLHourGlass default true;
283		property TraceFlags: TTraceFlags read FTraceFlags write FTraceFlags;
284	+	property UseDefaultSystemCodePage: boolean read FUseDefaultSystemCodePage
285	+	write FUseDefaultSystemCodePage;
286		property AfterConnect;
287		property AfterDisconnect;
288		property BeforeConnect;
289		property BeforeDisconnect;
290	+	property OnCreateDatabase: TNotifyEvent read FOnCreateDatabase write FOnCreateDatabase;
291		property OnLogin: TIBDatabaseLoginEvent read FOnLogin write FOnLogin;
292		property OnIdleTimer: TNotifyEvent read FOnIdleTimer write FOnIdleTimer;
293		property OnDialectDowngradeWarning: TNotifyEvent read FOnDialectDowngradeWarning write FOnDialectDowngradeWarning;
294		end;
295
296	<	{ TIBTransaction }
296	>	TDefaultEndAction = TARollback..TACommit;
297
298	<	TTransactionAction         = (TARollback, TACommit, TARollbackRetaining, TACommitRetaining);
298	>	{ TIBTransaction }
299
300		TIBTransaction = class(TComponent)
301		private
302	<	FIBLoaded: Boolean;
303	<	FCanTimeout         : Boolean;
302	>	FTransactionIntf: ITransaction;
303	>	FAfterDelete: TNotifyEvent;
304	>	FAfterEdit: TNotifyEvent;
305	>	FAfterExecQuery: TNotifyEvent;
306	>	FAfterInsert: TNotifyEvent;
307	>	FAfterPost: TNotifyEvent;
308	>	FAfterTransactionEnd: TNotifyEvent;
309	>	FBeforeTransactionEnd: TNotifyEvent;
310		FDatabases          : TList;
311	+	FOnStartTransaction: TNotifyEvent;
312		FSQLObjects         : TList;
313		FDefaultDatabase    : TIBDatabase;
279	–	FHandle             : TISC_TR_HANDLE;
280	–	FHandleIsShared     : Boolean;
314		FOnIdleTimer          : TNotifyEvent;
315		FStreamedActive     : Boolean;
316	<	FTPB                : PChar;
317	<	FTPBLength          : Short;
318	<	FTimer              : TTimer;
286	<	FDefaultAction      : TTransactionAction;
316	>	FTPB                : ITPB;
317	>	FTimer              : TFPTimer;
318	>	FDefaultAction      : TDefaultEndAction;
319		FTRParams           : TStrings;
320		FTRParamsChanged    : Boolean;
321	+	FInEndTransaction   : boolean;
322	+	FEndAction          : TTransactionAction;
323	+	procedure DoBeforeTransactionEnd;
324	+	procedure DoAfterTransactionEnd;
325	+	procedure DoOnStartTransaction;
326	+	procedure DoAfterExecQuery(Sender: TObject);
327	+	procedure DoAfterEdit(Sender: TObject);
328	+	procedure DoAfterDelete(Sender: TObject);
329	+	procedure DoAfterInsert(Sender: TObject);
330	+	procedure DoAfterPost(Sender: TObject);
331		procedure EnsureNotInTransaction;
332		procedure EndTransaction(Action: TTransactionAction; Force: Boolean);
333		function GetDatabase(Index: Integer): TIBDatabase;
#	Line 296 | Line 338 | type
338		function GetIdleTimer: Integer;
339		procedure BeforeDatabaseDisconnect(DB: TIBDatabase);
340		procedure SetActive(Value: Boolean);
299	–	procedure SetDefaultAction(Value: TTransactionAction);
341		procedure SetDefaultDatabase(Value: TIBDatabase);
342		procedure SetIdleTimer(Value: Integer);
343		procedure SetTRParams(Value: TStrings);
#	Line 309 | Line 350 | type
350
351		protected
352		procedure Loaded; override;
312	–	procedure SetHandle(Value: TISC_TR_HANDLE);
353		procedure Notification( AComponent: TComponent; Operation: TOperation); override;
354
355		public
356		constructor Create(AOwner: TComponent); override;
357		destructor Destroy; override;
318	–	function Call(ErrCode: ISC_STATUS; RaiseError: Boolean): ISC_STATUS;
358		procedure Commit;
359		procedure CommitRetaining;
360		procedure Rollback;
#	Line 327 | Line 366 | type
366		function AddDatabase(db: TIBDatabase): Integer;
367		function FindDatabase(db: TIBDatabase): Integer;
368		function FindDefaultDatabase: TIBDatabase;
369	+	function GetEndAction: TTransactionAction;
370		procedure RemoveDatabase(Idx: Integer);
371		procedure RemoveDatabases;
372		procedure CheckDatabasesInList;
#	Line 335 | Line 375 | type
375		property Databases[Index: Integer]: TIBDatabase read GetDatabase;
376		property SQLObjectCount: Integer read GetSQLObjectCount;
377		property SQLObjects[Index: Integer]: TIBBase read GetSQLObject;
338	–	property Handle: TISC_TR_HANDLE read FHandle;
339	–	property HandleIsShared: Boolean read FHandleIsShared;
378		property InTransaction: Boolean read GetInTransaction;
379	<	property TPB: PChar read FTPB;
380	<	property TPBLength: Short read FTPBLength;
379	>	property TransactionIntf: ITransaction read FTransactionIntf;
380	>	property TPB: ITPB read FTPB;
381		published
382		property Active: Boolean read GetInTransaction write SetActive;
383		property DefaultDatabase: TIBDatabase read FDefaultDatabase
384		write SetDefaultDatabase;
385		property IdleTimer: Integer read GetIdleTimer write SetIdleTimer default 0;
386	<	property DefaultAction: TTransactionAction read FDefaultAction write SetDefaultAction default taCommit;
386	>	property DefaultAction: TDefaultEndAction read FDefaultAction write FDefaultAction default taCommit;
387		property Params: TStrings read FTRParams write SetTRParams;
388		property OnIdleTimer: TNotifyEvent read FOnIdleTimer write FOnIdleTimer;
389	<	end;
389	>	property BeforeTransactionEnd: TNotifyEvent read FBeforeTransactionEnd
390	>	write FBeforeTransactionEnd;
391	>	property AfterTransactionEnd: TNotifyEvent read FAfterTransactionEnd
392	>	write FAfterTransactionEnd;
393	>	property OnStartTransaction: TNotifyEvent read FOnStartTransaction
394	>	write FOnStartTransaction;
395	>	property AfterExecQuery: TNotifyEvent read FAfterExecQuery
396	>	write FAfterExecQuery;
397	>	property AfterEdit: TNotifyEvent read FAfterEdit write FAfterEdit;
398	>	property AfterDelete: TNotifyEvent read FAfterDelete write FAfterDelete;
399	>	property AfterInsert: TNotifyEvent read FAfterInsert write FAfterInsert;
400	>	property AfterPost: TNotifyEvent read FAfterPost write FAfterPost;
401	>	end;
402	>
403	>	TTransactionEndEvent = procedure(Sender:TObject; Action: TTransactionAction) of object;
404	>	TBeforeDatabaseConnectEvent = procedure (Sender: TObject; DBParams: TStrings;
405	>	var DBName: string) of object;
406
407		{ TIBBase }
408
#	Line 357 | Line 411 | type
411		connections. }
412		TIBBase = class(TObject)
413		protected
414	+	FBeforeDatabaseConnect: TBeforeDatabaseConnectEvent;
415		FDatabase: TIBDatabase;
416		FIndexInDatabase: Integer;
417		FTransaction: TIBTransaction;
#	Line 364 | Line 419 | type
419		FOwner: TObject;
420		FBeforeDatabaseDisconnect: TNotifyEvent;
421		FAfterDatabaseDisconnect: TNotifyEvent;
422	+	FAfterDatabaseConnect: TNotifyEvent;
423		FOnDatabaseFree: TNotifyEvent;
424	<	FBeforeTransactionEnd: TNotifyEvent;
424	>	FBeforeTransactionEnd: TTransactionEndEvent;
425		FAfterTransactionEnd: TNotifyEvent;
426		FOnTransactionFree: TNotifyEvent;
427
428	+	procedure DoBeforeDatabaseConnect(DBParams: TStrings;
429	+	var DBName: string); virtual;
430	+	procedure DoAfterDatabaseConnect; virtual;
431		procedure DoBeforeDatabaseDisconnect; virtual;
432		procedure DoAfterDatabaseDisconnect; virtual;
433		procedure DoDatabaseFree; virtual;
434	<	procedure DoBeforeTransactionEnd; virtual;
434	>	procedure DoBeforeTransactionEnd(Action: TTransactionAction); virtual;
435		procedure DoAfterTransactionEnd; virtual;
436		procedure DoTransactionFree; virtual;
378	–	function GetDBHandle: PISC_DB_HANDLE; virtual;
379	–	function GetTRHandle: PISC_TR_HANDLE; virtual;
437		procedure SetDatabase(Value: TIBDatabase); virtual;
438		procedure SetTransaction(Value: TIBTransaction); virtual;
439		public
#	Line 384 | Line 441 | type
441		destructor Destroy; override;
442		procedure CheckDatabase; virtual;
443		procedure CheckTransaction; virtual;
444	+	procedure DoAfterExecQuery(Sender: TObject); virtual;
445	+	procedure DoAfterEdit(Sender: TObject); virtual;
446	+	procedure DoAfterDelete(Sender: TObject); virtual;
447	+	procedure DoAfterInsert(Sender: TObject); virtual;
448	+	procedure DoAfterPost(Sender: TObject); virtual;
449	+	procedure HandleException(Sender: TObject);
450	+	procedure SetCursor;
451	+	procedure RestoreCursor;
452		public
453	+	property BeforeDatabaseConnect: TBeforeDatabaseConnectEvent read FBeforeDatabaseConnect
454	+	write FBeforeDatabaseConnect;
455	+	property AfterDatabaseConnect: TNotifyEvent read FAfterDatabaseConnect
456	+	write FAfterDatabaseConnect;
457		property BeforeDatabaseDisconnect: TNotifyEvent read FBeforeDatabaseDisconnect
458		write FBeforeDatabaseDisconnect;
459		property AfterDatabaseDisconnect: TNotifyEvent read FAfterDatabaseDisconnect
460		write FAfterDatabaseDisconnect;
461		property OnDatabaseFree: TNotifyEvent read FOnDatabaseFree write FOnDatabaseFree;
462	<	property BeforeTransactionEnd: TNotifyEvent read FBeforeTransactionEnd write FBeforeTransactionEnd;
462	>	property BeforeTransactionEnd: TTransactionEndEvent read FBeforeTransactionEnd write FBeforeTransactionEnd;
463		property AfterTransactionEnd: TNotifyEvent read FAfterTransactionEnd write FAfterTransactionEnd;
464		property OnTransactionFree: TNotifyEvent read FOnTransactionFree write FOnTransactionFree;
465		property Database: TIBDatabase read FDatabase
466		write SetDatabase;
398	–	property DBHandle: PISC_DB_HANDLE read GetDBHandle;
467		property Owner: TObject read FOwner;
400	–	property TRHandle: PISC_TR_HANDLE read GetTRHandle;
468		property Transaction: TIBTransaction read FTransaction
469		write SetTransaction;
470		end;
471
472	<	procedure GenerateDPB(sl: TStrings; var DPB: string; var DPBLength: Short);
473	<	procedure GenerateTPB(sl: TStrings; var TPB: string; var TPBLength: Short);
472	>	function GenerateDPB(sl: TStrings): IDPB;
473	>	function GenerateTPB(sl: TStrings): ITPB;
474
475
476		implementation
477
478	<	uses IBIntf,{$IFDEF HAS_SQLMONITOR}IBSQLMonitor,{$ENDIF} IBCustomDataSet, IBDatabaseInfo, IBSQL, IBUtils, typInfo;
478	>	uses  IBSQLMonitor, IBCustomDataSet, IBDatabaseInfo, IBSQL, IBUtils,
479	>	typInfo, FBMessages, IBErrorCodes, RegExpr;
480
481		{ TIBDatabase }
482
483	<	constructor TIBDatabase.Create(AOwner: TComponent);
483	>	constructor TIBDataBase.Create(AOwner: TComponent);
484		begin
485		inherited Create(AOwner);
418	–	FIBLoaded := False;
419	–	CheckIBLoaded;
420	–	FIBLoaded := True;
486		LoginPrompt := True;
487		FSQLObjects := TList.Create;
488		FTransactions := TList.Create;
489		FDBName := '';
490		FDBParams := TStringList.Create;
491	+	FSQLHourGlass := true;
492	+	if (AOwner <> nil) and
493	+	(AOwner is TCustomApplication) and
494	+	TCustomApplication(AOWner).ConsoleApplication then
495	+	LoginPrompt := false;
496		FDBParamsChanged := True;
497		TStringList(FDBParams).OnChange := DBParamsChange;
498		TStringList(FDBParams).OnChanging := DBParamsChanging;
499		FDPB := nil;
430	–	FHandle := nil;
500		FUserNames := nil;
501		FInternalTransaction := TIBTransaction.Create(self);
502		FInternalTransaction.DefaultDatabase := Self;
503	<	FTimer := TTimer.Create(Self);
503	>	FTimer := TFPTimer.Create(Self);
504		FTimer.Enabled := False;
505		FTimer.Interval := 0;
506		FTimer.OnTimer := TimeoutConnection;
#	Line 439 | Line 508 | begin
508		FSQLDialect := 3;
509		FTraceFlags := [];
510		FDataSets := TList.Create;
511	+	CheckStreamConnect;
512		end;
513
514	<	destructor TIBDatabase.Destroy;
514	>	destructor TIBDataBase.Destroy;
515		var
516		i: Integer;
517		begin
518	<	if FIBLoaded then
519	<	begin
520	<	IdleTimer := 0;
521	<	if FHandle <> nil then
522	<	ForceClose;
523	<	for i := 0 to FSQLObjects.Count - 1 do
524	<	if FSQLObjects[i] <> nil then
525	<	SQLObjects[i].DoDatabaseFree;
526	<	RemoveSQLObjects;
527	<	RemoveTransactions;
528	<	FInternalTransaction.Free;
529	<	FreeMem(FDPB);
530	<	FDPB := nil;
531	<	FDBParams.Free;
462	<	FSQLObjects.Free;
463	<	FUserNames.Free;
464	<	FTransactions.Free;
465	<	end;
518	>	IdleTimer := 0;
519	>	if FAttachment <> nil then
520	>	ForceClose;
521	>	for i := 0 to FSQLObjects.Count - 1 do
522	>	if FSQLObjects[i] <> nil then
523	>	SQLObjects[i].DoDatabaseFree;
524	>	RemoveSQLObjects;
525	>	RemoveTransactions;
526	>	FInternalTransaction.Free;
527	>	FDPB := nil;
528	>	FDBParams.Free;
529	>	FSQLObjects.Free;
530	>	FUserNames.Free;
531	>	FTransactions.Free;
532		FDataSets.Free;
533		inherited Destroy;
534		end;
535
536	<	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;
536	>	procedure TIBDataBase.CheckActive;
537		begin
538		if StreamedConnected and (not Connected) then
539		Loaded;
540	<	if FHandle = nil then
540	>	if FAttachment = nil then
541		IBError(ibxeDatabaseClosed, [nil]);
542		end;
543
544	<	procedure TIBDatabase.EnsureInactive;
544	>	procedure TIBDataBase.EnsureInactive;
545		begin
546		if csDesigning in ComponentState then
547		begin
548	<	if FHandle <> nil then
548	>	if FAttachment <> nil then
549		Close;
550		end
551		end;
552
553	<	procedure TIBDatabase.CheckInactive;
553	>	procedure TIBDataBase.CheckInactive;
554		begin
555	<	if FHandle <> nil then
555	>	if FAttachment <> nil then
556		IBError(ibxeDatabaseOpen, [nil]);
557		end;
558
559	<	procedure TIBDatabase.CheckDatabaseName;
559	>	procedure TIBDataBase.CheckDatabaseName;
560		begin
561	<	if (FDBName = '') then
561	>	if (Trim(FDBName) = '') then
562		IBError(ibxeDatabaseNameMissing, [nil]);
563		end;
564
565	<	function TIBDatabase.AddSQLObject(ds: TIBBase): Integer;
565	>	function TIBDataBase.AddSQLObject(ds: TIBBase): Integer;
566		begin
567		result := 0;
568		if (ds.Owner is TIBCustomDataSet) then
569	<	{$IFDEF LINUX}
513	<	FDataSets.Add(TDataSet(ds.Owner));
514	<	{$ELSE}
515	<	RegisterClient(TDataSet(ds.Owner));
516	<	{$ENDIF}
569	>	FDataSets.Add(ds.Owner);
570		while (result < FSQLObjects.Count) and (FSQLObjects[result] <> nil) do
571		Inc(result);
572		if (result = FSQLObjects.Count) then
#	Line 522 | Line 575 | begin
575		FSQLObjects[result] := ds;
576		end;
577
578	<	function TIBDatabase.AddTransaction(TR: TIBTransaction): Integer;
578	>	function TIBDataBase.AddTransaction(TR: TIBTransaction): Integer;
579		begin
580		result := FindTransaction(TR);
581		if result <> -1 then
#	Line 539 | Line 592 | begin
592		FTransactions[result] := TR;
593		end;
594
595	<	procedure TIBDatabase.DoDisconnect;
595	>	procedure TIBDataBase.DoDisconnect;
596		begin
597		if Connected then
598		InternalClose(False);
599		FDBSQLDialect := 1;
600	+	FDefaultCharSetName := '';
601	+	FDefaultCharSetID := 0;
602	+	FDefaultCodePage := CP_NONE;
603		end;
604
605	<	procedure TIBDatabase.CreateDatabase;
606	<	var
607	<	tr_handle: TISC_TR_HANDLE;
605	>	procedure TIBDataBase.CreateDatabase;
606	>	begin
607	>	CheckInactive;
608	>	CheckDatabaseName;
609	>	FCreateDatabase := true;
610	>	Connected := true;
611	>	end;
612	>
613	>	procedure TIBDataBase.CreateDatabase(createDatabaseSQL: string);
614	>	var RegexObj: TRegExpr;
615		begin
616		CheckInactive;
617	<	tr_handle := nil;
618	<	Call(
619	<	isc_dsql_execute_immediate(StatusVector, @FHandle, @tr_handle, 0,
620	<	PChar('CREATE DATABASE ''' + FDBName + ''' ' + {do not localize}
621	<	Params.Text), SQLDialect, nil),
622	<	True);
617	>	FAttachment := FirebirdAPI.CreateDatabase(createDatabaseSQL,FSQLDialect);
618	>	RegexObj := TRegExpr.Create;
619	>	try
620	>	{extact database file spec}
621	>	RegexObj.ModifierG := false; {turn off greedy matches}
622	>	RegexObj.Expression := '^ *CREATE +(DATABASE|SCHEMA) +''(.*)''';
623	>	if RegexObj.Exec(AnsiUpperCase(createDatabaseSQL)) then
624	>	FDBName := system.copy(createDatabaseSQL,RegexObj.MatchPos[2],RegexObj.MatchLen[2]);
625	>	finally
626	>	RegexObj.Free;
627	>	end;
628	>	if assigned(FOnCreateDatabase) and (FAttachment <> nil) then
629	>	OnCreateDatabase(self);
630		end;
631
632	<	procedure TIBDatabase.DropDatabase;
632	>	procedure TIBDataBase.DropDatabase;
633		begin
634		CheckActive;
635	<	Call(isc_drop_database(StatusVector, @FHandle), True);
635	>	FAttachment.DropDatabase;
636	>	FAttachment := nil;
637		end;
638
639	<	procedure TIBDatabase.DBParamsChange(Sender: TObject);
639	>	procedure TIBDataBase.DBParamsChange(Sender: TObject);
640		begin
641		FDBParamsChanged := True;
642		end;
643
644	<	procedure TIBDatabase.DBParamsChanging(Sender: TObject);
644	>	procedure TIBDataBase.DBParamsChanging(Sender: TObject);
645		begin
646		EnsureInactive;
647		CheckInactive;
648		end;
649
650	<	function TIBDatabase.FindTransaction(TR: TIBTransaction): Integer;
650	>	function TIBDataBase.FindTransaction(TR: TIBTransaction): Integer;
651		var
652		i: Integer;
653		begin
#	Line 589 | Line 660 | begin
660		end;
661		end;
662
663	<	function TIBDatabase.FindDefaultTransaction(): TIBTransaction;
663	>	function TIBDataBase.FindDefaultTransaction: TIBTransaction;
664		var
665		i: Integer;
666		begin
#	Line 607 | Line 678 | begin
678		end;
679		end;
680
681	<	procedure TIBDatabase.ForceClose;
681	>	procedure TIBDataBase.ForceClose;
682		begin
683		if Connected then
684		InternalClose(True);
685		end;
686
687	<	function TIBDatabase.GetConnected: Boolean;
687	>	function TIBDataBase.GetConnected: Boolean;
688		begin
689	<	result := FHandle <> nil;
689	>	result := (FAttachment <> nil) and FAttachment.IsConnected;
690		end;
691
692	<	function TIBDatabase.GetSQLObject(Index: Integer): TIBBase;
692	>	function TIBDataBase.GetSQLObject(Index: Integer): TIBBase;
693		begin
694		result := FSQLObjects[Index];
695		end;
696
697	<	function TIBDatabase.GetSQLObjectCount: Integer;
697	>	function TIBDataBase.GetSQLObjectCount: Integer;
698		var
699		i: Integer;
700		begin
#	Line 632 | Line 703 | begin
703		Inc(result);
704		end;
705
706	<	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;
706	>	function TIBDataBase.GetIdleTimer: Integer;
707		begin
708		result := FTimer.Interval;
709		end;
710
711	<	function TIBDatabase.GetTransaction(Index: Integer): TIBTransaction;
711	>	function TIBDataBase.GetTransaction(Index: Integer): TIBTransaction;
712		begin
713		result := FTransactions[Index];
714		end;
715
716	<	function TIBDatabase.GetTransactionCount: Integer;
716	>	function TIBDataBase.GetTransactionCount: Integer;
717		var
718		i: Integer;
719		begin
#	Line 675 | Line 723 | begin
723		Inc(result);
724		end;
725
726	<	function TIBDatabase.IndexOfDBConst(st: String): Integer;
726	>	function TIBDataBase.IndexOfDBConst(st: String): Integer;
727		var
728		i, pos_of_str: Integer;
729		begin
#	Line 691 | Line 739 | begin
739		end;
740		end;
741
742	<	procedure TIBDatabase.InternalClose(Force: Boolean);
742	>	procedure TIBDataBase.InternalClose(Force: Boolean);
743		var
744		i: Integer;
745		begin
#	Line 720 | Line 768 | begin
768		end;
769		end;
770
771	<	if (not HandleIsShared) and
772	<	(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;
771	>	FAttachment.Disconnect(Force);
772	>	FAttachment := nil;
773
733	–	{$IFDEF HAS_SQLMONITOR}
774		if not (csDesigning in ComponentState) then
775		MonitorHook.DBDisconnect(Self);
736	–	{$ENDIF}
776
777		for i := 0 to FSQLObjects.Count - 1 do
778		if FSQLObjects[i] <> nil then
779		SQLObjects[i].DoAfterDatabaseDisconnect;
780		end;
781
782	<	procedure TIBDatabase.Loaded;
782	>	procedure TIBDataBase.CheckStreamConnect;
783		var
784		i: integer;
785		begin
786		try
787	<	if StreamedConnected and (not Connected) then
787	>	if not (csDesigning in ComponentState) and StreamedConnected and (not Connected) then
788		begin
750	–	inherited Loaded;
789		for i := 0 to FTransactions.Count - 1 do
790		if  FTransactions[i] <> nil then
791		begin
#	Line 763 | Line 801 | begin
801		(FDefaultTransaction.FStreamedActive) and
802		(not FDefaultTransaction.InTransaction) then
803		FDefaultTransaction.StartTransaction;
804	<	FStreamedConnected := False;
804	>	StreamedConnected := False;
805		end;
806		except
807		if csDesigning in ComponentState then
808	<	Application.HandleException(Self)
808	>	HandleException(Self)
809		else
810		raise;
811		end;
812		end;
813
814	<	procedure TIBDatabase.Notification( AComponent: TComponent;
815	<	Operation: TOperation);
814	>	procedure TIBDataBase.HandleException(Sender: TObject);
815	>	var aParent: TComponent;
816	>	begin
817	>	aParent := Owner;
818	>	while aParent <> nil do
819	>	begin
820	>	if aParent is TCustomApplication then
821	>	begin
822	>	TCustomApplication(aParent).HandleException(Sender);
823	>	Exit;
824	>	end;
825	>	aParent := aParent.Owner;
826	>	end;
827	>	SysUtils.ShowException(ExceptObject,ExceptAddr);
828	>	end;
829	>
830	>	procedure TIBDataBase.Notification(AComponent: TComponent;
831	>	Operation: TOperation);
832		var
833		i: Integer;
834		begin
#	Line 788 | Line 842 | begin
842		end;
843		end;
844
845	<	function TIBDatabase.Login: Boolean;
845	>	function TIBDataBase.Login(var aDatabaseName: string): Boolean;
846		var
847		IndexOfUser, IndexOfPassword: Integer;
848		Username, Password, OldPassword: String;
#	Line 812 | Line 866 | var
866		end;
867
868		begin
869	<	if Assigned(FOnLogin) then
869	>	Result := false;
870	>	if FLoginCalled then Exit;
871	>	FLoginCalled := true;
872	>	try
873	>	if Assigned(FOnLogin) and not (csDesigning in ComponentState) then
874		begin
875		result := True;
876		LoginParams := TStringList.Create;
#	Line 820 | Line 878 | begin
878		LoginParams.Assign(Params);
879		FOnLogin(Self, LoginParams);
880		Params.Assign (LoginParams);
881	+	aDatabaseName := FDBName;
882		HidePassword;
883		finally
884		LoginParams.Free;
885		end;
886		end
887		else
888	+	if assigned(IBGUIInterface) then
889		begin
890		IndexOfUser := IndexOfDBConst(DPBConstantNames[isc_dpb_user_name]);
891		if IndexOfUser <> -1 then
#	Line 840 | Line 900 | begin
900		Length(Params[IndexOfPassword]));
901		OldPassword := password;
902		end;
903	<	result := LoginDialogEx(DatabaseName, Username, Password, False);
903	>
904	>	result := IBGUIInterface.LoginDialogEx(aDatabaseName, Username, Password, False);
905		if result then
906		begin
907	<	if IndexOfUser = -1 then
908	<	Params.Add(DPBConstantNames[isc_dpb_user_name] + '=' + Username)
909	<	else
910	<	Params[IndexOfUser] := DPBConstantNames[isc_dpb_user_name] +
907	>	if Username <> '' 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] +
913		'=' + Username;
914	+	end
915	+	else
916	+	if IndexOfUser <> -1 then
917	+	Params.Delete(IndexOfUser);
918		if (Password = OldPassword) then
919		FHiddenPassword := ''
920		else
#	Line 857 | Line 924 | begin
924		HidePassword;
925		end;
926		end;
927	+	end
928	+	else
929	+	if LoginPrompt then
930	+	IBError(ibxeNoLoginDialog,[]);
931	+	finally
932	+	FLoginCalled := false
933		end;
934		end;
935
936	<	procedure TIBDatabase.DoConnect;
936	>	procedure TIBDataBase.DoConnect;
937		var
865	–	DPB: String;
938		TempDBParams: TStrings;
939	<
939	>	I: integer;
940	>	aDBName: string;
941	>	Status: IStatus;
942	>	CharSetID: integer;
943		begin
944		CheckInactive;
945		CheckDatabaseName;
#	Line 874 | Line 949 | begin
949		FDBParamsChanged := True;
950		end;
951		{ Use builtin login prompt if requested }
952	<	if LoginPrompt and not Login then
952	>	aDBName := FDBName;
953	>	if (LoginPrompt or (csDesigning in ComponentState)) and not Login(aDBName) then
954		IBError(ibxeOperationCancelled, [nil]);
955	<	{ Generate a new DPB if necessary }
956	<	if (FDBParamsChanged) then
957	<	begin
958	<	FDBParamsChanged := False;
959	<	if (not LoginPrompt) or (FHiddenPassword = '') then
960	<	GenerateDPB(FDBParams, DPB, FDPBLength)
961	<	else
962	<	begin
963	<	TempDBParams := TStringList.Create;
964	<	try
965	<	TempDBParams.Assign(FDBParams);
966	<	TempDBParams.Add('password=' + FHiddenPassword);
967	<	GenerateDPB(TempDBParams, DPB, FDPBLength);
968	<	finally
969	<	TempDBParams.Free;
970	<	end;
971	<	end;
972	<	IBAlloc(FDPB, 0, FDPBLength);
973	<	Move(DPB[1], FDPB[0], FDPBLength);
974	<	end;
975	<	if Call(isc_attach_database(StatusVector, Length(FDBName),
976	<	PChar(FDBName), @FHandle,
977	<	FDPBLength, FDPB), False) > 0 then
978	<	begin
979	<	FHandle := nil;
980	<	IBDataBaseError;
955	>
956	>	TempDBParams := TStringList.Create;
957	>	try
958	>	TempDBParams.Assign(FDBParams);
959	>	{$ifdef UNIX}
960	>	{See below for WINDOWS UseDefaultSystemCodePage}
961	>	if UseDefaultSystemCodePage then
962	>	TempDBParams.Values['lc_ctype'] :='UTF8';
963	>	{$endif}
964	>	{Opportunity to override defaults}
965	>	for i := 0 to FSQLObjects.Count - 1 do
966	>	begin
967	>	if FSQLObjects[i] <> nil then
968	>	SQLObjects[i].DoBeforeDatabaseConnect(TempDBParams,aDBName);
969	>	end;
970	>
971	>	repeat
972	>	{ Generate a new DPB if necessary }
973	>	if (FDPB = nil) or FDBParamsChanged or (TempDBParams.Text <> FDBParams.Text) then
974	>	begin
975	>	FDBParamsChanged := False;
976	>	if (not LoginPrompt and not (csDesigning in ComponentState)) or (FHiddenPassword = '') then
977	>	FDPB := GenerateDPB(TempDBParams)
978	>	else
979	>	begin
980	>	TempDBParams.Values['password'] := FHiddenPassword;
981	>	FDPB := GenerateDPB(TempDBParams);
982	>	end;
983	>	end;
984	>
985	>	if FCreateDatabase then
986	>	begin
987	>	FCreateDatabase := false;
988	>	FAttachment := FirebirdAPI.CreateDatabase(aDBName,FDPB, false);
989	>	if assigned(FOnCreateDatabase) and (FAttachment <> nil) then
990	>	OnCreateDatabase(self);
991	>	end
992	>	else
993	>	FAttachment := FirebirdAPI.OpenDatabase(aDBName,FDPB,false);
994	>
995	>	if FAttachment = nil then
996	>	begin
997	>	Status := FirebirdAPI.GetStatus;
998	>	{$IFDEF UNIX}
999	>	if Pos(':',aDBName) = 0 then
1000	>	begin
1001	>	if ((Status.GetSQLCode = -901) and (Status.GetIBErrorCode = isc_random)) {Access permissions on firebird temp}
1002	>	or
1003	>	((Status.GetSQLCode = -902) and (Status.GetIBErrorCode = isc_sys_request)) {Security DB Problem}
1004	>	or
1005	>	((Status.GetSQLCode = -902) and (Status.GetIBErrorCode = isc_psw_attach)) {Security DB Problem}
1006	>	or
1007	>	((Status.GetSQLCode = -904) and (Status.GetIBErrorCode = isc_lock_dir_access)) {Lock File Problem}
1008	>	then
1009	>	begin
1010	>	aDBName := 'localhost:' + aDBName;
1011	>	Continue;
1012	>	end
1013	>	end;
1014	>	{$ENDIF}
1015	>	if ((Status.GetSQLCode = -902) and (Status.GetIBErrorCode = isc_io_error)) {Database not found}
1016	>	and CreateIfNotExists and not (csDesigning in ComponentState) then
1017	>	FCreateDatabase := true
1018	>	else
1019	>	raise EIBInterBaseError.Create(Status);
1020	>	end;
1021	>
1022	>	if UseDefaultSystemCodePage and (FAttachment <> nil) then
1023	>	{Only now can we check the codepage in use by the Attachment.
1024	>	If not that required then re-open with required LCLType.}
1025	>	begin
1026	>	{$ifdef WINDOWS}
1027	>	if Attachment.CodePage2CharSetID(GetACP,CharSetID) then
1028	>	{$else}
1029	>	if Attachment.CodePage2CharSetID(DefaultSystemCodePage,CharSetID) then
1030	>	{$endif}
1031	>	begin
1032	>	FDefaultCharSetName := Attachment.GetCharsetName(CharSetID);
1033	>	if FDefaultCharSetName <> AnsiUpperCase(TempDBParams.Values['lc_ctype']) then
1034	>	begin
1035	>	TempDBParams.Values['lc_ctype'] := FDefaultCharSetName;
1036	>	FDBParamsChanged := True;
1037	>	FAttachment := nil;
1038	>	end
1039	>	end
1040	>	end;
1041	>
1042	>	until FAttachment <> nil;
1043	>
1044	>	FDefaultCharSetName := AnsiUpperCase(TempDBParams.Values['lc_ctype']);
1045	>	finally
1046	>	TempDBParams.Free;
1047		end;
1048	+	if FDefaultCharSetName <> '' then
1049	+	Attachment.CharSetName2CharSetID(FDefaultCharSetName,FDefaultCharSetID);
1050	+	Attachment.CharSetID2CodePage(FDefaultCharSetID,FDefaultCodePage);
1051	+
1052	+	if not (csDesigning in ComponentState) then
1053	+	FDBName := aDBName; {Synchronise at run time}
1054		FDBSQLDialect := GetDBSQLDialect;
1055		ValidateClientSQLDialect;
1056	<	{$IFDEF HAS_SQLMONITOR}
1056	>	for i := 0 to FSQLObjects.Count - 1 do
1057	>	begin
1058	>	if FSQLObjects[i] <> nil then
1059	>	SQLObjects[i].DoAfterDatabaseConnect;
1060	>	end;
1061		if not (csDesigning in ComponentState) then
1062		MonitorHook.DBConnect(Self);
911	–	{$ENDIF}
1063		end;
1064
1065	<	procedure TIBDatabase.RemoveSQLObject(Idx: Integer);
1065	>	procedure TIBDataBase.RemoveSQLObject(Idx: Integer);
1066		var
1067		ds: TIBBase;
1068		begin
#	Line 921 | Line 1072 | begin
1072		FSQLObjects[Idx] := nil;
1073		ds.Database := nil;
1074		if (ds.owner is TDataSet) then
924	–	{$IFDEF LINUX}
1075		FDataSets.Remove(TDataSet(ds.Owner));
926	–	{$ELSE}
927	–	UnregisterClient(TDataSet(ds.Owner));
928	–	{$ENDIF}
1076		end;
1077		end;
1078
1079	<	procedure TIBDatabase.RemoveSQLObjects;
1079	>	procedure TIBDataBase.RemoveSQLObjects;
1080		var
1081		i: Integer;
1082		begin
#	Line 937 | Line 1084 | begin
1084		begin
1085		RemoveSQLObject(i);
1086		if (TIBBase(FSQLObjects[i]).owner is TDataSet) then
940	–	{$IFDEF LINUX}
1087		FDataSets.Remove(TDataSet(TIBBase(FSQLObjects[i]).owner));
942	–	{$ELSE}
943	–	UnregisterClient(TDataSet(TIBBase(FSQLObjects[i]).owner));
944	–	{$ENDIF}
1088		end;
1089		end;
1090
1091	<	procedure TIBDatabase.RemoveTransaction(Idx: Integer);
1091	>	procedure TIBDataBase.RemoveTransaction(Idx: Integer);
1092		var
1093		TR: TIBTransaction;
1094		begin
#	Line 959 | Line 1102 | begin
1102		end;
1103		end;
1104
1105	<	procedure TIBDatabase.RemoveTransactions;
1105	>	procedure TIBDataBase.RemoveTransactions;
1106		var
1107		i: Integer;
1108		begin
#	Line 967 | Line 1110 | begin
1110		RemoveTransaction(i);
1111		end;
1112
1113	<	procedure TIBDatabase.SetDatabaseName(const Value: TIBFileName);
1113	>	procedure TIBDataBase.SetDatabaseName( const Value: TIBFileName);
1114		begin
1115		if FDBName <> Value then
1116		begin
#	Line 977 | Line 1120 | begin
1120		end;
1121		end;
1122
1123	<	procedure TIBDatabase.SetDBParamByDPB(const Idx: Integer; Value: String);
1123	>	procedure TIBDataBase.SetDBParamByDPB( const Idx: Integer; Value: String);
1124		var
1125		ConstIdx: Integer;
1126		begin
#	Line 996 | Line 1139 | begin
1139		end;
1140		end;
1141
1142	<	procedure TIBDatabase.SetDBParams(Value: TStrings);
1142	>	procedure TIBDataBase.SetDBParams(Value: TStrings);
1143		begin
1144		FDBParams.Assign(Value);
1145		end;
1146
1147	<	procedure TIBDatabase.SetDefaultTransaction(Value: TIBTransaction);
1147	>	procedure TIBDataBase.SetDefaultTransaction(Value: TIBTransaction);
1148		var
1149		i: Integer;
1150		begin
#	Line 1019 | Line 1162 | begin
1162		FDefaultTransaction := Value;
1163		end;
1164
1165	<	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);
1165	>	procedure TIBDataBase.SetIdleTimer(Value: Integer);
1166		begin
1167		if Value < 0 then
1168		IBError(ibxeTimeoutNegative, [nil])
#	Line 1048 | Line 1181 | begin
1181		end;
1182		end;
1183
1184	<	function TIBDatabase.TestConnected: Boolean;
1184	>	function TIBDataBase.TestConnected: Boolean;
1185		var
1186		DatabaseInfo: TIBDatabaseInfo;
1187		begin
#	Line 1069 | Line 1202 | begin
1202		end;
1203		end;
1204
1205	<	procedure TIBDatabase.TimeoutConnection(Sender: TObject);
1205	>	procedure TIBDataBase.TimeoutConnection(Sender: TObject);
1206		begin
1207		if Connected then
1208		begin
1209	<	if FCanTimeout then
1209	>	if not FAttachment.HasActivity then
1210		begin
1211		ForceClose;
1212		if Assigned(FOnIdleTimer) then
1213		FOnIdleTimer(Self);
1214		end
1082	–	else
1083	–	FCanTimeout := True;
1215		end;
1216		end;
1217
1218	<	function TIBDatabase.GetIsReadOnly: Boolean;
1218	>	function TIBDataBase.GetIsReadOnly: Boolean;
1219		var
1220		DatabaseInfo: TIBDatabaseInfo;
1221		begin
#	Line 1102 | Line 1233 | begin
1233		DatabaseInfo.Free;
1234		end;
1235
1236	<	function TIBDatabase.GetSQLDialect: Integer;
1236	>	function TIBDataBase.GetSQLDialect: Integer;
1237		begin
1238		Result := FSQLDialect;
1239		end;
1240
1241	<	procedure TIBDatabase.SetSQLDialect(const Value: Integer);
1241	>
1242	>	procedure TIBDataBase.SetSQLDialect( const Value: Integer);
1243		begin
1244		if (Value < 1) then IBError(ibxeSQLDialectInvalid, [nil]);
1245	<	if ((FHandle = nil) or (Value <= FDBSQLDialect))  then
1245	>	if ((FAttachment = nil) or (Value <= FDBSQLDialect))  then
1246		FSQLDialect := Value
1247		else
1248		IBError(ibxeSQLDialectInvalid, [nil]);
1249		end;
1250
1251	<	function TIBDatabase.GetDBSQLDialect: Integer;
1251	>	function TIBDataBase.GetDBSQLDialect: Integer;
1252		var
1253		DatabaseInfo: TIBDatabaseInfo;
1254		begin
#	Line 1126 | Line 1258 | begin
1258		DatabaseInfo.Free;
1259		end;
1260
1261	<	procedure TIBDatabase.ValidateClientSQLDialect;
1261	>	procedure TIBDataBase.ValidateClientSQLDialect;
1262		begin
1263		if (FDBSQLDialect < FSQLDialect) then
1264		begin
#	Line 1136 | Line 1268 | begin
1268		end;
1269		end;
1270
1271	<	procedure TIBDatabase.ApplyUpdates(const DataSets: array of TDataSet);
1271	>	procedure TIBDataBase.ApplyUpdates( const DataSets: array of TDataSet);
1272		var
1273		I: Integer;
1274		DS: TIBCustomDataSet;
#	Line 1162 | Line 1294 | begin
1294		TR.CommitRetaining;
1295		end;
1296
1297	<	procedure TIBDatabase.CloseDataSets;
1297	>	procedure TIBDataBase.CloseDataSets;
1298		var
1299		i: Integer;
1300		begin
#	Line 1171 | Line 1303 | begin
1303		DataSets[i].close;
1304		end;
1305
1306	<	function TIBDatabase.GetDataset(Index : longint) : TDataset;
1306	>	function TIBDataBase.GetDataset(Index: longint): TDataset;
1307		begin
1308		if (Index >= 0) and (Index < FDataSets.Count) then
1309		Result := TDataSet(FDataSets[Index])
#	Line 1179 | Line 1311 | begin
1311		raise Exception.Create('Invalid Index to DataSets');
1312		end;
1313
1314	<	function TIBDatabase.GetDataSetCount : Longint;
1314	>	function TIBDataBase.GetDataSetCount: Longint;
1315		begin
1316		Result := FDataSets.Count;
1317		end;
1318
1319	<	procedure TIBDatabase.GetFieldNames(const TableName: string; List: TStrings);
1319	>	procedure TIBDataBase.ReadState(Reader: TReader);
1320	>	begin
1321	>	FDBParams.Clear;
1322	>	inherited ReadState(Reader);
1323	>	end;
1324	>
1325	>	procedure TIBDataBase.SetConnected(Value: boolean);
1326	>	begin
1327	>	if StreamedConnected and not AllowStreamedConnected then
1328	>	begin
1329	>	StreamedConnected := false;
1330	>	Value := false
1331	>	end;
1332	>	inherited SetConnected(Value);
1333	>	end;
1334	>
1335	>	procedure TIBDataBase.GetFieldNames( const TableName: string; List: TStrings);
1336		var
1337		Query: TIBSQL;
1338		begin
#	Line 1213 | Line 1361 | begin
1361		BeginUpdate;
1362		try
1363		Clear;
1364	<	while (not Query.EOF) and (Query.Next <> nil) do
1365	<	List.Add(TrimRight(Query.Current.ByName('RDB$FIELD_NAME').AsString)); {do not localize}
1364	>	while (not Query.EOF) and Query.Next  do
1365	>	List.Add(TrimRight(Query.FieldByName('RDB$FIELD_NAME').AsString)); {do not localize}
1366		finally
1367		EndUpdate;
1368		end;
#	Line 1225 | Line 1373 | begin
1373		end;
1374		end;
1375
1376	<	procedure TIBDatabase.GetTableNames(List: TStrings; SystemTables: Boolean);
1376	>	procedure TIBDataBase.GetTableNames(List: TStrings; SystemTables: Boolean);
1377		var
1378		Query : TIBSQL;
1379		begin
#	Line 1253 | Line 1401 | begin
1401		BeginUpdate;
1402		try
1403		Clear;
1404	<	while (not Query.EOF) and (Query.Next <> nil) do
1405	<	List.Add(TrimRight(Query.Current[0].AsString));
1404	>	while (not Query.EOF) and Query.Next  do
1405	>	List.Add(TrimRight(Query.Fields[0].AsString));
1406		finally
1407		EndUpdate;
1408		end;
#	Line 1271 | Line 1419 | end;
1419		constructor TIBTransaction.Create(AOwner: TComponent);
1420		begin
1421		inherited Create(AOwner);
1274	–	FIBLoaded := False;
1275	–	CheckIBLoaded;
1276	–	FIBLoaded := True;
1277	–	CheckIBLoaded;
1422		FDatabases := TList.Create;
1423		FSQLObjects := TList.Create;
1280	–	FHandle := nil;
1424		FTPB := nil;
1282	–	FTPBLength := 0;
1425		FTRParams := TStringList.Create;
1426		FTRParamsChanged := True;
1427		TStringList(FTRParams).OnChange := TRParamsChange;
1428		TStringList(FTRParams).OnChanging := TRParamsChanging;
1429	<	FTimer := TTimer.Create(Self);
1429	>	FTimer := TFPTimer.Create(Self);
1430		FTimer.Enabled := False;
1431		FTimer.Interval := 0;
1432		FTimer.OnTimer := TimeoutTransaction;
#	Line 1295 | Line 1437 | destructor TIBTransaction.Destroy;
1437		var
1438		i: Integer;
1439		begin
1440	<	if FIBLoaded then
1441	<	begin
1442	<	if InTransaction then
1443	<	EndTransaction(FDefaultAction, True);
1444	<	for i := 0 to FSQLObjects.Count - 1 do
1445	<	if FSQLObjects[i] <> nil then
1446	<	SQLObjects[i].DoTransactionFree;
1447	<	RemoveSQLObjects;
1448	<	RemoveDatabases;
1449	<	FreeMem(FTPB);
1450	<	FTPB := nil;
1309	<	FTRParams.Free;
1310	<	FSQLObjects.Free;
1311	<	FDatabases.Free;
1312	<	end;
1440	>	if InTransaction then
1441	>	EndTransaction(FDefaultAction, True);
1442	>	for i := 0 to FSQLObjects.Count - 1 do
1443	>	if FSQLObjects[i] <> nil then
1444	>	SQLObjects[i].DoTransactionFree;
1445	>	RemoveSQLObjects;
1446	>	RemoveDatabases;
1447	>	FTPB := nil;
1448	>	FTRParams.Free;
1449	>	FSQLObjects.Free;
1450	>	FDatabases.Free;
1451		inherited Destroy;
1452		end;
1453
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	–
1454		procedure TIBTransaction.CheckDatabasesInList;
1455		begin
1456		if GetDatabaseCount = 0 then
#	Line 1336 | Line 1461 | procedure TIBTransaction.CheckInTransact
1461		begin
1462		if FStreamedActive and (not InTransaction) then
1463		Loaded;
1464	<	if (FHandle = nil) then
1464	>	if (TransactionIntf = nil) then
1465		IBError(ibxeNotInTransaction, [nil]);
1466		end;
1467
1468	+	procedure TIBTransaction.DoBeforeTransactionEnd;
1469	+	begin
1470	+	if Assigned(FBeforeTransactionEnd) then
1471	+	FBeforeTransactionEnd(self);
1472	+	end;
1473	+
1474	+	procedure TIBTransaction.DoAfterTransactionEnd;
1475	+	begin
1476	+	if Assigned(FAfterTransactionEnd) then
1477	+	FAfterTransactionEnd(self);
1478	+	end;
1479	+
1480	+	procedure TIBTransaction.DoOnStartTransaction;
1481	+	begin
1482	+	if assigned(FOnStartTransaction) then
1483	+	OnStartTransaction(self);
1484	+	end;
1485	+
1486	+	procedure TIBTransaction.DoAfterExecQuery(Sender: TObject);
1487	+	begin
1488	+	if assigned(FAfterExecQuery) then
1489	+	AfterExecQuery(Sender);
1490	+	end;
1491	+
1492	+	procedure TIBTransaction.DoAfterEdit(Sender: TObject);
1493	+	begin
1494	+	if assigned(FAfterEdit) then
1495	+	AfterEdit(Sender);
1496	+	end;
1497	+
1498	+	procedure TIBTransaction.DoAfterDelete(Sender: TObject);
1499	+	begin
1500	+	if assigned(FAfterDelete) then
1501	+	AfterDelete(Sender);
1502	+	end;
1503	+
1504	+	procedure TIBTransaction.DoAfterInsert(Sender: TObject);
1505	+	begin
1506	+	if assigned(FAfterInsert) then
1507	+	AfterInsert(Sender);
1508	+	end;
1509	+
1510	+	procedure TIBTransaction.DoAfterPost(Sender: TObject);
1511	+	begin
1512	+	if assigned(FAfterPost) then
1513	+	AfterPost(Sender);
1514	+	end;
1515	+
1516		procedure TIBTransaction.EnsureNotInTransaction;
1517		begin
1518		if csDesigning in ComponentState then
1519		begin
1520	<	if FHandle <> nil then
1520	>	if TransactionIntf <> nil then
1521		Rollback;
1522		end;
1523		end;
1524
1525		procedure TIBTransaction.CheckNotInTransaction;
1526		begin
1527	<	if (FHandle <> nil) then
1527	>	if (TransactionIntf <> nil) and  TransactionIntf.InTransaction then
1528		IBError(ibxeInTransaction, [nil]);
1529		end;
1530
#	Line 1360 | Line 1533 | var
1533		i: Integer;
1534		NilFound: Boolean;
1535		begin
1536	+	EnsureNotInTransaction;
1537	+	CheckNotInTransaction;
1538	+	FTransactionIntf := nil;
1539	+
1540		i := FindDatabase(db);
1541		if i <> -1 then
1542		begin
#	Line 1410 | Line 1587 | end;
1587		procedure TIBTransaction.EndTransaction(Action: TTransactionAction;
1588		Force: Boolean);
1589		var
1413	–	status: ISC_STATUS;
1590		i: Integer;
1591		begin
1592		CheckInTransaction;
1593	+	if FInEndTransaction then Exit;
1594	+	FInEndTransaction := true;
1595	+	FEndAction := Action;
1596	+	try
1597		case Action of
1598		TARollback, TACommit:
1599		begin
1600	<	if (HandleIsShared) and
1421	<	(Action <> FDefaultAction) and
1422	<	(not Force) then
1423	<	IBError(ibxeCantEndSharedTransaction, [nil]);
1600	>	DoBeforeTransactionEnd;
1601		for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then
1602	<	SQLObjects[i].DoBeforeTransactionEnd;
1602	>	SQLObjects[i].DoBeforeTransactionEnd(Action);
1603		if InTransaction then
1604		begin
1605	<	if HandleIsShared then
1606	<	begin
1430	<	FHandle := nil;
1431	<	FHandleIsShared := False;
1432	<	status := 0;
1433	<	end
1434	<	else
1435	<	if (Action = TARollback) then
1436	<	status := Call(isc_rollback_transaction(StatusVector, @FHandle), False)
1437	<	else
1438	<	status := Call(isc_commit_transaction(StatusVector, @FHandle), False);
1439	<	if ((Force) and (status > 0)) then
1440	<	status := Call(isc_rollback_transaction(StatusVector, @FHandle), False);
1441	<	if Force then
1442	<	FHandle := nil
1605	>	if (Action = TARollback) then
1606	>	FTransactionIntf.Rollback(Force)
1607		else
1608	<	if (status > 0) then
1609	<	IBDataBaseError;
1608	>	try
1609	>	FTransactionIntf.Commit;
1610	>	except on E: EIBInterBaseError do
1611	>	begin
1612	>	if Force then
1613	>	FTransactionIntf.Rollback(Force)
1614	>	else
1615	>	raise;
1616	>	end;
1617	>	end;
1618	>
1619		for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then
1620		SQLObjects[i].DoAfterTransactionEnd;
1621	+	DoAfterTransactionEnd;
1622		end;
1623		end;
1624		TACommitRetaining:
1625	<	Call(isc_commit_retaining(StatusVector, @FHandle), True);
1625	>	FTransactionIntf.CommitRetaining;
1626	>
1627		TARollbackRetaining:
1628	<	Call(isc_rollback_retaining(StatusVector, @FHandle), True);
1628	>	FTransactionIntf.RollbackRetaining;
1629		end;
1455	–	{$IFDEF HAS_SQLMONITOR}
1630		if not (csDesigning in ComponentState) then
1631		begin
1632		case Action of
#	Line 1466 | Line 1640 | begin
1640		MonitorHook.TRRollbackRetaining(Self);
1641		end;
1642		end;
1643	<	{$ENDIF}
1643	>	finally
1644	>	FInEndTransaction := false
1645	>	end;
1646		end;
1647
1648		function TIBTransaction.GetDatabase(Index: Integer): TIBDatabase;
#	Line 1501 | Line 1677 | end;
1677
1678		function TIBTransaction.GetInTransaction: Boolean;
1679		begin
1680	<	result := (FHandle <> nil);
1680	>	result := (TransactionIntf <> nil) and TransactionIntf.InTransaction;
1681		end;
1682
1683		function TIBTransaction.FindDatabase(db: TIBDatabase): Integer;
#	Line 1534 | Line 1710 | begin
1710		end;
1711		end;
1712
1713	+	function TIBTransaction.GetEndAction: TTransactionAction;
1714	+	begin
1715	+	if FInEndTransaction then
1716	+	Result := FEndAction
1717	+	else
1718	+	IBError(ibxeIB60feature, [nil])
1719	+	end;
1720	+
1721
1722		function TIBTransaction.GetIdleTimer: Integer;
1723		begin
#	Line 1549 | Line 1733 | procedure TIBTransaction.BeforeDatabaseD
1733		begin
1734		if InTransaction then
1735		EndTransaction(FDefaultAction, True);
1736	+	FTransactionIntf := nil;
1737		end;
1738
1739		procedure TIBTransaction.RemoveDatabase(Idx: Integer);
#	Line 1557 | Line 1742 | var
1742		begin
1743		if ((Idx >= 0) and (FDatabases[Idx] <> nil)) then
1744		begin
1745	+	EnsureNotInTransaction;
1746	+	CheckNotInTransaction;
1747	+	FTransactionIntf := nil;
1748	+
1749		DB := Databases[Idx];
1750		FDatabases[Idx] := nil;
1751		DB.RemoveTransaction(DB.FindTransaction(Self));
#	Line 1569 | Line 1758 | procedure TIBTransaction.RemoveDatabases
1758		var
1759		i: Integer;
1760		begin
1761	+	EnsureNotInTransaction;
1762	+	CheckNotInTransaction;
1763	+	FTransactionIntf := nil;
1764	+
1765		for i := 0 to FDatabases.Count - 1 do if FDatabases[i] <> nil then
1766		RemoveDatabase(i);
1767		end;
#	Line 1615 | Line 1808 | begin
1808		Rollback;
1809		end;
1810
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	–
1811		procedure TIBTransaction.SetDefaultDatabase(Value: TIBDatabase);
1812		var
1813		i: integer;
#	Line 1639 | Line 1825 | begin
1825		for i := 0 to FSQLObjects.Count - 1 do
1826		if (FSQLObjects[i] <> nil) and
1827		(TIBBase(FSQLObjects[i]).Database = nil) then
1828	<	SetOrdProp(TIBBase(FSQLObjects[i]).Owner, 'Database', Integer(Value));
1828	>	SetObjectProp(TIBBase(FSQLObjects[i]).Owner, 'Database', Value);
1829		end;
1830		FDefaultDatabase := Value;
1831		end;
1832
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	–
1833		procedure TIBTransaction.Notification( AComponent: TComponent;
1834		Operation: TOperation);
1835		var
#	Line 1695 | Line 1871 | end;
1871
1872		procedure TIBTransaction.StartTransaction;
1873		var
1698	–	pteb: PISC_TEB_ARRAY;
1699	–	TPB: String;
1874		i: Integer;
1875	+	Attachments: array of IAttachment;
1876	+	ValidDatabaseCount: integer;
1877		begin
1878		CheckNotInTransaction;
1879		CheckDatabasesInList;
1880	+	if TransactionIntf <> nil then
1881	+	begin
1882	+	TransactionIntf.Start(DefaultAction);
1883	+	Exit;
1884	+	end;
1885	+
1886		for i := 0 to FDatabases.Count - 1 do
1887		if  FDatabases[i] <> nil then
1888		begin
1889		with TIBDatabase(FDatabases[i]) do
1890		if not Connected then
1891	<	if FStreamedConnected then
1891	>	if StreamedConnected then
1892		begin
1893		Open;
1894	<	FStreamedConnected := False;
1894	>	StreamedConnected := False;
1895		end
1896		else
1897		IBError(ibxeDatabaseClosed, [nil]);
#	Line 1717 | Line 1899 | begin
1899		if FTRParamsChanged then
1900		begin
1901		FTRParamsChanged := False;
1902	<	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;
1902	>	FTPB :=  GenerateTPB(FTRParams);
1903		end;
1904
1905	<	pteb := nil;
1906	<	IBAlloc(pteb, 0, DatabaseCount * SizeOf(TISC_TEB));
1907	<	try
1908	<	for i := 0 to DatabaseCount - 1 do if Databases[i] <> nil then
1909	<	begin
1910	<	pteb^[i].db_handle := @(Databases[i].Handle);
1911	<	pteb^[i].tpb_length := FTPBLength;
1912	<	pteb^[i].tpb_address := FTPB;
1913	<	end;
1914	<	if Call(isc_start_multiple(StatusVector, @FHandle,
1915	<	DatabaseCount, PISC_TEB(pteb)), False) > 0 then
1916	<	begin
1917	<	FHandle := nil;
1918	<	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);
1905	>	ValidDatabaseCount := 0;
1906	>	for i := 0 to DatabaseCount - 1 do
1907	>	if Databases[i] <> nil then Inc(ValidDatabaseCount);
1908	>
1909	>	if ValidDatabaseCount = 1 then
1910	>	FTransactionIntf := Databases[0].Attachment.StartTransaction(FTPB,DefaultAction)
1911	>	else
1912	>	begin
1913	>	SetLength(Attachments,ValidDatabaseCount);
1914	>	for i := 0 to DatabaseCount - 1 do
1915	>	if Databases[i] <> nil then
1916	>	Attachments[i] := Databases[i].Attachment;
1917	>
1918	>	FTransactionIntf := FirebirdAPI.StartTransaction(Attachments,FTPB,DefaultAction);
1919		end;
1920	+
1921	+	if not (csDesigning in ComponentState) then
1922	+	MonitorHook.TRStart(Self);
1923	+	DoOnStartTransaction;
1924		end;
1925
1926		procedure TIBTransaction.TimeoutTransaction(Sender: TObject);
1927		begin
1928		if InTransaction then
1929		begin
1930	<	if FCanTimeout then
1930	>	if not TransactionIntf.HasActivity then
1931		begin
1932		EndTransaction(FDefaultAction, True);
1933		if Assigned(FOnIdleTimer) then
1934		FOnIdleTimer(Self);
1935		end
1762	–	else
1763	–	FCanTimeout := True;
1936		end;
1937		end;
1938
#	Line 1773 | Line 1945 | procedure TIBTransaction.TRParamsChangin
1945		begin
1946		EnsureNotInTransaction;
1947		CheckNotInTransaction;
1948	+	FTransactionIntf := nil;
1949		end;
1950
1951		{ TIBBase }
#	Line 1788 | Line 1961 | begin
1961		inherited Destroy;
1962		end;
1963
1964	+	procedure TIBBase.HandleException(Sender: TObject);
1965	+	begin
1966	+	if assigned(Database) then
1967	+	Database.HandleException(Sender)
1968	+	else
1969	+	SysUtils.ShowException(ExceptObject,ExceptAddr);
1970	+	end;
1971	+
1972	+	procedure TIBBase.SetCursor;
1973	+	begin
1974	+	if Assigned(Database) and not Database.SQLHourGlass then
1975	+	Exit;
1976	+	if assigned(IBGUIInterface) then
1977	+	IBGUIInterface.SetCursor;
1978	+	end;
1979	+
1980	+	procedure TIBBase.RestoreCursor;
1981	+	begin
1982	+	if Assigned(Database) and not Database.SQLHourGlass then
1983	+	Exit;
1984	+	if assigned(IBGUIInterface) then
1985	+	IBGUIInterface.RestoreCursor;
1986	+	end;
1987	+
1988		procedure TIBBase.CheckDatabase;
1989		begin
1990		if (FDatabase = nil) then
#	Line 1802 | Line 1999 | begin
1999		FTransaction.CheckInTransaction;
2000		end;
2001
2002	<	function TIBBase.GetDBHandle: PISC_DB_HANDLE;
2002	>	procedure TIBBase.DoBeforeDatabaseConnect(DBParams: TStrings; var DBName: string
2003	>	);
2004		begin
2005	<	CheckDatabase;
2006	<	result := @FDatabase.Handle;
2005	>	if assigned(FBeforeDatabaseConnect) then
2006	>	BeforeDatabaseConnect(self,DBParams,DBName);
2007		end;
2008
2009	<	function TIBBase.GetTRHandle: PISC_TR_HANDLE;
2009	>	procedure TIBBase.DoAfterDatabaseConnect;
2010		begin
2011	<	CheckTransaction;
2012	<	result := @FTransaction.Handle;
2011	>	if assigned(FAfterDatabaseConnect) then
2012	>	AfterDatabaseConnect(self);
2013		end;
2014
2015		procedure TIBBase.DoBeforeDatabaseDisconnect;
#	Line 1834 | Line 2032 | begin
2032		SetTransaction(nil);
2033		end;
2034
2035	<	procedure TIBBase.DoBeforeTransactionEnd;
2035	>	procedure TIBBase.DoBeforeTransactionEnd(Action: TTransactionAction);
2036		begin
2037		if Assigned(BeforeTransactionEnd) then
2038	<	BeforeTransactionEnd(Self);
2038	>	BeforeTransactionEnd(Self,Action);
2039		end;
2040
2041		procedure TIBBase.DoAfterTransactionEnd;
#	Line 1853 | Line 2051 | begin
2051		FTransaction := nil;
2052		end;
2053
2054	+	procedure TIBBase.DoAfterExecQuery(Sender: TObject);
2055	+	begin
2056	+	if FTransaction <> nil then
2057	+	FTransaction.DoAfterExecQuery(Sender);
2058	+	end;
2059	+
2060	+	procedure TIBBase.DoAfterEdit(Sender: TObject);
2061	+	begin
2062	+	if FTransaction <> nil then
2063	+	FTransaction.DoAfterEdit(Sender);
2064	+	end;
2065	+
2066	+	procedure TIBBase.DoAfterDelete(Sender: TObject);
2067	+	begin
2068	+	if FTransaction <> nil then
2069	+	FTransaction.DoAfterDelete(Sender);
2070	+	end;
2071	+
2072	+	procedure TIBBase.DoAfterInsert(Sender: TObject);
2073	+	begin
2074	+	if FTransaction <> nil then
2075	+	FTransaction.DoAfterInsert(Sender);
2076	+	end;
2077	+
2078	+	procedure TIBBase.DoAfterPost(Sender: TObject);
2079	+	begin
2080	+	if FTransaction <> nil then
2081	+	FTransaction.DoAfterPost(Sender);
2082	+	end;
2083	+
2084		procedure TIBBase.SetDatabase(Value: TIBDatabase);
2085		begin
2086		if (FDatabase <> nil) then
#	Line 1885 | Line 2113 | end;
2113		parameter buffer, and return it and its length
2114		in DPB and DPBLength, respectively. }
2115
2116	<	procedure GenerateDPB(sl: TStrings; var DPB: string; var DPBLength: Short);
2116	>	function GenerateDPB(sl: TStrings): IDPB;
2117		var
2118	<	i, j, pval: Integer;
2118	>	i, j: Integer;
2119		DPBVal: UShort;
2120		ParamName, ParamValue: string;
2121		begin
2122	<	{ 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);
2122	>	Result := FirebirdAPI.AllocateDPB;
2123
2124		{Iterate through the textual database parameters, constructing
2125		a DPB on-the-fly }
#	Line 1933 | Line 2158 | begin
2158		begin
2159		if DPBVal = isc_dpb_sql_dialect then
2160		ParamValue[1] := Char(Ord(ParamValue[1]) - 48);
2161	<	DPB := DPB +
1937	<	Char(DPBVal) +
1938	<	Char(Length(ParamValue)) +
1939	<	ParamValue;
1940	<	Inc(DPBLength, 2 + Length(ParamValue));
2161	>	Result.Add(DPBVal).SetAsString(ParamValue);
2162		end;
2163	+
2164		isc_dpb_num_buffers, isc_dpb_dbkey_scope, isc_dpb_force_write,
2165		isc_dpb_no_reserve, isc_dpb_damaged, isc_dpb_verify:
2166	<	begin
2167	<	DPB := DPB +
1946	<	Char(DPBVal) +
1947	<	#1 +
1948	<	Char(StrToInt(ParamValue));
1949	<	Inc(DPBLength, 3);
1950	<	end;
2166	>	Result.Add(DPBVal).SetAsByte(byte(ParamValue[1]));
2167	>
2168		isc_dpb_sweep:
2169	<	begin
2170	<	DPB := DPB +
1954	<	Char(DPBVal) +
1955	<	#1 +
1956	<	Char(isc_dpb_records);
1957	<	Inc(DPBLength, 3);
1958	<	end;
2169	>	Result.Add(DPBVal).SetAsByte(isc_dpb_records);
2170	>
2171		isc_dpb_sweep_interval:
2172	<	begin
2173	<	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;
2172	>	Result.Add(DPBVal).SetAsInteger(StrToInt(ParamValue));
2173	>
2174		isc_dpb_activate_shadow, isc_dpb_delete_shadow, isc_dpb_begin_log,
2175		isc_dpb_quit_log:
2176	<	begin
1974	<	DPB := DPB +
1975	<	Char(DPBVal) +
1976	<	#1 + #0;
1977	<	Inc(DPBLength, 3);
1978	<	end;
2176	>	Result.Add(DPBVal).SetAsByte(0);
2177		else
2178		begin
2179		if (DPBVal > 0) and
#	Line 1993 | Line 2191 | end;
2191		of the transaction parameters, generate a transaction
2192		parameter buffer, and return it and its length in
2193		TPB and TPBLength, respectively. }
2194	<	procedure GenerateTPB(sl: TStrings; var TPB: string; var TPBLength: Short);
2194	>	function GenerateTPB(sl: TStrings): ITPB;
2195		var
2196	<	i, j, TPBVal, ParamLength: Integer;
2196	>	i, j, TPBVal: Integer;
2197		ParamName, ParamValue: string;
2198		begin
2199	<	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;
2199	>	Result := FirebirdAPI.AllocateTPB;
2200		for i := 0 to sl.Count - 1 do
2201		begin
2202		if (Trim(sl[i]) =  '') then
2012	–	begin
2013	–	Dec(TPBLength);
2203		Continue;
2204	<	end;
2204	>
2205		if (Pos('=', sl[i]) = 0) then {mbcs ok}
2206		ParamName := LowerCase(sl[i]) {mbcs ok}
2207		else
#	Line 2036 | Line 2225 | begin
2225		isc_tpb_concurrency, isc_tpb_shared, isc_tpb_wait, isc_tpb_nowait,
2226		isc_tpb_read, isc_tpb_write, isc_tpb_ignore_limbo,
2227		isc_tpb_read_committed, isc_tpb_rec_version, isc_tpb_no_rec_version:
2228	<	TPB := TPB + Char(TPBVal);
2228	>	Result.Add(TPBVal);
2229	>
2230		isc_tpb_lock_read, isc_tpb_lock_write:
2231	<	begin
2232	<	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;
2231	>	Result.Add(TPBVal).SetAsString(ParamValue);
2232	>
2233		else
2234		begin
2235		if (TPBVal > 0) and

Diff Legend

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