Odszukanie ścieżki apkilacji przez funkcję EnumWindowsProc

amadro

2015-08-07T19:29:48+02:00

Rejestracja: dni
Ostatnio: dni
Postów: 15

0

Witam tworze program który dzięki funkcji EnumWindowsProc wyszukuje wszystkie otwarte aplikacje, ale niestety funkcja potrafi znajdź tylko tytuł okna (np. Google - Mozilla Firefox, Menadżer zadań, Ten Komputer, itp.), a ja potrzebuję ścieżkę (lub nazwę) na razie mam taką funkcję :

Kopiuj

function EnumWindowsProc(wHandle: HWND; lb: TListBox): BOOL; stdcall;
var
  Title, ClassName: array[0..255] of char;
begin
  GetWindowText(wHandle, Title, 255);
  GetClassName(wHandle, ClassName, 255);
  if IsWindowVisible(wHandle) then begin
    if string(Title)<>'' then
    lb.Items.Add(string(Title));
  end;
  Result := True;
end;

Pozdrawiam i proszę o szybką pomoc

olesio

2015-08-07T20:13:27+02:00

Rejestracja: dni
Ostatnio: dni
Lokalizacja: Szczecin
Postów: 4191

1

Twój kod nie jest do końca prawidłowy. Drugim parametrem funkcji enumerującej okienka jest typ LPARAM. Ale jeżeli musisz mieć to tak dziwnie to sobie zostaw tylko nie powinno się tak robić raczej.

Poniżej masz kod mojego modułu, pobierającego na podstawie uchwytu okna głownego - uchwyt ikonki programu. Wywnioskujesz z niego jak uzyskać PID na podstawie HWND, a następnie pełną ściezkę do pliku procesu o tym PID. Jeżeli ściezka nie jest ustalona pierwszą metodą (jest pusta), to kod sprawdza ją dla procesu 64 bitowego. Dopasuj sobie kod do swoich potrzeb. A więcej informacji znajdziesz na MSDNie.

Doam, że kod pisany pod Delphi 7 dla celów używania w programach pisanych w czystym WinAPI.

Kopiuj

unit get_hicon_from_hwnd;

interface

uses
  Windows, PSApi, ShellApi;

function GetIconFromHandle(WindowHandle : HWND) : HICON;

implementation

function StrLen(const Str : PChar) : Cardinal; assembler;
asm
        MOV     EDX,EDI
        MOV     EDI,EAX
        MOV     ECX,0FFFFFFFFH
        XOR     AL,AL
        REPNE   SCASB
        MOV     EAX,0FFFFFFFEH
        SUB     EAX,ECX
        MOV     EDI,EDX
end;

function GetIconFromHandle(WindowHandle : HWND) : HICON;

  function ProcessFullPath(Pid : DWORD) : string;
  var
    AHandle : THandle;
  begin
    Result := '';
    AHandle := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, Pid);
    if AHandle <> 0 then
    begin
      try
        SetLength(Result, MAX_PATH);
        if GetModuleFileNameEx(AHandle, 0, PChar(Result), MAX_PATH) > 0 then
        begin
          SetLength(Result, StrLen(PChar(Result)));
        end
        else
        begin
          Result := '';
        end;
      finally
        CloseHandle(AHandle);
      end;
    end;
  end;

  function ProcessFullPath64Bit(Pid : DWORD) : string;
  const
    PROCESS_QUERY_LIMITED_INFORMATION = $1000;
  var
    Len : DWord;
    AHandle, DllHandle : THandle;
    QueryFullProcessImageNameA : function(HProcess : THandle; dwFlags : DWord; lpExeName : PAnsiChar; lpdwSize : PDWord) : Bool; stdcall;
  begin
    Result := '';
    DllHandle := LoadLibrary('kernel32.dll');
    if DllHandle > 0 then
    begin
      QueryFullProcessImageNameA := GetProcAddress(DllHandle, 'QueryFullProcessImageNameA');
      if Assigned(QueryFullProcessImageNameA) then
      begin
        AHandle := OpenProcess(PROCESS_QUERY_LIMITED_INFORMATION, False, Pid);
        if AHandle <> 0 then
        begin
          Len := MAX_PATH;
          SetLength(Result, Len - 1);
          QueryFullProcessImageNameA(AHandle, 0, PAnsiChar(Result), @len);
          SetLength(Result, Len);
          CloseHandle(AHandle);
        end;
      end;
      FreeLibrary(DllHandle);
    end;
  end;

