2012-01-04 34 views
14

Tôi có một ứng dụng Delphi thường xuyên ghi vào một tệp đĩa cục bộ. Thỉnh thoảng nó không thể truy cập tập tin - một kết quả vi phạm chia sẻ khi nó cố gắng mở nó. Việc thử lại sau một thời gian trễ ngắn là tất cả những gì cần thiết, nhưng khi nó xảy ra, tôi muốn báo cáo quá trình ngăn chặn truy cập. Có khả thi khi vi phạm chia sẻ xảy ra cho chương trình liệt kê tất cả các tập tin đang sử dụng, kiểm tra tên tệp và nếu nó khớp với tên tệp dữ liệu của tôi, hãy truy xuất tên quy trình được liên kết với bộ xử lý đó không? Không, có phải không?Delphi - tìm quá trình đang truy cập tệp từ chương trình của tôi

Một số mã mẫu sẽ đẹp.

+1

Bạn có thể làm điều này với WMI và 'cim_datafile' Tôi tin. Nhưng tôi không biết gì về WMI. Tuy nhiên, tôi hy vọng rằng một trong những chuyên gia khác ở đây có chuyên môn về WMI sẽ có thể giúp bạn! –

+3

Phiên bản Windows nào bạn cần hỗ trợ? Nếu Windows Vista sau đó nhìn vào ['bài đăng này'] (http://blog.delphi-jedi.net/2010/11/14/is-file-in-use/), nó sử dụng [' IFileIsInUse'] (http://msdn.microsoft.com/en-us/library/bb775874%28VS.85%29.aspx) giao diện. – TLama

+0

Chúng tôi sử dụng http://technet.microsoft.com/en-us/sysinternals/bb896655 trong phần mềm của chúng tôi. Quá trình có tệp được sử dụng được ghi lại bằng cách sử dụng thông tin từ handle.exe là một công cụ miễn phí của SysInternals (hiện thuộc sở hữu của Microsoft). –

Trả lời

11

Bạn có về cơ bản hai cách

The Easy Way

nếu bạn đang sử dụng Windows Vista hoặc mới hơn thử giao diện IFileIsInUse

The Way cứng

nếu bạn cần một phương pháp tương thích với Windows XP, Vista, 7 và vân vân. sau đó bạn sử dụng các hàm NtQuerySystemInformation, NtQueryInformationFileNtQueryObject.

Đây là các bước để tiến hành

  1. Gọi NTQuerySystemInformation đi qua các giá trị không có giấy tờ SystemHandleInformation ($10) để có được danh sách các tay cầm
  2. sau đó xử lý danh sách các xử lý (chỉ dành cho ObjectType = 28) mà là các tập tin.
  3. gọi OpenProcess với PROCESS_DUP_HANDLE
  4. rồi gọi để nhận số real xử lý tệp.
  5. lấy tên của tên tệp được liên kết với tay cầm bằng các hàm NtQueryInformationFile và NtQueryObject.

Lưu ý 1: phần phức tạp của phương pháp này là giải quyết tên tệp dựa trên tay cầm. chức năng NtQueryInformationFile treo trong một số tình huống (xử lý hệ thống và những người khác) một cách giải quyết để ngăn chặn toàn bộ ứng dụng bị treo là gọi hàm từ một chuỗi riêng biệt.

Lưu ý 2: tồn tại các chức năng khác như GetFileInformationByHandleExGetFinalPathNameByHandle để giải quyết tên tệp của tay cầm. nhưng cả hai tồn tại kể từ khi Windows viste một d trong trường hợp như vậy là sử dụng tốt hơn IFileIsInUse.

Kiểm tra ứng dụng mẫu này được thử nghiệm trong Delphi 2007, XE2 và Windows XP và 7. từ đây bạn có thể thực hiện một số ý tưởng để giải quyết vấn đề của mình.

Lưu ý: Chức năng GetProcessIdUsingFile Chỉ so sánh tên của tệp (không phải đường dẫn).

{$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

Tuyên bố của API NtXXX đã có trong Jedi ApiLib (JwaNative.pas) ... – Remko

+0

Cảm ơn @RRUZ cho một câu trả lời rất hoàn chỉnh. Nền tảng này là XP và W7. Tôi biên soạn mã cho và trong khi nó hoạt động, tôi nghi ngờ tôi không thể làm những gì tôi muốn bởi vì khả năng chậm trễ trong quét các xử lý có nghĩa là quá trình vi phạm có thể sẽ kết thúc với các tập tin và lâu rồi. Tôi thử lại sau khi bị trễ 50mS khi tôi nhận được vi phạm chia sẻ và trong hầu hết các trường hợp, lần thử thứ hai thành công. Ban đầu của tôi chơi xung quanh với mã được cung cấp cho thấy sự chậm trễ theo thứ tự của giây để quét danh sách các xử lý. – rossmcm

2

Sử dụng NtQuerySystemInformation bạn có thể liệt kê tất cả các xử lý được mở bởi tất cả các quá trình sau đó bạn có thể sử dụng chức năng này để có được những tên file

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; 

Nếu đây là tập tin của bạn hơn dấy lên một tin nhắn ...

+0

Lớp thông tin hệ thống nào sẽ làm cho NtQuerySystemInformation cho chúng ta biết các xử lý của tất cả các tiến trình khác? Tôi chỉ thấy một tệp sẽ cho chúng ta biết nhiều * xử lý từng quá trình. –

+2

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

+0

@ opc0de +1 cho liên kết diễn đàn SysInternals – rossmcm

0

Bạn có thể tìm thấy một ví dụ nguồn cho giao diện IFileIsInUse bởi dự án JEDI ở đây: 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. 
Các vấn đề liên quan