Delphi Win32 TXMLDocument 无法从线程实例化和使用?

X-R*_*Ray 3 delphi indy txmldocument win32com indy10

我一直在使用 IndyTIdTCPServer对象并TXMLDocumentTIdTCPServer.OnExecute活动期间实例化对象实例。xml.Active我发现当设置为 true时出现异常非常令人惊讶:

未安装 Microsoft MSXML

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;
Run Code Online (Sandbox Code Playgroud)

更深入地观察,我发现发生异常的原因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;
Run Code Online (Sandbox Code Playgroud)

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

即使这是原因,我如何TXMLDocument在该事件处理程序中使用?

Rem*_*eau 9

MSXML 是一种基于COM 的技术。您需要CoInitialize/Ex()在每个访问 COM 接口的线程上下文中调用来初始化 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;
Run Code Online (Sandbox Code Playgroud)

但是,由于TIdTCPServer支持线程池,并且每个线程只应初始化 COM 一次,因此在本例1中初始化 COM 的最佳位置是直接在每个线程的方法中。为此,请显式地将派生组件(、等)分配给该属性(可以在设计时完成),然后将该属性(必须在运行时、激活服务器之前完成)设置为派生组件重写虚拟方法和方法的类。Execute()TIdSchedulerOfThreadTIdSchedulerOfThreadDefaultTIdSchedulerOfThreadPoolTIdTCPServer.SchedulerTIdSchedulerOfThread.ThreadClassTIdThreadWithTaskBeginExecute()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;
Run Code Online (Sandbox Code Playgroud)

1:至少在https://github.com/IndySockets/Indy/issues/6在 Indy 的未来版本中实现之前。