Delphi - 从程序中查找正在访问文件的进程 [英] Delphi - finding the process that is accessing a file from my program

查看：646
本文介绍了Delphi - 从程序中查找正在访问文件的进程的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！

问题描述

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



在共享时可行我的程序会枚举所有使用的文件句柄，检查文件名，如果它与我的数据文件的名称相匹配，则检索与该句柄相关联的进程名称。


解决方案

你基本上有两种方式



简单方式



如果您使用的是Windows Vista或更高版本，请尝试 IFileIsInUse 界面



难度



如果您需要与Windows XP，Vista，7等兼容的方法。那么您可以使用 NtQuerySystemInformation ， NtQueryInformationFile 和 NtQueryObject 功能。



这些是继续的步骤


  1. 调用传递未记录的 SystemHandleInformation（$ 10）值以获取句柄列表

  2. 然后处理作为文件的句柄列表（仅对于ObjectType = 28）。

  3. 调用OpenProcess with PROCESS_DUP_HANDLE

  4. 然后调用 DuplicateHandle 获取一个实际句柄该文件。

  5. 使用NtQueryInformationFile和NtQueryObject函数获取与句柄相关的文件名。


$ b $注意1：这个方法的棘手部分是解决一个句柄中的文件名。函数 NtQueryInformationFile 挂起在某些情况（系统句柄和其他）一个解决方法，以防止整个应用程序挂起是从单独的线程调用该函数。



注2：存在另一个功能，如 GetFileInformationByHandleEx 和 GetFinalPathNameByHandle 来解析句柄的文件名。但是两者都存在，因为Windows viste在这种情况下更好地使用 IFileIsInUse 。



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



注意：函数 GetProcessIdUsingFile 只比较文件的名称（而不是路径）。 

  {$ APPTYPE CONSOLE} 
 
 
使用
 Windows，
 SysUtils; 
 
 const 
 SystemHandleInformation = $ 10; 
 STATUS_SUCCESS = $ 00000000; 
 FileNameInformation = 9; 
 ObjectNameInformation = 1; 
 
 type 
 SYSTEM_HANDLE =打包记录
 uIdProcess：ULONG; 
 ObjectType：UCHAR; 
标志：UCHAR; 
句柄：Word; 
 pObject：指针; 
 GrantedAccess：ACCESS_MASK; 
结束
 
 SYSTEM_HANDLE_ARRAY = SYSTEM_HANDLE的Array [0..0]; 
 
 SYSTEM_HANDLE_INFORMATION =打包记录
 uCount：ULONG; 
句柄：SYSTEM_HANDLE_ARRAY; 
结束
 PSYSTEM_HANDLE_INFORMATION = ^ SYSTEM_HANDLE_INFORMATION; 
 
 NT_STATUS = Cardinal; 
 
 PFILE_NAME_INFORMATION = ^ FILE_NAME_INFORMATION; 
 FILE_NAME_INFORMATION =打包记录
 FileNameLength：ULONG; 
 FileName：WideChar的数组[0..MAX_PATH  -  1] 
结束
 
 PUNICODE_STRING = ^ TUNICODE_STRING; 
 TUNICODE_STRING =打包记录
长度：WORD; 
 MaximumLength：WORD; 
缓冲区：WideChar的数组[0..MAX_PATH  -  1]; 
结束
 
 POBJECT_NAME_INFORMATION = ^ TOBJECT_NAME_INFORMATION; 
 TOBJECT_NAME_INFORMATION =打包记录
名称：TUNICODE_STRING; 
结束
 
 PIO_STATUS_BLOCK = ^ IO_STATUS_BLOCK; 
 IO_STATUS_BLOCK =打包记录
状态：NT_STATUS; 
信息：DWORD; 
结束
 
 PGetFileNameThreadParam = ^ TGetFileNameThreadParam; 
 TGetFileNameThreadParam =打包记录
 hFile：THandle; 
结果：NT_STATUS; 
文件名：数组[0..MAX_PATH  -  1]的AnsiChar; 
结束
 
