从C#COM dll回调到Delphi应用程序导致内存泄漏

我有一个用C#编写的COM服务器和一个用Delphi编写的COM客户端。我已经实现了一个简单而优雅的回调机制，它的工作方式很有魅力。但是，FastMM4报告我的Delphi客户端正在创建内存泄漏。我已将应用程序提炼为泄漏的根源。我知道泄漏是由对象被引用计数的方式造成的（它从不归零，所以也不会被破坏），所以我试图理解为什么引用计数是这样工作的，是因为我在实现中做了一些错误的事情

我已经尽可能地减少了代码，但在一个问题中似乎仍然需要包含很多内容。但我真的不知道如何解释我在做什么。我把这两个项目（C#和Delphi）整齐地打包在一个zip文件中，但似乎我无法将其附加到任何地方

我在C端声明了两个接口（

ICOMCallbackContainer

和

ICOMCallbackTestServer

），并在那里实现了其中一个接口（

COMCallbackTestServer

）。我正在Delphi端实现另一个接口（

TCOMCallbackContainer

），并将Delphi类传递给C#类

这是C#COM服务器：

namespace COMCallbackTest
{
    [ComVisible(true)]
    [Guid("2AB7E954-0AAF-4CFE-844C-756E50FE6360")]
    public interface ICOMCallbackContainer
    {
        void Callback(string message);
    }

    [ComVisible(true)]
    [Guid("7717D7AE-B763-48BC-BA0B-0F3525BEE8A4")]
    public interface ICOMCallbackTestServer
    {
        ICOMCallbackContainer CallbackContainer { get; set; }
        void RunCOMProcess();
        void Dispose();
    }

    [ComVisible(true)]
    [Guid("CF33E3A7-0886-4A0D-A740-537D0640C641")]
    public class COMCallbackTestServer : ICOMCallbackTestServer
    {
        ICOMCallbackContainer _callbackContainer;

        ICOMCallbackContainer ICOMCallbackTestServer.CallbackContainer
        {
            get { return _callbackContainer; }
            set { _callbackContainer = value; }
        }

        void ICOMCallbackTestServer.RunCOMProcess()
        {
            if (_callbackContainer != null)
            {
                _callbackContainer.Callback("Step One");
                _callbackContainer.Callback("Step Two");
                _callbackContainer.Callback("Step Three");
            }
        }

        void ICOMCallbackTestServer.Dispose()
        {
            if (_callbackContainer != null)
                _callbackContainer.Callback("Done");
        }
    }
}

这是Delphi回调容器：

type
  TCOMCallbackMethod = reference to procedure(AMessage: string);

  TCOMCallbackContainer = class(TAutoIntfObject, ICOMCallbackContainer)
  private
    FCallbackMethod: TCOMCallbackMethod;
    procedure Callback(const message: WideString); safecall;
  public
    constructor Create(ACallbackMethod: TCOMCallbackMethod);
    destructor Destroy; override;
  end;

//  ...

constructor TCOMCallbackContainer.Create(ACallbackMethod: TCOMCallbackMethod);
var
  typeLib: ITypeLib;
begin
  OleCheck(LoadRegTypeLib(LIBID_COMCallbackTestServer,
                          COMCallbackTestServerMajorVersion,
                          COMCallbackTestServerMinorVersion,
                          0,
                          {out} typeLib));
  inherited Create(typeLib, ICOMCallbackContainer);
  FCallbackMethod := ACallbackMethod;
end;

destructor TCOMCallbackContainer.Destroy;
begin
  FCallbackMethod := nil;

  inherited Destroy;
end;

procedure TCOMCallbackContainer.Callback(const message: WideString);
begin
  if Assigned(FCallbackMethod) then
    FCallbackMethod(message);
end;

...
CLR -> TInterfacedObject._AddRef:  2
CLR -> TInterfacedObject.QueryInterface(INoMarshal):  S_OK
CLR -> TInterfacedObject.QueryInterface -> TObject.GetInterface -> _AddRef:  3
CLR -> TInterfacedObject._Release:  2
CLR -> TInterfacedObject.QueryInterface(IRpcOptions):  E_NOINTERFACE
CLR -> TInterfacedObject._Release:  1
...

...
CLR -> TInterfacedObject._AddRef:  2
CLR -> TInterfacedObject.QueryInterface(INoMarshal):  E_NOINTERFACE
CLR -> TInterfacedObject.QueryInterface(IAgileObject):  S_OK
CLR -> TInterfacedObject.QueryInterface -> TObject.GetInterface -> _AddRef:  3
CLR -> TInterfacedObject._Release:  2
CLR -> TInterfacedObject.QueryInterface(IRpcOptions):  E_NOINTERFACE
CLR -> TInterfacedObject._Release:  1
...

TCOMCallbackContainer继承自TAutoIntfObject，因此它实现IDispatch。我不知道我在构造函数中做的事情是否正确。我不太熟悉如何使用IDispatch

这是Delphi COM客户端：

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  FServer := CoCOMCallbackTestServer_.Create as ICOMCallbackTestServer;

  //  Increments RefCount by 2, expected 1
  FServer.CallbackContainer := TCOMCallbackContainer.Create(Process_Callback);
