Start Free Trial

asked on

How can I get the path of the topmost program from its window handle?

In Delphi XE7, I want to get the path of the program which has the topmost window. This implies to first get the handle of the topmost window:

hwnd := GetForegroundWindow;

Open in new window

The next step implies several different functions which I have found in examples on the Internet. Some of them work reliably with most programs, but they fail with some specific programs, e.g. DOpus, KeePass: With those specific programs only the filename of the program or nothing is returned.

Does anybody have a reliable method which works with ALL programs?

Currently I am working in Windows 7 x64 SP1

SOLUTION

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

ASKER

It does not work. It returns an empty string for processes like DOpus, KeePass, etc. I suspect that's because those are 64-bit programs.

ASKER CERTIFIED SOLUTION

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

ASKER

@Sinisa Could you please specify the necessary uses clause? Thank you.

add ActiveX, ComObj, Variants in uses.
and at bottom of unit:

initialization
  CoInitialize(nil);
finalization
  CoUninitialize;

Open in new window

ASKER

1. I used Vcl.OleAuto instead of ComObj. Which one is better?

2. But the best is: It does work now! Although it takes a little bit longer than with the ProcessFileName function of @jimyX. Is there something which can be done about the time?

3. For what is CoInitialize and CoUninitialize needed? It does also work without.

CoInitialize is needed because of getting system com object WbemScripting.SWbemLocator and this is why is little slower than commmon win api. But this function iterates more preocesses too (64bit). If its work without CoInitialize then you dont need CoUninitialize too (pair). In newer XEx Vcl.OleAuto should be fine.
Maybe, if you buld 64 bit exe you'll get 64 bit processes - with jimyX's example.

ASKER

Will this work in all Windows versions? Are there any incompatibility issues?

My solution will work on winXp, 7, 8, ....

ASKER

I also want to give part of the solution acceptance to jimyX. How can I do this?

you should split points - contact mlmcc (one of Admin if you need help about this)

Or use this link to make the request

ASKER

@Sinisa Vuk There seems to be a bug in your ProcessFileName function: For the Windows HTML Help program (hh.exe), it gives back C:\Windows\hh.exe\hh.exe instead of the existing C:\Windows\hh.exe!

ok, here is modified version:

function ProcessFileName(pid: Cardinal): String;
const
  wbemFlagForwardOnly = $00000020;
var
  FSWbemLocator, FWMIService, FWbemObjectSet, FWbemObject: OLEVariant;
  oEnum : IEnumvariant;
  iValue : LongWord;
  PathStr, ModuleName: String;
begin;
  Result := '';
  
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService := FSWbemLocator.ConnectServer('localhost', 'root\CIMV2', '', '');
  FWbemObjectSet:= FWMIService.ExecQuery('SELECT * FROM Win32_Process','WQL',wbemFlagForwardOnly);
  oEnum := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
  while oEnum.Next(1, FWbemObject, iValue) = 0 do
  begin
    PathStr := '';
    if not VarIsNull(FWbemObject.ExecutablePath) then
      PathStr := FWbemObject.ExecutablePath;
    if (Length(PathStr) > 0) and FileExists(PathStr) then
      ModuleName := PathStr
    else
      ModuleName := IncludeTrailingPathDelimiter(PathStr) + FWbemObject.Name;

    if pid = FWbemObject.ProcessId then
    begin
      Result := ModuleName; //keep name
    end;
    FWbemObject:=Unassigned;
    if Length(Result) > 0 then Break;
  end;
end;

Open in new window

//added FileExist to check...

ASKER

@Sinisa Vuk Thanks, now it works with hh.exe. However, unfortunately it does still not work with this program:

SystemExplorer.exe

For this program, it gives back:
\SystemExplorer.exe
with no path!

