Delphi 写服务程序

如何用 Delphi 创建系统服务程序？

Windows 2000/XP和2003等支持一种叫做"服务程序"的东西.程序作为服务启动有以下几个好处:

(1)不用登陆进系统即可运行.

(2)具有SYSTEM特权.所以你在进程管理器里面是无法结束它的.

笔者在2003年为一公司开发机顶盒项目的时候,曾经写过课件上传和媒体服务,下面就介绍一下如何用Delphi7创建一个Service程序.

运行Delphi7,选择菜单File-->New-->Other--->Service Application.将生成一个服务程序的框架.将工程保存为ServiceDemo.dpr和Unit_Main.pas,然后回到主框架.我们注意到,Service有几个属性.其中以下几个是我们比较常用的:

(1)DisplayName:服务的显示名称

(2)Name:服务名称.

我们在这里将DisplayName的值改为"Delphi服务演示程序",Name改为"DelphiService".编译这个项目,将得到 ServiceDemo.exe.这已经是一个服务程序了!进入CMD模式,切换致工程所在目录,运行命令"ServiceDemo.exe /install",将提示服务安装成功!然后"net start DelphiService"将启动这个服务.进入控制面版-->管理工具-->服务,将显示这个服务和当前状态.不过这个服务现在什么也干不了,因为我们还没有写代码:)先"net stop DelphiService"停止再"ServiceDemo.exe /uninstall"删除这个服务.回到Delphi7的IDE.

我们的计划是为这个服务添加一个主窗口,运行后任务栏显示程序的图标,双击图标将显示主窗口,上面有一个按钮,点击该按钮将实现Ctrl+Alt+Del功能.

实际上,服务程序莫认是工作于Winlogon桌面的,可以打开控制面板,查看我们刚才那个服务的属性-->登陆,其中"允许服务与桌面交互 "是不打钩的.怎么办?呵呵,回到IDE,注意那个布尔属性:Interactive,当这个属性为True的时候,该服务程序就可以与桌面交互了.

File-->New-->Form为服务添加窗口FrmMain,单元保存为Unit_FrmMain,并且把这个窗口设置为手工创建.完成后的代码如下:

01
unit Unit_Main; 

02
  
03
interface

04
  
05
uses

06
Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs, Unit_FrmMain; 

07
  
08
type

09
TDelphiService = class(TService) 

10
procedure ServiceContinue(Sender: TService; var Continued: Boolean); 

11
procedure ServiceExecute(Sender: TService); 

12
procedure ServicePause(Sender: TService; var Paused: Boolean); 

13
procedure ServiceShutdown(Sender: TService); 

14
procedure ServiceStart(Sender: TService; var Started: Boolean); 

15
procedure ServiceStop(Sender: TService; var Stopped: Boolean); 

16
private

17
{ Private declarations }

18
public

19
function GetServiceController: TServiceController; override; 

20
{ Public declarations }

21
end; 

22
  
23
var

24
DelphiService: TDelphiService; 

25
FrmMain: TFrmMain; 

26
implementation

27
  
28
{$R *.DFM}

29
  
30
procedure ServiceController(CtrlCode: DWord); stdcall; 

31
begin

32
DelphiService.Controller(CtrlCode); 

33
end; 

34
  
35
function TDelphiService.GetServiceController: TServiceController; 

36
begin

37
Result := ServiceController; 

38
end; 

39
  
40
procedure TDelphiService.ServiceContinue(Sender: TService; 

41
var Continued: Boolean); 

42
begin

43
while not Terminated do

44
begin

45
Sleep(10); 

46
ServiceThread.ProcessRequests(False); 

47
end; 

48
end; 

49
  
50
procedure TDelphiService.ServiceExecute(Sender: TService); 

51
begin

52
while not Terminated do

53
begin

54
Sleep(10); 

55
ServiceThread.ProcessRequests(False); 

56
end; 

57
end; 

58
  
59
procedure TDelphiService.ServicePause(Sender: TService; 

60
var Paused: Boolean); 

61
begin

62
Paused := True; 

63
end; 

64
  
65
procedure TDelphiService.ServiceShutdown(Sender: TService); 

66
begin

