用 Delphi 設計 NT Service 程式

bestlong

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,并且把这个窗口设置为手工创建.完成后的代码如下:

1. unit Unit_Main;
   
2. 
   
3. interface
   
4. 
   
5. uses
   
6.   Windows, Messages, SysUtils, Classes, Graphics, Controls,
   
7.   SvcMgr, Dialogs, Unit_FrmMain;
   
8. 
   
9. type
   
10. TDelphiService = class(TService)
    
11.     procedure ServiceContinue(Sender: TService; var Continued: Boolean);
    
12.     procedure ServiceExecute(Sender: TService);
    
13.     procedure ServicePause(Sender: TService; var Paused: Boolean);
    
14.     procedure ServiceShutdown(Sender: TService);
    
15.     procedure ServiceStart(Sender: TService; var Started: Boolean);
    
16.     procedure ServiceStop(Sender: TService; var Stopped: Boolean);
    
17.   private
    
18.     { Private declarations }
    
19.   public
    
20.     function GetServiceController: TServiceController; override;
    
21.     { Public declarations }
    
22. end;
    
23. 
    
24. var
    
25.   DelphiService: TDelphiService;
    
26.   FrmMain: TFrmMain;
    
27.   implementation
    
28. 
    
29. {$R *.DFM}
    
30. 
    
31. procedure ServiceController(CtrlCode: DWord); stdcall;
    
32. begin
    
33.   DelphiService.Controller(CtrlCode);
    
34. end;
    
35. 
    
36. function TDelphiService.GetServiceController: TServiceController;
    
37. begin
    
38.   Result := ServiceController;
    
39. end;
    
40. 
    
41. procedure TDelphiService.ServiceContinue(Sender: TService;
    
42. var Continued: Boolean);
    
43. begin
    
44.   while not Terminated do
    
45.   begin
    
46.     Sleep(10);
    
47.     ServiceThread.ProcessRequests(False);
    
48.   end;
    
49. end;
    
50. 
    
51. procedure TDelphiService.ServiceExecute(Sender: TService);
    
52. begin
    
53.   while not Terminated do
    
54.   begin
    
55.     Sleep(10);
    
56.     ServiceThread.ProcessRequests(False);
    
57.   end;
    
58. end;
    
59. 
    
60. procedure TDelphiService.ServicePause(Sender: TService;
    
61. var Paused: Boolean);
    
62. begin
    
63.   Paused := True;
    
64. end;
    
65. 
    
66. procedure TDelphiService.ServiceShutdown(Sender: TService);
    
67. begin
    
68.   gbCanClose := true;
    
69.   FrmMain.Free;
    
70.   Status := csStopped;
    
71.   ReportStatus();
    
72. end;
    
73. 
    
74. procedure TDelphiService.ServiceStart(Sender: TService;
    
75. var Started: Boolean);
    
76. begin
    
77.   Started := True;
    
78.   Svcmgr.Application.CreateForm(TFrmMain, FrmMain);
    
79.   gbCanClose := False;
    
80.   FrmMain.Hide;
    
81. end;
    
82. 
    
83. procedure TDelphiService.ServiceStop(Sender: TService;
    
84. var Stopped: Boolean);
    
85. begin
    
86.   Stopped := True;
    
87.   gbCanClose := True;
    
88.   FrmMain.Free;
    
89. end;
    
90. 
    
91. end.

複製代碼

主窗口单元如下:

1. unit Unit_FrmMain;
   
2. 
   
3. interface
   
4. 
   
5. uses
   
6.   Windows, Messages, SysUtils, Variants, Classes, ShellApi, Graphics,
   
7.   Controls, Forms, Dialogs, ExtCtrls, StdCtrls;
   
8. 
   
9. const
   
10.   WM_TrayIcon = WM_USER + 1234;
    
11. type
    
12.   TFrmMain = class(TForm)
    
13.     Timer1: TTimer;
    
14.     Button1: TButton;
    
15.     procedure FormCreate(Sender: TObject);
    
16.     procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    
17.     procedure FormDestroy(Sender: TObject);
    
18.     procedure Timer1Timer(Sender: TObject);
    
19.     procedure Button1Click(Sender: TObject);
    
20.   private
    
21.     { Private declarations }
    
22.     IconData: TNotifyIconData;
    
23.     procedure AddIconToTray;
    
24.     procedure DelIconFromTray;
    
25.     procedure TrayIconMessage(var Msg: TMessage); message WM_TrayIcon;
    
26.     procedure SysButtonMsg(var Msg: TMessage); message WM_SYSCOMMAND;
    