var
  Pid : DWORD;
  ProcesPath : string;
  FileInfo : SHFILEINFO;
begin
  Result := 0;
  if ISWindow(WindowHandle) then
  begin
    GetWindowThreadProcessId(WindowHandle, Pid);
    ProcesPath := ProcessFullPath(Pid);
    if ProcesPath = '' then
    begin
      ProcesPath := ProcessFullPath64Bit(Pid)
    end;
    if ProcesPath <> '' then
    begin
      SHGetFileInfo(PChar(ProcesPath), 0, FileInfo, SizeOf(FileInfo), SHGFI_ICON or SHGFI_LARGEICON);
      Result := FileInfo.hIcon;
    end;
  end;
end;

end.

2015-08-07T20:37:02+02:00

Rejestracja: dni
Ostatnio: dni

0

Dodałem funkcję która po hwnd wyciąga pid niestety podczas jej wywoływania wyświetla się błąd:

Kopiuj

First chance exception at $0040A16C. Exception class $C0000005 with message 'access violation at 0x0040a16c: read of address 0x00001484'. Process Project1.exe (2380)

Kopiuj

function GetPIDByHWnd(const hWnd: THandle): THandle;
var
PID: DWORD;
begin
if hWnd <> 0 then
  begin
    GetWindowThreadProcessID(hWnd, @PID);
    Result:=PID;
  end else Result:=0;
end;

function EnumWindowsProc(wHandle: HWND; lb: TListBox): BOOL; stdcall;
var
  Title, ClassName: array[0..255] of char;
begin
  GetWindowText(wHandle, Title, 255);
  GetClassName(wHandle, ClassName, 255);
  if IsWindowVisible(wHandle) then begin
    if string(Title)<>'' then
    lb.Items.Add(string(Title)+' '+ string(GetPIDByHWnd(wHandle)));
  end;
  Result := True;
end;

Azarien

2015-08-07T21:02:19+02:00

Rejestracja: dni
Ostatnio: dni

0

Kopiuj

string(GetPIDByHWnd(wHandle))

tutaj.

amadro

2015-08-07T21:16:26+02:00

Rejestracja: dni
Ostatnio: dni
Postów: 15

0

No tak, ale jak to naprawić?

2015-08-07T21:31:54+02:00

Rejestracja: dni
Ostatnio: dni

0

inttostr(...);

amadro

2015-08-07T23:21:57+02:00

Rejestracja: dni
Ostatnio: dni
Postów: 15

0

Ok dziki za pomoc wszystko śmiga aż miło :D

olesio

2015-08-08T01:17:35+02:00

Rejestracja: dni
Ostatnio: dni
Lokalizacja: Szczecin
Postów: 4191

1

Myślałem, że Tobie zależy na pełnej ścieżce do pliku wykonywalnego "rodzica" danego okna głownego. Poza tym jakąś masz dziwną manie rzutowań string... Jakim cudem chciałeś rzutować string(123) tak to nigdy w Delphi nie działało. Proponuję ogarąć elementarne podstawy języka, a później dopiero brać się za coś dalej.

amadro

2015-08-08T12:19:09+02:00

Rejestracja: dni
Ostatnio: dni
Postów: 15

0

olesio napisał(a):

Myślałem, że Tobie zależy na pełnej ścieżce do pliku wykonywalnego "rodzica" danego okna głownego. Poza tym jakąś masz dziwną manie rzutowań string... Jakim cudem chciałeś rzutować string(123) tak to nigdy w Delphi nie działało. Proponuję ogarąć elementarne podstawy języka, a później dopiero brać się za coś dalej.

Ok dzięki za pomoc douczę się trochę :)

Kod programu jakby ktoś chciał :

Kopiuj

type
  TQueryFullProcessImageNameW = function(AProcess: THANDLE; AFlags: DWORD;
    AFileName: PWideChar; var ASize: DWORD): BOOL; stdcall;
  TGetModuleFileNameExW = function(AProcess: THANDLE; AModule: HMODULE;
    AFilename: PWideChar; ASize: DWORD): DWORD; stdcall;
