使用Delphi创建Windows服务程序

Windows服务作为Windows提供的一种特殊应用程序，拥有下面优点：

随系统启动而启动，不需要用户手动执行，适合做后台检测程序等
不用登录系统即可运行
在后台运行，不与Windows桌面相互影响
拥有System权限，在任务管理器中无法结束运行

Windows不建议在服务程序中与桌面有交互，在Windows Xp及以前的版本Windows服务和用户桌面还运行在一个session下，所以服务程序还可以比较轻松的与桌面进行交互。但是自Windows Vista及以后的系统中，服务程序是运行于session0中，而第一个启动的用户则运行于session1中，要想在服务中显示桌面或者与桌面程序交互要使用很复杂的技术，甚至用CreateProcess和ShellExecute启动的应用程序都无法在用户桌面中显示。

一、在Delphi中创建Windows服务程序

Delphi中提供了创建Windows服务的程序框架，生成Windows服务工程的具体方法如下，点击菜单File->New->Other，在里面寻找Service Application项目，点击OK按钮生成即可。这里会生成一个带界面的TService1类。选中TService1界面，下面介绍一下TService的相关属性和事件。

TService属性：

AllowPause: 是否允许暂停
AllowStop: 是否允许停止
Dependencies: 设置该服务与其他服务的依赖关系
DisplayName: 在Windows服务管理器中显示的名称（注意：不是服务名）
Name: 服务名称，使用/install参数安装时安装的服务名为此属性值
Interactive: 是否要与桌面进行交互
StartType: 服务的启动方式
ServiceStartName: 设定用于启动服务的用户名
TService事件：

procedure TService1.ServiceStart(Sender: TService; var Started: Boolean);
在该服务启动的时候调用OnStart事件，参数Started的默认为True，所以不用在该事件中再设置Started := True;　在此事件中如果判断某些条件不允许服务运行，则可以将Started置为False，这样服务将会不再启动。
procedure TService1.ServiceStop(Sender: TService; var Stopped: Boolean);
在该服务被停止的时候调用OnStop事件，Stopped的默认为True，在此事件中如果判断某些条件不允许服务停止则可将Stopped置为False来防止服务被停止。
procedure TService1.ServiceExecute(Sender: TService);
服务的主体执行部分，需要将服务的主要功能实现代码放在此事件中，此过程执行完毕后服务将会自动停止，所以一般在此事件中要写类似如下代码：

procedure TService1.ServiceExecute(Sender: TService);
begin
  while not Terminated do
  begin
     Sleep(10);
     ServiceThread.ProcessRequests(False);
  end;
end;

4.procedure TService1.ServicePause(Sender: TService; var Paused: Boolean);
在服务被暂停时调用的事件，Paused的含义类似ServiceStart事件中的Started.
5.procedure TService1.ServiceContinue(Sender: TService; var Continued: Boolean);
服务被暂停后重新启动继续执行时调用的事件，Continued的含义类似ServiceStart事件中的Started

经过简单的点击后，一个最基本的Windows服务程序已经编写完成了，编译工程，将会生成一个exe程序，本例中生成一个ServiceTest.exe。
打开命令行窗口，将目录定位到工程的输出目录，输入ServiceTest.exe /install并执行，刚才编写的服务就安装到系统中了。
卸载服务时使用ServiceTest.exe /unstall
可以在命令行后面加/silent参数，使其不弹出安装、卸载成功的提示框。
注意：使用/install这种方式安装时，服务的名字是服务窗口的类名，不是DisplayName，服务管理器中显示的是DisplayName
也可使用Windows自带的sc命令来创建或者删除服务，创建的示例代码如下：

sc create "ServiceName" binpath= "C:UsersAdministratorDesktopServiceTestServiceTest.exe"
sc delete ServiceName

二、一些很有用的管理服务的函数

unit ServiceMgr;

interface
  uses Windows,Messages,SysUtils,Winsvc,Dialogs;

  function StartServices(Const  SvrName:String):Boolean;
  function StopServices(Const  SvrName:String):Boolean;
  function QueryServiceStatu(Const SvrName:   String):String;
  function CreateServices(Const SvrName,FilePath:String):Boolean;
  function DeleteServices(Const SvrName: String):Boolean;
  function IsServiceExisted(Const SvrName: String):Boolean;

implementation

//开启服务
function StartServices(Const SvrName: String): Boolean;
var
  sMgr, sHandle:SC_HANDLE;
  c:PChar;
begin
  Result:=False;

  sMgr := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
  if sMgr <=0 then Exit;

  sHandle := OpenService(sMgr, PChar(SvrName), SERVICE_ALL_ACCESS);
  if sHandle <=0 then Exit;

  try
    Result:=StartService(sHandle, 0, c);
    CloseServiceHandle(sHandle);
    CloseServiceHandle(sMgr);
  except
    CloseServiceHandle(sHandle);
    CloseServiceHandle(sMgr);
  end;
end;

//停止服务
function StopServices(Const SvrName: String): Boolean;
var
  sMgr, sHandle: SC_HANDLE;
  d: TServiceStatus;
begin
  Result := False;

  sMgr := OpenSCManager(nil,nil,SC_MANAGER_ALL_ACCESS);
  if sMgr <=0 then Exit;
  sHandle := OpenService(sMgr,PChar(SvrName),SERVICE_ALL_ACCESS);
  if sHandle <=0 then Exit;
  try
    Result:=ControlService(sHandle, SERVICE_CONTROL_STOP,d);
    CloseServiceHandle(sMgr);
    CloseServiceHandle(sHandle);
  except
    CloseServiceHandle(sMgr);
    CloseServiceHandle(sHandle);
  end;
