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 39 by tony, Tue May 17 08:14:52 2016 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	+	{$IF FPC_FULLVERSION >= 20700 }
39	+	{$codepage UTF8}
40	+	{$DEFINE HAS_ANSISTRING_CODEPAGE}
41	+	{$ENDIF}
42	+
43		interface
44
45		uses
46	<	{$IFDEF LINUX }
37	<	unix,
38	<	{$ELSE}
39	<	{$DEFINE HAS_SQLMONITOR}
46	>	{$IFDEF WINDOWS }
47		Windows,
48	+	{$ELSE}
49	+	unix,
50		{$ENDIF}
51	<	Dialogs, Controls, StdCtrls, SysUtils, Classes, Forms, ExtCtrls, IBHeader, IBExternals, DB,
52	<	IB, DBLoginDlg;
51	>	SysUtils, Classes, FPTimer, IBHeader, IBExternals, DB,
52	>	IB, CustApp;
53
54		const
55		DPBPrefix = 'isc_dpb_';
#	Line 151 | Line 160 | type
160		{ TIBDatabase }
161		TIBDataBase = class(TCustomConnection)
162		private
163	+	FAllowStreamedConnected: boolean;
164		FHiddenPassword: string;
165		FIBLoaded: Boolean;
166		FOnLogin: TIBDatabaseLoginEvent;
167	+	FSQLHourGlass: Boolean;
168		FTraceFlags: TTraceFlags;
169		FDBSQLDialect: Integer;
170		FSQLDialect: Integer;
#	Line 172 | Line 183 | type
183		FDefaultTransaction: TIBTransaction;
184		FInternalTransaction: TIBTransaction;
185		FStreamedConnected: Boolean;
186	<	FTimer: TTimer;
186	>	FTimer: TFPTimer;
187		FUserNames: TStringList;
188		FDataSets: TList;
189	+	FLoginCalled: boolean;
190	+	FCharSetSizes: array of integer;
191	+	FCharSetNames: array of RawByteString;
192	+	FDefaultCharSetName: RawByteString;
193	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
194	+	FCodePages: array of TSystemCodePage;
195	+	FDefaultCodePage: TSystemCodePage;
196	+	{$ENDIF}
197	+	FUseDefaultSystemCodePage: boolean;
198		procedure EnsureInactive;
199		function GetDBSQLDialect: Integer;
200		function GetSQLDialect: Integer;
#	Line 188 | Line 208 | type
208		function GetIdleTimer: Integer;
209		function GetTransaction(Index: Integer): TIBTransaction;
210		function GetTransactionCount: Integer;
211	<	function Login: Boolean;
211	>	function Login(var aDatabaseName: string): Boolean;
212	>	procedure LoadCharSetInfo;
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 243 | Line 266 | type
266		property TransactionCount: Integer read GetTransactionCount;
267		property Transactions[Index: Integer]: TIBTransaction read GetTransaction;
268		property InternalTransaction: TIBTransaction read FInternalTransaction;
269	+	property DefaultCharSetName: RawByteString read FDefaultCharSetName;
270	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
271	+	property DefaultCodePage: TSystemCodePage read FDefaultCodePage;
272	+	{$ENDIF}
273
274		published
275		property Connected;
276	<	property StreamedConnected;
276	>	property AllowStreamedConnected: boolean read FAllowStreamedConnected
277	>	write FAllowStreamedConnected;
278		property DatabaseName: TIBFileName read FDBName write SetDatabaseName;
279		property Params: TStrings read FDBParams write SetDBParams;
280		property LoginPrompt default True;
#	Line 254 | Line 282 | type
282		write SetDefaultTransaction;
283		property IdleTimer: Integer read GetIdleTimer write SetIdleTimer;
284		property SQLDialect : Integer read GetSQLDialect write SetSQLDialect default 3;
285	+	property SQLHourGlass: Boolean read FSQLHourGlass write FSQLHourGlass default true;
286		property DBSQLDialect : Integer read FDBSQLDialect;
287		property TraceFlags: TTraceFlags read FTraceFlags write FTraceFlags;
288	+	property UseDefaultSystemCodePage: boolean read FUseDefaultSystemCodePage
289	+	write FUseDefaultSystemCodePage;
290		property AfterConnect;
291		property AfterDisconnect;
292		property BeforeConnect;
#	Line 271 | Line 302 | type
302
303		TIBTransaction = class(TComponent)
304		private
305	+	FAfterDelete: TNotifyEvent;
306	+	FAfterEdit: TNotifyEvent;
307	+	FAfterExecQuery: TNotifyEvent;
308	+	FAfterInsert: TNotifyEvent;
309	+	FAfterPost: TNotifyEvent;
310	+	FAfterTransactionEnd: TNotifyEvent;
311	+	FBeforeTransactionEnd: TNotifyEvent;
312		FIBLoaded: Boolean;
313		FCanTimeout         : Boolean;
314		FDatabases          : TList;
315	+	FOnStartTransaction: TNotifyEvent;
316		FSQLObjects         : TList;
317		FDefaultDatabase    : TIBDatabase;
318		FHandle             : TISC_TR_HANDLE;
#	Line 282 | Line 321 | type
321		FStreamedActive     : Boolean;
322		FTPB                : PChar;
323		FTPBLength          : Short;
324	<	FTimer              : TTimer;
324	>	FTimer              : TFPTimer;
325		FDefaultAction      : TTransactionAction;
326		FTRParams           : TStrings;
327		FTRParamsChanged    : Boolean;
328	+	FInEndTransaction   : boolean;
329	+	FEndAction          : TTransactionAction;
330	+	procedure DoBeforeTransactionEnd;
331	+	procedure DoAfterTransactionEnd;
332	+	procedure DoOnStartTransaction;
333	+	procedure DoAfterExecQuery(Sender: TObject);
334	+	procedure DoAfterEdit(Sender: TObject);
335	+	procedure DoAfterDelete(Sender: TObject);
336	+	procedure DoAfterInsert(Sender: TObject);
337	+	procedure DoAfterPost(Sender: TObject);
338		procedure EnsureNotInTransaction;
339		procedure EndTransaction(Action: TTransactionAction; Force: Boolean);
340		function GetDatabase(Index: Integer): TIBDatabase;
#	Line 327 | Line 376 | type
376		function AddDatabase(db: TIBDatabase): Integer;
377		function FindDatabase(db: TIBDatabase): Integer;
378		function FindDefaultDatabase: TIBDatabase;
379	+	function GetEndAction: TTransactionAction;
380		procedure RemoveDatabase(Idx: Integer);
381		procedure RemoveDatabases;
382		procedure CheckDatabasesInList;
#	Line 348 | Line 398 | type
398		property DefaultAction: TTransactionAction read FDefaultAction write SetDefaultAction default taCommit;
399		property Params: TStrings read FTRParams write SetTRParams;
400		property OnIdleTimer: TNotifyEvent read FOnIdleTimer write FOnIdleTimer;
401	<	end;
401	>	property BeforeTransactionEnd: TNotifyEvent read FBeforeTransactionEnd
402	>	write FBeforeTransactionEnd;
403	>	property AfterTransactionEnd: TNotifyEvent read FAfterTransactionEnd
404	>	write FAfterTransactionEnd;
405	>	property OnStartTransaction: TNotifyEvent read FOnStartTransaction
406	>	write FOnStartTransaction;
407	>	property AfterExecQuery: TNotifyEvent read FAfterExecQuery
408	>	write FAfterExecQuery;
409	>	property AfterEdit: TNotifyEvent read FAfterEdit write FAfterEdit;
410	>	property AfterDelete: TNotifyEvent read FAfterDelete write FAfterDelete;
411	>	property AfterInsert: TNotifyEvent read FAfterInsert write FAfterInsert;
412	>	property AfterPost: TNotifyEvent read FAfterPost write FAfterPost;
413	>	end;
414	>
415	>	TTransactionEndEvent = procedure(Sender:TObject; Action: TTransactionAction) of object;
416	>	TBeforeDatabaseConnectEvent = procedure (Sender: TObject; DBParams: TStrings;
417	>	var DBName: string) of object;
418
419		{ TIBBase }
420
#	Line 357 | Line 423 | type
423		connections. }
424		TIBBase = class(TObject)
425		protected
426	+	FBeforeDatabaseConnect: TBeforeDatabaseConnectEvent;
427		FDatabase: TIBDatabase;
428		FIndexInDatabase: Integer;
429		FTransaction: TIBTransaction;
#	Line 364 | Line 431 | type
431		FOwner: TObject;
432		FBeforeDatabaseDisconnect: TNotifyEvent;
433		FAfterDatabaseDisconnect: TNotifyEvent;
434	+	FAfterDatabaseConnect: TNotifyEvent;
435		FOnDatabaseFree: TNotifyEvent;
436	<	FBeforeTransactionEnd: TNotifyEvent;
436	>	FBeforeTransactionEnd: TTransactionEndEvent;
437		FAfterTransactionEnd: TNotifyEvent;
438		FOnTransactionFree: TNotifyEvent;
439
440	+	procedure DoBeforeDatabaseConnect(DBParams: TStrings;
441	+	var DBName: string); virtual;
442	+	procedure DoAfterDatabaseConnect; virtual;
443		procedure DoBeforeDatabaseDisconnect; virtual;
444		procedure DoAfterDatabaseDisconnect; virtual;
445		procedure DoDatabaseFree; virtual;
446	<	procedure DoBeforeTransactionEnd; virtual;
446	>	procedure DoBeforeTransactionEnd(Action: TTransactionAction); virtual;
447		procedure DoAfterTransactionEnd; virtual;
448		procedure DoTransactionFree; virtual;
449		function GetDBHandle: PISC_DB_HANDLE; virtual;
#	Line 384 | Line 455 | type
455		destructor Destroy; override;
456		procedure CheckDatabase; virtual;
457		procedure CheckTransaction; virtual;
458	+	procedure DoAfterExecQuery(Sender: TObject); virtual;
459	+	procedure DoAfterEdit(Sender: TObject); virtual;
460	+	procedure DoAfterDelete(Sender: TObject); virtual;
461	+	procedure DoAfterInsert(Sender: TObject); virtual;
462	+	procedure DoAfterPost(Sender: TObject); virtual;
463	+	function GetCharSetSize(CharSetID: integer): integer;
464	+	function GetDefaultCharSetSize: integer;
465	+	function GetCharSetName(CharSetID: integer): string;
466	+	function GetDefaultCharSetName: RawByteString;
467	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
468	+	function GetCodePage(CharSetID: integer): TSystemCodePage;
469	+	function GetDefaultCodePage: TSystemCodePage;
470	+	{$ENDIF}
471	+	procedure HandleException(Sender: TObject);
472	+	procedure SetCursor;
473	+	procedure RestoreCursor;
474		public
475	+	property BeforeDatabaseConnect: TBeforeDatabaseConnectEvent read FBeforeDatabaseConnect
476	+	write FBeforeDatabaseConnect;
477	+	property AfterDatabaseConnect: TNotifyEvent read FAfterDatabaseConnect
478	+	write FAfterDatabaseConnect;
479		property BeforeDatabaseDisconnect: TNotifyEvent read FBeforeDatabaseDisconnect
480		write FBeforeDatabaseDisconnect;
481		property AfterDatabaseDisconnect: TNotifyEvent read FAfterDatabaseDisconnect
482		write FAfterDatabaseDisconnect;
483		property OnDatabaseFree: TNotifyEvent read FOnDatabaseFree write FOnDatabaseFree;
484	<	property BeforeTransactionEnd: TNotifyEvent read FBeforeTransactionEnd write FBeforeTransactionEnd;
484	>	property BeforeTransactionEnd: TTransactionEndEvent read FBeforeTransactionEnd write FBeforeTransactionEnd;
485		property AfterTransactionEnd: TNotifyEvent read FAfterTransactionEnd write FAfterTransactionEnd;
486		property OnTransactionFree: TNotifyEvent read FOnTransactionFree write FOnTransactionFree;
487		property Database: TIBDatabase read FDatabase
#	Line 408 | Line 499 | procedure GenerateTPB(sl: TStrings; var
499
500		implementation
501
502	<	uses IBIntf,{$IFDEF HAS_SQLMONITOR}IBSQLMonitor,{$ENDIF} IBCustomDataSet, IBDatabaseInfo, IBSQL, IBUtils, typInfo;
502	>	uses IBIntf, IBSQLMonitor, IBCustomDataSet, IBDatabaseInfo, IBSQL, IBUtils,
503	>	typInfo, IBCodePage;
504
505		{ TIBDatabase }
506
507	<	constructor TIBDatabase.Create(AOwner: TComponent);
507	>	constructor TIBDataBase.Create(AOwner: TComponent);
508		begin
509		inherited Create(AOwner);
510		FIBLoaded := False;
#	Line 423 | Line 515 | begin
515		FTransactions := TList.Create;
516		FDBName := '';
517		FDBParams := TStringList.Create;
518	+	FSQLHourGlass := true;
519	+	if (AOwner <> nil) and
520	+	(AOwner is TCustomApplication) and
521	+	TCustomApplication(AOWner).ConsoleApplication then
522	+	LoginPrompt := false;
523	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
524	+	FDefaultCodePage := CP_NONE;
525	+	{$ENDIF}
526		FDBParamsChanged := True;
527		TStringList(FDBParams).OnChange := DBParamsChange;
528		TStringList(FDBParams).OnChanging := DBParamsChanging;
#	Line 431 | Line 531 | begin
531		FUserNames := nil;
532		FInternalTransaction := TIBTransaction.Create(self);
533		FInternalTransaction.DefaultDatabase := Self;
534	<	FTimer := TTimer.Create(Self);
534	>	FTimer := TFPTimer.Create(Self);
535		FTimer.Enabled := False;
536		FTimer.Interval := 0;
537		FTimer.OnTimer := TimeoutConnection;
#	Line 439 | Line 539 | begin
539		FSQLDialect := 3;
540		FTraceFlags := [];
541		FDataSets := TList.Create;
542	+	CheckStreamConnect;
543		end;
544
545	<	destructor TIBDatabase.Destroy;
545	>	destructor TIBDataBase.Destroy;
546		var
547		i: Integer;
548		begin
#	Line 467 | Line 568 | begin
568		inherited Destroy;
569		end;
570
571	<	function TIBDatabase.Call(ErrCode: ISC_STATUS;
572	<	RaiseError: Boolean): ISC_STATUS;
571	>	function TIBDataBase.Call(ErrCode: ISC_STATUS; RaiseError: Boolean
572	>	): ISC_STATUS;
573		begin
574		result := ErrCode;
575		FCanTimeout := False;
#	Line 476 | Line 577 | begin
577		IBDataBaseError;
578		end;
579
580	<	procedure TIBDatabase.CheckActive;
580	>	procedure TIBDataBase.CheckActive;
581		begin
582		if StreamedConnected and (not Connected) then
583		Loaded;
#	Line 484 | Line 585 | begin
585		IBError(ibxeDatabaseClosed, [nil]);
586		end;
587
588	<	procedure TIBDatabase.EnsureInactive;
588	>	procedure TIBDataBase.EnsureInactive;
589		begin
590		if csDesigning in ComponentState then
591		begin
#	Line 493 | Line 594 | begin
594		end
595		end;
596
597	<	procedure TIBDatabase.CheckInactive;
597	>	procedure TIBDataBase.CheckInactive;
598		begin
599		if FHandle <> nil then
600		IBError(ibxeDatabaseOpen, [nil]);
601		end;
602
603	<	procedure TIBDatabase.CheckDatabaseName;
603	>	procedure TIBDataBase.CheckDatabaseName;
604		begin
605	<	if (FDBName = '') then
605	>	if (Trim(FDBName) = '') then
606		IBError(ibxeDatabaseNameMissing, [nil]);
607		end;
608
609	<	function TIBDatabase.AddSQLObject(ds: TIBBase): Integer;
609	>	function TIBDataBase.AddSQLObject(ds: TIBBase): Integer;
610		begin
611		result := 0;
612		if (ds.Owner is TIBCustomDataSet) then
613	<	{$IFDEF LINUX}
513	<	FDataSets.Add(TDataSet(ds.Owner));
514	<	{$ELSE}
515	<	RegisterClient(TDataSet(ds.Owner));
516	<	{$ENDIF}
613	>	FDataSets.Add(ds.Owner);
614		while (result < FSQLObjects.Count) and (FSQLObjects[result] <> nil) do
615		Inc(result);
616		if (result = FSQLObjects.Count) then
#	Line 522 | Line 619 | begin
619		FSQLObjects[result] := ds;
620		end;
621
622	<	function TIBDatabase.AddTransaction(TR: TIBTransaction): Integer;
622	>	function TIBDataBase.AddTransaction(TR: TIBTransaction): Integer;
623		begin
624		result := FindTransaction(TR);
625		if result <> -1 then
#	Line 539 | Line 636 | begin
636		FTransactions[result] := TR;
637		end;
638
639	<	procedure TIBDatabase.DoDisconnect;
639	>	procedure TIBDataBase.DoDisconnect;
640		begin
641		if Connected then
642		InternalClose(False);
643		FDBSQLDialect := 1;
644	+	SetLength(FCharSetSizes,0);
645	+	SetLength(FCharSetNames,0);
646	+	FDefaultCharSetName := '';
647	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
648	+	SetLength(FCodePages,0);
649	+	FDefaultCodePage := CP_NONE;
650	+	{$ENDIF}
651		end;
652
653	<	procedure TIBDatabase.CreateDatabase;
653	>	procedure TIBDataBase.CreateDatabase;
654		var
655		tr_handle: TISC_TR_HANDLE;
656		begin
#	Line 559 | Line 663 | begin
663		True);
664		end;
665
666	<	procedure TIBDatabase.DropDatabase;
666	>	procedure TIBDataBase.DropDatabase;
667		begin
668		CheckActive;
669		Call(isc_drop_database(StatusVector, @FHandle), True);
670		end;
671
672	<	procedure TIBDatabase.DBParamsChange(Sender: TObject);
672	>	procedure TIBDataBase.DBParamsChange(Sender: TObject);
673		begin
674		FDBParamsChanged := True;
675		end;
676
677	<	procedure TIBDatabase.DBParamsChanging(Sender: TObject);
677	>	procedure TIBDataBase.DBParamsChanging(Sender: TObject);
678		begin
679		EnsureInactive;
680		CheckInactive;
681		end;
682
683	<	function TIBDatabase.FindTransaction(TR: TIBTransaction): Integer;
683	>	function TIBDataBase.FindTransaction(TR: TIBTransaction): Integer;
684		var
685		i: Integer;
686		begin
#	Line 589 | Line 693 | begin
693		end;
694		end;
695
696	<	function TIBDatabase.FindDefaultTransaction(): TIBTransaction;
696	>	function TIBDataBase.FindDefaultTransaction: TIBTransaction;
697		var
698		i: Integer;
699		begin
#	Line 607 | Line 711 | begin
711		end;
712		end;
713
714	<	procedure TIBDatabase.ForceClose;
714	>	procedure TIBDataBase.ForceClose;
715		begin
716		if Connected then
717		InternalClose(True);
718		end;
719
720	<	function TIBDatabase.GetConnected: Boolean;
720	>	function TIBDataBase.GetConnected: Boolean;
721		begin
722		result := FHandle <> nil;
723		end;
724
725	<	function TIBDatabase.GetSQLObject(Index: Integer): TIBBase;
725	>	function TIBDataBase.GetSQLObject(Index: Integer): TIBBase;
726		begin
727		result := FSQLObjects[Index];
728		end;
729
730	<	function TIBDatabase.GetSQLObjectCount: Integer;
730	>	function TIBDataBase.GetSQLObjectCount: Integer;
731		var
732		i: Integer;
733		begin
#	Line 632 | Line 736 | begin
736		Inc(result);
737		end;
738
739	<	function TIBDatabase.GetDBParamByDPB(const Idx: Integer): String;
739	>	function TIBDataBase.GetDBParamByDPB( const Idx: Integer): String;
740		var
741		ConstIdx, EqualsIdx: Integer;
742		begin
#	Line 655 | Line 759 | begin
759		result := '';
760		end;
761
762	<	function TIBDatabase.GetIdleTimer: Integer;
762	>	function TIBDataBase.GetIdleTimer: Integer;
763		begin
764		result := FTimer.Interval;
765		end;
766
767	<	function TIBDatabase.GetTransaction(Index: Integer): TIBTransaction;
767	>	function TIBDataBase.GetTransaction(Index: Integer): TIBTransaction;
768		begin
769		result := FTransactions[Index];
770		end;
771
772	<	function TIBDatabase.GetTransactionCount: Integer;
772	>	function TIBDataBase.GetTransactionCount: Integer;
773		var
774		i: Integer;
775		begin
#	Line 675 | Line 779 | begin
779		Inc(result);
780		end;
781
782	<	function TIBDatabase.IndexOfDBConst(st: String): Integer;
782	>	function TIBDataBase.IndexOfDBConst(st: String): Integer;
783		var
784		i, pos_of_str: Integer;
785		begin
#	Line 691 | Line 795 | begin
795		end;
796		end;
797
798	<	procedure TIBDatabase.InternalClose(Force: Boolean);
798	>	procedure TIBDataBase.InternalClose(Force: Boolean);
799		var
800		i: Integer;
801		begin
#	Line 730 | Line 834 | begin
834		FHandleIsShared := False;
835		end;
836
733	–	{$IFDEF HAS_SQLMONITOR}
837		if not (csDesigning in ComponentState) then
838		MonitorHook.DBDisconnect(Self);
736	–	{$ENDIF}
839
840		for i := 0 to FSQLObjects.Count - 1 do
841		if FSQLObjects[i] <> nil then
842		SQLObjects[i].DoAfterDatabaseDisconnect;
843		end;
844
845	<	procedure TIBDatabase.Loaded;
845	>	procedure TIBDataBase.LoadCharSetInfo;
846	>	var Query: TIBSQL;
847	>	i: integer;
848	>	begin
849	>	if not FInternalTransaction.Active then
850	>	FInternalTransaction.StartTransaction;
851	>	Query := TIBSQL.Create(self);
852	>	try
853	>	Query.Database := Self;
854	>	Query.Transaction := FInternalTransaction;
855	>	Query.SQL.Text := 'Select RDB$CHARACTER_SET_ID, RDB$BYTES_PER_CHARACTER, RDB$CHARACTER_SET_NAME ' +
856	>	'From RDB$CHARACTER_SETS Order by 1 DESC'; {do not localize}
857	>	Query.Prepare;
858	>	Query.ExecQuery;
859	>	if not Query.EOF then
860	>	begin
861	>	SetLength(FCharSetSizes,Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger + 1);
862	>	SetLength(FCharSetNames,Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger + 1);
863	>	{$IFDEF HAS_ANSISTRING_CODEPAGE}
864	>	SetLength(FCodePages, Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger + 1);
865	>	{$ENDIF}
866	>	for i := 0 to Length(FCharSetSizes) - 1 do FCharSetSizes[i] := 1;
867	>	repeat
868	>	FCharSetSizes[Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger] :=
869	>	Query.FieldByName('RDB$BYTES_PER_CHARACTER').AsInteger;
870	>	FCharSetNames[Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger] :=
871	>	Trim(Query.FieldByName('RDB$CHARACTER_SET_NAME').AsString);
872	>	{$IFDEF HAS_ANSISTRING_CODEPAGE}
873	>	FCodePages[Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger] :=
874	>	IBGetCodePage(Trim(Query.FieldByName('RDB$CHARACTER_SET_NAME').AsString));
875	>	{$ENDIF}
876	>	Query.Next;
877	>	until Query.EOF;
878	>	end;
879	>	finally
880	>	Query.free;
881	>	FInternalTransaction.Commit;
882	>	end;
883	>	end;
884	>
885	>	procedure TIBDataBase.CheckStreamConnect;
886		var
887		i: integer;
888		begin
889		try
890	<	if StreamedConnected and (not Connected) then
890	>	if not (csDesigning in ComponentState) and StreamedConnected and (not Connected) then
891		begin
750	–	inherited Loaded;
892		for i := 0 to FTransactions.Count - 1 do
893		if  FTransactions[i] <> nil then
894		begin
#	Line 767 | Line 908 | begin
908		end;
909		except
910		if csDesigning in ComponentState then
911	<	Application.HandleException(Self)
911	>	HandleException(Self)
912		else
913		raise;
914		end;
915		end;
916
917	<	procedure TIBDatabase.Notification( AComponent: TComponent;
918	<	Operation: TOperation);
917	>	procedure TIBDataBase.HandleException(Sender: TObject);
918	>	var aParent: TComponent;
919	>	begin
920	>	aParent := Owner;
921	>	while aParent <> nil do
922	>	begin
923	>	if aParent is TCustomApplication then
924	>	begin
925	>	TCustomApplication(aParent).HandleException(Sender);
926	>	Exit;
927	>	end;
928	>	aParent := aParent.Owner;
929	>	end;
930	>	SysUtils.ShowException(ExceptObject,ExceptAddr);
931	>	end;
932	>
933	>	procedure TIBDataBase.Notification(AComponent: TComponent;
934	>	Operation: TOperation);
935		var
936		i: Integer;
937		begin
#	Line 788 | Line 945 | begin
945		end;
946		end;
947
948	<	function TIBDatabase.Login: Boolean;
948	>	function TIBDataBase.Login(var aDatabaseName: string): Boolean;
949		var
950		IndexOfUser, IndexOfPassword: Integer;
951		Username, Password, OldPassword: String;
#	Line 812 | Line 969 | var
969		end;
970
971		begin
972	<	if Assigned(FOnLogin) then
972	>	Result := false;
973	>	if FLoginCalled then Exit;
974	>	FLoginCalled := true;
975	>	try
976	>	if Assigned(FOnLogin) and not (csDesigning in ComponentState) then
977		begin
978		result := True;
979		LoginParams := TStringList.Create;
#	Line 820 | Line 981 | begin
981		LoginParams.Assign(Params);
982		FOnLogin(Self, LoginParams);
983		Params.Assign (LoginParams);
984	+	aDatabaseName := FDBName;
985		HidePassword;
986		finally
987		LoginParams.Free;
988		end;
989		end
990		else
991	+	if assigned(IBGUIInterface) then
992		begin
993		IndexOfUser := IndexOfDBConst(DPBConstantNames[isc_dpb_user_name]);
994		if IndexOfUser <> -1 then
#	Line 840 | Line 1003 | begin
1003		Length(Params[IndexOfPassword]));
1004		OldPassword := password;
1005		end;
1006	<	result := LoginDialogEx(DatabaseName, Username, Password, False);
1006	>	result := IBGUIInterface.LoginDialogEx(aDatabaseName, Username, Password, False);
1007		if result then
1008		begin
1009		if IndexOfUser = -1 then
#	Line 857 | Line 1020 | begin
1020		HidePassword;
1021		end;
1022		end;
1023	+	end
1024	+	else
1025	+	if LoginPrompt then
1026	+	IBError(ibxeNoLoginDialog,[]);
1027	+	finally
1028	+	FLoginCalled := false
1029		end;
1030		end;
1031
1032	<	procedure TIBDatabase.DoConnect;
1032	>	procedure TIBDataBase.DoConnect;
1033		var
1034		DPB: String;
1035		TempDBParams: TStrings;
1036	+	I: integer;
1037	+	aDBName: string;
1038
1039	+	{Call error analysis}
1040	+	sqlcode: Long;
1041	+	IBErrorCode: Long;
1042	+	status_vector: PISC_STATUS;
1043	+	{$ifdef WINDOWS}
1044	+	acp: uint;
1045	+	{$endif}
1046		begin
1047		CheckInactive;
1048		CheckDatabaseName;
#	Line 874 | Line 1052 | begin
1052		FDBParamsChanged := True;
1053		end;
1054		{ Use builtin login prompt if requested }
1055	<	if LoginPrompt and not Login then
1055	>	aDBName := FDBName;
1056	>	if (LoginPrompt or (csDesigning in ComponentState)) and not Login(aDBName) then
1057		IBError(ibxeOperationCancelled, [nil]);
1058	<	{ Generate a new DPB if necessary }
1059	<	if (FDBParamsChanged) then
1060	<	begin
1061	<	FDBParamsChanged := False;
1062	<	if (not LoginPrompt) or (FHiddenPassword = '') then
1063	<	GenerateDPB(FDBParams, DPB, FDPBLength)
1064	<	else
1058	>
1059	>	TempDBParams := TStringList.Create;
1060	>	try
1061	>	TempDBParams.Assign(FDBParams);
1062	>	if UseDefaultSystemCodePage then
1063	>	begin
1064	>	{$ifdef WINDOWS}
1065	>	acp := GetACP;
1066	>	{$IFDEF HAS_ANSISTRING_CODEPAGE}
1067	>	TempDBParams.Values['lc_ctype'] := IBGetCharacterSetName(acp);
1068	>	FDefaultCodePage := IBGetCodePage(AnsiUpperCase(TempDBParams.Values['lc_ctype']));
1069	>	{$ELSE}
1070	>	if (acp >= 1250) and (acp <= 1258) then
1071	>	TempDBParams.Values['lc_ctype'] := Format('WIN%d',[acp])
1072	>	else
1073	>	TempDBParams.Values['lc_ctype'] :='UTF8';
1074	>	{$ENDIF}
1075	>	{$else}
1076	>	{$IFDEF HAS_ANSISTRING_CODEPAGE}
1077	>	TempDBParams.Values['lc_ctype'] := IBGetCharacterSetName(DefaultSystemCodePage);
1078	>	FDefaultCodePage := IBGetCodePage(AnsiUpperCase(TempDBParams.Values['lc_ctype']));
1079	>	{$ELSE}
1080	>	TempDBParams.Values['lc_ctype'] :='UTF8';
1081	>	{$ENDIF}
1082	>	{$endif}
1083	>	end;
1084	>	{Opportunity to override defaults}
1085	>	for i := 0 to FSQLObjects.Count - 1 do
1086	>	begin
1087	>	if FSQLObjects[i] <> nil then
1088	>	SQLObjects[i].DoBeforeDatabaseConnect(TempDBParams,aDBName);
1089	>	end;
1090	>	FDefaultCharSetName := AnsiUpperCase(TempDBParams.Values['lc_ctype']);
1091	>
1092	>	{ Generate a new DPB if necessary }
1093	>	if (FDBParamsChanged or (TempDBParams.Text <> FDBParams.Text)) then
1094	>	begin
1095	>	FDBParamsChanged := False;
1096	>	if (not LoginPrompt and not (csDesigning in ComponentState)) or (FHiddenPassword = '') then
1097	>	GenerateDPB(TempDBParams, DPB, FDPBLength)
1098	>	else
1099	>	begin
1100	>	TempDBParams.Add('password=' + FHiddenPassword);
1101	>	GenerateDPB(TempDBParams, DPB, FDPBLength);
1102	>	end;
1103	>	IBAlloc(FDPB, 0, FDPBLength);
1104	>	Move(DPB[1], FDPB[0], FDPBLength);
1105	>	end;
1106	>	finally
1107	>	TempDBParams.Free;
1108	>	end;
1109	>	repeat
1110	>	if Call(isc_attach_database(StatusVector, Length(aDBName),
1111	>	PChar(aDBName), @FHandle,
1112	>	FDPBLength, FDPB), False) > 0 then
1113		begin
1114	<	TempDBParams := TStringList.Create;
1115	<	try
1116	<	TempDBParams.Assign(FDBParams);
1117	<	TempDBParams.Add('password=' + FHiddenPassword);
1118	<	GenerateDPB(TempDBParams, DPB, FDPBLength);
1119	<	finally
1120	<	TempDBParams.Free;
1114	>	{$IFDEF UNIX}
1115	>	if IsEmbeddedServer and (Pos(':',aDBName) = 0) then
1116	>	begin
1117	>	status_vector := StatusVector;
1118	>	IBErrorCode := StatusVectorArray[1];
1119	>	sqlcode := isc_sqlcode(StatusVector);
1120	>
1121	>	if ((sqlcode = -901) and (IBErrorCode = 335544382)) {Access permissions on firebird temp}
1122	>	or
1123	>	((sqlcode = -902) and (IBErrorCode = 335544373)) {Security DB Problem}
1124	>	then
1125	>	begin
1126	>	aDBName := 'localhost:' + aDBName;
1127	>	Continue;
1128	>	end;
1129		end;
1130	+	{$ENDIF}
1131	+	FHandle := nil;
1132	+	IBDataBaseError;
1133		end;
1134	<	IBAlloc(FDPB, 0, FDPBLength);
1135	<	Move(DPB[1], FDPB[0], FDPBLength);
1136	<	end;
899	<	if Call(isc_attach_database(StatusVector, Length(FDBName),
900	<	PChar(FDBName), @FHandle,
901	<	FDPBLength, FDPB), False) > 0 then
902	<	begin
903	<	FHandle := nil;
904	<	IBDataBaseError;
905	<	end;
1134	>	until FHandle <> nil;
1135	>	if not (csDesigning in ComponentState) then
1136	>	FDBName := aDBName; {Synchronise at run time}
1137		FDBSQLDialect := GetDBSQLDialect;
1138		ValidateClientSQLDialect;
1139	<	{$IFDEF HAS_SQLMONITOR}
1139	>	for i := 0 to FSQLObjects.Count - 1 do
1140	>	begin
1141	>	if FSQLObjects[i] <> nil then
1142	>	SQLObjects[i].DoAfterDatabaseConnect;
1143	>	end;
1144		if not (csDesigning in ComponentState) then
1145		MonitorHook.DBConnect(Self);
1146	<	{$ENDIF}
1146	>	LoadCharSetInfo;
1147		end;
1148
1149	<	procedure TIBDatabase.RemoveSQLObject(Idx: Integer);
1149	>	procedure TIBDataBase.RemoveSQLObject(Idx: Integer);
1150		var
1151		ds: TIBBase;
1152		begin
#	Line 921 | Line 1156 | begin
1156		FSQLObjects[Idx] := nil;
1157		ds.Database := nil;
1158		if (ds.owner is TDataSet) then
924	–	{$IFDEF LINUX}
1159		FDataSets.Remove(TDataSet(ds.Owner));
926	–	{$ELSE}
927	–	UnregisterClient(TDataSet(ds.Owner));
928	–	{$ENDIF}
1160		end;
1161		end;
1162
1163	<	procedure TIBDatabase.RemoveSQLObjects;
1163	>	procedure TIBDataBase.RemoveSQLObjects;
1164		var
1165		i: Integer;
1166		begin
#	Line 937 | Line 1168 | begin
1168		begin
1169		RemoveSQLObject(i);
1170		if (TIBBase(FSQLObjects[i]).owner is TDataSet) then
940	–	{$IFDEF LINUX}
1171		FDataSets.Remove(TDataSet(TIBBase(FSQLObjects[i]).owner));
942	–	{$ELSE}
943	–	UnregisterClient(TDataSet(TIBBase(FSQLObjects[i]).owner));
944	–	{$ENDIF}
1172		end;
1173		end;
1174
1175	<	procedure TIBDatabase.RemoveTransaction(Idx: Integer);
1175	>	procedure TIBDataBase.RemoveTransaction(Idx: Integer);
1176		var
1177		TR: TIBTransaction;
1178		begin
#	Line 959 | Line 1186 | begin
1186		end;
1187		end;
1188
1189	<	procedure TIBDatabase.RemoveTransactions;
1189	>	procedure TIBDataBase.RemoveTransactions;
1190		var
1191		i: Integer;
1192		begin
#	Line 967 | Line 1194 | begin
1194		RemoveTransaction(i);
1195		end;
1196
1197	<	procedure TIBDatabase.SetDatabaseName(const Value: TIBFileName);
1197	>	procedure TIBDataBase.SetDatabaseName( const Value: TIBFileName);
1198		begin
1199		if FDBName <> Value then
1200		begin
#	Line 977 | Line 1204 | begin
1204		end;
1205		end;
1206
1207	<	procedure TIBDatabase.SetDBParamByDPB(const Idx: Integer; Value: String);
1207	>	procedure TIBDataBase.SetDBParamByDPB( const Idx: Integer; Value: String);
1208		var
1209		ConstIdx: Integer;
1210		begin
#	Line 996 | Line 1223 | begin
1223		end;
1224		end;
1225
1226	<	procedure TIBDatabase.SetDBParams(Value: TStrings);
1226	>	procedure TIBDataBase.SetDBParams(Value: TStrings);
1227		begin
1228		FDBParams.Assign(Value);
1229		end;
1230
1231	<	procedure TIBDatabase.SetDefaultTransaction(Value: TIBTransaction);
1231	>	procedure TIBDataBase.SetDefaultTransaction(Value: TIBTransaction);
1232		var
1233		i: Integer;
1234		begin
#	Line 1019 | Line 1246 | begin
1246		FDefaultTransaction := Value;
1247		end;
1248
1249	<	procedure TIBDatabase.SetHandle(Value: TISC_DB_HANDLE);
1249	>	procedure TIBDataBase.SetHandle(Value: TISC_DB_HANDLE);
1250		begin
1251		if HandleIsShared then
1252		Close
#	Line 1029 | Line 1256 | begin
1256		FHandleIsShared := (Value <> nil);
1257		end;
1258
1259	<	procedure TIBDatabase.SetIdleTimer(Value: Integer);
1259	>	procedure TIBDataBase.SetIdleTimer(Value: Integer);
1260		begin
1261		if Value < 0 then
1262		IBError(ibxeTimeoutNegative, [nil])
#	Line 1048 | Line 1275 | begin
1275		end;
1276		end;
1277
1278	<	function TIBDatabase.TestConnected: Boolean;
1278	>	function TIBDataBase.TestConnected: Boolean;
1279		var
1280		DatabaseInfo: TIBDatabaseInfo;
1281		begin
#	Line 1069 | Line 1296 | begin
1296		end;
1297		end;
1298
1299	<	procedure TIBDatabase.TimeoutConnection(Sender: TObject);
1299	>	procedure TIBDataBase.TimeoutConnection(Sender: TObject);
1300		begin
1301		if Connected then
1302		begin
#	Line 1084 | Line 1311 | begin
1311		end;
1312		end;
1313
1314	<	function TIBDatabase.GetIsReadOnly: Boolean;
1314	>	function TIBDataBase.GetIsReadOnly: Boolean;
1315		var
1316		DatabaseInfo: TIBDatabaseInfo;
1317		begin
#	Line 1102 | Line 1329 | begin
1329		DatabaseInfo.Free;
1330		end;
1331
1332	<	function TIBDatabase.GetSQLDialect: Integer;
1332	>	function TIBDataBase.GetSQLDialect: Integer;
1333		begin
1334		Result := FSQLDialect;
1335		end;
1336
1337	<	procedure TIBDatabase.SetSQLDialect(const Value: Integer);
1337	>
1338	>	procedure TIBDataBase.SetSQLDialect( const Value: Integer);
1339		begin
1340		if (Value < 1) then IBError(ibxeSQLDialectInvalid, [nil]);
1341		if ((FHandle = nil) or (Value <= FDBSQLDialect))  then
#	Line 1116 | Line 1344 | begin
1344		IBError(ibxeSQLDialectInvalid, [nil]);
1345		end;
1346
1347	<	function TIBDatabase.GetDBSQLDialect: Integer;
1347	>	function TIBDataBase.GetDBSQLDialect: Integer;
1348		var
1349		DatabaseInfo: TIBDatabaseInfo;
1350		begin
#	Line 1126 | Line 1354 | begin
1354		DatabaseInfo.Free;
1355		end;
1356
1357	<	procedure TIBDatabase.ValidateClientSQLDialect;
1357	>	procedure TIBDataBase.ValidateClientSQLDialect;
1358		begin
1359		if (FDBSQLDialect < FSQLDialect) then
1360		begin
#	Line 1136 | Line 1364 | begin
1364		end;
1365		end;
1366
1367	<	procedure TIBDatabase.ApplyUpdates(const DataSets: array of TDataSet);
1367	>	procedure TIBDataBase.ApplyUpdates( const DataSets: array of TDataSet);
1368		var
1369		I: Integer;
1370		DS: TIBCustomDataSet;
#	Line 1162 | Line 1390 | begin
1390		TR.CommitRetaining;
1391		end;
1392
1393	<	procedure TIBDatabase.CloseDataSets;
1393	>	procedure TIBDataBase.CloseDataSets;
1394		var
1395		i: Integer;
1396		begin
#	Line 1171 | Line 1399 | begin
1399		DataSets[i].close;
1400		end;
1401
1402	<	function TIBDatabase.GetDataset(Index : longint) : TDataset;
1402	>	function TIBDataBase.GetDataset(Index: longint): TDataset;
1403		begin
1404		if (Index >= 0) and (Index < FDataSets.Count) then
1405		Result := TDataSet(FDataSets[Index])
#	Line 1179 | Line 1407 | begin
1407		raise Exception.Create('Invalid Index to DataSets');
1408		end;
1409
1410	<	function TIBDatabase.GetDataSetCount : Longint;
1410	>	function TIBDataBase.GetDataSetCount: Longint;
1411		begin
1412		Result := FDataSets.Count;
1413		end;
1414
1415	<	procedure TIBDatabase.GetFieldNames(const TableName: string; List: TStrings);
1415	>	procedure TIBDataBase.ReadState(Reader: TReader);
1416	>	begin
1417	>	FDBParams.Clear;
1418	>	inherited ReadState(Reader);
1419	>	end;
1420	>
1421	>	procedure TIBDataBase.SetConnected(Value: boolean);
1422	>	begin
1423	>	if StreamedConnected and not AllowStreamedConnected then
1424	>	begin
1425	>	StreamedConnected := false;
1426	>	Value := false
1427	>	end;
1428	>	inherited SetConnected(Value);
1429	>	end;
1430	>
1431	>	procedure TIBDataBase.GetFieldNames( const TableName: string; List: TStrings);
1432		var
1433		Query: TIBSQL;
1434		begin
#	Line 1225 | Line 1469 | begin
1469		end;
1470		end;
1471
1472	<	procedure TIBDatabase.GetTableNames(List: TStrings; SystemTables: Boolean);
1472	>	procedure TIBDataBase.GetTableNames(List: TStrings; SystemTables: Boolean);
1473		var
1474		Query : TIBSQL;
1475		begin
#	Line 1284 | Line 1528 | begin
1528		FTRParamsChanged := True;
1529		TStringList(FTRParams).OnChange := TRParamsChange;
1530		TStringList(FTRParams).OnChanging := TRParamsChanging;
1531	<	FTimer := TTimer.Create(Self);
1531	>	FTimer := TFPTimer.Create(Self);
1532		FTimer.Enabled := False;
1533		FTimer.Interval := 0;
1534		FTimer.OnTimer := TimeoutTransaction;
#	Line 1340 | Line 1584 | begin
1584		IBError(ibxeNotInTransaction, [nil]);
1585		end;
1586
1587	+	procedure TIBTransaction.DoBeforeTransactionEnd;
1588	+	begin
1589	+	if Assigned(FBeforeTransactionEnd) then
1590	+	FBeforeTransactionEnd(self);
1591	+	end;
1592	+
1593	+	procedure TIBTransaction.DoAfterTransactionEnd;
1594	+	begin
1595	+	if Assigned(FAfterTransactionEnd) then
1596	+	FAfterTransactionEnd(self);
1597	+	end;
1598	+
1599	+	procedure TIBTransaction.DoOnStartTransaction;
1600	+	begin
1601	+	if assigned(FOnStartTransaction) then
1602	+	OnStartTransaction(self);
1603	+	end;
1604	+
1605	+	procedure TIBTransaction.DoAfterExecQuery(Sender: TObject);
1606	+	begin
1607	+	if assigned(FAfterExecQuery) then
1608	+	AfterExecQuery(Sender);
1609	+	end;
1610	+
1611	+	procedure TIBTransaction.DoAfterEdit(Sender: TObject);
1612	+	begin
1613	+	if assigned(FAfterEdit) then
1614	+	AfterEdit(Sender);
1615	+	end;
1616	+
1617	+	procedure TIBTransaction.DoAfterDelete(Sender: TObject);
1618	+	begin
1619	+	if assigned(FAfterDelete) then
1620	+	AfterDelete(Sender);
1621	+	end;
1622	+
1623	+	procedure TIBTransaction.DoAfterInsert(Sender: TObject);
1624	+	begin
1625	+	if assigned(FAfterInsert) then
1626	+	AfterInsert(Sender);
1627	+	end;
1628	+
1629	+	procedure TIBTransaction.DoAfterPost(Sender: TObject);
1630	+	begin
1631	+	if assigned(FAfterPost) then
1632	+	AfterPost(Sender);
1633	+	end;
1634	+
1635		procedure TIBTransaction.EnsureNotInTransaction;
1636		begin
1637		if csDesigning in ComponentState then
#	Line 1414 | Line 1706 | var
1706		i: Integer;
1707		begin
1708		CheckInTransaction;
1709	+	if FInEndTransaction then Exit;
1710	+	FInEndTransaction := true;
1711	+	FEndAction := Action;
1712	+	try
1713		case Action of
1714		TARollback, TACommit:
1715		begin
#	Line 1421 | Line 1717 | begin
1717		(Action <> FDefaultAction) and
1718		(not Force) then
1719		IBError(ibxeCantEndSharedTransaction, [nil]);
1720	+	DoBeforeTransactionEnd;
1721		for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then
1722	<	SQLObjects[i].DoBeforeTransactionEnd;
1722	>	SQLObjects[i].DoBeforeTransactionEnd(Action);
1723		if InTransaction then
1724		begin
1725		if HandleIsShared then
#	Line 1445 | Line 1742 | begin
1742		IBDataBaseError;
1743		for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then
1744		SQLObjects[i].DoAfterTransactionEnd;
1745	+	DoAfterTransactionEnd;
1746		end;
1747		end;
1748		TACommitRetaining:
#	Line 1452 | Line 1750 | begin
1750		TARollbackRetaining:
1751		Call(isc_rollback_retaining(StatusVector, @FHandle), True);
1752		end;
1455	–	{$IFDEF HAS_SQLMONITOR}
1753		if not (csDesigning in ComponentState) then
1754		begin
1755		case Action of
#	Line 1466 | Line 1763 | begin
1763		MonitorHook.TRRollbackRetaining(Self);
1764		end;
1765		end;
1766	<	{$ENDIF}
1766	>	finally
1767	>	FInEndTransaction := false
1768	>	end;
1769		end;
1770
1771		function TIBTransaction.GetDatabase(Index: Integer): TIBDatabase;
#	Line 1534 | Line 1833 | begin
1833		end;
1834		end;
1835
1836	+	function TIBTransaction.GetEndAction: TTransactionAction;
1837	+	begin
1838	+	if FInEndTransaction then
1839	+	Result := FEndAction
1840	+	else
1841	+	IBError(ibxeIB60feature, [nil])
1842	+	end;
1843	+
1844
1845		function TIBTransaction.GetIdleTimer: Integer;
1846		begin
#	Line 1639 | Line 1946 | begin
1946		for i := 0 to FSQLObjects.Count - 1 do
1947		if (FSQLObjects[i] <> nil) and
1948		(TIBBase(FSQLObjects[i]).Database = nil) then
1949	<	SetOrdProp(TIBBase(FSQLObjects[i]).Owner, 'Database', Integer(Value));
1949	>	SetObjectProp(TIBBase(FSQLObjects[i]).Owner, 'Database', Value);
1950		end;
1951		FDefaultDatabase := Value;
1952		end;
#	Line 1740 | Line 2047 | begin
2047		FHandle := nil;
2048		IBDataBaseError;
2049		end;
1743	–	{$IFDEF HAS_SQLMONITOR}
2050		if not (csDesigning in ComponentState) then
2051		MonitorHook.TRStart(Self);
1746	–	{$ENDIF}
2052		finally
2053		FreeMem(pteb);
2054		end;
2055	+	DoOnStartTransaction;
2056		end;
2057
2058		procedure TIBTransaction.TimeoutTransaction(Sender: TObject);
#	Line 1788 | Line 2094 | begin
2094		inherited Destroy;
2095		end;
2096
2097	+	function TIBBase.GetCharSetSize(CharSetID: integer): integer;
2098	+	begin
2099	+	if (CharSetID >= 0) and (CharSetID < Length(Database.FCharSetSizes)) then
2100	+	Result := Database.FCharSetSizes[CharSetID]
2101	+	else
2102	+	Result := 1; {Unknown character set}
2103	+	end;
2104	+
2105	+	function TIBBase.GetDefaultCharSetSize: integer;
2106	+	var DefaultCharSetName: string;
2107	+	i: integer;
2108	+	begin
2109	+	DefaultCharSetName := GetDefaultCharSetName;
2110	+	Result := 4; {worse case}
2111	+	for i := 0 to Length(Database.FCharSetSizes) - 1 do
2112	+	if Database.FCharSetNames[i] = DefaultCharSetName then
2113	+	begin
2114	+	Result := Database.FCharSetSizes[i];
2115	+	break;
2116	+	end;
2117	+	end;
2118	+
2119	+	function TIBBase.GetCharSetName(CharSetID: integer): string;
2120	+	begin
2121	+	if (CharSetID >= 0) and (CharSetID < Length(Database.FCharSetNames)) then
2122	+	Result := Database.FCharSetNames[CharSetID]
2123	+	else
2124	+	Result := ''; {Unknown character set}
2125	+	end;
2126	+
2127	+	function TIBBase.GetDefaultCharSetName: RawByteString;
2128	+	begin
2129	+	Result := Database.FDefaultCharSetName;
2130	+	end;
2131	+
2132	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
2133	+	function TIBBase.GetCodePage(CharSetID: integer): TSystemCodePage;
2134	+	begin
2135	+	if (CharSetID >= 0) and (CharSetID < Length(Database.FCodePages)) then
2136	+	Result := Database.FCodePages[CharSetID]
2137	+	else
2138	+	Result := CP_NONE; {Unknown character set}
2139	+	end;
2140	+
2141	+	function TIBBase.GetDefaultCodePage: TSystemCodePage;
2142	+	begin
2143	+	Result := Database.FDefaultCodePage;
2144	+	end;
2145	+
2146	+	{$ENDIF}
2147	+
2148	+	procedure TIBBase.HandleException(Sender: TObject);
2149	+	begin
2150	+	if assigned(Database) then
2151	+	Database.HandleException(Sender)
2152	+	else
2153	+	SysUtils.ShowException(ExceptObject,ExceptAddr);
2154	+	end;
2155	+
2156	+	procedure TIBBase.SetCursor;
2157	+	begin
2158	+	if Assigned(Database) and not Database.SQLHourGlass then
2159	+	Exit;
2160	+	if assigned(IBGUIInterface) then
2161	+	IBGUIInterface.SetCursor;
2162	+	end;
2163	+
2164	+	procedure TIBBase.RestoreCursor;
2165	+	begin
2166	+	if Assigned(Database) and not Database.SQLHourGlass then
2167	+	Exit;
2168	+	if assigned(IBGUIInterface) then
2169	+	IBGUIInterface.RestoreCursor;
2170	+	end;
2171	+
2172		procedure TIBBase.CheckDatabase;
2173		begin
2174		if (FDatabase = nil) then
#	Line 1814 | Line 2195 | begin
2195		result := @FTransaction.Handle;
2196		end;
2197
2198	+	procedure TIBBase.DoBeforeDatabaseConnect(DBParams: TStrings; var DBName: string
2199	+	);
2200	+	begin
2201	+	if assigned(FBeforeDatabaseConnect) then
2202	+	BeforeDatabaseConnect(self,DBParams,DBName);
2203	+	end;
2204	+
2205	+	procedure TIBBase.DoAfterDatabaseConnect;
2206	+	begin
2207	+	if assigned(FAfterDatabaseConnect) then
2208	+	AfterDatabaseConnect(self);
2209	+	end;
2210	+
2211		procedure TIBBase.DoBeforeDatabaseDisconnect;
2212		begin
2213		if Assigned(BeforeDatabaseDisconnect) then
#	Line 1834 | Line 2228 | begin
2228		SetTransaction(nil);
2229		end;
2230
2231	<	procedure TIBBase.DoBeforeTransactionEnd;
2231	>	procedure TIBBase.DoBeforeTransactionEnd(Action: TTransactionAction);
2232		begin
2233		if Assigned(BeforeTransactionEnd) then
2234	<	BeforeTransactionEnd(Self);
2234	>	BeforeTransactionEnd(Self,Action);
2235		end;
2236
2237		procedure TIBBase.DoAfterTransactionEnd;
#	Line 1853 | Line 2247 | begin
2247		FTransaction := nil;
2248		end;
2249
2250	+	procedure TIBBase.DoAfterExecQuery(Sender: TObject);
2251	+	begin
2252	+	if FTransaction <> nil then
2253	+	FTransaction.DoAfterExecQuery(Sender);
2254	+	end;
2255	+
2256	+	procedure TIBBase.DoAfterEdit(Sender: TObject);
2257	+	begin
2258	+	if FTransaction <> nil then
2259	+	FTransaction.DoAfterEdit(Sender);
2260	+	end;
2261	+
2262	+	procedure TIBBase.DoAfterDelete(Sender: TObject);
2263	+	begin
2264	+	if FTransaction <> nil then
2265	+	FTransaction.DoAfterDelete(Sender);
2266	+	end;
2267	+
2268	+	procedure TIBBase.DoAfterInsert(Sender: TObject);
2269	+	begin
2270	+	if FTransaction <> nil then
2271	+	FTransaction.DoAfterInsert(Sender);
2272	+	end;
2273	+
2274	+	procedure TIBBase.DoAfterPost(Sender: TObject);
2275	+	begin
2276	+	if FTransaction <> nil then
2277	+	FTransaction.DoAfterPost(Sender);
2278	+	end;
2279	+
2280		procedure TIBBase.SetDatabase(Value: TIBDatabase);
2281		begin
2282		if (FDatabase <> nil) then

Diff Legend

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