| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Как узнать каким процессом занять файл? [D7, WinXP]

TopT ©   (2004-08-17 17:10:00) 

Некоторые файлы не удаляются или не перемесчаются из за того что они используются каким либо процесом. Вопрос прост: как узнать чем используется тот или иной файл и сообщить об этом пользевателю? Делать такой фокус умеет файл. менеджер Frigate, а это означает что это возможно. Если ктото знает или имеет ссылки на нужное чтиво, поделитесь знаниями, плз.

---

TopT   (2004-08-19 11:32:00) [1]

Игорь Шевченко, спасибо большое, пойду разбератся что к чему.

---

Игорь Шевченко   (2004-08-19 10:26:00) [2]

Продолжение:

Если процесс является сервисом или services.exe, то программа гарантировано будет виснуть (в этом ее отличие от Process Explorer Руссиновича).

Недостающие unit'ы можно взять здесь:
http://www.schevchenko.net.ru/SRC/Common_60.zip

или написать самостоятельно :)

---

Игорь Шевченко   (2004-08-19 10:24:00) [3]

> Ага. Они возьмут и расскажут мне все секреты. :)


Небольшой набросок, показывающий список файлов, открытых конкретным процессом, выглядит примерно так:

unit main;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, ComCtrls, HSObjectList, Menus;

type
 THandleInfo = class
 private
   FObjectTypeName: string;
   FObjectName: string;
   function GetObjectTypeName: string;
   function AcqiureDuplicatedHandle: THandle;
 public
   PID: ULONG;
   ObjectType: Byte;
   Flags: Byte;
   Handle: Word;
   FObject: Pointer;
   GrantedAccess: ACCESS_MASK;
   DupHandle: THandle;
   DupStatus: Integer;
   NameLength: Integer;
   TypeLength: Integer;

   constructor Create (APID: ULONG; AObjectType, AFlags: Byte;
     AHandle: Word; AObject: Pointer; AGrantedAccess: ACCESS_MASK);
   procedure InternalGetObjectName;
   property ObjectTypeName: string read GetObjectTypeName;
   property ObjectName: string read FObjectName;
   function Clone: THandleInfo;
 end;

 THandleInfoList = class(THSObjectList)
 private
   function GetItems (I: Integer): THandleInfo;
 public
   property Items [I: Integer]: THandleInfo read GetItems; default;
   procedure LoadHandles;
   function GetProcessHandles (APID: ULONG): THandleInfoList;
 end;

 TfMain = class(TForm)
   ListView: TListView;
   MainMenu1: TMainMenu;
   File1: TMenuItem;
   Exit1: TMenuItem;
   View1: TMenuItem;
   N1: TMenuItem;
   About1: TMenuItem;
   Openedfiles1: TMenuItem;
   procedure FormCreate(Sender: TObject);
   procedure FormDestroy(Sender: TObject);
   procedure Exit1Click(Sender: TObject);
   procedure Openedfiles1Click(Sender: TObject);
 private
   FDebugPrivilegeEnabled: Boolean;
   FHandleInfoList: THandleInfoList;
   procedure CollectHandleInformation;
   procedure DisplayHandleInformation;
   procedure DisplayProcessFiles (APID: ULONG);
 end;

var
 fMain: TfMain;

implementation
uses
 NtDll, HsWinUtils, NtStatusDefs, HsNtDef, ProcessFilesForm, HSUtilities;

{$R *.dfm}

{ THandleInfo }

constructor THandleInfo.Create (APID: ULONG; AObjectType, AFlags: Byte;
 AHandle: Word; AObject: Pointer; AGrantedAccess: ACCESS_MASK);
var
 ReturnLength: DWORD;
 BasicInfo: TOBJECT_BASIC_INFORMATION;
 ObjectInfo: Pointer;
 ObjectInfoLength: Integer;
