Autor Beitrag
daywalker0086
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starontopic star
Beiträge: 233


Delphi 2005 Architect
BeitragVerfasst: Di 30.07.19 11:06 
Hallo Leute,
ich möchte mit meinem Programm ein externes Programm schließn lassen das sich aufgehangen hat.
mit dieser Routine klappt es das Programm zu schließen wenn es noch normal läuft:
ausblenden volle Höhe Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
function GetProcessID(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;
CloseHandle(hProcSnap);
end;


function killprozess2(programm: string): integer; // .exe
var
  erg: integer;
  error_log: TStringList;
begin
  result := 0;

  if GetProcessID(programm) > 0 then begin // Wenn Prozess vorhanden
    SendMessage(GetWindowFromID(GetProcessID(programm)), WM_QUIT, 00); //Programm beenden senden - bei eingefrorenen Programm gehts hier nicht weiter
    sleep(5000);
  end;

  while(True) do
   begin
     Application.ProcessMessages;
     if GetProcessID(programm) > 0 then begin // Wenn Prozess vorhanden
     erg := KillProcess(GetProcessID(programm));
     if erg = 1 then begin // Wenn Prozess erfolgreich beendet, dann stopp
       // break; //Nur wenn sicher, dass ein Prozess auch nur EINMAL vorkommt - ALLE prozesse sollen beendet werden
     end;
         if erg >= 2 then begin // fehler... Prozess kann aus irgendeinen Grund nicht beendet werden
       // Dann kurz Protokollieren und Anwendung beenden!
       error_log := TStringList.Create;
       error_log.LoadFromFile('error_log.txt');
       error_log.Add( FormatDateTime('dd.mm.yyyy, hh:nn:ss', now) + ' '+programm + ' konnte nicht beendet werden!! Anwendung wurde geschlossen!');
       error_log.SaveToFile('error_log.txt');
       Application.Terminate;
       break;
       //Todo: Evtl. noch weiterverarbeiten
     end;
     end else begin
     result := 1;
     break; // Prozess nicht vorhanden, dann schließen
     end;
     end;
end;


Aber wenn das Programm bereits fest hängt dann hängt auch mein Programm beim ersten SendMessage.

Bekommt man das anders hin, dass das Programm auf jeden Fall beendet wird?
Tankard
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starofftopic star
Administrator
Beiträge: 213
Erhaltene Danke: 93



BeitragVerfasst: Di 30.07.19 11:21 
Moin,

schau dir mal folgende Funktion an:

ausblenden Delphi-Quelltext
1:
  Windows.TerminateProcess(hProcess,ExitCode);					


Weil wenn dein Programm schon hängt, wird wohl die MessageQueue auch nicht mehr abgearbeitet.
daywalker0086 Threadstarter
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starontopic star
Beiträge: 233


Delphi 2005 Architect
BeitragVerfasst: Di 30.07.19 12:31 
JA so siehts gut aus, danke dir ! :D