2012-01-04 20 views
14

Tengo una aplicación Delphi que escribe regularmente en un archivo de disco local. Ocasionalmente, no puede acceder al archivo; se produce una infracción de uso compartido cuando intenta abrirlo. El reintento después de un breve retraso es todo lo que se necesita, pero cuando ocurre, me gustaría informar el proceso que impidió el acceso.Delphi: encontrar el proceso que está accediendo a un archivo de mi programa

¿Es factible cuando se produce una infracción de uso compartido para mi programa enumerar todos los identificadores de archivo en uso, inspeccionar el nombre de archivo y si coincide con el nombre de mi archivo de datos, recupera el nombre de proceso asociado con ese identificador?

Algún código de ejemplo sería bueno.

+1

Usted puede hacer esto con WMI y 'cim_datafile' creo. Pero no sé nada sobre WMI. Sin embargo, ¡tengo la esperanza de que uno de los otros expertos aquí que tiene una especialidad en WMI pueda ayudarte! –

+3

¿Qué versión de Windows necesita para ser compatible? Si Windows Vista arriba mira ['this post'] (http://blog.delphi-jedi.net/2010/11/14/is-file-in-use/), usa el [' IFileIsInUse'] (http://msdn.microsoft.com/en-us/library/bb775874%28VS.85%29.aspx) interfaz. – TLama

+0

Usamos http://technet.microsoft.com/en-us/sysinternals/bb896655 en nuestro software. El proceso que tiene el archivo en uso se registra utilizando la información de handle.exe que es una herramienta gratuita de SysInternals (ahora propiedad de Microsoft). –

Respuesta

11

Usted tiene básicamente dos maneras

la manera fácil

si está usando Windows Vista o posterior probar la interfaz de IFileIsInUse

la manera dura

si necesita un método compatible con Windows XP, Vista, 7 y así sucesivamente. luego usa las funciones NtQuerySystemInformation, NtQueryInformationFile y NtQueryObject.

Estos son los pasos para proceder

  1. Llame al NtQuerySystemInformation pasando el valor indocumentado SystemHandleInformation ($10) para obtener la lista de identificadores
  2. luego procesar la lista de identificadores (sólo para ObjectType = 28), que son archivos.
  3. llamada OpenProcess con PROCESS_DUP_HANDLE
  4. DuplicateHandle luego llamar para conseguir una manija real al archivo.
  5. obtenga el nombre del archivo asociado al identificador utilizando las funciones NtQueryInformationFile y NtQueryObject.

Nota 1: la parte engañosa de este método es resolver el nombre del archivo en un identificador. la función NtQueryInformationFile se cuelga en algunos escenarios (manejadores del sistema y otros) una solución para evitar que toda la aplicación se cuelgue es llamar a la función desde un hilo separado.

Nota 2: existen otras funciones como GetFileInformationByHandleEx y GetFinalPathNameByHandle para resolver el nombre de archivo de un identificador. pero ambos existen desde Windows viste y en tal caso es mejor usar IFileIsInUse.

Compruebe esta aplicación de muestra probada en Delphi 2007, XE2 y Windows XP y 7. desde aquí puede tomar algunas ideas para resolver su problema.

Nota: La función GetProcessIdUsingFile solo compara el nombre de los archivos (no la ruta).

{$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. 
+0

Las declaraciones de las API de NtXXX ya están en Jedi ApiLib (JwaNative.pas) ... – Remko

+0

Gracias @RRUZ para una respuesta muy completa. La plataforma es XP y W7. Recopilé el código dado y mientras funciona, sospecho que no puedo hacer lo que quiero porque la posible demora en el escaneo de los identificadores significa que el proceso ofensivo probablemente habrá terminado con el archivo y desaparecido. Vuelvo a intentar después de una demora de 50 ms cuando recibo la infracción de uso compartido y en la mayoría de los casos el segundo intento es exitoso. Mi primer juego con el código suministrado sugiere demoras en el orden de segundos para escanear la lista de identificadores. – rossmcm

2

Usando NtQuerySystemInformation puede listar todos los identificadores abiertos por todos los procesos, puede utilizar esta función para obtener el nombre del archivo

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; 

Si este es el archivo que levantará un mensaje ...

+0

¿Qué clase de información del sistema hará que NtQuerySystemInformation nos diga los identificadores de todos los demás procesos? Solo veo el que nos dirá * cómo muchos * identificadores tienen cada proceso. –

+2

@RobKennedy http://forum.sysinternals.com/howto-enumerate-handles_topic18892.html – opc0de

+0

@ opc0de +1 para el enlace del foro SysInternals – rossmcm

0

Usted puede encontrar una fuente de ejemplo para la interfaz IFileIsInUse por el proyecto JEDI aquí: 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. 
Cuestiones relacionadas