Delphi注册与卸载系统服务

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.