ViewVC Help

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

root/public/ibx/trunk/runtime/IBServices.pas

Comparing ibx/trunk/runtime/IBServices.pas (file contents):
Revision 80 by tony, Mon Jan 1 11:31:07 2018 UTC vs.
Revision 143 by tony, Fri Feb 23 12:11:21 2018 UTC

#	Line 27 | Line 27
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                                                 }
30	>	{    Associates Ltd 2011 - 2018                                                 }
31		{                                                                        }
32		{************************************************************************}
33
#	Line 52 | Line 52 | uses
52		{$ELSE}
53		unix,
54		{$ENDIF}
55	<	SysUtils, Classes, IBHeader, IB, IBExternals, CustApp, IBTypes, IBSQL;
55	>	SysUtils, Classes, IB, IBExternals, CustApp, IBTypes;
56
57		const
58		DefaultBufferSize = 32000;
59
60		SPBPrefix = 'isc_spb_';
61	<	isc_spb_last_spb_constant = 12;
61	>	isc_spb_last_spb_constant = 13;
62		SPBConstantNames: array[1..isc_spb_last_spb_constant] of String = (
63		'user_name',
64		'sys_user_name',
#	Line 71 | Line 71 | const
71		'options',
72		'connect_timeout',
73		'dummy_packet_interval',
74	<	'sql_role_name'
74	>	'sql_role_name',
75	>	'expected_db'
76		);
77
78		SPBConstantValues: array[1..isc_spb_last_spb_constant] of Integer = (
#	Line 86 | Line 87 | const
87		isc_spb_options,
88		isc_spb_connect_timeout,
89		isc_spb_dummy_packet_interval,
90	<	isc_spb_sql_role_name
90	>	isc_spb_sql_role_name,
91	>	isc_spb_expected_db
92		);
93
94		type
#	Line 94 | Line 96 | type
96
97		TIBCustomService = class;
98
99	<	TLoginEvent = procedure(Database: TIBCustomService;
99	>	TLoginEvent = procedure(Service: TIBCustomService;
100		LoginParams: TStrings) of object;
101
102		{ TIBCustomService }
#	Line 102 | Line 104 | type
104		TIBCustomService = class(TComponent)
105		private
106		FParamsChanged : Boolean;
107	<	FSPB : ISPB;
107	>	FPortNo: string;
108		FSRB: ISRB;
109		FSQPB: ISQPB;
110		FTraceFlags: TTraceFlags;
#	Line 114 | Line 116 | type
116		FOnAttach: TNotifyEvent;
117		FProtocol: TProtocol;
118		FParams: TStrings;
119	+	FServerVersionNo: array [1..4] of integer;
120		FServiceQueryResults: IServiceQueryResults;
121		function GetActive: Boolean;
122		function GetServiceParamBySPB(const Idx: Integer): String;
123		function GetSQPB: ISQPB;
124		function GetSRB: ISRB;
125	+	function GetServerVersionNo(index: integer): integer;
126		procedure SetActive(const Value: Boolean);
127		procedure SetParams(const Value: TStrings);
128		procedure SetServerName(const Value: string);
#	Line 126 | Line 130 | type
130		procedure SetService(AValue: IServiceManager);
131		procedure SetServiceParamBySPB(const Idx: Integer;
132		const Value: String);
133	<	function IndexOfSPBConst(action: byte): Integer;
133	>	function IndexOfSPBConst(action: byte; List: TStrings): Integer;
134		function GetSPBConstName(action: byte): string;
135		procedure ParamsChange(Sender: TObject);
136		procedure ParamsChanging(Sender: TObject);
#	Line 135 | Line 139 | type
139
140		protected
141		procedure Loaded; override;
142	<	function Login(var aServerName: string): Boolean;
142	>	function Login(var aServerName: string; LOginParams: TStrings): Boolean;
143		procedure CheckActive;
144		procedure CheckInactive;
145		procedure HandleException(Sender: TObject);
#	Line 149 | Line 153 | type
153		destructor Destroy; override;
154		procedure Attach;
155		procedure Detach;
156	+	procedure Assign(Source: TPersistent); override;
157
158		{Copies database parameters as give in the DBParams to the Service
159		omitting any parameters not appropriate for TIBService. Typically, the
#	Line 158 | Line 163 | type
163		property ServiceIntf: IServiceManager read FService write SetService;
164		property ServiceParamBySPB[const Idx: Integer]: String read GetServiceParamBySPB
165		write SetServiceParamBySPB;
166	+	property ServerVersionNo[index: integer]: integer read GetServerVersionNo;
167		published
168		property Active: Boolean read GetActive write SetActive default False;
169		property ServerName: string read FServerName write SetServerName;
170		property Protocol: TProtocol read FProtocol write SetProtocol default Local;
171	+	property PortNo: string read FPortNo write FPortNo;
172		property Params: TStrings read FParams write SetParams;
173		property LoginPrompt: Boolean read FLoginPrompt write FLoginPrompt default True;
174		property TraceFlags: TTraceFlags read FTraceFlags write FTraceFlags;
#	Line 278 | Line 285 | type
285		constructor create (AOwner: TComponent); override;
286		function GetNextLine : String;
287		function GetNextChunk : String;
288	+	procedure ServiceStart; override;
289		function WriteNextChunk(stream: TStream): integer;
290		property Eof: boolean read FEof;
291		end;
292
293		TShutdownMode = (Forced, DenyTransaction, DenyAttachment);
294
295	+	{ TIBConfigService }
296	+
297		TIBConfigService = class(TIBControlService)
298		private
299		FDatabaseName: string;
#	Line 301 | Line 311 | type
311		procedure SetReserveSpace (Value: Boolean);
312		procedure SetAsyncMode (Value: Boolean);
313		procedure SetReadOnly (Value: Boolean);
314	+	procedure SetAutoAdmin(Value: Boolean);
315	+	procedure SetNoLinger;
316		published
317		property DatabaseName: string read FDatabaseName write SetDatabaseName;
318		end;
#	Line 331 | Line 343 | type
343		end;
344
345		TBackupLocation = (flServerSide,flClientSide);
346	+	TBackupStatsOption = (bsTotalTime,bsTimeDelta,bsPageReads,bsPageWrites);
347	+	TBackupStatsOptions = set of TBackupStatsOption;
348
349		{ TIBBackupRestoreService }
350
351		TIBBackupRestoreService = class(TIBControlAndQueryService)
352		private
353		FBackupFileLocation: TBackupLocation;
354	+	FStatisticsRequested: TBackupStatsOptions;
355		FVerbose: Boolean;
356		protected
357	+	procedure SetServiceStartOptions; override;
358		public
359		constructor Create(AOwner: TComponent); override;
360		published
361		property Verbose : Boolean read FVerbose write FVerbose default False;
362	+	property StatisticsRequested: TBackupStatsOptions read FStatisticsRequested write FStatisticsRequested;
363		property BackupFileLocation: TBackupLocation read FBackupFileLocation
364		write FBackupFileLocation default flServerSide;
365		end;
366
367		TBackupOption = (IgnoreChecksums, IgnoreLimbo, MetadataOnly, NoGarbageCollection,
368	<	OldMetadataDesc, NonTransportable, ConvertExtTables);
368	>	OldMetadataDesc, NonTransportable, ConvertExtTables, NoDBTriggers);
369		TBackupOptions = set of TBackupOption;
370
371		TIBBackupService = class (TIBBackupRestoreService)
#	Line 373 | Line 390 | type
390		end;
391
392		TRestoreOption = (DeactivateIndexes, NoShadow, NoValidityCheck, OneRelationAtATime,
393	<	Replace, CreateNewDB, UseAllSpace);
393	>	Replace, CreateNewDB, UseAllSpace, RestoreMetaDataOnly);
394
395		TRestoreOptions = set of TRestoreOption;
396
#	Line 453 | Line 470 | type
470		write FGlobalAction;
471		end;
472
473	+	{ TIBOnlineValidationService }
474	+
475	+	TIBOnlineValidationService = class(TIBControlAndQueryService)
476	+	private
477	+	FDatabaseName: string;
478	+	FExcludeIndexes: string;
479	+	FExcludeTables: string;
480	+	FIncludeIndexes: string;
481	+	FIncludeTables: string;
482	+	FLockTimeout: integer;
483	+	procedure SetDatabaseName(AValue: string);
484	+	protected
485	+	procedure SetServiceStartOptions; override;
486	+	public
487	+	constructor Create(AOwner: TComponent); override;
488	+	procedure ServiceStart; override;
489	+	published
490	+	property IncludeTables: string read FIncludeTables write FIncludeTables;
491	+	property ExcludeTables: string read FExcludeTables write FExcludeTables;
492	+	property IncludeIndexes: string read FIncludeIndexes write FIncludeIndexes;
493	+	property ExcludeIndexes: string read FExcludeIndexes write FExcludeIndexes;
494	+	property LockTimeout: integer read FLockTimeout write FLockTimeout default 10;
495	+	property DatabaseName: string read FDatabaseName write SetDatabaseName;
496	+	end;
497	+
498		TUserInfo = class
499		public
500		UserName: string;
#	Line 461 | Line 503 | type
503		LastName: string;
504		GroupID: Integer;
505		UserID: Integer;
506	+	AdminRole: boolean;
507		end;
508
509		TSecurityAction = (ActionAddUser, ActionDeleteUser, ActionModifyUser, ActionDisplayUser);
510		TSecurityModifyParam = (ModifyFirstName, ModifyMiddleName, ModifyLastName, ModifyUserId,
511	<	ModifyGroupId, ModifyPassword);
511	>	ModifyGroupId, ModifyPassword, ModifyAdminRole);
512		TSecurityModifyParams = set of TSecurityModifyParam;
513
514	+	{ TIBSecurityService }
515	+
516		TIBSecurityService = class(TIBControlAndQueryService)
517		private
518	+	FAdminRole: boolean;
519		FUserID: Integer;
520		FGroupID: Integer;
521		FFirstName: string;
#	Line 482 | Line 528 | type
528		FSecurityAction: TSecurityAction;
529		FModifyParams: TSecurityModifyParams;
530		procedure ClearParams;
531	+	procedure SetAdminRole(AValue: boolean);
532		procedure SetSecurityAction (Value: TSecurityAction);
533		procedure SetFirstName (Value: String);
534		procedure SetMiddleName (Value: String);
#	Line 505 | Line 552 | type
552		procedure AddUser;
553		procedure DeleteUser;
554		procedure ModifyUser;
555	+	function HasAdminRole: boolean;
556		property  UserInfo[Index: Integer]: TUserInfo read GetUserInfo;
557		property  UserInfoCount: Integer read GetUserInfoCount;
558
#	Line 519 | Line 567 | type
567		property UserID : Integer read FUserID write SetUserID;
568		property GroupID : Integer read FGroupID write SetGroupID;
569		property Password : string read FPassword write setPassword;
570	+	property AdminRole: boolean read FAdminRole write SetAdminRole;
571		end;
572
573
574		implementation
575
576		uses
577	<	IBSQLMonitor, Math, FBMessages;
577	>	IBSQLMonitor, FBMessages, RegExpr;
578	>
579	>	{ TIBOnlineValidationService }
580	>
581	>	procedure TIBOnlineValidationService.SetDatabaseName(AValue: string);
582	>	begin
583	>	if FDatabaseName = AValue then Exit;
584	>	FDatabaseName := AValue;
585	>	end;
586	>
587	>	procedure TIBOnlineValidationService.SetServiceStartOptions;
588	>	begin
589	>	inherited SetServiceStartOptions;
590	>	Action := isc_action_svc_validate;
591	>	if FDatabaseName = '' then
592	>	IBError(ibxeStartParamsError, [nil]);
593	>	SRB.Add(isc_action_svc_validate);
594	>	SRB.Add(isc_spb_dbname).AsString := FDatabaseName;
595	>	if IncludeTables <> '' then
596	>	SRB.Add(isc_spb_val_tab_incl).AsString := IncludeTables;
597	>	if ExcludeTables <> '' then
598	>	SRB.Add(isc_spb_val_tab_excl).AsString := ExcludeTables;
599	>	if IncludeIndexes <> '' then
600	>	SRB.Add(isc_spb_val_idx_incl).AsString := IncludeIndexes;
601	>	if ExcludeIndexes <> '' then
602	>	SRB.Add(isc_spb_val_idx_excl).AsString := ExcludeIndexes;
603	>	if LockTimeout <> 0 then
604	>	SRB.Add(isc_spb_val_lock_timeout).AsInteger := LockTimeout;
605	>	end;
606	>
607	>	constructor TIBOnlineValidationService.Create(AOwner: TComponent);
608	>	begin
609	>	inherited Create(AOwner);
610	>	FLockTimeout := 10;
611	>	end;
612	>
613	>	procedure TIBOnlineValidationService.ServiceStart;
614	>	begin
615	>	{Firebird 2.5 and later}
616	>	if (ServerVersionNo[1] < 2) or
617	>	((ServerVersionNo[1] = 2) and (ServerVersionNo[2] < 5)) then
618	>	IBError(ibxeServiceUnavailable,[]);
619	>	inherited ServiceStart;
620	>	end;
621
622		{ TIBBackupRestoreService }
623
624	+	procedure TIBBackupRestoreService.SetServiceStartOptions;
625	+	var options: string;
626	+	begin
627	+	{Firebird 2.5 and later}
628	+	if (ServerVersionNo[1] < 2) or
629	+	((ServerVersionNo[1] = 2) and (ServerVersionNo[2] < 5)) then Exit;
630	+
631	+	if StatisticsRequested <> [] then
632	+	begin
633	+	options := '';
634	+	if bsTotalTime in StatisticsRequested then
635	+	options += 'T';
636	+	if bsTimeDelta in StatisticsRequested then
637	+	options += 'D';
638	+	if bsPageReads in StatisticsRequested then
639	+	options += 'R';
640	+	if bsPageWrites in StatisticsRequested then
641	+	options += 'W';
642	+	SRB.Add(isc_spb_bkp_stat).AsString := options;
643	+	end;
644	+	end;
645	+
646		constructor TIBBackupRestoreService.Create(AOwner: TComponent);
647		begin
648		inherited Create(AOwner);
#	Line 538 | Line 652 | end;
652		{ TIBCustomService }
653
654		procedure TIBCustomService.Attach;
655	+
656	+	procedure GetServerVersionNo;
657	+	var Req: ISRB;
658	+	Results: IServiceQueryResults;
659	+	RegexObj: TRegExpr;
660	+	s: string;
661	+	begin
662	+	Req := FService.AllocateSRB;
663	+	Req.Add(isc_info_svc_server_version);
664	+	Results := FService.Query(nil,Req);
665	+	if (Results.Count = 1) and (Results[0].getItemType = isc_info_svc_server_version) then
666	+	RegexObj := TRegExpr.Create;
667	+	try
668	+	{extact database file spec}
669	+	RegexObj.ModifierG := false; {turn off greedy matches}
670	+	RegexObj.Expression := '[A-Z][A-Z]-V([0-9]+)\.([0-9]+)\.([0-9]+)\.([0-9]+) .*';
671	+	s := Results[0].AsString;
672	+	if RegexObj.Exec(s) then
673	+	begin
674	+	FServerVersionNo[1] := StrToInt(system.copy(s,RegexObj.MatchPos[1],RegexObj.MatchLen[1]));
675	+	FServerVersionNo[2] := StrToInt(system.copy(s,RegexObj.MatchPos[2],RegexObj.MatchLen[2]));
676	+	FServerVersionNo[3] := StrToInt(system.copy(s,RegexObj.MatchPos[3],RegexObj.MatchLen[3]));
677	+	FServerVersionNo[4] := StrToInt(system.copy(s,RegexObj.MatchPos[4],RegexObj.MatchLen[4]));
678	+	end;
679	+	finally
680	+	RegexObj.Free;
681	+	end;
682	+	end;
683	+
684		var aServerName: string;
685	+	TempSvcParams: TStrings;
686	+	SPB: ISPB;
687	+	PW: ISPBItem;
688		begin
689		CheckInactive;
690		CheckServerName;
691
692		aServerName := FServerName;
693
694	<	if FLoginPrompt and not Login(aServerName) then
695	<	IBError(ibxeOperationCancelled, [nil]);
696	<
697	<	{ Generate a new SPB if necessary }
698	<	if FParamsChanged then
699	<	begin
700	<	FParamsChanged := False;
701	<	FSPB := GenerateSPB(FParams);
694	>	TempSvcParams := TStringList.Create;
695	>	try
696	>	TempSvcParams.Assign(FParams);
697	>	if FLoginPrompt and not Login(aServerName,TempSvcParams) then
698	>	IBError(ibxeOperationCancelled, [nil]);
699	>	SPB := GenerateSPB(TempSvcParams);
700	>	finally
701	>	TempSvcParams.Free;
702		end;
703
704	<	FService := FirebirdAPI.GetServiceManager(aServerName,FProtocol,FSPB);
704	>	FService := FirebirdAPI.GetServiceManager(aServerName,PortNo,FProtocol,SPB);
705	>	PW := FService.getSPB.Find(isc_spb_password);
706	>	if PW <> nil then PW.AsString := 'xxxxxxxx'; {Hide password}
707	>
708	>	GetServerVersionNo;
709
710		if Assigned(FOnAttach) then
711		FOnAttach(Self);
#	Line 577 | Line 727 | begin
727		end;
728		end;
729
730	<	function TIBCustomService.Login(var aServerName: string): Boolean;
730	>	function TIBCustomService.Login(var aServerName: string; LoginParams: TStrings
731	>	): Boolean;
732		var
733		IndexOfUser, IndexOfPassword: Integer;
734		Username, Password: String;
735	<	LoginParams: TStrings;
735	>	ExtLoginParams: TStrings;
736		begin
737		if Assigned(FOnLogin) then begin
738		result := True;
739	<	LoginParams := TStringList.Create;
739	>	ExtLoginParams := TStringList.Create;
740		try
741	<	LoginParams.Assign(Params);
742	<	FOnLogin(Self, LoginParams);
743	<	Params.Assign (LoginParams);
741	>	ExtLoginParams.Assign(Params);
742	>	FOnLogin(Self, ExtLoginParams);
743	>	LoginParams.Assign (ExtLoginParams);
744		aServerName := ServerName;
745		finally
746	<	LoginParams.Free;
746	>	ExtLoginParams.Free;
747		end;
748		end
749		else
750		if assigned(IBGUIInterface)  then
751		begin
752	<	IndexOfUser := IndexOfSPBConst(isc_spb_user_name);
752	>	IndexOfUser := LoginParams.IndexOfName(GetSPBConstName(isc_spb_user_name));
753		if IndexOfUser <> -1 then
754	<	Username := Copy(Params[IndexOfUser],
755	<	Pos('=', Params[IndexOfUser]) + 1, {mbcs ok}
756	<	Length(Params[IndexOfUser]));
757	<	IndexOfPassword := IndexOfSPBConst(isc_spb_password);
754	>	Username := LoginParams.ValueFromIndex[IndexOfUser]
755	>	else
756	>	UserName := '';
757	>	IndexOfPassword :=LoginParams.IndexOfName(GetSPBConstName(isc_spb_password));
758		if IndexOfPassword <> -1 then
759	<	Password := Copy(Params[IndexOfPassword],
760	<	Pos('=', Params[IndexOfPassword]) + 1, {mbcs ok}
761	<	Length(Params[IndexOfPassword]));
759	>	Password := LoginParams.ValueFromIndex[IndexOfPassword]
760	>	else
761	>	Password := '';
762	>
763		result := IBGUIInterface.ServerLoginDialog(aServerName, Username, Password);
764		if result then
765		begin
766	<	IndexOfPassword := IndexOfSPBConst(isc_spb_password);
767	<	if IndexOfUser = -1 then
616	<	Params.Add(GetSPBConstName(isc_spb_user_name) + '=' + Username)
617	<	else
618	<	Params[IndexOfUser] := GetSPBConstName(isc_spb_user_name) +
619	<	'=' + Username;
620	<	if IndexOfPassword = -1 then
621	<	Params.Add(GetSPBConstName(isc_spb_password) + '=' + Password)
622	<	else
623	<	Params[IndexOfPassword] := GetSPBConstName(isc_spb_password) +
624	<	'=' + Password;
766	>	LoginParams.Values[GetSPBConstName(isc_spb_user_name)] := UserName;
767	>	LoginParams.Values[GetSPBConstName(isc_spb_password)] := Password;
768		end
769		end
770		else
#	Line 670 | Line 813 | begin
813		FTraceFlags := [];
814		FService := nil;
815		FSRB := nil;
673	–	FSPB := nil;
816		FServiceQueryResults := nil;
817		FProtocol := Local;
818		if (AOwner <> nil) and
#	Line 684 | Line 826 | begin
826		if FService <> nil then
827		Detach;
828		FSRB := nil;
687	–	FSPB := nil;
829		FParams.Free;
830		FServiceQueryResults := nil;
831		inherited Destroy;
#	Line 693 | Line 834 | end;
834		procedure TIBCustomService.Detach;
835		begin
836		CheckActive;
696	–	FService.Detach;
837		FService := nil;
838		MonitorHook.ServiceDetach(Self);
839		end;
840
841	+	procedure TIBCustomService.Assign(Source: TPersistent);
842	+	begin
843	+	if Source = self then Exit;
844	+	if Source is TIBCustomService then
845	+	with Source as TIBCustomService do
846	+	begin
847	+	self.FService := nil;  {Now appears inactive}
848	+	self.FServerName := FServerName;
849	+	self.Params.Assign(Params);
850	+	self.FServerVersionNo := FServerVersionNo;
851	+	self.FProtocol := FProtocol;
852	+	self.FLoginPrompt := FLoginPrompt;
853	+	self.FService := FService;
854	+	end
855	+	else
856	+	inherited Assign(Source);
857	+	end;
858	+
859		procedure TIBCustomService.SetDBParams(DBParams: TStrings);
860		var i: integer;
861		j: integer;
#	Line 730 | Line 888 | var
888		begin
889		if (Idx > 0) and (Idx <= isc_spb_last_spb_constant) then
890		begin
891	<	ConstIdx := IndexOfSPBConst(Idx);
891	>	ConstIdx := IndexOfSPBConst(Idx,Params);
892		if ConstIdx = -1 then
893		result := ''
894		else
#	Line 763 | Line 921 | begin
921		Result := FSRB;
922		end;
923
924	+	function TIBCustomService.GetServerVersionNo(index: integer): integer;
925	+	begin
926	+	CheckActive;
927	+	if (index >= Low(FServerVersionNo)) and (index <= High(FServerVersionNo)) then
928	+	Result := FServerVersionNo[index]
929	+	else
930	+	IBError(ibxeInfoBufferIndexError,[index]);
931	+	end;
932	+
933		procedure TIBCustomService.InternalServiceQuery;
934		begin
935		CheckActive;
936	<	FServiceQueryResults := FService.Query(FSQPB,FSRB);
937	<	FSQPB := nil;
938	<	FSRB := nil;
936	>	try
937	>	FServiceQueryResults := FService.Query(FSQPB,FSRB);
938	>	finally
939	>	FSQPB := nil;
940	>	FSRB := nil;
941	>	end;
942		MonitorHook.ServiceQuery(Self);
943		end;
944
#	Line 777 | Line 947 | begin
947		if csReading in ComponentState then
948		FStreamedActive := Value
949		else
950	<	if Value <> Active then
951	<	begin
952	<	if Value then
953	<	Attach
954	<	else
955	<	Detach;
786	<	end
787	<	else if Value then
788	<	begin
789	<	FService.Detach;
790	<	FService.Attach;
791	<	end;
950	>	if Value = Active then Exit;
951	>
952	>	if Value then
953	>	Attach
954	>	else
955	>	Detach;
956		end;
957
958		procedure TIBCustomService.SetParams(const Value: TStrings);
#	Line 829 | Line 993 | procedure TIBCustomService.SetServicePar
993		var
994		ConstIdx: Integer;
995		begin
996	<	ConstIdx := IndexOfSPBConst(Idx);
996	>	ConstIdx := IndexOfSPBConst(Idx,Params);
997		if (Value = '') then
998		begin
999		if ConstIdx <> -1 then
#	Line 844 | Line 1008 | begin
1008		end;
1009		end;
1010
1011	<	function TIBCustomService.IndexOfSPBConst(action: byte): Integer;
1011	>	function TIBCustomService.IndexOfSPBConst(action: byte; List: TStrings): Integer;
1012		var
1013		i,  pos_of_str: Integer;
1014		st: string;
#	Line 852 | Line 1016 | begin
1016		result := -1;
1017		st := GetSPBConstName(action);
1018		if st <> '' then
1019	<	for i := 0 to Params.Count - 1 do
1019	>	for i := 0 to List.Count - 1 do
1020		begin
1021	<	pos_of_str := Pos(st, Params[i]); {mbcs ok}
1021	>	pos_of_str := Pos(st, List[i]); {mbcs ok}
1022		if (pos_of_str = 1) or (pos_of_str = Length(SPBPrefix) + 1) then
1023		begin
1024		result := i;
#	Line 899 | Line 1063 | end;
1063		}
1064		function TIBCustomService.GenerateSPB(sl: TStrings): ISPB;
1065		var
1066	<	i, j, SPBVal, SPBServerVal: UShort;
1066	>	i, j, SPBServerVal: UShort;
1067		param_name, param_value: String;
1068		begin
1069		{ The SPB is initially empty, with the exception that
#	Line 923 | Line 1087 | begin
1087		{ We want to translate the parameter name to some integer
1088		value. We do this by scanning through a list of known
1089		service parameter names (SPBConstantNames, defined above). }
926	–	SPBVal := 0;
1090		SPBServerVal := 0;
1091		{ Find the parameter }
1092		for j := 1 to isc_spb_last_spb_constant do
1093		if (param_name = SPBConstantNames[j]) then
1094		begin
932	–	SPBVal := j;
1095		SPBServerVal := SPBConstantValues[j];
1096		break;
1097		end;
1098		case SPBServerVal of
1099	<	isc_spb_user_name, isc_spb_password:
1099	>	isc_spb_user_name,
1100	>	isc_spb_password,
1101	>	isc_spb_sql_role_name,
1102	>	isc_spb_expected_db:
1103		Result.Add(SPBServerVal).AsString := param_value;
1104		else
1105		begin
#	Line 1184 | Line 1349 | constructor TIBControlService.Create(AOw
1349		begin
1350		inherited create(AOwner);
1351		FSRB := nil;
1187	–	FSPB := nil;
1352		end;
1353
1354		procedure TIBControlService.InternalServiceStart;
#	Line 1268 | Line 1432 | begin
1432		InternalServiceStart;
1433		end;
1434
1435	+	procedure TIBConfigService.SetAutoAdmin(Value: Boolean);
1436	+	begin
1437	+	{only available for Firebird 2.5 and later}
1438	+	if (ServerVersionNo[1] < 2) or
1439	+	((ServerVersionNo[1] = 2) and (ServerVersionNo[2] < 5)) then Exit;
1440	+	if Value then
1441	+	SRB.Add(isc_action_svc_set_mapping)
1442	+	else
1443	+	SRB.Add(isc_action_svc_drop_mapping);
1444	+	InternalServiceStart;
1445	+	end;
1446	+
1447	+	procedure TIBConfigService.SetNoLinger;
1448	+	begin
1449	+	SRB.Add(isc_action_svc_properties);
1450	+	SRB.Add(isc_spb_dbname).AsString :=  FDatabaseName;
1451	+	SRB.Add(isc_spb_options).AsInteger := isc_spb_prp_nolinger;
1452	+	InternalServiceStart;
1453	+	end;
1454	+
1455		procedure TIBConfigService.SetReserveSpace(Value: Boolean);
1456		begin
1457		SRB.Add(isc_action_svc_properties);
#	Line 1364 | Line 1548 | begin
1548		param := param or isc_spb_bkp_non_transportable;
1549		if (ConvertExtTables in Options) then
1550		param := param or isc_spb_bkp_convert;
1551	+	{Firebird 2.5 and later}
1552	+	if (ServerVersionNo[1] > 2) or
1553	+	((ServerVersionNo[1] = 2) and (ServerVersionNo[2] = 5)) then
1554	+	begin
1555	+	if (NoDBTriggers in Options) then
1556	+	param := param or isc_spb_bkp_no_triggers;
1557	+	end;
1558		Action := isc_action_svc_backup;
1559		SRB.Add(isc_action_svc_backup);
1560		SRB.Add(isc_spb_dbname).AsString := FDatabaseName;
1561		SRB.Add(isc_spb_options).AsInteger := param;
1562		if Verbose  and (BackupFileLocation = flServerSide) then
1563	+	begin
1564		SRB.Add(isc_spb_verbose);
1565	+	inherited SetServiceStartOptions;
1566	+	end;
1567		if FBlockingFactor > 0 then
1568		SRB.Add(isc_spb_bkp_factor).AsInteger := FBlockingFactor;
1569		if BackupFileLocation = flServerSide then
#	Line 1429 | Line 1623 | begin
1623		param := param or isc_spb_res_create;
1624		if (UseAllSpace in Options) then
1625		param := param or isc_spb_res_use_all_space;
1626	+	if (RestoreMetaDataOnly in Options) then
1627	+	param := param or isc_spb_res_metadata_only;
1628		Action := isc_action_svc_restore;
1629		SRB.Add(isc_action_svc_restore);
1630		SRB.Add(isc_spb_options).AsInteger := param;
1631		if Verbose then
1632	+	begin
1633		SRB.Add(isc_spb_verbose);
1634	+	inherited SetServiceStartOptions;
1635	+	end;
1636		if FPageSize > 0 then
1637		SRB.Add(isc_spb_res_page_size).AsInteger := FPageSize;
1638		if FPageBuffers > 0 then
#	Line 1502 | Line 1701 | begin
1701		SQPB.Add(isc_info_svc_timeout).AsInteger := 1;
1702		if FSendBytes > 0 then
1703		Result := SQPB.Add(isc_info_svc_line).CopyFrom(stream,FSendBytes);
1704	<	InternalServiceQuery;
1704	>	try
1705	>	InternalServiceQuery;
1706	>	except
1707	>	FSendBytes := 0;
1708	>	raise;
1709	>	end;
1710
1711		FSendBytes := 0;
1712		for i := 0 to FServiceQueryResults.Count - 1 do
#	Line 1564 | Line 1768 | procedure TIBValidationService.FetchLimb
1768
1769		var
1770		i,j, k: Integer;
1567	–	Value: Char;
1771		begin
1772		for i := 0 to High(FLimboTransactionInfo) do
1773		FLimboTransactionInfo[i].Free;
#	Line 1819 | Line 2022 | begin
2022		isc_spb_sec_groupid:
2023		FUserInfo[k].GroupID := AsInteger;
2024
2025	+	isc_spb_sec_admin:
2026	+	FUserInfo[k].AdminRole := AsInteger <> 0;
2027	+
2028		else
2029		IBError(ibxeOutputParsingError, [getItemType]);
2030		end;
#	Line 1858 | Line 2064 | end;
2064		procedure TIBSecurityService.DisplayUsers;
2065		begin
2066		SecurityAction := ActionDisplayUser;
2067	<	SRB.Add(isc_action_svc_display_user);
2067	>	if HasAdminRole then
2068	>	SRB.Add(isc_action_svc_display_user_adm) {Firebird 2.5 and later only}
2069	>	else
2070	>	SRB.Add(isc_action_svc_display_user);
2071		InternalServiceStart;
2072		FetchUserInfo;
2073		end;
2074
2075	<	procedure TIBSecurityService.DisplayUser(UserName: String);
2075	>	procedure TIBSecurityService.DisplayUser(UserName: string);
2076		begin
2077		SecurityAction := ActionDisplayUser;
2078	<	SRB.Add(isc_action_svc_display_user);
2078	>	if HasAdminRole then
2079	>	SRB.Add(isc_action_svc_display_user_adm) {Firebird 2.5 and later only}
2080	>	else
2081	>	SRB.Add(isc_action_svc_display_user);
2082		SRB.Add(isc_spb_sec_username).AsString := UserName;
2083		InternalServiceStart;
2084		FetchUserInfo;
#	Line 1878 | Line 2090 | begin
2090		ServiceStart;
2091		end;
2092
2093	+	function TIBSecurityService.HasAdminRole: boolean;
2094	+	begin
2095	+	Result :=  (ServerVersionNo[1] > 2) or
2096	+	((ServerVersionNo[1] = 2) and (ServerVersionNo[2] = 5));
2097	+	end;
2098	+
2099		procedure TIBSecurityService.SetSecurityAction (Value: TSecurityAction);
2100		begin
2101		FSecurityAction := Value;
#	Line 1896 | Line 2114 | begin
2114		FPassword := '';
2115		end;
2116
2117	+	procedure TIBSecurityService.SetAdminRole(AValue: boolean);
2118	+	begin
2119	+	FAdminRole := AValue;
2120	+	Include (FModifyParams, ModifyAdminRole);
2121	+	end;
2122	+
2123		procedure TIBSecurityService.SetFirstName (Value: String);
2124		begin
2125		FFirstName := Value;
#	Line 1954 | Line 2178 | begin
2178		IBError(ibxeStartParamsError, [nil]);
2179		SRB.Add(isc_action_svc_add_user);
2180		SRB.Add(isc_spb_sec_username).AsString := FUserName;
2181	<	SRB.Add(isc_spb_sql_role_name).AsString := FSQLRole;
2181	>	if FSQLRole <> '' then
2182	>	SRB.Add(isc_spb_sql_role_name).AsString := FSQLRole;
2183		SRB.Add(isc_spb_sec_userid).AsInteger := FUserID;
2184		SRB.Add(isc_spb_sec_groupid).AsInteger := FGroupID;
2185		SRB.Add(isc_spb_sec_password).AsString := FPassword;
2186		SRB.Add(isc_spb_sec_firstname).AsString := FFirstName;
2187		SRB.Add(isc_spb_sec_middlename).AsString := FMiddleName;
2188		SRB.Add(isc_spb_sec_lastname).AsString := FLastName;
2189	+	if HasAdminRole then
2190	+	SRB.Add(isc_spb_sec_admin).AsInteger := ord(FAdminRole);
2191		end;
2192		ActionDeleteUser:
2193		begin
#	Line 1970 | Line 2197 | begin
2197		IBError(ibxeStartParamsError, [nil]);
2198		SRB.Add(isc_action_svc_delete_user);
2199		SRB.Add(isc_spb_sec_username).AsString := FUserName;
2200	<	SRB.Add(isc_spb_sql_role_name).AsString := FSQLRole;
2200	>	if FSQLRole <> '' then
2201	>	SRB.Add(isc_spb_sql_role_name).AsString := FSQLRole;
2202		end;
2203		ActionModifyUser:
2204		begin
#	Line 1980 | Line 2208 | begin
2208		IBError(ibxeStartParamsError, [nil]);
2209		SRB.Add(isc_action_svc_modify_user);
2210		SRB.Add(isc_spb_sec_username).AsString := FUserName;
2211	<	SRB.Add(isc_spb_sql_role_name).AsString := FSQLRole;
2211	>	if FSQLRole <> '' then
2212	>	SRB.Add(isc_spb_sql_role_name).AsString := FSQLRole;
2213		if (ModifyUserId in FModifyParams) then
2214		SRB.Add(isc_spb_sec_userid).AsInteger := FUserID;
2215		if (ModifyGroupId in FModifyParams) then
#	Line 1993 | Line 2222 | begin
2222		SRB.Add(isc_spb_sec_middlename).AsString := FMiddleName;
2223		if (ModifyLastName in FModifyParams) then
2224		SRB.Add(isc_spb_sec_lastname).AsString := FLastName;
2225	+	if (ModifyAdminRole in FModifyParams) and HasAdminRole then
2226	+	begin
2227	+	if FAdminRole then
2228	+	SRB.Add(isc_spb_sec_admin).AsInteger := 1
2229	+	else
2230	+	SRB.Add(isc_spb_sec_admin).AsInteger := 0;
2231	+	end;
2232		end;
2233		end;
2234		ClearParams;
#	Line 2044 | Line 2280 | begin
2280		end;
2281		end;
2282
2283	+	procedure TIBControlAndQueryService.ServiceStart;
2284	+	begin
2285	+	FEof := false;
2286	+	inherited ServiceStart;
2287	+	end;
2288	+
2289		function TIBControlAndQueryService.WriteNextChunk(stream: TStream): integer;
2290		var
2291		i: Integer;
2292	+	TimeOut: boolean;
2293		begin
2294		result := 0;
2295	+	TimeOut := false;
2296		if (FEof = True) then
2297		exit;
2298		if (FAction = 0) then
#	Line 2066 | Line 2310 | begin
2310		isc_info_svc_to_eof:
2311		begin
2312		Result := CopyTo(stream,0);
2313	<	FEof := Result = 0;
2313	>	FEof := (Result = 0) and not TimeOut;
2314		end;
2315
2316		isc_info_truncated:
2317		FEof := False;
2318
2319		isc_info_svc_timeout:
2320	<	{ignore};
2320	>	begin
2321	>	FEof := False;
2322	>	TimeOut := true;
2323	>	end
2324	>
2325		else
2326		IBError(ibxeOutputParsingError, [getItemType]);
2327		end;

Diff Legend

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