CreateProcess 、 WaitForSingleObject 、禁用调用应用程序的输入

Question

我正在调用另一个只显示如下网页的程序：

问题：如果我使用按钮创建流程，并且当创建的流程处于打开状态时，我单击调用表单上的复选框，然后关闭已选中复选框的创建流程。

我尝试使用在 .ShowModal 函数中看到的 DisableTaskWindows(0)。但它并不像我预期的那样工作。虽然它确实禁用了表单。但是在我启用它之后，表单似乎仍然处理了点击事件。有点像如果它有一个消息队列什么的。

谁能告诉我我做错了什么？

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 函数...我试过了，但没有用。我可能错过了回调？但是我不知道怎么用。

  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：

我想我可能已经解决了，我删除了表单的启用禁用。相反，我在执行 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;

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

CreateProcess 、 WaitForSingleObject 、禁用调用应用程序的输入

CreateProcess , WaitForSingleObject , Disable Input on Calling Application

delphi

createprocess

disabled-input