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

[Zacherl]

Hallo zusammen,

folgende Funktion liefert den vollständigen Namen einer Datei oder eines Verzeichnisses anhand eines Handles.

Delphi-Quellcode:

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

type
  NTSTATUS  = ULONG;
  HANDLE    = Winapi.Windows.THandle;
  PWSTR     = Winapi.Windows.LPWSTR;

  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;

function GetFilePathFromHandle(hFile: THandle): String;

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 := FileName;
  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;

const
  ObjectNameInformation = 1;
var
  NtQueryObject: function(ObjectHandle: HANDLE;
    ObjectInformationClass: ULONG; ObjectInformation: PVOID;
    ObjectInformationLength: ULONG; ReturnLength: PULONG): NTSTATUS; stdcall;
var
  ObjectInformation: PUNICODE_STRING;
  ReturnLength: ULONG;
  Status: NTSTATUS;
begin
  Result := '';
  @NtQueryObject := GetProcAddress(LoadLibrary('ntdll.dll'), 'NtQueryObject');
  if not Assigned(@NtQueryObject) then Exit;
  Status := NtQueryObject(hFile, ObjectNameInformation, nil, 0, @ReturnLength);
  if (Status <> STATUS_INFO_LENGTH_MISMATCH) then Exit;
  GetMem(ObjectInformation, ReturnLength);
  try
    Status := NtQueryObject(hFile, ObjectNameInformation, ObjectInformation,
      ReturnLength, @ReturnLength);
    if (Status = STATUS_SUCCESS) then
    begin
      Result := ObjectInformation.Buffer;
      Result := DeviceNameToFilePath(Result);
    end;
  finally
    FreeMem(ObjectInformation);
  end;
end;

Vermutlich können damit auch die Namen anderer Handles ermittelt werden, allerdings habe ich dies nicht weiter getestet.

Viele Grüße
Zacherl

[ASM]

Zitat von Zacherl:

... allerdings habe ich dies nicht weiter getestet.

Eben, ich wollte nämlich schon gerade fragen: hast Du den Code jemals selbst erfolgreich getestet ?

Eindeutig wohl eher aber nur per "Copy & Paste" von irgendwoher ungeprüft übernommen..
Denn "Dein" Code funktioniert weder unter Delphi 7 noch unter Delphi XE.

Sünde 1:
Zunächst einmal fehlen überhaupt grundsätzliche Deklarationen, ohne die der Code erst gar nicht zu compilieren ist, als da wären:

Code:

const
  STATUS_SUCCESS = $00000000;
  STATUS_INFO_LENGTH_MISMATCH = $C0000004;

type
  HANDLE = THandle;
  PVOID = Pointer;
  NTSTATUS = Cardinal;
  USHORT = word;

  UNICODE_STRING = packed record
    Length: USHORT;
    MaximumLength: USHORT;
    Buffer: PWideChar;
  end;
  PUNICODE_STRING = ^UNICODE_STRING;

Damit jedoch nicht genug!
Sünden 2ff:
Selbst nach Hinzufügen dieser essentiellen Deklarationen wird das entsprechende Programm dann zwar immerhin wenigstens compilierbar und lauffähig, bleibt trotzdem aber eine erfolgreiche, korrekte Ausgabe schuldig.

Erste Stolperstelle: Der Status bei folgendem Call

Code:

Status := NtQueryObject(hFile, ObjectNameInformation, ObjectInformation, ReturnLength, @ReturnLength);

ist "nicht erfolgreich".

Im eigentlichen Code sind nämlich massenweise Fehler,
z.B. ist in der Funktionsbeschreibung von NtQueryObject() der letzte Parameter nicht als OUT- bzw. VAR-Parameter deklariert. Das aber ist zwingend erforderlich, weil genau dieser Wert anschließend Parameter für den Zugriff auf die Daten der OBJECT_INFORMATION_CLASS ist.

Zweitens, die (lokale) Deklaration

Code:

var ObjectInformation: PUNICODE_STRING

