Problem mit ExtractAssociatedIcon

[delphinub23]

Guten Tag und Frohe Ostern,

ich programmiere ein kleines Tool, welches unter anderem einen Prozessviewer enthält.
Dieser soll nicht nur die laufenden Prozesse & PID, sondern auch das Icon des jeweiligen Prozesses anzeigen.
Oke, bis hierhin funktioniert alles. Bis auf die korrekte Rückgabe des Icons.

Folgendes Problem stell sich dar:

Es werden nur die korrekten Icons der Prozesse ausgegeben, die im Taskmanager diese Bezeichnung haben: 'PROZESSNAME *32'.
Alle anderen bekommen ein Systemicon zugeordnet.

Aufruf um die Icons zu erhalten:

Delphi-Quellcode:

aIcon := TIcon.Create;
try
  Index := 0;
  aicon.Handle := ExtractAssociatedIcon(HInstance,
                  PWideChar(Handler.GetProcessPath(Handler.GetAllRunningProcs.Strings[i])), Index);
  lvProcessList.Items[i].ImageIndex := ImageList.AddIcon(aIcon);
finally
  aIcon.Free;
end;

Kennt jemand eine Lösung um von allen Prozessen das korrekte Icon zu erhalten?


Danke im Voraus!
MfG - dnub

[Zacherl]

Es liegt zu 99% an deiner GetProcessPath() Methode. Meine Ansätze mit GetModuleFileNameEx() haben auch immer versagt, wenn ich von meiner 32bit Anwendung auf einen 64bit Prozess zugreifen wollte.

Als Workaround benutze ich die native NtQueryInformationProcess() API mit ProcessImageFileName als InformationClass.

[delphinub23]

Danke für deine Antwort Zacherl,

Könntest du mir das in einem kleinen Beispiel aufzeigen?
Ich finde auch nach langer googlelei keinen richtigen Einstieg.


MfG,
dnub

[Zacherl]

Kein Problem, die nativen APIs sind am Anfang gewöhnungsbedürftig. Die Lösung ist auch wie gesagt nur ein Workaround, da ich keine normale API kenne (außer über WMI, was extrem umständlich ist, wie ich finde), welche zuverlässig den Speicherort eines 64 bit Prozesses ausgibt.

Edit: Fehlerhaften Code entfernt. Voll funktionsfähige Methode gibts hier:
http://www.delphipraxis.net/1096831-post6.html

[delphinub23]

Zacherl, danke für deine Hilfe. Supersache

Nun noch folgendes Problem: Der Rückgabewert von NTStatus ist niemals korrekt. Ständig schwimmt mir der "nil"-e Wert (also -1024084...) rein.
Ich nutze D2010, also sollte es bei mir auch keine Probleme mit dem Unicode-Verhalten geben, oder?

MfG,
dnub

[Zacherl]

Habe das grade mal versucht zu reproduzieren und bin zu dem selben Ergebnis gekommen Wenn du die von mir rauskopierten Defines und Funktionen entfernst und dafür die JwaNative.pas und die JwaWinType.pas aus den JEDI API Headern einbindest, funktioniert alles korrekt. Kann mir das auch nicht erklären. Habe die Funktion allerdings grade noch etwas verbessert.

Ursprünglich wollte ich nur den Prozessnamen auslesen, weshalb ich noch ein ExtractFileName() in der Rückgabe hatte. Deshalb ist mir entgangen, dass statt den normalen Laufwerkbuchstaben C:, D:, E:, etc die nativen Namen wie \Device\HardDiscVolume2 zurückgegeben werden.

Hier die verbesserte Funktion mit Konvertierung in "normale" DOS Laufwerkbuchstaben:

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 GetProcessPathByPID(PID: DWord): String;
var
  ProcessName: array[0..MAX_PATH - 1] of WideChar;
  ReturnLength: ULONG;
  hProcess: THandle;
begin
  Result := '';
  hProcess := OpenProcess(PROCESS_QUERY_INFORMATION, false, PID);
  if (hProcess <> 0) and (hProcess <> INVALID_HANDLE_VALUE) then
  try
    if NT_SUCCESS(NtQueryInformationProcess(hProcess,
      ProcessImageFileName, @ProcessName[0], MAX_PATH, @ReturnLength)) then
    begin
      Result := DeviceNameToFilePath(PUNICODE_STRING(@ProcessName[0])^.Buffer);
    end;
  finally
    CloseHandle(hProcess);
  end;
end;

Edit: Mhh scheinbar waren einige Typen schon in einer Standard Delphi Unit deklariert. Mit folgenden Defines funktioniert es auch ohne die JEDI API Header:

Delphi-Quellcode:

type
  LONG      = Longint;
  NTSTATUS  = LONG;
  BOOL      = Windows.BOOL;
  HANDLE    = Windows.THandle;
  PVOID     = Pointer;
  ULONG     = Windows.ULONG;
  PULONG    = Windows.PULONG;
  PWSTR     = Windows.LPWSTR;

type
  PUNICODE_STRING = ^UNICODE_STRING;
  _UNICODE_STRING = record
    Length: USHORT;
    MaximumLength: USHORT;
    Buffer: PWSTR;
  end;
  UNICODE_STRING = _UNICODE_STRING;
  PCUNICODE_STRING = ^UNICODE_STRING;
  TUnicodeString = UNICODE_STRING;
  PUnicodeString = PUNICODE_STRING;

type
  _PROCESSINFOCLASS = (
    ProcessBasicInformation,
    ProcessQuotaLimits,
    ProcessIoCounters,
    ProcessVmCounters,
    ProcessTimes,
    ProcessBasePriority,
    ProcessRaisePriority,
    ProcessDebugPort,
    ProcessExceptionPort,
    ProcessAccessToken,
    ProcessLdtInformation,
    ProcessLdtSize,
    ProcessDefaultHardErrorMode,
    ProcessIoPortHandlers,
    ProcessPooledUsageAndLimits,
    ProcessWorkingSetWatch,
    ProcessUserModeIOPL,
    ProcessEnableAlignmentFaultFixup,
    ProcessPriorityClass,
    ProcessWx86Information,
    ProcessHandleCount,
    ProcessAffinityMask,
    ProcessPriorityBoost,
    ProcessDeviceMap,
    ProcessSessionInformation,
    ProcessForegroundInformation,
    ProcessWow64Information,
    ProcessImageFileName,
    ProcessLUIDDeviceMapsEnabled,
    ProcessBreakOnTermination,
    ProcessDebugObjectHandle,
    ProcessDebugFlags,
    ProcessHandleTracing,
    MaxProcessInfoClass);
  PROCESSINFOCLASS = _PROCESSINFOCLASS;
  PROCESS_INFORMATION_CLASS = PROCESSINFOCLASS;
  TProcessInfoClass = PROCESSINFOCLASS;

function NtQueryInformationProcess(ProcessHandle: HANDLE;
  ProcessInformationClass: PROCESSINFOCLASS;
  ProcessInformation: PVOID; ProcessInformationLength: ULONG;
  ReturnLength: PULONG): NTSTATUS; stdcall; external 'ntdll.dll';

function NT_SUCCESS(Status: NTSTATUS): BOOL;
begin
  Result := Status >= 0;
end;