AGB  ·  Impressum  







Anmelden
Nützliche Links
Registrieren

externes Programm beenden

Ein Thema von Monday · begonnen am 18. Nov 2017
Antwort Antwort
Monday

Registriert seit: 24. Aug 2012
64 Beiträge
 
FreePascal / Lazarus
 
#1

externes Programm beenden

  Alt 18. Nov 2017, 07:28
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
  Mit Zitat antworten Zitat
Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 12:05 Uhr.
Powered by vBulletin® Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2017 by Daniel R. Wolf