Delphi:获取Windows 10 v.1607中进程使用的句柄/文件列表

时间:2016-09-11 19:49:48

标签: delphi winapi

编辑:问题不在于NtQuerySystemInformation,而是在新版本的Windows 10中已经更改为值34的文件类型(bObjectType)中。在创建者中更新它是35。

我一直在成功使用以下代码来检索给定进程正在使用的文件列表,但自Windows 10“周年纪念更新”以来,它已不再有效。

Windows 10版本1607 Build 14393.105

有什么想法吗?

function GetFileNameHandle(hFile: THandle): String;
var lpExitCode: DWORD;
    pThreadParam: TGetFileNameThreadParam;
    hThread: THandle;
    Ret: Cardinal;
begin
  Result := '';
  ZeroMemory(@pThreadParam, SizeOf(TGetFileNameThreadParam));
  pThreadParam.hFile := hFile;
  hThread := CreateThread(nil, 0, @GetFileNameHandleThr, @pThreadParam, 0, {PDWORD(nil)^} Ret);
  if hThread <> 0 then
  try
    case WaitForSingleObject(hThread, 100) of
      WAIT_OBJECT_0: begin
        GetExitCodeThread(hThread, lpExitCode);
        if lpExitCode = STATUS_SUCCESS then
          Result := pThreadParam.FileName;
      end;
      WAIT_TIMEOUT: TerminateThread(hThread, 0);
    end;
  finally
    CloseHandle(hThread);
  end;
end;

procedure DeleteUpToFull(var src: String; UpTo: String);
begin
  Delete(src,1,Pos(Upto,src)+Length(UpTo)-1);
end;

procedure ConvertDevicePath(var dvc: string);
var i: integer;
    root: string;
    device: string;
    buffer: string;
    //drvs: string;
begin
  // much faster without using GetReadyDiskDrives
  setlength(buffer, 1000);
  for i := Ord('a') to Ord('z') do begin
    root := Chr(i) + ':';
    if (QueryDosDevice(PChar(root), pchar(buffer), 1000) <> 0) then begin
      device := pchar(buffer);
      if finds(device+'\',dvc) then begin
        DeleteUpToFull(dvc,device+'\');
        dvc := root[1] + ':\' + dvc;
        Exit;
      end;
    end;
  end;
end;

//get the pid of the process which had open the specified file
function GetHandlesByProcessID(const ProcessID: Integer; Results: TStringList; TranslatePaths: Boolean): Boolean;
var hProcess    : THandle;
    hFile       : THandle;
    ReturnLength: DWORD;
    SystemInformationLength : DWORD;
    Index       : Integer;
    pHandleInfo : PSYSTEM_HANDLE_INFORMATION;
    hQuery      : THandle;
    FileName    : string;
    r: byte;
begin
  Result := False;
  Results.Clear;
  pHandleInfo      := nil;
  ReturnLength     := 1024;
  pHandleInfo      := AllocMem(ReturnLength);
  hQuery           := NTQuerySystemInformation(DWORD(SystemHandleInformation), pHandleInfo, 1024, @ReturnLength);
  r := 0; // loop safe-guard
  While (hQuery = $C0000004) and (r < 10) do begin
    Inc(r);
    FreeMem(pHandleInfo);
    SystemInformationLength := ReturnLength;
    pHandleInfo             := AllocMem(ReturnLength+1024);
    hQuery                  := NTQuerySystemInformation(DWORD(SystemHandleInformation), pHandleInfo, SystemInformationLength, @ReturnLength);//Get the list of handles
  end;
  // if hQuery = 0 then
  //  RaiseLastOSError;

  try
    if (hQuery = STATUS_SUCCESS) then begin
     for Index := 0 to pHandleInfo^.uCount-1 do begin
       // filter to requested process
       if pHandleInfo.Handles[Index].uIdProcess <> ProcessID then Continue;
       // http://www.codeproject.com/Articles/18975/Listing-Used-Files
       // For an object of type file, the value bObjectType in SYSTEM_HANDLE is 28 in Windows XP, Windows 2000, and Window 7; 25 in Windows Vista; and 26 in Windows 2000.
       // XP = 28
       // W7 = 28
       // W8 = 31
       if (pHandleInfo.Handles[Index].ObjectType < 25) or
         (pHandleInfo.Handles[Index].ObjectType > 31) then Continue;

        hProcess := OpenProcess(PROCESS_DUP_HANDLE, FALSE, pHandleInfo.Handles[Index].uIdProcess);
        if(hProcess <> INVALID_HANDLE_VALUE) then begin
          try
           if not DuplicateHandle(hProcess, pHandleInfo.Handles[Index].Handle,
                                  GetCurrentProcess(), @hFile,  0 ,FALSE,
                                  DUPLICATE_SAME_ACCESS) then
            hFile := INVALID_HANDLE_VALUE;
          finally
           CloseHandle(hProcess);
          end;

          if (hFile <> INVALID_HANDLE_VALUE) then begin
            try
              FileName := GetFileNameHandle(hFile);
            finally
              CloseHandle(hFile);
            end;
          end
          else
          FileName := '';

          if FileName <> '' then begin
            if TranslatePaths then begin
                ConvertDevicePath(FileName);
                if not FileExists(Filename) then FileName := '\##\'+Filename; //Continue;
            end;
            Results.Add(FileName);
          end;
        end;
      end;
    end;
  finally
    if pHandleInfo <> nil then FreeMem(pHandleInfo);
  end;
end;

2 个答案:

答案 0 :(得分:2)

我刚刚在Windows 10周年更新中测试了我的博客文章“Running multiple instances of Microsoft Lync”中的代码,它似乎没有任何问题。

这是我测试的代码(将进程名称,例如foobar.exe作为参数):

program ListHandles;

{$APPTYPE CONSOLE}

uses
  JwaWinBase,
  JwaWinNT,
  JwaWinType,
  JwaNtStatus,
  JwaNative,
  JwaWinsta,
  SysUtils,
  StrUtils;

{$IFDEF RELEASE}
  // Leave out Relocation Table in Release version
  {$SetPEFlags IMAGE_FILE_RELOCS_STRIPPED}
{$ENDIF RELEASE}
{$SetPEOptFlags IMAGE_DLLCHARACTERISTICS_TERMINAL_SERVER_AWARE}

// No need for RTTI
{$WEAKLINKRTTI ON}
 {$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])}

