program Service;
uses
Windows,
WinSvc;
const
ServiceName: pchar = 'AFX Service';
DisplayName: pchar = 'AFX
Demo Service';
var
Status: TServiceStatus;
StatusHandle:
SERVICE_STATUS_HANDLE;
ServiceTable: array [0..1] of
TServiceTableEntry;
Stopped: boolean;
Paused: boolean;
procedure ServiceMain;
begin
repeat
if not Paused then
begin
Beep(1000, 1000);
Sleep(1000);
end;
until
Stopped;
end;
procedure ServiceCtrlHandler(Control: dword); stdcall;
begin
case
Control of
SERVICE_CONTROL_STOP:
begin
Stopped :=
True;
Status.dwCurrentState := SERVICE_STOP_PENDING;
SetServiceStatus(StatusHandle, Status);
end;
SERVICE_CONTROL_PAUSE:
begin
Paused := True;
Status.dwcurrentstate := SERVICE_PAUSED;
SetServiceStatus(StatusHandle, Status);
end;
SERVICE_CONTROL_CONTINUE:
begin
Paused := False;
Status.dwCurrentState := SERVICE_RUNNING;
SetServiceStatus(StatusHandle, Status);
end;
SERVICE_CONTROL_INTERROGATE: SetServiceStatus(StatusHandle, Status);
SERVICE_CONTROL_SHUTDOWN: Stopped := True;
end;
end;
procedure ServiceCtrlDispatcher(dwArgc: dword; var lpszArgv: pchar);
stdcall;
begin
StatusHandle := RegisterServiceCtrlHandler(ServiceName,
@ServiceCtrlHandler);
if StatusHandle <> 0 then
begin
ZeroMemory(@Status, SizeOf(Status));
Status.dwServiceType :=
SERVICE_WIN32_OWN_PROCESS or SERVICE_INTERACTIVE_PROCESS;
Status.dwCurrentState:= SERVICE_START_PENDING;
Status.dwControlsAccepted
:= SERVICE_ACCEPT_STOP or SERVICE_ACCEPT_PAUSE_CONTINUE;
Status.dwWaitHint := 1000;
SetServiceStatus(StatusHandle, Status);
Stopped := False;
Paused := False;
Status.dwCurrentState :=
SERVICE_RUNNING;
SetServiceStatus(StatusHandle, Status);
ServiceMain;
Status.dwCurrentState := SERVICE_STOPPED;
SetServiceStatus(StatusHandle, Status);
end;
end;
procedure UninstallService(ServiceName: pchar);
var
SCManager:
SC_HANDLE;
Service: SC_HANDLE;
begin
SCManager := OpenSCManager(nil,
nil, SC_MANAGER_ALL_ACCESS);
if SCManager = 0 then Exit;
try
Service := OpenService(SCManager, ServiceName, SERVICE_ALL_ACCESS);
ControlService(Service, SERVICE_CONTROL_STOP, Status);
DeleteService(Service);
CloseServiceHandle(Service);
finally
CloseServiceHandle(SCManager);
end;
end;
procedure InstallService(ServiceName, DisplayName: pchar; FileName:
string);
var
SCManager: SC_HANDLE;
Service: SC_HANDLE;
Args:
pchar;
begin
SCManager := OpenSCManager(nil, nil,
SC_MANAGER_ALL_ACCESS);
if SCManager = 0 then Exit;
try
Service :=
CreateService(SCManager, ServiceName, DisplayName, SERVICE_ALL_ACCESS,
SERVICE_WIN32_OWN_PROCESS or SERVICE_INTERACTIVE_PROCESS, SERVICE_AUTO_START,
SERVICE_ERROR_IGNORE, pchar(FileName), nil, nil, nil, nil, nil);
Args :=
nil;
StartService(Service, 0, Args);
CloseServiceHandle(Service);
finally
CloseServiceHandle(SCManager);
end;
end;
begin
if ParamStr(1) = '/i' then
begin
InstallService(ServiceName, DisplayName, ParamStr(0));
end
else if
ParamStr(1) = '/u' then
begin
UninstallService(ServiceName);
end
else
begin
ServiceTable[0].lpServiceName := ServiceName;
ServiceTable[0].lpServiceProc := @ServiceCtrlDispatcher;
ServiceTable[1].lpServiceName := nil;
ServiceTable[1].lpServiceProc :=
nil;
StartServiceCtrlDispatcher(ServiceTable[0]);
end;
end.