Problem mit ExtractAssociatedIcon

[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;