Delphi – 从程序中查找正在访问文件的进程

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

当我的程序枚举所有使用的文件句柄,检查文件名,如果它与我的数据文件的名称匹配时,是否可行,检索与该句柄相关联的进程名称？

一些示例代码会很好

解决方法

你基本上有两种方法

简单的方法

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

硬的方式

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

这些是继续进行的步骤

>调用NTQuerySystem information传递未记录的SystemHandleInformation ($10)值以获取句柄列表
>然后处理这些文件的列表(仅对于ObjectType = 28).
>使用PROCESS_DUP_HANDLE调用OpenProcess
>然后调用 DuplicateHandle 获取文件的真正句柄.
>使用NtQueryinformationFile和NtQueryObject函数获取与句柄相关的文件名的名称.

注1：该方法的棘手部分是解决基于句柄的文件名.函数NtQueryinformationFile在某些情况下挂起(系统句柄和其他),以防止整个应用程序挂起的方法是从单独的线程调用该函数.

注2：存在另一个功能,如GetFileInformationByHandleEx和GetFinalPathNameByHandle来解析句柄的文件名.但是两者都存在,因为Windows viste在这种情况下更好地使用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,@dwReturn);
    if Result = STATUS_SUCCESS then
    begin
      pThreadParam.Result := Result;
      WideCharToMultiByte(CP_ACP,@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,@FileNameInfo.FileName[0],IoStatusBlock.information,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,@GetFileNameHandleThr,@pThreadParam,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),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,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,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.

原文地址：https://www.jb51.cc/delphi/102722.html

Delphi – 从程序中查找正在访问文件的进程

解决方法

相关推荐