![]() |
Vollständigen Datei- oder Verzeichnisnamen über das Handle ermitteln
Hallo zusammen,
folgende Funktion liefert den vollständigen Namen einer Datei oder eines Verzeichnisses anhand eines Handles.
Delphi-Quellcode:
Vermutlich können damit auch die Namen anderer Handles ermittelt werden, allerdings habe ich dies nicht weiter getestet.
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; Viele Grüße Zacherl |
AW: Vollständigen Datei- oder Verzeichnisnamen über das Handle ermitteln
Zitat:
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:
Damit jedoch nicht genug!
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; 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:
ist "nicht erfolgreich".
Status := NtQueryObject(hFile, ObjectNameInformation, ObjectInformation, ReturnLength, @ReturnLength);
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:
ist völliger Unsinn.
var ObjectInformation: PUNICODE_STRING
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:
// Beispiel:
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;
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; |
AW: Vollständigen Datei- oder Verzeichnisnamen über das Handle ermitteln
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. |
AW: Vollständigen Datei- oder Verzeichnisnamen über das Handle ermitteln
Zitat:
Das ist so, als wenn man drinend empfiehlt immer auf die VCL zu verzichten und immer nur mit vollen Debuginfos kompiliert. |
AW: Vollständigen Datei- oder Verzeichnisnamen über das Handle ermitteln
Faszinierend. Die Annahme daß ein Volume auch einen Laufwerksbuchstaben haben müsse ist mal grob falsch (
![]() ![]() Ebenso kann ein Volume an mehreren Stellen eingehangen sein (genau wie in Linux auch). |
AW: Vollständigen Datei- oder Verzeichnisnamen über das Handle ermitteln
Zitat:
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. |
AW: Vollständigen Datei- oder Verzeichnisnamen über das Handle ermitteln
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. |
AW: Vollständigen Datei- oder Verzeichnisnamen über das Handle ermitteln
Zitat:
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. |
AW: Vollständigen Datei- oder Verzeichnisnamen über das Handle ermitteln
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:
Und wenn du schon Verbesserungvorschläge machst, warum pruefst du nicht den Rückgabewert deines 1. Aufrufes von NtQueryObject?
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. Im übrigen hab ich auch unter D/ (lange her wo ich es benutzt habe) nie Probleme mit der Optimierung gehabt. |
AW: Vollständigen Datei- oder Verzeichnisnamen über das Handle ermitteln
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. |
Alle Zeitangaben in WEZ +1. Es ist jetzt 12:59 Uhr. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz