我的班级实例中出现奇怪的内存覆盖问题

Question

这个问题与我之前问过的this 问题有关。 @RRUZ 提供的代码正在运行，但似乎不太正确或 我做错了什么。

在执行GetSharedFiles 之后，TMyObject 的实例中发生了奇怪的事情。 FMyEvent 字段（应该是）nil 指向一些随机数据。

我在 5 分钟前发现的是，如果我关闭编译器选项中的优化，它在重建后可以正常工作。所以也许这是一些编译器错误？

这是代码快照（Delphi 2009 Windows 7 64 位）：

unit Unit17;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm17 = class(TForm)
    btnetst: TButton;
    procedure btnTestClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

type
  TMyEvent = procedure(Sender: TObject) of object;

type
  TMyObject = class(TObject)
  private
    FMyEvent: TMyEvent;
    function GetSharedFiles: TStringList;
  public
    property OnEvent: TMyEvent read FMyEvent write FMyEvent;
    procedure DoSomething;
  end;

var
  Form17: TForm17;

implementation

uses
  ActiveDs_TLB,
  ActiveX;

function ADsGetObject(lpszPathName:WideString; const riid:TGUID; out ppObject):HRESULT; safecall; external 'activeds.dll';

{$R *.dfm}

procedure TForm17.btnTestClick(Sender: TObject);
var
  MyObject: TMyObject;
begin
  MyObject := TMyObject.Create;
  try
    MyObject.DoSomething;
  finally
    if Assigned(MyObject) then
      MyObject.Free;
  end;
end;

{ TMyObject }

procedure TMyObject.DoSomething;
var
  TmpList: TStringList;
begin
  try

    TmpList := GetSharedFiles; //something is overwritting the memory in object and puts random data to FMyEvent?
    if Assigned(FMyEvent) then
      ShowMessage('WTF'); //this should not be called, and if you comment out GetSharedFiles it won't.

  finally
    if Assigned(TmpList) then
      TmpList.Free;
  end;
end;


function TMyObject.GetSharedFiles: TStringList;
var
  FSO           : IADsFileServiceOperations;
  Resources     : IADsCollection;
  Resource      : OleVariant;
  pceltFetched  : Cardinal;
  oEnum         : IEnumvariant;
begin
  Result := TStringList.Create;
  //establish the connection to ADSI
  if ADsGetObject('WinNT://./lanmanserver', IADsFileServiceOperations, FSO) = S_OK then
  begin
    //get the resources interface
    Resources := FSO.Resources;
    //get the enumerator
    oEnum:= IUnknown(Resources._NewEnum) as IEnumVariant;
    while oEnum.Next(1, Resource, pceltFetched) = 0 do
    begin
      Result.Add(LowerCase(Format('%s%s%s',[Resource.Path,#9,Resource.User])));
      Resource:=Unassigned;
    end;
  end;
end;    
end.

有什么想法吗？ 感谢您的宝贵时间。

Answer 1

对此的调用约定应该是stdcall，而不是safecall：

function ADsGetObject(lpszPathName:WideString; const riid:TGUID; out ppObject):HRESULT; safecall; external 'activeds.dll';

---

回顾

典型的 COM 函数返回 HRESULT 结果；他们使用它来传递错误代码或S_OK，如果一切正常。使用这种类型的函数，你通常会有这样的代码：

if CallComFunction(parameters) = S_OK then
  begin
    // Normal processing goes here
  end
else
  begin
    // Error condition needs to be dealt with here.
  end

由于通常无法处理错误情况，Delphi 为我们提供了safecall 伪调用约定。这不是真正的调用约定，因为实际上它在幕后使用stdcall。它的作用是自动为S_OK 生成测试，并在失败时引发错误。因此，典型的 COM 方法可以声明为以下任一方法：

function TypicalComFunction(Parameters): HRESULT; stdcall;
procedure TypicalComFunction(Parameters); safecall;

如果您不打算处理任何潜在的错误，请使用第二种形式（使用safecall）并忽略潜在的异常。如果确实发生了错误，Delphi 将引发一个异常，并且该异常会冒泡，直到它到达应用程序中可以处理该错误的点。或者它会冒泡，直到它到达应用程序的异常处理程序，这用于向用户显示错误。

使用safecall，上面的典型代码如下所示：

TypicalComFunction(Parameters); // raises exception on error    
// Normal processing goes here

另一方面，如果您确实需要HRESUL，即使它与S_OK 不同，那么请使用stdcall 变体。

Answer 2

不，这并不意味着编译器本身存在错误。更改编译器 (DelphiFPC)、编译器版本或优化选项会影响代码生成，并优化引用计数临时值或提前释放它们，或更改使用的寄存器和寄存器分配。

这反过来可以使真正隐藏的错误弹出和关闭。

此类问题的一个示例是您调用外部函数。如果由于某种原因他们的原型（相关单元中的声明）是错误的，则寄存器可能会被破坏，并且编译器选项的再次变化可能会导致 heisenbug 行为。

自动类型的引用计数问题，或修改通过 CONST 在某处传递的全局变量也可能导致此类问题。在主 FPC 邮件列表 atm 上有一个关于后一个问题的大量线程。

记住：运行了很长时间的代码不一定正确。

Answer 3

这不会是编译器错误。在字段上设置数据断点，您会发现覆盖该字段的代码。

Answer 4

我过去也遇到过类似的错误。它仅在编译器优化打开时出现。否则，代码工作了大约 2 年没有问题。这是因为优化 ON 编译的代码与优化 OFF 编译的代码有很大不同！！！！！！！！！由于这些机会，错误可能会出现（或不会出现）。

提示：

• 使用 FastMM（设置为积极调试模式）
• 始终使用 FreeAndNil 而不是 Free。这可能对您有很大帮助，因为它可能会迫使您的代码中的错误更快出现 - 也可能在优化关闭的编译代码中。这实际上将证明该错误一直存在。您可以在代码中对“.Free”进行大量“搜索和替换”。

这两个技巧帮助我找到了错误。