Uruchomienie programu i oczekiwanie na jego zakończenie

0

W jaki sposób w Lazarusie zrobić funkcję sprawdzającą czy otwarta przez nas aplikacja nadal pracuje ?

Chce zrobić coś takiego

  1. Uruchamiam jakiś program ShellExecute - tu jest ok
  2. Czekam na jego zamknięcie - nie wiem jak to zrobić (kombinowałem z FindWidnow ale nie wiem jaki będzie tytuł okna otwieranego w pkt. 1 programu)
    i to w pętli...

Podpowiecie mi jak to zrobić ?

0

Z ShellExecute jest bardzo skomplikowane czekanie na zakończenie. Użyj CreateProcess, przykładów było od groma na tym forum.

0

Z uruchomieniem programu przez processCreate nie było problemów... lecz nadal nie mogę wykombinować tego czekania na zamknięcie...

0

Użyj klasy TProcess.

0

Uruchamiam aplikację w ten sposób:

CreateProcess(nil, pchar(tmpProgram), nil, nil, true, 0, nil, nil, tmpStartupInfo, tmpProcessInformation);  

Sprawdziłem, że w chwili uruchomienia programu tmpProcessInformation.hProcess, tmpProcessInformation.hThread, tmpProcessInformation.dwProcessId oraz tmpProcessInformation.dwThreadId przybierają "jakieś" wartości i utrzymują je mimo zamknięcia wywołanego programu. Jak w takim razie wykryć jego zamknięcie ?

W sieci znalezazłem coś takiego : WaitForSingleObject(tmpProcessInformation.hProcess, INFINITE) lecz też nie zdaje to egzaminu (program nie zatrzymuje się na tej linii?

0

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;

1 użytkowników online, w tym zalogowanych: 0, gości: 1