unit Unit1;
(*
Der zweite Anlauf ...
Dieses mal wird in einem Record die PID plus dazugehöriger Dateiname gespeichert.
Create und Close methoden sind nun entkoppelt.
Es können nun auch Argumente/Parameter angegeben werden.
Diese Variante funktioniert solange der aufgerufene Prozess sich nicht selbst schließt und wieder öffnet.
Diese Variante stellt nur grob dar wie ich es machen würde.
Diese Vorgehensweise ist bei weitem nicht perfekt sondern nur rasch skizziert und Alpha-Status (Erfolg beim testen) wurde erreicht.
Danke an himitsu für Hinweise.
*)
interface
uses
Winapi.Windows,
Winapi.PsApi,
System.SysUtils, System.Classes,
Vcl.Forms,
Vcl.Controls,
Vcl.StdCtrls,
Vcl.ExtCtrls;
type
TLastPID =
packed record
dwPID: DWORD;
sFileName:
string;
end;
TForm1 =
class(TForm)
pnlMain: TPanel;
pnlFilename: TPanel;
lblFilename: TLabel;
edtFilename: TEdit;
edtParams: TEdit;
pnlButtons: TPanel;
btnExecute: TButton;
btnTerminate: TButton;
procedure FormCreate(Sender: TObject);
procedure btnExecuteClick(Sender: TObject);
procedure btnTerminateClick(Sender: TObject);
private
(* Falls Deine Anwendung viele Sachen öffnen soll empfehle ich hier ein array fürs management. *)
LastPID: TLastPID;
// hier werden die zuletzt gültigen Daten hinterlegt.
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
// methode um eine ausführbare datei zu starten und die PID übermitteln.
function CreatePID(
const Filename, Params:
string;
var PID: DWORD): Boolean;
var
ProcessInfo: TProcessInformation;
StartUpInfo: TStartUpInfo;
CommandLine:
string;
begin
PID := 0;
CommandLine := '
"' + Filename + '
"';
if (Params <> '
')
then
CommandLine := CommandLine + '
' + Params;
FillMemory(@StartUpInfo, SizeOf(StartUpInfo), 0);
StartUpInfo.cb := SizeOf(StartUpInfo);
if CreateProcess(
nil, PChar(CommandLine),
nil,
nil, BOOL(False), NORMAL_PRIORITY_CLASS,
nil,
nil, StartUpInfo, ProcessInfo)
then
begin
PID := ProcessInfo.dwProcessId;
CloseHandle(ProcessInfo.hProcess);
CloseHandle(ProcessInfo.hThread);
Result := True;
end
else
Result := False;
end;
// methode um eine PID abzuschießen, inkl. optionaler Namensprüfung
function ClosePID(
const PID: DWORD;
const Filename:
string = '
'): Boolean;
var
hProcess: THandle;
Path:
Array [0..MAX_PATH -1]
of Char;
Checked: Boolean;
begin
Result := False;
if (PID = 0)
then
Exit;
if (Filename <> '
')
then
begin
hProcess := OpenProcess(PROCESS_QUERY_INFORMATION
or PROCESS_VM_READ, BOOL(False), PID);
if ((hProcess <> 0)
and (hProcess <> INVALID_HANDLE_VALUE))
then
begin
try
Checked := False;
// für GetModuleFileNameEx die PsApi unit einbinden
if (GetModuleFileNameEx(hProcess, 0, Path, MAX_PATH) = 0)
then
RaiseLastOSError
else
// extrem simplifizierte Prüfung auf Namensgleichheit
Checked := LowerCase(ExtractFileName(Filename)) = LowerCase(ExtractFileName(Path));
finally
CloseHandle(hProcess);
if ((Checked)
and (TerminateProcess(OpenProcess(PROCESS_TERMINATE, BOOL(False), PID), 0)))
then
Result := True;
end;
end;
end
else
if (TerminateProcess(OpenProcess(PROCESS_TERMINATE, BOOL(False), PID), 0))
then
Result := True;
end;
// programm start
procedure TForm1.FormCreate(Sender: TObject);
begin
ReportMemoryLeaksOnShutdown := True;
LastPID.dwPID := 0;
LastPID.sFileName := '
';
btnTerminate.Enabled := False;
end;
// ausfhren klick
procedure TForm1.btnExecuteClick(Sender: TObject);
begin
btnTerminate.Enabled := False;
if (
not FileExists(edtFilename.Text))
then
Exit;
if CreatePID(edtFilename.Text, edtParams.Text, LastPID.dwPID)
then
begin
LastPID.sFileName := edtFilename.Text;
btnTerminate.Enabled := True;
end;
end;
// beenden klick
procedure TForm1.btnTerminateClick(Sender: TObject);
begin
btnTerminate.Enabled := False;
ClosePID(LastPID.dwPID, LastPID.sFileName);
LastPID.dwPID := 0;
LastPID.sFileName := '
';
end;
end.