Delphi - 使用句柄按进程获取打开的文件

Question

我实际上是在编写一个应用程序来查看打开了哪些文件。

他是不是我的代码的一部分，我正在尝试使用它，但我不明白它...... 我正在尝试获取该进程打开的文件名，但该函数总是会产生如下结果：/Default or /Sessions/1/Windows ...类似的东西。请帮助我，对不起因为我的英语不好

const
SystemHandleInformation = $10;
STATUS_SUCCESS = $00000000;
STATUS_BUFFER_OVERFLOW = $80000005;
STATUS_INFO_LENGTH_MISMATCH = $C0000004;
DefaulBUFFERSIZE = $100000;

type
OBJECT_INFORMATION_CLASS = (ObjectBasicInformation, ObjectNameInformation,
ObjectTypeInformation, ObjectAllTypesInformation, ObjectHandleInformation);

SYSTEM_HANDLE = packed record
uIdProcess: ULONG;
ObjectType: UCHAR;
Flags: UCHAR;
Handle: Word;
pObject: Pointer;
GrantedAccess: ACCESS_MASK;
end;

PSYSTEM_HANDLE = ^SYSTEM_HANDLE;
SYSTEM_HANDLE_ARRAY = Array [0 .. 0] of SYSTEM_HANDLE;
PSYSTEM_HANDLE_ARRAY = ^SYSTEM_HANDLE_ARRAY;

SYSTEM_HANDLE_INFORMATION = packed record
uCount: ULONG;
Handles: SYSTEM_HANDLE_ARRAY;
end;

PSYSTEM_HANDLE_INFORMATION = ^SYSTEM_HANDLE_INFORMATION;

TNtQuerySystemInformation = function(SystemInformationClass: DWORD;
SystemInformation: Pointer; SystemInformationLength: DWORD;
ReturnLength: PDWORD): THandle; stdcall;
TNtQueryObject = function(ObjectHandle: cardinal;
ObjectInformationClass: OBJECT_INFORMATION_CLASS;
ObjectInformation: Pointer; Length: ULONG; ResultLength: PDWORD)
: THandle; stdcall;

UNICODE_STRING = packed record
Length: Word;
MaximumLength: Word;
Buffer: PWideChar;
 end;

OBJECT_NAME_INFORMATION = UNICODE_STRING;
POBJECT_NAME_INFORMATION = ^OBJECT_NAME_INFORMATION;

Var
NTQueryObject: TNtQueryObject;
NTQuerySystemInformation: TNtQuerySystemInformation;


Procedure EnumerateOpenFiles();
var
sDummy: string;
hProcess: THandle;
hObject: THandle;
ResultLength: DWORD;
aBufferSize: DWORD;
aIndex: Integer;
pHandleInfo: PSYSTEM_HANDLE_INFORMATION;
HDummy: THandle;
lpwsName: PWideChar;
lpwsType: PWideChar;
lpszProcess: pchar;
begin
aBufferSize := DefaulBUFFERSIZE;
pHandleInfo := AllocMem(aBufferSize);
HDummy := NTQuerySystemInformation(DWORD(SystemHandleInformation),
pHandleInfo, aBufferSize, @ResultLength); // Get the list of handles

if (HDummy = STATUS_SUCCESS) then // If no error continue
begin

