Dateipfad eines Prozess Images für 64 bit Prozesse ermitteln

[Zacherl]

In folgendem Thread kam die Frage auf, wie man den Prozesspfad eines 64 bit Prozesses ermitteln kann:
http://www.delphipraxis.net/160026-p...iatedicon.html

Da GetModuleFileNameEx und Konsorten leider fehlschlagen, wenn man versucht aus einem 32 bit Prozess auf einen 64 bit Prozess zuzugreifen, muss man ein wenig in die Trickkiste greifen und die native NtQueryInformationProcess API verwenden. Folgender Code ermittelt den Image Pfad eines beliebigen Prozesses anhand der Prozess ID und konvertiert den nativen Pfad ins standard DOS Format.

Edit 1: Für Systeme ab Windows Vista wird nun zuerst versucht die QueryFullProcessImageName API aufzurufen, welche den exakten DOS Pfad für beliebige Prozesse, egal ob 32 oder 64 bit liefert.
Edit 2: Die native NtQueryInformationProcess API habe ich durch GetProcessImageFileName ersetzt. Diese Funktion ist zwar erst ab XP verfügbar, dies macht aber nichts, da es von Windows kleiner XP sowieso keine 64 bit Versionen gab.
Edit 3: Für Systeme unter Windows XP wird nun GetModuleFileNameEx als Fallback verwendet, um den Prozesspfad zu ermitteln.

Delphi-Quellcode:

function DeviceNameToFilePath(FileName: String): String;
var
  Buffer: array[0..MAX_PATH - 1] of Char;
  BufferSize: DWord;
  LogicalDrives: array of Char;
  I: Integer;
  DeviceName: String;
begin
  Result := '';
  BufferSize := GetLogicalDriveStrings(MAX_PATH, @Buffer[0]);
  if (BufferSize = 0) then Exit;
  SetLength(LogicalDrives, (BufferSize - 2 * SizeOf(Char)) div 3);
  for I := Low(LogicalDrives) to High(LogicalDrives) do
  begin
    LogicalDrives[I] := Buffer[I * 4];
  end;
  for I := Low(LogicalDrives) to High(LogicalDrives) do
  begin
    BufferSize := QueryDosDevice(PChar(LogicalDrives[I] + ':'),
      @Buffer[0], MAX_PATH);
    if (BufferSize > 0) then
    begin
      DeviceName := AnsiLowerCase(PWideChar(@Buffer[0]));
      if (AnsiLowerCase(Copy(FileName, 1, Length(DeviceName))) =
        DeviceName) then
      begin
        Result := LogicalDrives[I] + ':' + Copy(FileName,
          Length(DeviceName) + 1, Length(FileName));
        Exit;
      end;
    end;
  end;
end;

function GetProcessPathByHandle(hProcess: THandle): String;
var
  QueryFullProcessImageName: function(hProcess: THandle; dwFlags: DWord;
    ImageFileName: PWideChar; dwSize: PDWord): BOOL; stdcall;
  GetProcessImageFileName: function(hProcess: THandle;
    ImageFileName: PWideChar; dwSize: DWord): DWord; stdcall;
  GetModuleFileNameEx: function(hProcess: THandle; hModule: HMODULE;
    FileName: PWideChar; dwSize: DWord): DWord; stdcall;
  FileName: array[0..MAX_PATH - 1] of WideChar;
  BufferSize: DWord;
begin
  Result := '';
  // Windows Vista or higher
  @QueryFullProcessImageName := GetProcAddress(LoadLibrary('kernel32.dll'),
    'QueryFullProcessImageNameW');
  if Assigned(QueryFullProcessImageName) then
  begin
    BufferSize := MAX_PATH;
    if (QueryFullProcessImageName(hProcess, 0, @FileName[0], @BufferSize)) then
    begin
      Result := PWideChar(@FileName[0]);
      Exit;
    end;
  end;
  // Windows XP
  @GetProcessImageFileName := GetProcAddress(LoadLibrary('kernel32.dll'),
    'GetProcessImageFileNameW');
  if (not Assigned(GetProcessImageFileName)) then
  begin
    @GetProcessImageFileName := GetProcAddress(LoadLibrary('psapi.dll'),
      'GetProcessImageFileNameW');
  end;
  if Assigned(GetProcessImageFileName) then
  begin
    BufferSize := GetProcessImageFileName(hProcess, @FileName[0], MAX_PATH);
    if (BufferSize > 0) then
    begin
      Result := DeviceNameToFilePath(PWideChar(@FileName[0]));
      Exit;
    end;
  end;
  // Windows 2000
  @GetModuleFileNameEx := GetProcAddress(LoadLibrary('kernel32.dll'),
    'GetModuleFileNameExW');
  if (not Assigned(GetModuleFileNameEx)) then
  begin
    @GetModuleFileNameEx := GetProcAddress(LoadLibrary('psapi.dll'),
      'GetModuleFileNameExW');
  end;
  if Assigned(GetModuleFileNameEx) then
  begin
    BufferSize := GetModuleFileNameEx(hProcess, 0, @FileName[0], MAX_PATH);
    if (BufferSize > 0) then
    begin
      Result := PWideChar(@FileName[0]);
      // Bugfix for system and service processes
      if (Copy(Result, 1, 4) = '\??\') then
      begin
        Result := Copy(Result, 5, Length(Result));
      end;
      Exit;
    end;
  end;
end;

function GetProcessPathByPID(PID: DWord): String;
var
  hProcess: THandle;
begin
  Result := '';
  hProcess := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ,
    false, PID);
  if (hProcess <> 0) and (hProcess <> INVALID_HANDLE_VALUE) then
  try
    Result := GetProcessPathByHandle(hProcess);
  finally
    CloseHandle(hProcess);
  end;
end;

Viele Grüße
Zacherl