使用Delphi创建Windows服务程序

分类：Delphi, System 阅读 (5,755) Add comments

6月 092014

转载请注明原文地址：http://bcoder.com/delphi/create-windows-service-by-delphi

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

1. 随系统启动而启动，不需要用户手动执行，适合做后台检测程序等
2. 不用登录系统即可运行
3. 在后台运行，不与Windows桌面相互影响
4. 拥有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事件：

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

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

procedure TService1.ServiceExecute(Sender: TService);

begin

while not Terminated do

begin

Sleep(10);

ServiceThread.ProcessRequests(False);

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

1 2	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.

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

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;

//停止服务

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;

//查询当前服务的状态

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;

{建立服务}

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;

{卸载服务}

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;

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服务的注意事项

1. 尽量避免使用ShowMessage等直接进行调试，容易造成服务无法响应等问题。
2. 停止服务时提示”Windows无法停止 xxx 服务（位于　本地计算机　上）” ，则可能是OnStop事件结束时将Stopped设置成了False或者OnExecute事件不能结束或者OnExecute与界面进行了不正确的交互。
3. 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

打赏

Leave a Reply Cancel reply