for aIndex := 0 to pHandleInfo^.uCount - 1 do // iterate the list
begin
  hProcess := OpenProcess(PROCESS_DUP_HANDLE or PROCESS_QUERY_INFORMATION or
    PROCESS_VM_READ, False, pHandleInfo.Handles[aIndex].uIdProcess);
  // open the process to get aditional info
  if (hProcess <> INVALID_HANDLE_VALUE) then // Check valid handle
  begin

    hObject := 0;
    if DuplicateHandle(hProcess, pHandleInfo.Handles[aIndex].Handle,
      GetCurrentProcess, @hObject, STANDARD_RIGHTS_REQUIRED, False, 0) then
    // Get  a copy of the original handle
    begin

      lpwsName := GetObjectInfo(hObject, ObjectTypeInformation);

      // Get the filename linked to the handle
      if (lpwsName <> nil) then
      begin
        lpwsType := GetObjectInfo(hObject, ObjectNameInformation);
        lpszProcess := AllocMem(MAX_PATH);

        if GetModuleFileNameEx(hProcess, 0, lpszProcess, MAX_PATH) <> 0 then
          // get the name of the process
          sDummy := ExtractFileName(lpszProcess)
        else
          sDummy := 'System Process';


          with MainForm.UsedFilesListView.Items.add do
          begin

            // Ajout
            Caption := sDummy;

            ImageIndex := -1;

            SubItems.add(lpwsName);

          end;


        // Writeln('PID      ', pHandleInfo.Handles[aIndex].uIdProcess);
        // Writeln('Handle   ', pHandleInfo.Handles[aIndex].Handle);
        // Writeln('Process  ', sDummy);
        // Writeln('FileName ', string(lpwsName));
        // Writeln;

        FreeMem(lpwsName);
        FreeMem(lpwsType);
        FreeMem(lpszProcess);
      end;
      CloseHandle(hObject);
    end;
    CloseHandle(hProcess);
  end;
end;
end;
FreeMem(pHandleInfo);

end;

Answer 1

首先，您没有在问题中提供SSCCE，这大大减少了有人查看并尝试修复您的代码的机会。因为我们需要考虑所有缺失的声明以及要包含哪些单元才能生成可编译的代码，是的，这很无聊。

其次，copy and paste programming 是一种不好的做法，它不会提高您的编程技能。尝试咨询 MSDN 了解某些 API 的作用以及如何使用它们，然后尝试使用您通过 Google/MSDN 收集的信息来修改代码。

关于问题本身，这是一个棘手的问题，并且广泛没有记录。

在 SysInternals 论坛上查看这篇有用的帖子，它大致解释了您必须做什么：HOWTO: Enumerate handles。

获取文件路径后，您必须将 MS-DOS 设备路径替换为其映射路径（例如 \Device\HarddiskVolume1 > C:\）。您可以使用 GetLogicalDriveStrings 和 QueryDosDevice API 来做到这一点。

现在是代码本身。你需要JEDI API library 来编译它。在 XE2 上测试：

{$APPTYPE CONSOLE}

program FileHandles;

uses
  Winapi.Windows,
  System.Classes,
  JwaNative,
  JwaNtStatus,
  JwaWinternl;

procedure EnumerateDevicePaths(const ADeviceNames, ADevicePaths: TStringList);
var
  drives     : array[0..4095] of Char;
  pdrive     : PChar;
  drive      : String;
  drive_path : array[0..4095] of Char;
  sdrive_path: String;
begin
  ADeviceNames.Clear;
  ADevicePaths.Clear;

  if GetLogicalDriveStrings(SizeOf(drives), drives) = 0 then
    Exit;

  pdrive := drives;
  while pdrive^ <> #0 do
  begin
    drive := Copy(pdrive, 0, 4);
    if drive <> '' then
    begin
      if drive[Length(drive)] = '\' then
        Delete(drive, Length(drive), 1);

      QueryDosDevice(PChar(drive), drive_path, SizeOf(drive_path));
      sdrive_path := drive_path;

      ADeviceNames.Add(drive);
      ADevicePaths.Add(sdrive_path);
    end;
    Inc(pdrive, 4);
  end;
end;

function EnumerateOpenFiles: Integer;
const
  HANDLE_BUFFER_INCREASE_CHUNK = 16 * 1024; // increase handles buffer by 16kb
type
  // this struct is missing in JEDI declarations (?)
  TSystemHandleInformations = record
    HandleCount: ULONG;
    Handles    : array[0..0] of TSystemHandleInformation;
  end;
  PSystemHandleInformations = ^TSystemHandleInformations;
var
  phandles_info : PSystemHandleInformations;
  phandles_size : DWORD;
  retcode       : DWORD;
  C1, C2        : Integer;
  phandle_info  : PSystemHandleInformation;
  process_handle: THandle;
  dup_handle    : THandle;
  obj_name_info : PObjectNameInformation;
  obj_name_size : DWORD;
  fname         : String;
  device_names  : TStringList;
  device_paths  : TStringList;