函数NtQueryInformationFile（FileHandle：THandle; 
 IoStatusBlock：PIO_STATUS_BLOCK; FileInformation：Pointer; 
长度：DWORD; FileInformationClass：DWORD）：NT_STATUS; 
 stdcall;外部'ntdll.dll'; 
 
函数NtQueryObject（ObjectHandle：THandle; 
 ObjectInformationClass：DWORD; ObjectInformation：Pointer; 
 ObjectInformationLength：ULONG; 
 ReturnLength：PDWORD）：NT_STATUS;标准外部'ntdll.dll'; 
 
函数NtQuerySystemInformation（SystemInformationClass：DWORD; SystemInformation：Pointer; SystemInformationLength：ULONG; ReturnLength：PULONG）：NT_STATUS;标准外部'ntdll.dll'名称'NtQuerySystemInformation'; 
 
 
函数GetFileNameHandleThr（Data：Pointer）：DWORD;标准
 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：= PG​​etFileNameThreadParam（Data）^; 
结果：= NtQueryInformationFile（pThreadParam.hFile，@IoStatusBlock，@FileNameInfo，MAX_PATH * 2，FileNameInformation）; 
如果Result = STATUS_SUCCESS然后
 begin 
结果：= 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; 
结果：= STATUS_SUCCESS; 
 WideCharToMultiByte（CP_ACP，0，@ FileNameInfo.FileName [0]，IoStatusBlock.Information，@ pThreadParam.FileName [0]，MAX_PATH，nil，nil）; 
结束
结束
 PGetFileNameThreadParam（Data）^：= pThreadParam; 
退出线程（Result）; 
结束
 
函数GetFileNameHandle（hFile：THandle）：String; 
 var 
 lpExitCode：DWORD; 
 pThreadParam：TGetFileNameThreadParam; 
 hThread：THandle; 
 begin 
结果：=''; 
 ZeroMemory（@pThreadParam，SizeOf（TGetFileNameThreadParam））; 
 pThreadParam.hFile：= hFile; 
 hThread：= CreateThread（nil，0，@GetFileNameHandleThr，@pThreadParam，0，PDWORD（nil）^）; 
如果hThread<> 0然后
尝试
 case 
 WAIT_OBJECT_0的WaitForSingleObject（hThread，100）：
 begin 
 GetExitCodeThread（hThread，lpExitCode）; 
如果lpExitCode = STATUS_SUCCESS然后
结果：= pThreadParam.FileName; 
结束
 WAIT_TIMEOUT：
 TerminateThread（hThread，0）; 
结束
 finally 
 CloseHandle（hThread）; 
结束
结束
 
 //获取已打开指定文件的进程的pid 
函数GetProcessIdUsingFile（const TargetFileName：string）：DWORD; 
 var 
 hProcess：THandle; 
 hFile：THandle; 
 ReturnLength：DWORD; 
 SystemInformationLength：DWORD; 
索引：整数; 
 pHandleInfo：PSYSTEM_HANDLE_INFORMATION; 
 hQuery：THandle; 
 FileName：string; 
开始
结果：= 0; 
 pHandleInfo：= nil; 
 ReturnLength：= 1024; 
 pHandleInfo：= AllocMem（ReturnLength）; 
 hQuery：= NTQuerySystemInformation（DWORD（SystemHandleInformation），pHandleInfo，1024，@ReturnLength）; 
如果ReturnLength<> 0则
 begin 
 FreeMem（pHandleInfo）; 
 SystemInformationLength：= ReturnLength; 
 pHandleInfo：= AllocMem（ReturnLength + 1024）; 
 hQuery：= NTQuerySystemInformation（DWORD（SystemHandleInformation），pHandleInfo，SystemInformationLength，@ReturnLength）; //获取句柄列表
 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 
如果不是DuplicateHandle（hProcess，pHandleInfo.Handles [Index] .Handle，GetCurrentProcess（），@hFile， 0，FALSE，DUPLICATE_SAME_ACCESS）然后
 hFile：= INVALID_HANDLE_VALUE; 
 finally 
 CloseHandle（hProcess）; 