var
  dwPid: DWORD;
  hProcess: THandle;

{$ALIGN 8}
{$MINENUMSIZE 4}
type
  _SYSTEM_HANDLE = record
    ProcessId: ULONG;
    ObjectTypeNumber: Byte;
    Flags: Byte;
    Handle: USHORT;
    _Object: PVOID;
    GrantedAccess: ACCESS_MASK;
  end;
  SYSTEM_HANDLE = _SYSTEM_HANDLE;
  PSYSTEM_HANDLE = ^SYSTEM_HANDLE;

  _SYSTEM_HANDLE_INFORMATION = record
    HandleCount: ULONG;
    Handles: array[0..0] of SYSTEM_HANDLE;
  end;
  SYSTEM_HANDLE_INFORMATION = _SYSTEM_HANDLE_INFORMATION;
  PSYSTEM_HANDLE_INFORMATION = ^SYSTEM_HANDLE_INFORMATION;

  _OBJECT_NAME_INFORMATION = record
    Length: USHORT;
    MaximumLength: USHORT;
    Pad: DWORD;
    Name: array[0..MAX_PATH-1] of Char;
  end;
  OBJECT_NAME_INFORMATION = _OBJECT_NAME_INFORMATION;
  POBJECT_NAME_INFORMATION = ^OBJECT_NAME_INFORMATION;

function GetObjectName(const hObject: THandle): String;
var
  oni: OBJECT_NAME_INFORMATION;
  cbSize: DWORD;
  nts: NTSTATUS;
begin
  Result := '';

  cbSize := SizeOf(oni) - (2 * SizeOf(USHORT));
  oni.Length := 0;
  oni.MaximumLength := cbSize;
  nts := NtQueryObject(hObject, ObjectNameInformation, @oni, cbSize, @cbSize);
  if (nts = STATUS_SUCCESS) and (oni.Length > 0) then
  begin
    Result := oni.Name;
  end;
end;

function GetCurrentSessionId: DWORD;
 asm
   mov     eax,fs:[$00000018];   // Get TEB
   mov     eax,[eax+$30];        // PPEB
   mov     eax,[eax+$1d4];       // PEB.SessionId
 end;

function GetProcessByName(const ProcessName: string): DWORD;
var
  ProcName: PChar;
  Count: Integer;
  tsapi: PTS_ALL_PROCESSES_INFO_ARRAY;
  i: Integer;
  dwSessionId: DWORD;
begin
  Result := 0;
  tsapi := nil;

  if not WinStationGetAllProcesses(SERVERNAME_CURRENT, 0, Count, tsapi) then
    Exit;

  ProcName := PChar(ProcessName);
  dwSessionId := GetCurrentSessionId;

  WriteLn(Format('Looking for Process %s in Session %d',
    [ProcessName, dwSessionId]));

  for i := 0 to Count - 1 do
  begin
    with tsapi^[i], tsapi^[i].pTsProcessInfo^ do
    begin
      if (dwSessionId = SessionId) and (ImageName.Buffer <> nil) and
        (StrIComp(ProcName, ImageName.Buffer) = 0) then
      begin
        Result := UniqueProcessId;
        WriteLn(Format('%s has Pid %d', [ProcessName, Result]));
        Break
      end;
    end;
  end;

  if tsapi <> nil then
    WinStationFreeGAPMemory(0, tsapi, Count);
