CreateProcess, WaitForSingleObject, отключить ввод при вызове приложения

Я звоню в другую Программу, которая отображает только такую ​​веб-страницу:

Проблема: если я создаю процесс с помощью кнопки, и пока открыт созданный процесс, я нажимаю флажок в форме вызова, закрываю созданный процесс, флажок отмечается.

Я попытался использовать DisableTaskWindows(0), как показано в функции.ShowModal. Но это не работает, как я ожидал. Пока он отключает форму. Но после того, как я включил его, похоже, что форма все равно обрабатывает событие click. Вроде как, если есть очередь сообщений или что-то.

Может кто-нибудь сказать мне, что я здесь делаю не так?

procedure TForm1.Button1Click(Sender: TObject);
var
  StartupInfo : TStartupInfo;
  ProcessInfo : TProcessInformation;
  ProcessCreated : Boolean;
  CommandLine : string;
  WindowList: TTaskWindowList;
begin
  WindowList := DisableTaskWindows(0);
  CommandLine:='webmodule.exe';
  uniqueString(CommandLine);
  ZeroMemory(@StartupInfo, SizeOf(StartupInfo));
  StartupInfo.cb := SizeOf(StartupInfo);
  ProcessCreated := CreateProcess(PChar(nil), PChar(CommandLine), nil, nil, false, 0, nil, nil, StartupInfo, ProcessInfo);
  if ProcessCreated then
    WaitForSingleObject(ProcessInfo.hProcess, INFINITE)
  else
    ShowMessage('Error : could not execute!');
  CloseHandle(ProcessInfo.hProcess);
  CloseHandle(ProcessInfo.hThread);
  EnableTaskWindows(WindowList);
end;

ОБНОВИТЬ

К сожалению, я не уверен, как использовать функцию RegisterWaitForSingleObject... Я пробовал это, но не работает. Может быть, мне не хватает CallBack? Но я понятия не имею, как его использовать.

  if ProcessCreated then
  begin
//    WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
    while (RegisterWaitForSingleObject(ProcessInfo.hProcess,ProcessInfo.hProcess,nil,nil,INFINITE,0) = false) do
    begin
      Form1.Color:=RGB(random(255),random(255),random(255));
      Application.ProcessMessages;
    end;

    CloseHandle(ProcessInfo.hProcess);
    CloseHandle(ProcessInfo.hThread);
  end
  else
    ShowMessage('Error : could not execute!');

ОБНОВЛЕНИЕ 2:

Я думаю, что, возможно, решил это, я удалил Enable Disable для формы. Вместо этого я делаю это после того, как я выполнил процесс.

  while PeekMessage(Msg, 0, WM_KEYFIRST, WM_KEYLAST, PM_REMOVE or PM_NOYIELD) do;
  while PeekMessage(Msg, 0, WM_MOUSEFIRST, WM_MOUSELAST, PM_REMOVE or PM_NOYIELD) do;

1 ответ

Решение

Проблема заключается в том, что вы блокируете основной цикл сообщений вашего приложения, ожидая завершения вызываемого процесса, поэтому вы не позволяете приложению обрабатывать пользовательский ввод до тех пор, пока этот процесс не завершится. Вы должны позволить своему приложению нормально обрабатывать сообщения, не блокировать их. Если вы отключите свою форму во время работы порожденного процесса, пользовательский ввод будет автоматически отклонен для вас.

Попробуйте что-то вроде этого:

procedure TForm1.Button1Click(Sender: TObject);
var
  StartupInfo : TStartupInfo;
  ProcessInfo : TProcessInformation;
  CommandLine : string;
begin
  CommandLine := 'webmodule.exe';
  UniqueString(CommandLine);
  ZeroMemory(@StartupInfo, SizeOf(StartupInfo));
  StartupInfo.cb := SizeOf(StartupInfo);
  if not CreateProcess(PChar(nil), PChar(CommandLine), nil, nil, FALSE, 0, nil, nil, StartupInfo, ProcessInfo) then
  begin
    ShowMessage('Error : could not execute!');
    Exit;
  end;
  CloseHandle(ProcessInfo.hThread);
  Enabled := False;
  repeat
    case MsgWaitForMultipleObjects(1, ProcessInfo.hProcess, FALSE, INFINITE, QS_ALLINPUT) of
      WAIT_OBJECT_0: Break;
      WAIT_OBJECT_0+1: Application.ProcessMessages;
    else
      begin
        ShowMessage('Error : could not wait!');
        Break;
      end;
    end;
  until False;
  CloseHandle(ProcessInfo.hProcess);
  Enabled := True;
end;

Или это:

type
  TForm1 = class(ToFrm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    ...
  private
    hWaitObj, hWaitProcess: THandle;
    procedure WaitFinished;
    ...
  end;

... 

procedure WaitCallback(lpParameter: Pointer; WaitFired: Boolean); stdcall;
begin
  TThread.Queue(nil, TForm1(lpParameter).WaitFinished);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  StartupInfo : TStartupInfo;
  ProcessInfo : TProcessInformation;
  CommandLine : string;
begin
  CommandLine := 'webmodule.exe';
  UniqueString(CommandLine);
  ZeroMemory(@StartupInfo, SizeOf(StartupInfo));
  StartupInfo.cb := SizeOf(StartupInfo);
  if not CreateProcess(PChar(nil), PChar(CommandLine), nil, nil, FALSE, 0, nil, nil, StartupInfo, ProcessInfo) then
  begin
    ShowMessage('Error : could not execute!');
    Exit;
  end;
  CloseHandle(ProcessInfo.hThread);
  if not RegisterWaitForSingleObject(hWaitObj, ProcessInfo.hProcess, WaitCallback, Self, INFINITE, WT_EXECUTELONGFUNCTION or WT_EXECUTEONLYONCE) then
  begin
    CloseHandle(ProcessInfo.hProcess);
    ShowMessage('Error : could not wait!');
    Exit;
  end;
  hWaitProcess := ProcessInfo.hProcess;
  Enabled := False;
end;

procedure TForm1.WaitFinished;
begin
  UnregisterWait(hWaitObj);
  CloseHandle(hWaitProcess);
  Enabled := True;
end;
Другие вопросы по тегам