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 158 by tony, Thu Mar 1 11:23:33 2018 UTC vs.
Revision 210 by tony, Wed Mar 14 15:03:38 2018 UTC

#	Line 23 | Line 23 | interface
23
24		uses
25		Classes, SysUtils, FileUtil, db, memds, IBDatabase, IBSQL, IBQuery,
26	<	IBCustomDataSet, IBUpdate, IBDatabaseInfo, IBServices, IB, Dialogs, Controls,
27	<	Forms;
26	>	IBCustomDataSet, IBUpdate, IBDatabaseInfo, IBXServices, IB,
27	>	Dialogs, Controls, Forms;
28
29		type
30
#	Line 74 | Line 74 | type
74		CurrentTransaction: TIBTransaction;
75		DatabaseQuery: TIBQuery;
76		Attachments: TIBQuery;
77	–	IBOnlineValidationService1: TIBOnlineValidationService;
77		DBTables: TIBQuery;
78		AuthMappings: TIBQuery;
79		AccessRights: TIBQuery;
80	+	IBConfigService1: TIBXConfigService;
81	+	IBServerProperties1: TIBXServerProperties;
82	+	IBLogService1: TIBXLogService;
83	+	IBSecurityService1: TIBXSecurityService;
84	+	IBOnlineValidationService1: TIBXOnlineValidationService;
85	+
86	+	IBLimboTrans: TIBXLimboTransactionResolutionService;
87	+	IBXServicesConnection1: TIBXServicesConnection;
88	+	IBStatisticalService1: TIBXStatisticalService;
89	+	IBValidationService1: TIBXValidationService;
90	+	InLimboList: TIBXServicesLimboTransactionsList;
91	+	LegacyUserList: TIBXServicesUserList;
92		SubjectAccessRights: TIBQuery;
82	–	IBSecurityService1: TIBSecurityService;
93		AttUpdate: TIBUpdate;
94		AdminUserQuery: TIBSQL;
95		DBTablesUpdate: TIBUpdate;
86	–	IBValidationService1: TIBValidationService;
87	–	InLimboList: TMemDataset;
88	–	LegacyUserList: TMemDataset;
96		UserListGROUPID: TLongintField;
97	+	UserListSECPASSWORD: TIBStringField;
98	+	UserListSECUSER_NAME: TIBStringField;
99		UserListSource: TDataSource;
100		DBCharSet: TIBQuery;
101		DBSecFiles: TIBQuery;
102		ExecDDL: TIBSQL;
94	–	IBConfigService1: TIBConfigService;
103		IBDatabase1: TIBDatabase;
104		IBDatabaseInfo: TIBDatabaseInfo;
105		AttmtQuery: TIBQuery;
98	–	IBLogService1: TIBLogService;
99	–	IBServerProperties1: TIBServerProperties;
100	–	IBStatisticalService1: TIBStatisticalService;
106		RoleNameList: TIBQuery;
107		TableNameLookup: TIBQuery;
108		TagsUpdate: TIBUpdate;
#	Line 124 | Line 129 | type
129		UserListSECMIDDLE_NAME: TIBStringField;
130		UserListSECPLUGIN: TIBStringField;
131		UserListUSERID: TLongintField;
127	–	UserListUSERNAME: TIBStringField;
128	–	UserListUSERPASSWORD: TIBStringField;
132		UserTags: TIBQuery;
133		procedure AccessRightsCalcFields(DataSet: TDataSet);
134		procedure ApplicationProperties1Exception(Sender: TObject; E: Exception);
#	Line 145 | Line 148 | type
148		Params: ISQLParams);
149		procedure DBTablesUpdateApplyUpdates(Sender: TObject; UpdateKind: TUpdateKind;
150		Params: ISQLParams);
151	<	procedure InLimboListAfterOpen(DataSet: TDataSet);
152	<	procedure InLimboListBeforeClose(DataSet: TDataSet);
153	<	procedure InLimboListBeforePost(DataSet: TDataSet);
151	>	procedure IBValidationService1GetNextLine(Sender: TObject; var Line: string
152	>	);
153	>	procedure IBXServicesConnection1Login(Service: TIBXServicesConnection;
154	>	var aServerName: string; LoginParams: TStrings);
155		procedure LegacyUserListAfterOpen(DataSet: TDataSet);
156	+	procedure LegacyUserListAfterPost(DataSet: TDataSet);
157		procedure LegacyUserListBeforeClose(DataSet: TDataSet);
153	–	procedure LegacyUserListBeforeDelete(DataSet: TDataSet);
154	–	procedure LegacyUserListBeforePost(DataSet: TDataSet);
158		procedure ShadowFilesCalcFields(DataSet: TDataSet);
159		procedure SubjectAccessRightsBeforeOpen(DataSet: TDataSet);
160		procedure TagsUpdateApplyUpdates(Sender: TObject; UpdateKind: TUpdateKind;
#	Line 177 | Line 180 | type
180		FDBUserName: string;
181		FDBPassword: string;
182		FLocalConnect: boolean;
180	–	FUsersLoading: boolean;
181	–	FLoadingLimboTr: boolean;
183		FSubjectAccessRightsID: string;
184		{Parsed results of connectstring;}
185		FServerName: string;
186		FPortNo: string;
187		FProtocol: TProtocolAll;
188		FDatabasePathName: string;
189	<	procedure ActivateService(aService: TIBCustomService);
189	>	procedure ConnectServicesAPI;
190		function GetAuthMethod: string;
191		function GetAutoAdmin: boolean;
192		function GetDatabaseName: string;
#	Line 220 | Line 221 | type
221		procedure BackupDatabase;
222		procedure RestoreDatabase;
223		procedure BringDatabaseOnline;
224	<	procedure ShutDown(aShutDownmode: TShutdownMode; aDelay: integer);
224	>	procedure ShutDown(aShutDownmode: TDBShutdownMode; aDelay: integer);
225		procedure DatabaseRepair(Options: TValidateOptions; ReportLines: TStrings);
226		procedure OnlineValidation(ReportLines: TStrings; SelectedTablesOnly: boolean);
227		procedure LimboResolution(ActionID: TTransactionGlobalAction; Report: TStrings);
#	Line 295 | Line 296 | procedure TDatabaseData.UpdateUserRolesA
296
297		procedure Grant(Params: ISQLParams);
298		begin
299	<	ExecDDL.SQL.Text := 'Grant ' + trim(Params.ByName('RDB$ROLE_NAME').AsString) + ' to ' + Params.ByName('USERNAME').AsString;
299	>	ExecDDL.SQL.Text := 'Grant ' + trim(Params.ByName('RDB$ROLE_NAME').AsString) + ' to ' + Params.ByName('SEC$USER_NAME').AsString;
300		ExecDDL.ExecQuery;
301		end;
302
303		procedure Revoke(Params: ISQLParams);
304		begin
305	<	ExecDDL.SQL.Text := 'Revoke ' + trim(Params.ByName('RDB$ROLE_NAME').AsString) + ' from ' + Params.ByName('USERNAME').AsString;
305	>	ExecDDL.SQL.Text := 'Revoke ' + trim(Params.ByName('RDB$ROLE_NAME').AsString) + ' from ' + Params.ByName('SEC$USER_NAME').AsString;
306		ExecDDL.ExecQuery;
307		end;
308
#	Line 318 | Line 319 | end;
319		procedure TDatabaseData.UpdateUsersApplyUpdates(Sender: TObject;
320		UpdateKind: TUpdateKind; Params: ISQLParams);
321
322	+	var UserName: string;
323	+
324		function FormatStmtOptions: string;
325		var Param: ISQLParam;
326		begin
327	<	Result := Trim(Params.ByName('UserName').AsString);
328	<	Param := Params.ByName('USERPASSWORD');
327	>	Result := UserName;
328	>	Param := Params.ByName('SEC$PASSWORD');
329		if (Param <> nil) and not Param.IsNull  then
330		Result += ' PASSWORD ''' + SQLSafeString(Param.AsString) + '''';
331		Param := Params.ByName('SEC$FIRST_NAME');
#	Line 351 | Line 354 | procedure TDatabaseData.UpdateUsersApply
354		var Param: ISQLParam;
355		begin
356		Result := '';
357	<	Param := Params.ByName('USERPASSWORD');
357	>	Param := Params.ByName('SEC$PASSWORD');
358		if (UpdateKind = ukModify) and not Param.IsNull then
359		begin
360	<	Result := 'ALTER USER ' + Trim(Params.ByName('UserName').AsString) +
360	>	Result := 'ALTER USER ' + UserName +
361		' PASSWORD ''' + SQLSafeString(Param.AsString) + '''';
362		Param := Params.ByName('SEC$PLUGIN');
363		if Param <> nil then
#	Line 363 | Line 366 | procedure TDatabaseData.UpdateUsersApply
366		end;
367
368		begin
369	<	{non SYSDBA user not an RDB$ADMIN can only change their password}
370	<	if (DBUserName <> 'SYSDBA') and (RoleName <> 'RDB$ADMIN') then
371	<	begin
372	<	ExecDDL.SQL.Text := GetAlterPasswordStmt;
373	<	if ExecDDL.SQL.Text <> '' then
374	<	ExecDDL.ExecQuery;
375	<	Exit;
376	<	end;
369	>	UserName := Trim(Params.ByName('SEC$USER_NAME').AsString);
370	>	{non SYSDBA user not an RDB$ADMIN can only change their password}
371	>	if (DBUserName <> 'SYSDBA') and (RoleName <> 'RDB$ADMIN') then
372	>	begin
373	>	ExecDDL.SQL.Text := GetAlterPasswordStmt;
374	>	if ExecDDL.SQL.Text <> '' then
375	>	ExecDDL.ExecQuery;
376	>	Exit;
377	>	end;
378
379	<	case UpdateKind of
380	<	ukInsert:
381	<	ExecDDL.SQL.Text := 'CREATE USER ' + FormatStmtOptions;
382	<	ukModify:
383	<	ExecDDL.SQL.Text := 'ALTER USER ' + FormatStmtOptions;
384	<	ukDelete:
385	<	ExecDDL.SQL.Text := 'DROP USER ' + Trim(Params.ByName('UserName').AsString);
386	<	end;
387	<	ExecDDL.ExecQuery;
379	>	case UpdateKind of
380	>	ukInsert:
381	>	ExecDDL.SQL.Text := 'CREATE USER ' + FormatStmtOptions;
382	>	ukModify:
383	>	ExecDDL.SQL.Text := 'ALTER USER ' + FormatStmtOptions;
384	>	ukDelete:
385	>	ExecDDL.SQL.Text := 'DROP USER ' + UserName;
386	>	end;
387	>	ExecDDL.ExecQuery;
388
389		if UpdateKind = ukInsert then
390		begin
391		{if new user is also given the admin role then we need to add this}
392		if Params.ByName('SEC$ADMIN').AsBoolean then
393		begin
394	<	ExecDDL.SQL.Text := 'ALTER USER ' + Trim(Params.ByName('UserName').AsString) + ' GRANT ADMIN ROLE';
394	>	ExecDDL.SQL.Text := 'ALTER USER ' + UserName + ' GRANT ADMIN ROLE';
395		ExecDDL.ExecQuery;
396		end;
397		end
#	Line 397 | Line 401 | begin
401		begin
402		if Params.ByName('SEC$ADMIN').AsBoolean and not Params.ByName('OLD_SEC$ADMIN').AsBoolean then
403		begin
404	<	ExecDDL.SQL.Text := 'ALTER USER ' + Trim(Params.ByName('UserName').AsString) + ' GRANT ADMIN ROLE';
404	>	ExecDDL.SQL.Text := 'ALTER USER ' + UserName + ' GRANT ADMIN ROLE';
405		ExecDDL.ExecQuery;
406		end
407		else
408		if not Params.ByName('SEC$ADMIN').AsBoolean and Params.ByName('OLD_SEC$ADMIN').AsBoolean then
409		begin
410	<	ExecDDL.SQL.Text := 'ALTER USER ' + Trim(Params.ByName('UserName').AsString) + ' REVOKE ADMIN ROLE';
410	>	ExecDDL.SQL.Text := 'ALTER USER ' + UserName + ' REVOKE ADMIN ROLE';
411		ExecDDL.ExecQuery;
412		end
413		end;
#	Line 411 | Line 415 | begin
415		{Update DB Creator Role}
416		if Params.ByName('DBCreator').AsBoolean and not Params.ByName('OLD_DBCreator').AsBoolean then
417		begin
418	<	ExecDDL.SQL.Text := 'GRANT CREATE DATABASE TO USER ' + Trim(Params.ByName('UserName').AsString);
418	>	ExecDDL.SQL.Text := 'GRANT CREATE DATABASE TO USER ' + UserName;
419		ExecDDL.ExecQuery;
420		end
421		else
422		if not Params.ByName('DBCreator').AsBoolean and Params.ByName('OLD_DBCreator').AsBoolean then
423		begin
424	<	ExecDDL.SQL.Text := 'REVOKE CREATE DATABASE FROM USER ' + Trim(Params.ByName('UserName').AsString);
424	>	ExecDDL.SQL.Text := 'REVOKE CREATE DATABASE FROM USER ' + UserName;
425		ExecDDL.ExecQuery;
426		end
427		end;
#	Line 430 | Line 434 | begin
434		DataSet.FieldByName('SEC$PLUGIN').AsString := 'Srp';
435		DataSet.FieldByName('UserID').AsInteger := 0;
436		DataSet.FieldByName('GroupID').AsInteger := 0;
437	<	DataSet.FieldByName('UserPassword').Clear;
437	>	DataSet.FieldByName('SEC$PASSWORD').Clear;
438		RoleNameList.Active := false; {Prevent role assignments until saved}
439		UserTags.Active := false; {ditto}
440		end;
#	Line 460 | Line 464 | end;
464
465		procedure TDatabaseData.UserTagsAfterInsert(DataSet: TDataSet);
466		begin
467	<	DataSet.FieldByName('SEC$USER_NAME').AsString := DataSet.DataSource.DataSet.FieldByName('UserName').AsString;
467	>	DataSet.FieldByName('SEC$USER_NAME').AsString := DataSet.DataSource.DataSet.FieldByName('SEC$USER_NAME').AsString;
468	>	end;
469	>
470	>	procedure TDatabaseData.ConnectServicesAPI;
471	>	begin
472	>	if IBXServicesConnection1.Connected then Exit;
473	>	try
474	>	IBXServicesConnection1.ConnectUsing(IBDatabase1);
475	>	except on E: Exception do
476	>	begin
477	>	Application.ShowException(E);
478	>	IBDatabase1.Connected := false;
479	>	FDBPassword := '';
480	>	Exit;
481	>	end;
482	>	end;
483		end;
484
485		procedure TDatabaseData.GetDBFlags;
486	<	var Line: string;
486	>	var Lines: TStringList;
487	>	i: integer;
488	>	line: string;
489		begin
490		if FDBHeaderScanned or not DatabaseQuery.Active or not AttmtQuery.Active then Exit;
491		FIsShadowDatabase := false;
492
493		try
473	–	ActivateService(IBStatisticalService1);
474	–
494		with IBStatisticalService1 do
495		begin
477	–	try
496		Options := [HeaderPages];
497	<	ServiceStart;
498	<	while not Eof do
499	<	begin
500	<	Line := GetNextLine;
501	<	if (Pos('Attributes',Line) <> 0) and (Pos('shadow',Line) <> 0) then
502	<	FIsShadowDatabase := true;
503	<
504	<	end
505	<	finally
506	<	Active := False;
507	<	end
497	>	Lines := TStringList.Create;
498	>	try
499	>	Execute(Lines);
500	>	for i := 0 to Lines.Count - 1 do
501	>	begin
502	>	line := Lines[i];
503	>	if (Pos('Attributes',Line) <> 0) and (Pos('shadow',Line) <> 0) then
504	>	begin
505	>	FIsShadowDatabase := true;
506	>	break;
507	>	end;
508	>	end;
509	>	finally
510	>	Lines.Free;
511	>	end;
512	>	FDBHeaderScanned := true;
513		end;
514		except on E: Exception do
515		MessageDlg('Error getting DB Header Page: ' + E.Message,mtError,[mbOK],0);
#	Line 556 | Line 579 | begin
579		begin
580		if MessageDlg('Turn off Linger Permanently?',mtConfirmation,[mbYes,mbNo],0) = mrNo then
581		begin
559	–	ActivateService(IBConfigService1);
582		IBConfigService1.SetNoLinger;
583		CurrentTransaction.Commit; {Refresh}
584		Exit;
#	Line 573 | Line 595 | begin
595		end;
596		end;
597
576	–	procedure TDatabaseData.ActivateService(aService: TIBCustomService);
577	–
578	–	procedure AssignDatabase(IBService: TIBCustomService; DBName: string);
579	–	begin
580	–	if IBService is TIBValidationService then
581	–	TIBValidationService(IBService).DatabaseName := DBName
582	–	else
583	–	if IBService is TIBOnlineValidationService then
584	–	TIBOnlineValidationService(IBService).DatabaseName := DBName
585	–	else
586	–	if IBService is TIBStatisticalService then
587	–	TIBStatisticalService(IBService).DatabaseName := DBName
588	–	else
589	–	if IBService is TIBConfigService then
590	–	TIBConfigService(IBService).DatabaseName := DBName
591	–	else
592	–	if IBService is TIBBackupService then
593	–	TIBBackupService(IBService).DatabaseName := DBName
594	–	else
595	–	if IBService is TIBRestoreService then
596	–	begin
597	–	TIBRestoreService(IBService).DatabaseName.Clear;
598	–	TIBRestoreService(IBService).DatabaseName.Add(DBName);
599	–	end;
600	–	end;
601	–
602	–	procedure SetupParams(IBService: TIBCustomService; UseDefaultSecDatabase: boolean; DBName: string);
603	–	var index: integer;
604	–	begin
605	–	with IBService do
606	–	begin
607	–	Active := false;
608	–	{Use database login user name and password}
609	–	Params.Values['user_name'] := FDBUserName;
610	–	Params.Values['password'] := FDBPassword;
611	–	Params.Values['sql_role_name'] := 'RDB$ADMIN';
612	–
613	–	if FProtocol <> unknownProtocol then
614	–	Protocol := FProtocol
615	–	else
616	–	Protocol := Local;
617	–	PortNo := FPortNo;
618	–	if Protocol = Local then
619	–	begin
620	–	{If Local we must specify the server as the Localhost}
621	–	ServerName := 'Localhost';
622	–	if AttmtQuery.Active then
623	–	begin
624	–	if not AttmtQuery.FieldByName('MON$REMOTE_PROTOCOL').IsNull then
625	–	Protocol := TCP; {Use loopback if database does not use embedded server}
626	–	end
627	–	else {Special case - database not open}
628	–	if not FileExists(DBName) or FileIsReadOnly(DBName) then
629	–	Protocol := TCP; {Use loopback if database does not use embedded server}
630	–	end
631	–	else
632	–	ServerName := FServername;
633	–	end;
634	–	AssignDatabase(IBService,DBName);
635	–
636	–	{Are we using a different security database?}
637	–
638	–	if not UseDefaultSecDatabase then
639	–	IBService.Params.Values['expected_db'] := DBName
640	–	else
641	–	begin
642	–	index := IBService.Params.IndexOfName('expected_db');
643	–	if index <> -1 then IBService.Params.Delete(index);
644	–	end;
645	–	end;
646	–
647	–	var SecPlugin: TField;
648	–	UsingDefaultSecDatabase: boolean;
649	–	begin
650	–	{Are we using a different security database?}
651	–
652	–	SecPlugin := DatabaseQuery.FindField('MON$SEC_DATABASE');
653	–	UsingDefaultSecDatabase := (SecPlugin = nil) or (Trim(SecPlugin.AsString) = 'Default');
654	–
655	–	{The server properties service is the base service holding the service interface}
656	–	if not IBServerProperties1.Active then
657	–	begin
658	–	SetupParams(IBServerProperties1,UsingDefaultSecDatabase,
659	–	{note that on a local server, the following always gives us the actual path}
660	–	GetDatabaseName);
661	–	with IBServerProperties1 do
662	–	begin
663	–	LoginPrompt := (Protocol <> Local) and (FDBPassword = '');  {Does this ever occur?}
664	–	repeat
665	–	try
666	–	Active := true;
667	–	LoginPrompt := false;
668	–	except
669	–	on E:EIBClientError do {Typically Login cancelled}
670	–	begin
671	–	MessageDlg(E.Message,mtError,[mbOK],0);
672	–	Exit;
673	–	end;
674	–	on E:Exception do
675	–	begin
676	–	MessageDlg(E.Message,mtError,[mbOK],0);
677	–	LoginPrompt := true;
678	–	end;
679	–	end;
680	–	until Active;
681	–	end;
682	–	end;
683	–
684	–	if aService = IBServerProperties1 then
685	–	Exit;
686	–
687	–	aService.Assign(IBServerProperties1);
688	–	AssignDatabase(aService,FDatabasePathName);
689	–	end;
598
599		function TDatabaseData.GetAuthMethod: string;
600		var AuthMeth: TField;
#	Line 700 | Line 608 | end;
608
609		procedure TDatabaseData.SetNoReserve(AValue: boolean);
610		begin
703	–	ActivateService(IBConfigService1);
611		IBConfigService1.SetReserveSpace(AValue);
705	–	while IBConfigService1.IsServiceRunning do;
612		end;
613
614		procedure TDatabaseData.SetPageBuffers(AValue: integer);
615		begin
710	–	ActivateService(IBConfigService1);
616		IBDatabase1.Connected := false;
617		try
618		IBConfigService1.SetPageBuffers(AValue);
714	–	while IBConfigService1.IsServiceRunning do;
619		finally
620		IBDatabase1.Connected := true;
621		end;
#	Line 719 | Line 623 | end;
623
624		procedure TDatabaseData.SetSweepInterval(AValue: integer);
625		begin
722	–	ActivateService(IBConfigService1);
626		IBDatabase1.Connected := false;
627		try
628		IBConfigService1.SetSweepInterval(AValue);
726	–	while IBConfigService1.IsServiceRunning do;
629		finally
630		IBDatabase1.Connected := true;
631		end;
#	Line 735 | Line 637 | begin
637		CurrentTransaction.Active := true;
638		DataBaseQuery.Active := true;
639		AttmtQuery.Active := true;
738	–	if assigned(FAfterDataReload) then
739	–	AfterDataReload(self);
640		if LegacyUserList.Active then
641		RoleNameList.Active := true;
642	+	if assigned(FAfterDataReload) then
643	+	AfterDataReload(self);
644		end;
645
646		destructor TDatabaseData.Destroy;
#	Line 757 | Line 659 | procedure TDatabaseData.Connect;
659
660		procedure KillShadows;
661		begin
760	–	ActivateService(IBValidationService1);
662		with IBValidationService1 do
663		begin
664	<	Options := [IBServices.KillShadows];
665	<	try
765	<	try
766	<	ServiceStart;
767	<	except  end;
768	<	While not Eof do
769	<	GetNextLine;
770	<	finally
771	<	while IsServiceRunning do;
772	<	end;
664	>	Options := [IBXServices.KillShadows];
665	>	Execute(nil);
666		MessageDlg('All Unavailable Shadows killed',mtInformation,[mbOK],0);
667		end;
668		end;
#	Line 814 | Line 707 | begin
707		FDBPassword := '';
708		FLocalConnect := false;
709		IBDatabase1.Connected := false;
710	<	IBConfigService1.Active := false;
711	<	IBStatisticalService1.Active := false;
819	<	IBServerProperties1.Active := false;
820	<	IBValidationService1.Active := false;
821	<	IBLogService1.Active := false;
822	<	IBSecurityService1.Active := false;
710	>	IBXServicesConnection1.Connected := false;
711	>	FDBHeaderScanned := false;
712		end;
713
714		procedure TDatabaseData.DropDatabase;
#	Line 830 | Line 719 | end;
719
720		procedure TDatabaseData.BackupDatabase;
721		begin
722	<	with BackupDlg do
834	<	begin
835	<	ActivateService(IBBackupService1);
836	<	ShowModal;
837	<	end;
722	>	BackupDlg.ShowModal;
723		end;
724
725		procedure TDatabaseData.RestoreDatabase;
#	Line 843 | Line 728 | var DefaultPageSize: integer;
728		begin
729		DefaultPageSize := DatabaseQuery.FieldByName('MON$PAGE_SIZE').AsInteger;
730		DefaultNumBuffers := DatabaseQuery.FieldByName('MON$PAGE_BUFFERS').AsInteger;
846	–	ActivateService(RestoreDlg.IBRestoreService1);
731		IBDatabase1.Connected := false;
732		try
733		RestoreDlg.ShowModal(DefaultPageSize,DefaultNumBuffers);
#	Line 858 | Line 742 | begin
742		MessageDlg('Database is already online!',mtInformation,[mbOK],0)
743		else
744		begin
861	–	ActivateService(IBConfigService1);
745		IBDatabase1.Connected := false;
746		try
747		IBConfigService1.BringDatabaseOnline;
865	–	while IBConfigService1.IsServiceRunning do;
748		finally
749		IBDatabase1.Connected := true;
750		end;
#	Line 873 | Line 755 | begin
755		end;
756		end;
757
758	<	procedure TDatabaseData.ShutDown(aShutDownmode: TShutdownMode; aDelay: integer);
758	>	procedure TDatabaseData.ShutDown(aShutDownmode: TDBShutdownMode; aDelay: integer
759	>	);
760		begin
878	–	ActivateService(IBConfigService1);
761		IBDatabase1.Connected := false;
762		try
763	<	ShutdownDatabaseDlg.Shutdown(IBConfigService1, aShutDownmode, aDelay);
763	>	ShutdownDatabaseDlg.Shutdown(DatabaseName, aShutDownmode, aDelay);
764		finally
765		IBDatabase1.Connected := true;
766		end;
#	Line 902 | Line 784 | procedure TDatabaseData.DatabaseRepair(O
784		end;
785
786		begin
905	–	ActivateService(IBValidationService1);
787		ReportLines.Add(Format('Validation of %s started',[IBValidationService1.DatabaseName]));
788		ReportOptions;
789		IBDatabase1.Connected := false;
790		with IBValidationService1 do
791		try
792	<	try
912	<	ServiceStart;
913	<	while not Eof do
914	<	begin
915	<	Application.ProcessMessages;
916	<	ReportLines.Add(GetNextLine);
917	<	end;
918	<	finally
919	<	while IsServiceRunning do;
920	<	end;
792	>	Execute(ReportLines);
793		ReportLines.Add('Operation Completed');
794		MessageDlg('Operation Completed',mtInformation,[mbOK],0);
795		finally
#	Line 932 | Line 804 | var TableNames: string;
804		begin
805		if IBDatabaseInfo.ODSMajorVersion < 12 then
806		raise Exception.Create('Online Validation is not supported');
935	–	ActivateService(IBOnlineValidationService1);
807		with IBOnlineValidationService1 do
808		begin
809		if SelectedTablesOnly then
#	Line 963 | Line 834 | begin
834		else
835		IncludeTables := '';
836		ReportLines.Add(Format('Online Validation of %s started',[IBOnlineValidationService1.DatabaseName]));
837	<	try
967	<	ServiceStart;
968	<	while not Eof do
969	<	begin
970	<	Application.ProcessMessages;
971	<	ReportLines.Add(GetNextLine);
972	<	end;
973	<	finally
974	<	while IsServiceRunning do;
975	<	end;
837	>	Execute(ReportLines);
838		ReportLines.Add('Online Validation Completed');
839		MessageDlg('Online Validation Completed',mtInformation,[mbOK],0);
840		end;
#	Line 987 | Line 849 | begin
849		with InLimboList do
850		if State = dsEdit then Post;
851		Report.Clear;
852	<	ActivateService(IBValidationService1);
853	<	with IBValidationService1 do
854	<	begin
855	<	GlobalAction := ActionID;
994	<	Report.Add('Starting Limbo transaction resolution');
995	<	FixLimboTransactionErrors;
996	<	while not Eof do
997	<	begin
998	<	Application.ProcessMessages;
999	<	Report.Add(GetNextLine);
1000	<	end;
1001	<	Report.Add('Limbo Transaction resolution complete');
1002	<	CurrentTransaction.Commit;
1003	<	InLimboList.Active := false;
1004	<	InLimboList.Active := true;
1005	<	end;
852	>	Report.Add('Starting Limbo transaction resolution');
853	>	InLimboList.FixErrors(ActionID,Report);
854	>	Report.Add('Limbo Transaction resolution complete');
855	>	CurrentTransaction.Commit;
856		end;
857
858		function TDatabaseData.GetLingerDelay: string;
#	Line 1070 | Line 920 | begin
920		{if need to know for ODS 11.2 then will have to use Service API}
921		else
922		begin
1073	–	ActivateService(IBSecurityService1);
923		with IBSecurityService1 do
924		begin
925		DisplayUser(DBUserName);
#	Line 1081 | Line 930 | end;
930
931		procedure TDatabaseData.SetAutoAdmin(AValue: boolean);
932		begin
933	<	ActivateService(IBConfigService1);
1085	<	IBConfigService1.SetAutoAdmin(AValue);
1086	<	while IBConfigService1.IsServiceRunning do;
933	>	IBSecurityService1.SetAutoAdmin(AValue);
934		CurrentTransaction.Commit;
935		end;
936
937		procedure TDatabaseData.SetDBReadOnly(AValue: boolean);
938		begin
1092	–	ActivateService(IBConfigService1);
939		IBDatabase1.Connected := false;
940		try
941		IBConfigService1.SetReadOnly(AValue);
1096	–	while IBConfigService1.IsServiceRunning do;
942		finally
943		IBDatabase1.Connected := true;
944		end;
#	Line 1101 | Line 946 | end;
946
947		procedure TDatabaseData.SetDBSQLDialect(AValue: integer);
948		begin
1104	–	ActivateService(IBConfigService1);
949		IBDatabase1.Connected := false;
950		try
951		IBConfigService1.SetDBSqlDialect(AValue);
1108	–	while IBConfigService1.IsServiceRunning do;
952		finally
953		IBDatabase1.Connected := true;
954		end;
#	Line 1113 | Line 956 | end;
956
957		procedure TDatabaseData.SetForcedWrites(AValue: boolean);
958		begin
1116	–	ActivateService(IBConfigService1);
959		IBConfigService1.SetAsyncMode(not AValue);
1118	–	while IBConfigService1.IsServiceRunning do;
960		end;
961
962		function TDatabaseData.IsDatabaseOnline: boolean;
#	Line 1131 | Line 972 | end;
972
973		procedure TDatabaseData.ActivateShadow;
974		begin
1134	–	ActivateService(IBConfigService1);
975		IBConfigService1.ActivateShadow;
1136	–	while IBConfigService1.IsServiceRunning do;
976		MessageDlg('Shadow Database activated. You should now rename the file or change the database alias name to point to the shadow',
977		mtInformation,[mbOK],0);
978		end;
#	Line 1235 | Line 1074 | end;
1074
1075		procedure TDatabaseData.LoadDatabaseStatistics(OptionID: integer; Lines: TStrings);
1076		begin
1238	–	ActivateService(IBStatisticalService1);
1077		if OptionID = 1 then
1078		LoadPerformanceStatistics(Lines)
1079		else
#	Line 1247 | Line 1085 | begin
1085		3: Options := [IndexPages];
1086		4: Options := [SystemRelations]
1087		end;
1088	<	Active := true;
1251	<	ServiceStart;
1252	<	while not Eof do
1253	<	Lines.Add(GetNextLine);
1088	>	Execute(Lines);
1089		end;
1090		end;
1091
#	Line 1258 | Line 1093 | procedure TDatabaseData.LoadServerProper
1093		var i: integer;
1094		begin
1095		Lines.Clear;
1261	–	ActivateService(IBServerProperties1);
1096		with IBServerProperties1 do
1097		begin
1264	–	FetchVersionInfo;
1098		Lines.Add('Server Version = ' + VersionInfo.ServerVersion);
1099		Lines.Add('Server Implementation = ' + VersionInfo.ServerImplementation);
1100		Lines.Add('Service Version = ' + IntToStr(VersionInfo.ServiceVersion));
1101	+	with ServicesConnection do
1102		Lines.Add(Format('Firebird Release = %d.%d.%d (Build no. %d)',[ServerVersionNo[1],
1103		ServerVersionNo[2],
1104		ServerVersionNo[3],
1105		ServerVersionNo[4]]));
1272	–	FetchDatabaseInfo;
1106		Lines.Add('No. of attachments = ' + IntToStr(DatabaseInfo.NoOfAttachments));
1107		Lines.Add('No. of databases = ' + IntToStr(DatabaseInfo.NoOfDatabases));
1108		for i := 0 to DatabaseInfo.NoOfDatabases - 1 do
1109		Lines.Add(Format('DB Name (%d) = %s',[i+1, DatabaseInfo.DbName[i]]));
1277	–	FetchConfigParams;
1110		Lines.Add('Base Location = ' + ConfigParams.BaseLocation);
1111		Lines.Add('Lock File Location = ' + ConfigParams.LockFileLocation);
1112		Lines.Add('Security Database Location = ' + ConfigParams.SecurityDatabaseLocation);
#	Line 1285 | Line 1117 | end;
1117		procedure TDatabaseData.LoadServerLog(Lines: TStrings);
1118		begin
1119		Lines.Clear;
1120	<	ActivateService(IBLogService1);
1289	<	if IBLogService1.Protocol = Local then
1120	>	if IBLogService1.ServicesConnection.ServiceIntf.getProtocol = Local then
1121		Lines.Add('Server Log not available with embedded server')
1122		else
1123	<	with IBLogService1 do
1293	<	begin
1294	<	ServiceStart;
1295	<	while not Eof do
1296	<	Lines.Add(GetNextLine);
1297	<	end;
1123	>	IBLogService1.Execute(Lines);
1124		end;
1125
1126		procedure TDatabaseData.RevokeAll;
#	Line 1389 | Line 1215 | begin
1215		// Do nothing
1216		end;
1217
1218	<	procedure TDatabaseData.InLimboListAfterOpen(DataSet: TDataSet);
1219	<
1394	<	function TypeToStr(MultiDatabase: boolean): string;
1395	<	begin
1396	<	if MultiDatabase then
1397	<	Result := 'Multi DB'
1398	<	else
1399	<	Result := 'Single DB';
1400	<	end;
1401	<
1402	<	function StateToStr(State: TTransactionState): string;
1403	<	begin
1404	<	case State of
1405	<	LimboState:
1406	<	Result := 'Limbo';
1407	<	CommitState:
1408	<	Result := 'Commit';
1409	<	RollbackState:
1410	<	Result := 'Rollback';
1411	<	else
1412	<	Result := 'Unknown';
1413	<	end;
1414	<	end;
1415	<
1416	<	function AdviseToStr(Advise: TTransactionAdvise): string;
1417	<	begin
1418	<	case Advise of
1419	<	CommitAdvise:
1420	<	Result := 'Commit';
1421	<	RollbackAdvise:
1422	<	Result := 'Rollback';
1423	<	else
1424	<	Result := 'Unknown';
1425	<	end;
1426	<	end;
1427	<
1428	<	function ActionToStr(anAction: IBServices.TTransactionAction): string;
1429	<	begin
1430	<	case anAction of
1431	<	CommitAction:
1432	<	Result := 'Commit';
1433	<	RollbackAction:
1434	<	Result := 'Rollback';
1435	<	end;
1436	<	end;
1437	<
1438	<	var i: integer;
1218	>	procedure TDatabaseData.IBValidationService1GetNextLine(Sender: TObject;
1219	>	var Line: string);
1220		begin
1221	<	if FLoadingLimboTr then Exit;
1441	<	FLoadingLimboTr := true;
1442	<	with IBValidationService1 do
1443	<	try
1444	<	ActivateService(IBValidationService1);
1445	<	Options := [LimboTransactions];
1446	<	ServiceStart;
1447	<	FetchLimboTransactionInfo;
1448	<	for i := 0 to LimboTransactionInfoCount - 1 do
1449	<	with LimboTransactionInfo[i] do
1450	<	begin
1451	<	InLimboList.Append;
1452	<	InLimboList.FieldByName('TransactionID').AsInteger := ID;
1453	<	InLimboList.FieldByName('TransactionType').AsString := TypeToStr(MultiDatabase);
1454	<	InLimboList.FieldByName('HostSite').AsString := HostSite;
1455	<	InLimboList.FieldByName('RemoteSite').AsString := RemoteSite;
1456	<	InLimboList.FieldByName('DatabasePath').AsString := RemoteDatabasePath;
1457	<	InLimboList.FieldByName('State').AsString := StateToStr(State);
1458	<	InLimboList.FieldByName('RecommendedAction').AsString := AdviseToStr(Advise);
1459	<	InLimboList.FieldByName('RequestedAction').AsString := ActionToStr(Action);
1460	<	InLimboList.Post;
1461	<	end;
1462	<	finally
1463	<	FLoadingLimboTr := false;
1464	<	end;
1465	<	end;
1466	<
1467	<	procedure TDatabaseData.InLimboListBeforeClose(DataSet: TDataSet);
1468	<	begin
1469	<	InLimboList.Clear(false);
1221	>	Application.ProcessMessages;
1222		end;
1223
1224	<	procedure TDatabaseData.InLimboListBeforePost(DataSet: TDataSet);
1225	<	var i: integer;
1224	>	procedure TDatabaseData.IBXServicesConnection1Login(
1225	>	Service: TIBXServicesConnection; var aServerName: string; LoginParams: TStrings);
1226		begin
1227	<	if FLoadingLimboTr then Exit;
1228	<	with IBValidationService1 do
1477	<	for i := 0 to LimboTransactionInfoCount - 1 do
1478	<	with LimboTransactionInfo[i] do
1479	<	begin
1480	<	if ID = InLimboList.FieldByName('TransactionID').AsInteger then
1481	<	begin
1482	<	if InLimboList.FieldByName('RequestedAction').AsString = 'Commit' then
1483	<	Action := CommitAction
1484	<	else
1485	<	if InLimboList.FieldByName('RequestedAction').AsString = 'Rollback' then
1486	<	Action := RollbackAction;
1487	<	break;
1488	<	end;
1489	<	end;
1227	>	LoginParams.Values['user_name'] := FDBUserName;
1228	>	LoginParams.Values['password'] := FDBPassword;
1229		end;
1230
1231		procedure TDatabaseData.LegacyUserListAfterOpen(DataSet: TDataSet);
1493	–	var i: integer;
1232		begin
1495	–	ActivateService(IBSecurityService1);
1496	–	with IBSecurityService1 do
1497	–	begin
1498	–	DisplayUsers;
1499	–	FUsersLoading := true;
1500	–	try
1501	–	for i := 0 to UserInfoCount - 1 do
1502	–	with UserInfo[i],LegacyUserList do
1503	–	begin
1504	–	Append;
1505	–	FieldByName('UserID').AsInteger := UserID;
1506	–	FieldByName('GroupID').AsInteger := GroupID;
1507	–	FieldByName('UserName').AsString := Trim(UserName);
1508	–	FieldByName('SEC$FIRST_NAME').AsString := FirstName;
1509	–	FieldByName('SEC$MIDDLE_NAME').AsString := MiddleName;
1510	–	FieldByName('SEC$LAST_NAME').AsString := LastName;
1511	–	FieldByName('UserPassword').Clear;
1512	–	FieldByName('SEC$ADMIN').AsBoolean := AdminRole;
1513	–	Post;
1514	–	end;
1515	–	finally
1516	–	FUsersLoading := false;
1517	–	end;
1518	–	end;
1233		UserListSource.DataSet := LegacyUserList;
1234		CurrentTransaction.Active := true;
1235		RoleNameList.Active := true;
1236		end;
1237
1238	<	procedure TDatabaseData.LegacyUserListBeforeClose(DataSet: TDataSet);
1238	>	procedure TDatabaseData.LegacyUserListAfterPost(DataSet: TDataSet);
1239		begin
1240	<	RoleNameList.Active := false;
1527	<	with LegacyUserList do
1528	<	begin
1529	<	if State in [dsEdit,dsInsert] then Post;
1530	<	Clear(false);
1531	<	end;
1240	>	RoleNameList.Active := true;
1241		end;
1242
1243	<	procedure TDatabaseData.LegacyUserListBeforeDelete(DataSet: TDataSet);
1243	>	procedure TDatabaseData.LegacyUserListBeforeClose(DataSet: TDataSet);
1244		begin
1245	<	ActivateService(IBSecurityService1);
1537	<	with IBSecurityService1 do
1538	<	begin
1539	<	UserName := DataSet.FieldByName('UserName').AsString;
1540	<	DeleteUser;
1541	<	while IsServiceRunning do;
1542	<	end;
1543	<	end;
1544	<
1545	<	procedure TDatabaseData.LegacyUserListBeforePost(DataSet: TDataSet);
1546	<
1547	<	procedure SetParams;
1548	<	begin
1549	<	with LegacyUserList, IBSecurityService1 do
1550	<	begin
1551	<	UserID := FieldByName('UserID').AsInteger;
1552	<	GroupID := FieldByName('GroupID').AsInteger;
1553	<	UserName := FieldByName('UserName').AsString;
1554	<	FirstName := FieldByName('SEC$FIRST_NAME').AsString;
1555	<	MiddleName := FieldByName('SEC$MIDDLE_NAME').AsString;
1556	<	LastName := FieldByName('SEC$LAST_NAME').AsString;
1557	<	if not FieldByName('UserPassword').IsNull then
1558	<	Password := FieldByName('UserPassword').AsString;
1559	<	AdminRole := FieldByName('SEC$ADMIN').AsBoolean;
1560	<	end;
1561	<	end;
1562	<
1563	<	begin
1564	<	if FUsersLoading then Exit;
1565	<	ActivateService(IBSecurityService1);
1566	<	case LegacyUserList.State of
1567	<	dsEdit:
1568	<	begin
1569	<	SetParams;
1570	<	IBSecurityService1.ModifyUser;
1571	<	end;
1572	<	dsInsert:
1573	<	begin
1574	<	SetParams;
1575	<	IBSecurityService1.AddUser;
1576	<	end;
1577	<	end;
1578	<	while IBSecurityService1.IsServiceRunning do;
1245	>	RoleNameList.Active := false;
1246		end;
1247
1248		procedure TDatabaseData.ShadowFilesCalcFields(DataSet: TDataSet);
#	Line 1662 | Line 1329 | begin
1329		end;
1330
1331		FLocalConnect := FProtocol = Local;
1332	+	ConnectServicesAPI;
1333		ReloadData;
1334		end;
1335
#	Line 1707 | Line 1375 | begin
1375		if AccessRightsSUBJECT_TYPE.AsInteger = 8 then
1376		begin
1377		if  (AccessRightsSUBJECT_NAME.AsString <> 'PUBLIC') and UserListSource.DataSet.Active and
1378	<	not UserListSource.DataSet.Locate('USERNAME',AccessRightsSUBJECT_NAME.AsString,[]) then
1378	>	not UserListSource.DataSet.Locate('SEC$USER_NAME',AccessRightsSUBJECT_NAME.AsString,[]) then
1379		begin
1380		AccessRightsImageIndex.AsInteger := 4;
1381		AccessRightsDisplayName.AsString := AccessRightsSUBJECT_NAME.AsString + ' (stale)';

Diff Legend

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