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

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

0 голосов
/ 07 февраля 2019

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

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

Я пытался использовать 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 Ответ

0 голосов
/ 08 февраля 2019

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

Попробуйте что-то еще подобное: 

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;
...