Multithreading 以多线程方式使用Delphi7 COM接口时的内存消耗

当以多线程方式访问

COM

对象接口（如

IXMLDocument

和

IXMLNode

）等）时，Delphi7中似乎存在一些内存问题。其他

COM接口

可能也有这个问题，但我的“研究”并没有那么深入，因为我也必须继续我当前的项目。在单个线程上创建

TXMLDocument

并通过

IXMLDocument

和

IXMLNode

等接口对其进行操作是可以的，但在多线程方法中，当一个线程创建

TXMLDocument

对象，而其他线程进行操作时，它会使用越来越多的内存

coinitializex（nil，COINIT\u multi-threaded）

在每个线程中都被调用，但都是徒劳的。似乎每个线程在获取接口时都会分配一些内存，而不会释放它，但每个线程都会分配一次内存—至少对于某个接口—例如

DocumentElement

或

ChildNodes

—因此，创建对象的线程旁边的一个工作线程不会导致可见的内存泄漏。但是动态创建的线程都以相同的方式运行，最终会消耗掉进程内存

下面是我的完整测试应用程序Delphi7

表单

as SCCE，它试图显示上述三种不同的场景——单线程、一个工作线程和动态创建的线程

unit uComTest;

interface

uses 
  Windows, SysUtils, Classes, Forms, ExtCtrls, Controls, StdCtrls, XMLDoc, XMLIntf,            ActiveX;

type

  TMyThread = class(TThread)
    procedure Execute;override;
  end;

  TForm1 = class(TForm)

    btnMainThread: TButton;
    edtText: TEdit;
    Timer1: TTimer;
    btnOneThread: TButton;
    btnMultiThread: TButton;
    Timer2: TTimer;
    chkXMLUse: TCheckBox;

    procedure FormCreate(Sender: TObject);
    procedure btnMainThreadClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btnOneThreadClick(Sender: TObject);
    procedure btnMultiThreadClick(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);

  private

    fXML:TXMLDocument;
    fXMLDocument:IXMLDocument;
    fThread:TMyThread;
    fCount:Integer;
    fLoop:Boolean;

    procedure XMLCreate;
    function XMLGetItfc:IXMLDocument;
    procedure XMLUse;

  public

end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject); 
begin
  CoinitializeEx(nil, COINIT_MULTITHREADED);
  XMLCreate; //XML is created on MainThread;
  Timer1.Enabled := false;
  Timer2.Enabled := false;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  fIXMLDocument := nil;
  CoUninitialize;
end;

procedure TForm1.XMLCreate;
begin
  fXML := TXMLDocument.Create('.\try.xml');
  fXML.Active;
  fXML.GetInterface(IXMLDocument, fIXMLDocument);
end;

function TForm1.XMLGetItfc:IXMLDocument;
begin
  fXML.GetInterface(IXMLDocument, Result); 
end;

procedure TForm1.XMLUse;
begin
  Inc(fCount);

  if chkXMLUse.Checked then
  begin
    XMLGetItfc.DocumentElement;
    edtText.Text := IntToStr(GetCurrentThreadId) + ': ' + 'XML access  ' + IntToStr(fCount);
  end
  else
    edtText.Text := IntToStr(GetCurrentThreadId) + ': ' + 'NO XML access  ' +   IntToStr(fCount)
end;

procedure TForm1.btnMainThreadClick(Sender: TObject);
begin
  fCount := 0;
  fLoop := false;
  Timer1.Enabled := not Timer1.Enabled;
end;

procedure TForm1.btnOneThreadClick(Sender: TObject);
begin
  if fLoop then
    fLoop := false
  else
  begin
    fCount := 0;
    fLoop := true;
    fThread := TMyThread.Create(FALSE);
  end;
end;

procedure TForm1.btnMultiThreadClick(Sender: TObject);
begin
  fCount := 0;
  fLoop := false;
  Timer2.Enabled := not Timer2.Enabled;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  XMLUse;
end;

procedure TForm1.Timer2Timer(Sender: TObject);
begin
  TMyThread.Create(FALSE);
end;

//this procedure executes in every thread
procedure TMyThread.Execute;
begin
  FreeOnTerminate := TRUE;
  CoinitializeEx(nil, COINIT_MULTITHREADED);
  try
    repeat
      Form1.XMLUse;
      if Form1.floop then
        sleep(100);
    until not Form1.floop;
  finally
    CoUninitialize;
  end;
end;

end.

嗯，这不仅仅是必要的，因为它是一个工作的Delphi表单，带有

按钮

和

计时器

，而且更少，因为您不能仅仅复制和编译它。以下是

表单

的dfm：

object Form1: TForm1
  Left = 54
  Top = 253
  Width = 337
  Height = 250
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  PixelsPerInch = 96
  TextHeight = 13
  object btnMainThread: TButton
    Left = 24
    Top = 32
    Width = 75
    Height = 25
    Caption = 'MainThread'
    TabOrder = 0
    OnClick = btnMainThreadClick
  end
  object edtText: TEdit
    Left = 24
    Top = 8
    Width = 257
    Height = 21
    TabOrder = 1
  end
  object btnOneThread: TButton
    Left = 24
    Top = 64
    Width = 75
    Height = 25
    Caption = 'One Thread'
    TabOrder = 2
    OnClick = btnOneThreadClick
  end
  object btnMultiThread: TButton
    Left = 24
    Top = 96
    Width = 75
    Height = 25
    Caption = 'MultiThread'
    TabOrder = 3
    OnClick = btnMultiThreadClick
  end
  object chkXMLUse: TCheckBox
    Left = 112
    Top = 88
    Width = 97
    Height = 17
    Caption = 'XML use'
    Checked = True
    State = cbChecked
    TabOrder = 4
  end
  object Timer1: TTimer
    Interval = 100
    OnTimer = Timer1Timer
  end
  object Timer2: TTimer
    Interval = 100
    OnTimer = Timer2Timer
    Left = 32
  end
