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;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var Proc :TPROCESSENTRY32 ;
Snap :THandle;
str_proc_msg,str:string;
result:BOOL;
i,j:integer;
begin
TaskList.Items.Clear;
Snap := CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS,0);
Proc.dwSize := SizeOf(TProcessEntry32);
Process32First(Snap,Proc);
repeat
TaskList.Items.Add(proc.szExeFile);
until (not Process32Next(Snap,Proc));
for i:=0 to tasklist.Items.count -1 do
begin
if AnsiContainsText(tasklist.Items.Strings[i],'QQ.exe')then
begin
str:=tasklist.Items.Strings[i];
killtask(str);
if checkbox1.Checked then
messagebox(form1.handle,'现在不能上QQ聊天','管理员警告',mb_ok);
exit;
end;
end;
end;
以上程序是我用一个timer每0.1秒检测一次进程中是否有QQ.exe,如果有就强行结束掉。效果还是可能的,但是又出现一个新的问题,这个程序执行的时候,机器关不了了,怎么办?望高手解答!!
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;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var Proc :TPROCESSENTRY32 ;
Snap :THandle;
str_proc_msg,str:string;
result:BOOL;
i,j:integer;
begin
TaskList.Items.Clear;
Snap := CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS,0);
Proc.dwSize := SizeOf(TProcessEntry32);
Process32First(Snap,Proc);
repeat
TaskList.Items.Add(proc.szExeFile);
until (not Process32Next(Snap,Proc));
for i:=0 to tasklist.Items.count -1 do
begin
if AnsiContainsText(tasklist.Items.Strings[i],'QQ.exe')then
begin
str:=tasklist.Items.Strings[i];
killtask(str);
if checkbox1.Checked then
messagebox(form1.handle,'现在不能上QQ聊天','管理员警告',mb_ok);
exit;
end;
end;
end;
以上程序是我用一个timer每0.1秒检测一次进程中是否有QQ.exe,如果有就强行结束掉。效果还是可能的,但是又出现一个新的问题,这个程序执行的时候,机器关不了了,怎么办?望高手解答!!
解决方案 »
免费领取超大流量手机卡,每月29元包185G流量+100分钟通话, 中国电信官方发货