logo标签列表

为什么一个类的实例(TInterfacedObject, IDropTarget)不会自动释放？

delphidelphi-5tinterfacedobject
7
我正在根据以下内容实现我的IDropTarget：如何允许一个窗体接受文件拖放而不处理Windows消息？ David的实现很好。然而IDropTarget (TInterfacedObject)对象不会自动释放，即使设置为“nil”也不行。
其中一部分代码是：
{ TDropTarget }
constructor TDropTarget.Create(AHandle: HWND; const ADragDrop: IDragDrop);
begin
  inherited Create;
  FHandle := AHandle;
  FDragDrop := ADragDrop;
  OleCheck(RegisterDragDrop(FHandle, Self));
  //_Release;
end;

destructor TDropTarget.Destroy;
begin
  MessageBox(0, 'TDropTarget.Destroy', '', MB_TASKMODAL);
  RevokeDragDrop(FHandle);
  inherited;
end;
...

procedure TForm1.FormShow(Sender: TObject);
begin
  Assert(Panel1.HandleAllocated);
  FDropTarget := TDropTarget.Create(Panel1.Handle, nil) as IDropTarget;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  FDropTarget := nil; // This should free FDropTarget
end;

var
  NeedOleUninitialize: Boolean = False;

initialization
  NeedOleUninitialize := Succeeded(OleInitialize(nil));

finalization
  if (NeedOleUninitialize) then
    OleUninitialize;

end.

其中 FDropTarget: IDropTarget;。

当我点击按钮时，没有弹出消息框，对象也没有被销毁。

如果我在构造函数结尾处调用 _Release;（如此处建议），则当我点击按钮或程序终止时，FDropTarget 会被销毁（我对这个“解决方案”表示怀疑）。

如果我省略 RegisterDragDrop(FHandle, Self)，那么 FDropTarget 会按预期被销毁。

我认为某些原因导致了引用计数的错误。我真的很困惑。如何正确释放 TInterfacedObject？

编辑：

以下是完整代码：

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  VirtualTrees, ExtCtrls, StdCtrls,
  ActiveX, ComObj;

