本文整理自网络,侵删。
uses TLHelp32;
{$R *.dfm}
const
KILL_ERR=0;
KILL_NOTSUPPORTED=-1;
KILL_ERR_OPENPROCESS=-2;
KILL_ERR_TERMINATEPROCESS=-3;
ENUM_NOERR=0;
ENUM_NOTSUPPORTED=-1;
ENUM_ERR_OPENPROCESSTOKEN=-2;
ENUM_ERR_LookupPrivilegeValue=-3;
ENUM_ERR_AdjustTokenPrivileges=-4;
SE_DEBUG_NAME='SeDebugPrivilege';
function EnableDebugPrivilegeNT:integer;
var
hToken:THANDLE;
DebugValue:TLargeInteger;
tkp:TTokenPrivileges ;
ReturnLength:DWORD;
PreviousState:TTokenPrivileges;
begin
if (OpenProcessToken(GetCurrentProcess,TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY,hToken)=false) then
result:=ENUM_ERR_OPENPROCESSTOKEN
else
begin
if (LookupPrivilegeValue(nil,SE_DEBUG_NAME,DebugValue)=false) then
result:=ENUM_ERR_LookupPrivilegeValue
else
begin
ReturnLength:=0;
tkp.PrivilegeCount:=1;
tkp.Privileges[0].Luid:=DebugValue;
tkp.Privileges[0].Attributes:=SE_PRIVILEGE_ENABLED;
AdjustTokenPrivileges(hToken,false,tkp,SizeOf(TTokenPrivileges),PreviousState,ReturnLength);
if (GetLastError <> ERROR_SUCCESS) then
result:=ENUM_ERR_AdjustTokenPrivileges
else
result:=ENUM_NOERR;
end;
end;
end;
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;
procedure TForm1.Button1Click(Sender: TObject);
var
TemStr:String;
begin
EnableDebugPrivilegeNT();
TemStr:='QQ.EXE';
if TemStr<>'' then
begin
if KillTask(TemStr)=KILL_ERR then
messagebox(0,'Fail!','kill',0)
else
messagebox(0,'Success!','kill',0);
end;
end;
相关阅读 >>
Delphi 使用firedac打开sqlite数据库韩文、阿拉伯文出现乱码的处理方法
Delphi socket connect timeout 套字节链接超时设置
更多相关阅读请进入《Delphi》频道 >>