I'am struggling implementing an OSX CoreMidi MidiCallback procedure with Lazarus / FreePascal.
In the MIDIServices unit, MIDIReadProc, the callback routine, is definded:
MIDIReadProc = procedure( (*const*) pktlist: MIDIPacketListPtr; readProcRefCon: UnivPtr; srcConnRefCon: UnivPtr );
This routine is called on a separate high-priority thread owned by CoreMidi when midi events are received.
I defined a callback procedure for handling received midi events:
Type procedure MyMidiCallback(pktList: MIDIPacketListPtr;readProcRefCon: UnivPtr; srcConnRefCon: UnivPtrMy);
procedure TMainForm.MyMidiCallback(pktList: MIDIPacketListPtr;readProcRefCon: UnivPtr; srcConnRefCon: UnivPtr);
begin
// handle midi packets
end;
The midi callback hook is defined in the following code at 'MidiInputPortCreate':
procedure TMainForm.ReceiveMidiTestClick(Sender: TObject);
var
NumOfSources, NumOfDestinations: ItemCount;
x: byte;
MIDIDestinationPointer, MidiSourcePointer: MIDIEndpointRef;
EndPointName: CFStringRef;
MidiClient: MidiClientRef;
InputPort: MidiPortRef;
MidiCallback: MidiReadProc;
begin
NumOfDestinations := MIDIGetNumberOfDestinations;
NumOfSources := MIDIGetNumberOfSources;
Memo.Lines.Add('Number of Midi Sources: ' + IntToStr(NumOfSources));
EndPointName := nil;
MidiClient := nil;
InputPort := nil;
MidiCallback := #TMainform.MyMidiCallback;
for x := 0 to NumOfDestinations -1 do // show destinations
begin
MidiDestinationPointer := MidiGetDestination(x);
MIDIObjectGetStringProperty(MidiDestinationPointer, kMIDIPropertyName, EndPointName);
Memo.Lines.Add('Destination ' + IntToStr(x) + ': ' + CFStrToAnsiStr(EndPointName));
end;
for x := 0 to NumOfSources -1 do // show sources
begin
MidiSourcePointer := MIDIGetSource(x);
MIDIObjectGetStringProperty(MidiSourcePointer, kMIDIPropertyName, EndPointName);
Memo.Lines.Add('Source ' + IntToStr(x) + ': ' + CFStrToAnsiStr(EndPointName));
end;
MidiClientCreate(CFSTRP('Midi Input Client'), nil, nil, MidiClient);
MidiInputPortCreate(MidiClient, CFSTRP('Input'), MidiCallback, nil, InputPort); // MidiCallback
MIDISourcePointer := MIDIGetSource(0); // select source(0) = midi keyboard
MidiPortConnectSource(InputPort, MIDISourcePointer, nil);
end;
Compiling generates the following error message:
mainunit.pas(480,19) Error: Incompatible types: got "<procedure variable type of procedure(MIDIPacketListPtr,Pointer,Pointer) of object;Register>" expected "<procedure variable type of procedure(MIDIPacketListPtr,Pointer,Pointer);MWPascal>"
I'am stuck here now; hope someone can help.
--------------------------------- UPDATE #1 ----------------------------------
The code above was indeed a bit strange so I rewrote things:
procedure TMainForm.ReceiveMidiTestClick(Sender: TObject);
var
MidiClient: MidiClientRef;
InputPort: MidiPortRef;
MidiCallback: MIDIReadProc;
begin
MidiCallback := MyMidiCallback;
MidiClientCreate(CFSTRP('Midi Input Client'), nil, nil, MidiClient);
MidiInputPortCreate(MidiClient, CFSTRP('Input'), MidiCallback, nil, InputPort);
MidiPortConnectSource(InputPort, MIDIGetSource(0), nil);
end;
procedure MyMidiCallback(pktList: MIDIPacketListPtr; readProcRefCon: UnivPtr; srcConnRefCon: UnivPtr);
begin
// handle midi packets
end;
Now the code compiles without errors but as soon as i hit a key on the midi keyboard, the application crashes with the following error message:
'ERROR Project ... raised exception class 'External: Sigtrap' at address FFFFD96F'
(FFFFD96F is probably the pointer to the MidiCallback routine).
Basically, the issue I have is how to let the MidiCallback pointer in MidiInputPortCreate point correctly to my MyMidiCallback procedure where I handle midi events.
BTW, sending Midi events works fine.
Let's put the error declarations in the error on separate lines:
mainunit.pas(480,19) Error: Incompatible types: got "
procedure(MIDIPacketListPtr,Pointer,Pointer) of object;Register>" expected "<
procedure variable type of procedure(MIDIPacketListPtr,Pointer,Pointer);MWPascal>"
Note two crucial differences:
1) The "of object" difference in the two procedure declarations in the error means you passed a method instead of a proper procedure.
2) Besides that, calling conventions doesn't seem to match, one is mwpascal; one is Register. Register is the default for most modes, so no calling convention modifier means register.
The "callback" part of your question is strange. You define a type as a procedure, but provide a method as implementation?
Related
In Delphi 10.1 Berlin, I'm trying to change a picture on a form by loading a PNG image from a resource.
I've followed this:
Load image from embedded resource
and used a TWICImage to automatically handle different possible image formats.
In this case I specifically want to use a PNG for transparency.
For some reason the function I've created returns nothing.
However, if I call result.savetofile('test.png') within the function the resource is succesfully saved, which verifies that the resource exists in the EXE and has been found.
function LoadImageResource(NativeInstance: NativeUInt; ImageResource: string): TWICImage;
var
Strm: TResourceStream;
WICImage: TWICImage;
begin
Strm := TResourceStream.Create(NativeInstance, ImageResource, RT_RCDATA);
try
Strm.Position := 0;
WICImage := TWICImage.Create;
try
WICImage.LoadFromStream(Strm);
result := WICImage; //these return empty
result.savetofile('test.png'); //this succesfully saves the resource to disk
finally
WICImage.Free;
end;
finally
Strm.Free;
end;
end;
Outside of the function, if I attempt to assign the image by calling for example Image1.picture.assign(LoadFromResource(...)) or Image1.picture.graphic := LoadFromResource(...) nothing gets assigned. And If I then call Image1.savetofile('test.png') I get an access violation error.
What might I be missing?
The problem is that you are destroying the image that you return. It's important to understand that classes are reference types in Delphi. So after the assignment to Result, in your code, you still have only a single instance, but two references to that same single instance.
You need to remove the call to Free.
function LoadImageResource(Module: NativeUInt; const ResName: string): TWICImage;
var
Strm: TResourceStream;
begin
Strm := TResourceStream.Create(Module, ResName, RT_RCDATA);
try
Result := TWICImage.Create;
Result.LoadFromStream(Strm);
finally
Strm.Free;
end;
end;
A little tweak is needed to make the function exception safe:
function LoadImageResource(Module: NativeUInt; const ResName: string): TWICImage;
var
Strm: TResourceStream;
begin
Strm := TResourceStream.Create(Module, ResName, RT_RCDATA);
try
Result := TWICImage.Create;
try
Result.LoadFromStream(Strm);
except
Result.Free;
raise;
end;
finally
Strm.Free;
end;
end;
When you call the function it behaves like a constructor. It either succeeds and returns a new instance, handing over ownership to the caller. Or it raises an exception. Accordingly I would name the function CreateImageFromResource.
Starting from Way of getting control handle from TMessage question, I've created my own implementation in order to replace the Windowproc with my own one, in order to make some processing when mouse left button is pressed.
TOverrideMessage = class
public
FControl: TWinControl;
FOldWndProc: TWndMethod;
procedure OverrideWindowProc(var Message: TMessage);
end;
implementation:
procedure TOverrideMessage.OverrideWindowProc(var Message: TMessage);
begin
if Message.Msg = WM_NCLBUTTONDOWN then
begin
FOldWndProc(Message);
if FControl is TSomeCustomControl then
ShowMessage(TSomeCustomControl(FControl).Caption);//this property exists
end
else
Dispatch(Message);
end;
And replace the windowprocs of each of the controls I want with an instance of my class:
LOverrideMessage := TOverrideMessage.Create;
LOverrideMessage.FControl := TSomeCustomControl(lControl4);
LOverrideMessage.FOldWndProc := TWinControl(lControl4).WindowProc;
TWinControl(lControl4).WindowProc := LOverrideMessage.OverrideWindowProc;
The problem I have is that the messages are not dispatched correctly further to the controls so the controls are not drawing correctly,etc. Also I'm not receiving the WM_NCLBUTTONDOWN message in the class implementation. What's wrong?
Your main problem is the failure to call FOldWndProc. You need to call that rather than Dispatch. When you call Dispatch you will get the base TObject handling, which does nothing.
procedure TOverrideMessage.OverrideWindowProc(var Message: TMessage);
begin
FOldWndProc(Message);
if Message.Msg = WM_NCLBUTTONDOWN then
if FControl is TSomeCustomControl then
ShowMessage(TSomeCustomControl(FControl).Caption);//this property exists
end;
If WM_NCLBUTTONDOWN doesn't arrive, then the message is not being sent to your control.
I am concerned by your casting. When you write:
LOverrideMessage.FControl := TSomeCustomControl(lControl4);
LOverrideMessage.FOldWndProc := TWinControl(lControl4).WindowProc;
TWinControl(lControl4).WindowProc := LOverrideMessage.OverrideWindowProc;
why do you need any of those casts? If lControl4 was derived from TWinControl then you would not need those casts. If lControl4 has a compile time type that is less derived, then at least include an is check.
I am trying to load the contents of a file from one of the Windows virtual folders (for example, a camera or iPhone picture folder). Below is some sample code that I am using to play around with this:
procedure TfrmForm.ButtonClick(Sender: TObject);
Var
Dialog: TAttachDialog;
Enum: IEnumShellItems;
Name: LPWSTR;
Item: IShellItem;
Strm: IStream;
OStrm: TOLEStream;
FStrm: TFileStream;
Result: HRESULT;
Buf: Array[0..99] Of Char;
Read: LongInt;
begin
Result := CoInitializeEx(Nil, COINIT_APARTMENTTHREADED Or
COINIT_DISABLE_OLE1DDE);
If Succeeded(Result) Then
Begin
Dialog := TAttachDialog.Create(Self);
Try
Dialog.Options := [fdoAllowMultiSelect, fdoPathMustExist,
fdoFileMustExist];
Dialog.Title := 'Select Attachments';
If Dialog.Execute(Self.Handle) Then
Begin
If FAILED(Dialog.ShellItems.EnumItems(Enum)) Then
Raise Exception.Create('Could not get the list of files selected.');
While Enum.Next(1, Item, Nil) = S_OK Do
Begin
If (Item.GetDisplayName(SIGDN_NORMALDISPLAY, Name) = S_OK) Then
Begin
mResults.Lines.Add(Name);
CoTaskMemFree(Name);
End;
If Item.BindToHandler(Nil, BHID_Stream, IID_IStream, Strm) = S_OK Then
Begin
OStrm := TOLEStream.Create(Strm);
FStrm := TFileStream.Create('C:\Temp\Test.jpg', fmCreate);
FStrm.CopyFrom(OStrm, OStrm.Size);
FreeAndNil(OStrm);
FreeAndNil(FStrm);
Strm := Nil;
End;
Item := Nil;
End;
End;
Finally
FreeAndNil(Dialog);
End;
CoUninitialize;
End;
end;
TAttachDialog is just a descendant of TCustomFileOpenDialog that exposes the ShellItems property. In my actual application, I need a TStream object returned. So, in this example, I am using a TFileStream top copy the source file as proof of concept that I have successfully accessed the file using a Delphi stream. Everything works Ok until I try the FStrm.CopyFrom at which point I get a "Not Implemented" error. What am I doing wrong with this or is there a better way entirely to do what I want?
The only time TStream itself raises a "not implemented" error is if neither the 32bit or 64bit version of Seek() are overridden in a descendant class (or one of them erroneously called the inherited method). If that were true, an EStreamError exception is raised saying "ClassName.Seek not implemented".
TOLEStream does override the 32bit version of Seek() to call IStream.Seek(). However, it does not override the TStream.GetSize() property getter. So when you are reading the OStrm.Size value before calling CopyFrom(), it calls the default TStream.GetSize() method, which uses Seek() to determine the stream size - Seek() to get the current position, then Seek() again to the end of the stream, saving the result, then Seek() again to go back to the previous position.
So, my guess would be that the IStream you have obtained likely does not support random seeking so its Seek() method is returning E_NOTIMPL, which TOLEStream.Seek() would detect and raise an EOleSysError exception saying "Not implemented".
Try calling IStream.Stat() to get the stream size (or derive a class from TOLEStream and override the GetSize() method to call Stat()), and then pass the returned size to CopyFrom() if > 0 (if you pass Count=0 to CopyFrom(), it will read the source stream's Position and Size properties, thus causing the same Seek() error), eg:
var
...
Stat: STATSTG;
begin
...
if Item.BindToHandler(Nil, BHID_Stream, IID_IStream, Strm) = S_OK Then
try
OStrm := TOLEStream.Create(Strm);
try
FStrm := TFileStream.Create('C:\Temp\Test.jpg', fmCreate);
try
OleCheck(Strm.Stat(Stat, STATFLAG_NONAME));
if Stat.cbSize.QuadPart > 0 then
FStrm.CopyFrom(OStrm, Stat.cbSize.QuadPart);
finally
FreeAndNil(FStrm);
end;
finally
FreeAndNil(OStrm);
end;
finally
Strm := Nil;
end;
...
end;
The alternative would be to simply avoid TStream.CopyFrom() and manually copy the bytes yourself, by allocating a local buffer and then calling OStrm.Read() in a loop, writing each read buffer to FStrm, until OStrm.Read() reports that there is no more bytes to read:
var
...
Buf: array[0..1023] of Byte;
NumRead: Integer;
begin
...
if Item.BindToHandler(Nil, BHID_Stream, IID_IStream, Strm) = S_OK Then
try
OStrm := TOLEStream.Create(Strm);
try
FStrm := TFileStream.Create('C:\Temp\Test.jpg', fmCreate);
try
repeat
NumRead := OStrm.Read(Buf[0], SizeOf(Buf));
if NumRead <= 0 then Break;
FStrm.WriteBuffer(Buf[0], NumRead);
until False;
finally
FreeAndNil(FStrm);
end;
finally
FreeAndNil(OStrm);
end;
finally
Strm := Nil;
end;
...
end;
I have an application which can log a stacktrace, which can be later used for debugging.
On Windows, I've gotten by using the excellent JCLDebug unit provided by the JEDI project.
Now that my application is running on OSX, I've hit a bit of a hitch - I don't know how to obtain the correct stacktrace when an exception occurs.
I have got the basics down -
1) I can get a stacktrace using 'backtrace' (found in libSystem.dylib)
2) The resulting backtrace can be converted into line numbers using the .map file provided by Delphi's linker
The issue I'm left with is - I don't know where to call backtrace from. I know that Delphi uses Mach exceptions (on a separate thread), and that I cannot use posix signals, but that's all that I've managed to sort out.
I can get a backtrace in the 'try...except' block, but unfortunately, by that point the stack has already wound down.
How can I install a proper exception logger which will run right after the exception occurs?
Update:
As per 'Honza R's suggestion, I've taken a look at the 'GetExceptionStackInfoProc' procedure.
This function does get me 'inside' of the exception handling process, but unfortunately leaves me with some of the same issues I had previously.
First of all - on desktop platforms, this function 'GetExceptionStackInfoProc' is just a function pointer, which you can assign with your own exception info handler. So out of the box, Delphi doesn't provide any stack information provider.
If I assign a function to 'GetExceptionStackInfoProc' and then run a 'backtrace' inside of it, I receive a stacktrace, but that trace is relative to the exception handler, not the thread which caused the exception.
'GetExceptionStackInfoProc' does contain a pointer to a 'TExceptionRecord', but there's very limited documentation available on this.
I might be going beyond my depth, but how can I get a stacktrace from the correct thread? Would it be possible for me to inject my own 'backtrace' function into the exception handler and then return to the standard exception handler from there?
Update 2
Some more details. One thing to clear up - this question is about exceptions that are handled by MACH messages, not software exceptions that are handled entirely within the RTL.
Embarcadero has laid out some comments along with these functions -
System.Internal.MachExceptions.pas -> catch_exception_raise_state_identity
{
Now we set up the thread state for the faulting thread so that when we
return, control will be passed to the exception dispatcher on that thread,
and this POSIX thread will continue watching for Mach exception messages.
See the documentation at <code>DispatchMachException()</code> for more
detail on the parameters loaded in EAX, EDX, and ECX.
}
System.Internal.ExcUtils.pas -> SignalConverter
{
Here's the tricky part. We arrived here directly by virtue of our
signal handler tweaking the execution context with our address. That
means there's no return address on the stack. The unwinder needs to
have a return address so that it can unwind past this function when
we raise the Delphi exception. We will use the faulting instruction
pointer as a fake return address. Because of the fencepost conditions
in the Delphi unwinder, we need to have an address that is strictly
greater than the actual faulting instruction, so we increment that
address by one. This may be in the middle of an instruction, but we
don't care, because we will never be returning to that address.
Finally, the way that we get this address onto the stack is important.
The compiler will generate unwind information for SignalConverter that
will attempt to undo any stack modifications that are made by this
function when unwinding past it. In this particular case, we don't want
that to happen, so we use some assembly language tricks to get around
the compiler noticing the stack modification.
}
Which seem to be responsible for the issue I'm having.
When I do a stacktrace after this exception system has handed control over to the RTL, it looks like this - (bearing in mind, the stack unwinder has been superseded by a backtrace routine. The backtrace will hand control over to the unwinder once it is completed)
0: MyExceptionBacktracer
1: initunwinder in System.pas
2: RaiseSignalException in System.Internal.ExcUtils.pas
Since RaiseSignalException is called by SignalConverter, I'm led to believe that the backtrace function provided by libc is not compatible with the modifications made to the stack. So, it's incapable of reading the stack beyond that point, but the stack is still present underneath.
Does anyone know what to do about that (or whether my hypothesis is correct)?
Update 3
I've finally managed to get proper stacktraces on OSX. Huge thanks to both Honza and Sebastian. By combining both of their techniques, I found something that works.
For anyone else who could benefit from this, here's the basic source. Bear in mind that I'm not quite sure if it's 100% correct, if you can suggest improvements, go ahead. This technique hooks onto an exception right before Delphi unwinds the stack on the faulting thread, and compensates for any stack frame corruption that might have taken place beforehand.
unit MyExceptionHandler;
interface
implementation
uses
SysUtils;
var
PrevRaiseException: function(Exc: Pointer): LongBool; cdecl;
function backtrace2(base : NativeUInt; buffer : PPointer; size : Integer) : Integer;
var SPMin : NativeUInt;
begin
SPMin:=base;
Result:=0;
while (size > 0) and (base >= SPMin) and (base <> 0) do begin
buffer^:=PPointer(base + 4)^;
base:=PNativeInt(base)^;
//uncomment to test stacktrace
//WriteLn(inttohex(NativeUInt(buffer^), 8));
Inc(Result);
Inc(buffer);
Dec(size);
end;
if (size > 0) then buffer^:=nil;
end;
procedure UnInstallExceptionHandler; forward;
var
InRaiseException: Boolean;
function RaiseException(Exc: Pointer): LongBool; cdecl;
var b : NativeUInt;
c : Integer;
buff : array[0..7] of Pointer;
begin
InRaiseException := True;
asm
mov b, ebp
end;
c:=backtrace2(b - $4 {this is the compiler dependent value}, #buff, Length(buff));
//... do whatever you want to do with the stacktrace
Result := PrevRaiseException(Exc);
InRaiseException := False;
end;
procedure InstallExceptionHandler;
var
U: TUnwinder;
begin
GetUnwinder(U);
Assert(Assigned(U.RaiseException));
PrevRaiseException := U.RaiseException;
U.RaiseException := RaiseException;
SetUnwinder(U);
end;
procedure UnInstallExceptionHandler;
var
U: TUnwinder;
begin
GetUnwinder(U);
U.RaiseException := PrevRaiseException;
SetUnwinder(U);
end;
initialization
InstallExceptionHandler;
end.
You can use GetExceptionStackInfoProc, CleanUpStackInfoProc and GetStackInfoStringProc in Exception class you need to save stack trace in GetExceptionStackInfoProc and then retrieve it with GetStackInfoStringProc which will get called by RTL if you use StackTrace property of the Exception. Maybe you could also take look at https://bitbucket.org/shadow_cs/delphi-arm-backtrace which demonstrates this on Android.
To do this properly on Mac OS X the libc backtrace function cannot be used because Delphi will corrupt stack frame when calling the GetExceptionStackInfoProc from Exception.RaisingException. Own implementation must be used that is capable of walking the stack from different base address which can be corrected by hand.
Your GetExceptionStackInfoProc would then look like this (I used XE5 for this example the value added to EBP bellow may differ based on which compiler you use and this example was only tested on Mac OS X, Windows implementation may or may not differ):
var b : NativeUInt;
c : Integer;
buff : array[0..7] of Pointer;
begin
asm
mov b, ebp
end;
c:=backtrace2(b - $14 {this is the compiler dependent value}, #buff, Length(buff));
//... do whatever you want to do with the stacktrace
end;
And the backtrace2 function would look like this (note that stop conditions and other validations are missing in the implementation to ensure that AVs are not caused during stack walking):
function backtrace2(base : NativeUInt; buffer : PPointer; size : Integer) : Integer;
var SPMin : NativeUInt;
begin
SPMin:=base;
Result:=0;
while (size > 0) and (base >= SPMin) and (base <> 0) do begin
buffer^:=PPointer(base + 4)^;
base:=PNativeInt(base)^;
Inc(Result);
Inc(buffer);
Dec(size);
end;
if (size > 0) then buffer^:=nil;
end;
You could hook yourself into the Exception Unwinder. Then you can call backtrace where the exception happens. Here's an example. The unit SBMapFiles is what I use for reading the mapfiles. It is not required to get the exception call stack.
unit MyExceptionHandler;
interface
implementation
uses
Posix.Base, SysUtils, SBMapFiles;
function backtrace(result: PNativeUInt; size: Integer): Integer; cdecl; external libc name '_backtrace';
function _NSGetExecutablePath(buf: PAnsiChar; BufSize: PCardinal): Integer; cdecl; external libc name '__NSGetExecutablePath';
var
PrevRaiseException: function(Exc: Pointer): LongBool; cdecl;
MapFile: TSBMapFile;
const
MaxDepth = 20;
SkipFrames = 3;
procedure ShowCurrentStack;
var
StackLog: PNativeUInt; //array[0..10] of Pointer;
Cnt: Integer;
I: Integer;
begin
{$POINTERMATH ON}
GetMem(StackLog, SizeOf(Pointer) * MaxDepth);
try
Cnt := backtrace(StackLog, MaxDepth);
for I := SkipFrames to Cnt - 1 do
begin
if StackLog[I] = $BE00EF00 then
begin
WriteLn('---');
Break;
end;
WriteLn(IntToHex(StackLog[I], 8), ' ', MapFile.GetFunctionName(StackLog[I]));
end;
finally
FreeMem(StackLog);
end;
{$POINTERMATH OFF}
end;
procedure InstallExceptionHandler; forward;
procedure UnInstallExceptionHandler; forward;
var
InRaiseException: Boolean;
function RaiseException(Exc: Pointer): LongBool; cdecl;
begin
InRaiseException := True;
ShowCurrentStack;
Result := PrevRaiseException(Exc);
InRaiseException := False;
end;
procedure InstallExceptionHandler;
var
U: TUnwinder;
begin
GetUnwinder(U);
Assert(Assigned(U.RaiseException));
PrevRaiseException := U.RaiseException;
U.RaiseException := RaiseException;
SetUnwinder(U);
end;
procedure UnInstallExceptionHandler;
var
U: TUnwinder;
begin
GetUnwinder(U);
U.RaiseException := PrevRaiseException;
SetUnwinder(U);
end;
procedure LoadMapFile;
var
FileName: array[0..255] of AnsiChar;
Len: Integer;
begin
if MapFile = nil then
begin
MapFile := TSBMapFile.Create;
Len := Length(FileName);
_NSGetExecutablePath(#FileName[0], #Len);
if FileExists(ChangeFileExt(FileName, '.map')) then
MapFile.LoadFromFile(ChangeFileExt(FileName, '.map'));
end;
end;
initialization
LoadMapFile;
InstallExceptionHandler;
end.
I'm trying to compile this project in Delphi 2010, which uses TNetSharingManager. I have imported the type library and tried compiling it, but unfortunately I'm getting an Access Violation in this function:
function TNetSharingManager.GetDefaultInterface: INetSharingManager;
begin
if FIntf = nil then
Connect;
Assert(FIntf nil, 'DefaultInterface is NULL. Component is not connected to Server. You must call "Connect" or "ConnectTo" before this operation');
Result := FIntf;
end;
(part of NETCONLib_TLB)
The error is in : if FIntf = nil then for some odd reason..
The code which is calling it:
procedure TForm1.GetConnectionList(Strings,IdList: TStrings);
var
pEnum: IEnumVariant;
vNetCon: OleVARIANT;
dwRetrieved: Cardinal;
pUser: NETCONLib_TLB.PUserType1;
NetCon : INetConnection;
begin
Strings.Clear;
IdList.Clear;
pEnum := ( NetSharingManager.EnumEveryConnection._NewEnum as IEnumVariant);
while (pEnum.Next(1, vNetCon, dwRetrieved) = S_OK) do
begin
(IUnknown(vNetCon) as INetConnection).GetProperties(pUser);
NetCon := (IUnknown(vNetCon) as INetConnection);
if (pUser.Status in [NCS_CONNECTED,NCS_CONNECTING])//remove if you want disabled NIC cards also
and (pUser.MediaType in [NCM_LAN,NCM_SHAREDACCESSHOST_LAN,NCM_ISDN] )
and (GetMacAddress(GuidToString(pUser.guidId))'' ) then
begin
//we only want valid network cards that are enabled
Strings.Add(pUser.pszwName );
IdList.Add(GuidToString(pUser.guidId));
end;
end;
end;
I don't understand why I cannot compare with nil. Any ideas?
It is likely the TNetSharingManager object itself has actually died (or wasn't created in the first place) when that error is triggered. The FIntF = nil expression is the first reference to an actual field of the class, i.e. it will be pointing into invalid address space.
[Edit] I download the source and followed the steps to import the TLB (Delphi 2010). To execute the appilcation, I had to (a) run Delphi as an admin, because I'm not a power user by default and (b) had to add a check for pUser <> nil because the final getProperties returns a nil-structure, but other than that the code run fine. So unfortunately, I can't seem to reproduce your problem.
Rereading your question, are you getting an AV while compiling?