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

查看：10 发布时间：2022/1/2 19:34:51 delphi process wmi delphi-2006 filehandle

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

问题描述

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

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

一些示例代码会很好.

解决方案

你基本上有两种方式

简单的方法

如果您使用的是 Windows Vista 或更新版本，请尝试 IFileIsInUse 接口

艰难之路

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

这些是继续的步骤

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

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

注意 2:存在其他函数，如 GetFileInformationByHandleEx 和 GetFinalPathNameByHandle 解析句柄的文件名.但两者都存在，因为在这种情况下，Windows viste 和 d 最好使用 IFileIsInUse.

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

注意:GetProcessIdUsingFile 函数只比较文件名(不是路径).

{$APPTYPE 控制台}用途视窗，系统实用程序；常量SystemHandleInformation = $10;STATUS_SUCCESS = $00000000；文件名信息 = 9;对象名称信息 = 1;类型SYSTEM_HANDLE=打包记录uIdProcess:ULONG;对象类型:UCHAR；标志 :UCHAR;句柄:字；pObject:指针；授予访问权限:ACCESS_MASK；结尾;SYSTEM_HANDLE_ARRAY = SYSTEM_HANDLE 的数组[0..0]；SYSTEM_HANDLE_INFORMATION=打包记录uCount:ULONG;句柄:SYSTEM_HANDLE_ARRAY；结尾;PSYSTEM_HANDLE_INFORMATION=^SYSTEM_HANDLE_INFORMATION;NT_STATUS = 红衣主教；PFILE_NAME_INFORMATION = ^FILE_NAME_INFORMATION;FILE_NAME_INFORMATION = 打包记录文件名长度:ULONG；文件名:WideChar 的数组 [0..MAX_PATH - 1]；结尾;PUNICODE_STRING = ^TUNICODE_STRING;TUNICODE_STRING = 压缩记录长度:字；最大长度:字；缓冲区: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;文件名:AnsiChar 的数组 [0..MAX_PATH - 1]；结尾;函数 NtQueryInformationFile(FileHandle: THandle;IoStatusBlock: PIO_STATUS_BLOCK;文件信息:指针；长度:双字；FileInformationClass: DWORD): NT_STATUS;标准调用；外部'ntdll.dll';函数 NtQueryObject(ObjectHandle: THandle;对象信息类:DWORD；对象信息:指针；对象信息长度: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;标准调用；无功dwReturn: DWORD;文件名信息:FILE_NAME_INFORMATION；对象名称信息:TOBJECT_NAME_INFORMATION；IoStatusBlock: IO_STATUS_BLOCK;pThreadParam: TGetFileNameThreadParam;开始ZeroMemory(@FileNameInfo, SizeOf(FILE_NAME_INFORMATION));pThreadParam := PGetFileNameThreadParam(Data)^;结果 := NtQueryInformationFile(pThreadParam.hFile, @IoStatusBlock, @FileNameInfo, MAX_PATH * 2, FileNameInformation);如果结果 = STATUS_SUCCESS 那么开始结果:= NtQueryObject(pThreadParam.hFile, ObjectNameInformation, @ObjectNameInfo, MAX_PATH * 2, @dwReturn);如果结果 = STATUS_SUCCESS 那么开始pThreadParam.Result := 结果;WideCharToMultiByte(CP_ACP, 0, @ObjectNameInfo.Name.Buffer[ObjectNameInfo.Name.MaximumLength - ObjectNameInfo.Name.Length], ObjectNameInfo.Name.Length, @pThreadParam.FileName[0], MAX_PATH, nil, nil);结尾别的开始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;退出线程(结果)；结尾;函数 GetFileNameHandle(hFile: THandle): String;无功lpExitCode:双字；pThreadParam: TGetFileNameThreadParam;hThread:THandle；开始结果:= '';ZeroMemory(@pThreadParam, SizeOf(TGetFileNameThreadParam));pThreadParam.hFile := hFile;hThread := CreateThread(nil, 0, @GetFileNameHandleThr, @pThreadParam, 0, PDWORD(nil)^);如果 hThread <>0 那么尝试案例 WaitForSingleObject(hThread, 100) 的等待_对象_0:开始GetExitCodeThread(hThread, lpExitCode);如果 lpExitCode = STATUS_SUCCESS 那么结果:= pThreadParam.FileName;结尾;等待_超时:TerminateThread(hThread, 0);结尾;最后关闭句柄(hThread)；结尾;结尾;//获取打开指定文件的进程的pid函数 GetProcessIdUsingFile(const TargetFileName:string): DWORD;无功hProcess : THandle;hFile : THandle;返回长度:DWORD；系统信息长度:DWORD；索引:整数；pHandleInfo : PSYSTEM_HANDLE_INFORMATION;hQuery : THandle;文件名:字符串；开始结果:=0；pHandleInfo := nil;返回长度:= 1024；pHandleInfo := AllocMem(ReturnLength);hQuery := NTQuerySystemInformation(DWORD(SystemHandleInformation), pHandleInfo, 1024, @ReturnLength);如果 ReturnLength<>0 那么开始FreeMem(pHandleInfo);SystemInformationLength := ReturnLength;pHandleInfo := AllocMem(ReturnLength+1024);hQuery := NTQuerySystemInformation(DWORD(SystemHandleInformation), pHandleInfo, SystemInformationLength, @ReturnLength);//获取句柄列表结尾别的引发LastOSError；尝试如果(hQuery = STATUS_SUCCESS)那么开始对于 Index:=0 到 pHandleInfo^.uCount-1 做如果 pHandleInfo.Handles[Index].ObjectType=28 那么开始hProcess := OpenProcess(PROCESS_DUP_HANDLE, FALSE, pHandleInfo.Handles[Index].uIdProcess);if(hProcess <> INVALID_HANDLE_VALUE) 那么开始尝试如果不是 DuplicateHandle(hProcess, pHandleInfo.Handles[Index].Handle,GetCurrentProcess(), @hFile, 0 ,FALSE, DUPLICATE_SAME_ACCESS) 然后hFile := INVALID_HANDLE_VALUE;最后CloseHandle(hProcess);结尾;如果 (hFile<>INVALID_HANDLE_VALUE) 那么开始尝试文件名:=GetFileNameHandle(hFile);最后关闭句柄(hFile)；结尾;结尾别的文件名:='';//Writeln(文件名);如果 CompareText(ExtractFileName(FileName), TargetFileName)=0 那么结果:=pHandleInfo.Handles[Index].uIdProcess;结尾;结尾;结尾;最后如果 pHandleInfo<>nil 那么FreeMem(pHandleInfo);结尾;结尾;函数 SetDebugPrivilege:布尔值；无功令牌句柄:T句柄；TokenPrivileges : TTokenPrivileges;开始结果:=假；如果 OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES 或 TOKEN_QUERY, TokenHandle) 然后开始如果 LookupPrivilegeValue(nil, PChar('SeDebugPrivilege'), TokenPrivileges.Privileges[0].Luid) 然后开始TokenPrivileges.PrivilegeCount := 1;TokenPrivileges.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;结果 := AdjustTokenPrivileges(TokenHandle, False,TokenPrivileges, 0, PTokenPrivileges(nil)^, PDWord(nil)^);结尾;结尾;结尾;开始尝试设置调试权限；Writeln('处理');Writeln(GetProcessIdUsingFile('MyFile.txt'));Writeln('完成');除了在 E:Exception 上做Writeln(E.Classname, ':', E.Message);结尾;读入；结尾.

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

Call the NTQuerySystemInformation passing the undocumented SystemHandleInformation ($10) value to get the list of handles
then process the list of handles (only for ObjectType = 28) which are files.
call OpenProcess with PROCESS_DUP_HANDLE
then call DuplicateHandle for get a real handle to the file.
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 - 查找从我的程序访问文件的进程 [英] Delphi - finding the process that is accessing a file from my program

问题描述

相关文章

其他开发最新文章

热门教程

热门工具

登录关闭

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

问题描述

相关文章

其他开发最新文章

热门教程

热门工具

登录 关闭

登录关闭