视窗系统 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

 

视窗系统, 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

 

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

 

(3)关于服务程式和桌面交互,更有种动态转换方法.大概单元如下:

 

unit ServiceDesktop;

 

interface

 

function InitServiceDesktop: boolean;

 

procedure DoneServiceDeskTop;

 

implementation

 

uses 视窗系统, 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_MACHINE＼SYSTEM＼ControlSet001＼Services＼下面,例如我们刚才那个服务就位于HKEY_LOCAL_MACHINE＼SYSTEM＼ControlSet001＼Services＼DelphiService下.第二种方法就是先用QueryServiceConfig2函数获取服务信息,然后ChangeServiceConfig2来改动描述.用Delphi实现的话,单元如下:

 

unit WinSvcEx;

 

interface

 

uses 视窗系统, 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

 

视窗系统,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 = $0001;

 

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);//关闭该服务程式.

 

-----------------------------------作者：陈经韬 来源：CnXHacker.Net -----------------