您现在的位置:首页 >> API >> API >> 内容

如何不用Delphi提供的ServiceApp写系统服务程序

时间:2011/9/3 14:53:32 点击:

  核心提示:首先定义以下变量:varServiceName: pchar = '';var Status: TServiceStatus;StatusHandle: SERVICE_STATUS_HANDLE;...

首先定义以下变量:
var
  ServiceName: pchar = '';
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
    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;

服务程序入口代码:
ServiceName := pchar('获取服务程序路径');
if ParamStr(1) = '/i' then
begin
  InstallService(ServiceName, '', 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;

作者:网络 来源:转载
共有评论 0相关评论
发表我的评论
  • 大名:
  • 内容:
本类推荐
  • 没有
本类固顶
  • 没有
  • 盒子文章(www.2ccc.com) © 2024 版权所有 All Rights Reserved.
  • 沪ICP备05001939号