begin
 PID := APID;
 ObjectType := AObjectType;
 Flags := AFlags;
 Handle := AHandle;
 FObject := AObject;
 GrantedAccess := AGrantedAccess;
 Duphandle := AcqiureDuplicatedHandle;
 try
   DupStatus := NtQueryObject(DupHandle, ObjectBasicInformation, @BasicInfo,
     SizeOf(BasicInfo),@ReturnLength);
   if NT_SUCCESS(DupStatus) then begin
     NameLength := BasicInfo.NameInformationLength;
     TypeLength := BasicInfo.TypeInformationLength;
     ObjectInfoLength := TypeLength+2;
     GetMem(ObjectInfo, ObjectInfoLength);
     try
       DupStatus := NtQueryObject(DupHandle, ObjectTypeInformation,
         ObjectInfo, ObjectInfoLength, @ReturnLength);
       if NT_SUCCESS(DupStatus) then
         with POBJECT_TYPE_INFORMATION(ObjectInfo)^ do
           FObjectTypeName := WideCharLenToString(Name.Buffer,
             Name.Length div SizeOf(WideChar));
     finally
       FreeMem(ObjectInfo);
     end;
     if HSMatchText(FObjectTypeName, ['Key', 'DebugObject', 'Desktop',
         'Directory', 'Event', 'EventPair', 'KeyedEvent', 'Mutant',
         'Port', 'Semaphore', 'SymbolicLink', 'Timer', 'Token',
         'WaitablePort', 'WindowStation', 'WmiGuid', 'Section']) then
       InternalGetObjectName;
   end;
 finally
   CloseHandle(DupHandle);
 end;
end;

procedure THandleInfo.InternalGetObjectName;
var
 ReturnLength: DWORD;
 ObjectInfo: Pointer;
 ObjectInfoLength: Integer;
begin
 if NameLength = 0 then
   ObjectInfoLength := MAX_PATH * SizeOf(WideChar)
 else
   ObjectInfoLength := NameLength;
 GetMem(ObjectInfo, ObjectInfoLength);
 try
   DupStatus := NtQueryObject(DupHandle, ObjectNameInformation, ObjectInfo,
     ObjectInfoLength,@ReturnLength);
   if NT_SUCCESS(DupStatus) then
     with POBJECT_NAME_INFORMATION(ObjectInfo)^ do
       FObjectName := WideCharLenToString(Name.Buffer,
         Name.Length div SizeOf(WideChar));
 finally
   FreeMem(ObjectInfo);
 end;
end;

{ TODO: Только для Windows XP, и вообще, плохой метод }
function THandleInfo.GetObjectTypeName : string;
begin
 if NT_SUCCESS(DupStatus) then
   Result := FObjectTypeName
 else
   case ObjectType of
   2:
     Result := 'Directory';
   3:
     Result := 'SymbolicLink';
   4:
     Result := 'Token';
   5:
     Result := 'Process';
   6:
     Result := 'Thread';
   7:
     Result := 'Job';
   8:
     Result := 'DebugObject';
   9:
     Result := 'Event';
   11:
     Result := 'Mutant';
   13:
     Result := 'Semaphore';
   14:
     Result := 'Timer';
   16:
     Result := 'KeyedEvent';
   17:
     Result := 'WindowStation';
   18:
     Result := 'Desktop';
   19:
     Result := 'Section';
   20:
     Result := 'Key';
   21:
     Result := 'Port';
   22:
     Result := 'WaitablePort';
   27:
     Result := 'IoCompletion';
   28:
     Result := 'File';
   29:
     Result := 'WmiGuid';
   else
     Result := Format('**unknown %d', [ObjectType]);
   end;
end;

function THandleInfo.Clone: THandleInfo;
begin
 Result := THandleInfo.Create(PID, ObjectType, Flags, Handle, FObject,
   GrantedAccess);
 Result.FObjectName := FObjectName;
 Result.FObjectTypeName := FObjectTypeName;
end;

function THandleInfo.AcqiureDuplicatedHandle: THandle;
var
 hProcess: THandle;