27.   public
    
28.     { Public declarations }
    
29. end;
    
30. 
    
31. var
    
32.   FrmMain: TFrmMain;
    
33.   gbCanClose: Boolean;
    
34. implementation
    
35. 
    
36. {$R *.dfm}
    
37. 
    
38. procedure TFrmMain.FormCreate(Sender: TObject);
    
39. begin
    
40.   FormStyle := fsStayOnTop;
    
41.   SetWindowLong(Application.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW);
    
42.   gbCanClose := False;
    
43.   Timer1.Interval := 1000;
    
44.   Timer1.Enabled := True;
    
45. end;
    
46. 
    
47. procedure TFrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    
48. begin
    
49.   CanClose := gbCanClose;
    
50.   if not CanClose then
    
51.   begin
    
52.     Hide;
    
53.   end;
    
54. end;
    
55. 
    
56. procedure TFrmMain.FormDestroy(Sender: TObject);
    
57. begin
    
58.   Timer1.Enabled := False;
    
59.   DelIconFromTray;
    
60. end;
    
61. 
    
62. procedure TFrmMain.AddIconToTray;
    
63. begin
    
64.   ZeroMemory(@IconData, SizeOf(TNotifyIconData));
    
65.   IconData.cbSize := SizeOf(TNotifyIconData);
    
66.   IconData.Wnd := Handle;
    
67.   IconData.uID := 1;
    
68.   IconData.uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;
    
69.   IconData.uCallbackMessage := WM_TrayIcon;
    
70.   IconData.hIcon := Application.Icon.Handle;
    
71.   IconData.szTip := Delphi服务演示程序;
    
72.   Shell_NotifyIcon(NIM_ADD, @IconData);
    
73. end;
    
74. 
    
75. procedure TFrmMain.DelIconFromTray;
    
76. begin
    
77.   Shell_NotifyIcon(NIM_DELETE, @IconData);
    
78. end;
    
79. 
    
80. procedure TFrmMain.SysButtonMsg(var Msg: TMessage);
    
81. begin
    
82.   if (Msg.wParam = SC_CLOSE) or
    
83. (Msg.wParam = SC_MINIMIZE) then Hide
    
84.   else inherited; // 执行默认动作
    
85. end;
    
86. 
    
87. procedure TFrmMain.TrayIconMessage(var Msg: TMessage);
    
88. begin
    
89.   if (Msg.LParam = WM_LBUTTONDBLCLK) then Show();
    
90. end;
    
91. 
    
92. procedure TFrmMain.Timer1Timer(Sender: TObject);
    
93. begin
    
94.   AddIconToTray;
    
95. end;
    
96. 
    
97. procedure SendHokKey;stdcall;
    
98. var
    
99.   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.

複製代碼

bestlong

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

1. uses Tlhelp32;
   
2. 
   
3. function KillTask(ExeFileName: string): Integer;
   
4. const
   
5.   PROCESS_TERMINATE = 01;
   
6. var
   
7.   ContinueLoop: BOOL;
   
8.   FSnapshotHandle: THandle;
   
9.   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( OpenProcess(PROCESS_TERMINATE,
    
22. BOOL(0),
    
23. FProcessEntry32.th32ProcessID),
    
24. 0));
    
25.     ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
    
26.   end;
    
27.   CloseHandle(FSnapshotHandle);
    
28. end;
    
29. 
    
30. 但是对于服务程序,它会提示"拒绝访问".其实只要程序拥有Debug权限即可:
    
31. function EnableDebugPrivilege: Boolean;
    
32. function EnablePrivilege(hToken: Cardinal; PrivName: string; bEnable: Boolean): Boolean;
    
33. var
    
34.   TP: TOKEN_PRIVILEGES;
    
35.   Dummy: Cardinal;
    
36. begin
    
37.   TP.PrivilegeCount := 1;
    
38.   LookupPrivilegeValue(nil, pchar(PrivName), TP.Privileges[0].Luid);
    
39.   if bEnable then
    
40.     TP.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED
    
41.   else TP.Privileges[0].Attributes := 0;
    
42.   AdjustTokenPrivileges(hToken, False, TP, SizeOf(TP), nil, Dummy);
    
43.   Result := GetLastError = ERROR_SUCCESS;
    
44. end;
    
45. 
    
46. var
    
47.   hToken: Cardinal;
    
48. begin
    
49.   OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES, hToken);
    
50.   result:=EnablePrivilege(hToken, SeDebugPrivilege, True);
    
51.   CloseHandle(hToken);
    
52. end;

