Delphi - 查找正在从我的程序访问文件的进程
Posted
技术标签:
【中文标题】Delphi - 查找正在从我的程序访问文件的进程【英文标题】：Delphi - finding the process that is accessing a file from my program 【发布时间】：2012-02-02 08:33:48 【问题描述】：我有一个定期写入本地磁盘文件的 Delphi 应用程序。有时它无法访问该文件 - 当它试图打开它时会导致共享冲突。只需要在短暂延迟后重试，但当它发生时，我想报告阻止访问的进程。
当我的程序发生共享冲突时，是否可以枚举所有正在使用的文件句柄，检查文件名，如果它与我的数据文件的名称匹配，则检索与该句柄关联的进程名称是否可行？
一些示例代码会很好。
【问题讨论】：
我相信你可以使用 WMI 和cim_datafile 做到这一点。但我对WMI一无所知。但是，我希望这里的其他一位专攻 WMI 的专家能够为您提供帮助！
您需要支持什么版本的Windows？如果 Windows Vista 启动然后查看this post，它使用IFileIsInUse 接口。
我们在我们的软件中使用technet.microsoft.com/en-us/sysinternals/bb896655。使用来自 SysInternals（现在归 Microsoft）的免费工具 handle.exe 的信息记录使用该文件的进程。
@TLama - Google 提供帮助，您可以轻松找到旧 sysinternals.org 站点副本的下载链接。例如，这个 torrent 文件：sysinternals.kompjoefriek.nl/sysinternals_site_rip.7z.torrent（2006 年 7 月 18 日）。不幸的是 Handle.exe 实用程序没有源代码。
@DavidHeffernan cim_datafile WMI 类，不提供此信息，据我所知，使用 WMI 不可能获得此类信息 :( 也许您对 InUseCount 感到困惑属性仅返回当前对文件处于活动状态的“文件打开”次数，但不返回该文件的打开方式。CIM_DataFile 仅用于枚举文件，如 Findfirst 和 FindNext 函数。
【参考方案1】：
您可以在此处找到 JEDI 项目的 IFileIsInUse 接口的源示例：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.
【讨论】：
【参考方案2】：你基本上有两种方法
简单的方法
如果您使用的是 Windows Vista 或更新版本，请尝试 IFileIsInUse 界面
艰难的道路
如果您需要兼容 Windows XP、Vista、7 等的方法。然后使用NtQuerySystemInformation、NtQueryInformationFile 和NtQueryObject 函数。
这些是继续的步骤
-
调用 NTQuerySystemInformation 传递未记录的 SystemHandleInformation ($10) 值以获取句柄列表
然后处理作为文件的句柄列表（仅适用于 ObjectType = 28）。
用
PROCESS_DUP_HANDLE调用OpenProcess
然后调用DuplicateHandle 获取文件的real 句柄。
使用 NtQueryInformationFile 和 NtQueryObject 函数获取与句柄关联的文件名。
注意 1：此方法的棘手部分是根据句柄解析文件名。函数NtQueryInformationFile 在某些情况下（系统句柄和其他）挂起 防止整个应用程序挂起的解决方法是从单独的线程调用该函数。
注意 2：存在其他函数，如 GetFileInformationByHandleEx 和 GetFinalPathNameByHandle 来解析句柄的文件名。但两者都存在，因为在这种情况下，Windows viste 和 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.
【讨论】：
感谢@RRUZ 提供非常完整的答案。平台是XP和W7。我编译了给定的代码，虽然它可以工作，但我怀疑我不能做我想做的事，因为扫描句柄的可能延迟意味着有问题的过程可能已经完成了文件并且早已不复存在。当我遇到共享冲突时，我会在 50 毫秒延迟后重试，并且在大多数情况下，第二次尝试成功。我最初使用提供的代码建议延迟几秒来扫描句柄列表。【参考方案3】：使用 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;
如果这是您的文件，请提出一条消息...
【讨论】：
哪个系统信息类会让 NtQuerySystemInformation 告诉我们所有其他进程的句柄？我只看到一个会告诉我们每个进程有多少句柄的那个。 @RobKennedy forum.sysinternals.com/howto-enumerate-handles_topic18892.html以上是关于Delphi - 查找正在从我的程序访问文件的进程的主要内容，如果未能解决你的问题，请参考以下文章
从我的 Java 程序访问 URL 时出现 HTTP 503 错误 [重复]
如何从我的 servlet 类访问放置在 /tmp 文件夹中的 sqlite db 文件？