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?
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.
Using Delphi (windows app) i want to get list of other applications running currently. Here How to check if a process is running using Delphi? i've found great tutorial about geting filenames/names of running application, however it gives names only process name (for example NOTEPAD.EXE). I've used naturally part with
UpperCase(ExtractFileName(FProcessEntry32.szExeFile))
and
UpperCase(ExtractFilePath(FProcessEntry32.szExeFile))
and just
UpperCase(FProcessEntry32.szExeFile)
but obviously FProcessEntry32.szExeFile does not have a path to file/process
Is there a simply way of getting list with paths? Here's How to get the list of running processes including full file path? solution with JclSysInfo library, but i cant use it in place of work in project.
I looked at what I could in Google and what I found usually concerned just the application that is running or the application that is active, but I can't just find a list of all running applications. Maybe i'm missing something obvious?
I'm not looking for any complex procedures, I'm not much interested in process parrent, or if there is no access to the process path, I don't have it and don't bother.
Any simple hint?
OK, due to helpfull comment from #TLama i've combined topics above to take name and path of process:
function processExists(exeFileName: string): Boolean;
var
ContinueLoopP, ContinueLoopM: BOOL;
FSnapshotHandle1, FSnapshotHandle2: THandle;
FProcessEntry32: TProcessEntry32;
FMODULEENTRY32: TMODULEENTRY32;
begin
FSnapshotHandle1 := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
FMODULEENTRY32.dwSize := SizeOf(FMODULEENTRY32);
ContinueLoopP := Process32First(FSnapshotHandle1, FProcessEntry32);
ContinueLoopM := Module32First(FSnapshotHandle2, FMODULEENTRY32);
Result := False;
while Integer(ContinueLoopP) <> 0 do
begin
if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =
UpperCase(ExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) =
UpperCase(ExeFileName))) then
Result := True;
ShowMessage(FMODULEENTRY32.szExePath + FProcessEntry32.szExeFile);
ContinueLoopP := Process32Next(FSnapshotHandle1, FProcessEntry32);
ContinueLoopM := Module32Next(FSnapshotHandle2, FMODULEENTRY32);
end;
CloseHandle(FSnapshotHandle1);
CloseHandle(FSnapshotHandle2);
end;
But still FProcessEntry32.szExeFile returns empty string. What i'm doing wrong? Thank You in advance.
I cannot write comment (low score), so I need to write as "answer". Try this code,
using FProcessEntry32.th32ProcessID as parameter:
Function QueryFullProcessImageNameW(hProcess:THandle; dwFlags:Cardinal; lpExeName:PWideChar; Var lpdwSize:Cardinal) : Boolean; StdCall; External 'Kernel32.dll' Name 'QueryFullProcessImageNameW';
Function GetFullPath(Pid:Cardinal) : UnicodeString;
Var rLength:Cardinal;
Handle:THandle;
Begin Result:='';
Handle:=OpenProcess(PROCESS_QUERY_INFORMATION, False, Pid);
If Handle = INVALID_HANDLE_VALUE Then Exit;
rLength:=256; // allocation buffer
SetLength(Result, rLength+1); // for trailing space
If Not QueryFullProcessImageNameW(Handle, 0, #Result[1],rLength) Then Result:='' Else SetLength(Result, rLength);
End;
This is a simple way I think. If you want to get the loaded DLL's full name, use
FMODULEENTRY32.hModule with GetModuleFileNameW function.
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?
I am working on a browser helper object written in Delphi, and when the BHO is installed and I close IE, I get the error "runtime error 216 at < address >". I suspect this could be because of the 253 disID (onquit) case on the following code:
function TIEM.Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult;
type
POleVariant=^OleVariant;
var
dps:TDispParams absolute Params;
bHasParams:Boolean;
pDispIDs:PDispIDList;
iDispIDsSize:Integer;
begin
Result:=DISP_E_MEMBERNOTFOUND;
pDispIDs:=nil;
iDispIDsSize:=0;
bHasParams:=(dps.cArgs>0);
if(bHasParams)then
begin
iDispIDsSize:=dps.cArgs*SizeOf(TDispID);
GetMem(pDispIDs,iDispIDsSize);
end;
try
if(bHasParams)then BuildPositionalDispIDs(pDispIDs,dps);
case DispID of
104:begin
Result:=S_OK;
end;
250:begin
DoBeforeNavigate2(IDispatch(dps.rgvarg^[pDispIDs^[0]].dispVal),
POleVariant(dps.rgvarg^[pDispIDs^[1]].pvarVal)^,
POleVariant(dps.rgvarg^[pDispIDs^[2]].pvarVal)^,
POleVariant(dps.rgvarg^[pDispIDs^[3]].pvarVal)^,
POleVariant(dps.rgvarg^[pDispIDs^[4]].pvarVal)^,
POleVariant(dps.rgvarg^[pDispIDs^[5]].pvarVal)^,
dps.rgvarg^[pDispIDs^[6]].pbool^);
Result:=S_OK;
end;
252:
begin
DoNavigateComplete2(IDispatch(dps.rgvarg^[pDispIds^[0]].dispval), POleVariant(dps.rgvarg^[pDispIds^[1]].pvarval)^);
Result := S_OK;
end;
259:
begin
DoDocumentComplete(IDispatch(dps.rgvarg^[pDispIds^[0]].dispval), POleVariant(dps.rgvarg^[pDispIds^[1]].pvarval)^);
Result := S_OK;
end;
253:
begin
Result := S_OK;
end;
else
Result := DISP_E_MEMBERNOTFOUND;
end;
finally
if(bHasParams)then
FreeMem(pDispIDs,iDispIDsSize);
end;
end;
But I am not sure and I couldn't find any info about it. I am using a library I got from an example on Hack China to create the BHO, and I found some project on Google Code that uses IConnectionPoint.Unadvise(Integer) on the 253 case. I tried that, but still get the same runtime error 216. I've also tried adding an exception handler to the above code, but it didn't catch anything.
I added:
finalization
exit;
And now I don't see the runtime error. I didn't know the BHO would need that.
A 216 error when exiting your app means your are triggering an Access Violation in the finalization code of your project after the sysutils unit has already been finalized.
So, check all your finalization sections for use of invalid pointers. In your search include the finalization sections of all components you use in the project.
To debug finalization sections, you can put a breakpoint on the "end" statement in the dpr and when the debugger breaks on that, use F7 to step into the finalization code, then use F7 and F8 to step through all the finalization sections. It will be a tedious process, but it will bring you to the exact statement causing the Access Violation.
I added:
finalization
exit;
And now I don't see the runtime error. I didn't know the BHO would need that.
I'm experiencing a memory leak when using WMI from Delphi 7 to query a (remote) pc. The memory leak only occurs on Windows 2003 (and Windows XP 64). Windows 2000 is fine, and so is Windows 2008. I'm wondering if anyone has experienced a similar problem.
The fact that the leak only occurs in certain versions of Windows implies that it might be a Windows issue, but I've been searching the web and haven't been able to locate a hotfix to resolve the issue. Also, it might be a Delphi issue, since a program with similar functionality in C# doesn't seem to have this leak. The latter fact has led me to believe that there might be another, better, way to get the information I need in Delphi without getting a memory leak.
I've included the source to a small program to expose the memory leak below. If the line sObject.Path_ below the { Leak! } comment is executed, the memory leak occurs. If I comment it out, there's no leak. (Obviously, in the "real" program, I do something useful with the result of the sObject.Path_ method call :).)
With a little quick 'n dirty Windows Task Manager profiling on my machine, I found the following:
Before N=100 N=500 N=1000
With sObject.Path_ 3.7M 7.9M 18.2M 31.2M
Without sObject.Path_ 3.7M 5.3M 5.4M 5.3M
I guess my question is: has anyone else encountered this problem? If so, is it indeed a Windows issue, and is there a hotfix? Or (more likely) is my Delphi code broken, and is there a better way to get the information I need?
You'll notice on several occasions, nil is assigned to objects, contrary to the Delphi spirit... These are COM objects that do not inherit from TObject, and have no destructor I can call. By assigning nil to them, Windows's garbage collector cleans them up.
program ConsoleMemoryLeak;
{$APPTYPE CONSOLE}
uses
Variants, ActiveX, WbemScripting_TLB;
const
N = 100;
WMIQuery = 'SELECT * FROM Win32_Process';
Host = 'localhost';
{ Must be empty when scanning localhost }
Username = '';
Password = '';
procedure ProcessObjectSet(WMIObjectSet: ISWbemObjectSet);
var
Enum: IEnumVariant;
tempObj: OleVariant;
Value: Cardinal;
sObject: ISWbemObject;
begin
Enum := (wmiObjectSet._NewEnum) as IEnumVariant;
while (Enum.Next(1, tempObj, Value) = S_OK) do
begin
sObject := IUnknown(tempObj) as SWBemObject;
{ Leak! }
sObject.Path_;
sObject := nil;
tempObj := Unassigned;
end;
Enum := nil;
end;
function ExecuteQuery: ISWbemObjectSet;
var
Locator: ISWbemLocator;
Services: ISWbemServices;
begin
Locator := CoSWbemLocator.Create;
Services := Locator.ConnectServer(Host, 'root\CIMV2',
Username, Password, '', '', 0, nil);
Result := Services.ExecQuery(WMIQuery, 'WQL',
wbemFlagReturnImmediately and wbemFlagForwardOnly, nil);
Services := nil;
Locator := nil;
end;
procedure DoQuery;
var
ObjectSet: ISWbemObjectSet;
begin
CoInitialize(nil);
ObjectSet := ExecuteQuery;
ProcessObjectSet(ObjectSet);
ObjectSet := nil;
CoUninitialize;
end;
var
i: Integer;
begin
WriteLn('Press Enter to start');
ReadLn;
for i := 1 to N do
DoQuery;
WriteLn('Press Enter to end');
ReadLn;
end.
I can reproduce the behaviour, the code leaks memory on Windows XP 64 and does not on Windows XP. Interestingly this occurs only if the Path_ property is read, reading Properties_ or Security_ with the same code does not leak any memory. A Windows-version-specific problem in WMI looks like the most probable cause of this. My system is up-to-date AFAIK, so there probably isn't a hotfix for this either.
I'd like to comment on your resetting all variant and interface variables, though. You write
You'll notice on several occasions, nil is assigned to objects, contrary to the Delphi spirit... These are COM objects that do not inherit from TObject, and have no destructor I can call. By assigning nil to them, Windows's garbage collector cleans them up.
This is not true, and consequently there is no need to set the variables to nil and Unassigned. Windows does not have a garbage collector, what you are dealing with are reference-counted objects, which are immediately destroyed once the reference count reaches 0. The Delphi compiler does insert the necessary calls to increment and decrement the reference count as necessary. Your assignments to nil and Unassigned decrement the reference count, and free the object when it reaches 0.
A new assignment to a variable, or the exiting of the procedure take care of this as well, so additional assignments are (albeit not wrong) superfluous and decrease the clarity of the code. The following code is completely equivalent and does not leak any additional memory:
procedure ProcessObjectSet(WMIObjectSet: ISWbemObjectSet);
var
Enum: IEnumVariant;
tempObj: OleVariant;
Value: Cardinal;
sObject: ISWbemObject;
begin
Enum := (wmiObjectSet._NewEnum) as IEnumVariant;
while (Enum.Next(1, tempObj, Value) = S_OK) do
begin
sObject := IUnknown(tempObj) as SWBemObject;
{ Leak! }
sObject.Path_;
end;
end;
I'd say one should explicitly reset interfaces only if this does actually free the object (so the current ref count has to be 1) and the destruction itself should really happen exactly at this point. Examples for the latter are that a large chunk of memory can be freed, or that a file needs to be closed or a synchronization object to be released.
you should store the return value of
sObject.Path_;
in a variable and make it SWbemObjectPath. This is necessary to make the reference counting right.