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,如果有就强行结束掉。效果还是可能的,但是又出现一个新的问题,这个程序执行的时候,机器关不了了,怎么办?望高手解答!!