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 33 by tony, Sat Jul 18 12:30:52 2015 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;
#	Line 33 | Line 38 | unit IBDatabase;
38		interface
39
40		uses
41	<	{$IFDEF LINUX }
37	<	unix,
38	<	{$ELSE}
39	<	{$DEFINE HAS_SQLMONITOR}
41	>	{$IFDEF WINDOWS }
42		Windows,
43	+	{$ELSE}
44	+	unix,
45		{$ENDIF}
46	<	Dialogs, Controls, StdCtrls, SysUtils, Classes, Forms, ExtCtrls, IBHeader, IBExternals, DB,
47	<	IB, DBLoginDlg;
46	>	SysUtils, Classes, FPTimer, IBHeader, IBExternals, DB,
47	>	IB, CustApp;
48
49		const
50		DPBPrefix = 'isc_dpb_';
#	Line 151 | Line 155 | type
155		{ TIBDatabase }
156		TIBDataBase = class(TCustomConnection)
157		private
158	+	FAllowStreamedConnected: boolean;
159		FHiddenPassword: string;
160		FIBLoaded: Boolean;
161		FOnLogin: TIBDatabaseLoginEvent;
162	+	FSQLHourGlass: Boolean;
163		FTraceFlags: TTraceFlags;
164		FDBSQLDialect: Integer;
165		FSQLDialect: Integer;
#	Line 172 | Line 178 | type
178		FDefaultTransaction: TIBTransaction;
179		FInternalTransaction: TIBTransaction;
180		FStreamedConnected: Boolean;
181	<	FTimer: TTimer;
181	>	FTimer: TFPTimer;
182		FUserNames: TStringList;
183		FDataSets: TList;
184	+	FLoginCalled: boolean;
185	+	FCharSetSizes: array of integer;
186		procedure EnsureInactive;
187		function GetDBSQLDialect: Integer;
188		function GetSQLDialect: Integer;
#	Line 189 | Line 197 | type
197		function GetTransaction(Index: Integer): TIBTransaction;
198		function GetTransactionCount: Integer;
199		function Login: Boolean;
200	+	procedure LoadCharSetInfo;
201		procedure SetDatabaseName(const Value: TIBFileName);
202		procedure SetDBParamByDPB(const Idx: Integer; Value: String);
203		procedure SetDBParams(Value: TStrings);
#	Line 205 | Line 214 | type
214		procedure DoConnect; override;
215		procedure DoDisconnect; override;
216		function GetConnected: Boolean; override;
217	<	procedure Loaded; override;
217	>	procedure CheckStreamConnect;
218	>	procedure HandleException(Sender: TObject);
219		procedure Notification( AComponent: TComponent; Operation: TOperation); override;
220		function GetDataset(Index : longint) : TDataset; override;
221		function GetDataSetCount : Longint; override;
222	<
222	>	procedure ReadState(Reader: TReader); override;
223	>	procedure SetConnected (Value : boolean); override;
224		public
225		constructor Create(AOwner: TComponent); override;
226		destructor Destroy; override;
#	Line 246 | Line 257 | type
257
258		published
259		property Connected;
260	<	property StreamedConnected;
260	>	property AllowStreamedConnected: boolean read FAllowStreamedConnected
261	>	write FAllowStreamedConnected;
262		property DatabaseName: TIBFileName read FDBName write SetDatabaseName;
263		property Params: TStrings read FDBParams write SetDBParams;
264		property LoginPrompt default True;
#	Line 254 | Line 266 | type
266		write SetDefaultTransaction;
267		property IdleTimer: Integer read GetIdleTimer write SetIdleTimer;
268		property SQLDialect : Integer read GetSQLDialect write SetSQLDialect default 3;
269	+	property SQLHourGlass: Boolean read FSQLHourGlass write FSQLHourGlass default true;
270		property DBSQLDialect : Integer read FDBSQLDialect;
271		property TraceFlags: TTraceFlags read FTraceFlags write FTraceFlags;
272		property AfterConnect;
#	Line 271 | Line 284 | type
284
285		TIBTransaction = class(TComponent)
286		private
287	+	FAfterDelete: TNotifyEvent;
288	+	FAfterEdit: TNotifyEvent;
289	+	FAfterExecQuery: TNotifyEvent;
290	+	FAfterInsert: TNotifyEvent;
291	+	FAfterPost: TNotifyEvent;
292	+	FAfterTransactionEnd: TNotifyEvent;
293	+	FBeforeTransactionEnd: TNotifyEvent;
294		FIBLoaded: Boolean;
295		FCanTimeout         : Boolean;
296		FDatabases          : TList;
297	+	FOnStartTransaction: TNotifyEvent;
298		FSQLObjects         : TList;
299		FDefaultDatabase    : TIBDatabase;
300		FHandle             : TISC_TR_HANDLE;
#	Line 282 | Line 303 | type
303		FStreamedActive     : Boolean;
304		FTPB                : PChar;
305		FTPBLength          : Short;
306	<	FTimer              : TTimer;
306	>	FTimer              : TFPTimer;
307		FDefaultAction      : TTransactionAction;
308		FTRParams           : TStrings;
309		FTRParamsChanged    : Boolean;
310	+	FInEndTransaction   : boolean;
311	+	FEndAction          : TTransactionAction;
312	+	procedure DoBeforeTransactionEnd;
313	+	procedure DoAfterTransactionEnd;
314	+	procedure DoOnStartTransaction;
315	+	procedure DoAfterExecQuery(Sender: TObject);
316	+	procedure DoAfterEdit(Sender: TObject);
317	+	procedure DoAfterDelete(Sender: TObject);
318	+	procedure DoAfterInsert(Sender: TObject);
319	+	procedure DoAfterPost(Sender: TObject);
320		procedure EnsureNotInTransaction;
321		procedure EndTransaction(Action: TTransactionAction; Force: Boolean);
322		function GetDatabase(Index: Integer): TIBDatabase;
#	Line 327 | Line 358 | type
358		function AddDatabase(db: TIBDatabase): Integer;
359		function FindDatabase(db: TIBDatabase): Integer;
360		function FindDefaultDatabase: TIBDatabase;
361	+	function GetEndAction: TTransactionAction;
362		procedure RemoveDatabase(Idx: Integer);
363		procedure RemoveDatabases;
364		procedure CheckDatabasesInList;
#	Line 348 | Line 380 | type
380		property DefaultAction: TTransactionAction read FDefaultAction write SetDefaultAction default taCommit;
381		property Params: TStrings read FTRParams write SetTRParams;
382		property OnIdleTimer: TNotifyEvent read FOnIdleTimer write FOnIdleTimer;
383	<	end;
383	>	property BeforeTransactionEnd: TNotifyEvent read FBeforeTransactionEnd
384	>	write FBeforeTransactionEnd;
385	>	property AfterTransactionEnd: TNotifyEvent read FAfterTransactionEnd
386	>	write FAfterTransactionEnd;
387	>	property OnStartTransaction: TNotifyEvent read FOnStartTransaction
388	>	write FOnStartTransaction;
389	>	property AfterExecQuery: TNotifyEvent read FAfterExecQuery
390	>	write FAfterExecQuery;
391	>	property AfterEdit: TNotifyEvent read FAfterEdit write FAfterEdit;
392	>	property AfterDelete: TNotifyEvent read FAfterDelete write FAfterDelete;
393	>	property AfterInsert: TNotifyEvent read FAfterInsert write FAfterInsert;
394	>	property AfterPost: TNotifyEvent read FAfterPost write FAfterPost;
395	>	end;
396	>
397	>	TTransactionEndEvent = procedure(Sender:TObject; Action: TTransactionAction) of object;
398	>	TBeforeDatabaseConnectEvent = procedure (Sender: TObject; DBParams: TStrings;
399	>	var DBName: string) of object;
400
401		{ TIBBase }
402
#	Line 357 | Line 405 | type
405		connections. }
406		TIBBase = class(TObject)
407		protected
408	+	FBeforeDatabaseConnect: TBeforeDatabaseConnectEvent;
409		FDatabase: TIBDatabase;
410		FIndexInDatabase: Integer;
411		FTransaction: TIBTransaction;
#	Line 364 | Line 413 | type
413		FOwner: TObject;
414		FBeforeDatabaseDisconnect: TNotifyEvent;
415		FAfterDatabaseDisconnect: TNotifyEvent;
416	+	FAfterDatabaseConnect: TNotifyEvent;
417		FOnDatabaseFree: TNotifyEvent;
418	<	FBeforeTransactionEnd: TNotifyEvent;
418	>	FBeforeTransactionEnd: TTransactionEndEvent;
419		FAfterTransactionEnd: TNotifyEvent;
420		FOnTransactionFree: TNotifyEvent;
421
422	+	procedure DoBeforeDatabaseConnect(DBParams: TStrings;
423	+	var DBName: string); virtual;
424	+	procedure DoAfterDatabaseConnect; virtual;
425		procedure DoBeforeDatabaseDisconnect; virtual;
426		procedure DoAfterDatabaseDisconnect; virtual;
427		procedure DoDatabaseFree; virtual;
428	<	procedure DoBeforeTransactionEnd; virtual;
428	>	procedure DoBeforeTransactionEnd(Action: TTransactionAction); virtual;
429		procedure DoAfterTransactionEnd; virtual;
430		procedure DoTransactionFree; virtual;
431		function GetDBHandle: PISC_DB_HANDLE; virtual;
#	Line 384 | Line 437 | type
437		destructor Destroy; override;
438		procedure CheckDatabase; virtual;
439		procedure CheckTransaction; virtual;
440	+	procedure DoAfterExecQuery(Sender: TObject); virtual;
441	+	procedure DoAfterEdit(Sender: TObject); virtual;
442	+	procedure DoAfterDelete(Sender: TObject); virtual;
443	+	procedure DoAfterInsert(Sender: TObject); virtual;
444	+	procedure DoAfterPost(Sender: TObject); virtual;
445	+	function GetCharSetSize(CharSetID: integer): integer;
446	+	procedure HandleException(Sender: TObject);
447	+	procedure SetCursor;
448	+	procedure RestoreCursor;
449		public
450	+	property BeforeDatabaseConnect: TBeforeDatabaseConnectEvent read FBeforeDatabaseConnect
451	+	write FBeforeDatabaseConnect;
452	+	property AfterDatabaseConnect: TNotifyEvent read FAfterDatabaseConnect
453	+	write FAfterDatabaseConnect;
454		property BeforeDatabaseDisconnect: TNotifyEvent read FBeforeDatabaseDisconnect
455		write FBeforeDatabaseDisconnect;
456		property AfterDatabaseDisconnect: TNotifyEvent read FAfterDatabaseDisconnect
457		write FAfterDatabaseDisconnect;
458		property OnDatabaseFree: TNotifyEvent read FOnDatabaseFree write FOnDatabaseFree;
459	<	property BeforeTransactionEnd: TNotifyEvent read FBeforeTransactionEnd write FBeforeTransactionEnd;
459	>	property BeforeTransactionEnd: TTransactionEndEvent read FBeforeTransactionEnd write FBeforeTransactionEnd;
460		property AfterTransactionEnd: TNotifyEvent read FAfterTransactionEnd write FAfterTransactionEnd;
461		property OnTransactionFree: TNotifyEvent read FOnTransactionFree write FOnTransactionFree;
462		property Database: TIBDatabase read FDatabase
#	Line 408 | Line 474 | procedure GenerateTPB(sl: TStrings; var
474
475		implementation
476
477	<	uses IBIntf,{$IFDEF HAS_SQLMONITOR}IBSQLMonitor,{$ENDIF} IBCustomDataSet, IBDatabaseInfo, IBSQL, IBUtils, typInfo;
477	>	uses IBIntf, IBSQLMonitor, IBCustomDataSet, IBDatabaseInfo, IBSQL, IBUtils,
478	>	typInfo;
479
480		{ TIBDatabase }
481
482	<	constructor TIBDatabase.Create(AOwner: TComponent);
482	>	constructor TIBDataBase.Create(AOwner: TComponent);
483	>	{$ifdef WINDOWS}
484	>	var acp: uint;
485	>	{$endif}
486		begin
487		inherited Create(AOwner);
488		FIBLoaded := False;
#	Line 423 | Line 493 | begin
493		FTransactions := TList.Create;
494		FDBName := '';
495		FDBParams := TStringList.Create;
496	+	FSQLHourGlass := true;
497	+	if (AOwner <> nil) and
498	+	(AOwner is TCustomApplication) and
499	+	TCustomApplication(AOWner).ConsoleApplication then
500	+	LoginPrompt := false;
501	+	{$ifdef UNIX}
502	+	if csDesigning in ComponentState then
503	+	FDBParams.Add('lc_ctype=UTF8');
504	+	{$else}
505	+	{$ifdef WINDOWS}
506	+	if csDesigning in ComponentState then
507	+	begin
508	+	acp := GetACP;
509	+	if (acp >= 1250) and (acp <= 1254) then
510	+	FDBParams.Values['lc_ctype'] := Format('WIN%d',[acp]);
511	+	end;
512	+	{$endif}
513	+	{$endif}
514		FDBParamsChanged := True;
515		TStringList(FDBParams).OnChange := DBParamsChange;
516		TStringList(FDBParams).OnChanging := DBParamsChanging;
#	Line 431 | Line 519 | begin
519		FUserNames := nil;
520		FInternalTransaction := TIBTransaction.Create(self);
521		FInternalTransaction.DefaultDatabase := Self;
522	<	FTimer := TTimer.Create(Self);
522	>	FTimer := TFPTimer.Create(Self);
523		FTimer.Enabled := False;
524		FTimer.Interval := 0;
525		FTimer.OnTimer := TimeoutConnection;
#	Line 439 | Line 527 | begin
527		FSQLDialect := 3;
528		FTraceFlags := [];
529		FDataSets := TList.Create;
530	+	CheckStreamConnect;
531		end;
532
533	<	destructor TIBDatabase.Destroy;
533	>	destructor TIBDataBase.Destroy;
534		var
535		i: Integer;
536		begin
#	Line 467 | Line 556 | begin
556		inherited Destroy;
557		end;
558
559	<	function TIBDatabase.Call(ErrCode: ISC_STATUS;
560	<	RaiseError: Boolean): ISC_STATUS;
559	>	function TIBDataBase.Call(ErrCode: ISC_STATUS; RaiseError: Boolean
560	>	): ISC_STATUS;
561		begin
562		result := ErrCode;
563		FCanTimeout := False;
#	Line 476 | Line 565 | begin
565		IBDataBaseError;
566		end;
567
568	<	procedure TIBDatabase.CheckActive;
568	>	procedure TIBDataBase.CheckActive;
569		begin
570		if StreamedConnected and (not Connected) then
571		Loaded;
#	Line 484 | Line 573 | begin
573		IBError(ibxeDatabaseClosed, [nil]);
574		end;
575
576	<	procedure TIBDatabase.EnsureInactive;
576	>	procedure TIBDataBase.EnsureInactive;
577		begin
578		if csDesigning in ComponentState then
579		begin
#	Line 493 | Line 582 | begin
582		end
583		end;
584
585	<	procedure TIBDatabase.CheckInactive;
585	>	procedure TIBDataBase.CheckInactive;
586		begin
587		if FHandle <> nil then
588		IBError(ibxeDatabaseOpen, [nil]);
589		end;
590
591	<	procedure TIBDatabase.CheckDatabaseName;
591	>	procedure TIBDataBase.CheckDatabaseName;
592		begin
593		if (FDBName = '') then
594		IBError(ibxeDatabaseNameMissing, [nil]);
595		end;
596
597	<	function TIBDatabase.AddSQLObject(ds: TIBBase): Integer;
597	>	function TIBDataBase.AddSQLObject(ds: TIBBase): Integer;
598		begin
599		result := 0;
600		if (ds.Owner is TIBCustomDataSet) then
601	<	{$IFDEF LINUX}
513	<	FDataSets.Add(TDataSet(ds.Owner));
514	<	{$ELSE}
515	<	RegisterClient(TDataSet(ds.Owner));
516	<	{$ENDIF}
601	>	FDataSets.Add(ds.Owner);
602		while (result < FSQLObjects.Count) and (FSQLObjects[result] <> nil) do
603		Inc(result);
604		if (result = FSQLObjects.Count) then
#	Line 522 | Line 607 | begin
607		FSQLObjects[result] := ds;
608		end;
609
610	<	function TIBDatabase.AddTransaction(TR: TIBTransaction): Integer;
610	>	function TIBDataBase.AddTransaction(TR: TIBTransaction): Integer;
611		begin
612		result := FindTransaction(TR);
613		if result <> -1 then
#	Line 539 | Line 624 | begin
624		FTransactions[result] := TR;
625		end;
626
627	<	procedure TIBDatabase.DoDisconnect;
627	>	procedure TIBDataBase.DoDisconnect;
628		begin
629		if Connected then
630		InternalClose(False);
631		FDBSQLDialect := 1;
632	+	SetLength(FCharSetSizes,0);
633		end;
634
635	<	procedure TIBDatabase.CreateDatabase;
635	>	procedure TIBDataBase.CreateDatabase;
636		var
637		tr_handle: TISC_TR_HANDLE;
638		begin
#	Line 559 | Line 645 | begin
645		True);
646		end;
647
648	<	procedure TIBDatabase.DropDatabase;
648	>	procedure TIBDataBase.DropDatabase;
649		begin
650		CheckActive;
651		Call(isc_drop_database(StatusVector, @FHandle), True);
652		end;
653
654	<	procedure TIBDatabase.DBParamsChange(Sender: TObject);
654	>	procedure TIBDataBase.DBParamsChange(Sender: TObject);
655		begin
656		FDBParamsChanged := True;
657		end;
658
659	<	procedure TIBDatabase.DBParamsChanging(Sender: TObject);
659	>	procedure TIBDataBase.DBParamsChanging(Sender: TObject);
660		begin
661		EnsureInactive;
662		CheckInactive;
663		end;
664
665	<	function TIBDatabase.FindTransaction(TR: TIBTransaction): Integer;
665	>	function TIBDataBase.FindTransaction(TR: TIBTransaction): Integer;
666		var
667		i: Integer;
668		begin
#	Line 589 | Line 675 | begin
675		end;
676		end;
677
678	<	function TIBDatabase.FindDefaultTransaction(): TIBTransaction;
678	>	function TIBDataBase.FindDefaultTransaction: TIBTransaction;
679		var
680		i: Integer;
681		begin
#	Line 607 | Line 693 | begin
693		end;
694		end;
695
696	<	procedure TIBDatabase.ForceClose;
696	>	procedure TIBDataBase.ForceClose;
697		begin
698		if Connected then
699		InternalClose(True);
700		end;
701
702	<	function TIBDatabase.GetConnected: Boolean;
702	>	function TIBDataBase.GetConnected: Boolean;
703		begin
704		result := FHandle <> nil;
705		end;
706
707	<	function TIBDatabase.GetSQLObject(Index: Integer): TIBBase;
707	>	function TIBDataBase.GetSQLObject(Index: Integer): TIBBase;
708		begin
709		result := FSQLObjects[Index];
710		end;
711
712	<	function TIBDatabase.GetSQLObjectCount: Integer;
712	>	function TIBDataBase.GetSQLObjectCount: Integer;
713		var
714		i: Integer;
715		begin
#	Line 632 | Line 718 | begin
718		Inc(result);
719		end;
720
721	<	function TIBDatabase.GetDBParamByDPB(const Idx: Integer): String;
721	>	function TIBDataBase.GetDBParamByDPB( const Idx: Integer): String;
722		var
723		ConstIdx, EqualsIdx: Integer;
724		begin
#	Line 655 | Line 741 | begin
741		result := '';
742		end;
743
744	<	function TIBDatabase.GetIdleTimer: Integer;
744	>	function TIBDataBase.GetIdleTimer: Integer;
745		begin
746		result := FTimer.Interval;
747		end;
748
749	<	function TIBDatabase.GetTransaction(Index: Integer): TIBTransaction;
749	>	function TIBDataBase.GetTransaction(Index: Integer): TIBTransaction;
750		begin
751		result := FTransactions[Index];
752		end;
753
754	<	function TIBDatabase.GetTransactionCount: Integer;
754	>	function TIBDataBase.GetTransactionCount: Integer;
755		var
756		i: Integer;
757		begin
#	Line 675 | Line 761 | begin
761		Inc(result);
762		end;
763
764	<	function TIBDatabase.IndexOfDBConst(st: String): Integer;
764	>	function TIBDataBase.IndexOfDBConst(st: String): Integer;
765		var
766		i, pos_of_str: Integer;
767		begin
#	Line 691 | Line 777 | begin
777		end;
778		end;
779
780	<	procedure TIBDatabase.InternalClose(Force: Boolean);
780	>	procedure TIBDataBase.InternalClose(Force: Boolean);
781		var
782		i: Integer;
783		begin
#	Line 730 | Line 816 | begin
816		FHandleIsShared := False;
817		end;
818
733	–	{$IFDEF HAS_SQLMONITOR}
819		if not (csDesigning in ComponentState) then
820		MonitorHook.DBDisconnect(Self);
736	–	{$ENDIF}
821
822		for i := 0 to FSQLObjects.Count - 1 do
823		if FSQLObjects[i] <> nil then
824		SQLObjects[i].DoAfterDatabaseDisconnect;
825		end;
826
827	<	procedure TIBDatabase.Loaded;
827	>	procedure TIBDataBase.LoadCharSetInfo;
828	>	var Query: TIBSQL;
829	>	i: integer;
830	>	begin
831	>	if not FInternalTransaction.Active then
832	>	FInternalTransaction.StartTransaction;
833	>	Query := TIBSQL.Create(self);
834	>	try
835	>	Query.Database := Self;
836	>	Query.Transaction := FInternalTransaction;
837	>	Query.SQL.Text := 'Select RDB$CHARACTER_SET_ID, RDB$BYTES_PER_CHARACTER ' +
838	>	'From RDB$CHARACTER_SETS Order by 1 DESC'; {do not localize}
839	>	Query.Prepare;
840	>	Query.ExecQuery;
841	>	if not Query.EOF then
842	>	begin
843	>	SetLength(FCharSetSizes,Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger + 1);
844	>	for i := 0 to Length(FCharSetSizes) - 1 do FCharSetSizes[i] := 1;
845	>	repeat
846	>	FCharSetSizes[Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger] :=
847	>	Query.FieldByName('RDB$BYTES_PER_CHARACTER').AsInteger;
848	>	Query.Next;
849	>	until Query.EOF;
850	>	end;
851	>	finally
852	>	Query.free;
853	>	FInternalTransaction.Commit;
854	>	end;
855	>	end;
856	>
857	>	procedure TIBDataBase.CheckStreamConnect;
858		var
859		i: integer;
860		begin
861		try
862	<	if StreamedConnected and (not Connected) then
862	>	if not (csDesigning in ComponentState) and StreamedConnected and (not Connected) then
863		begin
750	–	inherited Loaded;
864		for i := 0 to FTransactions.Count - 1 do
865		if  FTransactions[i] <> nil then
866		begin
#	Line 767 | Line 880 | begin
880		end;
881		except
882		if csDesigning in ComponentState then
883	<	Application.HandleException(Self)
883	>	HandleException(Self)
884		else
885		raise;
886		end;
887		end;
888
889	<	procedure TIBDatabase.Notification( AComponent: TComponent;
890	<	Operation: TOperation);
889	>	procedure TIBDataBase.HandleException(Sender: TObject);
890	>	var aParent: TComponent;
891	>	begin
892	>	aParent := Owner;
893	>	while aParent <> nil do
894	>	begin
895	>	if aParent is TCustomApplication then
896	>	begin
897	>	TCustomApplication(aParent).HandleException(Sender);
898	>	Exit;
899	>	end;
900	>	aParent := aParent.Owner;
901	>	end;
902	>	SysUtils.ShowException(ExceptObject,ExceptAddr);
903	>	end;
904	>
905	>	procedure TIBDataBase.Notification(AComponent: TComponent;
906	>	Operation: TOperation);
907		var
908		i: Integer;
909		begin
#	Line 788 | Line 917 | begin
917		end;
918		end;
919
920	<	function TIBDatabase.Login: Boolean;
920	>	function TIBDataBase.Login: Boolean;
921		var
922		IndexOfUser, IndexOfPassword: Integer;
923		Username, Password, OldPassword: String;
#	Line 812 | Line 941 | var
941		end;
942
943		begin
944	<	if Assigned(FOnLogin) then
944	>	Result := false;
945	>	if FLoginCalled then Exit;
946	>	FLoginCalled := true;
947	>	try
948	>	if Assigned(FOnLogin) and not (csDesigning in ComponentState) then
949		begin
950		result := True;
951		LoginParams := TStringList.Create;
#	Line 826 | Line 959 | begin
959		end;
960		end
961		else
962	+	if assigned(IBGUIInterface) then
963		begin
964		IndexOfUser := IndexOfDBConst(DPBConstantNames[isc_dpb_user_name]);
965		if IndexOfUser <> -1 then
#	Line 840 | Line 974 | begin
974		Length(Params[IndexOfPassword]));
975		OldPassword := password;
976		end;
977	<	result := LoginDialogEx(DatabaseName, Username, Password, False);
977	>	result := IBGUIInterface.LoginDialogEx(DatabaseName, Username, Password, False);
978		if result then
979		begin
980		if IndexOfUser = -1 then
#	Line 857 | Line 991 | begin
991		HidePassword;
992		end;
993		end;
994	+	end
995	+	else
996	+	if LoginPrompt then
997	+	IBError(ibxeNoLoginDialog,[]);
998	+	finally
999	+	FLoginCalled := false
1000		end;
1001		end;
1002
1003	<	procedure TIBDatabase.DoConnect;
1003	>	procedure TIBDataBase.DoConnect;
1004		var
1005		DPB: String;
1006		TempDBParams: TStrings;
1007	<
1007	>	I: integer;
1008	>	aDBName: string;
1009		begin
1010		CheckInactive;
1011		CheckDatabaseName;
#	Line 874 | Line 1015 | begin
1015		FDBParamsChanged := True;
1016		end;
1017		{ Use builtin login prompt if requested }
1018	<	if LoginPrompt and not Login then
1018	>	if (LoginPrompt or (csDesigning in ComponentState)) and not Login then
1019		IBError(ibxeOperationCancelled, [nil]);
1020	<	{ Generate a new DPB if necessary }
1021	<	if (FDBParamsChanged) then
1022	<	begin
1023	<	FDBParamsChanged := False;
1024	<	if (not LoginPrompt) or (FHiddenPassword = '') then
1025	<	GenerateDPB(FDBParams, DPB, FDPBLength)
1026	<	else
1027	<	begin
1028	<	TempDBParams := TStringList.Create;
1029	<	try
1030	<	TempDBParams.Assign(FDBParams);
1031	<	TempDBParams.Add('password=' + FHiddenPassword);
1032	<	GenerateDPB(TempDBParams, DPB, FDPBLength);
1033	<	finally
1034	<	TempDBParams.Free;
1035	<	end;
1036	<	end;
1037	<	IBAlloc(FDPB, 0, FDPBLength);
1038	<	Move(DPB[1], FDPB[0], FDPBLength);
1020	>
1021	>	TempDBParams := TStringList.Create;
1022	>	try
1023	>	TempDBParams.Assign(FDBParams);
1024	>	aDBName := FDBName;
1025	>	{Opportuning to override defaults}
1026	>	for i := 0 to FSQLObjects.Count - 1 do
1027	>	begin
1028	>	if FSQLObjects[i] <> nil then
1029	>	SQLObjects[i].DoBeforeDatabaseConnect(TempDBParams,aDBName);
1030	>	end;
1031	>
1032	>	{ Generate a new DPB if necessary }
1033	>	if (FDBParamsChanged or (TempDBParams.Text <> FDBParams.Text)) then
1034	>	begin
1035	>	FDBParamsChanged := False;
1036	>	if (not LoginPrompt and not (csDesigning in ComponentState)) or (FHiddenPassword = '') then
1037	>	GenerateDPB(TempDBParams, DPB, FDPBLength)
1038	>	else
1039	>	begin
1040	>	TempDBParams.Add('password=' + FHiddenPassword);
1041	>	GenerateDPB(TempDBParams, DPB, FDPBLength);
1042	>	end;
1043	>	IBAlloc(FDPB, 0, FDPBLength);
1044	>	Move(DPB[1], FDPB[0], FDPBLength);
1045	>	end;
1046	>	finally
1047	>	TempDBParams.Free;
1048		end;
1049	<	if Call(isc_attach_database(StatusVector, Length(FDBName),
1050	<	PChar(FDBName), @FHandle,
1049	>	if Call(isc_attach_database(StatusVector, Length(aDBName),
1050	>	PChar(aDBName), @FHandle,
1051		FDPBLength, FDPB), False) > 0 then
1052		begin
1053		FHandle := nil;
1054		IBDataBaseError;
1055		end;
1056	+	if not (csDesigning in ComponentState) then
1057	+	FDBName := aDBName; {Synchronise at run time}
1058		FDBSQLDialect := GetDBSQLDialect;
1059		ValidateClientSQLDialect;
1060	<	{$IFDEF HAS_SQLMONITOR}
1060	>	for i := 0 to FSQLObjects.Count - 1 do
1061	>	begin
1062	>	if FSQLObjects[i] <> nil then
1063	>	SQLObjects[i].DoAfterDatabaseConnect;
1064	>	end;
1065		if not (csDesigning in ComponentState) then
1066		MonitorHook.DBConnect(Self);
1067	<	{$ENDIF}
1067	>	LoadCharSetInfo;
1068		end;
1069
1070	<	procedure TIBDatabase.RemoveSQLObject(Idx: Integer);
1070	>	procedure TIBDataBase.RemoveSQLObject(Idx: Integer);
1071		var
1072		ds: TIBBase;
1073		begin
#	Line 921 | Line 1077 | begin
1077		FSQLObjects[Idx] := nil;
1078		ds.Database := nil;
1079		if (ds.owner is TDataSet) then
924	–	{$IFDEF LINUX}
1080		FDataSets.Remove(TDataSet(ds.Owner));
926	–	{$ELSE}
927	–	UnregisterClient(TDataSet(ds.Owner));
928	–	{$ENDIF}
1081		end;
1082		end;
1083
1084	<	procedure TIBDatabase.RemoveSQLObjects;
1084	>	procedure TIBDataBase.RemoveSQLObjects;
1085		var
1086		i: Integer;
1087		begin
#	Line 937 | Line 1089 | begin
1089		begin
1090		RemoveSQLObject(i);
1091		if (TIBBase(FSQLObjects[i]).owner is TDataSet) then
940	–	{$IFDEF LINUX}
1092		FDataSets.Remove(TDataSet(TIBBase(FSQLObjects[i]).owner));
942	–	{$ELSE}
943	–	UnregisterClient(TDataSet(TIBBase(FSQLObjects[i]).owner));
944	–	{$ENDIF}
1093		end;
1094		end;
1095
1096	<	procedure TIBDatabase.RemoveTransaction(Idx: Integer);
1096	>	procedure TIBDataBase.RemoveTransaction(Idx: Integer);
1097		var
1098		TR: TIBTransaction;
1099		begin
#	Line 959 | Line 1107 | begin
1107		end;
1108		end;
1109
1110	<	procedure TIBDatabase.RemoveTransactions;
1110	>	procedure TIBDataBase.RemoveTransactions;
1111		var
1112		i: Integer;
1113		begin
#	Line 967 | Line 1115 | begin
1115		RemoveTransaction(i);
1116		end;
1117
1118	<	procedure TIBDatabase.SetDatabaseName(const Value: TIBFileName);
1118	>	procedure TIBDataBase.SetDatabaseName( const Value: TIBFileName);
1119		begin
1120		if FDBName <> Value then
1121		begin
#	Line 977 | Line 1125 | begin
1125		end;
1126		end;
1127
1128	<	procedure TIBDatabase.SetDBParamByDPB(const Idx: Integer; Value: String);
1128	>	procedure TIBDataBase.SetDBParamByDPB( const Idx: Integer; Value: String);
1129		var
1130		ConstIdx: Integer;
1131		begin
#	Line 996 | Line 1144 | begin
1144		end;
1145		end;
1146
1147	<	procedure TIBDatabase.SetDBParams(Value: TStrings);
1147	>	procedure TIBDataBase.SetDBParams(Value: TStrings);
1148		begin
1149		FDBParams.Assign(Value);
1150		end;
1151
1152	<	procedure TIBDatabase.SetDefaultTransaction(Value: TIBTransaction);
1152	>	procedure TIBDataBase.SetDefaultTransaction(Value: TIBTransaction);
1153		var
1154		i: Integer;
1155		begin
#	Line 1019 | Line 1167 | begin
1167		FDefaultTransaction := Value;
1168		end;
1169
1170	<	procedure TIBDatabase.SetHandle(Value: TISC_DB_HANDLE);
1170	>	procedure TIBDataBase.SetHandle(Value: TISC_DB_HANDLE);
1171		begin
1172		if HandleIsShared then
1173		Close
#	Line 1029 | Line 1177 | begin
1177		FHandleIsShared := (Value <> nil);
1178		end;
1179
1180	<	procedure TIBDatabase.SetIdleTimer(Value: Integer);
1180	>	procedure TIBDataBase.SetIdleTimer(Value: Integer);
1181		begin
1182		if Value < 0 then
1183		IBError(ibxeTimeoutNegative, [nil])
#	Line 1048 | Line 1196 | begin
1196		end;
1197		end;
1198
1199	<	function TIBDatabase.TestConnected: Boolean;
1199	>	function TIBDataBase.TestConnected: Boolean;
1200		var
1201		DatabaseInfo: TIBDatabaseInfo;
1202		begin
#	Line 1069 | Line 1217 | begin
1217		end;
1218		end;
1219
1220	<	procedure TIBDatabase.TimeoutConnection(Sender: TObject);
1220	>	procedure TIBDataBase.TimeoutConnection(Sender: TObject);
1221		begin
1222		if Connected then
1223		begin
#	Line 1084 | Line 1232 | begin
1232		end;
1233		end;
1234
1235	<	function TIBDatabase.GetIsReadOnly: Boolean;
1235	>	function TIBDataBase.GetIsReadOnly: Boolean;
1236		var
1237		DatabaseInfo: TIBDatabaseInfo;
1238		begin
#	Line 1102 | Line 1250 | begin
1250		DatabaseInfo.Free;
1251		end;
1252
1253	<	function TIBDatabase.GetSQLDialect: Integer;
1253	>	function TIBDataBase.GetSQLDialect: Integer;
1254		begin
1255		Result := FSQLDialect;
1256		end;
1257
1258	<	procedure TIBDatabase.SetSQLDialect(const Value: Integer);
1258	>
1259	>	procedure TIBDataBase.SetSQLDialect( const Value: Integer);
1260		begin
1261		if (Value < 1) then IBError(ibxeSQLDialectInvalid, [nil]);
1262		if ((FHandle = nil) or (Value <= FDBSQLDialect))  then
#	Line 1116 | Line 1265 | begin
1265		IBError(ibxeSQLDialectInvalid, [nil]);
1266		end;
1267
1268	<	function TIBDatabase.GetDBSQLDialect: Integer;
1268	>	function TIBDataBase.GetDBSQLDialect: Integer;
1269		var
1270		DatabaseInfo: TIBDatabaseInfo;
1271		begin
#	Line 1126 | Line 1275 | begin
1275		DatabaseInfo.Free;
1276		end;
1277
1278	<	procedure TIBDatabase.ValidateClientSQLDialect;
1278	>	procedure TIBDataBase.ValidateClientSQLDialect;
1279		begin
1280		if (FDBSQLDialect < FSQLDialect) then
1281		begin
#	Line 1136 | Line 1285 | begin
1285		end;
1286		end;
1287
1288	<	procedure TIBDatabase.ApplyUpdates(const DataSets: array of TDataSet);
1288	>	procedure TIBDataBase.ApplyUpdates( const DataSets: array of TDataSet);
1289		var
1290		I: Integer;
1291		DS: TIBCustomDataSet;
#	Line 1162 | Line 1311 | begin
1311		TR.CommitRetaining;
1312		end;
1313
1314	<	procedure TIBDatabase.CloseDataSets;
1314	>	procedure TIBDataBase.CloseDataSets;
1315		var
1316		i: Integer;
1317		begin
#	Line 1171 | Line 1320 | begin
1320		DataSets[i].close;
1321		end;
1322
1323	<	function TIBDatabase.GetDataset(Index : longint) : TDataset;
1323	>	function TIBDataBase.GetDataset(Index: longint): TDataset;
1324		begin
1325		if (Index >= 0) and (Index < FDataSets.Count) then
1326		Result := TDataSet(FDataSets[Index])
#	Line 1179 | Line 1328 | begin
1328		raise Exception.Create('Invalid Index to DataSets');
1329		end;
1330
1331	<	function TIBDatabase.GetDataSetCount : Longint;
1331	>	function TIBDataBase.GetDataSetCount: Longint;
1332		begin
1333		Result := FDataSets.Count;
1334		end;
1335
1336	<	procedure TIBDatabase.GetFieldNames(const TableName: string; List: TStrings);
1336	>	procedure TIBDataBase.ReadState(Reader: TReader);
1337	>	begin
1338	>	FDBParams.Clear;
1339	>	inherited ReadState(Reader);
1340	>	end;
1341	>
1342	>	procedure TIBDataBase.SetConnected(Value: boolean);
1343	>	begin
1344	>	if StreamedConnected and not AllowStreamedConnected then
1345	>	begin
1346	>	StreamedConnected := false;
1347	>	Value := false
1348	>	end;
1349	>	inherited SetConnected(Value);
1350	>	end;
1351	>
1352	>	procedure TIBDataBase.GetFieldNames( const TableName: string; List: TStrings);
1353		var
1354		Query: TIBSQL;
1355		begin
#	Line 1225 | Line 1390 | begin
1390		end;
1391		end;
1392
1393	<	procedure TIBDatabase.GetTableNames(List: TStrings; SystemTables: Boolean);
1393	>	procedure TIBDataBase.GetTableNames(List: TStrings; SystemTables: Boolean);
1394		var
1395		Query : TIBSQL;
1396		begin
#	Line 1284 | Line 1449 | begin
1449		FTRParamsChanged := True;
1450		TStringList(FTRParams).OnChange := TRParamsChange;
1451		TStringList(FTRParams).OnChanging := TRParamsChanging;
1452	<	FTimer := TTimer.Create(Self);
1452	>	FTimer := TFPTimer.Create(Self);
1453		FTimer.Enabled := False;
1454		FTimer.Interval := 0;
1455		FTimer.OnTimer := TimeoutTransaction;
#	Line 1340 | Line 1505 | begin
1505		IBError(ibxeNotInTransaction, [nil]);
1506		end;
1507
1508	+	procedure TIBTransaction.DoBeforeTransactionEnd;
1509	+	begin
1510	+	if Assigned(FBeforeTransactionEnd) then
1511	+	FBeforeTransactionEnd(self);
1512	+	end;
1513	+
1514	+	procedure TIBTransaction.DoAfterTransactionEnd;
1515	+	begin
1516	+	if Assigned(FAfterTransactionEnd) then
1517	+	FAfterTransactionEnd(self);
1518	+	end;
1519	+
1520	+	procedure TIBTransaction.DoOnStartTransaction;
1521	+	begin
1522	+	if assigned(FOnStartTransaction) then
1523	+	OnStartTransaction(self);
1524	+	end;
1525	+
1526	+	procedure TIBTransaction.DoAfterExecQuery(Sender: TObject);
1527	+	begin
1528	+	if assigned(FAfterExecQuery) then
1529	+	AfterExecQuery(Sender);
1530	+	end;
1531	+
1532	+	procedure TIBTransaction.DoAfterEdit(Sender: TObject);
1533	+	begin
1534	+	if assigned(FAfterEdit) then
1535	+	AfterEdit(Sender);
1536	+	end;
1537	+
1538	+	procedure TIBTransaction.DoAfterDelete(Sender: TObject);
1539	+	begin
1540	+	if assigned(FAfterDelete) then
1541	+	AfterDelete(Sender);
1542	+	end;
1543	+
1544	+	procedure TIBTransaction.DoAfterInsert(Sender: TObject);
1545	+	begin
1546	+	if assigned(FAfterInsert) then
1547	+	AfterInsert(Sender);
1548	+	end;
1549	+
1550	+	procedure TIBTransaction.DoAfterPost(Sender: TObject);
1551	+	begin
1552	+	if assigned(FAfterPost) then
1553	+	AfterPost(Sender);
1554	+	end;
1555	+
1556		procedure TIBTransaction.EnsureNotInTransaction;
1557		begin
1558		if csDesigning in ComponentState then
#	Line 1414 | Line 1627 | var
1627		i: Integer;
1628		begin
1629		CheckInTransaction;
1630	+	if FInEndTransaction then Exit;
1631	+	FInEndTransaction := true;
1632	+	FEndAction := Action;
1633	+	try
1634		case Action of
1635		TARollback, TACommit:
1636		begin
#	Line 1421 | Line 1638 | begin
1638		(Action <> FDefaultAction) and
1639		(not Force) then
1640		IBError(ibxeCantEndSharedTransaction, [nil]);
1641	+	DoBeforeTransactionEnd;
1642		for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then
1643	<	SQLObjects[i].DoBeforeTransactionEnd;
1643	>	SQLObjects[i].DoBeforeTransactionEnd(Action);
1644		if InTransaction then
1645		begin
1646		if HandleIsShared then
#	Line 1445 | Line 1663 | begin
1663		IBDataBaseError;
1664		for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then
1665		SQLObjects[i].DoAfterTransactionEnd;
1666	+	DoAfterTransactionEnd;
1667		end;
1668		end;
1669		TACommitRetaining:
#	Line 1452 | Line 1671 | begin
1671		TARollbackRetaining:
1672		Call(isc_rollback_retaining(StatusVector, @FHandle), True);
1673		end;
1455	–	{$IFDEF HAS_SQLMONITOR}
1674		if not (csDesigning in ComponentState) then
1675		begin
1676		case Action of
#	Line 1466 | Line 1684 | begin
1684		MonitorHook.TRRollbackRetaining(Self);
1685		end;
1686		end;
1687	<	{$ENDIF}
1687	>	finally
1688	>	FInEndTransaction := false
1689	>	end;
1690		end;
1691
1692		function TIBTransaction.GetDatabase(Index: Integer): TIBDatabase;
#	Line 1534 | Line 1754 | begin
1754		end;
1755		end;
1756
1757	+	function TIBTransaction.GetEndAction: TTransactionAction;
1758	+	begin
1759	+	if FInEndTransaction then
1760	+	Result := FEndAction
1761	+	else
1762	+	IBError(ibxeIB60feature, [nil])
1763	+	end;
1764	+
1765
1766		function TIBTransaction.GetIdleTimer: Integer;
1767		begin
#	Line 1639 | Line 1867 | begin
1867		for i := 0 to FSQLObjects.Count - 1 do
1868		if (FSQLObjects[i] <> nil) and
1869		(TIBBase(FSQLObjects[i]).Database = nil) then
1870	<	SetOrdProp(TIBBase(FSQLObjects[i]).Owner, 'Database', Integer(Value));
1870	>	SetObjectProp(TIBBase(FSQLObjects[i]).Owner, 'Database', Value);
1871		end;
1872		FDefaultDatabase := Value;
1873		end;
#	Line 1740 | Line 1968 | begin
1968		FHandle := nil;
1969		IBDataBaseError;
1970		end;
1743	–	{$IFDEF HAS_SQLMONITOR}
1971		if not (csDesigning in ComponentState) then
1972		MonitorHook.TRStart(Self);
1746	–	{$ENDIF}
1973		finally
1974		FreeMem(pteb);
1975		end;
1976	+	DoOnStartTransaction;
1977		end;
1978
1979		procedure TIBTransaction.TimeoutTransaction(Sender: TObject);
#	Line 1788 | Line 2015 | begin
2015		inherited Destroy;
2016		end;
2017
2018	+	function TIBBase.GetCharSetSize(CharSetID: integer): integer;
2019	+	begin
2020	+	if (CharSetID >= 0) and (CharSetID < Length(Database.FCharSetSizes)) then
2021	+	Result := Database.FCharSetSizes[CharSetID]
2022	+	else
2023	+	Result := 1; {Unknown character set}
2024	+	end;
2025	+
2026	+	procedure TIBBase.HandleException(Sender: TObject);
2027	+	begin
2028	+	if assigned(Database) then
2029	+	Database.HandleException(Sender)
2030	+	else
2031	+	SysUtils.ShowException(ExceptObject,ExceptAddr);
2032	+	end;
2033	+
2034	+	procedure TIBBase.SetCursor;
2035	+	begin
2036	+	if Assigned(Database) and not Database.SQLHourGlass then
2037	+	Exit;
2038	+	if assigned(IBGUIInterface) then
2039	+	IBGUIInterface.SetCursor;
2040	+	end;
2041	+
2042	+	procedure TIBBase.RestoreCursor;
2043	+	begin
2044	+	if Assigned(Database) and not Database.SQLHourGlass then
2045	+	Exit;
2046	+	if assigned(IBGUIInterface) then
2047	+	IBGUIInterface.RestoreCursor;
2048	+	end;
2049	+
2050		procedure TIBBase.CheckDatabase;
2051		begin
2052		if (FDatabase = nil) then
#	Line 1814 | Line 2073 | begin
2073		result := @FTransaction.Handle;
2074		end;
2075
2076	+	procedure TIBBase.DoBeforeDatabaseConnect(DBParams: TStrings; var DBName: string
2077	+	);
2078	+	begin
2079	+	if assigned(FBeforeDatabaseConnect) then
2080	+	BeforeDatabaseConnect(self,DBParams,DBName);
2081	+	end;
2082	+
2083	+	procedure TIBBase.DoAfterDatabaseConnect;
2084	+	begin
2085	+	if assigned(FAfterDatabaseConnect) then
2086	+	AfterDatabaseConnect(self);
2087	+	end;
2088	+
2089		procedure TIBBase.DoBeforeDatabaseDisconnect;
2090		begin
2091		if Assigned(BeforeDatabaseDisconnect) then
#	Line 1834 | Line 2106 | begin
2106		SetTransaction(nil);
2107		end;
2108
2109	<	procedure TIBBase.DoBeforeTransactionEnd;
2109	>	procedure TIBBase.DoBeforeTransactionEnd(Action: TTransactionAction);
2110		begin
2111		if Assigned(BeforeTransactionEnd) then
2112	<	BeforeTransactionEnd(Self);
2112	>	BeforeTransactionEnd(Self,Action);
2113		end;
2114
2115		procedure TIBBase.DoAfterTransactionEnd;
#	Line 1853 | Line 2125 | begin
2125		FTransaction := nil;
2126		end;
2127
2128	+	procedure TIBBase.DoAfterExecQuery(Sender: TObject);
2129	+	begin
2130	+	if FTransaction <> nil then
2131	+	FTransaction.DoAfterExecQuery(Sender);
2132	+	end;
2133	+
2134	+	procedure TIBBase.DoAfterEdit(Sender: TObject);
2135	+	begin
2136	+	if FTransaction <> nil then
2137	+	FTransaction.DoAfterEdit(Sender);
2138	+	end;
2139	+
2140	+	procedure TIBBase.DoAfterDelete(Sender: TObject);
2141	+	begin
2142	+	if FTransaction <> nil then
2143	+	FTransaction.DoAfterDelete(Sender);
2144	+	end;
2145	+
2146	+	procedure TIBBase.DoAfterInsert(Sender: TObject);
2147	+	begin
2148	+	if FTransaction <> nil then
2149	+	FTransaction.DoAfterInsert(Sender);
2150	+	end;
2151	+
2152	+	procedure TIBBase.DoAfterPost(Sender: TObject);
2153	+	begin
2154	+	if FTransaction <> nil then
2155	+	FTransaction.DoAfterPost(Sender);
2156	+	end;
2157	+
2158		procedure TIBBase.SetDatabase(Value: TIBDatabase);
2159		begin
2160		if (FDatabase <> nil) then

Diff Legend

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