ist völliger Unsinn.
ObjectInformation muss vielmehr ein Record vom Typ OBJECT_NAME_INFORMATION sein; entsprechend muss ein pObjectInformation:=@OBJECT_NAME_INFORMATION eingeführt werden, weil der Zugriff über den Pointer läuft. Dadurch ändern sich natürlich zwingend eine Anzahl Anweisungen. Man erhält dann mit der Abfrage auf pObjectInformation^.Name.Buffer den korrekten DeviceNamen zum Filehandle.

Letztens (das Letzte i.e.S.):
Und diesen DeviceNamen nun mit DeviceNameToFilePath() in den logischen WindowsFilepath konvertieren zu wollen, ist ein völlig falscher Ansatz; das ergibt als Ergebnis einfach nur einen leeren String;

Fazit: der Code ist leider nicht zu gebrauchen. Ich frage mich, wer den zusammengeschustert hat (er kursiert seit geraumer Zeit im INet).

Statt nun aber mühsam alle Fehler im geposteten Code in allen Einzelheiten aufzuspüren und zu korrigieren, hier folgend (m)ein funktionsfähiger Code.
Der führt unter Windows XP sowohl mit Delphi 7 als auch mit Delphi XE zum richtigen Ergebnis; ob auch mit Win7, kann ich gerade nicht nachprüfen.

Code:

Type
  NTSTATUS = Cardinal;
  USHORT = word;

  UNICODE_STRING = packed record
    Length: USHORT;
    MaximumLength: USHORT;
    Buffer: PWideChar;
  end;

  OBJECT_NAME_INFORMATION = packed record
    Name: UNICODE_STRING;
    NameBuffer: array[0..0] of WCHAR;
  end;
  POBJECT_NAME_INFORMATION = ^OBJECT_NAME_INFORMATION;

  OBJECT_INFORMATION_CLASS = (ObjectBasicInformation, ObjectNameInformation,
    ObjectTypeInformation, ObjectAllInformation, ObjectDataInformation);

function NtQueryObject(ObjectHandle: cardinal; ObjectInformationClass: OBJECT_INFORMATION_CLASS;
  ObjectInformation: pointer; Length: ULONG; out ResultLength: PDWORD): NTSTATUS;
  stdcall; external 'ntdll.dll';

function NT_SUCCESS(Status: Integer): WordBool;
begin
  Result := Status >= 0;
end;

function PosEx(const SubStr, s: string; Offset: Cardinal = 1): Integer;
var
  i, x: Integer;
  Len, LenSubStr: Integer;
begin
  if Offset = 1 then Result := Pos(SubStr, S)
  else
  begin
    i := Offset;
    LenSubStr := Length(SubStr);
    Len := Length(s) - LenSubStr + 1;
    while i <= Len do
    begin
      if s[i] = SubStr[1] then
      begin
        x := 1;
        while (x < LenSubStr) and (s[i + x] = SubStr[x + 1]) do Inc(x);
        if (x = LenSubStr) then
        begin
          Result := i;
          Exit;
        end;
      end;
      Inc(i);
    end;
    Result := 0;
  end;
end;

function DevicePathToWin32Path(Path: string): string;
var
  c: char;
  s: string;
  i: integer;
