[ViewVC] Diff of: public/ibx/trunk/runtime/IBServices.pas

Comparing ibx/trunk/runtime/IBServices.pas (file contents):
Revision 1 by tony, Mon Jul 31 16:43:00 2000 UTC vs.
Revision 143 by tony, Fri Feb 23 12:11:21 2018 UTC

#	Line 24 \| Line 24
24		{ Corporation. All Rights Reserved. }
25		{ Contributor(s): Jeff Overcash }
26		{ }
27	+	{ IBX For Lazarus (Firebird Express) }
28	+	{ Contributor: Tony Whyman, MWA Software http://www.mwasoftware.co.uk }
29	+	{ Portions created by MWA Software are copyright McCallum Whyman }
30	+	{ Associates Ltd 2011 - 2018 }
31	+	{ }
32		{************************************************************************}
33
34		{
35		InterBase Express provides component interfaces to
36		functions introduced in InterBase 6.0. The Services
37	<	components (TIB*Service, TIBServerProperties) and
33	<	Install components (TIBInstall, TIBUninstall, TIBSetup)
37	>	components (TIB*Service, TIBServerProperties)
38		function only if you have installed InterBase 6.0 or
39	<	later software
39	>	later software, including Firebird
40		}
41
42		unit IBServices;
43
44	+	{$Mode Delphi}
45	+	{$codepage UTF8}
46	+
47		interface
48
49		uses
50	<	Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
51	<	IBDialogs, IBHeader, IB, IBExternals;
50	>	{$IFDEF WINDOWS }
51	>	Windows,
52	>	{$ELSE}
53	>	unix,
54	>	{$ENDIF}
55	>	SysUtils, Classes, IB, IBExternals, CustApp, IBTypes;
56
57		const
58		DefaultBufferSize = 32000;
59
60		SPBPrefix = 'isc_spb_';
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 59 \| 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 = (
79	<	isc_spb_user_name_mapped_to_server,
80	<	isc_spb_sys_user_name_mapped_to_server,
81	<	isc_spb_sys_user_name_enc_mapped_to_server,
82	<	isc_spb_password_mapped_to_server,
83	<	isc_spb_password_enc_mapped_to_server,
84	<	isc_spb_command_line_mapped_to_server,
85	<	isc_spb_dbname_mapped_to_server,
86	<	isc_spb_verbose_mapped_to_server,
87	<	isc_spb_options_mapped_to_server,
88	<	isc_spb_connect_timeout_mapped_to_server,
89	<	isc_spb_dummy_packet_interval_mapped_to_server,
90	<	isc_spb_sql_role_name_mapped_to_server
79	>	isc_spb_user_name,
80	>	isc_spb_sys_user_name,
81	>	isc_spb_sys_user_name_enc,
82	>	isc_spb_password,
83	>	isc_spb_password_enc,
84	>	isc_spb_command_line,
85	>	isc_spb_dbname,
86	>	isc_spb_verbose,
87	>	isc_spb_options,
88	>	isc_spb_connect_timeout,
89	>	isc_spb_dummy_packet_interval,
90	>	isc_spb_sql_role_name,
91	>	isc_spb_expected_db
92		);
93
94		type
81	–	TProtocol = (TCP, SPX, NamedPipe, Local);
95		TOutputBufferOption = (ByLine, ByChunk);
96
97		TIBCustomService = class;
98
99	<	TLoginEvent = procedure(Database: TIBCustomService;
99	>	TLoginEvent = procedure(Service: TIBCustomService;
100		LoginParams: TStrings) of object;
101
102	+	{ TIBCustomService }
103	+
104		TIBCustomService = class(TComponent)
105		private
91	–	FIBLoaded: Boolean;
106		FParamsChanged : Boolean;
107	<	FSPB, FQuerySPB : PChar;
108	<	FSPBLength, FQuerySPBLength : Short;
107	>	FPortNo: string;
108	>	FSRB: ISRB;
109	>	FSQPB: ISQPB;
110		FTraceFlags: TTraceFlags;
111		FOnLogin: TLoginEvent;
112		FLoginPrompt: Boolean;
98	–	FBufferSize: Integer;
99	–	FOutputBuffer: PChar;
100	–	FQueryParams: String;
113		FServerName: string;
114	<	FHandle: TISC_SVC_HANDLE;
114	>	FService: IServiceManager;
115		FStreamedActive : Boolean;
116		FOnAttach: TNotifyEvent;
105	–	FOutputBufferOption: TOutputBufferOption;
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);
111	–	procedure SetBufferSize(const Value: Integer);
127		procedure SetParams(const Value: TStrings);
128		procedure SetServerName(const Value: string);
129		procedure SetProtocol(const Value: TProtocol);
130	+	procedure SetService(AValue: IServiceManager);
131		procedure SetServiceParamBySPB(const Idx: Integer;
132		const Value: String);
133	<	function IndexOfSPBConst(st: String): 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);
137		procedure CheckServerName;
138	<	function Call(ErrCode: ISC_STATUS; RaiseError: Boolean): ISC_STATUS;
122	<	function ParseString(var RunLen: Integer): string;
123	<	function ParseInteger(var RunLen: Integer): Integer;
124	<	procedure GenerateSPB(sl: TStrings; var SPB: String; var SPBLength: Short);
138	>	function GenerateSPB(sl: TStrings): ISPB;
139
140		protected
141		procedure Loaded; override;
142	<	function Login: Boolean;
142	>	function Login(var aServerName: string; LOginParams: TStrings): Boolean;
143		procedure CheckActive;
144		procedure CheckInactive;
145	<	property OutputBuffer : PChar read FOutputBuffer;
132	<	property OutputBufferOption : TOutputBufferOption read FOutputBufferOption write FOutputBufferOption;
133	<	property BufferSize : Integer read FBufferSize write SetBufferSize default DefaultBufferSize;
145	>	procedure HandleException(Sender: TObject);
146		procedure InternalServiceQuery;
147	<	property ServiceQueryParams: String read FQueryParams write FQueryParams;
147	>	property SRB: ISRB read GetSRB;
148	>	property SQPB: ISQPB read GetSQPB;
149	>	property ServiceQueryResults: IServiceQueryResults read FServiceQueryResults;
150
151		public
152		constructor Create(AOwner: TComponent); override;
153		destructor Destroy; override;
154		procedure Attach;
155		procedure Detach;
156	<	property Handle: TISC_SVC_HANDLE read FHandle;
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
160	>	DBParams are TIBDatabase.Params}
161	>	procedure SetDBParams(DBParams: TStrings);
162	>
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 215 \| Line 238 \| type
238		FLicenseMaskInfo: TLicenseMaskInfo;
239		FVersionInfo: TVersionInfo;
240		FConfigParams: TConfigParams;
218	–	procedure ParseConfigFileData(var RunLen: Integer);
241		public
242		constructor Create(AOwner: TComponent); override;
243		destructor Destroy; override;
#	Line 234 \| Line 256 \| type
256		property Options : TPropertyOptions read FOptions write FOptions;
257		end;
258
259	+	{ TIBControlService }
260	+
261		TIBControlService = class (TIBCustomService)
262		private
239	–	FStartParams: String;
240	–	FStartSPB: PChar;
241	–	FStartSPBLength: Integer;
263		function GetIsServiceRunning: Boolean;
264		protected
265	<	property ServiceStartParams: String read FStartParams write FStartParams;
245	<	procedure SetServiceStartOptions; virtual;
246	<	procedure ServiceStartAddParam (Value: string; param: Integer); overload;
247	<	procedure ServiceStartAddParam (Value: Integer; param: Integer); overload;
265	>	procedure CheckServiceNotRunning;
266		procedure InternalServiceStart;
267	+	procedure SetServiceStartOptions; virtual;
268
269		public
270		constructor Create(AOwner: TComponent); override;
#	Line 253 \| Line 272 \| type
272		property IsServiceRunning : Boolean read GetIsServiceRunning;
273		end;
274
275	+	{ TIBControlAndQueryService }
276	+
277		TIBControlAndQueryService = class (TIBControlService)
278		private
279		FEof: Boolean;
#	Line 264 \| 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;
268	–	published
269	–	property BufferSize;
291		end;
292
293		TShutdownMode = (Forced, DenyTransaction, DenyAttachment);
294
295	+	{ TIBConfigService }
296	+
297		TIBConfigService = class(TIBControlService)
298		private
299		FDatabaseName: string;
#	Line 288 \| 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 301 \| Line 326 \| type
326		published
327		end;
328
329	<	TStatOption = (DataPages, DbLog, HeaderPages, IndexPages, SystemRelations);
329	>	TStatOption = (DataPages, {DbLog,} HeaderPages, IndexPages, SystemRelations);
330		TStatOptions = set of TStatOption;
331
332		TIBStatisticalService = class(TIBControlAndQueryService)
#	Line 317 \| Line 342 \| type
342		property Options : TStatOptions read FOptions write FOptions;
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 353 \| 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	+
397	+	{ TIBRestoreService }
398	+
399		TIBRestoreService = class (TIBBackupRestoreService)
400		private
401		FDatabaseName: TStrings;
#	Line 363 \| Line 403 \| type
403		FOptions: TRestoreOptions;
404		FPageSize: Integer;
405		FPageBuffers: Integer;
406	+	FSendBytes: integer;
407		procedure SetBackupFile(const Value: TStrings);
408		procedure SetDatabaseName(const Value: TStrings);
409		protected
#	Line 370 \| Line 411 \| type
411		public
412		constructor Create(AOwner: TComponent); override;
413		destructor Destroy; override;
414	+	function SendNextChunk(stream: TStream; var line: String): integer;
415		published
416		{ a name=value pair of filename and length }
417		property DatabaseName: TStrings read FDatabaseName write SetDatabaseName;
#	Line 428 \| 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 436 \| 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 457 \| 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 480 \| 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 494 \| 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	<	IBIntf, IBSQLMonitor;
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);
649	>	FBackupFileLocation := flServerSide;
650	>	end;
651
652		{ TIBCustomService }
653
654		procedure TIBCustomService.Attach;
655	<	var
656	<	SPB: String;
657	<	ConnectString: String;
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	<	if FLoginPrompt and not Login then
516	<	IBError(ibxeOperationCancelled, [nil]);
692	>	aServerName := FServerName;
693
694	<	{ Generate a new SPB if necessary }
695	<	if FParamsChanged then
696	<	begin
697	<	FParamsChanged := False;
698	<	GenerateSPB(FParams, SPB, FSPBLength);
699	<	IBAlloc(FSPB, 0, FsPBLength);
700	<	Move(SPB[1], FSPB[0], FSPBLength);
701	<	end;
526	<	case FProtocol of
527	<	TCP: ConnectString := FServerName + ':service_mgr'; {do not localize}
528	<	SPX: ConnectString := FServerName + '@service_mgr'; {do not localize}
529	<	NamedPipe: ConnectString := '\\' + FServerName + '\service_mgr'; {do not localize}
530	<	Local: ConnectString := 'service_mgr'; {do not localize}
531	<	end;
532	<	if call(isc_service_attach(StatusVector, Length(ConnectString),
533	<	PChar(ConnectString), @FHandle,
534	<	FSPBLength, FSPB), False) > 0 then
535	<	begin
536	<	FHandle := nil;
537	<	IBDataBaseError;
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,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);
712
#	Line 551 \| Line 721 \| begin
721		Attach;
722		except
723		if csDesigning in ComponentState then
724	<	Application.HandleException(Self)
724	>	HandleException(self)
725		else
726		raise;
727		end;
728		end;
729
730	<	function TIBCustomService.Login: 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 begin
750	<	IndexOfUser := IndexOfSPBConst(SPBConstantNames[isc_spb_user_name]);
749	>	else
750	>	if assigned(IBGUIInterface) then
751	>	begin
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(SPBConstantNames[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]));
762	<	result := ServerLoginDialog(serverName, Username, Password);
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(SPBConstantNames[isc_spb_password]);
767	<	if IndexOfUser = -1 then
768	<	Params.Add(SPBConstantNames[isc_spb_user_name] + '=' + Username)
769	<	else
770	<	Params[IndexOfUser] := SPBConstantNames[isc_spb_user_name] +
771	<	'=' + Username;
597	<	if IndexOfPassword = -1 then
598	<	Params.Add(SPBConstantNames[isc_spb_password] + '=' + Password)
599	<	else
600	<	Params[IndexOfPassword] := SPBConstantNames[isc_spb_password] +
601	<	'=' + Password;
602	<	end;
603	<	end;
766	>	LoginParams.Values[GetSPBConstName(isc_spb_user_name)] := UserName;
767	>	LoginParams.Values[GetSPBConstName(isc_spb_password)] := Password;
768	>	end
769	>	end
770	>	else
771	>	IBError(ibxeNoLoginDialog,[]);
772		end;
773
774		procedure TIBCustomService.CheckActive;
775		begin
776		if FStreamedActive and (not Active) then
777		Loaded;
778	<	if FHandle = nil then
778	>	if FService = nil then
779		IBError(ibxeServiceActive, [nil]);
780		end;
781
782		procedure TIBCustomService.CheckInactive;
783		begin
784	<	if FHandle <> nil then
784	>	if FService <> nil then
785		IBError(ibxeServiceInActive, [nil]);
786		end;
787
788	+	procedure TIBCustomService.HandleException(Sender: TObject);
789	+	var aParent: TComponent;
790	+	begin
791	+	aParent := Owner;
792	+	while aParent <> nil do
793	+	begin
794	+	if aParent is TCustomApplication then
795	+	begin
796	+	TCustomApplication(aParent).HandleException(Sender);
797	+	Exit;
798	+	end;
799	+	aParent := aParent.Owner;
800	+	end;
801	+	SysUtils.ShowException(ExceptObject,ExceptAddr);
802	+	end;
803	+
804		constructor TIBCustomService.Create(AOwner: TComponent);
805		begin
806		inherited Create(AOwner);
623	–	FIBLoaded := False;
624	–	CheckIBLoaded;
625	–	FIBLoaded := True;
807		FserverName := '';
808		FParams := TStringList.Create;
809		FParamsChanged := True;
810		TStringList(FParams).OnChange := ParamsChange;
811		TStringList(FParams).OnChanging := ParamsChanging;
631	–	FSPB := nil;
632	–	FQuerySPB := nil;
633	–	FBufferSize := DefaultBufferSize;
634	–	FHandle := nil;
812		FLoginPrompt := True;
813		FTraceFlags := [];
814	+	FService := nil;
815	+	FSRB := nil;
816	+	FServiceQueryResults := nil;
817	+	FProtocol := Local;
818	+	if (AOwner <> nil) and
819	+	(AOwner is TCustomApplication) and
820	+	TCustomApplication(AOwner).ConsoleApplication then
821	+	LoginPrompt := false;
822		end;
823
824		destructor TIBCustomService.Destroy;
825		begin
826	<	if FIBLoaded then
642	<	begin
643	<	if FHandle <> nil then
826	>	if FService <> nil then
827		Detach;
828	<	FreeMem(FSPB);
829	<	FSPB := nil;
830	<	FParams.Free;
648	<	end;
828	>	FSRB := nil;
829	>	FParams.Free;
830	>	FServiceQueryResults := nil;
831		inherited Destroy;
832		end;
833
834		procedure TIBCustomService.Detach;
835		begin
836		CheckActive;
837	<	if (Call(isc_service_detach(StatusVector, @FHandle), False) > 0) then
838	<	begin
839	<	FHandle := nil;
840	<	IBDataBaseError;
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	<	FHandle := nil;
857	<	MonitorHook.ServiceDetach(Self);
856	>	inherited Assign(Source);
857	>	end;
858	>
859	>	procedure TIBCustomService.SetDBParams(DBParams: TStrings);
860	>	var i: integer;
861	>	j: integer;
862	>	k: integer;
863	>	ParamName: string;
864	>	begin
865	>	Params.Clear;
866	>	for i := 0 to DBParams.Count - 1 do
867	>	begin
868	>	ParamName := DBParams[i];
869	>	k := Pos('=',ParamName);
870	>	if k > 0 then system.Delete(ParamName,k,Length(ParamName)-k+1);
871	>	for j := 1 to isc_spb_last_spb_constant do
872	>	if ParamName = SPBConstantNames[j] then
873	>	begin
874	>	Params.Add(DBParams[i]);
875	>	break;
876	>	end;
877	>	end;
878		end;
879
880		function TIBCustomService.GetActive: Boolean;
881		begin
882	<	result := FHandle <> nil;
882	>	result := FService <> nil;
883		end;
884
885		function TIBCustomService.GetServiceParamBySPB(const Idx: Integer): String;
#	Line 673 \| Line 888 \| var
888		begin
889		if (Idx > 0) and (Idx <= isc_spb_last_spb_constant) then
890		begin
891	<	ConstIdx := IndexOfSPBConst(SPBConstantNames[Idx]);
891	>	ConstIdx := IndexOfSPBConst(Idx,Params);
892		if ConstIdx = -1 then
893		result := ''
894		else
#	Line 690 \| Line 905 \| begin
905		result := '';
906		end;
907
908	+	function TIBCustomService.GetSQPB: ISQPB;
909	+	begin
910	+	CheckActive;
911	+	if FSQPB = nil then
912	+	FSQPB := FService.AllocateSQPB;
913	+	Result := FSQPB;
914	+	end;
915	+
916	+	function TIBCustomService.GetSRB: ISRB;
917	+	begin
918	+	CheckActive;
919	+	if FSRB = nil then
920	+	FSRB := FService.AllocateSRB;
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	<	FQuerySPBLength := Length(FQueryParams);
696	<	if FQuerySPBLength = 0 then
697	<	IBError(ibxeQueryParamsError, [nil]);
698	<	IBAlloc(FQuerySPB, 0, FQuerySPBLength);
699	<	Move(FQueryParams[1], FQuerySPB[0], FQuerySPBLength);
700	<	if (FOutputBuffer = nil) then
701	<	IBAlloc(FOutputBuffer, 0, FBufferSize);
935	>	CheckActive;
936		try
937	<	if call(isc_service_query(StatusVector, @FHandle, nil, 0, nil,
704	<	FQuerySPBLength, FQuerySPB,
705	<	FBufferSize, FOutputBuffer), False) > 0 then
706	<	begin
707	<	FHandle := nil;
708	<	IBDataBaseError;
709	<	end;
937	>	FServiceQueryResults := FService.Query(FSQPB,FSRB);
938		finally
939	<	FreeMem(FQuerySPB);
940	<	FQuerySPB := nil;
713	<	FQuerySPBLength := 0;
714	<	FQueryParams := '';
939	>	FSQPB := nil;
940	>	FSRB := nil;
941		end;
942		MonitorHook.ServiceQuery(Self);
943		end;
#	Line 721 \| Line 947 \| begin
947		if csReading in ComponentState then
948		FStreamedActive := Value
949		else
950	<	if Value then
725	<	Attach
726	<	else
727	<	Detach;
728	<	end;
950	>	if Value = Active then Exit;
951
952	<	procedure TIBCustomService.SetBufferSize(const Value: Integer);
953	<	begin
954	<	if (FOutputBuffer <> nil) and (Value <> FBufferSize) then
955	<	IBAlloc(FOutputBuffer, 0, FBufferSize);
952	>	if Value then
953	>	Attach
954	>	else
955	>	Detach;
956		end;
957
958		procedure TIBCustomService.SetParams(const Value: TStrings);
#	Line 758 \| Line 980 \| begin
980		end;
981		end;
982
983	+	procedure TIBCustomService.SetService(AValue: IServiceManager);
984	+	begin
985	+	if FService = AValue then Exit;
986	+	FService := AValue;
987	+	if AValue <> nil then
988	+	FServerName := FService.getServerName;
989	+	end;
990	+
991		procedure TIBCustomService.SetServiceParamBySPB(const Idx: Integer;
992		const Value: String);
993		var
994		ConstIdx: Integer;
995		begin
996	<	ConstIdx := IndexOfSPBConst(SPBConstantNames[Idx]);
996	>	ConstIdx := IndexOfSPBConst(Idx,Params);
997		if (Value = '') then
998		begin
999		if ConstIdx <> -1 then
#	Line 772 \| Line 1002 \| begin
1002		else
1003		begin
1004		if (ConstIdx = -1) then
1005	<	Params.Add(SPBConstantNames[Idx] + '=' + Value)
1005	>	Params.Add(GetSPBConstName(Idx) + '=' + Value)
1006		else
1007	<	Params[ConstIdx] := SPBConstantNames[Idx] + '=' + Value;
1007	>	Params[ConstIdx] := GetSPBConstName(Idx) + '=' + Value;
1008		end;
1009		end;
1010
1011	<	function TIBCustomService.IndexOfSPBConst(st: String): Integer;
1011	>	function TIBCustomService.IndexOfSPBConst(action: byte; List: TStrings): Integer;
1012		var
1013	<	i, pos_of_str: Integer;
1013	>	i, pos_of_str: Integer;
1014	>	st: string;
1015		begin
1016		result := -1;
1017	<	for i := 0 to Params.Count - 1 do
1017	>	st := GetSPBConstName(action);
1018	>	if st <> '' then
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 794 \| Line 1027 \| begin
1027		end;
1028		end;
1029
1030	+	function TIBCustomService.GetSPBConstName(action: byte): string;
1031	+	var i: integer;
1032	+	begin
1033	+	Result := '';
1034	+	for i := Low(SPBConstantValues) to High(SPBConstantValues) do
1035	+	if SPBConstantValues[i] = action then
1036	+	begin
1037	+	Result := SPBConstantNames[i];
1038	+	break;
1039	+	end;
1040	+	end;
1041	+
1042		procedure TIBCustomService.ParamsChange(Sender: TObject);
1043		begin
1044		FParamsChanged := True;
#	Line 810 \| Line 1055 \| begin
1055		IBError(ibxeServerNameMissing, [nil]);
1056		end;
1057
813	–	function TIBCustomService.Call(ErrCode: ISC_STATUS;
814	–	RaiseError: Boolean): ISC_STATUS;
815	–	begin
816	–	result := ErrCode;
817	–	if RaiseError and (ErrCode > 0) then
818	–	IBDataBaseError;
819	–	end;
820	–
821	–	function TIBCustomService.ParseString(var RunLen: Integer): string;
822	–	var
823	–	Len: UShort;
824	–	tmp: Char;
825	–	begin
826	–	Len := isc_vax_integer(OutputBuffer + RunLen, 2);
827	–	RunLen := RunLen + 2;
828	–	if (Len <> 0) then
829	–	begin
830	–	tmp := OutputBuffer[RunLen + Len];
831	–	OutputBuffer[RunLen + Len] := #0;
832	–	result := String(PChar(@OutputBuffer[RunLen]));
833	–	OutputBuffer[RunLen + Len] := tmp;
834	–	RunLen := RunLen + Len;
835	–	end
836	–	else
837	–	result := '';
838	–	end;
839	–
840	–	function TIBCustomService.ParseInteger(var RunLen: Integer): Integer;
841	–	begin
842	–	result := isc_vax_integer(OutputBuffer + RunLen, 4);
843	–	RunLen := RunLen + 4;
844	–	end;
845	–
1058		{
1059		* GenerateSPB -
1060		* Given a string containing a textual representation
1061		* of the Service parameters, generate a service
1062	<	* parameter buffer, and return it and its length
851	<	* in SPB and SPBLength, respectively.
1062	>	* parameter buffer, and return it .
1063		}
1064	<	procedure TIBCustomService.GenerateSPB(sl: TStrings; var SPB: String;
854	<	var SPBLength: Short);
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
1070		the SPB version must be the first byte of the string.
1071		}
1072	<	SPBLength := 2;
1073	<	SPB := Char(isc_spb_version);
864	<	SPB := SPB + Char(isc_spb_current_version);
1072	>	Result := FirebirdAPI.AllocateSPB;
1073	>
1074		{ Iterate through the textual service parameters, constructing
1075		a SPB on-the-fly }
1076	+	if sl.Count > 0 then
1077		for i := 0 to sl.Count - 1 do
1078		begin
1079		{ Get the parameter's name and value from the list,
#	Line 877 \| 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). }
880	–	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
886	–	SPBVal := j;
1095		SPBServerVal := SPBConstantValues[j];
1096		break;
1097		end;
1098	<	case SPBVal of
1099	<	isc_spb_user_name, isc_spb_password:
1100	<	begin
1101	<	SPB := SPB +
1102	<	Char(SPBServerVal) +
1103	<	Char(Length(param_value)) +
896	<	param_value;
897	<	Inc(SPBLength, 2 + Length(param_value));
898	<	end;
1098	>	case SPBServerVal of
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
1106	<	if (SPBVal > 0) and
902	<	(SPBVal <= isc_dpb_last_dpb_constant) then
1106	>	if GetSPBConstName(SPBServerVal) <> '' then
1107		IBError(ibxeSPBConstantNotSupported,
1108	<	[SPBConstantNames[SPBVal]])
1108	>	[GetSPBConstName(SPBServerVal)])
1109		else
1110	<	IBError(ibxeSPBConstantUnknown, [SPBVal]);
1110	>	IBError(ibxeSPBConstantUnknown, [SPBServerVal]);
1111		end;
1112		end;
1113		end;
#	Line 930 \| Line 1134 \| begin
1134		inherited Destroy;
1135		end;
1136
933	–	procedure TIBServerProperties.ParseConfigFileData(var RunLen: Integer);
934	–	begin
935	–	Inc(RunLen);
936	–	with FConfigParams.ConfigFileData do
937	–	begin
938	–	SetLength (ConfigFileValue, Length(ConfigFileValue)+1);
939	–	SetLength (ConfigFileKey, Length(ConfigFileKey)+1);
940	–
941	–	ConfigFileKey[High(ConfigFileKey)] := Integer(OutputBuffer[RunLen-1]);
942	–	ConfigFileValue[High(ConfigFileValue)] := ParseInteger(RunLen);
943	–	end;
944	–	end;
945	–
1137		procedure TIBServerProperties.Fetch;
1138		begin
1139		if (Database in Options) then
#	Line 959 \| Line 1150 \| end;
1150
1151		procedure TIBServerProperties.FetchConfigParams;
1152		var
1153	<	RunLen: Integer;
1153	>	i, j: Integer;
1154
1155		begin
1156	<	ServiceQueryParams := Char(isc_info_svc_get_config) +
1157	<	Char(isc_info_svc_get_env) +
1158	<	Char(isc_info_svc_get_env_lock) +
1159	<	Char(isc_info_svc_get_env_msg) +
1160	<	Char(isc_info_svc_user_dbpath);
1156	>	SRB.Add(isc_info_svc_get_config);
1157	>	SRB.Add(isc_info_svc_get_env);
1158	>	SRB.Add(isc_info_svc_get_env_lock);
1159	>	SRB.Add(isc_info_svc_get_env_msg);
1160	>	SRB.Add(isc_info_svc_user_dbpath);
1161
1162		InternalServiceQuery;
1163	<	RunLen := 0;
1164	<	While (not (Integer(OutputBuffer[RunLen]) = isc_info_end)) do
1163	>
1164	>	for i := 0 to FServiceQueryResults.Count - 1 do
1165	>	with FServiceQueryResults[i] do
1166		begin
1167	<	case Integer(OutputBuffer[RunLen]) of
1167	>	case getItemType of
1168		isc_info_svc_get_config:
1169		begin
1170	<	FConfigParams.ConfigFileData.ConfigFileKey := nil;
1171	<	FConfigParams.ConfigFileData.ConfigFileValue := nil;
1172	<	Inc (RunLen);
1173	<	while (not (Integer(OutputBuffer[RunLen]) = isc_info_flag_end)) do
1174	<	ParseConfigFileData (RunLen);
1175	<	if (Integer(OutputBuffer[RunLen]) = isc_info_flag_end) then
1176	<	Inc (RunLen);
1170	>	SetLength (FConfigParams.ConfigFileData.ConfigFileValue, Count);
1171	>	SetLength (FConfigParams.ConfigFileData.ConfigFileKey, Count);
1172	>
1173	>	for j := 0 to Count - 1 do
1174	>	begin
1175	>	FConfigParams.ConfigFileData.ConfigFileKey[j] := Items[j].getItemType;
1176	>	FConfigParams.ConfigFileData.ConfigFileValue[j] := Items[j].AsInteger;
1177	>	end;
1178		end;
1179
1180		isc_info_svc_get_env:
1181	<	begin
989	<	Inc (RunLen);
990	<	FConfigParams.BaseLocation := ParseString(RunLen);
991	<	end;
1181	>	FConfigParams.BaseLocation := AsString;
1182
1183		isc_info_svc_get_env_lock:
1184	<	begin
995	<	Inc (RunLen);
996	<	FConfigParams.LockFileLocation := ParseString(RunLen);
997	<	end;
1184	>	FConfigParams.LockFileLocation := AsString;
1185
1186		isc_info_svc_get_env_msg:
1187	<	begin
1001	<	Inc (RunLen);
1002	<	FConfigParams.MessageFileLocation := ParseString(RunLen);
1003	<	end;
1187	>	FConfigParams.MessageFileLocation := AsString;
1188
1189		isc_info_svc_user_dbpath:
1190	<	begin
1191	<	Inc (RunLen);
1008	<	FConfigParams.SecurityDatabaseLocation := ParseString(RunLen);
1009	<	end;
1190	>	FConfigParams.SecurityDatabaseLocation := AsString;
1191	>
1192		else
1193	<	IBError(ibxeOutputParsingError, [nil]);
1193	>	IBError(ibxeOutputParsingError, [getItemType]);
1194		end;
1195		end;
1196		end;
1197
1198		procedure TIBServerProperties.FetchDatabaseInfo;
1199		var
1200	<	i, RunLen: Integer;
1200	>	i,j: Integer;
1201		begin
1202	<	ServiceQueryParams := Char(isc_info_svc_svr_db_info);
1202	>	SRB.Add(isc_info_svc_svr_db_info);
1203		InternalServiceQuery;
1204	<	if (OutputBuffer[0] <> Char(isc_info_svc_svr_db_info)) then
1205	<	IBError(ibxeOutputParsingError, [nil]);
1206	<	RunLen := 1;
1207	<	if (OutputBuffer[RunLen] <> Char(isc_spb_num_att)) then
1208	<	IBError(ibxeOutputParsingError, [nil]);
1209	<	Inc(RunLen);
1210	<	FDatabaseInfo.NoOfAttachments := ParseInteger(RunLen);
1211	<	if (OutputBuffer[RunLen] <> Char(isc_spb_num_db)) then
1212	<	IBError(ibxeOutputParsingError, [nil]);
1213	<	Inc(RunLen);
1214	<	FDatabaseInfo.NoOfDatabases := ParseInteger(RunLen);
1215	<	FDatabaseInfo.DbName := nil;
1216	<	SetLength(FDatabaseInfo.DbName, FDatabaseInfo.NoOfDatabases);
1217	<	i := 0;
1218	<	while (OutputBuffer[RunLen] <> Char(isc_info_flag_end)) do
1219	<	begin
1220	<	if (OutputBuffer[RunLen] <> Char(SPBConstantValues[isc_spb_dbname])) then
1221	<	IBError(ibxeOutputParsingError, [nil]);
1222	<	Inc(RunLen);
1223	<	FDatabaseInfo.DbName[i] := ParseString(RunLen);
1224	<	Inc (i);
1225	<	end;
1204	>
1205	>	SetLength(FDatabaseInfo.DbName,0);
1206	>	for i := 0 to FServiceQueryResults.Count - 1 do
1207	>	with FServiceQueryResults[i] do
1208	>	begin
1209	>	case getItemType of
1210	>	isc_info_svc_svr_db_info:
1211	>	for j := 0 to FServiceQueryResults[i].Count - 1 do
1212	>	with FServiceQueryResults[i][j] do
1213	>	case getItemType of
1214	>	isc_spb_num_att:
1215	>	FDatabaseInfo.NoOfAttachments := AsInteger;
1216	>
1217	>	isc_spb_num_db:
1218	>	FDatabaseInfo.NoOfDatabases := AsInteger;
1219	>
1220	>	isc_spb_dbname:
1221	>	begin
1222	>	SetLength(FDatabaseInfo.DbName,length(FDatabaseInfo.DbName)+1);
1223	>	FDatabaseInfo.DbName[length(FDatabaseInfo.DbName)-1] := AsString;
1224	>	end;
1225	>	else
1226	>	IBError(ibxeOutputParsingError, [getItemType]);
1227	>	end;
1228	>	else
1229	>	IBError(ibxeOutputParsingError, [getItemType]);
1230	>	end;
1231	>	end;
1232		end;
1233
1234		procedure TIBServerProperties.FetchLicenseInfo;
1235		var
1236	<	i, RunLen: Integer;
1049	<	done: Integer;
1236	>	i,j : Integer;
1237		begin
1238	<	ServiceQueryParams := Char(isc_info_svc_get_license) +
1239	<	Char(isc_info_svc_get_licensed_users);
1238	>	SRB.Add(isc_info_svc_get_license);
1239	>	SRB.Add(isc_info_svc_get_licensed_users);
1240		InternalServiceQuery;
1241	<	RunLen := 0;
1242	<	done := 0;
1243	<	i := 0;
1244	<	FLicenseInfo.key := nil;
1245	<	FLicenseInfo.id := nil;
1246	<	FLicenseInfo.desc := nil;
1247	<
1248	<	While done < 2 do begin
1249	<	Inc(Done);
1063	<	Inc(RunLen);
1064	<	case Integer(OutputBuffer[RunLen-1]) of
1241	>
1242	>	SetLength(FLicenseInfo.key, 0);
1243	>	SetLength(FLicenseInfo.id, 0);
1244	>	SetLength(FLicenseInfo.desc, 0);
1245	>
1246	>	for i := 0 to FServiceQueryResults.Count - 1 do
1247	>	with FServiceQueryResults[i] do
1248	>	begin
1249	>	case getItemType of
1250		isc_info_svc_get_license:
1066	–	begin
1067	–	while (OutputBuffer[RunLen] <> Char(isc_info_flag_end)) do
1251		begin
1252	<	if (i >= Length(FLicenseInfo.key)) then
1253	<	begin
1254	<	SetLength(FLicenseInfo.key, i + 10);
1255	<	SetLength(FLicenseInfo.id, i + 10);
1256	<	SetLength(FLicenseInfo.desc, i + 10);
1252	>	SetLength(FLicenseInfo.key, Count);
1253	>	SetLength(FLicenseInfo.id, Count);
1254	>	SetLength(FLicenseInfo.desc, Count);
1255	>
1256	>	for j := 0 to Count -1 do
1257	>	with Items[j] do
1258	>	case getItemType of
1259	>	isc_spb_lic_id:
1260	>	FLicenseInfo.id[j] := AsString;
1261	>
1262	>	isc_spb_lic_key:
1263	>	FLicenseInfo.key[j] := AsString;
1264	>
1265	>	isc_spb_lic_desc:
1266	>	FLicenseInfo.desc[j] := AsString;
1267	>	else
1268	>	IBError(ibxeOutputParsingError, [getItemType]);
1269		end;
1075	–	if (OutputBuffer[RunLen] <> Char(isc_spb_lic_id)) then
1076	–	IBError(ibxeOutputParsingError, [nil]);
1077	–	Inc(RunLen);
1078	–	FLicenseInfo.id[i] := ParseString(RunLen);
1079	–	if (OutputBuffer[RunLen] <> Char(isc_spb_lic_key)) then
1080	–	IBError(ibxeOutputParsingError, [nil]);
1081	–	Inc(RunLen);
1082	–	FLicenseInfo.key[i] := ParseString(RunLen);
1083	–	if (OutputBuffer[RunLen] <> Char(7)) then
1084	–	IBError(ibxeOutputParsingError, [nil]);
1085	–	Inc(RunLen);
1086	–	FLicenseInfo.desc[i] := ParseString(RunLen);
1087	–	Inc(i);
1088	–	end;
1089	–	Inc(RunLen);
1090	–	if (Length(FLicenseInfo.key) > i) then
1091	–	begin
1092	–	SetLength(FLicenseInfo.key, i);
1093	–	SetLength(FLicenseInfo.id, i);
1094	–	SetLength(FLicenseInfo.desc, i);
1270		end;
1096	–	end;
1097	–	isc_info_svc_get_licensed_users:
1098	–	FLicenseInfo.LicensedUsers := ParseInteger(RunLen);
1271		else
1272	<	IBError(ibxeOutputParsingError, [nil]);
1272	>	IBError(ibxeOutputParsingError, [getItemType]);
1273		end;
1274		end;
1275		end;
1276
1277		procedure TIBServerProperties.FetchLicenseMaskInfo();
1278		var
1279	<	done,RunLen:integer;
1279	>	i : Integer;
1280		begin
1281	<	ServiceQueryParams := Char(isc_info_svc_get_license_mask) +
1282	<	Char(isc_info_svc_capabilities);
1281	>	SRB.Add(isc_info_svc_get_license_mask);
1282	>	SRB.Add(isc_info_svc_capabilities);
1283		InternalServiceQuery;
1284	<	RunLen := 0;
1285	<	done := 0;
1286	<	While done <= 1 do
1287	<	begin
1288	<	Inc(done);
1117	<	Inc(RunLen);
1118	<	case Integer(OutputBuffer[RunLen-1]) of
1284	>
1285	>	for i := 0 to FServiceQueryResults.Count - 1 do
1286	>	with FServiceQueryResults[i] do
1287	>	begin
1288	>	case getItemType of
1289		isc_info_svc_get_license_mask:
1290	<	FLicenseMaskInfo.LicenseMask := ParseInteger(RunLen);
1290	>	FLicenseMaskInfo.LicenseMask := AsInteger;
1291		isc_info_svc_capabilities:
1292	<	FLicenseMaskInfo.CapabilityMask := ParseInteger(RunLen);
1292	>	FLicenseMaskInfo.CapabilityMask := AsInteger;
1293		else
1294	<	IBError(ibxeOutputParsingError, [nil]);
1294	>	IBError(ibxeOutputParsingError, [getItemType]);
1295		end;
1296		end;
1297		end;
#	Line 1129 \| Line 1299 \| end;
1299
1300		procedure TIBServerProperties.FetchVersionInfo;
1301		var
1302	<	RunLen: Integer;
1133	<	done: Integer;
1302	>	i : Integer;
1303		begin
1304	<	ServiceQueryParams := Char(isc_info_svc_version) +
1305	<	Char(isc_info_svc_server_version) +
1306	<	Char(isc_info_svc_implementation);
1304	>	SRB.Add(isc_info_svc_version);
1305	>	SRB.Add(isc_info_svc_server_version);
1306	>	SRB.Add(isc_info_svc_implementation);
1307		InternalServiceQuery;
1139	–	RunLen := 0;
1140	–	done := 0;
1308
1309	<	While done <= 2 do
1309	>	for i := 0 to FServiceQueryResults.Count - 1 do
1310	>	with FServiceQueryResults[i] do
1311		begin
1312	<	Inc(done);
1145	<	Inc(RunLen);
1146	<	case Integer(OutputBuffer[RunLen-1]) of
1312	>	case getItemType of
1313		isc_info_svc_version:
1314	<	FVersionInfo.ServiceVersion := ParseInteger(RunLen);
1314	>	FVersionInfo.ServiceVersion := AsInteger;
1315		isc_info_svc_server_version:
1316	<	FVersionInfo.ServerVersion := ParseString(RunLen);
1316	>	FVersionInfo.ServerVersion := AsString;
1317		isc_info_svc_implementation:
1318	<	FVersionInfo.ServerImplementation := ParseString(RunLen);
1318	>	FVersionInfo.ServerImplementation := AsString;
1319		else
1320	<	IBError(ibxeOutputParsingError, [nil]);
1320	>	IBError(ibxeOutputParsingError, [getItemType]);
1321		end;
1322		end;
1323		end;
1324
1325		{ TIBControlService }
1326	+
1327		procedure TIBControlService.SetServiceStartOptions;
1328		begin
1329
1330		end;
1331
1332		function TIBControlService.GetIsServiceRunning: Boolean;
1166	–	var
1167	–	RunLen: Integer;
1333		begin
1334	<	ServiceQueryParams := Char(isc_info_svc_running);
1334	>	SRB.Add(isc_info_svc_running);
1335		InternalServiceQuery;
1171	–	if (OutputBuffer[0] <> Char(isc_info_svc_running)) then
1172	–	IBError(ibxeOutputParsingError, [nil]);
1173	–	RunLen := 1;
1174	–	if (ParseInteger(RunLen) = 1) then
1175	–	result := True
1176	–	else
1177	–	result := False;
1178	–	end;
1336
1337	<	procedure TIBControlService.ServiceStartAddParam (Value: string; param: Integer);
1338	<	var
1339	<	Len: UShort;
1183	<	begin
1184	<	Len := Length(Value);
1185	<	if Len > 0 then
1186	<	begin
1187	<	FStartParams := FStartParams +
1188	<	Char(Param) +
1189	<	PChar(@Len)[0] +
1190	<	PChar(@Len)[1] +
1191	<	Value;
1192	<	end;
1337	>	Result := (FServiceQueryResults.Count > 0) and
1338	>	(FServiceQueryResults[0].getItemType = isc_info_svc_running) and
1339	>	(FServiceQueryResults[0].AsInteger = 1);
1340		end;
1341
1342	<	procedure TIBControlService.ServiceStartAddParam (Value: Integer; param: Integer);
1342	>	procedure TIBControlService.CheckServiceNotRunning;
1343		begin
1344	<	FStartParams := FStartParams +
1345	<	Char(Param) +
1199	<	PChar(@Value)[0] +
1200	<	PChar(@Value)[1] +
1201	<	PChar(@Value)[2] +
1202	<	PChar(@Value)[3];
1344	>	if IsServiceRunning then
1345	>	IBError(ibxeServiceRunning,[nil]);
1346		end;
1347
1348		constructor TIBControlService.Create(AOwner: TComponent);
1349		begin
1350		inherited create(AOwner);
1351	<	FStartParams := '';
1209	<	FStartSPB := nil;
1210	<	FStartSPBLength := 0;
1351	>	FSRB := nil;
1352		end;
1353
1354		procedure TIBControlService.InternalServiceStart;
1355		begin
1356	<	FStartSPBLength := Length(FStartParams);
1216	<	if FStartSPBLength = 0 then
1356	>	if SRB = nil then
1357		IBError(ibxeStartParamsError, [nil]);
1358	<	IBAlloc(FStartSPB, 0, FStartSPBLength);
1219	<	Move(FStartParams[1], FStartSPB[0], FstartSPBLength);
1358	>
1359		try
1360	<	if call(isc_service_start(StatusVector, @FHandle, nil,
1222	<	FStartSPBLength, FStartSPB), False) > 0 then
1223	<	begin
1224	<	FHandle := nil;
1225	<	IBDataBaseError;
1226	<	end;
1360	>	FService.Start(SRB);
1361		finally
1362	<	FreeMem(FStartSPB);
1229	<	FStartSPB := nil;
1230	<	FStartSPBLength := 0;
1231	<	FStartParams := '';
1362	>	FSRB := nil;
1363		end;
1364		MonitorHook.ServiceStart(Self);
1365		end;
#	Line 1236 \| Line 1367 \| end;
1367		procedure TIBControlService.ServiceStart;
1368		begin
1369		CheckActive;
1370	+	CheckServiceNotRunning;
1371		SetServiceStartOptions;
1372		InternalServiceStart;
1373		end;
#	Line 1249 \| Line 1381 \| end;
1381
1382		procedure TIBConfigService.ActivateShadow;
1383		begin
1384	<	ServiceStartParams := Char(isc_action_svc_properties);
1385	<	ServiceStartAddParam (FDatabaseName, SPBConstantValues[isc_spb_dbname]);
1386	<	ServiceStartAddParam (isc_spb_prp_activate, SPBConstantValues[isc_spb_options]);
1384	>	SRB.Add(isc_action_svc_properties);
1385	>	SRB.Add(isc_spb_dbname).AsString := FDatabaseName;
1386	>	SRB.Add(isc_spb_options).AsInteger := isc_spb_prp_activate;
1387		InternalServiceStart;
1388		end;
1389
1390		procedure TIBConfigService.BringDatabaseOnline;
1391		begin
1392	<	ServiceStartParams := Char(isc_action_svc_properties);
1393	<	ServiceStartAddParam (FDatabaseName, SPBConstantValues[isc_spb_dbname]);
1394	<	ServiceStartAddParam (isc_spb_prp_db_online, SPBConstantValues[isc_spb_options]);
1392	>	SRB.Add(isc_action_svc_properties);
1393	>	SRB.Add(isc_spb_dbname).AsString := FDatabaseName;
1394	>	SRB.Add(isc_spb_options).AsInteger := isc_spb_prp_db_online;
1395		InternalServiceStart;
1396		end;
1397
1398		procedure TIBConfigService.SetAsyncMode(Value: Boolean);
1399		begin
1400	<	ServiceStartParams := Char(isc_action_svc_properties);
1401	<	ServiceStartAddParam (FDatabaseName, SPBConstantValues[isc_spb_dbname]);
1402	<	ServiceStartParams := ServiceStartParams +
1271	<	Char(isc_spb_prp_write_mode);
1400	>	SRB.Add(isc_action_svc_properties);
1401	>	SRB.Add(isc_spb_dbname).AsString := FDatabaseName;
1402	>	with SRB.Add(isc_spb_prp_write_mode) do
1403		if Value then
1404	<	ServiceStartParams := ServiceStartParams +
1274	<	Char(isc_spb_prp_wm_async)
1404	>	AsByte := isc_spb_prp_wm_async
1405		else
1406	<	ServiceStartParams := ServiceStartParams +
1277	<	Char(isc_spb_prp_wm_sync);
1406	>	AsByte := isc_spb_prp_wm_sync;
1407		InternalServiceStart;
1408		end;
1409
#	Line 1285 \| Line 1414 \| end;
1414
1415		procedure TIBConfigService.SetPageBuffers(Value: Integer);
1416		begin
1417	<	ServiceStartParams := Char(isc_action_svc_properties);
1418	<	ServiceStartAddParam (FDatabaseName, SPBConstantValues[isc_spb_dbname]);
1419	<	ServiceStartAddParam (Value, isc_spb_prp_page_buffers);
1417	>	SRB.Add(isc_action_svc_properties);
1418	>	SRB.Add(isc_spb_dbname).AsString := FDatabaseName;
1419	>	SRB.Add(isc_spb_prp_page_buffers).AsInteger := Value;
1420		InternalServiceStart;
1421		end;
1422
1423		procedure TIBConfigService.SetReadOnly(Value: Boolean);
1424		begin
1425	<	ServiceStartParams := Char(isc_action_svc_properties);
1426	<	ServiceStartAddParam (FDatabaseName, SPBConstantValues[isc_spb_dbname]);
1427	<	ServiceStartParams := ServiceStartParams +
1299	<	Char(isc_spb_prp_access_mode);
1425	>	SRB.Add(isc_action_svc_properties);
1426	>	SRB.Add(isc_spb_dbname).AsString := FDatabaseName;
1427	>	with SRB.Add(isc_spb_prp_access_mode) do
1428		if Value then
1429	<	ServiceStartParams := ServiceStartParams +
1302	<	Char(isc_spb_prp_am_readonly)
1429	>	AsByte := isc_spb_prp_am_readonly
1430		else
1431	<	ServiceStartParams := ServiceStartParams +
1432	<	Char(isc_spb_prp_am_readwrite);
1431	>	AsByte := isc_spb_prp_am_readwrite;
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	<	ServiceStartParams := Char(isc_action_svc_properties);
1458	<	ServiceStartAddParam (FDatabaseName, SPBConstantValues[isc_spb_dbname]);
1459	<	ServiceStartParams := ServiceStartParams +
1314	<	Char(isc_spb_prp_reserve_space);
1457	>	SRB.Add(isc_action_svc_properties);
1458	>	SRB.Add(isc_spb_dbname).AsString := FDatabaseName;
1459	>	with SRB.Add(isc_spb_prp_reserve_space) do
1460		if Value then
1461	<	ServiceStartParams := ServiceStartParams +
1317	<	Char(isc_spb_prp_res)
1461	>	AsByte := isc_spb_prp_res
1462		else
1463	<	ServiceStartParams := ServiceStartParams +
1320	<	Char(isc_spb_prp_res_use_full);
1463	>	AsByte := isc_spb_prp_res_use_full;
1464		InternalServiceStart;
1465		end;
1466
1467		procedure TIBConfigService.SetSweepInterval(Value: Integer);
1468		begin
1469	<	ServiceStartParams := Char(isc_action_svc_properties);
1470	<	ServiceStartAddParam (FDatabaseName, SPBConstantValues[isc_spb_dbname]);
1471	<	ServiceStartAddParam (Value, isc_spb_prp_sweep_interval);
1469	>	SRB.Add(isc_action_svc_properties);
1470	>	SRB.Add(isc_spb_dbname).AsString := FDatabaseName;
1471	>	SRB.Add(isc_spb_prp_sweep_interval).AsInteger := Value;
1472		InternalServiceStart;
1473		end;
1474
1475		procedure TIBConfigService.SetDBSqlDialect(Value: Integer);
1476		begin
1477	<	ServiceStartParams := Char(isc_action_svc_properties);
1478	<	ServiceStartAddParam (FDatabaseName, SPBConstantValues[isc_spb_dbname]);
1479	<	ServiceStartAddParam (Value, isc_spb_prp_set_sql_dialect);
1477	>	SRB.Add(isc_action_svc_properties);
1478	>	SRB.Add(isc_spb_dbname).AsString := FDatabaseName;
1479	>	SRB.Add(isc_spb_prp_set_sql_dialect).AsInteger := Value;
1480		InternalServiceStart;
1481		end;
1482
1483		procedure TIBConfigService.ShutdownDatabase(Options: TShutdownMode;
1484		Wait: Integer);
1485		begin
1486	<	ServiceStartParams := Char(isc_action_svc_properties);
1487	<	ServiceStartAddParam (FDatabaseName, SPBConstantValues[isc_spb_dbname]);
1486	>	SRB.Add(isc_action_svc_properties);
1487	>	SRB.Add(isc_spb_dbname).AsString := FDatabaseName;
1488		if (Options = Forced) then
1489	<	ServiceStartAddParam (Wait, isc_spb_prp_shutdown_db)
1489	>	SRB.Add(isc_spb_prp_shutdown_db).AsInteger := Wait
1490		else if (Options = DenyTransaction) then
1491	<	ServiceStartAddParam (Wait, isc_spb_prp_deny_new_transactions)
1491	>	SRB.Add(isc_spb_prp_deny_new_transactions).AsInteger := Wait
1492		else
1493	<	ServiceStartAddParam (Wait, isc_spb_prp_deny_new_attachments);
1493	>	SRB.Add(isc_spb_prp_deny_new_attachments).AsInteger := Wait;
1494		InternalServiceStart;
1495		end;
1496
1497	+
1498		{ TIBStatisticalService }
1499
1500		procedure TIBStatisticalService.SetDatabaseName(const Value: string);
#	Line 1359 \| Line 1503 \| begin
1503		end;
1504
1505		procedure TIBStatisticalService.SetServiceStartOptions;
1506	<	var
1363	<	param: Integer;
1506	>	var param: integer;
1507		begin
1508		if FDatabaseName = '' then
1509		IBError(ibxeStartParamsError, [nil]);
1510	+
1511		param := 0;
1512		if (DataPages in Options) then
1513		param := param or isc_spb_sts_data_pages;
1514	<	if (DbLog in Options) then
1515	<	param := param or isc_spb_sts_db_log;
1514	>	{ if (DbLog in Options) then
1515	>	param := param or isc_spb_sts_db_log; -- removed from Firebird 2}
1516		if (HeaderPages in Options) then
1517		param := param or isc_spb_sts_hdr_pages;
1518		if (IndexPages in Options) then
#	Line 1376 \| Line 1520 \| begin
1520		if (SystemRelations in Options) then
1521		param := param or isc_spb_sts_sys_relations;
1522		Action := isc_action_svc_db_stats;
1523	<	ServiceStartParams := Char(isc_action_svc_db_stats);
1524	<	ServiceStartAddParam (FDatabaseName, SPBConstantValues[isc_spb_dbname]);
1525	<	ServiceStartAddParam (param, SPBConstantValues[isc_spb_options]);
1523	>	SRB.Add(isc_action_svc_db_stats);
1524	>	SRB.Add(isc_spb_dbname).AsString := FDatabaseName;
1525	>	SRB.Add(isc_spb_options).AsInteger := param;
1526		end;
1527
1528		{ TIBBackupService }
#	Line 1404 \| 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	<	ServiceStartParams := Char(isc_action_svc_backup);
1560	<	ServiceStartAddParam(FDatabaseName, SPBConstantValues[isc_spb_dbname]);
1561	<	ServiceStartAddParam(param, SPBConstantValues[isc_spb_options]);
1562	<	if Verbose then
1563	<	ServiceStartParams := ServiceStartParams + Char(SPBConstantValues[isc_spb_verbose]);
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	<	ServiceStartAddParam(FBlockingFactor, isc_spb_bkp_factor);
1568	>	SRB.Add(isc_spb_bkp_factor).AsInteger := FBlockingFactor;
1569	>	if BackupFileLocation = flServerSide then
1570		for i := 0 to FBackupFile.Count - 1 do
1571		begin
1572		if (Trim(FBackupFile[i]) = '') then
1573		continue;
1574		if (Pos('=', FBackupFile[i]) <> 0) then
1575		begin {mbcs ok}
1576	<	ServiceStartAddParam(FBackupFile.Names[i], isc_spb_bkp_file);
1576	>	SRB.Add(isc_spb_bkp_file).AsString := FBackupFile.Names[i];
1577		value := Copy(FBackupFile[i], Pos('=', FBackupFile[i]) + 1, Length(FBackupFile.Names[i])); {mbcs ok}
1578	<	param := StrToInt(value);
1424	<	ServiceStartAddParam(param, isc_spb_bkp_length);
1578	>	SRB.Add(isc_spb_bkp_length).AsInteger := StrToInt(value);;
1579		end
1580		else
1581	<	ServiceStartAddParam(FBackupFile[i], isc_spb_bkp_file);
1582	<	end;
1581	>	SRB.Add(isc_spb_bkp_file).AsString := FBackupFile[i];
1582	>	end
1583	>	else
1584	>	SRB.Add(isc_spb_bkp_file).AsString := 'stdout';
1585		end;
1586
1587		constructor TIBBackupService.Create(AOwner: TComponent);
#	Line 1467 \| 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	<	ServiceStartParams := Char(isc_action_svc_restore);
1630	<	ServiceStartAddParam(param, SPBConstantValues[isc_spb_options]);
1631	<	if Verbose then ServiceStartParams := ServiceStartParams + Char(SPBConstantValues[isc_spb_verbose]);
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	<	ServiceStartAddParam(FPageSize, isc_spb_res_page_size);
1637	>	SRB.Add(isc_spb_res_page_size).AsInteger := FPageSize;
1638		if FPageBuffers > 0 then
1639	<	ServiceStartAddParam(FPageBuffers, isc_spb_res_buffers);
1639	>	SRB.Add(isc_spb_res_buffers).AsInteger := FPageBuffers;
1640	>	if BackupFileLocation = flServerSide then
1641		for i := 0 to FBackupFile.Count - 1 do
1642		begin
1643		if (Trim(FBackupFile[i]) = '') then continue;
1644		if (Pos('=', FBackupFile[i]) <> 0) then {mbcs ok}
1645		begin
1646	<	ServiceStartAddParam(FBackupFile.Names[i], isc_spb_bkp_file);
1646	>	SRB.Add(isc_spb_bkp_file).AsString := FBackupFile.Names[i];
1647		value := Copy(FBackupFile[i], Pos('=', FBackupFile[i]) + 1, Length(FBackupFile.Names[i])); {mbcs ok}
1648	<	param := StrToInt(value);
1486	<	ServiceStartAddParam(param, isc_spb_bkp_length);
1648	>	SRB.Add(isc_spb_bkp_length).AsInteger := StrToInt(value);;
1649		end
1650		else
1651	<	ServiceStartAddParam(FBackupFile[i], isc_spb_bkp_file);
1652	<	end;
1651	>	SRB.Add(isc_spb_bkp_file).AsString := FBackupFile[i];
1652	>	end
1653	>	else
1654	>	SRB.Add(isc_spb_bkp_file).AsString := 'stdin';
1655	>
1656		for i := 0 to FDatabaseName.Count - 1 do
1657		begin
1658		if (Trim(FDatabaseName[i]) = '') then continue;
1659		if (Pos('=', FDatabaseName[i]) <> 0) then {mbcs ok}
1660	<	begin
1661	<	ServiceStartAddParam(FDatabaseName.Names[i], SPBConstantValues[isc_spb_dbname]);
1660	>	begin
1661	>	SRB.Add(isc_spb_dbname).AsString := FDatabaseName.Names[i];
1662		value := Copy(FDatabaseName[i], Pos('=', FDatabaseName[i]) + 1, Length(FDatabaseName[i])); {mbcs ok}
1663	<	param := StrToInt(value);
1499	<	ServiceStartAddParam(param, isc_spb_res_length);
1663	>	SRB.Add(isc_spb_res_length).AsInteger := StrToInt(value);
1664		end
1665		else
1666	<	ServiceStartAddParam(FDatabaseName[i], SPBConstantValues[isc_spb_dbname]);
1666	>	SRB.Add(isc_spb_dbname).AsString := FDatabaseName[i];
1667		end;
1668		end;
1669
#	Line 1518 \| Line 1682 \| begin
1682		inherited Destroy;
1683		end;
1684
1685	+	function TIBRestoreService.SendNextChunk(stream: TStream; var line: String
1686	+	): integer;
1687	+	var
1688	+	i: Integer;
1689	+	begin
1690	+	Result := 0;
1691	+	line := '';
1692	+	if (FEof = True) then
1693	+	exit;
1694	+
1695	+	if (FAction = 0) then
1696	+	IBError(ibxeQueryParamsError, [nil]);
1697	+
1698	+	SRB.Add(isc_info_svc_line);
1699	+	SRB.Add(isc_info_svc_stdin);
1700	+
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	+	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
1713	+	with FServiceQueryResults[i] do
1714	+	begin
1715	+	case getItemType of
1716	+	isc_info_svc_line:
1717	+	line := AsString;
1718	+
1719	+	isc_info_svc_stdin:
1720	+	FSendBytes := AsInteger;
1721	+
1722	+	isc_info_svc_timeout,
1723	+	isc_info_data_not_ready:
1724	+	{ignore};
1725	+	else
1726	+	IBError(ibxeOutputParsingError, [getItemType]);
1727	+	end;
1728	+	end;
1729	+	FEOF := (FSendBytes = 0) and (line = '');
1730	+	end;
1731	+
1732		procedure TIBRestoreService.SetBackupFile(const Value: TStrings);
1733		begin
1734		FBackupFile.Assign(Value);
#	Line 1545 \| Line 1756 \| begin
1756		end;
1757
1758		procedure TIBValidationService.FetchLimboTransactionInfo;
1759	+
1760	+	procedure NextLimboTransaction(index: integer);
1761	+	begin
1762	+	SetLength(FLimboTransactionInfo, index+1);
1763	+	FLimboTransactionInfo[index] := TLimboTransactionInfo.Create;
1764	+	{ if no advice commit as default }
1765	+	FLimboTransactionInfo[index].Advise := UnknownAdvise;
1766	+	FLimboTransactionInfo[index].Action:= CommitAction;
1767	+	end;
1768	+
1769		var
1770	<	i, RunLen: Integer;
1550	<	Value: Char;
1770	>	i,j, k: Integer;
1771		begin
1552	–	ServiceQueryParams := Char(isc_info_svc_limbo_trans);
1553	–	InternalServiceQuery;
1554	–	RunLen := 0;
1555	–	if (OutputBuffer[RunLen] <> Char(isc_info_svc_limbo_trans)) then
1556	–	IBError(ibxeOutputParsingError, [nil]);
1557	–	Inc(RunLen, 3);
1772		for i := 0 to High(FLimboTransactionInfo) do
1773		FLimboTransactionInfo[i].Free;
1774	<	FLimboTransactionInfo := nil;
1775	<	i := 0;
1776	<	while (OutputBuffer[RunLen] <> Char(isc_info_end)) do
1777	<	begin
1778	<	if (i >= Length(FLimboTransactionInfo)) then
1779	<	SetLength(FLimboTransactionInfo, i + 10);
1780	<	if FLimboTransactionInfo[i] = nil then
1781	<	FLimboTransactionInfo[i] := TLimboTransactionInfo.Create;
1782	<	with FLimboTransactionInfo[i] do
1774	>	SetLength(FLimboTransactionInfo,0);
1775	>
1776	>	SRB.Add(isc_info_svc_limbo_trans);
1777	>	InternalServiceQuery;
1778	>
1779	>	k := -1;
1780	>	for i := 0 to FServiceQueryResults.Count - 1 do
1781	>	with FServiceQueryResults[i] do
1782	>	case getItemType of
1783	>	isc_info_svc_limbo_trans:
1784		begin
1785	<	if (OutputBuffer[RunLen] = Char(isc_spb_single_tra_id)) then
1786	<	begin
1787	<	Inc(RunLen);
1573	<	MultiDatabase := False;
1574	<	ID := ParseInteger(RunLen);
1575	<	end
1576	<	else
1785	>	if FServiceQueryResults[i].Count = 0 then continue;
1786	>	NextLimboTransaction(0);
1787	>	for j := 0 to FServiceQueryResults[i].Count - 1 do
1788		begin
1789	<	Inc(RunLen);
1579	<	MultiDatabase := True;
1580	<	ID := ParseInteger(RunLen);
1581	<	HostSite := ParseString(RunLen);
1582	<	if (OutputBuffer[RunLen] <> Char(isc_spb_tra_state)) then
1583	<	IBError(ibxeOutputParsingError, [nil]);
1584	<	Inc(RunLen);
1585	<	Value := OutputBuffer[RunLen];
1586	<	Inc(RunLen);
1587	<	if (Value = Char(isc_spb_tra_state_limbo)) then
1588	<	State := LimboState
1589	<	else
1590	<	if (Value = Char(isc_spb_tra_state_commit)) then
1591	<	State := CommitState
1592	<	else
1593	<	if (Value = Char(isc_spb_tra_state_rollback)) then
1594	<	State := RollbackState
1595	<	else
1596	<	State := UnknownState;
1597	<	RemoteSite := ParseString(RunLen);
1598	<	RemoteDatabasePath := ParseString(RunLen);
1599	<	Value := OutputBuffer[RunLen];
1600	<	Inc(RunLen);
1601	<	if (Value = Char(isc_spb_tra_advise_commit)) then
1789	>	with FServiceQueryResults[i][j] do
1790		begin
1791	<	Advise := CommitAdvise;
1792	<	Action:= CommitAction;
1793	<	end
1794	<	else
1795	<	if (Value = Char(isc_spb_tra_advise_rollback)) then
1796	<	begin
1797	<	Advise := RollbackAdvise;
1798	<	Action := RollbackAction;
1799	<	end
1800	<	else
1801	<	begin
1802	<	{ if no advice commit as default }
1803	<	Advise := UnknownAdvise;
1804	<	Action:= CommitAction;
1791	>	case getItemType of
1792	>	isc_spb_single_tra_id:
1793	>	begin
1794	>	Inc(k);
1795	>	if k > 0 then
1796	>	NextLimboTransaction(k);
1797	>	FLimboTransactionInfo[k].MultiDatabase := False;
1798	>	FLimboTransactionInfo[k].ID := AsInteger;
1799	>	end;
1800	>
1801	>	isc_spb_multi_tra_id:
1802	>	begin
1803	>	Inc(k);
1804	>	if k > 0 then
1805	>	NextLimboTransaction(k);
1806	>	FLimboTransactionInfo[k].MultiDatabase := True;
1807	>	FLimboTransactionInfo[k].ID := AsInteger;
1808	>	end;
1809	>
1810	>	isc_spb_tra_host_site:
1811	>	FLimboTransactionInfo[k].HostSite := AsString;
1812	>
1813	>	isc_spb_tra_state:
1814	>	case AsByte of
1815	>	isc_spb_tra_state_limbo:
1816	>	FLimboTransactionInfo[k].State := LimboState;
1817	>
1818	>	isc_spb_tra_state_commit:
1819	>	FLimboTransactionInfo[k].State := CommitState;
1820	>
1821	>	isc_spb_tra_state_rollback:
1822	>	FLimboTransactionInfo[k].State := RollbackState;
1823	>
1824	>	else
1825	>	FLimboTransactionInfo[k].State := UnknownState;
1826	>	end;
1827	>
1828	>	isc_spb_tra_remote_site:
1829	>	FLimboTransactionInfo[k].RemoteSite := AsString;
1830	>
1831	>	isc_spb_tra_db_path:
1832	>	FLimboTransactionInfo[k].RemoteDatabasePath := AsString;
1833	>
1834	>	isc_spb_tra_advise:
1835	>	with FLimboTransactionInfo[k] do
1836	>	begin
1837	>	case (AsByte) of
1838	>	isc_spb_tra_advise_commit:
1839	>	begin
1840	>	Advise := CommitAdvise;
1841	>	Action:= CommitAction;
1842	>	end;
1843	>
1844	>	isc_spb_tra_advise_rollback:
1845	>	begin
1846	>	Advise := RollbackAdvise;
1847	>	Action := RollbackAction;
1848	>	end;
1849	>
1850	>	else
1851	>	Advise := UnknownAdvise;
1852	>	end;
1853	>	end;
1854	>
1855	>	else
1856	>	IBError(ibxeOutputParsingError, [getItemType]);
1857		end;
1858	+	end;
1859		end;
1619	–	Inc (i);
1860		end;
1861	+	else
1862	+	IBError(ibxeOutputParsingError, [getItemType]);
1863		end;
1622	–	if (i > 0) then
1623	–	SetLength(FLimboTransactionInfo, i+1);
1864		end;
1865
1866		procedure TIBValidationService.FixLimboTransactionErrors;
1867		var
1868		i: Integer;
1869		begin
1870	<	ServiceStartParams := Char(isc_action_svc_repair);
1871	<	ServiceStartAddParam (FDatabaseName, SPBConstantValues[isc_spb_dbname]);
1872	<	if (FGlobalAction = NoGlobalAction) then
1873	<	begin
1634	<	i := 0;
1635	<	while (FLimboTransactionInfo[i].ID <> 0) do
1870	>	SRB.Add(isc_action_svc_repair);
1871	>	SRB.Add(isc_spb_dbname).AsString := FDatabaseName;
1872	>	case FGlobalAction of
1873	>	NoGlobalAction:
1874		begin
1875	<	if (FLimboTransactionInfo[i].Action = CommitAction) then
1638	<	ServiceStartAddParam (FLimboTransactionInfo[i].ID, isc_spb_rpr_commit_trans)
1639	<	else
1640	<	ServiceStartAddParam (FLimboTransactionInfo[i].ID, isc_spb_rpr_rollback_trans);
1641	<	Inc(i);
1642	<	end;
1643	<	end
1644	<	else
1645	<	begin
1646	<	i := 0;
1647	<	if (FGlobalAction = CommitGlobal) then
1648	<	while (FLimboTransactionInfo[i].ID <> 0) do
1875	>	for i := 0 to LimboTransactionInfoCount - 1 do
1876		begin
1877	<	ServiceStartAddParam (FLimboTransactionInfo[i].ID, isc_spb_rpr_commit_trans);
1878	<	Inc(i);
1879	<	end
1880	<	else
1881	<	while (FLimboTransactionInfo[i].ID <> 0) do
1877	>	if (FLimboTransactionInfo[i].Action = CommitAction) then
1878	>	SRB.Add(isc_spb_rpr_commit_trans).AsInteger := FLimboTransactionInfo[i].ID
1879	>	else
1880	>	SRB.Add(isc_spb_rpr_rollback_trans).AsInteger := FLimboTransactionInfo[i].ID;
1881	>	end;
1882	>	end;
1883	>
1884	>	CommitGlobal:
1885	>	begin
1886	>	for i := 0 to LimboTransactionInfoCount - 1 do
1887	>	SRB.Add(isc_spb_rpr_commit_trans).AsInteger := FLimboTransactionInfo[i].ID;
1888	>	end;
1889	>
1890	>	RollbackGlobal:
1891		begin
1892	<	ServiceStartAddParam (FLimboTransactionInfo[i].ID, isc_spb_rpr_rollback_trans);
1893	<	Inc(i);
1892	>	for i := 0 to LimboTransactionInfoCount - 1 do
1893	>	SRB.Add(isc_spb_rpr_rollback_trans).AsInteger := FLimboTransactionInfo[i].ID;
1894		end;
1895	+
1896	+	RecoverTwoPhaseGlobal:
1897	+	begin
1898	+	for i := 0 to LimboTransactionInfoCount - 1 do
1899	+	SRB.Add(isc_spb_rpr_recover_two_phase).AsInteger := FLimboTransactionInfo[i].ID;
1900	+	end;
1901		end;
1902		InternalServiceStart;
1903		end;
#	Line 1670 \| Line 1912 \| end;
1912
1913		function TIBValidationService.GetLimboTransactionInfoCount: integer;
1914		begin
1915	<	Result := High(FLimboTransactionInfo);
1915	>	Result := Length(FLimboTransactionInfo);
1916		end;
1917
1918		procedure TIBValidationService.SetDatabaseName(const Value: string);
#	Line 1685 \| Line 1927 \| begin
1927		Action := isc_action_svc_repair;
1928		if FDatabaseName = '' then
1929		IBError(ibxeStartParamsError, [nil]);
1930	+	SRB.Add(isc_action_svc_repair);
1931	+	SRB.Add(isc_spb_dbname).AsString := FDatabaseName;
1932		param := 0;
1933		if (SweepDB in Options) then
1934		param := param or isc_spb_rpr_sweep_db;
1935		if (ValidateDB in Options) then
1936		param := param or isc_spb_rpr_validate_db;
1937	<	ServiceStartParams := Char(isc_action_svc_repair);
1694	<	ServiceStartAddParam (FDatabaseName, SPBConstantValues[isc_spb_dbname]);
1695	<	if param > 0 then
1696	<	ServiceStartAddParam (param, SPBConstantValues[isc_spb_options]);
1697	<	param := 0;
1937	>
1938		if (LimboTransactions in Options) then
1939		param := param or isc_spb_rpr_list_limbo_trans;
1940		if (CheckDB in Options) then
#	Line 1712 \| Line 1952 \| begin
1952		param := param or isc_spb_rpr_validate_db;
1953		end;
1954		if param > 0 then
1955	<	ServiceStartAddParam (param, SPBConstantValues[isc_spb_options]);
1955	>	SRB.Add(isc_spb_options).AsInteger := param;
1956		end;
1957
1958		{ TIBSecurityService }
#	Line 1729 \| Line 1969 \| begin
1969		for i := 0 to High(FUserInfo) do
1970		FUserInfo[i].Free;
1971		FUserInfo := nil;
1972	<	inherited destroy;
1972	>	inherited Destroy;
1973		end;
1974
1975		procedure TIBSecurityService.FetchUserInfo;
1976		var
1977	<	i, RunLen: Integer;
1977	>	i, j, k: Integer;
1978		begin
1979	<	ServiceQueryParams := Char(isc_info_svc_get_users);
1979	>	SRB.Add(isc_info_svc_get_users);
1980		InternalServiceQuery;
1981	<	RunLen := 0;
1742	<	if (OutputBuffer[RunLen] <> Char(isc_info_svc_get_users)) then
1743	<	IBError(ibxeOutputParsingError, [nil]);
1744	<	Inc(RunLen);
1981	>
1982		for i := 0 to High(FUserInfo) do
1983		FUserInfo[i].Free;
1984	<	FUserInfo := nil;
1985	<	i := 0;
1986	<	{ Don't have any use for the combined length
1987	<	so increment past by 2 }
1988	<	Inc(RunLen, 2);
1989	<	while (OutputBuffer[RunLen] <> Char(isc_info_end)) do
1990	<	begin
1991	<	if (i >= Length(FUSerInfo)) then
1992	<	SetLength(FUserInfo, i + 10);
1993	<	if (OutputBuffer[RunLen] <> Char(isc_spb_sec_username)) then
1994	<	IBError(ibxeOutputParsingError, [nil]);
1995	<	Inc(RunLen);
1996	<	if FUserInfo[i] = nil then
1997	<	FUserInfo[i] := TUserInfo.Create;
1998	<	FUserInfo[i].UserName := ParseString(RunLen);
1999	<	if (OutputBuffer[RunLen] <> Char(isc_spb_sec_firstname)) then
2000	<	IBError(ibxeOutputParsingError, [nil]);
2001	<	Inc(RunLen);
2002	<	FUserInfo[i].FirstName := ParseString(RunLen);
2003	<	if (OutputBuffer[RunLen] <> Char(isc_spb_sec_middlename)) then
2004	<	IBError(ibxeOutputParsingError, [nil]);
2005	<	Inc(RunLen);
2006	<	FUserInfo[i].MiddleName := ParseString(RunLen);
2007	<	if (OutputBuffer[RunLen] <> Char(isc_spb_sec_lastname)) then
2008	<	IBError(ibxeOutputParsingError, [nil]);
2009	<	Inc(RunLen);
2010	<	FUserInfo[i].LastName := ParseString(RunLen);
2011	<	if (OutputBuffer[RunLen] <> Char(isc_spb_sec_userId)) then
2012	<	IBError(ibxeOutputParsingError, [nil]);
2013	<	Inc(RunLen);
2014	<	FUserInfo[i].UserId := ParseInteger(RunLen);
2015	<	if (OutputBuffer[RunLen] <> Char(isc_spb_sec_groupid)) then
2016	<	IBError(ibxeOutputParsingError, [nil]);
2017	<	Inc(RunLen);
2018	<	FUserInfo[i].GroupID := ParseInteger(RunLen);
2019	<	Inc (i);
1984	>	for i := 0 to FServiceQueryResults.Count - 1 do
1985	>	with FServiceQueryResults[i] do
1986	>	begin
1987	>	case getItemType of
1988	>	isc_info_svc_get_users:
1989	>	begin
1990	>	SetLength(FUserInfo,1);
1991	>	k := 0;
1992	>	FUserInfo[0] := TUserInfo.Create;
1993	>	FUserInfo[0].UserName := '';
1994	>	for j := 0 to FServiceQueryResults[i].Count - 1 do
1995	>	begin
1996	>	with FServiceQueryResults[i][j] do
1997	>	case getItemType of
1998	>	isc_spb_sec_username:
1999	>	begin
2000	>	if FUserInfo[k].UserName <> '' then
2001	>	begin
2002	>	Inc(k);
2003	>	SetLength(FUserInfo,k+1);
2004	>	if FUserInfo[k] = nil then
2005	>	FUserInfo[k] := TUserInfo.Create;
2006	>	end;
2007	>	FUserInfo[k].UserName := AsString;
2008	>	end;
2009	>
2010	>	isc_spb_sec_firstname:
2011	>	FUserInfo[k].FirstName := AsString;
2012	>
2013	>	isc_spb_sec_middlename:
2014	>	FUserInfo[k].MiddleName := AsString;
2015	>
2016	>	isc_spb_sec_lastname:
2017	>	FUserInfo[k].LastName := AsString;
2018	>
2019	>	isc_spb_sec_userId:
2020	>	FUserInfo[k].UserId := AsInteger;
2021	>
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;
2031	>	end;
2032	>	end;
2033	>	else
2034	>	IBError(ibxeOutputParsingError, [getItemType]);
2035	>	end;
2036		end;
1784	–	if (i > 0) then
1785	–	SetLength(FUserInfo, i+1);
2037		end;
2038
2039		function TIBSecurityService.GetUserInfo(Index: Integer): TUserInfo;
#	Line 1795 \| Line 2046 \| end;
2046
2047		function TIBSecurityService.GetUserInfoCount: Integer;
2048		begin
2049	<	Result := High(FUSerInfo);
2049	>	Result := Length(FUserInfo);
2050		end;
2051
2052		procedure TIBSecurityService.AddUser;
#	Line 1813 \| Line 2064 \| end;
2064		procedure TIBSecurityService.DisplayUsers;
2065		begin
2066		SecurityAction := ActionDisplayUser;
2067	<	ServiceStartParams := Char(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	<	ServiceStartParams := Char(isc_action_svc_display_user);
2079	<	ServiceStartAddParam (UserName, isc_spb_sec_username);
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;
2085		end;
#	Line 1833 \| 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 1851 \| 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 1907 \| Line 2176 \| begin
2176		Len := Length(FUserName);
2177		if (Len = 0) then
2178		IBError(ibxeStartParamsError, [nil]);
2179	<	ServiceStartParams := Char(isc_action_svc_add_user);
2180	<	ServiceStartAddParam (FSQLRole, SPBConstantValues[isc_spb_sql_role_name]);
2181	<	ServiceStartAddParam (FUserName, isc_spb_sec_username);
2182	<	ServiceStartAddParam (FUserID, isc_spb_sec_userid);
2183	<	ServiceStartAddParam (FGroupID, isc_spb_sec_groupid);
2184	<	ServiceStartAddParam (FPassword, isc_spb_sec_password);
2185	<	ServiceStartAddParam (FFirstName, isc_spb_sec_firstname);
2186	<	ServiceStartAddParam (FMiddleName, isc_spb_sec_middlename);
2187	<	ServiceStartAddParam (FLastName, isc_spb_sec_lastname);
2179	>	SRB.Add(isc_action_svc_add_user);
2180	>	SRB.Add(isc_spb_sec_username).AsString := FUserName;
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 1923 \| Line 2195 \| begin
2195		Len := Length(FUserName);
2196		if (Len = 0) then
2197		IBError(ibxeStartParamsError, [nil]);
2198	<	ServiceStartParams := Char(isc_action_svc_delete_user);
2199	<	ServiceStartAddParam (FSQLRole, SPBConstantValues[isc_spb_sql_role_name]);
2200	<	ServiceStartAddParam (FUserName, isc_spb_sec_username);
2198	>	SRB.Add(isc_action_svc_delete_user);
2199	>	SRB.Add(isc_spb_sec_username).AsString := FUserName;
2200	>	if FSQLRole <> '' then
2201	>	SRB.Add(isc_spb_sql_role_name).AsString := FSQLRole;
2202		end;
2203		ActionModifyUser:
2204		begin
#	Line 1933 \| Line 2206 \| begin
2206		Len := Length(FUserName);
2207		if (Len = 0) then
2208		IBError(ibxeStartParamsError, [nil]);
2209	<	ServiceStartParams := Char(isc_action_svc_modify_user);
2210	<	ServiceStartAddParam (FSQLRole, SPBConstantValues[isc_spb_sql_role_name]);
2211	<	ServiceStartAddParam (FUserName, isc_spb_sec_username);
2209	>	SRB.Add(isc_action_svc_modify_user);
2210	>	SRB.Add(isc_spb_sec_username).AsString := FUserName;
2211	>	if FSQLRole <> '' then
2212	>	SRB.Add(isc_spb_sql_role_name).AsString := FSQLRole;
2213		if (ModifyUserId in FModifyParams) then
2214	<	ServiceStartAddParam (FUserID, isc_spb_sec_userid);
2214	>	SRB.Add(isc_spb_sec_userid).AsInteger := FUserID;
2215		if (ModifyGroupId in FModifyParams) then
2216	<	ServiceStartAddParam (FGroupID, isc_spb_sec_groupid);
2216	>	SRB.Add(isc_spb_sec_groupid).AsInteger := FGroupID;
2217		if (ModifyPassword in FModifyParams) then
2218	<	ServiceStartAddParam (FPassword, isc_spb_sec_password);
2218	>	SRB.Add(isc_spb_sec_password).AsString := FPassword;
2219		if (ModifyFirstName in FModifyParams) then
2220	<	ServiceStartAddParam (FFirstName, isc_spb_sec_firstname);
2220	>	SRB.Add(isc_spb_sec_firstname).AsString := FFirstName;
2221		if (ModifyMiddleName in FModifyParams) then
2222	<	ServiceStartAddParam (FMiddleName, isc_spb_sec_middlename);
2222	>	SRB.Add(isc_spb_sec_middlename).AsString := FMiddleName;
2223		if (ModifyLastName in FModifyParams) then
2224	<	ServiceStartAddParam (FLastName, isc_spb_sec_lastname);
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;
2235		end;
2236
2237		{ TIBUnStructuredService }
2238	<	constructor TIBControlAndQueryService.Create(AOwner: TComponent);
2238	>	constructor TIBControlAndQueryService.create(AOwner: TComponent);
2239		begin
2240		inherited Create(AOwner);
2241		FEof := False;
#	Line 1970 \| Line 2251 \| end;
2251
2252		function TIBControlAndQueryService.GetNextChunk: String;
2253		var
2254	<	Length: Integer;
2254	>	i: Integer;
2255		begin
2256		if (FEof = True) then
2257		begin
#	Line 1979 \| Line 2260 \| begin
2260		end;
2261		if (FAction = 0) then
2262		IBError(ibxeQueryParamsError, [nil]);
2263	<	ServiceQueryParams := Char(isc_info_svc_to_eof);
2263	>
2264	>	SRB.Add(isc_info_svc_to_eof);
2265		InternalServiceQuery;
2266	<	if (OutputBuffer[0] <> Char(isc_info_svc_to_eof)) then
2267	<	IBError(ibxeOutputParsingError, [nil]);
2268	<	Length := isc_vax_integer(OutputBuffer + 1, 2);
2269	<	if (OutputBuffer[3 + Length] = Char(isc_info_truncated)) then
2270	<	FEof := False
2271	<	else
2272	<	if (OutputBuffer[3 + Length] = Char(isc_info_end)) then
2273	<	FEof := True
2266	>
2267	>	FEof := True;
2268	>	for i := 0 to FServiceQueryResults.Count - 1 do
2269	>	with FServiceQueryResults[i] do
2270	>	begin
2271	>	case getItemType of
2272	>	isc_info_svc_to_eof:
2273	>	Result := AsString;
2274	>
2275	>	isc_info_truncated:
2276	>	FEof := False;
2277		else
2278	<	IBError(ibxeOutputParsingError, [nil]);
2279	<	OutputBuffer[3 + Length] := #0;
2280	<	result := String(PChar(@OutputBuffer[3]));
2278	>	IBError(ibxeOutputParsingError, [getItemType]);
2279	>	end;
2280	>	end;
2281		end;
2282
2283	<	function TIBControlAndQueryService.GetNextLine: String;
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	<	Length: Integer;
2291	>	i: Integer;
2292	>	TimeOut: boolean;
2293		begin
2294	+	result := 0;
2295	+	TimeOut := false;
2296		if (FEof = True) then
2003	–	begin
2004	–	result := '';
2297		exit;
2006	–	end;
2298		if (FAction = 0) then
2299		IBError(ibxeQueryParamsError, [nil]);
2300	<	ServiceQueryParams := Char(isc_info_svc_line);
2300	>
2301	>	SQPB.Add(isc_info_svc_timeout).AsInteger := 1;
2302	>	SRB.Add(isc_info_svc_to_eof);
2303		InternalServiceQuery;
2304	<	if (OutputBuffer[0] <> Char(isc_info_svc_line)) then
2305	<	IBError(ibxeOutputParsingError, [nil]);
2306	<	Length := isc_vax_integer(OutputBuffer + 1, 2);
2307	<	if (OutputBuffer[3 + Length] <> Char(isc_info_end)) then
2015	<	IBError(ibxeOutputParsingError, [nil]);
2016	<	if (length <> 0) then
2017	<	FEof := False
2018	<	else
2304	>
2305	>	FEof := True;
2306	>	for i := 0 to FServiceQueryResults.Count - 1 do
2307	>	with FServiceQueryResults[i] do
2308		begin
2309	<	result := '';
2310	<	FEof := True;
2309	>	case getItemType of
2310	>	isc_info_svc_to_eof:
2311	>	begin
2312	>	Result := CopyTo(stream,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	>	begin
2321	>	FEof := False;
2322	>	TimeOut := true;
2323	>	end
2324	>
2325	>	else
2326	>	IBError(ibxeOutputParsingError, [getItemType]);
2327	>	end;
2328	>	end;
2329	>	end;
2330	>
2331	>	function TIBControlAndQueryService.GetNextLine: String;
2332	>	var
2333	>	i: Integer;
2334	>	begin
2335	>	Result := '';
2336	>	if (FEof = True) then
2337		exit;
2338	+
2339	+	if (FAction = 0) then
2340	+	IBError(ibxeQueryParamsError, [nil]);
2341	+
2342	+	SRB.Add(isc_info_svc_line);
2343	+	InternalServiceQuery;
2344	+
2345	+	for i := 0 to FServiceQueryResults.Count - 1 do
2346	+	with FServiceQueryResults[i] do
2347	+	begin
2348	+	case getItemType of
2349	+	isc_info_svc_line:
2350	+	Result := AsString;
2351	+	else
2352	+	IBError(ibxeOutputParsingError, [getItemType]);
2353	+	end;
2354		end;
2355	<	OutputBuffer[3 + Length] := #0;
2025	<	result := String(PChar(@OutputBuffer[3]));
2355	>	FEOF := Result = '';
2356		end;
2357
2358		{ TIBLogService }
#	Line 2030 \| Line 2360 \| end;
2360		procedure TIBLogService.SetServiceStartOptions;
2361		begin
2362		Action := isc_action_svc_get_ib_log;
2363	<	ServiceStartParams := Char(isc_action_svc_get_ib_log);
2363	>	SRB.Add(isc_action_svc_get_ib_log);
2364		end;
2365
2366		{ TDatabaseInfo }
#	Line 2043 \| Line 2373 \| end;
2373		destructor TDatabaseInfo.Destroy;
2374		begin
2375		DbName := nil;
2376	<	inherited;
2376	>	inherited Destroy;
2377		end;
2378
2379		{ TLicenseInfo }
#	Line 2060 \| Line 2390 \| begin
2390		Key := nil;
2391		Id := nil;
2392		Desc := nil;
2393	<	inherited;
2393	>	inherited Destroy;
2394		end;
2395
2396		{ TConfigFileData }
#	Line 2075 \| Line 2405 \| destructor TConfigFileData.Destroy;
2405		begin
2406		ConfigFileValue := nil;
2407		ConfigFileKey := nil;
2408	<	inherited;
2408	>	inherited Destroy;
2409		end;
2410
2411		{ TConfigParams }
#	Line 2090 \| Line 2420 \| destructor TConfigParams.Destroy;
2420		begin
2421		ConfigFileData.Free;
2422		ConfigFileParams := nil;
2423	<	inherited;
2423	>	inherited Destroy;
2424		end;
2425
2426		end.

Diff Legend

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

Comparing ibx/trunk/runtime/IBServices.pas (file contents): Revision 1 by tony, Mon Jul 31 16:43:00 2000 UTC vs. Revision 143 by tony, Fri Feb 23 12:11:21 2018 UTC

Diff Legend

Comparing ibx/trunk/runtime/IBServices.pas (file contents):
Revision 1 by tony, Mon Jul 31 16:43:00 2000 UTC vs.
Revision 143 by tony, Fri Feb 23 12:11:21 2018 UTC