以多线程方式使用Delphi7 COM接口时的内存消耗 [英] Memory consumption when using Delphi7 COM interfaces in a multithreaded way

问题描述

在访问 COM 对象接口（例如 IXMLDocument 和<$）时，Delphi7似乎存在一些内存问题c $ c> IXMLNode - 等等 - 以多线程方式。其他 COM接口可能会共享这个问题，但我的研究不是那么深的原因，我必须继续我的当前项目。创建 TXMLDocument 并通过 IXMLDocument 和 IXMLNode 在单线程是确定，但在多线程方法中，当一个线程创建 TXMLDocument 对象，其他操作它使用越来越多的内存。 CoInitializeEx（nil，COINIT_MULTITHREADED）在每个线程中调用，但是无效。看起来每个线程在获取接口时分配一些内存，并且不释放它，但是每个线程分配一次 - 至少对于某个接口。 DocumentElement 或 ChildNodes - 因此在创建对象的旁边有一个工作线程不会导致可见内存泄漏。但是动态创建的线程的行为都是一样的，最终消耗了进程内存。

It seems that there is some memory problem in Delphi7 when accessing COM object interfaces such as IXMLDocument and IXMLNode - and so forth - in a multithreaded way. Other COM interfaces may share this problem, but my "research" isn't that deep cause I have to proceed my current project as well. Creating TXMLDocument and manipulating it via interfaces like IXMLDocument and IXMLNode on a single thread is ok, but in a multithreading approach, when one thread creates the TXMLDocument object and the others manipulates it uses more and more memory. CoInitializeEx(nil, COINIT_MULTITHREADED) is called in every thread but in vain. It seems that every thread allocates some memory when getting an interface and does not free it, but every thread allocates it once - at least for a certain interface - e.g. the DocumentElement or ChildNodes - so one working thread beside the one that created the object - does not cause visible memory leak. But dynamically created threads are all behave the same way and eventually consume up process memory.

这是我的完整测试应用程序Delphi7 form as SCCE，它试图显示上面提到的三种不同的情况 - 单线程，一个工作线程和动态创建的线程。

Here is my full test application Delphi7 form as SCCE which try to show three different scenario mentioned above - single thread, one working thread and dynamically created threads.

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形式与按钮和 timers 等等，因为你不能只是复制和编译它。这里也是形式的dfm：

Well, it is more than necessary cause it's a working Delphi form with buttons and timers and less because you cannot just copy and compile it. Here is the form's dfm as well:

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

这里是一个控制台应用程序。只是运行它，看看是否有任何内存消耗。修改它，如果你认为它可以写一种方式保持多线程，但不会消耗内存：

And here is a console app. Just run it and see if any memory consumption occurs. Modify it as you like if you think it can be written a way that preserve multithreading but does not eat up memory:

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。
任何帮助是非常受欢迎的。

I'm using Delphi7 Enterprise on Windows7. Any help is very welcomed.

推荐答案

您正在使用自由螺纹线程模型。当您调用 TXMLDocument.Create 时，将创建一个COM对象。然后，您可以从多个线程使用该对象，而不进行任何同步。换句话说，你违反了COM线程规则。可能有比这更多的问题，但你不能指望继续，直到你处理这个。

You are using the free-threaded threading model. You create a single COM object when you call TXMLDocument.Create. You then use that object from multiple threads without any synchronization. In other words, you are contravening the COM threading rules. There may be more problems than this, but you cannot expect to proceed until you deal with this.

这篇关于以多线程方式使用Delphi7 COM接口时的内存消耗的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！