begin
  i := PosEx('\', Path, 2);
  i := PosEx('\', Path, i + 1);
  result := copy(Path, i, length(Path));
  delete(Path, i, length(Path));
  for c := 'A' to 'Z' do
  begin
    setlength(s, 1000);
    if QueryDosDevice(pchar(string(c) + ':'), pChar(s), 1000) <> 0 then
    begin
      s := pChar(s);
      if sametext(Path, s) then
      begin
        result := c + ':' + result;
        exit;
      end;
    end;
  end;
  result := '';
end;

function FileHandleToFilePath(hFile: DWORD): WideString;
var
  Status: NTSTATUS;
  ONI: POBJECT_NAME_INFORMATION;
  ReturnSize: DWORD;
  pReturnSize: PDWORD;
begin
  if (hFile <> INVALID_HANDLE_VALUE) then
  begin
    pReturnSize := @ReturnSize;
    NtQueryObject(hFile, ObjectNameInformation, nil, 0, pReturnSize);
    ONI := VirtualAlloc(nil, ReturnSize, MEM_COMMIT, PAGE_READWRITE);
    if (Assigned(ONI)) then
    begin
      Status := NtQueryObject(hFile, ObjectNameInformation, ONI, ReturnSize, pReturnSize);
      if (NT_SUCCESS(Status)) then
      begin
        SetLength(Result, ONI^.name.Length);
        Result := ONI^.name.Buffer
      end;
      VirtualFree(ONI, 0, MEM_RELEASE);
    end;
  end;
end;

// Beispiel:

Code:

procedure TForm1.Button1Click(Sender: TObject);
var
  FileName: string;
  FileHandle: THandle;
  DevicePath: string;
  Win32Path: string;
  ErrMsg: string;
  buffer: array[0..MAX_PATH-1] of Char;
begin
  DevicePath := '';
  Win32Path := '';
  ErrMsg := '';
  GetWindowsDirectory(buffer, max_path);
  // oder eben ein anderes File
  FileName := StrPas(buffer)+'\NOTEPAD.EXE';
  if not Fileexists(Filename) then
  begin
    Showmessage(format('File "%s" not found!', [ExtractFilename(FileName)]));
    exit;
  end;
  FileHandle := CreateFile(pAnsiChar(FileName), GENERIC_READ,
    FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0);
  //  alternatively:
  //  FileHandle := FileOpen(FileName,fmOpenRead or fmShareDenyNone);
  if FileHandle = INVALID_HANDLE_VALUE then ErrMsg := 'Failed: Invalid Filehandle!'
  else
  try
    // der "Dummy"-Zugriff per FileRead ist wichtig,
    // damit im System durch den (erstmaligen) Zugriff
    // ein dem FileHandle zugeordneter Record OBJECT_NAME_INFORMATION angelegt wird;
    // ist nicht notwendig, wenn bereits anderweitig das File aktiv benutzt worden ist
    Sysutils.FileRead(FileHandle, buffer, 10);
    DevicePath := FileHandleToFilePath(FileHandle);
    if DevicePath = '' then ErrMsg := ' Failed: Unable to get DevicePath!'
    else
    begin
      Win32Path := DevicePathToWin32Path(DevicePath);
      if Win32Path = '' then ErrMsg := ' Failed: Unable to convert DevicePath to Win32Path!';
    end
  finally
    FileClose(FileHandle);
  end;
  if Win32Path <> '' then ShowMessage(Win32Path)
  else ShowMessage(ErrMsg);
end;

[ASM]

Noch ein sehr wichtiger, ergänzender Hinweis als Nachtrag zu meinem Code:

In der Compileroption (Menu: Optionen >> Compiler-Tab >> Codeerzeugung) muss unbedingt die Optimierung deaktiviert werden, was ohnehin grundsätzlich immer dringend zu empfehlen ist.

Der Compiler verhaspelt sich sonst in FileHandleToFilePath() bei der Ermittlung der benötigten Größe des Ausgabepuffers im ersten Aufruf von NtQueryObject(). Irgendetwas geht da unverständlicherweise intern mit der Zuweisung der Speichergröße an den entsprechenden Pointer schief. Folge: weil dann nicht auf den Ausgabepuffer zugegriffen werden kann, kann somit daraus auch nicht der Devicename zum Filehandle ausgelesen werden und somit natürlich auch nicht der Win32Filepath ermittelt.

Also nicht vergessen: Compiler-Optimierung AUS.

[himitsu]

Zitat:

was ohnehin grundsätzlich immer dringend zu empfehlen ist.

Wieso?

Das ist so, als wenn man drinend empfiehlt immer auf die VCL zu verzichten
und immer nur mit vollen Debuginfos kompiliert.

[Assarbad]

Faszinierend. Die Annahme daß ein Volume auch einen Laufwerksbuchstaben haben müsse ist mal grob falsch (Reparse Points/Volume Mount Points). Ansonsten schließe ich mich weitgehend ASM an. Es wäre cleverer den Pfad so wie er ankam zurückzugeben, falls die Umwandlung fehlschlägt.

Ebenso kann ein Volume an mehreren Stellen eingehangen sein (genau wie in Linux auch).

[ASM]

Zitat von himitsu:

Wieso?

Das ist so, als wenn man drinend empfiehlt immer auf die VCL zu verzichten
und immer nur mit vollen Debuginfos kompiliert.

Worin genau soll denn der Vorteil der "Optimierung" liegen ?

Ich habe - im Falle recht komplexer Projekte - bereits wiederholt äußerst schwerwiegende, fatale Probleme erfahren müssen, insofern die Optimierung zunächst aktiviert gewesen war. Die ist ja leider per default in jedem neuen Projekt aktiviert, was anscheinend nicht durch Voreinstellung abgeschaltet werden kann und immer erst explizit manuell in jedem neuen Projekt vorgenommen werden muss. Sobald die Optimierung dann nachträglich deaktiviert worden war, war damit auch das spezielle Problem beseitigt - wie auch eben jetzt beschrieben.

Dagegen habe ich noch nie ein einziges entsprechend compilerbedingtes Problem beobachtet, welches durch eine Deaktivierung der Optimierung verursacht worden war.
Unabhängig davon steht im übrigen eine aktivierte Optimierung allzu häufig dem Debugging lokaler Variablen heftig im Wege.

Nenne mir also einen einzigen Grund, warum die Aktivierung der Optimierung wirklich sinnvoll und notwendig wäre.

[himitsu]

Ich hab noch nie erlebt, daß die Codeoptimierung negative Auswirkungen hatte?
Und dazu soll diese Optimierung auch nicht das Verhalten des Programms verändern, also gibt es auch keine Nachteile.

Würde mich also mal interessieren, wie soein Code aussieht, welcher mit Optimierung nicht mehr funktioniert.

[ASM]

Zitat von himitsu:

Ich hab noch nie erlebt, daß die Codeoptimierung negative Auswirkungen hatte?

Vielleicht hast Du ja nie mit Delphi 7 gearbeitet ?

Alles von mir Beschriebene bezieht sich auf das Arbeiten mit Delphi 7. Mit dieser Version arbeite ich noch immer standardmäßig (warum auch nicht).

Jetzt habe ich den Code gerade noch einmal unter Delphi XE compiliert und zwar einmal mit und einmal ohne Aktivierung der Optimierung.
Ergebnis: OK, in Delphi XE ist inzwischen offenbar die Optimierung überarbeitet. Hier im konkreten Fall hat die Einstellung der Optimierung jedenfalls keinen Einfluss mehr auf den erfolgreichen Ablauf. Die Frage bleibt, ob das immer so sein wird; ich bin da aus meiner Erfahrung skeptisch.

Bei der Compilierung mit Delphi 7 dagegen kann die Aktivierung/Deaktivierung der Optimierung einen ganz entscheidenden Einfluss auf das korrekte Funktionieren des Programms haben, exakt wie gerade beschrieben. Versuche es doch selbst einmal unter Delphi 7: den Code zur Beoachtung des deutlich unterschiedlichen Erfolgs hast Du ja von mir wie oben beschrieben.

[brechi]

Der Compiler verhaspelt sich da nicht, der letzte Parameter muss entweder als PDWORD oder "out DWORD" deklariert sein, denn dein code funktioniert bei mit erst recht nicht.
Und danach funktioniert es betimmt auch mit D7 + Optimierung.

Code:

ReturnLength [out, optional]
    An optional pointer to a location where the function writes the actual size of the information requested. If that size is less than or equal to the ObjectInformationLength parameter, the function copies the information into the ObjectInformation buffer; otherwise, it returns an NTSTATUS error code and returns in ReturnLength the size of the buffer required to receive the requested information.

Und wenn du schon Verbesserungvorschläge machst, warum pruefst du nicht den Rückgabewert deines 1. Aufrufes von NtQueryObject?
Im übrigen hab ich auch unter D/ (lange her wo ich es benutzt habe) nie Probleme mit der Optimierung gehabt.

[brechi]

So also ich hab mich bei der Dokumentation verlesen, aber anscheinend ist ein "out DWORD" doch richtig, jedenfalls funktioniert der Code dann damit und man erhaelt als Rückgabe "C0000004" = STATUS_INFO_LENGTH_MISMATCH + die Richtige Laenge in ReturnSize.

[This function may be changed or removed from Windows without further notice.] -> mit Windows7 /D2007 hier getestet

Edit2:
bin ich blöd?:
"optional pointer to a location" = "Adresse eines Speicherbereichs" oder? -> demnach MSDN richtig und muss ein "out DWORD" besser "PDWORD" sein da optional, also ggf nil.