end;

procedure EnumHandles;
var
  shi: PSYSTEM_HANDLE_INFORMATION;
  cbSize: DWORD;
  cbRet: DWORD;
  nts: NTSTATUS;
  i: Integer;
  hDupHandle: THandle;
  dwErr: DWORD;
  ObjectName: string;
begin
  WriteLn('Enumerating Handles');
  cbSize := $5000;
  GetMem(shi, cbSize);
  repeat
    cbSize := cbSize * 2;
    ReallocMem(shi, cbSize);
    nts := NtQuerySystemInformation(SystemHandleInformation, shi, cbSize, @cbRet);
  until nts <> STATUS_INFO_LENGTH_MISMATCH;

  if nts = STATUS_SUCCESS then
  begin
    for i := 0 to shi^.HandleCount - 1 do
    begin
      if shi^.Handles[i].GrantedAccess <> $0012019f then
      begin
        if shi^.Handles[i].ProcessId = dwPid then
        begin
          nts := NtDuplicateObject(hProcess, shi^.Handles[i].Handle,
            GetCurrentProcess, @hDupHandle, 0, 0, 0);

          if nts = STATUS_SUCCESS then
          begin
            ObjectName := GetObjectName(hDupHandle);
            if (ObjectName <> '') then
            begin
              WriteLn(Format('Handle=%d Name=%s', [shi^.Handles[i].Handle, ObjectName]));
              CloseHandle(hDupHandle);
            end;
          end;
        end;
      end;
    end;
  end
  else begin
    dwErr := RtlNtStatusToDosError(nts);
    WriteLn(Format('Failed to read handles, NtQuerySystemInformation failed with %.8x => %d (%s)', [nts, SysErrorMessage(dwErr)]));
  end;

  FreeMem(shi);
end;


procedure AnyKey;
begin
    WriteLn('Finished');
    WriteLn('Press any key to continue');
    ReadLn;
end;

begin
  try
    dwPid := GetProcessByName(ParamStr(1));
    if dwPid = 0 then
    begin
      WriteLn('Process was not found, exiting.');
      Exit;
    end;

    WriteLn(Format('Opening Process %d with PROCESS_DUP_HANDLE', [dwPid]));
    hProcess := OpenProcess(PROCESS_DUP_HANDLE, False, dwPid);

    if hProcess = 0 then
    begin
      WriteLn(Format('OpenProcess failed with %s', [SysErrorMessage(GetLastError)]));
      Exit;
    end
    else begin
      WriteLn(Format('Process Handle is %d', [hProcess]));
    end;

    EnumHandles;

  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
end.

答案 1 :(得分:1)

下一个代码(在C ++中)在所有Windows版本(Win 10 1607)上100%正确。另外,我使用SystemExtendedHandleInformation代替SystemHandleInformation,并建议您这样做。它从XP开始存在。但是,SystemHandleInformation的代码也能正常工作,我只是检查了它。

NTSTATUS GetHandlesByProcessID()
{
    union {
        PVOID buf;
        PSYSTEM_HANDLE_INFORMATION_EX pshti;
    };

    NTSTATUS status;
    ULONG ReturnLength = 1024;//not reasonable value for start query,but let be
    ULONG UniqueProcessId = GetCurrentProcessId(); 
    do 
    {
        status = STATUS_INSUFFICIENT_RESOURCES;

        if (buf = new BYTE[ReturnLength])
        {
            if (0 <= (status = ZwQuerySystemInformation(SystemExtendedHandleInformation, buf, ReturnLength, &ReturnLength)))
            {
                if (ULONG_PTR NumberOfHandles = pshti->NumberOfHandles)
                {
                    SYSTEM_HANDLE_TABLE_ENTRY_INFO_EX* Handles = pshti->Handles;
                    do 
                    {
                        if (Handles->UniqueProcessId == UniqueProcessId)
                        {
                            DbgPrint("%u, %p\n", Handles->ObjectTypeIndex, Handles->HandleValue);
                        }
                    } while (Handles++, --NumberOfHandles);
                }
            }

            delete buf;
        }

    } while (status == STATUS_INFO_LENGTH_MISMATCH);

    return status;
}

我认为这就像Delphi循环中的repeat until:)

r := 0; // loop safe-guard - 这不是必需的。

关于硬编码ObjectTypeIndex - 从Win 8.1开始,您可以从操作系统中获取此信息。您需要使用ZwQueryObject()致电ObjectTypesInformation(在某些来源中,此名称为ObjectAllTypeInformation,请参阅ntifs.h)以获取OBJECT_TYPE_INFORMATION结构数组。查找TypeIndex成员 - 它与ObjectTypeIndex中的SYSTEM_HANDLE_TABLE_ENTRY_INFO_EX完全相同。在Win 8.1之前,还有一些方法可以使用ObjectAllTypeInformation来实现“动态”,但它更复杂。