Delphi - поиск процесса, который обращается к файлу из моей программы - PullRequest
14 голосов
/ 04 января 2012

У меня есть приложение Delphi, которое регулярно пишет в файл на локальном диске. Иногда он не может получить доступ к файлу - возникает нарушение совместного доступа при попытке открыть его. Все, что нужно, это повторить попытку после небольшой задержки, но когда это произойдет, я хотел бы сообщить о процессе, который препятствовал доступу.

Возможно ли, когда в моей программе возникает нарушение совместного доступа, чтобы перечислить все используемые файловые дескрипторы, проверить имя файла и, если оно совпадает с именем моего файла данных, извлечь имя процесса, связанное с этим дескриптором?

Какой-нибудь пример кода был бы хорош.

Ответы [ 3 ]

12 голосов
/ 05 января 2012

У вас есть два основных способа:

Простой способ

, если вы используете Windows Vista или новее, попробуйте IFileIsInUse интерфейс

Трудный путь

, если вам нужен метод, совместимый с Windows XP, Vista, 7 и так далее.затем вы используете функции NtQuerySystemInformation , NtQueryInformationFile и NtQueryObject .

Это шаги для выполнения

  1. Вызовите NTQuerySystemInformation, передав недокументированное значение SystemHandleInformation ($ 10) , чтобы получить список дескрипторов
  2. , затем обработайте список дескрипторов (только для ObjectType = 28), которые являются файлами.
  3. вызовите OpenProcess с помощью PROCESS_DUP_HANDLE
  4. , затем вызовите DuplicateHandle для получения дескриптора real для файла.
  5. получите имя файла, связанного с дескрипторомиспользуя функции NtQueryInformationFile и NtQueryObject.

Примечание 1. Сложной частью этого метода является определение имени файла на основе дескриптора.функция NtQueryInformationFile в некоторых случаях зависает (системные дескрипторы и т. д.). Обходной путь для предотвращения зависания всего приложения - вызов функции из отдельного потока.

Примечание 2: существуют другие функции, такие как GetFileInformationByHandleEx и GetFinalPathNameByHandle для разрешения имени файла дескриптора.но оба они существуют, поскольку Windows Vista и 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.
2 голосов
/ 04 января 2012

Используя NtQuerySystemInformation, вы можете перечислить все открытые дескрипторы по всем процессам, затем вы можете использовать эту функцию, чтобы получить имя файла

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

function GetFileNameFromHandle(const hFile: THandle): string;
var
  IO_STATUSBLOCK:IO_STATUS_BLOCK;
  FileNameInfo:FILE_NAME_INFORMATION;
  szFile:String;
begin
  FillChar(FileNameInfo.FileName,SizeOf(FileNameInfo.FileName),0);
  NtQueryInformationFile(hFile,@IO_STATUSBLOCK,@FileNameInfo,500,9);
  szFile:=WideCharToString(FileNameInfo.fileName);
  CloseHandle(hFile);
  Result:=szFile;
end;

Если это ваш файл, то вызовите сообщение ...

0 голосов
/ 31 декабря 2015

Исходный пример для интерфейса IFileIsInUse можно найти в проекте JEDI здесь: https://svn.code.sf.net/p/jedi-apilib/code/jwapi/trunk/Examples/FileIsInUse/Client/FileIsInUseClientExample.dpr

