Delphi - 查找从我的程序访问文件的进程

Question

Delphi - 查找从我的程序访问文件的进程

ros*_*mcm 14 delphi wmi process filehandle delphi-2006

我有一个定期写入本地磁盘文件的Delphi应用程序.有时它无法访问该文件 - 尝试打开时会导致共享冲突.短暂延迟后重试就是所需要的,但是当它发生时,我想报告阻止访问的进程.

当我的程序发生共享冲突以枚举正在使用的所有文件句柄时,是否可行,检查文件名,如果它与我的数据文件的名称匹配,则检索与该句柄关联的进程名称？

一些示例代码会很好.

Answer 1

RRU*_*RUZ 12

你基本上有两种方式

简单的方法

如果您使用的是Windows Vista或更新版本,请尝试使用该IFileIsInUse界面

困难的方式

如果你需要一个兼容Windows XP,Vista,7等的方法.然后你使用NtQuerySystemInformation,NtQueryInformationFile和NtQueryObject函数.

这些是继续进行的步骤

调用NTQuerySystemInformation传递未记录的SystemHandleInformation($ 10)值以获取句柄列表
然后处理作为文件的句柄列表(仅用于ObjectType = 28).
用Open调用OpenProcess PROCESS_DUP_HANDLE
然后调用DuplicateHandle获取real文件句柄.
使用NtQueryInformationFile和NtQueryObject函数获取与句柄相关联的文件名.

注1:此方法的棘手部分是基于句柄解析文件名.该函数NtQueryInformationFile在某些场景(系统句柄和其他场景)中挂起,防止整个应用程序挂起的解决方法是从单独的线程调用该函数.

注2:存在另一个函数,如GetFileInformationByHandleEx和GetFinalPathNameByHandle来解析句柄的文件名.但两者都存在,因为在这种情况下,Windows viste和d更好用IFileIsInUse.

检查在Delphi 2007,XE2和Windows XP和7中测试的此示例应用程序.从这里您可以采取一些想法来解决您的问题.

注意:该功能GetProcessIdUsingFile仅比较文件的名称(而不是路径).

{$APPTYPE CONSOLE}


uses
  Windows,
  SysUtils;

const
  SystemHandleInformation = $10;
  STATUS_SUCCESS          = $00000000;
  FileNameInformation     = 9;
  ObjectNameInformation   = 1;

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

 SYSTEM_HANDLE_ARRAY = Array[0..0] of SYSTEM_HANDLE;

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

  NT_STATUS = Cardinal;

  PFILE_NAME_INFORMATION = ^FILE_NAME_INFORMATION;
  FILE_NAME_INFORMATION = packed record
    FileNameLength: ULONG;
    FileName: array [0..MAX_PATH - 1] of WideChar;
  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;

  PIO_STATUS_BLOCK = ^IO_STATUS_BLOCK;
  IO_STATUS_BLOCK = packed record
    Status: NT_STATUS;
    Information: DWORD;
  end;

  PGetFileNameThreadParam = ^TGetFileNameThreadParam;
  TGetFileNameThreadParam = packed record
    hFile    : THandle;
    Result   : NT_STATUS;
    FileName : array [0..MAX_PATH - 1] of AnsiChar;
  end;

  function NtQueryInformationFile(FileHandle: THandle;
    IoStatusBlock: PIO_STATUS_BLOCK; FileInformation: Pointer;
    Length: DWORD; FileInformationClass: DWORD): NT_STATUS;
    stdcall; external 'ntdll.dll';

  function NtQueryObject(ObjectHandle: THandle;
    ObjectInformationClass: DWORD; ObjectInformation: Pointer;
    ObjectInformationLength: ULONG;
    ReturnLength: PDWORD): NT_STATUS; stdcall; external 'ntdll.dll';

  function NtQuerySystemInformation(SystemInformationClass: DWORD; SystemInformation: Pointer; SystemInformationLength: ULONG; ReturnLength: PULONG): NT_STATUS; stdcall; external 'ntdll.dll' name 'NtQuerySystemInformation';


function GetFileNameHandleThr(Data: Pointer): DWORD; stdcall;
var
  dwReturn: DWORD;
  FileNameInfo: FILE_NAME_INFORMATION;
  ObjectNameInfo: TOBJECT_NAME_INFORMATION;
  IoStatusBlock: IO_STATUS_BLOCK;
  pThreadParam: TGetFileNameThreadParam;