複製代碼

使用方法:
EnableDebugPrivilege;//提升权限
KillTask(xxxx.exe);//关闭该服务程序.

bestlong

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

1. unit WinSvcEx;
   
2. 
   
3. interface
   
4. 
   
5. uses Windows, WinSvc;
   
6. 
   
7. const
   
8. //
   
9. // Service config info levels
   
10. //
    
11. SERVICE_CONFIG_DESCRIPTION = 1;
    
12. SERVICE_CONFIG_FAILURE_ACTIONS = 2;
    
13. //
    
14. // DLL name of imported functions
    
15. //
    
16. AdvApiDLL = advapi32.dll;
    
17. type
    
18. //
    
19. // Service description string
    
20. //
    
21. PServiceDescriptionA = ^TServiceDescriptionA;
    
22. PServiceDescriptionW = ^TServiceDescriptionW;
    
23. PServiceDescription = PServiceDescriptionA;
    
24. {$EXTERNALSYM _SERVICE_DESCRIPTIONA}
    
25. _SERVICE_DESCRIPTIONA = record
    
26. lpDescription : PAnsiChar;
    
27. end;
    
28. {$EXTERNALSYM _SERVICE_DESCRIPTIONW}
    
29. _SERVICE_DESCRIPTIONW = record
    
30. lpDescription : PWideChar;
    
31. end;
    
32. {$EXTERNALSYM _SERVICE_DESCRIPTION}
    
33. _SERVICE_DESCRIPTION = _SERVICE_DESCRIPTIONA;
    
34. {$EXTERNALSYM SERVICE_DESCRIPTIONA}
    
35. SERVICE_DESCRIPTIONA = _SERVICE_DESCRIPTIONA;
    
36. {$EXTERNALSYM SERVICE_DESCRIPTIONW}
    
37. SERVICE_DESCRIPTIONW = _SERVICE_DESCRIPTIONW;
    
38. {$EXTERNALSYM SERVICE_DESCRIPTION}
    
39. SERVICE_DESCRIPTION = _SERVICE_DESCRIPTIONA;
    
40. TServiceDescriptionA = _SERVICE_DESCRIPTIONA;
    
41. TServiceDescriptionW = _SERVICE_DESCRIPTIONW;
    
42. TServiceDescription = TServiceDescriptionA;
    
43. 
    
44. //
    
45. // Actions to take on service failure
    
46. //
    
47. {$EXTERNALSYM _SC_ACTION_TYPE}
    
48. _SC_ACTION_TYPE = (SC_ACTION_NONE, SC_ACTION_RESTART, SC_ACTION_REBOOT, SC_ACTION_RUN_COMMAND);
    
49. {$EXTERNALSYM SC_ACTION_TYPE}
    
50. SC_ACTION_TYPE = _SC_ACTION_TYPE;
    
51. 
    
52. PServiceAction = ^TServiceAction;
    
53. {$EXTERNALSYM _SC_ACTION}
    
54. _SC_ACTION = record
    
55. aType : SC_ACTION_TYPE;
    
56. Delay : DWORD;
    
57. end;
    
58. {$EXTERNALSYM SC_ACTION}
    
59. SC_ACTION = _SC_ACTION;
    
60. TServiceAction = _SC_ACTION;
    
61. 
    
62. PServiceFailureActionsA = ^TServiceFailureActionsA;
    
63. PServiceFailureActionsW = ^TServiceFailureActionsW;
    
64. PServiceFailureActions = PServiceFailureActionsA;
    
65. {$EXTERNALSYM _SERVICE_FAILURE_ACTIONSA}
    
66. _SERVICE_FAILURE_ACTIONSA = record
    
67. dwResetPeriod : DWORD;
    
68. lpRebootMsg : LPSTR;
    
69. lpCommand : LPSTR;
    
70. cActions : DWORD;
    
71. lpsaActions : ^SC_ACTION;
    
72. end;
    
73. {$EXTERNALSYM _SERVICE_FAILURE_ACTIONSW}
    
74. _SERVICE_FAILURE_ACTIONSW = record
    
75. dwResetPeriod : DWORD;
    
76. lpRebootMsg : LPWSTR;
    
77. lpCommand : LPWSTR;
    
78. cActions : DWORD;
    
79. lpsaActions : ^SC_ACTION;
    
80. end;
    
81. {$EXTERNALSYM _SERVICE_FAILURE_ACTIONS}
    
82. _SERVICE_FAILURE_ACTIONS = _SERVICE_FAILURE_ACTIONSA;
    
