?

如何用 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,并且把這個窗口設置為手工創建.完成后的代碼如下:

?

view sourceprint?

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.

?

主窗口單元如下:

?

view sourceprint?

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)關于服務程序與桌面交互,還有種動態切換方法.大概單元如下:

view sourceprint?

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實現的話,單元如下:

view sourceprint?

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工具箱"的功能?首先,根據進程名稱來殺死進程是用以下函數:

?

view sourceprint?

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權限即可:

?

view sourceprint?

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;

?

使用方法:

view sourceprint?

1	EnableDebugPrivilege;//提升權限

2

??

3	KillTask(xxxx.exe);//關閉該服務程序.

?

?

轉載于:https://www.cnblogs.com/ywangzi/archive/2011/10/24/2222850.html

總結

以上是生活随笔為你收集整理的Delphi 写服务程序的全部內容，希望文章能夠幫你解決所遇到的問題。

如果覺得生活随笔網站內容還不錯，歡迎將生活随笔推薦給好友。