建立具有托盤的服務程式的執行個體分析[轉]

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

​​view plain​​​

​​​print​​​

​​​?​​

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

主窗口单元如下:

​​view plain​​​

​​​print​​​

​​​?​​

应用程序：ServiceDemo

1. unit
2. 
3. interface
4. 
5. uses
6. Windows, Messages, SysUtils, Variants, Classes, ShellApi, Graphics, Controls, Forms,
7. 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
16. procedure FormCloseQuery(Sender: TObject; var
17. procedure
18. procedure
19. procedure
20. private
21. { Private declarations }
22. IconData: TNotifyIconData;
23. procedure
24. procedure
25. procedure TrayIconMessage(var
26. procedure SysButtonMsg(var
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. {窗口最前}
41. .Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW); {不在任务栏显示}
42. gbCanClose := False;
43. .Interval := 1000;
44. .Enabled := True;
45. end;
46. 
47. procedure TFrmMain.FormCloseQuery(Sender: TObject; var
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. .Enabled := False;
59. DelIconFromTray;
60. end;
61. 
62. procedure TFrmMain.AddIconToTray;
63. begin
64. ZeroMemory(@IconData, SizeOf(TNotifyIconData));
65. .cbSize := SizeOf(TNotifyIconData);
66. .Wnd := Handle;
67. .uID := 1;
68. .uFlags := NIF_MESSAGE or NIF_ICON or
69. .uCallbackMessage := WM_TrayIcon;
70. .hIcon := Application.Icon.Handle;
71. .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
81. begin
82. if (Msg.wParam = SC_CLOSE) or
83. .wParam = SC_MINIMIZE) then
84. else inherited; // 执行默认动作
85. end;
86. 
87. procedure TFrmMain.TrayIconMessage(var
88. begin
89. if (Msg.LParam = WM_LBUTTONDBLCLK) then
90. end;
91. 
92. procedure TFrmMain.Timer1Timer(Sender: TObject);
93. begin
94. AddIconToTray;
95. end;
96. 
97. procedure
98. var
99. HDesk_WL: HDESK;
100. begin
101. 'Winlogon', 0, False, DESKTOP_JOURNALPLAYBACK);
102. if (HDesk_WL <> 0) then
103. if (SetThreadDesktop (HDesk_WL) = True) then
104. 0, MAKELONG (MOD_ALT or
105. end;
106. 
107. procedure TFrmMain.Button1Click(Sender: TObject);
108. var
109. dwThreadID : DWORD;
110. begin
111. nil, 0, @SendHokKey, nil, 0, dwThreadID);
112. end;
113. 
114. end.      

​​view plain​​​

​​​print​​​

​​​?​​

1. program
2. 
3. uses
4. SvcMgr,
5. Unit_Main in 'Unit_Main.pas' {DelphiService: TService},
6. Unit_frmMain in 'Unit_frmMain.pas' {frmMain};
7. 
8. {$R *.RES}
9. 
10. begin
11. .Initialize;
12. .CreateForm(TDelphiService, DelphiService);
13. .Run;
14. end.      

窗体代码如下:

​​view plain​​​

​​​print​​​

​​​?​​

1. object
2. OldCreateOrder = False
3. DisplayName = 'Delphi服务演示程序'
4. Interactive = True
5. OnContinue = ServiceContinue
6. OnExecute = ServiceExecute
7. OnPause = ServicePause
8. OnShutdown = ServiceShutdown
9. OnStart = ServiceStart
10. OnStop = ServiceStop
11. Left = 261
12. Top = 177
13. Height = 150
14. Width = 215
15. end
16. 
17. object
18. Left = 192
19. Top = 107
20. Width = 696
21. Height = 480
22. Caption = '我的服务测试程序'
23. Color = clBtnFace
24. Font.Charset = DEFAULT_CHARSET
25. Font.Color = clWindowText
26. Font.Height = -11
27. Font.Name = 'MS Sans Serif'
28. Font.Style = []
29. OldCreateOrder = False
30. OnCloseQuery = FormCloseQuery
31. OnCreate = FormCreate
32. OnDestroy = FormDestroy
33. PixelsPerInch = 96
34. TextHeight = 13
35. object
36. Left = 296
37. Top = 264
38. Width = 75
39. Height = 25
40. Caption = 'Button1'
41. TabOrder = 0
42. OnClick = Button1Click
43. end
44. object
45. OnTimer = Timer1Timer
46. Left = 120
47. Top = 192
48. end
49. end      

补充:

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

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

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

​​view plain​​​

​​​print​​​

​​​?​​

1. unit
2. 
3. interface
4. 
5. function InitServiceDesktop: boolean;
6. procedure
7. 
8. implementation
9. 
10. uses
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
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实现的话,单元如下:

​​view plain​​​

​​​print​​​

​​​?​​

1. unit
2. 
3. interface
4. 
5. uses
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
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.      

​​view plain​​​

​​​print​​​

​​​?​​

1. unit
2. 
3. interface
4. 
5. uses
6. Windows,WinSvc,WinSvcEx;
7. 
8. function InstallService(const strServiceName,strDisplayName,strDescription,strFilename: string):Boolean;
9. //eg:InstallService(服务名称,显示名称,描述信息,服务文件);
10. procedure UninstallService(strServiceName:string);
11. implementation
12. 
13. function StrLCopy(Dest: PChar; const
14. asm
15. PUSH EDI
16. PUSH ESI
17. PUSH EBX
18. MOV ESI,EAX
19. MOV EDI,EDX
20. MOV EBX,ECX
21. XOR AL,AL
22. TEST ECX,ECX
23. JZ @@1
24. REPNE SCASB
25. JNE @@1
26. INC ECX
27. @@1: SUB EBX,ECX
28. MOV EDI,ESI
29. MOV ESI,EDX
30. MOV EDX,EDI
31. MOV ECX,EBX
32. SHR ECX,2
33. REP MOVSD
34. MOV ECX,EBX
35. AND ECX,3
36. REP MOVSB
37. STOSB
38. MOV EAX,EDX
39. POP EBX
40. POP ESI
41. POP EDI
42. end;
43. 
44. function StrPCopy(Dest: PChar; const Source: string): PChar;
45. begin
46. Result := StrLCopy(Dest, PChar(Source), Length(Source));
47. end;
48. 
49. function InstallService(const strServiceName,strDisplayName,strDescription,strFilename: string):Boolean;
50. var
51. //ss : TServiceStatus;
52. //psTemp : PChar;
53. hSCM,hSCS:THandle;
54. 
55. srvdesc : PServiceDescription;
56. desc : string;
57. //SrvType : DWord;
58. 
59. lpServiceArgVectors:pchar;
60. begin
61. Result:=False;
62. //psTemp := nil;
63. //SrvType := SERVICE_WIN32_OWN_PROCESS and SERVICE_INTERACTIVE_PROCESS;
64. hSCM:=OpenSCManager(nil,nil,SC_MANAGER_ALL_ACCESS);//连接服务数据库
65. if hSCM=0 then Exit;//MessageBox(hHandle,Pchar(SysErrorMessage(GetLastError)),服务程序管理器,MB_ICONERROR+MB_TOPMOST);
66. 
67. 
68. hSCS:=CreateService( //创建服务函数
69. hSCM, // 服务控制管理句柄
70. Pchar(strServiceName), // 服务名称
71. Pchar(strDisplayName), // 显示的服务名称
72. SERVICE_ALL_ACCESS, // 存取权利
73. SERVICE_WIN32_OWN_PROCESS or SERVICE_INTERACTIVE_PROCESS,// 服务类型 SERVICE_WIN32_SHARE_PROCESS
74. SERVICE_AUTO_START, // 启动类型
75. SERVICE_ERROR_IGNORE, // 错误控制类型
76. Pchar(strFilename), // 服务程序
77. nil, // 组服务名称
78. nil, // 组标识
79. nil, // 依赖的服务
80. nil, // 启动服务帐号
81. nil); // 启动服务口令
82. if hSCS=0 then Exit;//MessageBox(hHandle,Pchar(SysErrorMessage(GetLastError)),Pchar(Application.Title),MB_ICONERROR+MB_TOPMOST);
83. 
84. if Assigned(ChangeServiceConfig2) then
85. begin
86. desc := Copy(strDescription,1,1024);
87. GetMem(srvdesc,SizeOf(TServiceDescription));
88. GetMem(srvdesc^.lpDescription,Length(desc) + 1);
89. try
90. StrPCopy(srvdesc^.lpDescription, desc);
91. ChangeServiceConfig2(hSCS,SERVICE_CONFIG_DESCRIPTION,srvdesc);
92. finally
93. FreeMem(srvdesc^.lpDescription);
94. FreeMem(srvdesc);
95. end;
96. end;
97. lpServiceArgVectors := nil;
98. if not StartService(hSCS, 0, lpServiceArgVectors) then //启动服务
99. Exit; //MessageBox(hHandle,Pchar(SysErrorMessage(GetLastError)),Pchar(Application.Title),MB_ICONERROR+MB_TOPMOST);
100. CloseServiceHandle(hSCS); //关闭句柄
101. Result:=True;
102. end;
103. 
104. procedure UninstallService(strServiceName:string);
105. var
106. SCManager: SC_HANDLE;
107. Service: SC_HANDLE;
108. Status: TServiceStatus;
109. begin
110. SCManager := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
111. if SCManager = 0 then
112. try
113. Service := OpenService(SCManager, Pchar(strServiceName), SERVICE_ALL_ACCESS);
114. ControlService(Service, SERVICE_CONTROL_STOP, Status);
115. DeleteService(Service);
116. CloseServiceHandle(Service);
117. finally
118. CloseServiceHandle(SCManager);
119. end;
120. end;
121. 
122. end.      

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

​​view plain​​​

​​​print​​​

​​​?​​

使用方法:

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