Текущий архив: 2004.09.26;
Скачать: CL | DM;

Вниз

Как узнать каким процессом занять файл?   Найти похожие ветки 

← →
TopT   (2004-08-17 17:10) [0]

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

---

← →
Игорь Шевченко ©   (2004-08-17 18:14) [1]

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


www.sysinternals.com Process Explorer

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

---

← →
TopT   (2004-08-17 20:10) [2]

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

---

← →
Игорь Шевченко ©   (2004-08-18 10:42) [3]

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


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

---

← →
TopT   (2004-08-18 12:48) [4]

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

---

← →
Игорь Шевченко ©   (2004-08-18 15:13) [5]

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


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

---

← →
Sun bittern ©   (2004-08-18 16:03) [6]

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

---

← →
TopT   (2004-08-18 16:47) [7]

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

---

← →
Игорь Шевченко ©   (2004-08-19 10:24) [8]

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


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

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) [9]

Продолжение:
{ 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.


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

---

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

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

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

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

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

---

← →
TopT   (2004-08-19 11:32) [11]

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

---

Страницы: 1 вся ветка

Текущий архив: 2004.09.26;
Скачать: CL | DM;

Наверх

Память: 0.52 MB
Время: 0.038 c