end

这是一个控制台应用程序。只要运行它，看看是否有内存消耗发生。如果您认为它可以以保留多线程但不消耗内存的方式编写，请随意修改：

program ConsoleTest;

{$APPTYPE CONSOLE}

uses

  Windows, SysUtils, Classes, XMLDoc, XMLIntf, ActiveX;

type

  TMyThread = class(TThread)

    procedure Execute;override;

  end;

var
  fCriticalSection:TRTLCriticalSection;
  fIXMLDocument:IXMLDocument;
  i:Integer;

//--------- Globals -------------------------------
procedure XMLCreate;
begin
  fIXMLDocument := TXMLDocument.Create('.\try.xml');
  fIXMLDocument.Active;
end;

procedure XMLUse;
begin
  fIXMLDocument.DocumentElement;
end;

//------- TMyThread ------------------------------
procedure TMyThread.Execute;
begin
  FreeOnTerminate := TRUE;

  EnterCriticalSection(fCriticalSection);
  try
    CoinitializeEx(nil, COINIT_MULTITHREADED);
    try
      XMLUse;
    finally
      CoUninitialize;
    end;
  finally
    LeaveCriticalSection(fCriticalSection);
  end;
end;

//------------ Main -------------------------
begin
  InitializeCriticalSection(fCriticalSection);
  CoinitializeEx(nil, COINIT_MULTITHREADED);
  try
    XMLCreate;
    try
      for i := 0 to 100000 do
      begin
        TMyThread.Create(FALSE);
        sleep(100);
      end;
    finally
      fIXMLDocument := nil;
    end;
  finally
    CoUninitialize;
    DeleteCriticalSection(fCriticalSection);
  end;
end.

我正在Windows7上使用Delphi7 Enterprise。

---

欢迎提供任何帮助。

您使用的是免费线程模型。调用

TXMLDocument.create

时创建一个COM对象。然后从多个线程使用该对象，而不进行任何同步。换句话说，您违反了COM线程规则。可能会有更多的问题，但在处理这些问题之前，您不能期望继续进行。

问题没有得到回答，问题仍然没有解决。但我必须自己解决它，所以最终我决定切换到另一个

XML

实现。我的选择是

OmniXML

，内存消耗现在消失了

对于这个问题，这不是一个真正的解决方案，但我在主线程上启动了一个

IXMLDocument

实例，并在调用resume之前将其引用传递给新创建的动态线程。使用这种方法，

IXMLDocument的所有引用都保留在主线程上，因此当referencecount为零时，Delphi可以处理所有引用。
只需在第二个代码块中添加dfm，其余的就不需要在代码中出现一个大的红旗：
XML:=TXMLDocument.Create（'.\try.XML'）。应该是
fXMLDocument:=TXMLDocument.Create（'.\try.xml'）。并且去掉GetInterface代码。第二个大的危险信号。您不能从线程访问GUI<
TMyThread.Execute
中的code>Form1.XMLUse
是不允许的，因为XMLUse函数正在设置TEdit文本。在我看来，你需要正确掌握线程的基本知识。我建议阅读这本优秀的Delphi多线程指南：我现在没有时间，但我将为您提供在线程中正确使用XMLDocument的示例。我们不需要GUI。只需在控制台应用程序中创建一个SSCCE。我尝试了同步（而不是在测试应用程序中）——正如我所说的，使用一个线程访问
COM
是可以的。我想用辛奇作为最后的手段。据我所知，
COM
对象访问只能与
单元
线程模型同步。使用
free
线程，您可能需要监视并发访问（使用
关键部分
等），但不需要同步。就创建者和工作线程而言，我尝试了“Conit_uu2;”标志的所有四种可能的替代方案。只是稳定的内存消耗。因此，问题是：在没有同步的情况下，它能以任何可能的方式使用吗？那么，什么是同步？使用互斥来序列化就可以了。您的代码忽略线程规则。为什么不同的线程需要共享对象？在同步下，我的意思是强制一个线程将参数和函数指针传递给另一个线程（例如主线程），该线程将在第一个线程处于有效等待循环时调用该函数。通过这种方式，我们可以像在单线程模式下一样执行部分代码。其他同步工具（如critical Section）强制线程等待，但在原始线程上执行代码。在这个测试应用程序中，由于睡眠的原因，不需要使用这些其他工具。不同的线程都只要求相同的接口，它们必须这样做。我真正的项目是一个高度多线程的项目。只要我不是被迫的，我会尽量坚持这一点。你对同步的定义和我的不一样。听着，我也不知道睡眠是从哪里来的。这不是一个同步工具。这不会改变线程模型，也不会以某种方式消除存在的竞争。如果性能是一个问题，那么数据共享肯定不会有帮助。划分是您需要的。使用STA获得最佳性能。