67
gbCanClose := true; 

68
FrmMain.Free; 

69
Status := csStopped; 

70
ReportStatus(); 

71
end; 

72
  
73
procedure TDelphiService.ServiceStart(Sender: TService; 

74
var Started: Boolean); 

75
begin

76
Started := True; 

77
Svcmgr.Application.CreateForm(TFrmMain, FrmMain); 

78
gbCanClose := False; 

79
FrmMain.Hide; 

80
end; 

81
  
82
procedure TDelphiService.ServiceStop(Sender: TService; 

83
var Stopped: Boolean); 

84
begin

85
Stopped := True; 

86
gbCanClose := True; 

87
FrmMain.Free; 

88
end; 

89
  
90
end.

主窗口单元如下:

001
unit Unit_FrmMain; 

002
  
003
interface

004
  
005
uses

006
Windows, Messages, SysUtils, Variants, Classes, ShellApi, Graphics, Controls, Forms, 

007
Dialogs, ExtCtrls, StdCtrls; 

008
  
009
const

010
WM_TrayIcon = WM_USER + 1234; 

011
type

012
TFrmMain = class(TForm) 

013
Timer1: TTimer; 

014
Button1: TButton; 

015
procedure FormCreate(Sender: TObject); 

016
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); 

017
procedure FormDestroy(Sender: TObject); 

018
procedure Timer1Timer(Sender: TObject); 

019
procedure Button1Click(Sender: TObject); 

020
private

021
{ Private declarations }

022
IconData: TNotifyIconData; 

023
procedure AddIconToTray; 

024
procedure DelIconFromTray; 

025
procedure TrayIconMessage(var Msg: TMessage); message WM_TrayIcon; 

026
procedure SysButtonMsg(var Msg: TMessage); message WM_SYSCOMMAND; 

027
public

028
{ Public declarations }

029
end; 

030
  
031
var

032
FrmMain: TFrmMain; 

033
gbCanClose: Boolean; 

034
implementation

035
  
036
{$R *.dfm}

037
  
038
procedure TFrmMain.FormCreate(Sender: TObject); 

039
begin

040
FormStyle := fsStayOnTop; 

041
SetWindowLong(Application.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW); 

042
gbCanClose := False; 

043
Timer1.Interval := 1000; 

044
Timer1.Enabled := True; 

045
end; 

046
  
047
procedure TFrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean); 

048
begin

049
CanClose := gbCanClose; 

050
if not CanClose then

051
begin

052
Hide; 

053
end; 

054
end; 

055
  
056
procedure TFrmMain.FormDestroy(Sender: TObject); 

057
begin

058
Timer1.Enabled := False; 

059
DelIconFromTray; 

060
end; 

061
  
062
procedure TFrmMain.AddIconToTray; 

063
begin

064
ZeroMemory(@IconData, SizeOf(TNotifyIconData)); 

065
IconData.cbSize := SizeOf(TNotifyIconData); 

066
IconData.Wnd := Handle; 

067
IconData.uID := 1; 

068
IconData.uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP; 

069
IconData.uCallbackMessage := WM_TrayIcon; 

070
IconData.hIcon := Application.Icon.Handle; 

071
IconData.szTip := Delphi服务演示程序; 

072
Shell_NotifyIcon(NIM_ADD, @IconData); 

073
end; 

074
  
075
procedure TFrmMain.DelIconFromTray; 

076
begin

077
Shell_NotifyIcon(NIM_DELETE, @IconData); 

078
end; 

079
  
080
procedure TFrmMain.SysButtonMsg(var Msg: TMessage); 

081
begin

082
if (Msg.wParam = SC_CLOSE) or

083
(Msg.wParam = SC_MINIMIZE) then Hide 

084
else inherited; // 执行默认动作 

085
end; 

086
  
087
procedure TFrmMain.TrayIconMessage(var Msg: TMessage); 

088
begin

089
if (Msg.LParam = WM_LBUTTONDBLCLK) then Show(); 

090
end; 

091
  
092
procedure TFrmMain.Timer1Timer(Sender: TObject); 

093
begin

094
AddIconToTray; 

095
end; 

096
  
097
procedure SendHokKey;stdcall; 