结束
 
 if（hFile<> INVALID_HANDLE_VALUE）then 
 begin 
 try 
 FileName：= GetFileNameHandle（hFile）; 
 finally 
 CloseHandle（hFile）; 
结束
 end 
 else 
 FileName：=''; 
 
 // Writeln（FileName）; 
如果CompareText（ExtractFileName（FileName），TargetFileName）= 0 then 
结果：= pHandleInfo.Handles [Index] .uIdProcess; 
结束
结束
结束
 finally 
如果pHandleInfo<> nil then 
 FreeMem（pHandleInfo）; 
结束
结束
 
函数SetDebugPrivilege：Boolean; 
 var 
 TokenHandle：THandle; 
 TokenPrivileges：TTokenPrivileges; 
 begin 
结果：= false; 
如果OpenProcessToken（GetCurrentProcess（），TOKEN_ADJUST_PRIVILEGES或TOKEN_QUERY，TokenHandle）然后
 begin 
如果LookupPrivilegeValue（nil，PChar（'SeDebugPrivilege'），TokenPrivileges.Privileges [0] .Luid）then 
 begin 
 TokenPrivileges.PrivilegeCount：= 1; 
 TokenPrivileges.Privileges [0] .Attributes：= SE_PRIVILEGE_ENABLED; 
结果：= AdjustTokenPrivileges（TokenHandle，False，
 TokenPrivileges，0，PTokenPrivileges（nil）^，PDWord（nil）^）; 
结束
结束
结束
 
 begin 
 try 
 SetDebugPrivilege; 
 Writeln（'Processing'）; 
 Writeln（GetProcessIdUsingFile（'MyFile.txt'））; 
 Writeln（'Done'）; 
除了
在E：Exception do 
 Writeln（E.Classname，'：'，E.Message）; 
结束
 Readln; 
结束。


I have a Delphi app that regularly writes to a local disk file. Occasionally it is unable to access the file - a sharing violation results when it tries to open it. A retry after a short delay is all that is needed, but when it occurs, I would like to report the process that prevented the access.

Is it feasible when a sharing violation occurs for my program to enumerate all the file handles in use, inspect the filename, and if it matches the name of my data file, retrieves the process name associated with that handle?

Some example code would be nice.

解决方案

You have basically two ways

The Easy Way

if you are using Windows Vista or newer try the IFileIsInUse interface

The Hard Way

if you need a method compatible with Windows XP,Vista,7 and so on. then you use the NtQuerySystemInformation, NtQueryInformationFile and NtQueryObject functions.

These are the steps to proceed

  1. Call the NTQuerySystemInformation passing the undocumented SystemHandleInformation ($10) value to get the list of handles
  2. then process the list of handles (only for ObjectType = 28) which are files.
  3. call OpenProcess with PROCESS_DUP_HANDLE
  4. then call DuplicateHandle for get a real handle to the file.
  5. get the name of the filename asociated to the handle using the NtQueryInformationFile and NtQueryObject functions.

Note 1 : the tricky part of this method is resolve the filename based in a handle. the function NtQueryInformationFile hangs in some scenarios (system handles and others) a workaround to prevent the entire application from hanging is call the function from a separate thread.

Note 2 : exist another functions like GetFileInformationByHandleEx and GetFinalPathNameByHandle to resolve the filename of a handle. but both exist since Windows viste an d in such case is better use IFileIsInUse.

Check this sample application tested in Delphi 2007, XE2 and Windows XP and 7. from here you can take some ideas to resolve your issue.

Note : The function GetProcessIdUsingFile Only compares the name of the files (not the path). 

{$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.

这篇关于Delphi - 从程序中查找正在访问文件的进程的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！

查看全文
相关文章
Delphi最新文章
热门教程
热门工具
登录 关闭
扫码关注1秒登录
发送“验证码”获取 | 15天全站免登陆