如何抽取 COM 消息?

How to pump COM messages?

我想等待 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 人员似乎专门针对这种情况创建了一个函数:

While a thread in a Single-Threaded Apartment (STA) blocks, we will pump certain messages for you. Message pumping during blocking is one of the black arts at Microsoft. Pumping too much can cause reentrancy that invalidates assumptions made by your application. Pumping too little causes deadlocks. Starting with Windows 2000, OLE32 exposes CoWaitForMultipleHandles so that you can pump “just the right amount.”

所以我试过了:

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

Set UseCOMWait to True to ensure that when a thread is blocked and waiting for the object, any STA COM calls can be made back into this thread.

太棒了!让我们使用它:

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;

上面的代码是错误的,因为:

如果我要发送自己的消息,我编程的时间已经足够 运行 很远了。

问题

所以我有四个问题。都相关。这个 post 是四个之一:

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

另见

总而言之,您必须正常抽取所有消息,不能单独挑出 COM 消息(此外,没有文档化的消息可以 peek/pump他们自己,他们只为 COM 的内部人员所知。

How to make WebBrower.Navigate2 synchronous?

你不能。但是您也不必等待 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;

How to pump COM messages?

你不能,反正不能靠自己。泵出一切,并准备好处理由此导致的任何再入问题。

Does pumping COM messages cause COM events to callback?

是的。

How to use 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;