如何泵送COM消息？

Question

我想等待 WebBrowser 控件完成导航。所以我创建了一个Event，然后我想等待它被设置：

procedure TContoso.NavigateToEmpty(WebBrowser: IWebBrowser2);
begin
   FEvent.ResetEvent;
   WebBrowser.Navigate2('about:blank'); //Event is signalled in the DocumentComplete event

   Self.WaitFor;
end;

然后我在

DocumentComplete

事件中设置事件：

procedure TContoso.DocumentComplete(ASender: TObject; const pDisp: IDispatch; const URL: OleVariant);
var
    doc: IHTMLDocument2;
begin
    if (pDisp <> FWebBrowser.DefaultInterface) then
    begin
       //This DocumentComplete event is for another frame
       Exit;
    end;

    //Set the event that it's complete
    FEvent.SetEvent;
end;

问题在于如何等待这个事件发生。

等等

第一反应是等待事件被触发：

procedure TContoso.WaitFor;
begin
   FEvent.WaitFor;
end;

问题在于

DocumentComplete

事件永远无法触发，因为应用程序永远不会处于 足够空闲 状态以允许 COM 事件通过。

忙睡觉等待

我的第一反应是忙着睡觉，等待flag：

procedure TContoso.NavigateToEmpty(WebBrowser: IWebBrowser2);
begin
   FIsDocumentComplete := False;
   WebBrowser.Navigate2('about:blank'); //Flag is set in the DocumentComplete event
   Self.WaitFor;
end;

procedure TContoso.WaitFor;
var
   n: Iterations;
const
   MaxIterations = 25; //100ms each * 10 * 5 = 5 seconds
begin
   while n < MaxIterations do
   begin
      if FIsDocumentComplete then
         Exit;
      Inc(n);
      Sleep(100); //100ms
   end;
end;

Sleep

的问题在于，它不允许应用程序进行足够空闲以允许 COM 事件消息通过。

使用 CoWaitForMultipleHandles

经过研究，似乎COM人们创建了一个专门针对这种情况创建的函数：（archive）

当单线程单元 (STA) 中的线程阻塞时，我们将为您推送某些消息。阻塞期间的消息泵送是微软的黑魔法之一。泵送过多可能会导致重入，从而使应用程序所做的假设无效。泵送太少会导致死锁。从 Windows 2000 开始，OLE32 公开了 CoWaitForMultipleHandles，以便您可以泵送“恰到好处的量”。

所以我尝试了：

procedure TContoso.WaitFor;
var
   hr: HRESULT;
   dwIndex: DWORD;
begin
   hr := CoWaitForMultipleHandles(0, 5000, 1, @FEvent.Handle, {out}dwIndex);
   OleCheck(hr);
end;

问题是这行不通；它不允许 COM 事件出现。 使用UseCOMWait等待

我也可以尝试 Delphi 自己的 TEvent 的主要秘密功能：UseCOMWait

将

UseCOMWait

设置为 True 以确保当线程被阻塞并等待对象时，任何 STA COM 调用都可以返回到该线程中。

太棒了！让我们使用它：

FEvent := TEvent.Create(True);

function TContoso.WaitFor: Boolean;
begin
   FEvent.WaitFor;
end;

除非那不起作用；因为回调事件永远不会被触发。

MsgWaitForMultipleBugs

所以现在我开始深入研究可怕的，可怕的，可怕的，可怕的，有缺陷，容易出错，导致重入，草率，需要鼠标轻推，有时会崩溃

MsgWaitForMultipleObjects

的世界:

function TContoso.WaitFor: Boolean;
var
//  hr: HRESULT;
//  dwIndex: DWORD;
//  msg: TMsg;
    dwRes: DWORD;
begin
//  hr := CoWaitForMultipleHandles(0, 5000, 1, @FEvent.Handle, {out}dwIndex);
//  OleCheck(hr);
//  Result := (hr = S_OK);

    Result := False;
    while (True) do
    begin
        dwRes := MsgWaitForMultipleObjects(1, @FEvent.Handle, False, 5000, QS_SENDMESSAGE);
        if (dwRes = WAIT_OBJECT_0) then
        begin
            //Our event signalled
            Result := True;
            Exit;
        end
        else if (dwRes = WAIT_TIMEOUT) then
        begin
            //We waited our five seconds; give up
            Exit;
        end
        else if (dwRes = WAIT_ABANDONED_0) then
        begin
            //Our event object was destroyed; something's wrong
            Exit;
        end
        else if (dwRes = (WAIT_OBJECT_0+1)) then
        begin
            GetMessage(msg, 0, 0, 0);
        if msg.message = WM_QUIT then
        begin
            {
                http://blogs.msdn.com/oldnewthing/archive/2005/02/22/378018.aspx

                PeekMessage will always return WM_QUIT. If we get it, we need to
                cancel what we're doing and "re-throw" the quit message.

                    The other important thing about modality is that a WM_QUIT message
                    always breaks the modal loop. Remember this in your own modal loops!
                    If ever you call the PeekMessage function or The GetMessage
                    function and get a WM_QUIT message, you must not only exit your
                    modal loop, but you must also re-generate the WM_QUIT message
                    (via the PostQuitMessage message) so the next outer layer will
                    see the WM_QUIT message and do its cleanup as well. If you fail
                    to propagate the message, the next outer layer will not know that
                    it needs to quit, and the program will seem to "get stuck" in its
                    shutdown code, forcing the user to terminate the process the hard way.
            }
            PostQuitMessage(msg.wParam);
            Exit;
        end;
        TranslateMessage(msg);
        DispatchMessage(msg);
    end;