begin
 Result := INVALID_HANDLE_VALUE;
 hProcess := OpenProcess(PROCESS_DUP_HANDLE, false, PID);
 if hProcess = 0 then
   Exit;
 try
   if not DuplicateHandle (hProcess, Handle, GetCurrentProcess,
       @Result, 0, false, 0) then
     Result := INVALID_HANDLE_VALUE
 finally
   CloseHandle(hProcess);
 end;
end;


Продолжение следует...

---

Игорь Шевченко   (2004-08-19 10:24:00) [4]

Продолжение:
{ THandleInfoList }

function THandleInfoList.GetItems (I: Integer): THandleInfo;
begin
 Result := THandleInfo(inherited Items[I]);
end;

type
{ Определение типов Windows }
 USHORT = Word;
 PVOID  = Pointer;

function THandleInfoList.GetProcessHandles(APID: ULONG): THandleInfoList;
var
 I: Integer;
begin
 Result := THandleInfoList.Create;
 try
   for I:=0 to Pred(Count) do
     if Items[I].PID = APID then
       Result.Add(Items[I].Clone);
 except
   Result.Free;
   raise;
 end;
end;

procedure THandleInfoList.LoadHandles;
var
 HandlesInfo: Pointer;
 HandlesInfoSize: Integer;
 rc: NTSTATUS;
 I: ULONG;
begin
 HandlesInfoSize := $400;
 GetMem(HandlesInfo, HandlesInfoSize);
 rc := NtQuerySystemInformation(SystemHandleInformation, HandlesInfo,
   HandlesInfoSize, nil);
 while rc = STATUS_INFO_LENGTH_MISMATCH do begin
   FreeMem(HandlesInfo);
   HandlesInfoSize := HandlesInfoSize * 2;
   GetMem(HandlesInfo, HandlesInfoSize);
   rc := NtQuerySystemInformation(SystemHandleInformation, HandlesInfo,
     HandlesInfoSize, nil);
 end;
 if not NT_SUCCESS(rc) then
   raise Exception.CreateFmt(
     'NtQuerySystemInformation failed with status 0x%.8x', [rc]);
 with PSYSTEM_HANDLES_INFORMATION(HandlesInfo)^ do
   for I:=0 to Pred(Count) do
     Add(THandleInfo.Create(Data[I].PID, Data[I].ObjectType,
       Data[I].Flags, Data[I].Handle, Data[I].FObject,
       Data[I].GrantedAccess));
 FreeMem(HandlesInfo);
end;

{ TfMain }

procedure TfMain.FormCreate(Sender: TObject);
begin
 FDebugPrivilegeEnabled := HSEnablePrivilege(SE_DEBUG_NAME);
 if not FDebugPrivilegeEnabled then
   raise Exception.Create('Не удалось установить привилегию отладки');
 FHandleInfoList := THandleInfoList.Create;
 CollectHandleInformation;
 DisplayHandleInformation;
end;

procedure TfMain.CollectHandleInformation;
begin
 FHandleInfoList.LoadHandles;
end;

procedure TfMain.DisplayHandleInformation;

 procedure AddObject (AObject: THandleInfo);
 var
   LI : TListItem;
 begin
   LI := ListView.Items.Add;
   with AObject do begin
     LI.Caption := IntToStr(PID);
     LI.SubItems.Add(IntToStr(ObjectType));
     LI.SubItems.Add(ObjectTypeName);
     LI.SubItems.Add(Format('%.2x', [Flags]));
     LI.SubItems.Add(Format('%.8x', [Handle]));
     LI.SubItems.Add(Format('%.8x', [GrantedAccess]));
     if DupStatus <> 0 then
       LI.SubItems.Add(Format('%.8x', [DupStatus]))
     else
       LI.SubItems.Add('');
     LI.SubItems.Add(ObjectName);
   end;
 end;

var
 I : Integer;
