Delphi: Liste der von einem Prozess in Windows 10 v. 1607 verwendeten Handles / Dateien abrufen

Bearbeiten: Das Problem lag nicht in NtQuerySystemInformation, sondern im Dateityp (bObjectType), der in dieser neuen Edition von Windows 10 auf den Wert 34 geändert wurde. In Creators Update ist es 35.

Ich habe den folgenden Code erfolgreich verwendet, um eine Liste der von einem bestimmten Prozess verwendeten Dateien abzurufen, aber seit dem "Jubiläums-Update" für Windows 10 funktioniert es nicht mehr.

Windows 10 Version 1607 Build 14393.105

Irgendeine Idee

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;

Antworten auf die Frage(4)

Ihre Antwort auf die Frage