externes Programm beenden

[Monday]

Hallo,

bitte um Gegenlesen

Ich habe ein Codeschnippsel gemacht, bei dem mich Interessiert, ob dort die Gefahr besteht das:
- Endlosschleifen bestehen (könnten)
- auch funktioniert, wenn der externe Prozess arbeitsintensiv ist
- sich das Programm "selbst aufhängt"
- oder mir sonstige Logik Fehler entstanden sein könnten.

Dieser Codeschnippsel soll ein (oder mehrere gleichnamige) Prozesse beenden. Das Programm soll warten bis der Prozess wirklich beendet ist. Andernfalls soll es sich selbst beenden.

(Noch zum Hintergrund: Den Code will ich in einen meiner Programme einsetzen, dass ein externes (arbeitsintensives) Program startet, das umfangreiche Berechnungen macht und mehrere Prozesse von sich selbst startet. Nun kann es passieren, dass die Berechnungen zu lange dauern, das Programm nicht mehr richtig reagiert u.ä. Sollte das passieren, will ich das Programm dann "abschießen".)


(Lazaruscode)

Delphi-Quellcode:

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,windows,tlhelp32;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;




implementation


{$R *.lfm}

{ TForm1 }


Function EnumChildProc(AHandle: hWnd; ASListPtr: LPARAM): BOOL; StdCall;
 Var
  tmpS,
  theWinText,
  theClassName: String;
Begin
 Result:= True;
  SetLength     (theClassName, 256);
  GetClassName  (AHandle, PChar(theClassName), 255);
  SetLength     (theWinText, 256);
  GetWindowText (AHandle, PChar(theWinText), 255);
  FillChar      (tmpS[1], Length(tmpS), ' ');
   tmpS:= tmpS+StrPas(PChar(theClassName));

   If theWinText <> EmptyStr
   Then tmpS:= tmpS+' <'+StrPas(PChar(theWinText))+'>'
   Else tmpS:= tmpS+'""';

  TStringList(ASListPtr).Add(tmpS);
End;


Function EnumWindowsProc(AHandle: hWnd; ASList: TStringList): BOOL; StdCall;
 Var
  tmpS,
  theWinText,
  theClassName: String;
Begin
 Result:= True;
  SetLength     (theClassName, 256);
  GetClassName  (AHandle, PChar(theClassName), 255);
  SetLength     (theWinText, 256);
  GetWindowText (AHandle, PChar(theWinText), 255);

   tmpS:= StrPas(PChar(theClassName));

   If (theWinText <> EmptyStr)
   Then tmpS:= tmpS+' <'+StrPas(PChar(theWinText))+'>'
   Else tmpS:= tmpS+'""';

  ASList.Add(tmpS);
  EnumChildWindows(AHandle, @EnumChildProc, LPARAM(@ASList));
End;





function GetWindowFromID(ProcessID : Cardinal): THandle;
Var TestID  : Cardinal;
    TestHandle : Thandle;
Begin
  Result := 0;
  TestHandle := FindWindowEx(GetDesktopWindow, 0, Nil, Nil);
  While TestHandle > 0 do  Begin
      If GetParent(TestHandle) = 0 Then
        GetWindowThreadProcessId(TestHandle,  @TestID);
          If TestID = ProcessID Then  Begin
            Result := TestHandle;
            Exit;
          End;
      TestHandle := GetWindow(TestHandle, GW_HWNDNEXT)
  End;
End;




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 KillProcess(dwProcID: DWORD): integer;
var
  hProcess : Cardinal;
  dw : DWORD;
begin
{ result:
0   =  Keine Meldung
1   =  Erfolgreich beendet
2   =  Prozess konnte nicht innerhalb von X Sekunden beendet werden
3   =  Fehlermeldung
}
  result := 0;
  hProcess := OpenProcess(SYNCHRONIZE or PROCESS_TERMINATE, False, dwProcID);
  TerminateProcess(hProcess, 0);
  dw := WaitForSingleObject(hProcess, 10000);    // Letzte Zahl ist Warten
  case dw of
    WAIT_OBJECT_0: begin result := 1;end;
    WAIT_TIMEOUT:
    begin
      result := 2;
      CloseHandle(hProcess);
      exit;
    end;
    WAIT_FAILED:
    begin
      result := 3;
      //RaiseLastOSError;
      CloseHandle(hProcess);
      exit;
    end;
  end;
  CloseHandle(hProcess);
  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_CLOSE, 0, 0);  //Programm beenden senden
      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;



procedure TForm1.Button1Click(Sender: TObject);
var
  programm : string;
begin
  // Zum Testen...
  programm := 'notepad.exe';
  //programm := 'cmd.exe';
  //programm := 'avgnt.exe';  //Lässt sich nicht beenden


  Label1.Caption := 'Warten...';

  killprozess2(programm);


  Label1.Caption := 'Fertig';
end;

end.

LG