Programm durch Delphi Programm beenden?

[Cronos]

Eine Frage, ich suche nen Script mit dem ich andere offene ( meißt im hintergrund laufende) Programme mit einem kleinen Delphi programm beenden kann.
Ich bin leider Anfänger und bring das nicht zusammen.

Danke

[JasonDX]

Wer suchet,der findet

greetz
Mike

[Cronos]

Da Hab ich leider nichts gefunden ;(

[ichbins]

Prozess beenden oder gleich in der Code Library: Prozess beenden

folgender Code:

Delphi-Quellcode:

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);

  { wenn es geklappt hat }
  if Process32First(hProcSnap, pe32) = true then
    { und los geht's: Prozess suchen}
    while Process32Next(hProcSnap, pe32) = true do
    begin
      if pos(sProcName, pe32.szExeFile) <> 0then
        result := pe32.th32ProcessID;
    end;
end; 

procedure KillIt(name:string);
var
  hProcess : Cardinal;
  dw       : DWORD;
  dwprocid : cardinal;
begin
  dwprocide:=getprocid(name);
  { 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
    { everythings's 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;
end;

du musst nur die Unit TLHelp32 in die Uses-Liste einbinden.

[mushroomfreak05]

Laufende Anwendung beenden
CreateToolHelp32Snapshot, TerminateProcess


--------------------------------------------------------------------------------

Die Funktion beendet den Prozess, der mit übergebenen Exenamen übereinstimmt. Sollten mehrere Prozesse des selben Exenamens laufen, so wird der zuerst Gefundene geschlossen.

Wenn der Prozess erfolgreich beendet wurde, wird true zurückgegeben.

Delphi-Quellcode:

uses TLHelp32;

function KillTask(const AExeName: string): boolean;
var
  p: TProcessEntry32;
  h: THandle;
begin
  Result := false;
  p.dwSize := SizeOf(p);
  h := CreateToolHelp32Snapshot(TH32CS_SnapProcess, 0);
  try
    if Process32First(h, p) then
      repeat
        if AnsiLowerCase(p.szExeFile) = AnsiLowerCase(AExeName) then
          Result := TerminateProcess(OpenProcess(Process_Terminate,
                                                 false,
                                                 p.th32ProcessID),
                                     0);
      until (not Process32Next(h, p)) or Result;
  finally
    CloseHandle(h);
  end;
end;

//Aufruf
procedure TForm1.Button2Click(Sender: TObject);
begin
  if not KillTask('Project2.exe') then
    Showmessage('Prozess konnte nicht beendet werden.');
end;

Bei diesem Code wird der Prozess ohne Rückfrage beendet. Dadurch kann es ggf. zu Datenverlusten kommen.

[edit=Sharky]Delphi-Tags gesetzt. Mfg, Sharky[/edit]

[Cronos]

Danke hat einwandfrei Funktioniert ;) :thumb:

[renekr]

Hallo,
Ich habe einige Functionen hier im Forum getestet aber unter Win NT Probleme mit dem Abschiessen eines Programmes über deren *.exe Namen.

Kann mir jemand nen Tipp geben?

Danke

[ManuMF]

Kannst du uns die Art des Problems geben?

[renekr]

Hi,
also das Problem ist das ich unter Win NT 4.0 eine Exe nicht abschiessen oder beenden kann!

Bräuchte die Funktion dringen um was upzudaten.

Danke.

[mkinzler]

Villeicht mit Hilfe bon pskill aus den pstools von Sysinternal.

[renekr]

Hi,
wäre ne idee aber ich hätte es gerne im Source drin.

danke

[ManuMF]

Naja, es gibt Programme, die sich nicht so einfach abschießen lassen, weil
- sie sich schützen
- man nicht genügend Rechte hat
Nur wenn beides nicht zutrifft, liegt es am Code.

[renekr]

Hallo,
Ich habe es mittlerweile per Enumprocess hinbekommen.

Delphi-Quellcode:

uses PsApi;

function TerminateEXE(sFile: string): Bool;
var verSystem: TOSVersionInfo; hdlSnap,hdlProcess: THandle; bPath,bLoop: Bool;  
    peEntry: TProcessEntry32; arrPid: array [0..1023] of DWord; iC: DWord;   
    i,iCount: Integer; arrModul: array [0..299] of Char; hdlModul: HMODULE;   
begin   
 result:=false;   
 if ExtractFileName(sFile)=sFile then bPath:=false else bPath:=true;   
 verSystem.dwOSVersionInfoSize:=SizeOf(TOSVersionInfo);   
 GetVersionEx(verSystem);   
 if verSystem.dwPlatformId=VER_PLATFORM_WIN32_WINDOWS then begin   
  hdlSnap:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0);   
  peEntry.dwSize:=Sizeof(peEntry);   
  bLoop:=Process32First(hdlSnap,peEntry);   
  while integer(bLoop)<>0 do begin   
   if bPath then begin   
    if CompareText(peEntry.szExeFile,sFile)=0 then begin   
     TerminateProcess(OpenProcess(PROCESS_TERMINATE,false,peEntry.th32ProcessID),0);   
     result:=true;   
    end;   
   end else begin   
    if CompareText(ExtractFileName(peEntry.szExeFile),sFile)=0 then begin   
     TerminateProcess(OpenProcess(PROCESS_TERMINATE,false,peEntry.th32ProcessID),0);   
     result:=true;   
    end;   
   end;   
   bLoop:=Process32Next(hdlSnap,peEntry);   
  end;   
  CloseHandle(hdlSnap);   
 end else   
 if verSystem.dwPlatformId=VER_PLATFORM_WIN32_NT then begin   
  EnumProcesses(@arrPid,SizeOf(arrPid),iC);  
  iCount:=iC div SizeOf(DWORD);  
  for i:=0 to Pred(iCount) do begin   
   hdlProcess:=OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ,false,arrPid[i]);   
   if (hdlProcess<>0) then begin  
    EnumProcessModules(hdlProcess,@hdlModul,SizeOf(hdlModul),iC);   
    GetModuleFilenameEx(hdlProcess,hdlModul,arrModul,SizeOf(arrModul));   
    if bPath then begin   
     if CompareText(arrModul,sFile)=0 then begin   
      TerminateProcess(OpenProcess(PROCESS_TERMINATE or PROCESS_QUERY_INFORMATION,False,arrPid[i]), 0);   
      result:=true;   
     end;   
    end else begin   
     if CompareText(ExtractFileName(arrModul),sFile)=0 then begin   
      TerminateProcess(OpenProcess(PROCESS_TERMINATE or PROCESS_QUERY_INFORMATION,False,arrPid[i]), 0);   
      result:=true;   
     end;  
    end;  
    CloseHandle(hdlProcess);   
   end;   
  end;  
 end;  
 end;

PS: Ich hatte oder habe alle Rechte für das PRogramm,weil es ja auch von mir kommt,nur zum updaten muss i es zu machen,weil das 1. programm das 2. staret und das 2. das 1. updatet *GG*

danke