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.