function IsWindows200OrLater: Boolean;

begin
  Result := Win32MajorVersion >= 5;
end;

function IsWindowsVistaOrLater: Boolean;
begin
  Result := Win32MajorVersion >= 6;
end;

var
  PsapiLib: HMODULE;
  GetModuleFileNameExW: TGetModuleFileNameExW;

procedure DonePsapiLib;
begin
  if PsapiLib = 0 then Exit;
  FreeLibrary(PsapiLib);
  PsapiLib := 0;
  @GetModuleFileNameExW := nil;
end;

procedure InitPsapiLib;
begin
  if PsapiLib <> 0 then Exit;
  PsapiLib := LoadLibrary('psapi.dll');
  if PsapiLib = 0 then RaiseLastOSError;
  @GetModuleFileNameExW := GetProcAddress(PsapiLib, 'GetModuleFileNameExW');
  if not Assigned(GetModuleFileNameExW) then
    try
      RaiseLastOSError;
    except
      DonePsapiLib;
      raise;
    end;
end;

function GetFileNameByProcessID(AProcessID: DWORD): UnicodeString;
const
  PROCESS_QUERY_LIMITED_INFORMATION = $00001000;
var
  HProcess: THandle;
  Lib: HMODULE;
  QueryFullProcessImageNameW: TQueryFullProcessImageNameW;
  S: DWORD;
begin
  if IsWindowsVistaOrLater then
    begin
      Lib := GetModuleHandle('kernel32.dll');
      if Lib = 0 then RaiseLastOSError;
      @QueryFullProcessImageNameW := GetProcAddress(Lib, 'QueryFullProcessImageNameW');
      if not Assigned(QueryFullProcessImageNameW) then RaiseLastOSError;
      HProcess := OpenProcess(PROCESS_QUERY_LIMITED_INFORMATION, False, AProcessID);
      if HProcess = 0 then RaiseLastOSError;
      try
        S := MAX_PATH;
        SetLength(Result, S + 1);
        while not QueryFullProcessImageNameW(HProcess, 0, PWideChar(Result), S) and (GetLastError = ERROR_INSUFFICIENT_BUFFER) do
          begin
            S := S * 2;
            SetLength(Result, S + 1);
          end;
        SetLength(Result, S);
        Inc(S);
        if not QueryFullProcessImageNameW(HProcess, 0, PWideChar(Result), S) then
          RaiseLastOSError;
      finally
        CloseHandle(HProcess);
      end;
    end
  else
    if IsWindows200OrLater then
      begin
        InitPsapiLib;
        HProcess := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, AProcessID);
        if HProcess = 0 then RaiseLastOSError;
        try
          S := MAX_PATH;
          SetLength(Result, S + 1);
          if GetModuleFileNameExW(HProcess, 0, PWideChar(Result), S) = 0 then
            RaiseLastOSError;
          Result := PWideChar(Result);
        finally
          CloseHandle(HProcess);
        end;
      end;
end;


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 GetPIDByHWnd(const hWnd: THandle): THandle;
var
PID: DWORD;
begin
if hWnd <> 0 then
  begin
    GetWindowThreadProcessID(hWnd, @PID);
    Result:=PID;
  end else Result:=0;
end;

function EnumWindowsProc(wHandle: HWND; lb: TListBox): BOOL; stdcall;
var
  Title, ClassName: array[0..255] of char;
  path:string;
begin
  GetWindowText(wHandle, Title, 255);
  GetClassName(wHandle, ClassName, 255);
  if IsWindowVisible(wHandle) then begin
    if string(Title)<>'' then begin
        pid := GetPIDByHWnd(wHandle);
        name:=string(Title);
        Exename:=ExtractFileName(GetFileNameByProcessID(pid));
        lb.Items.Add(name + '   -   ' + inttostr(pid) + '   -   ' + exeName);
    end;
  end;
  Result := True;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
listbox1.Clear;
EnumWindows(@EnumWindowsProc, LPARAM(ListBox1));
end;

initialization
  PsapiLib := 0;

finalization
  DonePsapiLib;
end.

Pokazuje np.
Dysk lokalny (D:) - 172 - explorer.exe