@@ -96,15 +96,18 @@ TAppService = class
96
96
fOnStop : TSvcAnonMethod;
97
97
fOnExecute : TSvcAnonMethod;
98
98
fAfterRemove : TSvcRemoveEvent;
99
+ fServiceDescription : string;
99
100
procedure ReportSvcStatus (dwCurrentState, dwWin32ExitCode, dwWaitHint: DWORD);
100
101
procedure Execute ;
101
102
procedure Help ;
102
103
procedure DoStop ;
104
+ procedure SetServiceDescription ;
103
105
public
104
106
constructor Create;
105
107
destructor Destroy; override;
106
108
property ServiceName : string read fServiceName write fServiceName;
107
109
property DisplayName : string read fDisplayName write fDisplayName;
110
+ property ServiceDescription : string read fServiceDescription write fServiceDescription;
108
111
property LoadOrderGroup : string read fLoadOrderGroup write fLoadOrderGroup;
109
112
property Dependencies : string read fDependencies write fDependencies;
110
113
property DesktopInteraction : Boolean read fDesktopInteraction write fDesktopInteraction;
@@ -138,6 +141,11 @@ TAppService = class
138
141
139
142
implementation
140
143
144
+ { $IFDEF MSWINDOWS}
145
+ uses
146
+ Registry;
147
+ { $ENDIF}
148
+
141
149
procedure ServiceCtrlHandler (Control: DWORD); stdcall;
142
150
begin
143
151
case Control of
@@ -242,6 +250,27 @@ procedure TAppService.ReportSvcStatus(dwCurrentState, dwWin32ExitCode, dwWaitHin
242
250
SetServiceStatus(StatusHandle,ServiceStatus);
243
251
end ;
244
252
253
+ procedure TAppService.SetServiceDescription ;
254
+ { $IFDEF MSWINDOWS}
255
+ var
256
+ reg: TRegistry;
257
+ { $ENDIF}
258
+ begin
259
+ { $IFDEF MSWINDOWS}
260
+ reg := TRegistry.Create(KEY_READ or KEY_WRITE);
261
+ try
262
+ reg.RootKey := HKEY_LOCAL_MACHINE;
263
+ if reg.OpenKey(' \SYSTEM\CurrentControlSet\Services\' + fServiceName, False) then
264
+ begin
265
+ reg.WriteString(' Description' , fServiceDescription);
266
+ reg.CloseKey;
267
+ end ;
268
+ finally
269
+ reg.Free;
270
+ end ;
271
+ { $ENDIF}
272
+ end ;
273
+
245
274
procedure TAppService.Execute ;
246
275
begin
247
276
// we have to do something or service will stop
@@ -320,7 +349,7 @@ procedure TAppService.Install;
320
349
end ;
321
350
// service interacts with desktop
322
351
if fDesktopInteraction then servicetype := SERVICE_WIN32_OWN_PROCESS and SERVICE_INTERACTIVE_PROCESS
323
- else servicetype := SERVICE_WIN32_OWN_PROCESS;
352
+ else servicetype := SERVICE_WIN32_OWN_PROCESS;
324
353
// service load order
325
354
if fLoadOrderGroup.IsEmpty then svcloadgroup := nil
326
355
else svcloadgroup := PChar(fLoadOrderGroup);
@@ -333,7 +362,7 @@ procedure TAppService.Install;
333
362
// service user password
334
363
if fUserPass.IsEmpty then svcuserpass := nil
335
364
else svcuserpass := PChar(fUserPass);
336
-
365
+
337
366
fSvHandle := CreateService(fSCMHandle,
338
367
PChar(fServiceName),
339
368
PChar(fDisplayName),
@@ -348,6 +377,9 @@ procedure TAppService.Install;
348
377
svcusername, // user
349
378
svcuserpass); // password
350
379
380
+ if Length(fServiceDescription) > 0 then
381
+ SetServiceDescription;
382
+
351
383
if fSvHandle <> 0 then
352
384
begin
353
385
if fSilent then Writeln(Format(cInstallMsg,[fServiceName]))
@@ -364,7 +396,7 @@ procedure TAppService.Help;
364
396
WriteLn(' [/instance:<service name>]' +#9 +' Install service with a custom name' );
365
397
end
366
398
else Writeln(Format(' %s [/console] [/install] [/remove] [/h] [/help]' ,[ExtractFileName(ParamStr(0 ))]));
367
- WriteLn(' [/console]' +#9 #9 #9 +' Force run as a console application (when runned from another service)' );
399
+ WriteLn(' [/console]' +#9 #9 #9 +' Force run as a console application (when run from another service)' );
368
400
WriteLn(' [/install]' +#9 #9 #9 +' Install as a service' );
369
401
WriteLn(' [/remove]' +#9 #9 #9 +' Remove service' );
370
402
WriteLn(' [/h /help]' +#9 #9 #9 +' This help' );
0 commit comments