Вывести на экран список окон верхнего уровня (с указанием родительского процесса)

program Test;
uses
  Windows, Messages, SysUtils;
 
const
  WndClass   = 'TWindow';
  WndCaption = 'Top-Level Windows List';
 
var
   listbox : HWND;
 
function GetProcessImageFileName(hProcess:THandle; lpImageFileName:LPTSTR; nSize:DWORD):DWORD; stdcall;
   external 'PSAPI.dll' name 'GetProcessImageFileNameW'; // или GetProcessImageFileNameA, смотря какая Дельфи
 
// Эта функция по PID получает название EXE-файла процесса
function GetProcessFileName(PID : DWORD) : string;
var
   hProcess : THandle;
   sProcessName : array[0 .. MAX_PATH] of Char;
begin
   Result := '';
   // Для начала откроем процесс для получения информации
   hProcess := OpenProcess(PROCESS_QUERY_INFORMATION, False, PID);
   if hProcess <> 0 then
   begin
      // Удалось открыть? Тогда получаем нужную информацию об имени файла
      if GetProcessImageFileName(hProcess, @sProcessName, MAX_PATH) = 0 then
      begin
         // Не получилось вытащить имя файла, сообщаем об ошибке и выходим
         MessageBox(0, PChar(SysErrorMessage(GetLastError)), 'Error !', MB_ICONERROR or MB_OK);
         CloseHandle(hProcess); // Это я забыл сделать, тоже нужно закрыть процесс, который был открыт
         Exit;
      end;
      // Все нормально, полный путь к файлу получен, вернем само имя, откинув директории
      Result := ExtractFileName(sProcessName);
 
      // Не забываем закрыть процесс
      CloseHandle(hProcess);
   end;
end;
 
// Найдено новое окно верхнего уровня - приходим сюда. В MyHwnd передается его хендл
function ListWindows(MyHwnd : HWND; Lp : LPARAM) : BOOL; stdcall;
var
   sClass : array[0 .. MAX_PATH] of Char;
   sCaption : array[0 .. MAX_PATH] of Char;
   s : string;
   PID : DWORD;
begin
   // Если найденное окно - видимое
   if IsWindowVisible(MyHwnd) then
   begin
      // получаем его класс, содержимое заголовка, и находим, какому процессу оно принадлежит (PID)
      GetClassName(MyHwnd, sClass, MAX_PATH);
      SendMessage(MyHwnd, WM_GETTEXT, MAX_PATH, LPARAM(@sCaption));
      GetWindowThreadProcessId(MyHwnd, PID);
 
      // По номеру процесса определяем имя файла в GetProcessFileName
      s := Format('Class = %s, Caption = %s, PID = %d, Process : %s',
         [sClass, sCaption, PID, GetProcessFileName(PID)]);
      // И добавляем информацию об этом окне в ListBox.
      SendMessage(listbox, LB_ADDSTRING, 0, lparam(@s[1]));
   end;
   Result := True; // Продолжать искать дальше
end;
 
 
function WindowProc(Wnd : HWND; Msg, wParam, lParam : Integer) : Integer ; stdcall;
begin
  case Msg of
    WM_DESTROY:
    begin
      PostQuitMessage(0);
      Result := 0;
      Exit;
    end;
  else
    Result := DefWindowProc(Wnd, Msg, wParam, lParam)
  end;
end;
 
var
  Wnd   : HWND;
  WC    : TWndClassEx;
  Msg   : TMsg;
begin
  FillChar(WC, SizeOf(TWndClassEx), 0);
  WC.cbSize        := SizeOf(WC);
  WC.style         := CS_HREDRAW or CS_VREDRAW;
  WC.lpfnWndProc   := @WindowProc;
  WC.hInstance     := hInstance;
  WC.hIcon         := LoadIcon(0, IDI_APPLICATION);
  WC.hCursor       := LoadCursor(0, IDC_ARROW);
  WC.hbrBackground := COLOR_WINDOW;
  WC.lpszMenuName  := NIL;
  WC.lpszClassName := WndClass;
 
  RegisterClassEx(WC);
 
  // Создаем главное окно приложения
  Wnd := CreateWindowEx(0, WndClass, WndCaption, WS_OVERLAPPEDWINDOW,
                        250, 60, 800, 200, 0, 0, hInstance, NIL);
  // Показываем его
  ShowWindow(Wnd, SW_SHOWNORMAL);
 
  // На окне создаем ListBox, в который будем записывать результаты
  listbox := CreateWindowEx(WS_EX_CLIENTEDGE, 'ListBox', '', LBS_STANDARD or WS_CHILD or WS_VISIBLE,
                            0, 0, 790, 160, Wnd, 0, hInstance, NIL);
  // Выставляем этому ЛистБоксу стандартный шрифт, чтоб не был этот ужасный, который выставляет система
  SendMessage(listbox, WM_SETFONT, WPARAM(GetStockObject(DEFAULT_GUI_FONT)), 1);
 
  // Перечисляем все окна верхнего уровня. При этом для каждого найденного
  // такого окна работает Callback-функция ListWindows
  EnumWindows(@ListWindows, LPARAM(0));
 
  // Это очередь сообщений, чтобы программа вообще заработала
  while GetMessage(Msg, 0, 0, 0) do
  begin
    TranslateMessage(Msg);
    DispatchMessage(Msg);
  end;
 
  Halt(Msg.wParam);
end.