begin
  device_names := TStringList.Create;
  try
    device_paths := TStringList.Create;
    try
      EnumerateDevicePaths(device_names, device_paths); // enumerate devices list, so we can use these later on to replace MS-DOS paths with mapped ones

      phandles_size := HANDLE_BUFFER_INCREASE_CHUNK; // start with HANDLE_BUFFER_INCREASE_CHUNK value
      phandles_info := AllocMem(phandles_size);
      try
        retcode := NtQuerySystemInformation(DWORD(SystemHandleInformation), phandles_info, phandles_size, nil);
        while retcode = STATUS_INFO_LENGTH_MISMATCH do // realloc handles buffer memory until it's big enough to accept all handles data
        begin
          Inc(phandles_size, HANDLE_BUFFER_INCREASE_CHUNK);
          ReallocMem(phandles_info, phandles_size);
          retcode := NtQuerySystemInformation(DWORD(SystemHandleInformation), phandles_info, phandles_size, nil);
        end;

        if retcode <> STATUS_SUCCESS then
          Exit(retcode);

        // iterate through opened handles
        for C1 := 0 to phandles_info^.HandleCount do
        begin
          phandle_info := pointer(Integer(@phandles_info^.Handles) + C1 * SizeOf(TSystemHandleInformation)); // get pointer to C1 handle info structure

          // if ObjectType is not file, or if handle is named pipe (which would make Nt*() function to block), we skip to the next handle
          // GrantedAccess mask here is very cryptic, I've been unable to find more information about it on Google, all codes use static hex numbers for check
          if (phandle_info^.ObjectTypeNumber <> 28) or
             (phandle_info^.GrantedAccess = $0012019F) or
             (phandle_info^.GrantedAccess = $001A019F) or
             (phandle_info^.GrantedAccess = $00120189) then
            Continue;

          process_handle := OpenProcess(PROCESS_DUP_HANDLE, FALSE, phandle_info^.ProcessId);
          if process_handle <> 0 then
          try
            if DuplicateHandle(process_handle, phandle_info^.Handle, GetCurrentProcess, @dup_handle, 0, FALSE, 0) then
            try
              obj_name_size := SizeOf(TObjectNameInformation);
              obj_name_info := AllocMem(obj_name_size);
              try
                // get path to the file
                retcode := NtQueryObject(dup_handle, ObjectNameInformation, obj_name_info, obj_name_size, @obj_name_size);
                if retcode <> STATUS_SUCCESS then
                begin
                  ReallocMem(obj_name_info, obj_name_size);
                  retcode := NtQueryObject(dup_handle, ObjectNameInformation, obj_name_info, obj_name_size, nil);
                end;

                if retcode <> STATUS_SUCCESS then
                  Continue;

                fname := obj_name_info^.Name.Buffer;

                // replace MS-DOS device names with their mappings
                for C2 := 0 to device_paths.Count - 1 do
                  if Copy(fname, 1, Length(device_paths[C2])) = device_paths[C2] then
                  begin
                    Delete(fname, 1, Length(device_paths[C2]));
                    fname := device_names[C2] + fname;
                    Break;
                  end;

                // do necessary processing with fname here
                WriteLn(phandle_info^.ProcessId, ': ', fname);
              finally
                FreeMem(obj_name_info, obj_name_size);
              end;
            finally
              CloseHandle(dup_handle);
            end;
          finally
            CloseHandle(process_handle);
          end;
        end;
      finally
        FreeMem(phandles_info, phandles_size);
      end;

      Exit(STATUS_SUCCESS);
    finally
      device_paths.Free;
    end;
  finally
    device_names.Free;
  end;
end;

begin
  EnumerateOpenFiles;
  Write('Done!');
  ReadLn;
end.

此代码可以通过多种方式进行改进，但我已经为您提供了足够的开始。例如，其中一项优化是通过按 PID 对句柄列表进行排序来避免多次打开同一进程，然后只打开一次进程以检查具有相同 PID 的句柄组。

Answer 2

您似乎正在使用此处的代码：Delphi - get what files are opened by an application。此代码声称：

列出所有进程的所有打开句柄

换句话说，它列出了与文件对象以外的对象相关联的句柄。您看到的看起来不像文件名的文件名确实如此。它们是进程拥有句柄的文件以外的对象的名称。