Как узнать все открытые дескрипторы файлов?
01.01.2007
////////////////////////////////////////////////////////////////////////////////
//
// ****************************************************************************
// * Unit Name : Unit15
// * Purpose : Перечисление всех открытых файлов в системе
// * (до которых получилось достучаться)
// * Author : Александр (Rouse_) Багель
// * Version : 1.00
// ****************************************************************************
//
unit Unit15;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls;
type
TForm15 = class(TForm)
Button1: TButton;
Memo1: TMemo;
ProgressBar1: TProgressBar;
procedure Button1Click(Sender: TObject);
public
procedure ShowLockedProcess(FileName: String);
end;
var
Form15: TForm15;
implementation
{$R *.dfm}
type
NT_STATUS = Cardinal;
TFileDirectoryInformation = packed record
NextEntryOffset: ULONG;
FileIndex: ULONG;
CreationTime: LARGE_INTEGER;
LastAccessTime: LARGE_INTEGER;
LastWriteTime: LARGE_INTEGER;
ChangeTime: LARGE_INTEGER;
EndOfFile: LARGE_INTEGER;
AllocationSize: LARGE_INTEGER;
FileAttributes: ULONG;
FileNameLength: ULONG;
FileName: array[0..0] of WideChar;
end;
FILE_DIRECTORY_INFORMATION = TFileDirectoryInformation;
PFileDirectoryInformation = ^TFileDirectoryInformation;
PFILE_DIRECTORY_INFORMATION = PFileDirectoryInformation;
PSYSTEM_THREADS = ^SYSTEM_THREADS;
SYSTEM_THREADS = packed record
KernelTime: LARGE_INTEGER;
UserTime: LARGE_INTEGER;
CreateTime: LARGE_INTEGER;
WaitTime: ULONG;
StartAddress: Pointer;
UniqueProcess: DWORD;
UniqueThread: DWORD;
Priority: Integer;
BasePriority: Integer;
ContextSwitchCount: ULONG;
State: Longint;
WaitReason: Longint;
end;
PSYSTEM_PROCESS_INFORMATION = ^SYSTEM_PROCESS_INFORMATION;
SYSTEM_PROCESS_INFORMATION = packed record
NextOffset: ULONG;
ThreadCount: ULONG;
Reserved1: array [0..5] of ULONG;
CreateTime: FILETIME;
UserTime: FILETIME;
KernelTime: FILETIME;
ModuleNameLength: WORD;
ModuleNameMaxLength: WORD;
ModuleName: PWideChar;
BasePriority: ULONG;
ProcessID: ULONG;
InheritedFromUniqueProcessID: ULONG;
HandleCount: ULONG;
Reserved2 : array[0..1] of ULONG;
PeakVirtualSize : ULONG;
VirtualSize : ULONG;
PageFaultCount : ULONG;
PeakWorkingSetSize : ULONG;
WorkingSetSize : ULONG;
QuotaPeakPagedPoolUsage : ULONG;
QuotaPagedPoolUsage : ULONG;
QuotaPeakNonPagedPoolUsage : ULONG;
QuotaNonPagedPoolUsage : ULONG;
PageFileUsage : ULONG;
PeakPageFileUsage : ULONG;
PrivatePageCount : ULONG;
ReadOperationCount : LARGE_INTEGER;
WriteOperationCount : LARGE_INTEGER;
OtherOperationCount : LARGE_INTEGER;
ReadTransferCount : LARGE_INTEGER;
WriteTransferCount : LARGE_INTEGER;
OtherTransferCount : LARGE_INTEGER;
ThreadInfo: array [0..0] of SYSTEM_THREADS;
end;
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;
PUNICODE_STRING = ^TUNICODE_STRING;
TUNICODE_STRING = packed record
Length : WORD;
MaximumLength : WORD;
Buffer : array [0..MAX_PATH - 1] of WideChar;
end;
POBJECT_NAME_INFORMATION = ^TOBJECT_NAME_INFORMATION;
TOBJECT_NAME_INFORMATION = packed record
Name : TUNICODE_STRING;
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;
const
STATUS_SUCCESS = NT_STATUS($00000000);
STATUS_INVALID_INFO_CLASS = NT_STATUS($C0000003);
STATUS_INFO_LENGTH_MISMATCH = NT_STATUS($C0000004);
STATUS_INVALID_DEVICE_REQUEST = NT_STATUS($C0000010);
ObjectNameInformation = 1;
FileDirectoryInformation = 1;
FileNameInformation = 9;
SystemProcessesAndThreadsInformation = 5;
SystemHandleInformation = 16;
function ZwQuerySystemInformation(ASystemInformationClass: DWORD;
ASystemInformation: Pointer; ASystemInformationLength: DWORD;
AReturnLength: PDWORD): NT_STATUS; stdcall; external 'ntdll.dll';
function NtQueryInformationFile(FileHandle: THandle;
IoStatusBlock: PIO_STATUS_BLOCK; FileInformation: Pointer;
Length: DWORD; FileInformationClass: DWORD): NT_STATUS;
stdcall; external 'ntdll.dll';
function NtQueryObject(ObjectHandle: THandle;
ObjectInformationClass: DWORD; ObjectInformation: Pointer;
ObjectInformationLength: ULONG;
ReturnLength: PDWORD): NT_STATUS; stdcall; external 'ntdll.dll';
function GetLongPathNameA(lpszShortPath, lpszLongPath: PChar;
cchBuffer: DWORD): DWORD; stdcall; external kernel32;
procedure TForm15.Button1Click(Sender: TObject);
begin
ShowLockedProcess('');
end;
procedure TForm15.ShowLockedProcess(FileName: String);
function GetInfoTable(ATableType: DWORD): Pointer;
var
dwSize: DWORD;
pPtr: Pointer;
ntStatus: NT_STATUS;
begin
Result := nil;
dwSize := WORD(-1);
GetMem(pPtr, dwSize);
ntStatus := ZwQuerySystemInformation(ATableType, pPtr, dwSize, nil);
while ntStatus = STATUS_INFO_LENGTH_MISMATCH do
begin
dwSize := dwSize * 2;
ReallocMem(pPtr, dwSize);
ntStatus := ZwQuerySystemInformation(ATableType, pPtr, dwSize, nil);
end;
if ntStatus = STATUS_SUCCESS then
Result := pPtr
else
FreeMem(pPtr);
end;
function GetFileNameThread(lpParameters: Pointer): DWORD; stdcall;
var
FileNameInfo: FILE_NAME_INFORMATION;
ObjectNameInfo: TOBJECT_NAME_INFORMATION;
IoStatusBlock: IO_STATUS_BLOCK;
pThreadParam: TGetFileNameThreadParam;
dwReturn: DWORD;
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
Result := NtQueryObject(pThreadParam.hFile, ObjectNameInformation,
@ObjectNameInfo, MAX_PATH * 2, @dwReturn);
if Result = STATUS_SUCCESS then
begin
pThreadParam.Status := Result;
WideCharToMultiByte(CP_ACP, 0,
@ObjectNameInfo.Name.Buffer[ObjectNameInfo.Name.MaximumLength -
ObjectNameInfo.Name.Length],
ObjectNameInfo.Name.Length, @pThreadParam.Data[0],
MAX_PATH, nil, nil);
end
else
begin
pThreadParam.Status := STATUS_SUCCESS;
Result := STATUS_SUCCESS;
WideCharToMultiByte(CP_ACP, 0,
@FileNameInfo.FileName[0], IoStatusBlock.Information,
@pThreadParam.Data[0],
MAX_PATH, nil, nil);
end;
end;
PGetFileNameThreadParam(lpParameters)^ := pThreadParam;
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
try
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;
finally
CloseHandle(hThread);
end;
end;
function SetDebugPriv: Boolean;
var
Token: THandle;
tkp: TTokenPrivileges;
begin
Result := false;
if OpenProcessToken(GetCurrentProcess,
TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, Token) then
begin
if LookupPrivilegeValue(nil, PChar('SeDebugPrivilege'),
tkp.Privileges[0].Luid) then
begin
tkp.PrivilegeCount := 1;
tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
Result := AdjustTokenPrivileges(Token, False,
tkp, 0, PTokenPrivileges(nil)^, PDWord(nil)^);
end;
end;
end;
type
DriveQueryData = record
DiskLabel: String;
DiskDosQuery: String;
DosQueryLen: Integer;
end;
var
hFile, hProcess: THandle;
pHandleInfo: PSYSTEM_HANDLE_INFORMATION_EX;
I, Drive: Integer;
ObjectTypeNumber: Byte;
FileDirectory, FilePath, ProcessName: String;
SystemInformation, TempSI: PSYSTEM_PROCESS_INFORMATION;
DosDevices: array [0..25] of DriveQueryData;
LongFileName, TmpFileName: String;
begin
SetLength(LongFileName, MAX_PATH);
GetLongPathNameA(PChar(FileName), @LongFileName[1], MAX_PATH);
for Drive := 0 to 25 do
begin
DosDevices[Drive].DiskLabel := Chr(Drive + Ord('a')) + ':';
SetLength(DosDevices[Drive].DiskDosQuery, MAXCHAR);
ZeroMemory(@DosDevices[Drive].DiskDosQuery[1], MAXCHAR);
QueryDosDevice(PChar(DosDevices[Drive].DiskLabel),
@DosDevices[Drive].DiskDosQuery[1], MAXCHAR);
DosDevices[Drive].DosQueryLen := Length(PChar(DosDevices[Drive].DiskDosQuery));
SetLength(DosDevices[Drive].DiskDosQuery, DosDevices[Drive].DosQueryLen);
end;
ObjectTypeNumber := 0;
SetDebugPriv;
hFile := CreateFile('NUL', GENERIC_READ, 0, nil, OPEN_EXISTING, 0, 0);
if hFile = INVALID_HANDLE_VALUE then RaiseLastOSError;
try
pHandleInfo := GetInfoTable(SystemHandleInformation);
if pHandleInfo = nil then RaiseLastOSError;
try
for I := 0 to pHandleInfo^.NumberOfHandles - 1 do
if pHandleInfo^.Information[I].Handle = hFile then
if pHandleInfo^.Information[I].ProcessId = GetCurrentProcessId then
begin
ObjectTypeNumber := pHandleInfo^.Information[I].ObjectTypeNumber;
Break;
end;
finally
FreeMem(pHandleInfo);
end;
finally
CloseHandle(hFile);
end;
SystemInformation := GetInfoTable(SystemProcessesAndThreadsInformation);
if SystemInformation <> nil then
try
pHandleInfo := GetInfoTable(SystemHandleInformation);
if pHandleInfo <> nil then
try
ProgressBar1.Position := 0;
ProgressBar1.Max := pHandleInfo^.NumberOfHandles;
for I := 0 to pHandleInfo^.NumberOfHandles - 1 do
begin
if pHandleInfo^.Information[I].ObjectTypeNumber = ObjectTypeNumber then
begin
hProcess := OpenProcess(PROCESS_DUP_HANDLE, True,
pHandleInfo^.Information[I].ProcessId);
if hProcess > 0 then
try
if DuplicateHandle(hProcess, pHandleInfo^.Information[I].Handle,
GetCurrentProcess, @hFile, 0, False, DUPLICATE_SAME_ACCESS) then
try
if Application.Terminated then Exit;
FilePath := GetFileNameFromHandle(hFile);
if FilePath <> '' then
begin
FileDirectory := '';
for Drive := 0 to 25 do
if DosDevices[Drive].DosQueryLen > 0 then
if Copy(FilePath, 1, DosDevices[Drive].DosQueryLen) =
DosDevices[Drive].DiskDosQuery then
begin
FileDirectory := DosDevices[Drive].DiskLabel;
Delete(FilePath, 1, DosDevices[Drive].DosQueryLen);
Break;
end;
if FileDirectory = '' then Continue;
TempSI := SystemInformation;
repeat
if TempSI^.ProcessID =
pHandleInfo^.Information[I].ProcessId then
begin
ProcessName := TempSI^.ModuleName;
Break;
end;
TempSI := Pointer(DWORD(TempSI) + TempSI^.NextOffset);
until TempSI^.NextOffset = 0;
SetLength(TmpFileName, MAX_PATH);
GetLongPathNameA(PChar(FileDirectory + FilePath), @TmpFileName[1], MAX_PATH);
Memo1.Lines.Add(ProcessName + ': ' + TmpFileName);
end;
finally
CloseHandle(hFile);
end;
finally
CloseHandle(hProcess);
end;
end;
ProgressBar1.Position := ProgressBar1.Position + 1;
Application.ProcessMessages;
end;
finally
FreeMem(pHandleInfo);
end;
finally
FreeMem(SystemInformation);
end;
ShowMessage('All handles found.');
end;
end.
Взято из https://forum.sources.ru