098
var

099
HDesk_WL: HDESK; 

100
begin

101
HDesk_WL := OpenDesktop (Winlogon, 0, False, DESKTOP_JOURNALPLAYBACK); 

102
if (HDesk_WL <> 0) then

103
if (SetThreadDesktop (HDesk_WL) = True) then

104
PostMessage(HWND_BROADCAST, WM_HOTKEY, 0, MAKELONG (MOD_ALT or MOD_CONTROL, VK_DELETE)); 

105
end; 

106
  
107
procedure TFrmMain.Button1Click(Sender: TObject); 

108
var

109
dwThreadID : DWORD; 

110
begin

111
CreateThread(nil, 0, @SendHokKey, nil, 0, dwThreadID); 

112
end; 

113
  
114
end.

补充:

(1)关于更多服务程序的演示程序,请访问以下 http://www.torry.net/pages.php?id=226 ,上面包含了多个演示如何控制和管理系统服务的代码.

(2)请切记:Windows实际上存在多个桌面.例如屏幕传输会出现白屏,可能有两个原因:一是系统处于锁定或未登陆桌面,二是处于屏幕保护桌面.这时候要将当前桌面切换到该桌面才能抓屏.

(3)关于服务程序与桌面交互,还有种动态切换方法.大概单元如下:

01
unit ServiceDesktop; 

02
  
03
interface

04
  
05
function InitServiceDesktop: boolean; 

06
procedure DoneServiceDeskTop; 

07
  
08
implementation

09
  
10
uses Windows, SysUtils; 

11
  
12
const

13
DefaultWindowStation = WinSta0; 

14
DefaultDesktop = Default; 

15
var

16
hwinstaSave: HWINSTA; 

17
hdeskSave: HDESK; 

18
hwinstaUser: HWINSTA; 

19
hdeskUser: HDESK; 

20
function InitServiceDesktop: boolean; 

21
var

22
dwThreadId: DWORD; 

23
begin

24
dwThreadId := GetCurrentThreadID; 

25
// Ensure connection to service window station and desktop, and 

26
// save their handles. 

27
hwinstaSave := GetProcessWindowStation; 

28
hdeskSave := GetThreadDesktop(dwThreadId); 

29
  
30
  
31
hwinstaUser := OpenWindowStation(DefaultWindowStation, FALSE, MAXIMUM_ALLOWED); 

32
if hwinstaUser = 0 then

33
begin

34
OutputDebugString(PChar(OpenWindowStation failed + SysErrorMessage(GetLastError))); 

35
Result := false; 

36
exit; 

37
end; 

38
  
39
if not SetProcessWindowStation(hwinstaUser) then

40
begin

41
OutputDebugString(SetProcessWindowStation failed); 

42
Result := false; 

43
exit; 

44
end; 

45
  
46
hdeskUser := OpenDesktop(DefaultDesktop, 0, FALSE, MAXIMUM_ALLOWED); 

47
if hdeskUser = 0 then

48
begin

49
OutputDebugString(OpenDesktop failed); 

50
SetProcessWindowStation(hwinstaSave); 

51
CloseWindowStation(hwinstaUser); 

52
Result := false; 

53
exit; 

54
end; 

55
Result := SetThreadDesktop(hdeskUser); 

56
if not Result then

57
OutputDebugString(PChar(SetThreadDesktop + SysErrorMessage(GetLastError))); 

58
end; 

59
  
60
procedure DoneServiceDeskTop; 

61
begin

62
// Restore window station and desktop. 

63
SetThreadDesktop(hdeskSave); 

64
SetProcessWindowStation(hwinstaSave); 

65
if hwinstaUser <> 0 then

66
CloseWindowStation(hwinstaUser); 

67
if hdeskUser <> 0 then

68
CloseDesktop(hdeskUser); 

69
end; 

70
  
71
initialization

72
InitServiceDesktop; 

73
finalization

74
DoneServiceDesktop; 

75
end.

更详细的演示代码请参看: http://www.torry.net/samples/samples/os/isarticle.zip

