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

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

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

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

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

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 для формы. Вместо этого я делаю это после выполнения Process .

  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;

person user1937012    schedule 07.02.2019    source источник
comment
Вы пытались просто установить свойство Enabled вызывающей формы вместо использования (Disable|Enable)TaskWindows()? Я бы даже предложил использовать RegisterWaitForSingleObject() или аналогичный, чтобы позволить коду вернуть управление основному циклу обработки сообщений во время ожидания порожденного процесса, а затем позволить функции обратного вызова ожидания закрыть открытые дескрипторы и повторно включить форму   -  person Remy Lebeau    schedule 07.02.2019
comment
Вызовите CloseHande только в случае успеха CreateProcess   -  person David Heffernan    schedule 07.02.2019
comment
к сожалению, Form1.Enabled:=false и Form1.Enabled:=true не работают. После того, как я включу форму... CheckBox нажат...   -  person user1937012    schedule 07.02.2019
comment
Суть использования RegisterWaitForSingleObject заключалась в том, чтобы изменить код так, чтобы он выполнялся асинхронно. Если CreateProcess завершается успешно, вызовите RegisterWaitForSingleObject один раз, а затем немедленно выйдите из Button1Click. В фоновом режиме ОС продолжит ожидание порожденного процесса, и когда он завершится, вы получите уведомление через обратный вызов. Таким образом, вы можете позволить основному циклу сообщений продолжать работать в обычном режиме, и он будет поглощать пользовательский ввод, пока форма отключена, до тех пор, пока процесс не завершится и форма не будет снова включена. НЕ пытайтесь делать все внутри Button1Click.   -  person Remy Lebeau    schedule 07.02.2019
comment
Проблема в том, что WaitForSingleObject блокирует основной поток и поэтому не может обрабатывать (вводить) сообщения. Отключенная форма должна подавать звуковой сигнал, например, при нажатии. Предложение Реми сработает, или MsgWaitForMultipleObjects..   -  person Sertac Akyuz    schedule 07.02.2019
comment
@Remy: боюсь, я не совсем понимаю, как работает этот обратный вызов. Как мне это сделать после успеха Createprocess? И тогда где мне ждать обратного звонка?   -  person user1937012    schedule 07.02.2019
comment
@user1937012 user1937012 вы даете RegisterWaitForSingleObject() указатель на функцию, ОС вызывает эту функцию, когда запрошенный дескриптор получает сигнал (когда порожденный процесс завершается). Вы не ждете обратного вызова, вы идете дальше и позволяете функции вызываться позже.   -  person Remy Lebeau    schedule 08.02.2019
comment
@ user1937012 Я добавил ответ с примерами   -  person Remy Lebeau    schedule 08.02.2019


Ответы (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;
person Remy Lebeau    schedule 07.02.2019
comment
Обратный вызов выполняется в другом потоке? Это причина, по которой вы ставите его в очередь в основной поток? - person Sertac Akyuz; 08.02.2019
comment
да. Читать документацию: Процедура обратного вызова выполняется рабочим потоком, когда состояние объекта становится сигнальным или истекает интервал времени ожидания. Когда ожидание завершено, вы должны вызвать функцию UnregisterWait или UnregisterWaitEx, чтобы отменить операцию ожидания... Не выполняйте блокирующий вызов любой из этих функций из функции обратного вызова. - person Remy Lebeau; 08.02.2019
comment
@Remy: это потрясающе!!! Спасибо!!! Я изучу код и прочитаю документацию еще раз. - person user1937012; 08.02.2019
comment
@Remy: я читаю документы MSDN для MsgWaitForMultipleObjects, пока мне удалось все понять. Есть только одна вещь, которая ускользает от меня. pHandles . Это говорит о массиве дескрипторов объектов. Тем не менее, когда я проверяю документы MSDN для CreateProcess, а затем структуру PROCESS_INFORMATION, там говорится, что Handle to Newly created object. (не массив дескрипторов объектов). И если я не совсем запутался, то MsgWaitForMultipleObjects(1, ProcessInfo.hProcess, FALSE, INFINITE, QS_ALLINPUT) в коде получает только один Handle. Это работает, я просто пытаюсь понять, как это работает. - person user1937012; 08.02.2019
comment
@user1937012 user1937012 MsgWaitForMultipleObjects принимает массив дескрипторов. Совершенно верно передать ему массив из 1 дескриптора. В Delphi этот параметр объявлен как нетипизированный var, поэтому можно пропустить создание фактического массива при передаче только 1 дескриптора. Адрес памяти одной переменной и адрес памяти массива из 1 элемента эквивалентны. - person Remy Lebeau; 08.02.2019
comment
@Remy: ваш второй пример сначала не работал, я действительно не понимал, почему. Так что я в основном ткнул в него. Пока я, наконец, не обнаружил, что проблема была @hWaitObj, мне нужно было изменить ее на hWaitObj. После этого он работает так, как ожидалось. Почему это сработало, к сожалению, не знаю :( - person user1937012; 08.02.2019
comment
@Remy: я изменил код еще больше, и он все еще работает, это тоже верно? procedure WaitCallBack(lpParameter: Pointer; WaitFired: Boolean); stdcall; и я изменил RegisterWaitForSingleObject следующим образом if not RegisterWaitForSingleObject(hWaitObj, ProcessInfo.hProcess, WaitCallback, Self, Infinite,WT_EXECUTELONGFUNCTION or WT_EXECUTEONLYONCE) then - person user1937012; 08.02.2019
comment
@ user1937012 мой компьютер умер ранее на этой неделе, и я потерял доступ к своему Delphi, поэтому я не мог проверить фактические объявления, когда писал этот пример, поэтому я догадался. Должно быть, я неправильно угадал. Если ваши твики сработают, то так тому и быть. Я обновил свой пример. - person Remy Lebeau; 08.02.2019