如何提取COM消息？

Question

我想等待WebBrowser控件完成导航.所以我创建一个事件,然后我想等待它被设置:

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事件通过.

忙碌的睡眠等待

我的第一反应是忙着睡觉,等待一面旗帜:

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;

a的问题Sleep在于它不允许应用程序空闲到足以允许COM事件消息通过.

使用CoWaitForMultipleHandles

经过研究,似乎COM人员创建了一个完全针对这种情况创建的函数:

当单线程公寓(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(参见Old New Thing)

如果我打算收集我自己的消息,我已经编程了很长时间以逃避远方.

问题

所以我有四个问题.所有相关的.这篇文章是四个中的一个:

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

我正在写作,并使用Delphi.但显然任何本机代码都可以工作(C,C++,汇编,机器代码).

也可以看看

• MSDN博客:托管阻止 - 克里斯布鲁姆
• 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;