(4)关于安装服务如何添加服务描述.有两种方法:一是修改注册表.服务的详细信息都位于HKEY_LOCAL_MACHINE\SYSTEM\ ControlSet001\Services\下面,例如我们刚才那个服务就位于HKEY_LOCAL_MACHINE\SYSTEM\ ControlSet001\Services\DelphiService下.第二种方法就是先用QueryServiceConfig2函数获取服务信息,然后ChangeServiceConfig2来改变描述.用Delphi实现的话,单元如下:

001
unit WinSvcEx; 

002
  
003
interface

004
  
005
uses Windows, WinSvc; 

006
  
007
const

008
// 

009
// Service config info levels 

010
// 

011
SERVICE_CONFIG_DESCRIPTION = 1; 

012
SERVICE_CONFIG_FAILURE_ACTIONS = 2; 

013
// 

014
// DLL name of imported functions 

015
// 

016
AdvApiDLL = advapi32.dll; 

017
type

018
// 

019
// Service description string 

020
// 

021
PServiceDescriptionA = ^TServiceDescriptionA; 

022
PServiceDescriptionW = ^TServiceDescriptionW; 

023
PServiceDescription = PServiceDescriptionA; 

024
{$EXTERNALSYM _SERVICE_DESCRIPTIONA}

025
_SERVICE_DESCRIPTIONA = record

026
lpDescription : PAnsiChar; 

027
end; 

028
{$EXTERNALSYM _SERVICE_DESCRIPTIONW}

029
_SERVICE_DESCRIPTIONW = record

030
lpDescription : PWideChar; 

031
end; 

032
{$EXTERNALSYM _SERVICE_DESCRIPTION}

033
_SERVICE_DESCRIPTION = _SERVICE_DESCRIPTIONA; 

034
{$EXTERNALSYM SERVICE_DESCRIPTIONA}

035
SERVICE_DESCRIPTIONA = _SERVICE_DESCRIPTIONA; 

036
{$EXTERNALSYM SERVICE_DESCRIPTIONW}

037
SERVICE_DESCRIPTIONW = _SERVICE_DESCRIPTIONW; 

038
{$EXTERNALSYM SERVICE_DESCRIPTION}

039
SERVICE_DESCRIPTION = _SERVICE_DESCRIPTIONA; 

040
TServiceDescriptionA = _SERVICE_DESCRIPTIONA; 

041
TServiceDescriptionW = _SERVICE_DESCRIPTIONW; 

042
TServiceDescription = TServiceDescriptionA; 

043
  
044
// 

045
// Actions to take on service failure 

046
// 

047
{$EXTERNALSYM _SC_ACTION_TYPE}

048
_SC_ACTION_TYPE = (SC_ACTION_NONE, SC_ACTION_RESTART, SC_ACTION_REBOOT, SC_ACTION_RUN_COMMAND); 

049
{$EXTERNALSYM SC_ACTION_TYPE}

050
SC_ACTION_TYPE = _SC_ACTION_TYPE; 

051
  
052
PServiceAction = ^TServiceAction; 

053
{$EXTERNALSYM _SC_ACTION}

054
_SC_ACTION = record

055
aType : SC_ACTION_TYPE; 

056
Delay : DWORD; 

057
end; 

058
{$EXTERNALSYM SC_ACTION}

059
SC_ACTION = _SC_ACTION; 

060
TServiceAction = _SC_ACTION; 

061
  
062
PServiceFailureActionsA = ^TServiceFailureActionsA; 

063
PServiceFailureActionsW = ^TServiceFailureActionsW; 

064
PServiceFailureActions = PServiceFailureActionsA; 

065
{$EXTERNALSYM _SERVICE_FAILURE_ACTIONSA}

066
_SERVICE_FAILURE_ACTIONSA = record

067
dwResetPeriod : DWORD; 

068
lpRebootMsg : LPSTR; 

069
lpCommand : LPSTR; 

070
cActions : DWORD; 

071
lpsaActions : ^SC_ACTION; 

072
end; 

073
{$EXTERNALSYM _SERVICE_FAILURE_ACTIONSW}

074
_SERVICE_FAILURE_ACTIONSW = record

075
dwResetPeriod : DWORD; 

076
lpRebootMsg : LPWSTR; 

077
lpCommand : LPWSTR; 