begin
 Caption := Caption + Format(' %d дескрипторов', [FHandleInfoList.Count]);
 for I:=0 to Pred(FHandleInfoList.Count) do begin
   with FHandleInfoList[I] do begin
     if HSMatchText(ObjectTypeName, ['Key', 'DebugObject', 'Desktop',
         'Directory', 'Event', 'EventPair', 'KeyedEvent', 'Mutant',
         'Port', 'Semaphore', 'SymbolicLink', 'Timer', 'Token',
         'WaitablePort', 'WindowStation', 'WmiGuid', 'Section']) then begin
       if ObjectName <> '' then
         AddObject (FHandleInfoList[I]);
     end else if (not SameText(ObjectTypeName, 'File')) and
         (not SameText(ObjectTypeName, 'Process')) and
         (not SameText(ObjectTypeName, 'Thread')) then
       AddObject (FHandleInfoList[I]);
   end;
   Application.ProcessMessages;
 end;
end;

procedure TfMain.FormDestroy(Sender: TObject);
begin
 FHandleInfoList.Free;
end;

procedure TfMain.Exit1Click(Sender: TObject);
begin
 Close;
end;

procedure TfMain.Openedfiles1Click(Sender: TObject);
var
 PidStr: string;
begin
 if InputQuery('XPNTUtils', 'Enter process ID (hex value preceeded by $)',
     PidStr) then begin
   DisplayProcessFiles(StrToIntDef(PidStr, -1));
 end;
end;

procedure TfMain.DisplayProcessFiles(APID: ULONG);
var
 Handles: THandleInfoList;
 I: Integer;
begin
 if APID = ULONG(-1) then
   Exit;
 Handles := FHandleInfoList.GetProcessHandles(APID);
 try
   with TfProcessFiles.Create(Application) do
     try
       for I:=0 to Pred(Handles.Count) do
         if SameText(Handles[I].ObjectTypeName, 'File') then begin
           Handles[I].DupHandle := Handles[I].AcqiureDuplicatedHandle;
           try
             Handles[I].InternalGetObjectName;
           finally
             CloseHandle(Handles[I].DupHandle);
           end;
           ListBox.Items.Add(Handles[I].ObjectName);
         end;
       ShowModal;
     finally
       Free;
     end;
 finally
   Handles.Free;
 end;
end;

end.


Продолжение следует...

---

TopT   (2004-08-18 16:47:00) [5]

>Sun bittern ©   (18.08.04 16:03) [6]
Ага. Они возьмут и расскажут мне все секреты. :)

---

Sun bittern   (2004-08-18 16:03:00) [6]

Спросить у разработчиков Frigate 3.25. Он вроде бы на меня несколько раз ругался, что файл занят такой то прогой :)

---

Игорь Шевченко   (2004-08-18 15:13:00) [7]

> Неужели все так сложно?


Было бы просто - таких бы программ по инету валялось бы, как собак нерезаных, да еще и с исходниками.

---

TopT   (2004-08-18 12:48:00) [8]

>Игорь Шевченко ©   (18.08.04 10:42) [3]
Неужели все так сложно? Нужно, очень нужно это написать.
Подскажи хоть в какую сторону копать.  Мне ненужна столь детальная информация о процесе, мне просто нужно знать каким процесом занять файл.

---

Игорь Шевченко   (2004-08-18 10:42:00) [9]

> Да нет, мне програмно нужно узнать.


А это в общем случае нереально. Process Explorer для этих целей использует драйвер режима ядра. Оно сильно надо - такую мороку ?

---

TopT   (2004-08-17 20:10:00) [10]

Игорь Шевченко ©   (17.08.04 18:14) [1]
Да нет, мне програмно нужно узнать. Тоесть моя прога должна узнать :) А Process Explorer у меня давно стоит вместо "Task Manager" :)
>>Сообщить любыми доступными средствами, вплоть до кидания тапка через комнату.
Я думаю я лучше ограничусь MessageBox-ом, а то тапками кидатся както неприлично :)

---

Игорь Шевченко   (2004-08-17 18:14:00) [11]

>  как узнать чем используется тот или иной файл


www.sysinternals.com Process Explorer

Сообщить любыми доступными средствами, вплоть до кидания тапка через комнату.

---

Наверх