type    
  TDropTarget = class(TInterfacedObject, IDropTarget)
  private
    FHandle: HWND;
    FDropAllowed: Boolean;
    function GetTreeFromDataObject(const DataObject: IDataObject): TBaseVirtualTree;
    procedure SetEffect(var dwEffect: Integer);
    function DragEnter(const dataObj: IDataObject; grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult; stdcall;
    function DragOver(grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult; stdcall;
    function DragLeave: HResult; stdcall;
    function Drop(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult; stdcall;
  public
    constructor Create(AHandle: HWND);
    destructor Destroy; override;
  end;

  TForm1 = class(TForm)
    Panel1: TPanel;
    VirtualStringTree1: TVirtualStringTree;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure VirtualStringTree1DragAllowed(Sender: TBaseVirtualTree;
      Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean);
    procedure Button1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    FDropTarget: IDropTarget;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

{ TDropTarget }

constructor TDropTarget.Create(AHandle: HWND);
begin
  inherited Create;
  FHandle := AHandle;
  OleCheck(RegisterDragDrop(FHandle, Self));
  //_Release;
end;

destructor TDropTarget.Destroy;
begin
  MessageBox(0, 'TDropTarget.Destroy', '', MB_TASKMODAL);
  RevokeDragDrop(FHandle);
  inherited;
end;

function TDropTarget.GetTreeFromDataObject(const DataObject: IDataObject): TBaseVirtualTree;
// Returns the owner/sender of the given data object by means of a special clipboard format
// or nil if the sender is in another process or no virtual tree at all.
var
  Medium: TStgMedium;
  Data: PVTReference;
  formatetcIn: TFormatEtc;
begin
  Result := nil;
  if Assigned(DataObject) then
  begin
    formatetcIn.cfFormat := CF_VTREFERENCE;
    formatetcIn.ptd := nil;
    formatetcIn.dwAspect := DVASPECT_CONTENT;
    formatetcIn.lindex := -1;
    formatetcIn.tymed := TYMED_ISTREAM or TYMED_HGLOBAL;
    if DataObject.GetData(formatetcIn, Medium) = S_OK then
    begin
      Data := GlobalLock(Medium.hGlobal);
      if Assigned(Data) then
      begin
        if Data.Process = GetCurrentProcessID then
          Result := Data.Tree;
        GlobalUnlock(Medium.hGlobal);
      end;
      ReleaseStgMedium(Medium);
    end;
  end;
end;

procedure TDropTarget.SetEffect(var dwEffect: Integer);
begin
  if FDropAllowed then begin
    dwEffect := DROPEFFECT_COPY;
  end else begin
    dwEffect := DROPEFFECT_NONE;
  end;
end;

function TDropTarget.DragEnter(const dataObj: IDataObject; grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult;
var
  Tree: TBaseVirtualTree;
begin
  Result := S_OK;
  try
    Tree := GetTreeFromDataObject(dataObj);
    FDropAllowed := Assigned(Tree);
    SetEffect(dwEffect);
  except
    Result := E_UNEXPECTED;
  end;
end;

function TDropTarget.DragLeave: HResult;
begin
  Result := S_OK;
end;

function TDropTarget.DragOver(grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult;
begin
  Result := S_OK;
  try
    SetEffect(dwEffect);
  except
    Result := E_UNEXPECTED;
  end;
end;

function TDropTarget.Drop(const dataObj: IDataObject; grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult;
var
  Tree: TBaseVirtualTree;
begin
  Result := S_OK;
  try
    Tree := GetTreeFromDataObject(dataObj);
    FDropAllowed := Assigned(Tree);
    if FDropAllowed then
    begin
      Alert(Tree.Name);
    end;
  except
    Application.HandleException(Self);
  end;
end;

{----------------------------------------------------------------------------------------------------------------------}
procedure TForm1.FormCreate(Sender: TObject);
begin
  VirtualStringTree1.RootNodeCount := 10;
end;

procedure TForm1.VirtualStringTree1DragAllowed(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean);
begin
  Allowed := True;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  Assert(Panel1.HandleAllocated);
  FDropTarget := TDropTarget.Create(Panel1.Handle) as IDropTarget;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  FDropTarget := nil; // This should free FDropTarget
end;

var
  NeedOleUninitialize: Boolean = False;

initialization
  NeedOleUninitialize := Succeeded(OleInitialize(nil));

finalization
  if (NeedOleUninitialize) then
    OleUninitialize;

end.

DFM:

object Form1: TForm1
  Left = 192
  Top = 114
  Width = 567
  Height = 268
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Shell Dlg 2'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  OnShow = FormShow
  PixelsPerInch = 96
  TextHeight = 13
  object Panel1: TPanel
    Left = 368
    Top = 8
    Width = 185
    Height = 73
    Caption = 'Panel1'
    TabOrder = 0
  end
  object VirtualStringTree1: TVirtualStringTree
    Left = 8
    Top = 8
    Width = 200
    Height = 217
    Header.AutoSizeIndex = 0
    Header.Font.Charset = DEFAULT_CHARSET
    Header.Font.Color = clWindowText
    Header.Font.Height = -11
    Header.Font.Name = 'MS Shell Dlg 2'
    Header.Font.Style = []
    Header.MainColumn = -1
    Header.Options = [hoColumnResize, hoDrag]
    TabOrder = 1
    TreeOptions.SelectionOptions = [toMultiSelect]
    OnDragAllowed = VirtualStringTree1DragAllowed
    Columns = <>
  end
  object Button1: TButton
    Left = 280
    Top = 8
    Width = 75
    Height = 25
    Caption = 'Button1'
    TabOrder = 2
    OnClick = Button1Click
  end
end

结论： 从文档中得知：

RegisterDragDrop函数同时也会调用IDropTarget指针上的IUnknown::AddRef方法。

我提供的答案已经修正了错误。

请注意，TDropTarget上的引用计数被抑制。这是因为调用RegisterDragDrop时会增加引用计数。这会创建一个循环引用，而抑制引用计数的代码则会破坏它。这意味着您应该通过类变量而不是接口变量来使用这个类，以避免泄漏。

@GolezTrol，David在他的代码中使用了额外的IDragDrop来进行实现。我没有使用，因为我不需要它。没关系，我会删除注释，因为它与问题无关。 - zig
@Fritzw，RevokeDragDrop在类的析构函数中。 - zig
1
@DavidHeffernan，真正的MCVE就是你的代码。并且仅有 FDropTarget := TDropTarget.Create(Panel1.Handle, nil) as IDropTarget。 - zig
1
@Fritzw，但是为什么引用计数>0？ - zig
代码在其他地方。我必须尝试重新创建你的代码。为什么我要这样做呢？如果你想要帮助，为什么不能自己动手呢？ - David Heffernan
显示剩余6条评论
1个回答
9
在`TDragDrop.Create`中调用RegisterDragDrop时，传递了一个计数引用到新的TDragDrop实例。这增加了它的引用计数器。指令FDragDrop := Nil减少了引用计数器，但仍然存在一个引用对象的引用，防止对象自行销毁。
为了将引用计数器降至零，您需要在删除该实例的最后一个引用之前调用RevokeDragDrop(FHandle)。简而言之，在析构函数中调用RevokeDragDrop太晚了。
因为它是一个接口？ - Fritzw
1
啊，我明白了。文档上说：“RegisterDragDrop 函数还会在 IDropTarget 指针上调用 IUnknown::AddRef 方法。” 我能否调用“_Release”来重置引用计数？ - zig
2
好的，我现在已经完成了。这个答案可以被接受。加上@zig找到的文档链接会更好。 - David Heffernan
1
@remy 在窗口句柄创建时创建拖放对象。在窗口句柄被销毁时销毁拖放对象。拖放对象类很好，只需要与窗口生命周期绑定即可。 - David Heffernan
1
就我个人而言，我会（并且已经这样做了）在创建窗体时创建下拉对象，并保留对它的引用（refcnt 1），然后在创建面板窗口时注册它（refcnt 2），在销毁面板窗口时注销它（refcnt 1），最后在销毁窗体时释放它（refcnt 0）。 - Remy Lebeau
显示剩余5条评论
网页内容由stack overflow 提供, 点击上面的
可以查看英文原文，
原文链接