078
cActions : DWORD; 

079
lpsaActions : ^SC_ACTION; 

080
end; 

081
{$EXTERNALSYM _SERVICE_FAILURE_ACTIONS}

082
_SERVICE_FAILURE_ACTIONS = _SERVICE_FAILURE_ACTIONSA; 

083
{$EXTERNALSYM SERVICE_FAILURE_ACTIONSA}

084
SERVICE_FAILURE_ACTIONSA = _SERVICE_FAILURE_ACTIONSA; 

085
{$EXTERNALSYM SERVICE_FAILURE_ACTIONSW}

086
SERVICE_FAILURE_ACTIONSW = _SERVICE_FAILURE_ACTIONSW; 

087
{$EXTERNALSYM SERVICE_FAILURE_ACTIONS}

088
SERVICE_FAILURE_ACTIONS = _SERVICE_FAILURE_ACTIONSA; 

089
TServiceFailureActionsA = _SERVICE_FAILURE_ACTIONSA; 

090
TServiceFailureActionsW = _SERVICE_FAILURE_ACTIONSW; 

091
TServiceFailureActions = TServiceFailureActionsA; 

092
  
093
/////////////////////////////////////////////////////////////////////////// 

094
// API Function Prototypes 

095
/////////////////////////////////////////////////////////////////////////// 

096
TQueryServiceConfig2 = function (hService : SC_HANDLE; dwInfoLevel : DWORD; lpBuffer : pointer; 

097
cbBufSize : DWORD; var pcbBytesNeeded) : BOOL; stdcall; 

098
TChangeServiceConfig2 = function (hService : SC_HANDLE; dwInfoLevel : DWORD; lpInfo : pointer) : BOOL; stdcall; 

099
  
100
var

101
hDLL : THandle ; 

102
LibLoaded : boolean ; 

103
  
104
var

105
OSVersionInfo : TOSVersionInfo; 

106
  
107
{$EXTERNALSYM QueryServiceConfig2A}

108
QueryServiceConfig2A : TQueryServiceConfig2; 

109
{$EXTERNALSYM QueryServiceConfig2W}

110
QueryServiceConfig2W : TQueryServiceConfig2; 

111
{$EXTERNALSYM QueryServiceConfig2}

112
QueryServiceConfig2 : TQueryServiceConfig2; 

113
  
114
{$EXTERNALSYM ChangeServiceConfig2A}

115
ChangeServiceConfig2A : TChangeServiceConfig2; 

116
{$EXTERNALSYM ChangeServiceConfig2W}

117
ChangeServiceConfig2W : TChangeServiceConfig2; 

118
{$EXTERNALSYM ChangeServiceConfig2}

119
ChangeServiceConfig2 : TChangeServiceConfig2; 

120
  
121
implementation

122
  
123
initialization

124
OSVersionInfo.dwOSVersionInfoSize := SizeOf(OSVersionInfo); 

125
GetVersionEx(OSVersionInfo); 

126
if (OSVersionInfo.dwPlatformId = VER_PLATFORM_WIN32_NT) and (OSVersionInfo.dwMajorVersion >= 5) then

127
begin

128
if hDLL = 0 then

129
begin

130
hDLL:=GetModuleHandle(AdvApiDLL); 

131
LibLoaded := False; 

132
if hDLL = 0 then

133
begin

134
hDLL := LoadLibrary(AdvApiDLL); 

135
LibLoaded := True; 

136
end; 

137
end; 

138
  
139
if hDLL <> 0 then

140
begin

141
@QueryServiceConfig2A := GetProcAddress(hDLL, QueryServiceConfig2A); 

142
@QueryServiceConfig2W := GetProcAddress(hDLL, QueryServiceConfig2W); 

143
@QueryServiceConfig2 := @QueryServiceConfig2A; 

144
@ChangeServiceConfig2A := GetProcAddress(hDLL, ChangeServiceConfig2A); 

145
@ChangeServiceConfig2W := GetProcAddress(hDLL, ChangeServiceConfig2W); 

146
@ChangeServiceConfig2 := @ChangeServiceConfig2A; 

147
end; 

148
end

149
else

150
begin

