type
NT_STATUS = Cardinal;
PSYSTEM_HANDLE_INFORMATION = ^SYSTEM_HANDLE_INFORMATION;
SYSTEM_HANDLE_INFORMATION = packed record
ProcessId: DWORD;
ObjectTypeNumber: Byte;
Flags: Byte;
Handle: Word;
pObject: Pointer;
GrantedAccess: DWORD;
end;
PSYSTEM_HANDLE_INFORMATION_EX = ^SYSTEM_HANDLE_INFORMATION_EX;
SYSTEM_HANDLE_INFORMATION_EX = packed record
NumberOfHandles: dword;
Information: array [0..0] of SYSTEM_HANDLE_INFORMATION;
end;
PFILE_NAME_INFORMATION = ^FILE_NAME_INFORMATION;
FILE_NAME_INFORMATION = packed record
FileNameLength: ULONG;
FileName: array [0..MAX_PATH - 1] of WideChar;
end;
PIO_STATUS_BLOCK = ^IO_STATUS_BLOCK;
IO_STATUS_BLOCK = packed record
Status: NT_STATUS;
Information: DWORD;
end;
PGetFileNameThreadParam = ^TGetFileNameThreadParam;
TGetFileNameThreadParam = packed record
hFile: THandle;
Data: array [0..MAX_PATH - 1] of Char;
Status: NT_STATUS;
end;
function NtQuerySystemInformation(ASystemInformationClass: DWORD;
ASystemInformation: Pointer; ASystemInformationLength: DWORD;
AReturnLength: PDWORD): NT_STATUS; stdcall;
function NtQueryInformationFile(FileHandle: THandle;
IoStatusBlock: PIO_STATUS_BLOCK; FileInformation: Pointer;
Length: DWORD; FileInformationClass: DWORD): NT_STATUS;
stdcall;
implementation
function NtQuerySystemInformation; external 'ntdll.dll' name 'NtQuerySystemInformation';
function NtQueryInformationFile; external 'ntdll.dll' name 'NtQueryInformationFile';
const
STATUS_SUCCESS = NT_STATUS($00000000);
STATUS_INFO_LENGTH_MISMATCH = NT_STATUS($C0000004);
FileNameInformation = 9;
SystemHandleInformation = 16;
function GetInfoTable(ATableType: DWORD): Pointer;
var
dwSize: DWORD;
pPtr: Pointer;
begin
dwSize := $10000;
pPtr:=nil;
repeat
inc(dwSize,dwSize);
ReallocMem(pPtr, dwSize);
until NtQuerySystemInformation(ATableType, pPtr, dwSize, nil)<>STATUS_INFO_LENGTH_MISMATCH;
Result := pPtr;
end;
function GetFileNameThread(lpParameters: Pointer): DWORD; stdcall;
var
FileNameInfo: FILE_NAME_INFORMATION;
IoStatusBlock: IO_STATUS_BLOCK;
pThreadParam: PGetFileNameThreadParam;
begin
ZeroMemory(@FileNameInfo, SizeOf(FILE_NAME_INFORMATION));
pThreadParam := PGetFileNameThreadParam(lpParameters);
Result := NtQueryInformationFile(pThreadParam^.hFile, @IoStatusBlock,
@FileNameInfo, MAX_PATH * 2, FileNameInformation);
if Result = STATUS_SUCCESS then
begin
pThreadParam^.Status := STATUS_SUCCESS;
WideCharToMultiByte(CP_ACP, 0,
@FileNameInfo.FileName[0], IoStatusBlock.Information,
@pThreadParam^.Data[0],
MAX_PATH, nil, nil);
end;
ExitThread(Result);
end;
function GetFileNameFromHandle(hFile: THandle): String;
var
lpExitCode: DWORD;
pThreadParam: TGetFileNameThreadParam;
hThread: THandle;
begin
Result := '';
ZeroMemory(@pThreadParam, SizeOf(TGetFileNameThreadParam));
pThreadParam.hFile := hFile;
hThread := CreateThread(nil, 0, @GetFileNameThread, @pThreadParam, 0, PDWORD(nil)^);
if hThread <> 0 then begin
case WaitForSingleObject(hThread, 100) of
WAIT_OBJECT_0:
begin
GetExitCodeThread(hThread, lpExitCode);
if lpExitCode = STATUS_SUCCESS then
Result := pThreadParam.Data;
end;
WAIT_TIMEOUT:
TerminateThread(hThread, 0);
end;
CloseHandle(hThread);
end;
end;
function GetFileHandleAndClear(SubFileName: String): THandle;
var
hFile: THandle;
pHandleInfo: PSYSTEM_HANDLE_INFORMATION_EX;
I: Integer;
ObjectTypeNumber1: Byte;
FilePath: String;
MyProcID:Cardinal;
hProcess: THandle;
begin
result:=0;
ObjectTypeNumber1 := 0;
hFile := CreateFile('NUL', GENERIC_READ, 0, nil, OPEN_EXISTING, 0, 0);
if hFile <> INVALID_HANDLE_VALUE then begin
pHandleInfo := GetInfoTable(SystemHandleInformation);
if pHandleInfo <> nil then begin
MyProcID:=GetCurrentProcessId;
for I := pHandleInfo^.NumberOfHandles - 1 downto 0 do
with pHandleInfo^.Information[I] do begin
if Handle = hFile then
if ProcessId = MyProcID then
begin
ObjectTypeNumber1 := ObjectTypeNumber;
Break;
end;
end;
CloseHandle(hFile);
for I := pHandleInfo^.NumberOfHandles - 1 downto 0 do begin
with pHandleInfo^.Information[I] do begin
if ObjectTypeNumber = ObjectTypeNumber1 then begin
if ProcessId=MyProcID then begin
FilePath := GetFileNameFromHandle(Handle);
result:= Handle;
hProcess:= OpenProcess(PROCESS_DUP_HANDLE, True, pHandleInfo^.Information[I].ProcessId);
try
DuplicateHandle(hProcess,
pHandleInfo^.Information[I].Handle,
GetCurrentProcess,
@hFile,
0,
True,
DUPLICATE_CLOSE_SOURCE);
CloseHandle(hFile);
finally
CloseHandle(hProcess);
end;
break;
end;
end;
end;
end;
end;
end;
end;