Strange, works for me. (started SystemExplorer under win 7/64 bit). Is it running inanother user?
(you don't need to send me private message - because I monitor this question too)

ASKER

It is run by Windows Task Planner at System Logon in the context of my own user account.

ok, here is modified function:

uses ... , ShellAPI;

function ProcessFileName(pid: Cardinal): String;
const
  wbemFlagForwardOnly = $00000020;
type
  TPWideCharArray = array[0..0] of PWideChar;
var
  FSWbemLocator, FWMIService, FWbemObjectSet, FWbemObject: OLEVariant;
  oEnum : IEnumvariant;
  iValue : LongWord;
  PathStr, ModuleName: String;
  TempArgs: PPWideChar;
  CmdLine: WideString;
  NumArgs: Integer;
begin;
  Result := '';
  
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService := FSWbemLocator.ConnectServer('localhost', 'root\CIMV2', '', '');
  FWbemObjectSet:= FWMIService.ExecQuery('SELECT * FROM Win32_Process','WQL',wbemFlagForwardOnly);
  oEnum := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
  while oEnum.Next(1, FWbemObject, iValue) = 0 do
  begin
    if pid = FWbemObject.ProcessId then
    begin
      PathStr := '';
      //get exec path
      if not VarIsNull(FWbemObject.ExecutablePath) then
        PathStr := FWbemObject.ExecutablePath;
      //try another way using cmd line
      if (Length(PathStr) = 0) and (not VarIsNull(FWbemObject.CommandLine)) then
      begin
        CmdLine := FWbemObject.CommandLine;
        TempArgs := CommandLineToArgvW(PWideChar(CmdLine), NumArgs);
        if TempArgs <> nil then
        begin
          PathStr := TPWideCharArray(TempArgs^)[0];
          LocalFree(THandle(TempArgs));
        end;
      end;

      if (Length(PathStr) > 0) and FileExists(PathStr) then
        ModuleName := PathStr
      else
        ModuleName := IncludeTrailingPathDelimiter(PathStr) + FWbemObject.Name;

      Result := ModuleName; //keep name
    end;
    FWbemObject := Unassigned;
    if Length(Result) > 0 then Break;
  end;
end;

Open in new window

... and more properties for wmi service:
https://msdn.microsoft.com/en-us/library/aa394372%28v=vs.85%29.aspx

ASKER

Sorry, it still gives back \SystemExplorer.exe instead of the whole path. (Please note the backslash at the beginning).

Also when I start SystemExplorer manually e.g. from the Windows Start Menu, (which requires to confirm the UA prompt), it gives back \SystemExplorer.exe for SystemExplorer.exe.

The real path for this program is:
C:\Program Files (x86)\System Explorer\SystemExplorer.exe

ASKER

BTW, here is the log from CodeSite:

User generated image

Try put the break point in code and look for values in variables: CmdLine, PathStr, FWbemObject.Name ....
?
As I said - I started manually too (SystemExplorer.exe - without uac have to say) and works.

ASKER

When I start my program as administrator then it gives back the whole path:

C:\Program Files (x86)\System Explorer\SystemExplorer.exe

However, the program must be able to be started by normal user.

ASKER

@Sinisa Vuk wrote: "I started manually too (SystemExplorer.exe - without uac have to say) and works."

This means that you have higher privileges on your system. However, my program is required to be started by normal user.

Yes, must be it. Unfortunately have no clue what next, yet.

ASKER

I've now even tried to use your code in a 64-bit program. But it still gives back \SystemExplorer.exe.

if you run cmd.exe with following:

wmic process where ProcessId=<pid of process here>

Open in new window

what you get?

check if ther is more luck with:

//speed up: http://stackoverflow.com/questions/10199531/how-can-i-improve-the-wmi-performance-using-delphi
function ProcessFileName(pid: Cardinal): String;
const
  wbemFlagForwardOnly = $00000020;
  wbemAuthenticationLevelPkt = $04;
  wbemImpersonationLevelImpersonate = $00000003;
type
  TPWideCharArray = array[0..0] of PWideChar;
var
  FSWbemLocator, FWMIService, FWbemObjectSet, FWbemObject: OLEVariant;
  oEnum : IEnumvariant;
  iValue : LongWord;
  PathStr, ModuleName: String;
  TempArgs: PPWideChar;
  CmdLine: WideString;
  NumArgs: Integer;
begin;
  Result := '';
  
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FSWbemLocator.Security_.AuthenticationLevel := wbemAuthenticationLevelPkt;
  FSWbemLocator.Security_.ImpersonationLevel := wbemImpersonationLevelImpersonate;
  FWMIService := FSWbemLocator.ConnectServer('localhost', 'root\CIMV2', '', '');
  FWbemObjectSet:= FWMIService.ExecQuery('SELECT * FROM Win32_Process','WQL',wbemFlagForwardOnly);
  oEnum := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
  while oEnum.Next(1, FWbemObject, iValue) = 0 do
  begin
    if pid = FWbemObject.ProcessId then
    begin
      PathStr := '';
      //get exec path
      if not VarIsNull(FWbemObject.ExecutablePath) then
        PathStr := FWbemObject.ExecutablePath;
      //try another way using cmd line
      if (Length(PathStr) = 0) and (not VarIsNull(FWbemObject.CommandLine)) then
      begin
        CmdLine := FWbemObject.CommandLine;
        TempArgs := CommandLineToArgvW(PWideChar(CmdLine), NumArgs);
        if TempArgs <> nil then
        begin
          PathStr := TPWideCharArray(TempArgs^)[0];
          LocalFree(THandle(TempArgs));
        end;
      end;

      if (Length(PathStr) > 0) and FileExists(PathStr) then
        ModuleName := PathStr
      else
        ModuleName := IncludeTrailingPathDelimiter(PathStr) + FWbemObject.Name;

      Result := ModuleName; //keep name
    end;
    FWbemObject := Unassigned;
    if Length(Result) > 0 then Break;
  end;
end;

Open in new window

note - this line could be:

FWMIService := FSWbemLocator.ConnectServer('localhost', 'root\CIMV2', 'admin_name', 'admin_password');

Open in new window

...and even better - instead of 'localhost' - you can put remote computer too.

ASKER

wmic process where ProcessId=17996 gets this:

User generated image

ASKER

@Sinisa Vuk comment from 16:05:03 Unfortunately, also this code gives back \SystemExplorer.exe.