pet*_*ter 5 memory delphi com multithreading xmldocument
当以多线程方式访问COM诸如IXMLDocument和IXMLNode/等等的对象接口时,Delphi7中似乎存在一些内存问题.其他人COM interfaces可能会分享这个问题,但我的"研究"并不是那么深刻,因为我必须继续我现在的项目.创建TXMLDocument并通过接口,如操纵它IXMLDocument,并IXMLNode在单个线程上是好的,但在多线程的方法,当一个线程创建的TXMLDocument对象和其他人操纵它使用越来越多的内存.CoInitializeEx(nil, COINIT_MULTITHREADED)在每个线程中调用但是徒劳无功.似乎每个线程得到一个接口时,并没有释放它分配一些内存,但每一次的线程分配给它-至少在某一个接口-例如DocumentElement或ChildNodes- 所以在创建对象的线程旁边有一个工作线程 - 不会导致可见的内存泄漏.但是,动态创建的线程的行为方式都相同,最终消耗了进程内存.
这是我的完整测试应用程序Delphi7 form作为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表单,buttons而且timers因为你不能只复制和编译它.这也是formdfm:
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.任何帮助都非常欢迎.
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.