用Delphi创建服务程序

【 tulaoshi.com - 编程语言 】

　　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,并且把这个窗口设置为手工创建.完成后的代码如下:
　　
　　
　　unit Unit_Main;
　　
　　interface
　　
　　uses
　　Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs, Unit_FrmMain;
　　
　　type
　　TDelphiService = class(TService)
　　procedure ServiceContinue(Sender: TService; var Continued: Boolean);
　　procedure ServiceExecute(Sender: TService);
　　procedure ServicePause(Sender: TService; var Paused: Boolean);
　　procedure ServiceShutdown(Sender: TService);
　　procedure ServiceStart(Sender: TService; var Started: Boolean);
　　procedure ServiceStop(Sender: TService; var Stopped: Boolean);
　　private
　　{ Private declarations }
　　public
　　function GetServiceController: TServiceController; override;
　　{ Public declarations }
　　end;
　　
　　var
　　DelphiService: TDelphiService;
　　FrmMain: TFrmMain;
　　implementation
　　
　　{$R *.DFM}
　　
　　procedure ServiceController(CtrlCode: DWord); stdcall;
　　begin
　　DelphiService.Controller(CtrlCode);
　　end;
　　
　　function TDelphiService.GetServiceController: TServiceController;
　　begin
　　Result := ServiceController;
　　end;
　　
　　procedure TDelphiService.ServiceContinue(Sender: TService;
　　var Continued: Boolean);
　　begin
　　while not Terminated do
　　begin
　　Sleep(10);
　　ServiceThread.ProcessRequests(False);
　　end;
　　end;
　　
　　procedure TDelphiService.ServiceExecute(Sender: TService);
　　begin
　　while not Terminated do
　　begin
　　Sleep(10);
　　ServiceThread.ProcessRequests(False);
　　end;
　　end;
　　
　　procedure TDelphiService.ServicePause(Sender: TService;
　　var Paused: Boolean);
　　begin
　　Paused := True;
　　end;
　　
　　procedure TDelphiService.ServiceShutdown(Sender: TService);
　　begin
　　gbCanClose := true;
　　FrmMain.Free;
　　Status := csStopped;
　　ReportStatus();
　　end;
　　
　　procedure TDelphiService.ServiceStart(Sender: TService;
　　var Started: Boolean);
　　begin
　　Started := True;
　　Svcmgr.Application.CreateForm(TFrmMain, FrmMain);
　　gbCanClose := False;
　　FrmMain.Hide;
　　end;
　　
　　procedure TDelphiService.ServiceStop(Sender: TService;
　　var Stopped: Boolean);
　　begin
　　Stopped := True;
　　gbCanClose := True;
　　FrmMain.Free;
　　end;
　　
　　end.
　　
　　
　　主窗口单元如下:
　　
　　unit Unit_FrmMain;
　　
　　interface
　　
　　uses
　　Windows, Messages, SysUtils, Variants, Classes, ShellApi, Graphics, Controls, Forms,
　　Dialogs, ExtCtrls, StdCtrls;
　　
　　const
　　WM_TrayIcon = WM_USER + 1234;
　　type
　　TFrmMain = class(TForm)
　　Timer1: TTimer;
　　Button1: TButton;
　　procedure FormCreate(Sender: TObject);
　　procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
　　procedure FormDestroy(Sender: TObject);
　　procedure Timer1Timer(Sender: TObject);
　　procedure Button1Click(Sender: TObject);
　　private
　　{ Private declarations }
　　IconData: TNotifyIconData;
　　procedure AddIconToTray;
　　procedure DelIconFromTray;
　　procedure TrayIconMessage(var Msg: TMessage); message WM_TrayIcon;
　　procedure SysButtonMsg(var Msg: TMessage); message WM_SYSCOMMAND;
　　public
　　{ Public declarations }
　　end;
　　
　　var
　　FrmMain: TFrmMain;
　　gbCanClose: Boolean;
　　implementation
　　
　　{$R *.dfm}
　　
　　procedure TFrmMain.FormCreate(Sender: TObject);
　　begin
　　FormStyle := fsStayOnTop;
　　SetWindowLong(Application.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW);
　　gbCanClose := False;
　　Timer1.Interval := 1000;
　　Timer1.Enabled := True;
　　end;
　　
　　procedure TFrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
　　begin
　　CanClose := gbCanClose;
　　if not CanClose then
　　begin
　　Hide;
　　end;
　　end;
　　
　　procedure TFrmMain.FormDestroy(Sender: TObject);
　　begin
　　Timer1.Enabled := False;
　　DelIconFromTray;
　　end;
　　
　　procedure TFrmMain.AddIconToTray;
　　begin
　　ZeroMemory(@IconData, SizeOf(TNotifyIconData));
　　IconData.cbSize := SizeOf(TNotifyIconData);
　　IconData.Wnd := Handle;
　　IconData.uID := 1;
　　IconData.uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;
　　IconData.uCallbackMessage := WM_TrayIcon;
　　IconData.hIcon := Application.Icon.Handle;
　　IconData.szTip := Delphi服务演示程序;
　　Shell_NotifyIcon(NIM_ADD, @IconData);
　　end;
　　
　　procedure TFrmMain.DelIconFromTray;
　　begin
　　Shell_NotifyIcon(NIM_DELETE, @IconData);
　　end;
　　
　　procedure TFrmMain.SysButtonMsg(var Msg: TMessage);
　　begin
　　if (Msg.wParam = SC_CLOSE) or
　　(Msg.wParam = SC_MINIMIZE) then Hide
　　else inherited; // 执行默认动作
　　end;
　　
　　procedure TFrmMain.TrayIconMessage(var Msg: TMessage);
　　begin
　　if (Msg.LParam = WM_LBUTTONDBLCLK) then Show();
　　end;
　　
　　procedure TFrmMain.Timer1Timer(Sender: TObject);
　　begin
　　AddIconToTray;
　　end;
　　
　　procedure SendHokKey;stdcall;
　　var
　　HDesk_WL: HDESK;
　　begin
　　HDesk_WL := OpenDesktop (WinLogon, 0, False, DESKTOP_JOURNALPLAYBACK);
　　if (HDesk_WL 0) then
　　if (SetThreadDesktop (HDesk_WL) = True) then
　　PostMessage(HWND_BROADCAST, WM_HOTKEY, 0, MAKELONG (MOD_ALT or MOD_CONTROL, VK_DELETE));
　　end;
　　
　　procedure TFrmMain.Button1Click(Sender: TObject);
　　var
　　dwThreadID : DWORD;
　　begin
　　CreateThread(nil, 0, @SendHokKey, nil, 0, dwThreadID);
　　end;
　　
　　end.
　　
　　
　　补充:
　　(1)关于更多服务程序的演示程序,请访问以下Url:http://www.torry.net/pages.php？id=226,上面包含了多个演示如何控制和管理系统服务的代码.
　　
　　(2)请切记:Windows实际上存在多个桌面.例如屏幕传输会出现白屏,可能有两个原因:一是系统处于锁定或未登陆桌面,二是处于屏幕保护桌面.这时候要将当前桌面切换到该桌面才能抓屏.
　　
　　(3)关于服务程序与桌面交互,还有种动态切换方法.大概单元如下:
　　unit ServiceDesktop;
　　
　　interface
　　
　　function InitServiceDesktop: boolean;
　　procedure DoneServiceDeskTop;
　　
　　implementation
　　
　　uses Windows, SysUtils;
　　
　　const
　　DefaultWindowStation = WinSta0;
　　DefaultDesktop = Default;
　　var
　　hwinstaSave: HWINSTA;
　　hdeskSave: HDESK;
　　hwinstaUser: HWINSTA;
　　hdeskUser: HDESK;
　　function InitServiceDesktop: boolean;
　　var
　　dwThreadId: DWORD;
　　begin
　　dwThreadId := GetCurrentThreadID;
　　// Ensure connection to service window station and desktop, and
　　// save their handles.
　　hwinstaSave := GetProcessWindowStation;
　　hdeskSave := GetThreadDesktop(dwThreadId);
　　
　　
　　hwinstaUser := OpenWindowStation(DefaultWindowStation, FALSE, MAXIMUM_ALLOWED);
　　if hwinstaUser = 0 then
　　begin
　　OutputDebugString(PChar(OpenWindowStation failed + SysErrorMessage(GetLastError)));
　　Result := false;
　　exit;
　　end;
　　
　　if not SetProcessWindowStation(hwinstaUser) then
　　begin
　　OutputDebugString(SetProcessWindowStation failed);
　　Result := false;
　　exit;
　　end;
　　
　　hdeskUser := OpenDesktop(DefaultDesktop, 0, FALSE, MAXIMUM_ALLOWED);
　　if hdeskUser = 0 then
　　begin
　　OutputDebugString(OpenDesktop failed);
　　SetProcessWindowStation(hwinstaSave);
　　CloseWindowStation(hwinstaUser);
　　Result := false;
　　exit;
　　end;
　　Result := SetThreadDesktop(hdeskUser);
　　if not Result then
　　OutputDebugString(PChar(SetThreadDesktop + SysErrorMessage(GetLastError)));
　　end;
　　
　　procedure DoneServiceDeskTop;
　　begin
　　// Restore window station and desktop.
　　SetThreadDesktop(hdeskSave);
　　SetProcessWindowStation(hwinstaSave);
　　if hwinstaUser 0 then
　　CloseWindowStation(hwinstaUser);
　　if hdeskUser 0 then
　　CloseDesktop(hdeskUser);
　　end;
　　
　　initialization
　　InitServiceDesktop;
　　finalization
　　DoneServiceDesktop;
　　end.
　　更详细的演示代码请参看:http://www.torry.net/samples/samples/os/isarticle.zip
　　
　　(4)关于安装服务如何添加服务描述.有两种方法:一是修改注册表.服务的详细信息都位于HKEY_LOCAL_MACHINESYSTEM ControlSet001Services下面,例如我们刚才那个服务就位于HKEY_LOCAL_MACHINESYSTEM ControlSet001ServicesDelphiService下.第二种方法就是先用QueryServiceConfig2函数获取服务信息,然后ChangeServiceConfig2来改变描述.用Delphi实现的话,单元如下:
　　
　　unit WinSvcEx;
　　
　　interface
　　
　　uses Windows, WinSvc;
　　
　　const
　　//
　　// Service config info levels
　　//
　　SERVICE_CONFIG_DESCRIPTION = 1;
　　SERVICE_CONFIG_FAILURE_ACTIONS = 2;
　　//
　　// DLL name of imported functions
　　//
　　AdvApiDLL = advapi32.dll;
　　type
　　//
　　// Service description string
　　//
　　PServiceDescriptionA = ^TServiceDescriptionA;
　　PServiceDescriptionW = ^TServiceDescriptionW;
　　PServiceDescription = PServiceDescriptionA;
　　{$EXTERNALSYM _SERVICE_DESCRIPTIONA}
　　_SERVICE_DESCRIPTIONA = record
　　lpDescription : PAnsiChar;
　　end;
　　{$EXTERNALSYM _SERVICE_DESCRIPTIONW}
　　_SERVICE_DESCRIPTIONW = record
　　lpDescription : PWideChar;
　　end;
　　{$EXTERNALSYM _SERVICE_DESCRIPTION}
　　_SERVICE_DESCRIPTION = _SERVICE_DESCRIPTIONA;
　　{$EXTERNALSYM SERVICE_DESCRIPTIONA}
　　SERVICE_DESCRIPTIONA = _SERVICE_DESCRIPTIONA;
　　{$EXTERNALSYM SERVICE_DESCRIPTIONW}
　　SERVICE_DESCRIPTIONW = _SERVICE_DESCRIPTIONW;
　　{$EXTERNALSYM SERVICE_DESCRIPTION}
　　SERVICE_DESCRIPTION = _SERVICE_DESCRIPTIONA;
　　TServiceDescriptionA = _SERVICE_DESCRIPTIONA;
　　TServiceDescriptionW = _SERVICE_DESCRIPTIONW;
　　TServiceDescription = TServiceDescriptionA;
　　
　　//
　　// Actions to take on service failure
　　//
　　{$EXTERNALSYM _SC_ACTION_TYPE}
　　_SC_ACTION_TYPE = (SC_ACTION_NONE, SC_ACTION_RESTART, SC_ACTION_REBOOT, SC_ACTION_RUN_COMMAND);
　　{$EXTERNALSYM SC_ACTION_TYPE}
　　SC_ACTION_TYPE = _SC_ACTION_TYPE;
　　
　　PServiceAction = ^TServiceAction;
　　{$EXTERNALSYM _SC_ACTION}
　　_SC_ACTION = record
　　aType : SC_ACTION_TYPE;
　　Delay : DWORD;
　　end;
　　{$EXTERNALSYM SC_ACTION}
　　SC_ACTION = _SC_ACTION;
　　TServiceAction = _SC_ACTION;
　　
　　PServiceFailureActionsA = ^TServiceFailureActionsA;
　　PServiceFailureActionsW = ^TServiceFailureActionsW;
　　PServiceFailureActions = PServiceFailureActionsA;
　　{$EXTERNALSYM _SERVICE_FAILURE_ACTIONSA}
　　_SERVICE_FAILURE_ACTIONSA = record
　　dwResetPeriod : DWORD;
　　lpRebootMsg : LPSTR;
　　lpCommand : LPSTR;
　　cActions : DWORD;
　　lpsaActions : ^SC_ACTION;
　　end;
　　{$EXTERNALSYM _SERVICE_FAILURE_ACTIONSW}
　　_SERVICE_FAILURE_ACTIONSW = record
　　dwResetPeriod : DWORD;
　　lpRebootMsg : LPWSTR;
　　lpCommand : LPWSTR;
　　cActions : DWORD;
　　lpsaActions : ^SC_ACTION;
　　end;
　　{$EXTERNALSYM _SERVICE_FAILURE_ACTIONS}
　　_SERVICE_FAILURE_ACTIONS = _SERVICE_FAILURE_ACTIONSA;
　　{$EXTERNALSYM SERVICE_FAILURE_ACTIONSA}
　　SERVICE_FAILURE_ACTIONSA = _SERVICE_FAILURE_ACTIONSA;
　　{$EXTERNALSYM SERVICE_FAILURE_ACTIONSW}
　　SERVICE_FAILURE_ACTIONSW = _SERVICE_FAILURE_ACTIONSW;
　　{$EXTERNALSYM SERVICE_FAILURE_ACTIONS}
　　SERVICE_FAILURE_ACTIONS = _SERVICE_FAILURE_ACTIONSA;
　　TServiceFailureActionsA = _SERVICE_FAILURE_ACTIONSA;
　　TServiceFailureActionsW = _SERVICE_FAILURE_ACTIONSW;
　　TServiceFailureActions = TServiceFailureActionsA;
　　
　　///////////////////////////////////////////////////////////////////////////
　　// API Function Prototypes
　　///////////////////////////////////////////////////////////////////////////
　　TQueryServiceConfig2 = function (hService : SC_HANDLE; dwInfoLevel : DWORD; lpBuffer : pointer;
　　cbBufSize : DWORD; var pcbBytesNeeded) : BOOL; stdcall;
　　TChangeServiceConfig2 = function (hService : SC_HANDLE; dwInfoLevel : DWORD; lpInfo : pointer) : BOOL; stdcall;
　　
　　var
　　hDLL : THandle ;
　　LibLoaded : boolean ;
　　
　　var
　　OSVersionInfo : TOSVersionInfo;
　　
　　{$EXTERNALSYM QueryServiceConfig2A}
　　QueryServiceConfig2A : TQueryServiceConfig2;
　　{$EXTERNALSYM QueryServiceConfig2W}
　　QueryServiceConfig2W : TQueryServiceConfig2;
　　{$EXTERNALSYM QueryServiceConfig2}
　　QueryServiceConfig2 : TQueryServiceConfig2;
　　
　　{$EXTERNALSYM ChangeServiceConfig2A}
　　ChangeServiceConfig2A : TChangeServiceConfig2;
　　{$EXTERNALSYM ChangeServiceConfig2W}
　　ChangeServiceConfig2W : TChangeServiceConfig2;
　　{$EXTERNALSYM ChangeServiceConfig2}
　　ChangeServiceConfig2 : TChangeServiceConfig2;
　　
　　implementation
　　
　　initialization
　　OSVersionInfo.dwOSVersionInfoSize := SizeOf(OSVersionInfo);
　　GetVersionEx(OSVersionInfo);
　　if (OSVersionInfo.dwPlatformId = VER_PLATFORM_WIN32_NT) and (OSVersionInfo.dwMajorVersion = 5) then
　　begin
　　if hDLL = 0 then
　　begin
　　hDLL:=GetModuleHandle(AdvApiDLL);
　　LibLoaded := False;
　　if hDLL = 0 then
　　begin
　　hDLL := LoadLibrary(AdvApiDLL);
　　LibLoaded := True;
　　end;
　　end;
　　
　　if hDLL 0 then
　　begin
　　@QueryServiceConfig2A := GetProcAddress(hDLL, QueryServiceConfig2A);
　　@QueryServiceConfig2W := GetProcAddress(hDLL, QueryServiceConfig2W);
　　@QueryServiceConfig2 := @QueryServiceConfig2A;
　　@ChangeServiceConfig2A := GetProcAddress(hDLL, ChangeServiceConfig2A);
　　@ChangeServiceConfig2W := GetProcAddress(hDLL, ChangeServiceConfig2W);
　　@ChangeServiceConfig2 := @ChangeServiceConfig2A;
　　end;
　　end
　　else
　　begin
　　@QueryServiceConfig2A := nil;
　　@QueryServiceConfig2W := nil;
　　@QueryServiceConfig2 := nil;
　　@ChangeServiceConfig2A := nil;
　　@ChangeServiceConfig2W := nil;
　　@ChangeServiceConfig2 := nil;
　　end;
　　
　　finalization
　　if (hDLL 0) and LibLoaded then
　　FreeLibrary(hDLL);
　　
　　end.
　　
　　unit winntService;
　　
　　interface
　　
　　uses
　　Windows,WinSvc,WinSvcEx;
　　
　　function InstallService(const strServiceName,strDisplayName,strDescription,strFilename: string):Boolean;
　　//eg:InstallService(服务名称,显示名称,描述信息,服务文件);
　　procedure UninstallService(strServiceName:string);
　　implementation
　　
　　function StrLCopy(Dest: PChar; const Source: PChar; MaxLen: Cardinal): PChar; assembler;
　　asm
　　PUSH EDI
　　PUSH ESI
　　PUSH EBX
　　MOV ESI,EAX
　　MOV EDI,EDX
　　MOV EBX,ECX
　　XOR AL,AL
　　TEST ECX,ECX
　　JZ @@1
　　REPNE SCASB
　　JNE @@1
　　INC ECX
　　@@1: SUB EBX,ECX
　　MOV EDI,ESI
　　MOV ESI,EDX
　　MOV EDX,EDI
　　MOV ECX,EBX
　　SHR ECX,2
　　REP MOVSD
　　MOV ECX,EBX
　　AND ECX,3
　　REP MOVSB
　　STOSB
　　MOV EAX,EDX
　　POP EBX
　　POP ESI
　　POP EDI
　　end;
　　
　　function StrPCopy(Dest: PChar; const Source: string): PChar;
　　begin
　　Result := StrLCopy(Dest, PChar(Source), Length(Source));
　　end;
　　
　　function InstallService(const strServiceName,strDisplayName,strDescription,strFilename: string):Boolean;
　　var
　　//ss : TServiceStatus;
　　//psTemp : PChar;
　　hSCM,hSCS:THandle;
　　
　　srvdesc : PServiceDescription;
　　desc : string;
　　//SrvType : DWord;
　　
　　lpServiceArgVectors:pchar;
　　begin
　　Result:=False;
　　//psTemp := nil;
　　//SrvType := SERVICE_WIN32_OWN_PROCESS and SERVICE_INTERACTIVE_PROCESS;
　　hSCM:=OpenSCManager(nil,nil,SC_MANAGER_ALL_ACCESS);//连接服务数据库
　　if hSCM=0 then Exit;//MessageBox(hHandle,Pchar(SysErrorMessage(GetLastError)),服务程序管理器,MB_ICONERROR+MB_TOPMOST);
　　
　　
　　hSCS:=CreateService( //创建服务函数
　　hSCM, // 服务控制管理句柄
　　Pchar(strServiceName), // 服务名称
　　Pchar(strDisplayName), // 显示的服务名称
　　SERVICE_ALL_ACCESS, // 存取权利
　　SERVICE_WIN32_OWN_PROCESS or SERVICE_INTERACTIVE_PROCESS,// 服务类型 SERVICE_WIN32_SHARE_PROCESS
　　SERVICE_AUTO_START, // 启动类型
　　SERVICE_ERROR_IGNORE, // 错误控制类型
　　Pchar(strFilename), // 服务程序
　　nil, // 组服务名称
　　nil, // 组标识
　　nil, // 依赖的服务
　　nil, // 启动服务帐号
　　nil); // 启动服务口令
　　if hSCS=0 then Exit;//MessageBox(hHandle,Pchar(SysErrorMessage(GetLastError)),Pchar(Application.Title),MB_ICONERROR+MB_TOPMOST);
　　
　　if Assigned(ChangeServiceConfig2) then
　　begin
　　desc := Copy(strDescription,1,1024);
　　GetMem(srvdesc,SizeOf(TServiceDescription));
　　GetMem(srvdesc^.lpDescription,Length(desc) + 1);
　　try
　　StrPCopy(srvdesc^.lpDescription, desc);
　　ChangeServiceConfig2(hSCS,SERVICE_CONFIG_DESCRIPTION,srvdesc);
　　finally
　　FreeMem(srvdesc^.lpDescription);
　　FreeMem(srvdesc);
　　end;
　　end;
　　lpServiceArgVectors := nil;
　　if not StartService(hSCS, 0, lpServiceArgVectors) then //启动服务
　　Exit; //MessageBox(hHandle,Pchar(SysErrorMessage(GetLastError)),Pchar(Application.Title),MB_ICONERROR+MB_TOPMOST);
　　CloseServiceHandle(hSCS); //关闭句柄
　　Result:=True;
　　end;
　　
　　procedure UninstallService(strServiceName:string);
　　var
　　SCManager: SC_HANDLE;
　　Service: SC_HANDLE;
　　Status: TServiceStatus;
　　begin
　　SCManager := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
　　if SCManager = 0 then Exit;
　　try
　　Service := OpenService(SCManager, Pchar(strServiceName), SERVICE_ALL_ACCESS);
　　ControlService(Service, SERVICE_CONTROL_STOP, Status);
　　DeleteService(Service);
　　CloseServiceHandle(Service);
　　finally
　　CloseServiceHandle(SCManager);
　　end;
　　end;
　　
　　end.
　　
　　(5)如何暴力关闭一个服务程序,实现我们以前那个"NT工具箱"的功能？首先,根据进程名称来杀死进程是用以下函数:
　　uses Tlhelp32;
　　
　　function KillTask(ExeFileName: string): Integer;
　　const
　　PROCESS_TERMINATE = 01;
　　var
　　ContinueLoop: BOOL;
　　FSnapshotHandle: THandle;
　　FProcessEntry32: TProcessEntry32;
　　begin
　　Result := 0;
　　FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
　　FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
　　ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);
　　
　　while Integer(ContinueLoop) 0 do
　　begin
　　if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =
　　UpperCase(ExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) =
　　UpperCase(ExeFileName))) then
　　Result := Integer(TerminateProcess(
　　OpenProcess(PROCESS_TERMINATE,
　　BOOL(0),
　　FProcessEntry32.th32ProcessID),
　　0));
　　ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
　　end;
　　CloseHandle(FSnapshotHandle);
　　end;
　　
　　但是对于服务程序,它会提示"拒绝访问".其实只要程序拥有Debug权限即可:
　　function EnableDebugPrivilege: Boolean;
　　function EnablePrivilege(hToken: Cardinal; PrivName: string; bEnable: Boolean): Boolean;
　　var
　　TP: TOKEN_PRIVILEGES;
　　Dummy: Cardinal;
　　begin
　　TP.PrivilegeCount := 1;
　　LookupPrivilegeValue(nil, pchar(PrivName), TP.Privileges[0].Luid);
　　if bEnable then
　　TP.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED
　　else TP.Privileges[0].Attributes := 0;
　　AdjustTokenPrivileges(hToken, False, TP, SizeOf(TP), nil, Dummy);
　　Result := GetLastError = ERROR_SUCCESS;
　　end;
　　
　　var
　　hToken: Cardinal;
　　begin
　　OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES, hToken);
　　result:=EnablePrivilege(hToken, SeDebugPrivilege, True);
　　CloseHandle(hToken);
　　end;
　　
　　使用方法:
　　EnableDebugPrivilege;//提升权限
　　KillTask(xxxx.exe);//关闭该服务程序.