Czy Lazarus czy nie, to nie rozumiem, jakimś problemem jest pobrać PID zwrócony przez dwProcessId
, typu TProcessInformation
w CreateProcess
? I następnie z użyciem EnumProcesses
albo takiego kodu jak poniżej, sprawdzić sobie czy proces nadal pracuje?
Wedle mnie problemu nie ma żadnego. A i nie sprawdzałem tego wprawdzie pod Lazarusem, ale za pewne wszystko przy ewentualnych drobnych przeróbkach, powinno się tam powieść. Aha, nawet jeśli uruchomionych procesów będzie kilkaset, to i tak potrwa to chwileczkę, góra kilkaset ms.
//..
uses
TlHelp32, PsApi;
type
TOnFindProcessProc = procedure(FindedProcessName : string; FindedPid : DWORD);
procedure ListProcesses(OnFindProcessProc : TOnFindProcessProc);
var
HSnapShot : THandle;
ProcInfo : TProcessEntry32;
begin
HSnapShot := CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS, 0);
if HSnapShot <> THandle(-1) then
begin
ProcInfo.dwSize := SizeOf(ProcInfo);
if Process32First(HSnapshot, ProcInfo) then
begin
if @OnFindProcessProc <> nil then
begin
OnFindProcessProc(ProcInfo.szExeFile, ProcInfo.th32ProcessID);
end;
while (Process32Next(HSnapShot, ProcInfo)) do
begin
if @OnFindProcessProc <> nil then
begin
OnFindProcessProc(ProcInfo.szExeFile, ProcInfo.th32ProcessID);
end;
end;
end;
CloseHandle(HSnapShot);
end;
end;
//...
EDIT: Faktycznie enumerowanie procesów w wątku co parę sekund, jest średnio udanym rozwiązaniem. Także celowo odpaliłem "zakurzonego" Lazarusa 64 bit pod Windows 7. Kompilacja trwa oczywiście wielki, ale cóż, darmowe pr0 środowisko, wymaga chyba takich wyrzeczeń ;) Poniższy kod, bez problemów działa i pokazuje komunikat, dopiero po zamknięciu kalkulatora.
//...
uses
Windows;
procedure TForm1.Button1Click(Sender: TObject);
var
SI : TStartupInfo;
PI : TProcessInformation;
begin
ZeroMemory(@SI, SizeOf(SI));
SI.cb := SizeOf(SI);
SI.dwFlags := STARTF_USESHOWWINDOW;
SI.wShowWindow := CmdShow;
CreateProcess(nil, PChar('calc.exe'), nil, nil, False, 0, nil, nil, SI, PI);
WaitForSingleObject(PI.hProcess, INFINITE);
ShowMessage('Bum!');
end;