end;

procedure TfrmMain.FormDestroy(Sender: TObject);
begin
  //  Decrements RefCount by 0, expected 1
  FServer.CallbackContainer := nil;

  FServer.Dispose;
  FServer := nil;
end;

procedure TfrmMain.btnBeginProcessClick(Sender: TObject);
begin
  FServer.RunCOMProcess;
end;

procedure TfrmMain.Process_Callback(AMessage: string);
begin
  mmoProcessMessages.Lines.Add(AMessage);
end;

上面的TCOMCallbackContainer实例永远不会被销毁，因为RefCount永远不会低于2

所以我的问题是，为什么将回调容器对象分配给COM属性会使引用计数增加两倍，而将nil分配给COM属性则根本不会减少引用计数

编辑

我创建了TMyInterfacedObject（与TInterfacedObject相同），并将其用作TCOMCallbackContainer的基类。我在TMyInterfacedObject的每个方法中放置断点。在每个断点，我都记录了调用堆栈（以及一些其他信息）。对于更新RefCount的每个方法，行末尾的数字将显示RefCount的新值。对于QueryInterface，我包括了IID和相应的接口名（通过Google找到）以及调用的结果

TfrmMain.FormCreate -> TCOMCallbackContainer.Create -> TInterfacedObject.NewInstance:  1
TfrmMain.FormCreate -> TCOMCallbackContainer.Create -> TInterfacedObject.AfterConstruction:  0
CLR -> TInterfacedObject.QueryInterface("00000000-0000-0000-C000-000000000046" {IUnknown}):  S_OK
CLR -> TInterfacedObject.QueryInterface -> TObject.GetInterface -> _AddRef:  1
CLR -> TInterfacedObject.QueryInterface("C3FCC19E-A970-11D2-8B5A-00A0C9B7C9C4" {IManagedObject}):  E_NOINTERFACE
CLR -> TInterfacedObject.QueryInterface("B196B283-BAB4-101A-B69C-00AA00341D07" {IProvideClassInfo}):  E_NOINTERFACE
CLR -> TInterfacedObject._AddRef:  2
CLR -> TInterfacedObject.QueryInterface("ECC8691B-C1DB-4DC0-855E-65F6C551AF49" {INoMarshal}):  E_NOINTERFACE
CLR -> TInterfacedObject.QueryInterface("94EA2B94-E9CC-49E0-C0FF-EE64CA8F5B90" {IAgileObject}):  E_NOINTERFACE
CLR -> TInterfacedObject.QueryInterface("00000003-0000-0000-C000-000000000046" {IMarshal}):  E_NOINTERFACE
CLR -> TInterfacedObject.QueryInterface("00000144-0000-0000-C000-000000000046" {IRpcOptions}):  E_NOINTERFACE
CLR -> TInterfacedObject._Release:  1
CLR -> TInterfacedObject.QueryInterface("2AB7E954-0AAF-4CFE-844C-756E50FE6360" {ICOMCallbackContainer}):  S_OK
CLR -> TInterfacedObject.QueryInterface -> TObject.GetInterface -> _AddRef:  2
CLR -> TInterfacedObject._AddRef:  3
CLR -> TInterfacedObject._Release:  2

列出的所有断点都发生在

FServer.CallbackContainer:=TCOMCallbackContainer.Create（Process\u Callback）中语句。在Destroy方法中，尤其是在
FServer.CallbackContainer:=nil语句，未命中任何断点

我想，也许是COM库在调用析构函数之前被卸载了，所以我复制了
FServer.CallbackContainer:=nil行到构造函数的末尾。这没什么区别

传递给QueryInterface调用的接口在Delphi环境中似乎不可用，因此我将尝试将其中一些接口继承到C#端的ICOMCallbackContainer中，以使它们可用（在研究它们应该做什么以及如何工作之后）

编辑2

我尝试实现INoMarshal和IAgileObject只是为了看看会发生什么。我尝试了这两种方法，因为它们都是标记接口，实际上没有什么可实现的。它稍微改变了这个过程，但没有任何帮助。看起来，如果CLR找到了INoMarshal，那么它不会查找IAgileObject或IMarshal；如果它没有找到INoMarshal，但是找到了IAgileObject，那么它不会查找IMarshal。（这似乎并不重要，甚至对我来说也没有意义。）

将INoMarshal添加到TCOMCallbackContainer后：

type
  TCOMCallbackMethod = reference to procedure(AMessage: string);

  TCOMCallbackContainer = class(TAutoIntfObject, ICOMCallbackContainer)
  private
    FCallbackMethod: TCOMCallbackMethod;
    procedure Callback(const message: WideString); safecall;
  public
    constructor Create(ACallbackMethod: TCOMCallbackMethod);
    destructor Destroy; override;
  end;

//  ...

constructor TCOMCallbackContainer.Create(ACallbackMethod: TCOMCallbackMethod);
var
  typeLib: ITypeLib;
