5

やCOMなどのオブジェクト インターフェイスにマルチスレッドでアクセスする場合、Delphi7 でメモリの問題が発生するようです。他の人もこの問題を共有しているかもしれませんが、私の「研究」はそれほど深いものではなく、現在のプロジェクトも進めなければなりません。のようなインターフェースを介して単一のスレッドで作成および操作することは問題ありませんが、マルチスレッドのアプローチでは、1 つのスレッドがオブジェクトを作成し、他のスレッドがオブジェクトを操作すると、ますます多くのメモリが使用されます。すべてのスレッドで呼び出されますが、無駄です。インターフェイスを取得するときにすべてのスレッドがメモリを割り当て、それを解放しないように見えますが、すべてのスレッドは一度だけ割り当てます-少なくとも特定のインターフェイスに対して-たとえばorIXMLDocumentIXMLNodeCOM interfacesTXMLDocumentIXMLDocumentIXMLNodeTXMLDocumentCoInitializeEx(nil, COINIT_MULTITHREADED)DocumentElementChildNodes- したがって、オブジェクトを作成したスレッドの横にある 1 つの作業スレッドは、目に見えるメモリ リークを引き起こしません。しかし、動的に作成されたスレッドはすべて同じように動作し、最終的にプロセス メモリを消費します。

form上記の 3 つの異なるシナリオ (単一スレッド、1 つの作業スレッド、および動的に作成されたスレッド) を示そうとする SCCE としての私の完全なテスト アプリケーション Delphi7を次に示します。

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、それを単にコピーしてコンパイルすることはできないためです。formの 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 を使用しています。どんな助けでも大歓迎です。

4

3 に答える 3

5

フリースレッド スレッド モデルを使用しています。を呼び出すときに、単一の COM オブジェクトを作成しますTXMLDocument.Create。次に、同期せずに複数のスレッドからそのオブジェクトを使用します。つまり、COM スレッドの規則に違反しています。これ以外にも問題があるかもしれませんが、これに対処するまで先に進むことは期待できません。

于 2013-10-30T09:14:14.337 に答える
0

質問には答えられず、問題は未解決のままでした。しかし、自分で解決しなければならなかったので、最終的に別のXML実装に切り替えることにしました。私の選択はOmniXML、メモリ消費がなくなりました。

于 2013-11-01T07:04:58.090 に答える
0

これはこの問題の実際の解決策ではありませんが、IXMLDocumentメインスレッドでインスタンスを開始し、再開を呼び出す前に新しく作成された動的スレッドへの参照を渡すことで解決しました。このアプローチでは、すべての参照がメインスレッドにIXMLDocument残るため、Delphi は参照カウントがゼロになったときにすべてを処理できます。

于 2017-05-24T21:14:41.603 に答える