{******************************************************************************}
{ JEDI FileIsInUse Example Project                                             }
{ http://jedi-apilib.sourceforge.net                                           }
{                                                                              }
{ Obtained through: Joint Endeavour of Delphi Innovators (Project JEDI)        }
{                                                                              }
{ Author(s): Christian Wimmer                                                  }
{                                                                              }
{ Description: Shows how to use the IFileIsInUse API                           }
{                                                                              }
{ Preparations: JWA must be ready to use.                                      }
{               Requires at least Windows Vista                                }
{                                                                              }
{ Version history: 14th November 2010 initial release                          }
{                                                                              }
{ No license. Use this example with no warranty at all and on your own risk.   }
{ This example is just for learning purposes and should not be used in         }
{ productive environments.                                                     }
{ The code has surely some errors that need to be fixed. In such a case        }
{ you can contact the author(s) through the JEDI API hompage, the mailinglist  }
{ or via the article link.                                                     }
{                                                                              }
{******************************************************************************}
program FileIsInUseClientExample;


{Define this switch to use the definition of the IFileIsInUse interface from
 the JEDI API units.
 Undefine it, to use it from the file here.
}
{.$DEFINE JWA_BUILTIN_IFILEISINUSE}

uses
  ComObj,
  ActiveX,
  SysUtils,
  JwaWinType,
  JwaWinUser
{$IFDEF JWA_BUILTIN_IFILEISINUSE}
  ,JwaShlObj
{$ENDIF JWA_BUILTIN_IFILEISINUSE}
  ;

{$IFNDEF JWA_BUILTIN_IFILEISINUSE}
{$ALIGN 4}
const
  IID_IFileIsInUse: TGUID = (
    D1:$64a1cbf0; D2:$3a1a; D3:$4461; D4:($91,$58,$37,$69,$69,$69,$39,$50));

type
  tagFILE_USAGE_TYPE = (
    FUT_PLAYING = 0,
    FUT_EDITING = 1,
    FUT_GENERIC = 2
  );
  FILE_USAGE_TYPE = tagFILE_USAGE_TYPE;
  TFileUsageType = FILE_USAGE_TYPE;

const
  OF_CAP_CANSWITCHTO     = $0001;
  OF_CAP_CANCLOSE        = $0002;

type
  IFileIsInUse = interface(IUnknown)
    ['{64a1cbf0-3a1a-4461-9158-376969693950}']
    function GetAppName(out ppszName: LPWSTR) : HRESULT; stdcall;
    function GetUsage(out pfut : FILE_USAGE_TYPE) : HRESULT; stdcall;
    function GetCapabilities(out pdwCapFlags : DWORD) : HRESULT; stdcall;
    function GetSwitchToHWND(out phwnd : HWND) : HRESULT; stdcall;
    function CloseFile() : HRESULT; stdcall;
  end;
{$ENDIF JWA_BUILTIN_IFILEISINUSE}

function GetFileInUseInfo(const FileName : WideString) : IFileIsInUse;
var
  ROT : IRunningObjectTable;
  mFile, enumIndex, Prefix : IMoniker;
  enumMoniker : IEnumMoniker;
  MonikerType : LongInt;
  unkInt  : IInterface;
  ctx : IBindCtx;
  sEnumIndex, sFile : PWideChar;
begin
  result := nil;
  OleCheck(CreateBindCtx(0, ctx));

  //
  OleCheck(GetRunningObjectTable(0, ROT));
  OleCheck(CreateFileMoniker(PWideChar(FileName), mFile));

  OleCheck(ROT.EnumRunning(enumMoniker));

  while (enumMoniker.Next(1, enumIndex, nil) = S_OK) do
  begin
    OleCheck(enumIndex.IsSystemMoniker(MonikerType));
    if MonikerType = MKSYS_FILEMONIKER then
    begin
      OleCheck((EnumIndex as IMoniker).GetDisplayName(ctx, nil, sEnumIndex));

      sFile := CoTaskMemAlloc(MAX_PATH);
      OleCheck(mFile.GetDisplayName(ctx, nil, sFile));

      if Succeeded(mFile.CommonPrefixWith(enumIndex, Prefix)) and
         (mFile.IsEqual(Prefix) = S_OK) then
      begin
        if Succeeded(ROT.GetObject(enumIndex, unkInt)) then
        begin
          if Succeeded(unkInt.QueryInterface(IID_IFileIsInUse, result)) then
          begin
            result := unkInt as IFileIsInUse;
            exit;
          end;
        end;
      end;
    end;
  end;
end;

const
  TFileUsageTypeStr : array[TFileUsageType] of String = (
    'FUT_PLAYING (0)',
    'FUT_EDITING (1)',
    'FUT_GENERIC (2)');

  CapStr : array[1..3] of String = (
    'OF_CAP_CANSWITCHTO ($0001)',
    'OF_CAP_CANCLOSE ($0002)',
    'OF_CAP_CANSWITCHTO ($0001) or OF_CAP_CANCLOSE ($0002)'
  );


var
  FileInUse : IFileIsInUse;
  pAppName : PWidechar;
  Usage : TFileUsageType;
  Caps : Cardinal;
  WindowHandle : HWND;
  Msg, S : String;
  Buttons : Integer;
begin
  CoInitialize(nil);

  if not FileExists(ParamStr(1)) then
  begin
    MessageBox(0, 'Missing filename as command line parameter', '', MB_ICONERROR or MB_OK);
    exit;
  end;

  FileInUse := GetFileInUseInfo(ParamStr(1));

  if Assigned(FileInUse) then
  begin
    OleCheck(FileInUse.GetAppName(pAppName));
    OleCheck(FileInUse.GetUsage(Usage));
    OleCheck(FileInUse.GetCapabilities(Caps));
    OleCheck(FileInUse.GetSwitchToHWND(WindowHandle));

    Buttons := MB_OK;

    if (Caps and OF_CAP_CANSWITCHTO = OF_CAP_CANSWITCHTO) then
    begin
      Msg := 'YES = Switch to Window? NO = Send close file; Cancel= Do nothing';
      Buttons := MB_YESNOCANCEL;
    end;


    S := Format('AppName: %s'#13#10'Usage: %s'#13#10'Caps: %s'#13#10'Hwnd: %d'#13#10+Msg,
      [WideString(pAppName), TFileUsageTypeStr[Usage], CapStr[Caps], WindowHandle]);

    case MessageBox(0, PChar(S), '', MB_ICONINFORMATION or Buttons) of
      IDYES:
      begin
        SetForegroundWindow(WindowHandle);
        Sleep(2000); //allows the window to be displayed in front; otherwise IDE will be shown
      end;
      IDNO:
      begin
        OleCheck(FileInUse.CloseFile);
      end;
    end;

    CoTaskMemFree(pAppName);
  end;
end.
...