83. {$EXTERNALSYM SERVICE_FAILURE_ACTIONSA}
    
84. SERVICE_FAILURE_ACTIONSA = _SERVICE_FAILURE_ACTIONSA;
    
85. {$EXTERNALSYM SERVICE_FAILURE_ACTIONSW}
    
86. SERVICE_FAILURE_ACTIONSW = _SERVICE_FAILURE_ACTIONSW;
    
87. {$EXTERNALSYM SERVICE_FAILURE_ACTIONS}
    
88. SERVICE_FAILURE_ACTIONS = _SERVICE_FAILURE_ACTIONSA;
    
89. TServiceFailureActionsA = _SERVICE_FAILURE_ACTIONSA;
    
90. TServiceFailureActionsW = _SERVICE_FAILURE_ACTIONSW;
    
91. TServiceFailureActions = TServiceFailureActionsA;
    
92. 
    
93. ///////////////////////////////////////////////////////////////////////////
    
94. // API Function Prototypes
    
95. ///////////////////////////////////////////////////////////////////////////
    
96. TQueryServiceConfig2 = function (hService : SC_HANDLE; dwInfoLevel : DWORD; lpBuffer : pointer;
    
97. cbBufSize : DWORD; var pcbBytesNeeded) : BOOL; stdcall;
    
98. TChangeServiceConfig2 = function (hService : SC_HANDLE; dwInfoLevel : DWORD; lpInfo : pointer) : BOOL; stdcall;
    
99. 
    
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. end.

複製代碼

bestlong

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

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

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

1. unit ServiceDesktop;
   
2. 
   
3. interface
   
4. 
   
5. function InitServiceDesktop: boolean;
   
6. procedure DoneServiceDeskTop;
   
7. 
   
8. implementation
   
9. 
   
10. uses Windows, SysUtils;
    
11. 
    
12. const
    
13.   DefaultWindowStation = WinSta0;
    
14.   DefaultDesktop = Default;
    
15. 
    
16. var
    
17.   hwinstaSave: HWINSTA;
    
18.   hdeskSave: HDESK;
    
19.   hwinstaUser: HWINSTA;
    
20.   hdeskUser: HDESK;
    
21. 
    
22. function InitServiceDesktop: boolean;
    
23. var
    
24.   dwThreadId: DWORD;
    
25. begin
    
26.   dwThreadId := GetCurrentThreadID;
    
27.   // Ensure connection to service window station and desktop, and
    
28.   // save their handles.
    
29.   hwinstaSave := GetProcessWindowStation;
    
30.   hdeskSave := GetThreadDesktop(dwThreadId);
    
31. 
    
32.   hwinstaUser := OpenWindowStation(DefaultWindowStation, FALSE, MAXIMUM_ALLOWED);
    
33.   if hwinstaUser = 0 then
    
34.   begin
    
35.     OutputDebugString(PChar(OpenWindowStation failed + SysErrorMessage(GetLastError)));
    
36.     Result := false;
    
37.     exit;
    
38.   end;
    
39. 
    
40.   if not SetProcessWindowStation(hwinstaUser) then
    
41.   begin
    
42.     OutputDebugString(SetProcessWindowStation failed);
    
43.     Result := false;
    
44.     exit;
    
45.   end;
    
46. 
    
47.   hdeskUser := OpenDesktop(DefaultDesktop, 0, FALSE, MAXIMUM_ALLOWED);
    
48.   if hdeskUser = 0 then
    
49.   begin
    
50.     OutputDebugString(OpenDesktop failed);
    
51.     SetProcessWindowStation(hwinstaSave);
    
52.     CloseWindowStation(hwinstaUser);
    
53.     Result := false;
    
54.     exit;
    
55.   end;
    
56.   Result := SetThreadDesktop(hdeskUser);
    
57.   if not Result then
    
58.     OutputDebugString(PChar(SetThreadDesktop + SysErrorMessage(GetLastError)));
    
59. end;
    
60. 
    
61. procedure DoneServiceDeskTop;
    
62. begin
    
63.   // Restore window station and desktop.
    
64.   SetThreadDesktop(hdeskSave);
    
65.   SetProcessWindowStation(hwinstaSave);
    
66.   if hwinstaUser <> 0 then
    
67.     CloseWindowStation(hwinstaUser);
    
68.   if hdeskUser <> 0 then
    
69.     CloseDesktop(hdeskUser);
    
70. end;
    
71. 
    
72. initialization
    
73.   InitServiceDesktop;
    
74. finalization
    
75.   DoneServiceDesktop;
    
76. end.

複製代碼

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