Delphi – 获取应用程序打开的文件

如何使用Delphi获取应用程序打开文件的列表？
例如,winword.exe打开了哪些文件

解决方法

使用Native API函数 NtQuerySystemInformation,您可以列出所有进程的所有打开句柄.

试试这个例子

program ListAllHandles;

{$APPTYPE CONSOLE}

uses
  PSApi,Windows,SysUtils;

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;


function GetobjectInfo(hObject:cardinal; objInfoClass:OBJECT_informatION_CLASS):LPWSTR;
var
 pObjectInfo:POBJECT_NAME_informatION;
 HDummy     :THandle;
 dwSize     :DWORD;
begin
  Result:=nil;
  dwSize      := sizeof(OBJECT_NAME_informatION);
  pObjectInfo := Allocmem(dwSize);
  HDummy      := NTQueryObject(hObject,objInfoClass,pObjectInfo,dwSize,@dwSize);

  if((HDummy = STATUS_BUFFER_OVERFLOW) or (HDummy = STATUS_INFO_LENGTH_MISMATCH)) then
    begin
   FreeMem(pObjectInfo);
   pObjectInfo := Allocmem(dwSize);
   HDummy      := NTQueryObject(hObject,@dwSize);
  end;

  if((HDummy >= STATUS_SUCCESS) and (pObjectInfo.Buffer <> nil)) then
  begin
   Result := Allocmem(pObjectInfo.Length + sizeof(WCHAR));
   copyMemory(result,pObjectInfo.Buffer,pObjectInfo.Length);
  end;
  FreeMem(pObjectInfo);
end;

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 : PAnsiChar;
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,0) then  //Get  a copy of the original handle
          begin
      lpwsName := GetobjectInfo(hObject,ObjectNameinformation); //Get the filename linked to the handle
      if (lpwsName <> nil)  then
            begin
       lpwsType    := GetobjectInfo(hObject,ObjectTypeinformation);
       lpszProcess := Allocmem(MAX_PATH);

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

              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;

begin
  try
    NTQueryObject            := GetProcAddress(GetModuleHandle('NTDLL.DLL'),'NtQueryObject');
    NTQuerySysteminformation := GetProcAddress(GetModuleHandle('NTDLL.DLL'),'NtQuerySysteminformation');
   if (@NTQuerySysteminformation<>nil) and (@NTQuerySysteminformation<>nil) then
    EnumerateOpenFiles();
    Readln;
  except
    on E:Exception do
      Writeln(E.Classname,': ',E.Message);
  end;
end.