This problem is related to this question, which I've asked earlier. The code provided by @RRUZ is working but it seems that not quite correctly or I am doing something wrong.
After executing GetSharedFiles
strange thing is happening in instance of TMyObject
. The field FMyEvent
which was (and it should be) nil points to some random data.
What I've discovered just 5 minutes ago is that if I turn off the optimization in compiler options it works fine after rebuild. So maybe this is some compiler bug?
Here is a code snapshot (Delphi 2009 Windows 7 64 bit):
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.
Any ideas what is going wrong? Thanks for your time.
The calling convention on this should probably be stdcall
, not safecall
:
function ADsGetObject(lpszPathName:WideString; const riid:TGUID; out ppObject):HRESULT; safecall; external 'activeds.dll';
Typical COM functions return a HRESULT
result; They use it to pass an error code or S_OK
if everything went fine. Using this type of function, you'd usually have this kind of code:
if CallComFunction(parameters) = S_OK then
begin
// Normal processing goes here
end
else
begin
// Error condition needs to be dealt with here.
end
Since error conditions can't usually be dealt with, Delphi provides us with the safecall
pseudo-calling-convention. It's not a true calling convention because in fact it uses stdcall
behind the scenes. What it does is to automatically generate the test for S_OK
and, on failure, raises an error. So the typical COM method can be declared as either one of this:
function TypicalComFunction(Parameters): HRESULT; stdcall;
procedure TypicalComFunction(Parameters); safecall;
If you don't intend to deal with any potential errors use the second form (with safecall
) and simply ignore the potential exception. If an error does occur, Delphi will raise an Exception, and that exception will bubble-up until it reaches a point in the application that can deal with the error. Or it bubbles up until it reaches Application's exception handler, and that's used to display the error for the user.
Using safecall
, the typical code above looks like this:
TypicalComFunction(Parameters); // raises exception on error
// Normal processing goes here
On the other hand if you do need the HRESUL
even if it's different from S_OK
, then use the stdcall
variant.