如何从 Windows 任务管理器（应用程序选项卡）获取应用程序 + 从 Delphi 获取它们在 HDD 上的位置

Posted 2023-03-14

【中文标题】如何从 Windows 任务管理器（应用程序选项卡）获取应用程序 + 从 Delphi 获取它们在 HDD 上的位置

【英文标题】：How to get applications from Windows Task manager (Applications Tab) + their locations on HDD from Delphi

【发布时间】：2010-08-01 14:34:36

【问题描述】：

我想在 Windows 任务管理器的应用程序选项卡（不是进程选项卡）中获取正在运行和可见的程序列表，并获取它们在 HDD 上的位置？ 我需要在 Delphi 中完成。有人可以帮忙吗？

【参考方案1】：

据我所知，任务管理器中的应用程序选项卡是一个***窗口列表，这些窗口不属于其他窗口，没有父窗口，也不是工具窗口。在我的Process Info 中，我有一个名为 AppInfo.pas 的单元，它返回具有此类特征的窗口列表，并且该列表与您在任务管理器中看到的内容相匹配。这是编写为 EnumWindows API 函数的回调函数的代码的主要部分：

$IFDEF DELPHI2007UP
class function TAppWindowCollection.EnumWinProc(wHandle: HWND; lparam: integer): Bool;
$ELSE
function EnumWinProc(wHandle: HWND; lparam: integer): Bool; stdcall;
$ENDIF
Const
  MAX_TEXT = MAX_PATH;
var
  WindowItem : TWindowItem;
  strText,strClass : array [0..MAX_TEXT] of char;
  IsAppMainWin : Boolean;
begin
  //Check if the window is a visible application main window.
  IsAppMainWin := IsWindowVisible(wHandle)          AND                        //Visible
                  (GetWindow(wHandle,GW_OWNER) = 0) AND                        //Not owned by other windows
                  (GetParent(wHandle) = 0)          AND                        //Does not have any parent
                  (GetWindowLong(wHandle,GWL_EXSTYLE) AND WS_EX_TOOLWINDOW = 0); //Not a tool window

  if IsAppMainWin then
  begin
    WindowItem := TAppWindowCollection(lparam).Add;

    GetWindowText(wHandle,strText,MAX_TEXT);
    GetClassName(wHandle,strClass,MAX_TEXT);

    WindowItem.FCaption := strText;
    WindowItem.FHandle := wHandle;
    WindowItem.FWindowClass := strClass;
    GetWindowThreadProcessId(wHandle,WindowItem.FProcessID);
  end;

  Result := True;
end;

完整源码可以参考AppInfo.pas。

并在硬盘上获取他们的位置

这些只是窗户。如果要获取每个项目对应的EXE文件的路径，首先要找到拥有这个窗口的进程，使用GetWindowThreadProcessID API函数。这就是我在上面的代码中所做的。获得进程 ID 后，您可以从中获取进程句柄，并枚举其模块。第一个模块是主 EXE 文件。我在我的 TProcessInfo 组件中实现了这一点，该组件与 AppInfo.pas 包含在同一个包中。

【讨论】：

TWindowItem 声明在哪里？

@user1580348 欢迎来到 Stack Overflow。只需阅读所有答案，而不仅仅是一个。并且不要忘记为您喜欢的内容点赞，而不是删除所有内容。

【参考方案2】：

这是一个完整的独立解决方案（不再有断开的链接）

program ApplicationList;

$APPTYPE CONSOLE
$R *.res

uses
  System.SysUtils,
  Winapi.Windows,
  Winapi.PsAPI;

function GetPathFromPID( const PID : cardinal ) : string;
var
  hProcess : THandle;
  path :     array [0 .. MAX_PATH - 1] of char;
begin
  hProcess := OpenProcess( PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, false, PID );
  if hProcess <> 0
  then
    try
      if GetModuleFileNameEx( hProcess, 0, path, MAX_PATH ) = 0
      then
        RaiseLastOSError;
      Result := path;
    finally
      CloseHandle( hProcess )
    end
  else
    RaiseLastOSError;
end;

function EnumWinProc( wHandle : hWnd; lparam : integer ) : Bool; stdcall;
Const
  MAX_TEXT = MAX_PATH;
var
  strText, strClass : array [0 .. MAX_TEXT] of char;
  strPath :           string;
  IsAppMainWin :      Boolean;
  ProcId :            cardinal;
begin
  // Check if the window is a visible application main window.
  IsAppMainWin := IsWindowVisible( wHandle ) AND // Visible
    ( GetWindow( wHandle, GW_OWNER ) = 0 ) AND   // Not owned by other windows
    ( GetParent( wHandle ) = 0 ) AND             // Does not have any parent
    ( GetWindowLong( wHandle, GWL_EXSTYLE ) AND WS_EX_TOOLWINDOW = 0 ); // Not a tool window

  if IsAppMainWin
  then
    begin

      GetWindowText( wHandle, strText, MAX_TEXT );
      GetClassName( wHandle, strClass, MAX_TEXT );

      GetWindowThreadProcessID( wHandle, ProcId );

      try
        strPath := GetPathFromPID( ProcId );
      except
        strPath := '???';
      end;

      WriteLn( ProcId, ' - ', strClass, ' - ', strText, ' - ', strPath );
    end;

  Result := True;
end;

procedure DoEnumWindows;
var
  FirstWnd : cardinal;
begin
  EnumWindows( @EnumWinProc, cardinal( @FirstWnd ) );
end;

begin
  try
    DoEnumWindows;
  except
    on E : Exception do
      WriteLn( E.ClassName, ': ', E.Message );
  end;

  ReadLn;

end.

【讨论】：

@Kermia 什么不能用于此代码？它编译并检索所有想要的信息（Delphi XE3）

@Kermia - 我想知道你的评论应该如何弄清楚代码有什么问题......

我很抱歉。我只是不太熟悉控制台应用程序。谢谢@SirRufo :)