Delphi-trouver le processus d'accès à un fichier de mon programme
J'ai une application Delphi qui écrit régulièrement sur un disque local. Il est parfois impossible d'accéder au fichier - une violation de partage des résultats lorsqu'il essaie de l'ouvrir. Une nouvelle tentative après un court délai est tout ce qui est nécessaire, mais quand elle se produit, je voudrais signaler le processus qui a empêché l'accès.
est-il possible quand une violation de partage se produit pour mon programme d'énumérer tous les poignées de fichier en usage, inspecter le nom de fichier, et si elle correspond au nom de mon fichier de données, récupère le nom du processus associé à cette poignée?
un exemple de code serait bien.
3 réponses
Vous avez essentiellement deux façons
Le Moyen Le Plus Facile
si vous utilisez Windows Vista ou plus récent essayer IFileIsInUse
interface
Dur
si vous avez besoin d'une méthode compatible avec Windows XP,Vista,7 et ainsi de suite. ensuite, vous utilisez le NtQuerySystemInformation, NtQueryInformationFile et NtQueryObject fonction.
ce sont les étapes pour continuer
- Appel de la NTQuerySystemInformation passant les sans-papiers SystemHandleInformation ($10) valeur pour obtenir la liste des poignées
- puis traiter la liste des poignées (seulement pour ObjectType = 28) qui sont des fichiers.
- appel OpenProcess
PROCESS_DUP_HANDLE
- alors appelez DuplicateHandle pour obtenir un
real
descripteur du fichier. - obtenir le nom du fichier associé au manche à l'aide des fonctions NtQueryInformationFile et NtQueryObject.
Note 1: la partie délicate de cette méthode est de résoudre le nom de fichier basé dans une poignée. la fonction NtQueryInformationFile
accroche dans certains scénarios (poignées système et autres) une solution pour empêcher l'application entière de suspendre est d'appeler la fonction à partir d'un thread séparé.
Note 2 : existe une autre fonction comme GetFileInformationByHandleEx et GetFinalPathNameByHandle pour résoudre le nom de fichier d'une poignée. mais les deux existent car Windows existe et dans ce cas est mieux utiliser IFileIsInUse
.
vérifier cet exemple d'application testé dans Delphi 2007, XE2 et Windows XP et 7. de là, vous pouvez prendre quelques idées pour résoudre votre problème.
Note : la fonction GetProcessIdUsingFile
compare seulement le nom des fichiers (pas le chemin).
{$APPTYPE CONSOLE}
uses
Windows,
SysUtils;
const
SystemHandleInformation = ;
STATUS_SUCCESS = 000000;
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.
en utilisant NtQuerySystemInformation vous pouvez lister toutes les poignées ouvertes par tous les processus alors vous pouvez utiliser cette fonction pour obtenir le nom du fichier
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 c'est votre fichier de soulever un message ...
Vous pouvez trouver un exemple de source pour l'interface IFileIsInUse par le projet JEDI ici: 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:a1cbf0; D2:a1a; D3:61; D4:(,,,,,,,));
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 = 01;
OF_CAP_CANCLOSE = 02;
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 (01)',
'OF_CAP_CANCLOSE (02)',
'OF_CAP_CANSWITCHTO (01) or OF_CAP_CANCLOSE (02)'
);
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.