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.