this slowpoke moves

Terminate Process

uses tlhelp32

{**                Prozesse in Stringliste schreiben                   **}
procedure GetProcs(sl: TStringlist);
var
  hProcSnap: THandle;
  pe32: TProcessEntry32;
begin
  hProcSnap := CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS, 0);
  if hProcSnap = INVALID_HANDLE_VALUE then exit;
  pe32.dwSize := SizeOf(ProcessEntry32);
  if Process32First(hProcSnap, pe32) = true then
    while Process32Next(hProcSnap, pe32) = true do
    begin
      sl.Add(pe32.szExeFile);
    end;
  CloseHandle(hProcSnap);
end;

{**            ProzessID an Hand der Exe-Datei ermittlen               **}
function GetProcID(sProcName: String): Integer;
var
  hProcSnap: THandle;
  pe32: TProcessEntry32;
begin
  result := -1;
  hProcSnap := CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS, 0);
  if hProcSnap = INVALID_HANDLE_VALUE then exit;
  pe32.dwSize := SizeOf(ProcessEntry32);
  if Process32First(hProcSnap, pe32) = true then
    while Process32Next(hProcSnap, pe32) = true do
    begin
      if pos(sProcName, pe32.szExeFile) <> 0then
      result := pe32.th32ProcessID;
    end;
end;
 

{**                         Prozess beenden                            **}
procedure KillIt(dwProcID: DWORD);
var
  hProcess : Cardinal;
  dw : DWORD;
begin
  { open the process and store the process-handle }
  hProcess := OpenProcess(SYNCHRONIZE or PROCESS_TERMINATE, False, dwProcID);
  { kill it }
  TerminateProcess(hProcess, 0);
  { TerminateProcess returns immediately, so wie have to verify the result via WaitfForSingleObject }
  dw := WaitForSingleObject(hProcess, 5000);
  case dw of
    { everythingss all right, we killed the process }
    WAIT_OBJECT_0: Messagebox(Application.Handle, 'Prozess wurde beendet.', 'Prozess beenden',MB_ICONINFORMATION);
    { process could not be terminated after 5 seconds }
    WAIT_TIMEOUT:
      begin
        Messagebox(Application.Handle, 'Prozess konnte nicht innerhalb von 5 Sekunden beendet werden.', 'Prozess beenden', MB_ICONSTOP);
        exit;
      end;
    { error in calling WaitForSingleObject }
    WAIT_FAILED:
      begin
        RaiseLastOSError;
        exit;
      end;
  end;
  //Form1.Button1Click(Form1);
end;

{**     Button zum Auflisten der Prozesse und in Listbox schreiben     **}
procedure TForm1.Button1Click(Sender: TObject);
var
  sl : TStringlist;
begin
  sl := TStringlist.Create;
  try
    GetProcs(sl);
    Listbox1.Clear;
    Listbox1.Items.Assign(sl);
  finally
    sl.Free;
  end;
end;
Beispiel :
procedure TForm1.Button2Click(Sender: TObject);
begin
   KillIt(GetProcID(Listbox1.Items.Strings[Listbox1.ItemIndex]));
end;

Keine Kommentare:

Kommentar veröffentlichen

Beliebte Posts

Translate