ViewVC Help

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

root/public/ibx/trunk/examples/DBAdmin/DataModule.pas

Comparing ibx/trunk/examples/DBAdmin/DataModule.pas (file contents):
Revision 271 by tony, Mon Apr 16 08:49:32 2018 UTC vs.
Revision 272 by tony, Mon Feb 4 13:34:37 2019 UTC

#	Line 28 | Line 28 | uses
28
29		type
30
31	<	{ TDatabaseData }
31	>	{ TDBDataModule }
32
33	<	TDatabaseData = class(TDataModule)
33	>	TDBDataModule = class(TDataModule)
34		AccessRightsCHILDCOUNT: TIBLargeIntField;
35		AccessRightsDisplayName: TStringField;
36		AccessRightsID: TIBStringField;
#	Line 71 | Line 71 | type
71		AttachmentsRDBSECURITY_CLASS: TIBStringField;
72		AttachmentsRDBSYSTEM_FLAG: TIBSmallintField;
73		CharSetLookup: TIBQuery;
74	+	ConfigDataset: TMemDataset;
75		CurrentTransaction: TIBTransaction;
76		DatabaseQuery: TIBQuery;
77		Attachments: TIBQuery;
78	+	DatabaseQueryMONBACKUP_STATE: TIBSmallintField;
79	+	DatabaseQueryMONCREATION_DATE: TDateTimeField;
80	+	DatabaseQueryMONCRYPT_PAGE: TIBLargeIntField;
81	+	DatabaseQueryMONDATABASE_NAME: TIBStringField;
82	+	DatabaseQueryMONFORCED_WRITES: TIBSmallintField;
83	+	DatabaseQueryMONNEXT_TRANSACTION: TIBLargeIntField;
84	+	DatabaseQueryMONODS_MAJOR: TIBSmallintField;
85	+	DatabaseQueryMONODS_MINOR: TIBSmallintField;
86	+	DatabaseQueryMONOLDEST_ACTIVE: TIBLargeIntField;
87	+	DatabaseQueryMONOLDEST_SNAPSHOT: TIBLargeIntField;
88	+	DatabaseQueryMONOLDEST_TRANSACTION: TIBLargeIntField;
89	+	DatabaseQueryMONOWNER: TIBStringField;
90	+	DatabaseQueryMONPAGES: TIBLargeIntField;
91	+	DatabaseQueryMONPAGE_BUFFERS: TIBIntegerField;
92	+	DatabaseQueryMONPAGE_SIZE: TIBSmallintField;
93	+	DatabaseQueryMONREAD_ONLY: TIBSmallintField;
94	+	DatabaseQueryMONRESERVE_SPACE: TIBSmallintField;
95	+	DatabaseQueryMONSEC_DATABASE: TIBStringField;
96	+	DatabaseQueryMONSHUTDOWN_MODE: TIBSmallintField;
97	+	DatabaseQueryMONSQL_DIALECT: TIBSmallintField;
98	+	DatabaseQueryMONSTAT_ID: TIBIntegerField;
99	+	DatabaseQueryMONSWEEP_INTERVAL: TIBIntegerField;
100	+	DatabaseQueryRDBCHARACTER_SET_NAME: TIBStringField;
101	+	DatabaseQueryRDBDESCRIPTION: TIBMemoField;
102	+	DatabaseQueryRDBLINGER: TIBIntegerField;
103	+	DatabaseQueryRDBRELATION_ID: TIBSmallintField;
104	+	DatabaseQueryRDBSECURITY_CLASS: TIBStringField;
105		DBTables: TIBQuery;
106		AuthMappings: TIBQuery;
107		AccessRights: TIBQuery;
#	Line 135 | Line 163 | type
163		procedure AttachmentsAfterDelete(DataSet: TDataSet);
164		procedure AttachmentsAfterOpen(DataSet: TDataSet);
165		procedure AttachmentsBeforeOpen(DataSet: TDataSet);
166	+	procedure ConfigDatasetAfterClose(DataSet: TDataSet);
167		procedure CurrentTransactionAfterTransactionEnd(Sender: TObject);
168		procedure DatabaseQueryAfterOpen(DataSet: TDataSet);
169		procedure DatabaseQueryBeforeClose(DataSet: TDataSet);
170	+	procedure DatabaseQueryMONCREATION_DATEGetText(Sender: TField;
171	+	var aText: string; DisplayText: Boolean);
172		procedure DBCharSetAfterClose(DataSet: TDataSet);
173		procedure DBCharSetBeforeOpen(DataSet: TDataSet);
174		procedure IBDatabase1AfterConnect(Sender: TObject);
#	Line 150 | Line 181 | type
181		Params: ISQLParams);
182		procedure IBValidationService1GetNextLine(Sender: TObject; var Line: string
183		);
184	+	procedure IBXServicesConnection1AfterConnect(Sender: TObject);
185		procedure IBXServicesConnection1Login(Service: TIBXServicesConnection;
186		var aServerName: string; LoginParams: TStrings);
187		procedure LegacyUserListAfterOpen(DataSet: TDataSet);
#	Line 186 | Line 218 | type
218		FPortNo: string;
219		FProtocol: TProtocolAll;
220		FDatabasePathName: string;
221	<	procedure ConnectServicesAPI;
221	>	FHasUserAdminPrivilege: boolean;
222		function GetAuthMethod: string;
223		function GetAutoAdmin: boolean;
224		function GetDatabaseName: string;
#	Line 196 | Line 228 | type
228		function GetDBSQLDialect: integer;
229		function GetDBUserName: string;
230		function GetDescription: string;
199	–	function GetEmbeddedMode: boolean;
231		function GetForcedWrites: boolean;
232		function GetLingerDelay: string;
233		function GetNoReserve: boolean;
#	Line 216 | Line 247 | type
247		procedure SetPageBuffers(AValue: integer);
248		procedure SetSweepInterval(AValue: integer);
249		procedure ReloadData(Data: PtrInt=0);
250	+	protected
251	+	FServiceUserName: string;
252	+	function GetEmbeddedMode: boolean; virtual;
253	+	procedure ConnectServicesAPI; virtual;
254	+	function CallLoginDlg(var aDatabaseName, aUserName, aPassword: string;
255	+	var aCreateIfNotExist: boolean): TModalResult; virtual;
256		public
257		destructor Destroy; override;
258	<	procedure Connect;
259	<	procedure Disconnect;
258	>	function Connect: boolean; virtual;
259	>	procedure Disconnect; virtual;
260		procedure DropDatabase;
261		procedure BackupDatabase;
262		procedure RestoreDatabase;
#	Line 236 | Line 273 | type
273		procedure RemoveShadowSet(ShadowSet: integer);
274		procedure LoadPerformanceStatistics(Lines: TStrings);
275		procedure LoadDatabaseStatistics(OptionID: integer; Lines: TStrings);
276	+	function LoadConfigData(ConfigFileData: TConfigFileData): boolean;
277		procedure LoadServerProperties(Lines: TStrings);
278		procedure LoadServerLog(Lines: TStrings);
279		procedure RevokeAll;
#	Line 258 | Line 296 | type
296		property DBOwner: string read GetDBOwner;
297		property DBSQLDialect: integer read GetDBSQLDialect write SetDBSQLDialect;
298		property ServerName: string read GetServerName;
299	<	property HasUserAdminPrivilege: boolean read GetUserAdminPrivilege;
299	>	property ServiceUserName: string read FServiceUserName;
300	>	property HasUserAdminPrivilege: boolean read FHasUserAdminPrivilege;
301		property AfterDBConnect: TNotifyEvent read FAfterDBConnect write FAfterDBConnect;
302		property AfterDataReload: TNotifyEvent read FAfterDataReload write FAfterDataReload;
303		end;
304
305		var
306	<	DatabaseData: TDatabaseData;
306	>	DBDataModule: TDBDataModule;
307
308		implementation
309
#	Line 283 | Line 322 | const
322		resourcestring
323		sPreserveShadowFiles = 'Preserve Shadow Set Files after drop?';
324
325	<	{ TDatabaseData }
325	>	{ TDBDataModule }
326
327	<	procedure TDatabaseData.UpdateCharSetApplyUpdates(Sender: TObject;
327	>	procedure TDBDataModule.UpdateCharSetApplyUpdates(Sender: TObject;
328		UpdateKind: TUpdateKind; Params: ISQLParams);
329		begin
330		if UpdateKind = ukModify then
#	Line 296 | Line 335 | begin
335		end;
336		end;
337
338	<	procedure TDatabaseData.UpdateUserRolesApplyUpdates(Sender: TObject;
338	>	procedure TDBDataModule.UpdateUserRolesApplyUpdates(Sender: TObject;
339		UpdateKind: TUpdateKind; Params: ISQLParams);
340
341		procedure Grant(Params: ISQLParams);
#	Line 321 | Line 360 | begin
360		end;
361		end;
362
363	<	procedure TDatabaseData.UpdateUsersApplyUpdates(Sender: TObject;
363	>	procedure TDBDataModule.UpdateUsersApplyUpdates(Sender: TObject;
364		UpdateKind: TUpdateKind; Params: ISQLParams);
365
366		var UserName: string;
#	Line 431 | Line 470 | begin
470		end
471		end;
472
473	<	procedure TDatabaseData.UserListAfterInsert(DataSet: TDataSet);
473	>	procedure TDBDataModule.UserListAfterInsert(DataSet: TDataSet);
474		begin
475		DataSet.FieldByName('SEC$ADMIN').AsBoolean := false;
476		DataSet.FieldByName('SEC$ACTIVE').AsBoolean := false;
#	Line 444 | Line 483 | begin
483		UserTags.Active := false; {ditto}
484		end;
485
486	<	procedure TDatabaseData.UserListAfterOpen(DataSet: TDataSet);
486	>	procedure TDBDataModule.UserListAfterOpen(DataSet: TDataSet);
487		begin
488		UserListSource.DataSet := UserList;
489		RoleNameList.Active := true;
490		UserTags.Active := true;
491		end;
492
493	<	procedure TDatabaseData.UserListAfterPost(DataSet: TDataSet);
493	>	procedure TDBDataModule.UserListAfterPost(DataSet: TDataSet);
494		begin
495		CurrentTransaction.Commit;
496		end;
497
498	<	procedure TDatabaseData.UserListAfterScroll(DataSet: TDataSet);
498	>	procedure TDBDataModule.UserListAfterScroll(DataSet: TDataSet);
499		begin
500		UserList.FieldByName('SEC$PLUGIN').ReadOnly := UserList.State <> dsInsert;
501		end;
502
503	<	procedure TDatabaseData.UserListBeforeClose(DataSet: TDataSet);
503	>	procedure TDBDataModule.UserListBeforeClose(DataSet: TDataSet);
504		begin
505		RoleNameList.Active := false;
506		UserTags.Active := false;
507		end;
508
509	<	procedure TDatabaseData.UserTagsAfterInsert(DataSet: TDataSet);
509	>	procedure TDBDataModule.UserTagsAfterInsert(DataSet: TDataSet);
510		begin
511		DataSet.FieldByName('SEC$USER_NAME').AsString := DataSet.DataSource.DataSet.FieldByName('SEC$USER_NAME').AsString;
512		end;
513
514	<	procedure TDatabaseData.ConnectServicesAPI;
514	>	procedure TDBDataModule.ConnectServicesAPI;
515		begin
516		if IBXServicesConnection1.Connected then Exit;
517		try
#	Line 487 | Line 526 | begin
526		end;
527		end;
528
529	<	procedure TDatabaseData.GetDBFlags;
529	>	function TDBDataModule.CallLoginDlg(var aDatabaseName, aUserName,
530	>	aPassword: string; var aCreateIfNotExist: boolean): TModalResult;
531	>	begin
532	>	Result := DBLoginDlg.ShowModal(aDatabaseName, aUserName, aPassword, aCreateIfNotExist);
533	>	end;
534	>
535	>	procedure TDBDataModule.GetDBFlags;
536		var Lines: TStringList;
537		i: integer;
538		line: string;
#	Line 521 | Line 566 | begin
566		end;
567		end;
568
569	<	function TDatabaseData.GetDBOwner: string;
569	>	function TDBDataModule.GetDBOwner: string;
570		var DBOField: TField;
571		begin
572		DBOField := DatabaseQuery.FindField('MON$OWNER');
#	Line 531 | Line 576 | begin
576		Result := 'n/a';
577		end;
578
579	<	function TDatabaseData.GetAutoAdmin: boolean;
579	>	function TDBDataModule.GetAutoAdmin: boolean;
580		begin
581		Result := false;
582		if not CurrentTransaction.Active then Exit;
#	Line 543 | Line 588 | begin
588		end;
589		end;
590
591	<	function TDatabaseData.GetDatabaseName: string;
591	>	function TDBDataModule.GetDatabaseName: string;
592		begin
593		if DatabaseQuery.Active and not DatabaseQuery.FieldByName('MON$DATABASE_NAME').IsNull then
594		Result := DatabaseQuery.FieldByName('MON$DATABASE_NAME').AsString
#	Line 551 | Line 596 | begin
596		Result := FDatabasePathName;
597		end;
598
599	<	function TDatabaseData.GetDBReadOnly: boolean;
599	>	function TDBDataModule.GetDBReadOnly: boolean;
600		begin
601		Result := DatabaseQuery.Active and (DatabaseQuery.FieldByName('MON$READ_ONLY').AsInteger  <> 0);
602		end;
603
604	<	function TDatabaseData.GetDBSQLDialect: integer;
604	>	function TDBDataModule.GetDBSQLDialect: integer;
605		begin
606		Result := IBDatabaseInfo.DBSQLDialect;
607		end;
608
609	<	function TDatabaseData.GetDBUserName: string;
610	<	begin
611	<	Result := Trim(AttmtQuery.FieldByName('MON$USER').AsString);
609	>	function TDBDataModule.GetDBUserName: string;
610	>	var DPB: IDPB;
611	>	info: IDPBItem;
612	>	begin
613	>	Result := '';
614	>	if AttmtQuery.Active then
615	>	Result := Trim(AttmtQuery.FieldByName('MON$USER').AsString)
616	>	else
617	>	if IBDatabase1.Connected then
618	>	begin
619	>	DPB := IBDatabase1.Attachment.getDPB;
620	>	info := DPB.Find(isc_dpb_user_name);
621	>	if info <> nil then
622	>	Result := info.AsString;
623	>	end
624		end;
625
626	<	function TDatabaseData.GetDescription: string;
626	>	function TDBDataModule.GetDescription: string;
627		begin
628	<	Result :=  DatabaseQuery.FieldByName('RDB$DESCRIPTION').AsString;
628	>	if DatabaseQuery.Active then
629	>	Result :=  DatabaseQuery.FieldByName('RDB$DESCRIPTION').AsString
630	>	else
631	>	Result := '';
632		end;
633
634	<	function TDatabaseData.GetEmbeddedMode: boolean;
634	>	function TDBDataModule.GetEmbeddedMode: boolean;
635		begin
636	<	Result := AttmtQuery.FieldByName('MON$REMOTE_PROTOCOL').IsNull;
636	>	Result := AttmtQuery.Active and AttmtQuery.FieldByName('MON$REMOTE_PROTOCOL').IsNull;
637		end;
638
639	<	function TDatabaseData.GetForcedWrites: boolean;
639	>	function TDBDataModule.GetForcedWrites: boolean;
640		begin
641		Result := DatabaseQuery.Active and (DatabaseQuery.FieldByName('MON$FORCED_WRITES').AsInteger  <> 0);
642		end;
643
644	<	procedure TDatabaseData.SetLingerDelay(AValue: string);
644	>	procedure TDBDataModule.SetLingerDelay(AValue: string);
645		begin
646		if (StrToInt(AValue) =  DatabaseQuery.FieldByName('RDB$LINGER').AsInteger) then Exit;
647
#	Line 606 | Line 666 | begin
666		end;
667
668
669	<	function TDatabaseData.GetAuthMethod: string;
669	>	function TDBDataModule.GetAuthMethod: string;
670		var AuthMeth: TField;
671		begin
672		AuthMeth := AttmtQuery.FindField('MON$AUTH_METHOD');
#	Line 616 | Line 676 | begin
676		Result := AuthMeth.AsString;
677		end;
678
679	<	procedure TDatabaseData.SetNoReserve(AValue: boolean);
679	>	procedure TDBDataModule.SetNoReserve(AValue: boolean);
680		begin
681		IBConfigService1.SetReserveSpace(AValue);
682		end;
683
684	<	procedure TDatabaseData.SetPageBuffers(AValue: integer);
684	>	procedure TDBDataModule.SetPageBuffers(AValue: integer);
685		begin
686		IBDatabase1.Connected := false;
687		try
#	Line 631 | Line 691 | begin
691		end;
692		end;
693
694	<	procedure TDatabaseData.SetSweepInterval(AValue: integer);
694	>	procedure TDBDataModule.SetSweepInterval(AValue: integer);
695		begin
696		IBDatabase1.Connected := false;
697		try
#	Line 641 | Line 701 | begin
701		end;
702		end;
703
704	<	procedure TDatabaseData.ReloadData(Data: PtrInt);
704	>	procedure TDBDataModule.ReloadData(Data: PtrInt);
705		begin
706		if csDestroying in ComponentState then Exit;
707		CurrentTransaction.Active := true;
#	Line 653 | Line 713 | begin
713		AfterDataReload(self);
714		end;
715
716	<	destructor TDatabaseData.Destroy;
716	>	destructor TDBDataModule.Destroy;
717		begin
718		Application.RemoveAsyncCalls(self);
719		inherited Destroy;
720		end;
721
722	<	procedure TDatabaseData.Connect;
722	>	function TDBDataModule.Connect: boolean;
723
724		procedure ReportException(E: Exception);
725		begin
#	Line 692 | Line 752 | procedure TDatabaseData.Connect;
752		var KillDone: boolean;
753		begin
754		KillDone := false;
755	+	Result := false;
756		Disconnect;
757		repeat
758		try
#	Line 723 | Line 784 | begin
784
785		if assigned(FAfterDBConnect) then
786		AfterDBConnect(self);
787	+	Result := IBDatabase1.Connected;
788		end;
789
790	<	procedure TDatabaseData.Disconnect;
790	>	procedure TDBDataModule.Disconnect;
791		begin
792		FDBUserName := '';
793		FDBPassword := '';
794	+	FServiceUserName := '';
795		FLocalConnect := false;
796		IBDatabase1.Connected := false;
797		IBXServicesConnection1.Connected := false;
798		FDBHeaderScanned := false;
799		end;
800
801	<	procedure TDatabaseData.DropDatabase;
801	>	procedure TDBDataModule.DropDatabase;
802		begin
803		IBDatabase1.DropDatabase;
804		Disconnect;
805		end;
806
807	<	procedure TDatabaseData.BackupDatabase;
807	>	procedure TDBDataModule.BackupDatabase;
808		begin
809		BackupDlg.ShowModal;
810		end;
811
812	<	procedure TDatabaseData.RestoreDatabase;
812	>	procedure TDBDataModule.RestoreDatabase;
813		var DefaultPageSize: integer;
814		DefaultNumBuffers: integer;
815		begin
#	Line 760 | Line 823 | begin
823		end;
824		end;
825
826	<	procedure TDatabaseData.BringDatabaseOnline;
826	>	procedure TDBDataModule.BringDatabaseOnline;
827		begin
828		if IsDatabaseOnline then
829		MessageDlg('Database is already online!',mtInformation,[mbOK],0)
#	Line 779 | Line 842 | begin
842		end;
843		end;
844
845	<	procedure TDatabaseData.ShutDown(aShutDownmode: TDBShutdownMode; aDelay: integer
845	>	procedure TDBDataModule.ShutDown(aShutDownmode: TDBShutdownMode; aDelay: integer
846		);
847		begin
848		IBDatabase1.Connected := false;
#	Line 790 | Line 853 | begin
853		end;
854		end;
855
856	<	procedure TDatabaseData.DatabaseRepair(Options: TValidateOptions; ReportLines: TStrings);
856	>	procedure TDBDataModule.DatabaseRepair(Options: TValidateOptions; ReportLines: TStrings);
857
858		procedure ReportOptions;
859		var Line: string;
#	Line 821 | Line 884 | begin
884		end;
885		end;
886
887	<	procedure TDatabaseData.OnlineValidation(ReportLines: TStrings;
887	>	procedure TDBDataModule.OnlineValidation(ReportLines: TStrings;
888		SelectedTablesOnly: boolean);
889		var TableNames: string;
890		Separator: string;
#	Line 864 | Line 927 | begin
927		end;
928		end;
929
930	<	procedure TDatabaseData.LimboResolution(ActionID: TTransactionGlobalAction;
930	>	procedure TDBDataModule.LimboResolution(ActionID: TTransactionGlobalAction;
931		Report: TStrings);
932		begin
933		if not InLimboList.Active then
#	Line 879 | Line 942 | begin
942		CurrentTransaction.Commit;
943		end;
944
945	<	function TDatabaseData.GetLingerDelay: string;
945	>	function TDBDataModule.GetLingerDelay: string;
946		var Linger: TField;
947		begin
948		Result := 'n/a';
#	Line 894 | Line 957 | begin
957		end;
958		end;
959
960	<	function TDatabaseData.GetNoReserve: boolean;
960	>	function TDBDataModule.GetNoReserve: boolean;
961		begin
962		Result :=  DatabaseQuery.Active and (DatabaseQuery.FieldByName('MON$RESERVE_SPACE').AsInteger <> 0);
963		end;
964
965	<	function TDatabaseData.GetPageBuffers: integer;
965	>	function TDBDataModule.GetPageBuffers: integer;
966		begin
967		Result := IBDatabaseInfo.NumBuffers;
968		end;
969
970	<	function TDatabaseData.GetRoleName: string;
970	>	function TDBDataModule.GetRoleName: string;
971		begin
972		Result := Trim(AttmtQuery.FieldByName('MON$ROLE').AsString);
973		end;
974
975	<	function TDatabaseData.GetSecurityDatabase: string;
975	>	function TDBDataModule.GetSecurityDatabase: string;
976		var SecPlugin: TField;
977		begin
978		SecPlugin := DatabaseQuery.FindField('MON$SEC_DATABASE');
#	Line 919 | Line 982 | begin
982		Result := Trim(SecPlugin.AsString);
983		end;
984
985	<	function TDatabaseData.GetServerName: string;
985	>	function TDBDataModule.GetServerName: string;
986		begin
987		Result := IBXServicesConnection1.ServerName;
988		end;
989
990	<	function TDatabaseData.GetSweepInterval: integer;
990	>	function TDBDataModule.GetSweepInterval: integer;
991		begin
992		if DatabaseQuery.Active then
993		Result :=  DatabaseQuery.FieldByName('MON$SWEEP_INTERVAL').AsInteger
#	Line 932 | Line 995 | begin
995		Result := 0;
996		end;
997
998	<	function TDatabaseData.GetUserAdminPrivilege: boolean;
998	>	function TDBDataModule.GetUserAdminPrivilege: boolean;
999		begin
1000		Result := false;
1001		{For ODS 12 use SEC$USERS table}
1002	<	if IBDatabaseInfo.ODSMajorVersion >= 12 then
1002	>	if IBDatabase1.Connected and (IBDatabaseInfo.ODSMajorVersion >= 12) then
1003		with AdminUserQuery do
1004		begin
1005		ExecQuery;
#	Line 951 | Line 1014 | begin
1014		begin
1015		with IBSecurityService1 do
1016		begin
1017	<	DisplayUser(DBUserName);
1017	>	DisplayUser(ServiceUserName);
1018		Result := (UserInfoCount > 0) and UserInfo[0].AdminRole;
1019		end;
1020		end;
1021		end;
1022
1023	<	procedure TDatabaseData.SetAutoAdmin(AValue: boolean);
1023	>	procedure TDBDataModule.SetAutoAdmin(AValue: boolean);
1024		begin
1025		IBSecurityService1.SetAutoAdmin(AValue);
1026		CurrentTransaction.Commit;
1027		end;
1028
1029	<	procedure TDatabaseData.SetDBReadOnly(AValue: boolean);
1029	>	procedure TDBDataModule.SetDBReadOnly(AValue: boolean);
1030		begin
1031		IBDatabase1.Connected := false;
1032		try
#	Line 973 | Line 1036 | begin
1036		end;
1037		end;
1038
1039	<	procedure TDatabaseData.SetDBSQLDialect(AValue: integer);
1039	>	procedure TDBDataModule.SetDBSQLDialect(AValue: integer);
1040		begin
1041		IBDatabase1.Connected := false;
1042		try
#	Line 983 | Line 1046 | begin
1046		end;
1047		end;
1048
1049	<	procedure TDatabaseData.SetDescription(AValue: string);
1049	>	procedure TDBDataModule.SetDescription(AValue: string);
1050		begin
1051		with TIBSQL.Create(IBDatabase1) do
1052		try
#	Line 996 | Line 1059 | begin
1059		CurrentTransaction.Commit;
1060		end;
1061
1062	<	procedure TDatabaseData.SetForcedWrites(AValue: boolean);
1062	>	procedure TDBDataModule.SetForcedWrites(AValue: boolean);
1063		begin
1064		IBConfigService1.SetAsyncMode(not AValue);
1065		end;
1066
1067	<	function TDatabaseData.IsDatabaseOnline: boolean;
1067	>	function TDBDataModule.IsDatabaseOnline: boolean;
1068		begin
1069		Result := DatabaseQuery.Active and (DatabaseQuery.FieldByName('MON$SHUTDOWN_MODE').AsInteger = 0);
1070		end;
1071
1072	<	function TDatabaseData.IsShadowDatabase: boolean;
1072	>	function TDBDataModule.IsShadowDatabase: boolean;
1073		begin
1074		GetDBFlags;
1075		Result := FIsShadowDatabase;
1076		end;
1077
1078	<	procedure TDatabaseData.ActivateShadow;
1078	>	procedure TDBDataModule.ActivateShadow;
1079		begin
1080		IBConfigService1.ActivateShadow;
1081		MessageDlg('Shadow Database activated. You should now rename the file or change the database alias name to point to the shadow',
1082		mtInformation,[mbOK],0);
1083		end;
1084
1085	<	procedure TDatabaseData.AddSecondaryFile(aFileName: string; StartAt,
1085	>	procedure TDBDataModule.AddSecondaryFile(aFileName: string; StartAt,
1086		FileLength: integer);
1087		var SQLText: string;
1088		begin
#	Line 1032 | Line 1095 | begin
1095		CurrentTransaction.Commit;
1096		end;
1097
1098	<	procedure TDatabaseData.AddShadowSet;
1098	>	procedure TDBDataModule.AddShadowSet;
1099		var CurrentLocation: TBookmark;
1100		ShadowSet: integer;
1101		begin
#	Line 1055 | Line 1118 | begin
1118		CurrentTransaction.Active := true;
1119		end;
1120
1121	<	procedure TDatabaseData.RemoveShadowSet(ShadowSet: integer);
1121	>	procedure TDBDataModule.RemoveShadowSet(ShadowSet: integer);
1122		begin
1123		if IBDatabaseInfo.ODSMajorVersion < 12 then
1124		begin
#	Line 1075 | Line 1138 | begin
1138		CurrentTransaction.Commit;
1139		end;
1140
1141	<	procedure TDatabaseData.LoadPerformanceStatistics(Lines: TStrings);
1141	>	procedure TDBDataModule.LoadPerformanceStatistics(Lines: TStrings);
1142
1143		procedure AddPerfStats(Heading: string; stats: TStrings);
1144		var i: integer;
#	Line 1114 | Line 1177 | begin
1177		end;
1178		end;
1179
1180	<	procedure TDatabaseData.LoadDatabaseStatistics(OptionID: integer; Lines: TStrings);
1180	>	procedure TDBDataModule.LoadDatabaseStatistics(OptionID: integer; Lines: TStrings);
1181		begin
1182		if OptionID = 1 then
1183		LoadPerformanceStatistics(Lines)
#	Line 1131 | Line 1194 | begin
1194		end;
1195		end;
1196
1197	<	procedure TDatabaseData.LoadServerProperties(Lines: TStrings);
1197	>	function TDBDataModule.LoadConfigData(ConfigFileData: TConfigFileData): boolean;
1198	>	var i: integer;
1199	>	aValue: integer;
1200	>	begin
1201	>	ConfigDataset.Active := true;
1202	>	ConfigDataset.Clear(false);
1203	>	for i := 0 to Length(ConfigFileData.ConfigFileKey) - 1 do
1204	>	begin
1205	>	aValue := ConfigFileData.ConfigFileValue[i] ;
1206	>	with ConfigDataset do
1207	>	case ConfigFileData.ConfigFileKey[i] of
1208	>	ISCCFG_LOCKMEM_KEY:
1209	>	AppendRecord(['Lock mem', aValue]);
1210	>	ISCCFG_LOCKSEM_KEY:
1211	>	AppendRecord(['Lock Semaphores', aValue]);
1212	>	ISCCFG_LOCKSIG_KEY:
1213	>	AppendRecord(['Lock sig', aValue]);
1214	>	ISCCFG_EVNTMEM_KEY:
1215	>	AppendRecord(['Event mem', aValue]);
1216	>	ISCCFG_PRIORITY_KEY:
1217	>	AppendRecord(['Priority', aValue]);
1218	>	ISCCFG_MEMMIN_KEY:
1219	>	AppendRecord(['Min memory', aValue]);
1220	>	ISCCFG_MEMMAX_KEY:
1221	>	AppendRecord(['Max Memory', aValue]);
1222	>	ISCCFG_LOCKORDER_KEY:
1223	>	AppendRecord(['Lock order', aValue]);
1224	>	ISCCFG_ANYLOCKMEM_KEY:
1225	>	AppendRecord(['Any lock mem', aValue]);
1226	>	ISCCFG_ANYLOCKSEM_KEY:
1227	>	AppendRecord(['Any lock semaphore',aValue]);
1228	>	ISCCFG_ANYLOCKSIG_KEY:
1229	>	AppendRecord(['any lock sig', aValue]);
1230	>	ISCCFG_ANYEVNTMEM_KEY:
1231	>	AppendRecord(['any event mem', aValue]);
1232	>	ISCCFG_LOCKHASH_KEY:
1233	>	AppendRecord(['Lock hash', aValue]);
1234	>	ISCCFG_DEADLOCK_KEY:
1235	>	AppendRecord(['Deadlock', aValue]);
1236	>	ISCCFG_LOCKSPIN_KEY:
1237	>	AppendRecord(['Lock spin', aValue]);
1238	>	ISCCFG_CONN_TIMEOUT_KEY:
1239	>	AppendRecord(['Conn timeout', aValue]);
1240	>	ISCCFG_DUMMY_INTRVL_KEY:
1241	>	AppendRecord(['Dummy interval', aValue]);
1242	>	ISCCFG_IPCMAP_KEY:
1243	>	AppendRecord(['Map size', aValue]);
1244	>	ISCCFG_DBCACHE_KEY:
1245	>	AppendRecord(['Cache size', aValue]);
1246	>	end;
1247	>	end;
1248	>	Result := ConfigDataset.Active and (ConfigDataset.RecordCount > 0);
1249	>	end;
1250	>
1251	>	procedure TDBDataModule.LoadServerProperties(Lines: TStrings);
1252		var i: integer;
1253		begin
1254		Lines.Clear;
#	Line 1147 | Line 1264 | begin
1264		ServerVersionNo[4]]));
1265		Lines.Add('No. of attachments = ' + IntToStr(DatabaseInfo.NoOfAttachments));
1266		Lines.Add('No. of databases = ' + IntToStr(DatabaseInfo.NoOfDatabases));
1267	<	for i := 0 to DatabaseInfo.NoOfDatabases - 1 do
1267	>	for i := 0 to length(DatabaseInfo.DbName) - 1 do
1268		Lines.Add(Format('DB Name (%d) = %s',[i+1, DatabaseInfo.DbName[i]]));
1269		Lines.Add('Base Location = ' + ConfigParams.BaseLocation);
1270		Lines.Add('Lock File Location = ' + ConfigParams.LockFileLocation);
#	Line 1156 | Line 1273 | begin
1273		end;
1274		end;
1275
1276	<	procedure TDatabaseData.LoadServerLog(Lines: TStrings);
1276	>	procedure TDBDataModule.LoadServerLog(Lines: TStrings);
1277		begin
1278		Lines.Clear;
1279		if IBLogService1.ServicesConnection.ServiceIntf.getProtocol = Local then
#	Line 1165 | Line 1282 | begin
1282		IBLogService1.Execute(Lines);
1283		end;
1284
1285	<	procedure TDatabaseData.RevokeAll;
1285	>	procedure TDBDataModule.RevokeAll;
1286		begin
1287		with SubjectAccessRights do
1288		if Active then
#	Line 1199 | Line 1316 | begin
1316		end;
1317		end;
1318
1319	<	procedure TDatabaseData.SyncSubjectAccessRights(ID: string);
1319	>	procedure TDBDataModule.SyncSubjectAccessRights(ID: string);
1320		begin
1321		if (FSubjectAccessRightsID = ID) and SubjectAccessRights.Active then Exit;
1322		SubjectAccessRights.Active := false;
#	Line 1207 | Line 1324 | begin
1324		SubjectAccessRights.Active := true;
1325		end;
1326
1327	<	procedure TDatabaseData.IBDatabase1Login(Database: TIBDatabase;
1327	>	procedure TDBDataModule.IBDatabase1Login(Database: TIBDatabase;
1328		LoginParams: TStrings);
1329		var aDatabaseName: string;
1330		aUserName: string;
#	Line 1225 | Line 1342 | begin
1342		aUserName := LoginParams.Values['user_name'];
1343		aPassword := '';
1344		aCreateIfNotExist := false;
1345	<	if DBLoginDlg.ShowModal(aDatabaseName, aUserName, aPassword, aCreateIfNotExist) = mrOK then
1345	>	if CallLoginDlg(aDatabaseName, aUserName, aPassword, aCreateIfNotExist) = mrOK then
1346		begin
1347		FDBPassword := aPassword; {remember for reconnect}
1348		Database.DatabaseName := aDatabaseName;
#	Line 1240 | Line 1357 | begin
1357		IBError(ibxeOperationCancelled, [nil]);
1358		end;
1359
1360	<	procedure TDatabaseData.AttUpdateApplyUpdates(Sender: TObject;
1360	>	procedure TDBDataModule.AttUpdateApplyUpdates(Sender: TObject;
1361		UpdateKind: TUpdateKind; Params: ISQLParams);
1362		begin
1363		if UpdateKind = ukDelete then
#	Line 1251 | Line 1368 | begin
1368		end;
1369		end;
1370
1371	<	procedure TDatabaseData.DBTablesUpdateApplyUpdates(Sender: TObject;
1371	>	procedure TDBDataModule.DBTablesUpdateApplyUpdates(Sender: TObject;
1372		UpdateKind: TUpdateKind; Params: ISQLParams);
1373		begin
1374		// Do nothing
1375		end;
1376
1377	<	procedure TDatabaseData.IBValidationService1GetNextLine(Sender: TObject;
1377	>	procedure TDBDataModule.IBValidationService1GetNextLine(Sender: TObject;
1378		var Line: string);
1379		begin
1380		Application.ProcessMessages;
1381		end;
1382
1383	<	procedure TDatabaseData.IBXServicesConnection1Login(
1383	>	procedure TDBDataModule.IBXServicesConnection1AfterConnect(Sender: TObject);
1384	>	var UN: ISPBItem;
1385	>	begin
1386	>	UN := IBXServicesConnection1.ServiceIntf.getSPB.Find(isc_spb_user_name);
1387	>	if UN <> nil then
1388	>	FServiceUserName := UN.AsString;
1389	>	end;
1390	>
1391	>	procedure TDBDataModule.IBXServicesConnection1Login(
1392		Service: TIBXServicesConnection; var aServerName: string; LoginParams: TStrings);
1393		begin
1394		LoginParams.Values['user_name'] := FDBUserName;
1395		LoginParams.Values['password'] := FDBPassword;
1396		end;
1397
1398	<	procedure TDatabaseData.LegacyUserListAfterOpen(DataSet: TDataSet);
1398	>	procedure TDBDataModule.LegacyUserListAfterOpen(DataSet: TDataSet);
1399		begin
1400		UserListSource.DataSet := LegacyUserList;
1401	<	CurrentTransaction.Active := true;
1402	<	RoleNameList.Active := true;
1401	>	if IBDatabase1.Connected then
1402	>	begin
1403	>	CurrentTransaction.Active := true;
1404	>	RoleNameList.Active := true;
1405	>	end;
1406		end;
1407
1408	<	procedure TDatabaseData.LegacyUserListAfterPost(DataSet: TDataSet);
1408	>	procedure TDBDataModule.LegacyUserListAfterPost(DataSet: TDataSet);
1409		begin
1410	<	RoleNameList.Active := true;
1410	>	if IBDatabase1.Connected then
1411	>	RoleNameList.Active := true;
1412		end;
1413
1414	<	procedure TDatabaseData.LegacyUserListBeforeClose(DataSet: TDataSet);
1414	>	procedure TDBDataModule.LegacyUserListBeforeClose(DataSet: TDataSet);
1415		begin
1416		RoleNameList.Active := false;
1417		end;
1418
1419	<	procedure TDatabaseData.ShadowFilesCalcFields(DataSet: TDataSet);
1419	>	procedure TDBDataModule.ShadowFilesCalcFields(DataSet: TDataSet);
1420		var Flags: integer;
1421		begin
1422		Flags := DataSet.FieldByName('RDB$FILE_FLAGS').AsInteger;
#	Line 1306 | Line 1435 | begin
1435		DataSet.FieldByName('FileMode').AsString := ''
1436		end;
1437
1438	<	procedure TDatabaseData.SubjectAccessRightsBeforeOpen(DataSet: TDataSet);
1438	>	procedure TDBDataModule.SubjectAccessRightsBeforeOpen(DataSet: TDataSet);
1439		begin
1440		SubjectAccessRights.ParamByName('ID').AsString := FSubjectAccessRightsID;
1441		end;
1442
1443	<	procedure TDatabaseData.TagsUpdateApplyUpdates(Sender: TObject;
1443	>	procedure TDBDataModule.TagsUpdateApplyUpdates(Sender: TObject;
1444		UpdateKind: TUpdateKind; Params: ISQLParams);
1445		var sql: string;
1446		begin
#	Line 1336 | Line 1465 | begin
1465		ExecDDL.ExecQuery;
1466		end;
1467
1468	<	procedure TDatabaseData.IBDatabase1AfterConnect(Sender: TObject);
1468	>	procedure TDBDataModule.IBDatabase1AfterConnect(Sender: TObject);
1469		begin
1470		{Virtual tables did not exist prior to Firebird 2.1 - so don't bother with old version}
1471		with IBDatabaseInfo do
#	Line 1372 | Line 1501 | begin
1501
1502		FLocalConnect := FProtocol = Local;
1503		ConnectServicesAPI;
1504	+	CurrentTransaction.Active := true;
1505	+	FHasUserAdminPrivilege := GetUserAdminPrivilege;
1506		ReloadData;
1507		end;
1508
1509	<	procedure TDatabaseData.IBDatabase1AfterDisconnect(Sender: TObject);
1509	>	procedure TDBDataModule.IBDatabase1AfterDisconnect(Sender: TObject);
1510		begin
1511		FDisconnecting := false;
1512		end;
1513
1514	<	procedure TDatabaseData.IBDatabase1BeforeDisconnect(Sender: TObject);
1514	>	procedure TDBDataModule.IBDatabase1BeforeDisconnect(Sender: TObject);
1515		begin
1516		FDisconnecting := true;
1517		end;
1518
1519	<	procedure TDatabaseData.DatabaseQueryAfterOpen(DataSet: TDataSet);
1519	>	procedure TDBDataModule.DatabaseQueryAfterOpen(DataSet: TDataSet);
1520		begin
1521		DBCharSet.Active := true;
1522		end;
1523
1524	<	procedure TDatabaseData.CurrentTransactionAfterTransactionEnd(Sender: TObject);
1524	>	procedure TDBDataModule.CurrentTransactionAfterTransactionEnd(Sender: TObject);
1525		begin
1526		if not Disconnecting and not (csDestroying in ComponentState) then
1527		begin
#	Line 1399 | Line 1530 | begin
1530		end;
1531		end;
1532
1533	<	procedure TDatabaseData.ApplicationProperties1Exception(Sender: TObject;
1533	>	procedure TDBDataModule.ApplicationProperties1Exception(Sender: TObject;
1534		E: Exception);
1535		begin
1536		if E is EIBInterBaseError then
#	Line 1414 | Line 1545 | begin
1545		CurrentTransaction.Rollback;
1546		end;
1547
1548	<	procedure TDatabaseData.AccessRightsCalcFields(DataSet: TDataSet);
1548	>	procedure TDBDataModule.AccessRightsCalcFields(DataSet: TDataSet);
1549		begin
1550		AccessRightsDisplayName.AsString := AccessRightsSUBJECT_NAME.AsString;
1551		if AccessRightsSUBJECT_TYPE.AsInteger = 8 then
#	Line 1432 | Line 1563 | begin
1563		AccessRightsImageIndex.AsInteger := -1;
1564		end;
1565
1566	<	procedure TDatabaseData.AttachmentsAfterDelete(DataSet: TDataSet);
1566	>	procedure TDBDataModule.AttachmentsAfterDelete(DataSet: TDataSet);
1567		begin
1568		CurrentTransaction.Commit;
1569		end;
1570
1571	<	procedure TDatabaseData.AttachmentsAfterOpen(DataSet: TDataSet);
1571	>	procedure TDBDataModule.AttachmentsAfterOpen(DataSet: TDataSet);
1572		begin
1573		Attachments.Locate('MON$ATTACHMENT_ID',AttmtQuery.FieldByName('MON$ATTACHMENT_ID').AsInteger,[]);
1574		end;
1575
1576	<	procedure TDatabaseData.AttachmentsBeforeOpen(DataSet: TDataSet);
1576	>	procedure TDBDataModule.AttachmentsBeforeOpen(DataSet: TDataSet);
1577		begin
1578		if IBDatabaseInfo.ODSMajorVersion >= 12 then
1579		(DataSet as TIBQuery).Parser.Add2WhereClause('r.MON$SYSTEM_FLAG = 0');
1580		end;
1581
1582	<	procedure TDatabaseData.DatabaseQueryBeforeClose(DataSet: TDataSet);
1582	>	procedure TDBDataModule.ConfigDatasetAfterClose(DataSet: TDataSet);
1583	>	begin
1584	>	ConfigDataset.Clear(false);
1585	>	end;
1586	>
1587	>	procedure TDBDataModule.DatabaseQueryBeforeClose(DataSet: TDataSet);
1588		begin
1589		DBCharSet.Active := false;
1590		end;
1591
1592	<	procedure TDatabaseData.DBCharSetAfterClose(DataSet: TDataSet);
1592	>	procedure TDBDataModule.DatabaseQueryMONCREATION_DATEGetText(Sender: TField;
1593	>	var aText: string; DisplayText: Boolean);
1594	>	begin
1595	>	if DisplayText then
1596	>	with DefaultFormatSettings do
1597	>	aText := FormatDateTime(LongDateFormat + ' ' + LongTimeFormat,Sender.AsDateTime)
1598	>	else
1599	>	aText := Sender.AsString;
1600	>	end;
1601	>
1602	>	procedure TDBDataModule.DBCharSetAfterClose(DataSet: TDataSet);
1603		begin
1604		CharSetLookup.Active := false;
1605		end;
1606
1607	<	procedure TDatabaseData.DBCharSetBeforeOpen(DataSet: TDataSet);
1607	>	procedure TDBDataModule.DBCharSetBeforeOpen(DataSet: TDataSet);
1608		begin
1609		CharSetLookup.Active := true;
1610		end;

Diff Legend

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