{ Delphi NT Service Skeleton by Aphex http://www.iamaphex.cjb.net aphex@iamaphex.net
This tiny NT service can install/uninstall/start/stop itself based on command line arguments. The example service beeps once a second to show that it is running.
To install the service: Service.exe /i
To uninstall the service: Service.exe /u } program 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.
注：本站部分文章源于互联网，版权归原作者所有！如有侵权，请原作者与本站联系，本站将立即删除！ 本站文章除特别注明外均可转载，但需注明出处！ [MinTao学以致用网] 
