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;