这个问题与我之前问过的这个问题有关。@RRUZ提供的代码正在工作,但似乎不太正确我做错了什么。
执行GetSharedFiles
后,TMyObject
的实例发生了奇怪的事情。字段FMyEvent
是(它应该是)nil指向一些随机数据。
我在5分钟前发现的是,如果我关闭编译器选项的优化,它在重建后工作得很好。也许这是编译器的bug?
下面是一个代码快照(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.
你知道哪里出错了吗?感谢您的宝贵时间。
调用约定应该是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将引发一个异常,并且该异常将出现,直到它到达应用程序中可以处理错误的点。或者它会弹出,直到它到达Application的异常处理程序,并用于为用户显示错误。
使用safecall
,上面的典型代码看起来像这样:
TypicalComFunction(Parameters); // raises exception on error
// Normal processing goes here
另一方面,如果确实需要HRESUL
,即使它与S_OK
不同,那么使用stdcall
变体
不,这并不意味着编译器本身有bug。更改编译器(Delphi<->FPC)、编译器版本或优化选项可能会影响代码退化,并优化掉引用计数的temp或更早地释放它们,或更改已使用的寄存器和寄存器分配。
这反过来又可以使真正隐藏的bug弹出和关闭。
这类问题的一个例子是调用外部函数。如果由于某种原因,它们的原型(在相关单元中的声明)是错误的,寄存器可能会被破坏,并且不同的编译器选项可能会导致heisenbug行为。
同样,自动类型的重新计数问题,或者修改通过CONST传递的全局变量也会导致这样的问题。在FPC主邮件列表上有一个关于后一个问题的大帖子。
记住:运行了很长时间的代码不一定是正确的
这不会是一个编译器错误。在字段上设置数据断点,您将找到覆盖该字段的代码。
我以前也遇到过类似的错误。它只在编译器优化时出现。除此之外,代码工作了大约2年没有问题。这是因为使用ON优化编译的代码与使用OFF优化编译的代码非常不同!!!!!!!由于这些机会,错误可能会出现(或不出现)。
提示:
- 使用FastMM(设置为主动调试模式)
- 总是使用FreeAndNil而不是Free。这可能会对你有很大的帮助,因为它可能会迫使代码中的错误更快地出现——也许在关闭优化编译的代码中也是如此。这实际上会证明这个bug一直存在。你可以在你的代码中为"。free"做大量的"搜索和替换"。
这两个技巧帮助我找到了bug