Memory consumption when using Delphi7 COM interfaces in a multithreaded way

Question

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.

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.

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.

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

Answer 1

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.