• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 415
  • Last Modified:

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
0
PeterDelphin
Asked:
PeterDelphin
  • 15
  • 12
  • +1
2 Solutions
 
jimyXCommented:
Which method did you use?

I use this one successfully:
uses PsAPI;

function ProcessFileName(PID: DWORD): string;
var
  Handle: THandle;
begin
  Result := '';
  Handle := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, PID);
  if Handle <> 0 then
    try
      SetLength(Result, MAX_PATH);

      if GetModuleFileNameEx(Handle, 0, PChar(Result), MAX_PATH) > 0 then
        SetLength(Result, StrLen(PChar(Result)))
      else
        Result := '';
    finally
      CloseHandle(Handle);
    end;
end;

function GetProcessNameFromWnd(Wnd: HWND): string;
var
  List: TStringList;
  PID: DWORD;
  I: Integer;
begin
  Result := '';
  if IsWindow(Wnd) then
  begin
    PID := INVALID_HANDLE_VALUE;
    GetWindowThreadProcessId(Wnd, @PID);

    Result := ProcessFileName(PID);
  end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  hwd: HWND;
begin
  hwd:= GetForegroundWindow;
  Memo1.Lines.Add(GetProcessNameFromWnd(hwd));
end;

Open in new window

0
 
PeterDelphinAuthor Commented:
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.
0
 
Sinisa VukCommented:
Yes, problem is mixing 32bit and 64bit processes Use my function (WMI) to get proper process id
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;
    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


...and replace  jimy's function ProcessFileName
0
Cloud Class® Course: Microsoft Windows 7 Basic

This introductory course to Windows 7 environment will teach you about working with the Windows operating system. You will learn about basic functions including start menu; the desktop; managing files, folders, and libraries.

 
PeterDelphinAuthor Commented:
@Sinisa Could you please specify the necessary uses clause? Thank you.
0
 
Sinisa VukCommented:
add ActiveX,  ComObj,  Variants in uses.
and at bottom of unit:
initialization
  CoInitialize(nil);
finalization
  CoUninitialize;

Open in new window

0
 
PeterDelphinAuthor Commented:
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.
0
 
Sinisa VukCommented:
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.
0
 
PeterDelphinAuthor Commented:
Will this work in all Windows versions? Are there any incompatibility issues?
0
 
Sinisa VukCommented:
My solution will work on winXp, 7, 8, ....
0
 
PeterDelphinAuthor Commented:
I also want to give part of the solution acceptance to jimyX. How can I do this?
0
 
Sinisa VukCommented:
you should split points - contact mlmcc (one of Admin if you need help about this)
0
 
☠ MASQ ☠Commented:
Or use this link to make the request
0
 
PeterDelphinAuthor Commented:
@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!
0
 
Sinisa VukCommented:
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...
0
 
PeterDelphinAuthor Commented:
@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!
0
 
Sinisa VukCommented:
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)
0
 
PeterDelphinAuthor Commented:
It is run by Windows Task Planner at System Logon in the context of my own user account.
0
 
Sinisa VukCommented:
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
0
 
PeterDelphinAuthor Commented:
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
0
 
PeterDelphinAuthor Commented:
BTW, here is the log from CodeSite:

CodeSite log
0
 
Sinisa VukCommented:
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.
0
 
PeterDelphinAuthor Commented:
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.
0
 
PeterDelphinAuthor Commented:
@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.
0
 
Sinisa VukCommented:
Yes, must be it. Unfortunately have no clue what next, yet.
0
 
PeterDelphinAuthor Commented:
I've now even tried to use your code in a 64-bit program. But it still gives back \SystemExplorer.exe.
0
 
Sinisa VukCommented:
if you run cmd.exe with following:

wmic process where ProcessId=<pid of process here>

Open in new window


what you get?
0
 
Sinisa VukCommented:
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.
0
 
PeterDelphinAuthor Commented:
wmic process where ProcessId=17996 gets this:

After running wmi command in cmd
0
 
PeterDelphinAuthor Commented:
@Sinisa Vuk comment from 16:05:03 Unfortunately, also this code gives back \SystemExplorer.exe.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

  • 15
  • 12
  • +1
Tackle projects and never again get stuck behind a technical roadblock.
Join Now