end;

//查询当前服务的状态
function  QueryServiceStatu(Const SvrName: String): String;
var
  sMgr, sHandle: SC_HANDLE;
  d: TServiceStatus;
begin
  Result := '未安装';

  sMgr := OpenSCManager(nil,nil,SC_MANAGER_ALL_ACCESS);
  if sMgr <=0 then Exit;
  sHandle := OpenService(sMgr,PChar(SvrName),SERVICE_ALL_ACCESS);

  if sHandle <= 0 then Exit;
  try
    QueryServiceStatus(sHandle, d);
  if d.dwCurrentState  = SERVICE_RUNNING then
    Result := '启动'   //Run
  else if d.dwCurrentState   = SERVICE_RUNNING then
    Result := 'Wait'   //Runing
  else if d.dwCurrentState   = SERVICE_START_PENDING then
    Result := 'Wait'   //Pause
  else if d.dwCurrentState   = SERVICE_STOP_PENDING   then
    Result := '停止'   //Pause
  else if d.dwCurrentState   = SERVICE_PAUSED then
    Result := '暂停'   //Pause
  else if d.dwCurrentState   = SERVICE_STOPPED then
    Result := '停止'   //Stop
  else if d.dwCurrentState   = SERVICE_CONTINUE_PENDING   then
    Result := 'Wait'   //Pause
  else if d.dwCurrentState   = SERVICE_PAUSE_PENDING then
    Result := 'Wait';   //Pause

    CloseServiceHandle(sMgr);
    CloseServiceHandle(sHandle);
  except
    CloseServiceHandle(sMgr);
    CloseServiceHandle(sHandle);
  end;
end;

{建立服务}
function  CreateServices(Const SvrName,FilePath: String): Boolean;
var
  sMgr, sHandle:SC_HANDLE;
begin
  Result:=False;
  if FilePath = '' then Exit;

  sMgr := OpenSCManager(nil,nil,SC_MANAGER_CREATE_SERVICE);

  if sMgr <= 0 then Exit;
  try
    sHandle := CreateService(sMgr, PChar(SvrName),
    PChar(SvrName),
    SERVICE_ALL_ACCESS,
    SERVICE_INTERACTIVE_PROCESS or SERVICE_WIN32_OWN_PROCESS,
    SERVICE_AUTO_START,SERVICE_ERROR_NORMAL,
    PChar(FilePath),nil,nil,nil,nil,nil);
    if sHandle <= 0 then begin
      ShowMessage( SysErrorMessage(GetlastError));
      Exit;
    end;
    CloseServiceHandle(sMgr);
    CloseServiceHandle(sHandle);

    Result := True;
  except
    CloseServiceHandle(sMgr);
    CloseServiceHandle(sHandle);
    Exit;
  end;
end;

{卸载服务}
function DeleteServices(Const SvrName: String): Boolean;
var
  sMgr, sHandle:SC_HANDLE;
begin
  Result:=False;
  sMgr := OpenSCManager(nil,nil,SC_MANAGER_ALL_ACCESS);
  if sMgr <= 0 then  Exit;
  sHandle :=OpenService(sMgr,PChar(SvrName),STANDARD_RIGHTS_REQUIRED);
  if sHandle <= 0 then Exit;
  try
    Result := DeleteService(sHandle);

    if not Result then
      ShowMessage(SysErrorMessage(GetlastError));
    CloseServiceHandle(sHandle);
    CloseServiceHandle(sMgr);
  except
    CloseServiceHandle(sHandle);
    CloseServiceHandle(sMgr);
    Exit;
  end;
end;

function IsServiceExisted(Const SvrName: String):Boolean;
var
  sMgr, sHandle:SC_HANDLE;
begin
  Result:=False;
  sMgr := OpenSCManager(nil,nil,SC_MANAGER_ALL_ACCESS);
  if sMgr <= 0 then  Exit;
  sHandle :=OpenService(sMgr, PChar(SvrName), STANDARD_RIGHTS_REQUIRED);
  if sHandle > 0 then
    Result := True;
end;

end.

调用方法：

{启动服务} StartServices(服务名);
{停止服务} StopServices(服务名);
{新建服务} CreateServices(服务名,exe文件路径);
{删除服务} DeleteServices(服务名);
{获取服务状态} string:=QueryServiceStatu(服务名);

注意这里的服务名是Service类的名称，不是DisplayName

三、Delphi中编写Windows服务的注意事项

尽量避免使用ShowMessage等直接进行调试，容易造成服务无法响应等问题。
停止服务时提示”Windows无法停止 xxx 服务（位于　本地计算机　上）” ，则可能是OnStop事件结束时将Stopped设置成了False或者OnExecute事件不能结束或者OnExecute与界面进行了不正确的交互。
Windows Vista及上版本的系统中不再支持服务中显示窗口，所以在这些版本的系统上，如果需要显示窗口，则要另外创建一个窗口程序，并与之用消息通讯以显示窗口。

四、一些有用的链接

Subverting Vista UAC in Both 32 and 64 bit Architectures
http://www.codeproject.com/Articles/35773/Subverting-Vista-UAC-in-Both-and-bit-Archite

如何在Windows Service里面运行程序
http://blog.sina.com.cn/s/blog_5f8817250100vooy.html