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;

[delphinub23]

Ja Zacherl, darauf bin ich auch gerade gestoßen.
Allein mit den JediAPI Headern wollte es nicht funzen o.o

Jetzt geht es aber auch ohne diese, nur das die Icons alle das 'UNDEFINED DATA' Icon bekommen.

Aber immerhin - Nun werde ich mich noch ein bisschen weiter reinfuchsen und das Problem hoffentlich lösen!

Danke für deine Hilfe!

MfG,
dnub

[Zacherl]

Probiers eventuell mal mit SHGetFileInfo Deine Funktion liefert dir erstmal die 32x32 Pixel großen Icons, die in deinem ListView nicht wirklich schön aussehen. Außerdem geht dir zusätzlich noch irgendwie die Transparenz verloren.

Folgende Funktion liefert dir das 16x16 Pixel Icon einer Datei:

Delphi-Quellcode:

function GetFileIcon(FileName: String): HICON;
var
  FileInfo: TSHFileInfo;
begin
  Result := 0;
  if (SHGetFileInfo(PChar(FileName), 0, FileInfo, SizeOf(FileInfo),
    SHGFI_ICON OR SHGFI_SMALLICON OR SHGFI_SYSICONINDEX) > 0) then
  begin
    Result := FileInfo.hIcon;
  end;
end;

Du kannst es dann einfach folgendermaßen zu deiner ImageList hinzufügen:

Delphi-Quellcode:

var
  Icon: TIcon;
begin
  Icon := TIcon.Create;
  try
    Icon.Handle := GetFileIcon(GetProcessPathByPID(MyProcessID));
    if (Icon.Handle > 0) then
    begin
      ImageList1.AddIcon(Icon);
    end;
  finally
    Icon.Free;
  end;
end;

Damit die Transparenz erhalten bleibt stell mal im OI die Eigenschaft ColorDepth von cdDeviceDependent auf cd32Bit.

[delphinub23]

Habe ich schon getan, aber genau diese Variante gibt keinen eindeutigen Pfad bei den 64Bit Prozessen zurück, denke ich.
Auf jeden Fall konnte ich es mit dieser Methode nicht nach meinen Wünschen umsetzen.

MfG,
dnub

[Zacherl]

Nein, nein, um den Pfad zu ermitteln, kannst du doch jetzt die GetProcessPathByPID() Funktion von mir benutzen. Den dadurch erhaltenen Pfad übergibst du an die GetFileIcon() Funktion und voilla Habe meinen vorherigen Post noch durch ein Beispiel ergänzt.