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