end;

上面的代码是错误的，因为：

• 我不知道要唤醒什么样的消息（是否发送了 com 事件？）
• 我不知道我不想调用GetMessage，因为它会获取消息；我只想获取 COM 消息（参见第一点）
• 我可能应该使用 PeekMessage（参见第 2 点）
• 我不知道是否必须循环调用 GetMessage 直到它返回 false（请参阅旧的新事物）

如果我要传达自己的信息，我已经编程了足够长的时间来逃跑，跑得很远。

问题

所以我有四个问题。都相关。这篇文章是四篇文章之一：

• 如何让WebBrower.Navigate2同步？
• 如何泵送COM消息？
• 泵送 COM 消息是否会导致 COM 事件回调？
• 如何使用CoWaitForMultipleHandles

我正在使用Delphi 进行编写。但显然任何本机代码都可以工作（C、C++、汇编、机器代码）。

另请参阅

• MSDN 博客：托管阻止 - Chris Brumme
• CoWaitForMultipleHandles API 的行为与文档不符
• Visual Studio 论坛：如何使用“CoWaitForMultipleHandles”？
• MSDN：CoWaitForMultipleHandles 函数
• MSDN 博客：CLR 中的公寓和泵送 - Chris Brumme
• 哪些阻塞操作会导致 STA 线程泵送 COM 消息？

Answer 1

总而言之，你必须正常地泵送所有消息，你不能只单独挑选出COM消息（此外，没有任何记录的消息可以让你自己查看/泵送，它们只是已知的COM 的内部结构）。

如何让WebBrower.Navigate2同步？

你不能。但您也不必等待

OnDocumentComplete

事件。您可以在

NavigateToEmpty()

本身内部进行忙循环，直到 WebBrowser 的

ReadyState

属性为

READYSTATE_COMPLETE

，在消息等待处理时泵送消息队列：

procedure TContoso.NavigateToEmpty(WebBrowser: IWebBrowser2);
begin
  WebBrowser.Navigate2('about:blank');
  while (WebBrowser.ReadyState <> READYSTATE_COMPLETE) and (not Application.Terminated) do
  begin
    // if MsgWaitForMultipleObjects(0, Pointer(nil)^, False, 5000, QS_ALLINPUT) = WAIT_OBJECT_0 then
    // if GetQueueStatus(QS_ALLINPUT) <> 0 then
      Application.ProcessMessages;
  end;
end;

如何泵送COM消息？

你不能，无论如何他们自己也不能。抽出所有东西，并准备好处理由此导致的任何重新进入问题。

泵送 COM 消息是否会导致 COM 事件回调？

是的。

如何使用CoWaitForMultipleHandles

尝试这样的事情：

procedure TContoso.NavigateToEmpty(WebBrowser: IWebBrowser2);
var
  hEvent: THandle;
  dwIndex: DWORD;
  hr: HRESULT;
begin
  // when UseCOMWait() is true, TEvent.WaitFor() does not wait for, or
  // notify, when messages are pending in the queue, so use
  // CoWaitForMultipleHandles() directly instead.  But you have to still
  // use a waitable object, just don't signal it...
  hEvent := CreateEvent(nil, True, False, nil);
  if hEvent = 0 then RaiseLastOSError;
  try
    WebBrowser.Navigate2('about:blank');
    while (WebBrowser.ReadyState <> READYSTATE_COMPLETE) and (not Application.Terminated) do
    begin
      hr := CoWaitForMultipleHandles(COWAIT_INPUTAVAILABLE, 5000, 1, hEvent, dwIndex);
      case hr of
        S_OK: Application.ProcessMessages;
        RPC_S_CALLPENDING, RPC_E_TIMEOUT: begin end;
      else
        RaiseLastOSError(hr);
      end;
    end;
  finally
    CloseHandle(hEvent);
  end;
end;