代码之家  ›  专栏  ›  技术社区  ›  user1937012

CreateProcess,WaitForSingleObject,在调用应用程序时禁用输入

  •  1
  • user1937012  · 技术社区  · 7 年前

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

    我尝试使用.showmodel函数中显示的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:

    我想我可能已经解决了它,我删除了表单的启用和禁用。相反,我在执行流程后执行此操作。

      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 回复  |  直到 7 年前
        1
  •  4
  •   Remy Lebeau    7 年前

    问题是,您在等待生成的进程退出时阻塞了应用程序的主消息循环,因此在该进程结束之前,您不允许应用程序处理用户输入。你需要让你的应用程序正常处理消息,不要阻止它们。如果在生成的进程运行时禁用表单,用户输入将自动为您放弃。

    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;
    
    推荐文章