begin
  OleCheck(LoadRegTypeLib(LIBID_COMCallbackTestServer,
                          COMCallbackTestServerMajorVersion,
                          COMCallbackTestServerMinorVersion,
                          0,
                          {out} typeLib));
  inherited Create(typeLib, ICOMCallbackContainer);
  FCallbackMethod := ACallbackMethod;
end;

destructor TCOMCallbackContainer.Destroy;
begin
  FCallbackMethod := nil;

  inherited Destroy;
end;

procedure TCOMCallbackContainer.Callback(const message: WideString);
begin
  if Assigned(FCallbackMethod) then
    FCallbackMethod(message);
end;

...
CLR -> TInterfacedObject._AddRef:  2
CLR -> TInterfacedObject.QueryInterface(INoMarshal):  S_OK
CLR -> TInterfacedObject.QueryInterface -> TObject.GetInterface -> _AddRef:  3
CLR -> TInterfacedObject._Release:  2
CLR -> TInterfacedObject.QueryInterface(IRpcOptions):  E_NOINTERFACE
CLR -> TInterfacedObject._Release:  1
...

...
CLR -> TInterfacedObject._AddRef:  2
CLR -> TInterfacedObject.QueryInterface(INoMarshal):  E_NOINTERFACE
CLR -> TInterfacedObject.QueryInterface(IAgileObject):  S_OK
CLR -> TInterfacedObject.QueryInterface -> TObject.GetInterface -> _AddRef:  3
CLR -> TInterfacedObject._Release:  2
CLR -> TInterfacedObject.QueryInterface(IRpcOptions):  E_NOINTERFACE
CLR -> TInterfacedObject._Release:  1
...

将IAgileObject添加到TCOMCallbackContainer后：

type
  TCOMCallbackMethod = reference to procedure(AMessage: string);

  TCOMCallbackContainer = class(TAutoIntfObject, ICOMCallbackContainer)
  private
    FCallbackMethod: TCOMCallbackMethod;
    procedure Callback(const message: WideString); safecall;
  public
    constructor Create(ACallbackMethod: TCOMCallbackMethod);
    destructor Destroy; override;
  end;

//  ...

constructor TCOMCallbackContainer.Create(ACallbackMethod: TCOMCallbackMethod);
var
  typeLib: ITypeLib;
begin
  OleCheck(LoadRegTypeLib(LIBID_COMCallbackTestServer,
                          COMCallbackTestServerMajorVersion,
                          COMCallbackTestServerMinorVersion,
                          0,
                          {out} typeLib));
  inherited Create(typeLib, ICOMCallbackContainer);
  FCallbackMethod := ACallbackMethod;
end;

destructor TCOMCallbackContainer.Destroy;
begin
  FCallbackMethod := nil;

  inherited Destroy;
end;

procedure TCOMCallbackContainer.Callback(const message: WideString);
begin
  if Assigned(FCallbackMethod) then
    FCallbackMethod(message);
end;

...
CLR -> TInterfacedObject._AddRef:  2
CLR -> TInterfacedObject.QueryInterface(INoMarshal):  S_OK
CLR -> TInterfacedObject.QueryInterface -> TObject.GetInterface -> _AddRef:  3
CLR -> TInterfacedObject._Release:  2
CLR -> TInterfacedObject.QueryInterface(IRpcOptions):  E_NOINTERFACE
CLR -> TInterfacedObject._Release:  1
...

...
CLR -> TInterfacedObject._AddRef:  2
CLR -> TInterfacedObject.QueryInterface(INoMarshal):  E_NOINTERFACE
CLR -> TInterfacedObject.QueryInterface(IAgileObject):  S_OK
CLR -> TInterfacedObject.QueryInterface -> TObject.GetInterface -> _AddRef:  3
CLR -> TInterfacedObject._Release:  2
CLR -> TInterfacedObject.QueryInterface(IRpcOptions):  E_NOINTERFACE
CLR -> TInterfacedObject._Release:  1
...

在托管代码中，外部COM接口被包装到（RCW）中。与原始COM接口不同，RCW的寿命由不使用引用计数的垃圾收集器确定。在您的特定情况下，这意味着对null的赋值不会立即减少refCount

可以通过显式调用强制COM对象引用释放：

[ComVisible（true）]
是否意味着
字符串
被封送为
BStr
？
TCOMCallbackContainer。销毁
是毫无意义的。把它拿走。您的
TAutoIntfObject
子分类在形式上与VCL中唯一的子分类相同，即
TStringsAdapter
。所以我认为
TCOMCallbackContainer
很好。COM服务器是如何导入的？这看起来合理吗。这是我们看不到的自动生成的代码。因此，
cococomcallbacktestserver
类型和朋友。@DavidHeffernan，字符串类型在_TLB.pas文件中显示为WideString，我相信它与BStr相同。是的，
WideString
和
BStr
是兼容的。我更熟悉p/invoke，但是
[ComVisible（true）]
暗示
字符串BStr
显然是有意义的。在类中使用未解释的引用实现自己的AddRef和Release。在每个方法中添加断点，并在触发断点时查看调用堆栈。这至少可以确定推荐人的身份。非常感谢。这不仅修复了我所经历的泄漏，而且我也学到了一些东西。我肯定需要学习更多关于编组的知识。