Vollständigen Datei- oder Verzeichnisnamen über das Handle ermitteln

[himitsu]

Völlig funktionsfähig und erfolgreich inklusive Codeoptimierung in D7, D2007, D2009, D2010, XE und XE2 getestet.

Delphi-Quellcode:

uses
  Windows, SysUtils, StrUtils;

type
  NTSTATUS = Cardinal;
  TUnicodeString = record
    Length, MaximumLength: Word;
    Buffer: PWideChar;
  end;
  TObjectNameInformation = record
    Name: TUnicodeString;
    NameBuffer: array[0..MAX_PATH-1] of WideChar;
  end;

const
  STATUS_SUCCESS = NTSTATUS($00000000);
  STATUS_INVALID_PARAMETER = NTSTATUS($C000000D);
  STATUS_INFO_LENGTH_MISMATCH = NTSTATUS($C0000004);
  ObjectNameInformation = 1;

function DevicePathToFileName(const DevicePath: string): string;
var
  DeviceList, DosDevice: array[0..MAX_PATH-1] of Char;
  Device: PChar;
  Size: LongWord;
begin
  Result := DevicePath;
  Size := GetLogicalDriveStrings(MAX_PATH, @DeviceList);
  if (Size = 0) or (Size > MAX_PATH) then
    RaiseLastOSError;
  Device := @DeviceList;
  while Device^ <> #0 do begin
    Size := QueryDosDevice(PChar(ExcludeTrailingPathDelimiter(Device)), @DosDevice, MAX_PATH);
    if Size = 0 then
      RaiseLastOSError;
    if StartsText(IncludeTrailingPathDelimiter(DosDevice), Result) then
      Exit(Device + Copy(Result, Length(IncludeTrailingPathDelimiter(DosDevice)) + 1));
    Inc(Device, Length(Device) + 1);
  end;
end;

function GetFilePathFromHandle(hFile: THandle): string;
var
  NtQueryObject: function(Handle: THandle; ObjectInformationClass: Cardinal; ObjectInformation: Pointer;
    ObjectInformationLength: Cardinal; ReturnLength: PCardinal): NTSTATUS; stdcall;
  NameInformation: TObjectNameInformation;
  Status: NTSTATUS;
begin
  Result := '';
  NtQueryObject := GetProcAddress(GetModuleHandle('ntdll.dll'), 'NtQueryObject');
  if not Assigned(NtQueryObject) then
    Exit;
  Status := NtQueryObject(hFile, ObjectNameInformation, @NameInformation, SizeOf(NameInformation), nil);
  if Status <> STATUS_SUCCESS then
    Exit;
  Result := DevicePathToFileName(NameInformation.Name.Buffer);
end;

Ach ja, das Packed ist mit voller Absicht, denn bei kleinen Codeschnippseln versuche ich möglichst nicht an den Compileroptionen rumzuspielen,
denn ich weiß ja nicht, was im restlichen Code für Einstellungen vorgesehn sind.

Und leider bietet Delphi immernoch keine Möglichkeit die aktuellen Einstellen zwischenzuspeichern und nachher wieder zurückzusezten.
Das könnte man sich nur für {$#+} und {$#-} selber basteln, aber für {$A2}, {$A4} und {$A16} ist keine Bestimmung möglich.

TUnicodeString: oder ohne packed, aber mit {$A4} bzw. {$ALIGN 4}

TObjectNameInformation: alternativ ebenfalls mit {$A4} bzw. {$ALIGN 4}
Aber auch ohne packed und mit unkorrekter Ausrichtung, würde es dennoch funktionieren, solange keiner NameBuffer auslesen will.

Achtung: Im Zielprogramm muß eine Speicherausrichtung von mindestens 8 Byte eingestellt sein. (in den Projektoptionen oder über {$ALIGN 8}).
Ein {$ALIGN 16} währe vermutlich aber auch möglich.

Zitat:

Delphi-Quellcode:

if StartsText(IncludeTrailingPathDelimiter(DosDevice), Result) then
  Exit(Device + Copy(Result, Length(IncludeTrailingPathDelimiter(DosDevice)) + 1));

Und wenn es in älteren Delphis damit ein paar Problemchen gibt. (Letzeres geht immer)

Delphi-Quellcode:

if StartsText(IncludeTrailingPathDelimiter(DosDevice), Result) then begin
  Result := Device + Copy(Result, Length(IncludeTrailingPathDelimiter(DosDevice)) + 1);
  Exit;
end;

oder

Delphi-Quellcode:

if AnsiStartsText(IncludeTrailingPathDelimiter(DosDevice), Result) then begin
  Result := Device + Copy(Result, Length(IncludeTrailingPathDelimiter(DosDevice)) + 1, Length(DosDevice));
  Exit;
end;