unit Unit1;

interface

uses     tlhelp32,
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls, Menus, ExtCtrls;

type NT_STATUS = Cardinal;

 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;

 PIO_STATUS_BLOCK = ^IO_STATUS_BLOCK;
 IO_STATUS_BLOCK = packed record
   Status: NT_STATUS;
   Information: DWORD;
 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;

 PFILE_NAME_INFORMATION = ^FILE_NAME_INFORMATION;
 FILE_NAME_INFORMATION = packed record
   FileNameLength: ULONG;
   FileName: array [0..MAX_PATH - 1] of WideChar;
 end;
 TForm1 = class(TForm)
   ListBox1: TListBox;
   MainMenu1: TMainMenu;
   N11: TMenuItem;
   Timer1: TTimer;
   procedure FormCreate(Sender: TObject);
   procedure Timer1Timer(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;
SYSTEM_HANDLE_INFORMATION = packed record
     ProcessId: DWORD;
     ObjectTypeNumber: Byte;
     Flags: Byte;
     Handle: Word;
     pObject: Pointer;
     GrantedAccess: DWORD;
end;
PSYSTEM_HANDLE_INFORMATION = ^SYSTEM_HANDLE_INFORMATION;

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;
 PGetFileNameThreadParam = ^TGetFileNameThreadParam;
 TGetFileNameThreadParam = packed record
   hFile: THandle;
   Data: array [0..MAX_PATH - 1] of Char;
   Status: NT_STATUS;
 end;

//**************************************************************************
var   SystemHandleInformation:SYSTEM_HANDLE_INFORMATION;
 Form1: TForm1;
 
 function GetLongPathNameA(lpszShortPath, lpszLongPath: PChar;
       cchBuffer: DWORD): DWORD; stdcall; external kernel32;

 function NtQueryObject(ObjectHandle: THandle;
   ObjectInformationClass: DWORD; ObjectInformation: Pointer;
   ObjectInformationLength: ULONG;
   ReturnLength: 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 ZwQuerySystemInformation(ASystemInformationClass: DWORD;
      ASystemInformation: Pointer; ASystemInformationLength: DWORD;
     AReturnLength: PDWORD): NT_STATUS; stdcall; external 'ntdll.dll';
implementation

{$R *.dfm}
//**************************************************************************
 function GetInfoTable(ATableType: DWORD): Pointer;
  const STATUS_INFO_LENGTH_MISMATCH = NT_STATUS($C0000004);
  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 = NT_STATUS($00000000){STATUS_SUCCESS} then
      Result := pPtr
    else
      FreeMem(pPtr);
  end;
//**************************************************************************
function GetFileHandleType:byte;
var
hFile,r:THANDLE;
Info: PSYSTEM_HANDLE_INFORMATION_EX;
begin
result:=0;
hFile := CreateFile('NUL', GENERIC_READ, 0, 0, OPEN_EXISTING, 0, 0);
if (hFile <> INVALID_HANDLE_VALUE) then begin
Info := GetInfoTable(16{SystemHandleInformation});
if (Info<>nil) then
for r:=0 to Info.NumberOfHandles do begin
 if ((Info.Information[r].Handle = hFile) and
    (Info.Information[r].ProcessId = GetCurrentProcessId)) then begin
   result:=info.Information[r].ObjectTypeNumber;
//   Result := ;
  break;
 end;
end;
end;

FreeMem(Info);
CloseHandle(hFile);
end;

//**************************************************************************
function GetFileNameThread(lpParameters: Pointer): DWORD; stdcall;
const FileNameInformation = 9; ObjectNameInformation = 1;
  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 = NT_STATUS($00000000){STATUS_SUCCESS} then
    begin
      Result := NtQueryObject(pThreadParam.hFile, ObjectNameInformation,
        @ObjectNameInfo, MAX_PATH * 2, @dwReturn);
      if Result = NT_STATUS($00000000){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 := NT_STATUS($00000000){STATUS_SUCCESS};
        Result := NT_STATUS($00000000){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 = NT_STATUS($00000000){STATUS_SUCCESS} then
           Result := pThreadParam.Data;
       end;
       WAIT_TIMEOUT:
         TerminateThread(hThread, 0);
     end;
   finally
     CloseHandle(hThread);
   end;
 end;
//**************************************************************************
procedure TForm1.FormCreate(Sender: TObject);
var SystemInformation: PSYSTEM_PROCESS_INFORMATION;
 pHandleInfo: PSYSTEM_HANDLE_INFORMATION_EX;
b:byte;  i:integer;    s:String;
begin {
SystemInformation:= GetInfoTable(5);
 if SystemInformation <> nil then
   pHandleInfo := GetInfoTable(16);
caption:=inttostr(pHandleInfo^.NumberOfHandles);
//********* FOR ******************
b:=GetFileHandleType;
for i:=0 to pHandleInfo^.NumberOfHandles do
begin
if pHandleInfo^.Information[i].ObjectTypeNumber=b then
begin
 ListBox1.Items.Add(inttostr(pHandleInfo^.Information[i].Handle));
end;
end;
//******* END FOR ****************{}
end;

function GetHandlesFileFromPID(PID:cardinal):string;
var SystemInformation: PSYSTEM_PROCESS_INFORMATION;
 pHandleInfo: PSYSTEM_HANDLE_INFORMATION_EX;
b:byte;  i:integer;    s:String;
cp,hp:Cardinal;hFile: THandle;
begin
b:=GetFileHandleType;
SystemInformation:= GetInfoTable(5);
 if SystemInformation <> nil then
   pHandleInfo := GetInfoTable(16);
for I := 0 to pHandleInfo^.NumberOfHandles - 1 do
     begin
       if pHandleInfo^.Information[I].ObjectTypeNumber = b then
       begin
         hP := OpenProcess(PROCESS_DUP_HANDLE, True,
           pHandleInfo^.Information[I].ProcessId);
         if hP > 0 then
         try
           if DuplicateHandle(hP, pHandleInfo^.Information[I].Handle,
             GetCurrentProcess, @hFile, 0, False, DUPLICATE_SAME_ACCESS) then
           try
             if Application.Terminated then Exit;
             s := GetFileNameFromHandle(hFile);
//              caption:=IntToStr(cp);
            if (trim(s)<>'')and(pHandleInfo^.Information[I].ProcessId=PID) then
              result:=result+(inttostr(pHandleInfo^.Information[I].ProcessId)+' '+s)
              +#10#13;
           finally
             CloseHandle(hFile);
           end;
         finally
           CloseHandle(hP);
         end;
       end;
       Application.ProcessMessages;
     end;
end;

//**************************************************************************

procedure TForm1.Timer1Timer(Sender: TObject);

begin
ListBox1.Items.Text:=GetHandlesFileFromPID(2756);
end;

end.