Search code examples
delphiprocesswmidelphi-2006filehandle

Delphi - finding the process that is accessing a file from my program


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.


Solution

  • 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.