////////////////////////////////////////////////////////////////////////////////
//
// ****************************************************************************
// * Unit Name : Unit15
// * Purpose : Перечисление всех открытых файлов в системе
// * (до которых получилось достучаться)
// * Author : Александр (Rouse_) Багель
// * Version : 1.00
// ****************************************************************************
//
{©Drkb v.3(2007): www.drkb.ru}

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
  EntryOffset: 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
  Offset: 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^.Offset);
  until TempSI^.Offset = 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.