begin
  ZeroMemory(@FileNameInfo, SizeOf(FILE_NAME_INFORMATION));
  pThreadParam := PGetFileNameThreadParam(Data)^;
  Result := NtQueryInformationFile(pThreadParam.hFile, @IoStatusBlock,  @FileNameInfo, MAX_PATH * 2, FileNameInformation);
  if Result = STATUS_SUCCESS then
  begin
    Result := NtQueryObject(pThreadParam.hFile, ObjectNameInformation,  @ObjectNameInfo, MAX_PATH * 2, @dwReturn);
    if Result = STATUS_SUCCESS then
    begin
      pThreadParam.Result := Result;
      WideCharToMultiByte(CP_ACP, 0, @ObjectNameInfo.Name.Buffer[ObjectNameInfo.Name.MaximumLength - ObjectNameInfo.Name.Length], ObjectNameInfo.Name.Length, @pThreadParam.FileName[0], MAX_PATH, nil, nil);
    end
    else
    begin
      pThreadParam.Result := STATUS_SUCCESS;
      Result := STATUS_SUCCESS;
      WideCharToMultiByte(CP_ACP, 0, @FileNameInfo.FileName[0], IoStatusBlock.Information, @pThreadParam.FileName[0], MAX_PATH, nil, nil);
    end;
  end;
  PGetFileNameThreadParam(Data)^ := pThreadParam;
  ExitThread(Result);
end;

function GetFileNameHandle(hFile: THandle): String;
var
  lpExitCode: DWORD;
  pThreadParam: TGetFileNameThreadParam;
  hThread: THandle;
begin
  Result := '';
  ZeroMemory(@pThreadParam, SizeOf(TGetFileNameThreadParam));
  pThreadParam.hFile := hFile;
  hThread := CreateThread(nil, 0, @GetFileNameHandleThr, @pThreadParam, 0, PDWORD(nil)^);
  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;

//get the pid of the process which had open the specified file
function GetProcessIdUsingFile(const TargetFileName:string): DWORD;
var
 hProcess    : THandle;
 hFile       : THandle;
 ReturnLength: DWORD;
 SystemInformationLength : DWORD;
 Index       : Integer;
 pHandleInfo : PSYSTEM_HANDLE_INFORMATION;
 hQuery      : THandle;
 FileName    : string;
begin
  Result:=0;
  pHandleInfo      := nil;
  ReturnLength     := 1024;
  pHandleInfo      := AllocMem(ReturnLength);
  hQuery           := NTQuerySystemInformation(DWORD(SystemHandleInformation), pHandleInfo, 1024, @ReturnLength);
  if ReturnLength<>0 then
  begin
    FreeMem(pHandleInfo);
    SystemInformationLength := ReturnLength;
    pHandleInfo             := AllocMem(ReturnLength+1024);
    hQuery                  := NTQuerySystemInformation(DWORD(SystemHandleInformation), pHandleInfo, SystemInformationLength, @ReturnLength);//Get the list of handles
  end
  else
   RaiseLastOSError;

  try
    if(hQuery = STATUS_SUCCESS) then
    begin
      for Index:=0 to pHandleInfo^.uCount-1 do
      if pHandleInfo.Handles[Index].ObjectType=28 then
      begin
        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:='';

          //Writeln(FileName);
           if CompareText(ExtractFileName(FileName), TargetFileName)=0 then
            Result:=pHandleInfo.Handles[Index].uIdProcess;
        end;
      end;
    end;
  finally
   if pHandleInfo<>nil then
     FreeMem(pHandleInfo);
  end;
end;

function SetDebugPrivilege: Boolean;
var
  TokenHandle: THandle;
  TokenPrivileges : TTokenPrivileges;
begin
  Result := false;
  if OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, TokenHandle) then
  begin
    if LookupPrivilegeValue(nil, PChar('SeDebugPrivilege'), TokenPrivileges.Privileges[0].Luid) then
    begin
      TokenPrivileges.PrivilegeCount := 1;
      TokenPrivileges.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
      Result := AdjustTokenPrivileges(TokenHandle, False,
        TokenPrivileges, 0, PTokenPrivileges(nil)^, PDWord(nil)^);
    end;
  end;
end;

begin
  try
   SetDebugPrivilege;
   Writeln('Processing');
   Writeln(GetProcessIdUsingFile('MyFile.txt'));
   Writeln('Done');
  except
    on E:Exception do
      Writeln(E.Classname, ': ', E.Message);
  end;
  Readln;
end.

Run Code Online (Sandbox Code Playgroud)

归档时间：	13 年，8 月前
查看次数：	6955 次
最近记录：	9 年，8 月前