151
@QueryServiceConfig2A := nil; 

152
@QueryServiceConfig2W := nil; 

153
@QueryServiceConfig2 := nil; 

154
@ChangeServiceConfig2A := nil; 

155
@ChangeServiceConfig2W := nil; 

156
@ChangeServiceConfig2 := nil; 

157
end; 

158
  
159
finalization

160
if (hDLL <> 0) and LibLoaded then

161
FreeLibrary(hDLL); 

162
  
163
end. 

164
  
165
unit winntService; 

166
  
167
interface

168
  
169
uses

170
Windows,WinSvc,WinSvcEx; 

171
  
172
function InstallService(const strServiceName,strDisplayName,strDescription,strFilename: string):Boolean; 

173
//eg:InstallService(服务名称,显示名称,描述信息,服务文件); 

174
procedure UninstallService(strServiceName:string); 

175
implementation

176
  
177
function StrLCopy(Dest: PChar; const Source: PChar; MaxLen: Cardinal): PChar; assembler; 

178
asm

179
PUSH EDI 

180
PUSH ESI 

181
PUSH EBX 

182
MOV ESI,EAX 

183
MOV EDI,EDX 

184
MOV EBX,ECX 

185
XOR AL,AL 

186
TEST ECX,ECX 

187
JZ @@1

188
REPNE SCASB 

189
JNE @@1

190
INC ECX 

191
@@1: SUB EBX,ECX 

192
MOV EDI,ESI 

193
MOV ESI,EDX 

194
MOV EDX,EDI 

195
MOV ECX,EBX 

196
SHR ECX,2

197
REP MOVSD 

198
MOV ECX,EBX 

199
AND ECX,3

200
REP MOVSB 

201
STOSB 

202
MOV EAX,EDX 

203
POP EBX 

204
POP ESI 

205
POP EDI 

206
end; 

207
  
208
function StrPCopy(Dest: PChar; const Source: string): PChar; 

209
begin

210
Result := StrLCopy(Dest, PChar(Source), Length(Source)); 

211
end; 

212
  
213
function InstallService(const strServiceName,strDisplayName,strDescription,strFilename: string):Boolean; 

214
var

215
//ss : TServiceStatus; 

216
//psTemp : PChar; 

217
hSCM,hSCS:THandle; 

218
  
219
srvdesc : PServiceDescription; 

220
desc : string; 

221
//SrvType : DWord; 

222
  
223
lpServiceArgVectors:pchar; 

224
begin

225
Result:=False; 

226
//psTemp := nil; 

227
//SrvType := SERVICE_WIN32_OWN_PROCESS and SERVICE_INTERACTIVE_PROCESS; 

228
hSCM:=OpenSCManager(nil,nil,SC_MANAGER_ALL_ACCESS);//连接服务数据库 

229
if hSCM=0 then Exit;//MessageBox(hHandle,Pchar(SysErrorMessage(GetLastError)),服务程序管理器,MB_ICONERROR+MB_TOPMOST); 

230
  
231
  
232
hSCS:=CreateService( //创建服务函数 

233
hSCM, // 服务控制管理句柄 

234
Pchar(strServiceName), // 服务名称 

235
Pchar(strDisplayName), // 显示的服务名称 

236
SERVICE_ALL_ACCESS, // 存取权利 

237
SERVICE_WIN32_OWN_PROCESS or SERVICE_INTERACTIVE_PROCESS,// 服务类型 SERVICE_WIN32_SHARE_PROCESS 

238
SERVICE_AUTO_START, // 启动类型 

239
SERVICE_ERROR_IGNORE, // 错误控制类型 

240
Pchar(strFilename), // 服务程序 

241
nil, // 组服务名称 

242
nil, // 组标识 

243
nil, // 依赖的服务 

244
nil, // 启动服务帐号 

245
nil); // 启动服务口令 

246
if hSCS=0 then Exit;//MessageBox(hHandle,Pchar(SysErrorMessage(GetLastError)),Pchar(Application.Title),MB_ICONERROR+MB_TOPMOST); 

247
  
248
if Assigned(ChangeServiceConfig2) then

249
begin

250
desc := Copy(strDescription,1,1024); 

