Delphi Win32 TXMLDocument 不能从线程中实例化和使用？

Question

这个问题在这里已经有了答案:

XML: MSXML Not Installed (3 个回答)

Delphi : load xml file within a thread (1 个回答)

Using CoInitialize in a Delphi thread (1 个回答)

关闭 去年。

我一直在使用 Indy TIdTCPServer对象并实例化一个 TXMLDocument TIdTCPServer.OnExecute 期间的对象实例事件。当xml.Active 时出现异常，我感到非常惊讶。设置为真:

Microsoft MSXML is not installed

procedure TForm4.tcpRXExecute(AContext: TIdContext);
var
  sResponseXML : string;
  xml:IXMLDocument;
begin
  // get message from client
  sResponseXML := AContext.Connection.IOHandler.ReadLn;

  xml:=TXMLDocument.Create(nil);
  
  // error here:  "Microsoft MSXML is not installed"
  xml.Active:=true;

  xml.Encoding:='UTF-8';

  xml.LoadFromXML(sResponseXML);

  // use the xml document
  
  //AContext.Connection.IOHandler.WriteLn('... message sent from server :)');
end;

深入研究发现异常发生是因为TMSXMLDOMDocumentFactory.TryCoCreateInstance()尽管接收到相同的 GuidList，但无法创建正确的文档对象实例就像它在应用程序的其他部分从主线程接收到的一样。我不明白为什么如果从组件的线程调用该对象没有实例化。

这里是 Embarcadero 代码，该对象应该被实例化:

class function TMSXMLDOMDocumentFactory.TryCoCreateInstance(const GuidList: array of TGUID): IUnknown;
var
  I: Integer;
  Status: HResult;
begin
  for I := Low(GuidList) to High(GuidList) do
  begin
    // never successful if the XML document object was being used from the Execute event handler.
    Status := CoCreateInstance(GuidList[I], nil, CLSCTX_INPROC_SERVER or
      CLSCTX_LOCAL_SERVER, IDispatch, Result);
    if Status = S_OK then Exit;
  end;
end;

我想它一定与 CLSCTX_INPROC_SERVER 有关或 CLSCTX_LOCAL_SERVER ( https://learn.microsoft.com/en-us/windows/win32/api/wtypesbase/ne-wtypesbase-clsctx )，但我不明白为什么这些可能是个问题。

即使那是原因，我该如何使用 TXMLDocument从那个事件处理程序中？

Answer 1

MSXML 是一种基于 COM 的技术。您需要调用 CoInitialize/Ex() 来在每个访问 COM 接口(interface)的线程上下文中初始化 COM 库。否则，在这种情况下，CoCreateInstance() 将失败并出现 CO_E_NOTINITIALIZED 错误。 Delphi 的 RTL 在主线程中为你初始化 COM 库，但你必须在工作线程中自己完成，例如 TIdTCPServer 使用的那些。

默认情况下，TIdTCPServer 为每个客户端连接创建一个新线程。在这种情况下，最容易初始化 COM 的地方是服务器的 OnConnect 事件(因为 OnExecute 事件是循环的)。

procedure TForm4.tcpRXConnect(AContext: TIdContext);
begin
  CoInitialize(nil);
end;

procedure TForm4.tcpRXDisconnect(AContext: TIdContext);
begin
  CoUninitialize();
end;

然而，由于 TIdTCPServer 支持线程池，并且 COM 应该每个线程只初始化一次，在这种情况下初始化 COM 的最佳位置¹ 直接在每个线程的 Execute() 方法中。为此，将 TIdSchedulerOfThread 派生组件(TIdSchedulerOfThreadDefault、TIdSchedulerOfThreadPool 等)显式分配给 TIdTCPServer.Scheduler 属性(可以在设计时完成)，然后将 TIdSchedulerOfThread.ThreadClass 属性(必须在运行时完成，在服务器激活之前完成)设置为 TIdThreadWithTask - 覆盖虚拟 BeginExecute() 和 AfterExecute() 方法的派生类。

type
  TMyThreadWithTask = class(TIdThreadWithTask)
  protected
    procedure BeforeExecute; override;
    procedure AfterExecute; override;
  end;

procedure TMyThreadWithTask.BeforeExecute;
begin
  CoInitialize(nil);
  inherited;
end;

procedure TMyThreadWithTask.AfterExecute;
begin
  inherited;
  CoUninitialize();
end;

procedure TForm4.FormCreate(Sender: TObject);
begin
  IdSchedulerOfThreadDefault1.ThreadClass := TMyThreadWithTask;
end;

^{1:至少在 https://github.com/IndySockets/Indy/issues/6 之前在 Indy 的 future 版本中实现。}