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.