Delphi - finding the process that is accessing a f

Question

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.

Answer 1

You can find a source example for the IFileIsInUse interface by the JEDI project here: 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.

Answer 2

Using NtQuerySystemInformation you can list all opened handles by all the processes then you can use this function to get the file name

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;

If this is your file than raise up a message ...

Answer 3

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.