251
GetMem(srvdesc,SizeOf(TServiceDescription)); 

252
GetMem(srvdesc^.lpDescription,Length(desc) + 1); 

253
try

254
StrPCopy(srvdesc^.lpDescription, desc); 

255
ChangeServiceConfig2(hSCS,SERVICE_CONFIG_DESCRIPTION,srvdesc); 

256
finally

257
FreeMem(srvdesc^.lpDescription); 

258
FreeMem(srvdesc); 

259
end; 

260
end; 

261
lpServiceArgVectors := nil; 

262
if not StartService(hSCS, 0, lpServiceArgVectors) then //启动服务 

263
Exit; //MessageBox(hHandle,Pchar(SysErrorMessage(GetLastError)),Pchar(Application.Title),MB_ICONERROR+MB_TOPMOST); 

264
CloseServiceHandle(hSCS); //关闭句柄 

265
Result:=True; 

266
end; 

267
  
268
procedure UninstallService(strServiceName:string); 

269
var

270
SCManager: SC_HANDLE; 

271
Service: SC_HANDLE; 

272
Status: TServiceStatus; 

273
begin

274
SCManager := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS); 

275
if SCManager = 0 then Exit; 

276
try

277
Service := OpenService(SCManager, Pchar(strServiceName), SERVICE_ALL_ACCESS); 

278
ControlService(Service, SERVICE_CONTROL_STOP, Status); 

279
DeleteService(Service); 

280
CloseServiceHandle(Service); 

281
finally

282
CloseServiceHandle(SCManager); 

283
end; 

284
end; 

285
  
286
end.

(5)如何暴力关闭一个服务程序,实现我们以前那个"NT工具箱"的功能?首先,根据进程名称来杀死进程是用以下函数:

01
uses Tlhelp32; 

02
  
03
function KillTask(ExeFileName: string): Integer; 

04
const

05
PROCESS_TERMINATE = 01; 

06
var

07
ContinueLoop: BOOL; 

08
FSnapshotHandle: THandle; 

09
FProcessEntry32: TProcessEntry32; 

10
begin

11
Result := 0; 

12
FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0); 

13
FProcessEntry32.dwSize := SizeOf(FProcessEntry32); 

14
ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32); 

15
  
16
while Integer(ContinueLoop) <> 0 do

17
begin

18
if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) = 

19
UpperCase(ExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) = 

20
UpperCase(ExeFileName))) then

21
Result := Integer(TerminateProcess( 

22
OpenProcess(PROCESS_TERMINATE, 

23
BOOL(0), 

24
FProcessEntry32.th32ProcessID), 

25
0)); 

26
ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32); 

27
end; 

28
CloseHandle(FSnapshotHandle); 

29
end;

但是对于服务程序,它会提示"拒绝访问".其实只要程序拥有Debug权限即可:

01
function EnableDebugPrivilege: Boolean; 

02
function EnablePrivilege(hToken: Cardinal; PrivName: string; bEnable: Boolean): Boolean; 

03
var

04
TP: TOKEN_PRIVILEGES; 

05
Dummy: Cardinal; 

06
begin

07
TP.PrivilegeCount := 1; 

08
LookupPrivilegeValue(nil, pchar(PrivName), TP.Privileges[0].Luid); 

09
if bEnable then

10
TP.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED 

11
else TP.Privileges[0].Attributes := 0; 

12
AdjustTokenPrivileges(hToken, False, TP, SizeOf(TP), nil, Dummy); 

13
Result := GetLastError = ERROR_SUCCESS; 

14
end; 

15
  
16
var

17
hToken: Cardinal; 

18
begin

19
OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES, hToken); 

20
result:=EnablePrivilege(hToken, SeDebugPrivilege, True); 

21
CloseHandle(hToken); 

22
end;

使用方法:

1
EnableDebugPrivilege;//提升权限 

2
  
3
KillTask(xxxx.exe);//关闭该服务程序.

posted @ 2011-10-24 17:06 马儿快跑阅读(3981) 评论(0) 编辑收藏举报

会员力量，点亮园子希望

刷新页面返回顶部

Delphi 写服务程序

如何用 Delphi 创建系统服务程序？

公告