如何泵送 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 人创建了一个专门针对这种情况创建的函数：

当单线程单元 (STA) 中的线程阻塞时，我们会为您发送某些消息。阻塞期间的消息泵送是 Microsoft 的黑魔法之一。抽水过多会导致重入，从而使您的应用程序所做的假设无效。泵送太少会导致死锁。从 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

所以现在我开始深入研究可怕的，awful，awful，awful，buggy，error -容易、重入诱导、草率、需要轻推鼠标，有时会导致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（请参阅 Old New Thing）

如果我要发送自己的消息，我已经编程了足够长的时间来逃跑，很远。

问题

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

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

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

另见

• MSDN 博客：Managed Blocking - Chris Brumme
• CoWaitForMultipleHandles API doesn't behave as documented
• Visual Studio 论坛：How to use "CoWaitForMultipleHandles" ?
• MSDN：CoWaitForMultipleHandles function
• MSDN 博客：Apartments and Pumping in the CLR - Chris Brumme
• Which blocking operations cause an STA thread to pump COM messages?

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;