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

Вниз

Как получить список файлов, открытых определенным процессом?   Найти похожие ветки 

← →
Fluffy   (2006-05-26 01:09) [0]

не знаю, как получить список всех открытых файлов для определенного процесса. Список процессов уже получила, а вот файлы, им открытые, никак. Долго искала в инете, на форумах Delphi, но все безрезультатно. Знаю, что в есть функции NtQueryObject и NtQueryInformationFile, но это для Си, а как ее в делфи применить ума не приложу

---

← →
Игорь Шевченко ©   (2006-05-26 09:13) [1]

unit NtHandles;

interface
uses
 Classes;

procedure GetProcessFiles (const PID: Cardinal; Files: TStrings);

implementation
uses
 Windows, SysUtils,
 NtDll, NtProcessInfo,  HsNtDef, NtUtils, HSObjectList;

type
 THSNtHandle = class
 private
   FPID: ULONG;
   FObjectType: Byte;
   FFlags: Byte;
   FHandle: Word;
   FObject: Pointer;
   FGrantedAccess: ACCESS_MASK;
   FObjectTypeName: string;
   function AcquireDuplicatedHandle: THandle;
   function GetObjectName: string;
 public
   constructor Create (APID: ULONG; AObjectType, AFlags: Byte;
     AHandle: Word; AObject: Pointer; AGrantedAccess: ACCESS_MASK);
   property ObjectTypeName: string read FObjectTypeName;
   property ObjectName: string read GetObjectName;
 end;

 THSNtHandles = class(THSObjectList)
 private
   function GetItems(I: Integer): THSNtHandle;
 public
   property Items[I: Integer]: THSNtHandle read GetItems; default;
 end;

 TFileNameTranslator = class(TStringList)
 private
   function GetDriveName(const Index: Integer): string;
 public
   constructor Create;
   function TranslateNtFileName (const Value: string): string;
 end;

function GetProcessHandles (const PID: ULONG): THSNtHandles;
var
 HandlesInfo: Pointer;
 HandlesInfoSize: ULONG;
 rc: NTSTATUS;
 I: Integer;
begin
 HandlesInfo := QueryListInformation (SystemHandleInformation, rc,
   HandlesInfoSize);
 Result := THSNtHandles.Create;
 if not NT_SUCCESS(rc) then
   Exit;
 try
   with PSYSTEM_HANDLES_INFORMATION(HandlesInfo)^ do
     for I:=0 to Pred(Count) do
       if Data[I].PID = PID then
         Result.Add(THsNtHandle.Create(Data[I].PID, Data[I].ObjectType,
           Data[I].Flags, Data[I].Handle, Data[I].FObject,
           Data[I].GrantedAccess));
   FreeMem(HandlesInfo);
 except
   Result.Free;
   raise;
 end;
end;

procedure GetProcessFiles (const PID: Cardinal; Files: TStrings);
var
 Handles: THSNtHandles;
 I: Integer;
 Translator: TFileNameTranslator;
begin
 Files.Clear;
 Translator := TFileNameTranslator.Create;
 try
   Handles := GetProcessHandles (PID);
   for I:=0 to Pred(Handles.Count) do
     if SameText(Handles[I].ObjectTypeName, "File") then
       Files.Add (Translator.TranslateNtFileName(Handles[I].ObjectName));
 finally
   Translator.Free;
 end;
end;

{ THSNtHandles }

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

{ THSNtHandle }

function THSNtHandle.AcquireDuplicatedHandle: THandle;
var
 hProcess: THandle;
begin
 Result := INVALID_HANDLE_VALUE;
 hProcess := OpenProcess(PROCESS_DUP_HANDLE, false, FPID);
 if hProcess <> 0 then
   try
     if not DuplicateHandle (hProcess, FHandle, GetCurrentProcess,
         @Result, 0, false, 0) then
       Result := INVALID_HANDLE_VALUE;
   finally
     CloseHandle(hProcess);
   end;
end;

constructor THSNtHandle.Create(APID: ULONG; AObjectType, AFlags: Byte;
 AHandle: Word; AObject: Pointer; AGrantedAccess: ACCESS_MASK);
var
 rc: NTSTATUS;
 DupHandle: THandle;
 ReturnLength: ULONG;
 BasicInfo: OBJECT_BASIC_INFORMATION;
 ObjectType: Pointer;
 ObjectTypeLength: Integer;
begin
 FPID := APID;
 FObjectType := AObjectType;
 FFlags := AFlags;
 FHandle := AHandle;
 FObject := AObject;
 FGrantedAccess := AGrantedAccess;
 DupHandle := AcquireDuplicatedHandle;
 try
   rc := NtQueryObject(DupHandle, ObjectBasicInformation, @BasicInfo,
     SizeOf(BasicInfo),@ReturnLength);
   if NT_SUCCESS(rc) then begin
     ObjectTypeLength := BasicInfo.TypeInformationLength+2;
     GetMem(ObjectType, ObjectTypeLength);
     try
       rc := NtQueryObject(DupHandle, ObjectTypeInformation,
         ObjectType, ObjectTypeLength, @ReturnLength);
       if NT_SUCCESS(rc) then
         with POBJECT_TYPE_INFORMATION(ObjectType)^ do
           FObjectTypeName := HSUnicodeStringToAnsiString (Name);
     finally
       FreeMem(ObjectType);
     end;
   end;
 finally
   CloseHandle(DupHandle);
 end;
end;

function THSNtHandle.GetObjectName: string;
var
 ReturnLength: ULONG;
 ObjectInfo: Pointer;
 ObjectInfoLength: Integer;
 rc: NTSTATUS;
 DupHandle: THandle;
begin
 DupHandle := AcquireDuplicatedHandle;
 try
   ObjectInfoLength := MAX_PATH * SizeOf(WideChar);
   GetMem(ObjectInfo, ObjectInfoLength);
   try
     rc := NtQueryObject (DupHandle, ObjectNameInformation, ObjectInfo,
       ObjectInfoLength, @ReturnLength);
     if NT_SUCCESS(rc) then
       with POBJECT_NAME_INFORMATION(ObjectInfo)^ do
         Result := HSUnicodeStringToAnsiString (Name);
   finally
     FreeMem(ObjectInfo);
   end;
 finally
   CloseHandle(DupHandle);
 end;
end;

{ TFileNameTranslator }

constructor TFileNameTranslator.Create;
var
 I: Integer;
 Buffer: ZString;
 Drive: array[0..2] of char;
 Drives: DWORD;
begin
 inherited;
 FillChar(Drive, SizeOf(Drive), 0);
 Drive[1] := ":";
 Drives := GetLogicalDrives;
 for I:=0 to 31 do begin
   if (Drives and (1 shl I)) <> 0 then begin
     Drive[0] := Char(I + Ord("A"));
     QueryDosDevice(Drive, Buffer, sizeof(Buffer));
     AddObject(Buffer, TObject(I));
   end;
 end;
end;

function TFileNameTranslator.GetDriveName(const Index: Integer): string;
var
 DriveNo: Integer;
begin
 SetLength(Result, 2);
 DriveNo := Integer(Objects[Index]);
 Result[1] := Char(DriveNo + Ord("A"));
 Result[2] := ":";
end;

function TFileNameTranslator.TranslateNtFileName(
 const Value: string): string;
var
 I: Integer;
begin
 for I:=0 to Pred(Count) do
   if Copy(Value, 1, Length(Strings[I])) = Strings[I] then begin
     Result := Value;
     System.Delete(Result, 1, Length(Strings[I]));
     Result := GetDriveName(I) + Result;
     Exit;
   end;
 Result := Value;
end;

end.

продолжение следует

---

← →
Игорь Шевченко ©   (2006-05-26 09:14) [2]

unit main;

interface
uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 Menus, ComCtrls, NtProcessInfo, ExtCtrls;

type
 TfMain = class(TForm)
   lvProcesses: TListView;
   MainMenu: TMainMenu;
   miFile: TMenuItem;
   miHelp: TMenuItem;
   miView: TMenuItem;
   miAbout: TMenuItem;
   miRefresh: TMenuItem;
   miExit: TMenuItem;
   Splitter: TSplitter;
   lvFiles: TListView;
   Panel1: TPanel;
   procedure miExitClick(Sender: TObject);
   procedure RefreshEvent(Sender: TObject);
   procedure FormCreate(Sender: TObject);
   procedure FormDestroy(Sender: TObject);
   procedure lvProcessesDblClick(Sender: TObject);
   procedure miAboutClick(Sender: TObject);
 private
   FProcesses: THSNtProcessInfoList;
   procedure RefreshView;
   procedure RefreshProcessList;
   procedure DisplayProcess (AProcess: THsNtProcessInfo);
   procedure DisplayProcessFiles (AProcess: THsNtProcessInfo);
 end;

var
 fMain: TfMain;

implementation
uses
 NtDll, HsNtDef, NtHandles, About;

{$R *.dfm}

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

procedure TfMain.RefreshView;
var
 I: Integer;
begin
 RefreshProcessList;
 lvProcesses.Items.Clear;
 for I:=0 to Pred(FProcesses.Count) do
   DisplayProcess (FProcesses[I]);
end;

procedure TfMain.RefreshEvent(Sender: TObject);
begin
 RefreshView;
end;

procedure TfMain.FormCreate(Sender: TObject);
begin
 FProcesses := THSNtProcessInfoList.CreateEmpty;
end;

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

procedure TfMain.RefreshProcessList;
var
 ProcessInfo: Pointer;
 rc: NTSTATUS;
 Dummy: ULONG;
begin
 ProcessInfo := QueryListInformation(SystemProcessesAndThreadsInformation, rc,
   Dummy);
 if NT_SUCCESS(rc) then
   FProcesses.Rebuild(ProcessInfo);
end;

procedure TfMain.DisplayProcess(AProcess: THsNtProcessInfo);
begin
 with lvProcesses.Items.Add do begin
   Data := AProcess;
   Caption := AProcess.ProcessName;
   SubItems.Add(IntToStr(AProcess.Info.ProcessId));
   SubItems.Add(AProcess.UserName);
 end;
end;

procedure TfMain.lvProcessesDblClick(Sender: TObject);
begin
 with lvProcesses.Selected do
   if Assigned(Data) and (SubItems[1] <> "") and not SameText(SubItems[1],
      "SYSTEM") then
     DisplayProcessFiles (Data);
end;

procedure TfMain.DisplayProcessFiles(AProcess: THsNtProcessInfo);
var
 S: TStringList;
 I: Integer;
begin
 lvFiles.Items.Clear;
 S := TStringList.Create;
 try
   NtHandles.GetProcessFiles (AProcess.Info.ProcessId, S);
   for I:=0 to Pred(S.Count) do
     lvFiles.Items.Add.Caption := S[I];
 finally
   S.Free;
 end;
end;

procedure TfMain.miAboutClick(Sender: TObject);
begin
 with TfAbout.Create(Application) do
   try
     ShowModal
   finally
     Free;
   end;
end;

end.

---

← →
Игорь Шевченко ©   (2006-05-26 09:15) [3]

Программа определяет и показывает имена файлов, открытых выбранным процессом.
Автор: Игорь Шевченко
Список открытых файлов получается запросами к функциям менеджера объектов системы Windows NT.

Демонстрируется использование функций Native API:
NtQuerySystemInformation - для получения списка процессов и списка открытых
 дескрипторов всеми процессами системы.
NtQueryObject - для получения информации от менеджера объектов системы.

Демонстрируется использование функций Windows API:
OpenProcess - для получения дескриптора выбранного процесса.
DuplicateHandle - для получения копии дескриптора открытого выбранным процессом
 объекта.
CloseHandle - для освобождения дескриптора объекта.
GetLogicalDrives - для трансляции внутреннего имени файла в имя вида
 "диск:\путь\имя.тип".
QueryDosDevice - для трансляции внутреннего имени файла.
OpenProcessToken, GetTokenInformation, LookupAccountSid - для получения имени
 пользователя, запустившего процесс.
ShellExecute - для открытия интернет-сайта по клику на метке
            - для вызова почтового клиента с заполненным адресом и темой
              письма по клику на метке.
PtInRect, SetCapture, ReleaseCapture - для имитации поведения гиперссылки:
 изменения стиля шрифта и формы курсора при наведении курсора на метку.

Ограничения применения: программа работает только в операционных системах
семейства NT (Windows NT, Windows 2000, Windows XP, Windows 2003).
У процессов, созданных системой, список открытых файлов получить нельзя.

Побочные эффекты и нерешенные проблемы: В случае, если выбранный процесс открыл
именованный канал для связи с менеджером сервисов, программа ЗАВИСНЕТ при
определении имени этого канала.

Все остальные файлы брать в
http://kladovka.net.ru/download.cgi?id=47
http://kladovka.net.ru/download.cgi?id=48

---

← →
GrayFace ©   (2006-05-26 10:22) [4]

Приведите, пожалуйста, ShellExecute - для вызова почтового клиента с заполненным адресом и темой письма по клику на метке.

У процессов, созданных системой, список открытых файлов получить нельзя.
А это лечится Debug привилегиями или является ограничением метода?

---

← →
Fluffy   (2006-05-26 10:24) [5]

огромное спасибо!

---

← →
Игорь Шевченко ©   (2006-05-26 10:27) [6]

GrayFace ©   (26.05.06 10:22) [4]


> Приведите, пожалуйста, ShellExecute - для вызова почтового
> клиента с заполненным адресом и темой письма по клику на
> метке.


procedure TfAbout.LabelEmailClick(Sender: TObject);
begin
 ShellExecute(Application.Handle, "open",
   "mailto:foo@bar.com?subject=OpenedFiles", "", "", SW_SHOW);
end;


> А это лечится Debug привилегиями или является ограничением
> метода?


Нельзя получить список открытых файлов для сервисов и сервис-менеджера - это ограничение метода. Для остальных можно.

---

← →
GrayFace ©   (2006-05-26 10:36) [7]

Спасибо.

---

← →
Fluffy   (2006-05-26 11:11) [8]

Попробовала реализовать алгоритм, но компилятор ругается на NtProcessInfo.dcu ...........

---

← →
Fluffy   (2006-05-26 11:14) [9]

Вот она моя невнимательность, всегда читаю не до конца и в результате делаю поспешные выводы :)

---

← →
Fluffy   (2006-05-26 21:01) [10]

Немного преобразовала код и вот что в результате получилось:


unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, Menus, ComCtrls, NtProcessInfo, ExtCtrls, Grids, StdCtrls;

type
 TForm1 = class(TForm)
   MainMenu: TMainMenu;
   miFile: TMenuItem;
   StringGrid1: TStringGrid;
   miExit: TMenuItem;
   procedure miFileClick(Sender: TObject);
   procedure RefreshEvent(Sender: TObject);
   procedure FormCreate(Sender: TObject);
   procedure FormDestroy(Sender: TObject);
   procedure StringGrid1DblClick(Sender: TObject);
   procedure miExitClick(Sender: TObject);
 private
   { Private declarations }
  FProcesses: THSNtProcessInfoList;
  procedure RefreshView;
  procedure RefreshProcessList;
  procedure DisplayProcess (AProcess: THsNtProcessInfo);
  procedure DisplayProcessFiles (AProcess: THsNtProcessInfo);
 public
   { Public declarations }
 end;

var
 Form1: TForm1;
 j: integer;

implementation
uses
NtDll, HsNtDef, NtHandles;

{$R *.dfm}

procedure TForm1.miFileClick(Sender: TObject);
begin
StringGrid1.Cells[0,0]:="Имя образа / Имя открытого файла";
StringGrid1.Cells[1,0]:="PID";
StringGrid1.Cells[2,0]:="Имя пользователя";
FProcesses := THSNtProcessInfoList.CreateEmpty;
Form1.RefreshEvent(Sender);
end;

procedure TForm1.RefreshView;
var
I: Integer;
begin
StringGrid1.RowCount:=2;
RefreshProcessList;
j:=1;
for I:=0 to Pred(FProcesses.Count) do
 begin
  DisplayProcess (FProcesses[I]);
  StringGrid1.RowCount:=StringGrid1.RowCount+1;
 end;
StringGrid1.RowCount:=StringGrid1.RowCount-1;
end;

procedure TForm1.RefreshEvent(Sender: TObject);
begin
RefreshView;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
StringGrid1.Cells[0,0]:="Имя образа / Имя открытого файла";
StringGrid1.Cells[1,0]:="PID";
StringGrid1.Cells[2,0]:="Имя пользователя";
FProcesses := THSNtProcessInfoList.CreateEmpty;
Form1.RefreshEvent(Sender);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
FProcesses.Free;
end;

procedure TForm1.RefreshProcessList;
var
ProcessInfo: Pointer;
rc: NTSTATUS;
Dummy: ULONG;
begin
ProcessInfo := QueryListInformation(SystemProcessesAndThreadsInformation, rc,
  Dummy);
if NT_SUCCESS(rc) then
  FProcesses.Rebuild(ProcessInfo);
end;

procedure TForm1.DisplayProcess(AProcess: THsNtProcessInfo);
begin
StringGrid1.Cells[0,StringGrid1.RowCount-1]:=AProcess.ProcessName;
StringGrid1.Cells[1,StringGrid1.RowCount-1]:=IntToStr(AProcess.Info.ProcessId);
if AProcess.UserName<>"" then
 StringGrid1.Cells[2,StringGrid1.RowCount-1]:=AProcess.UserName
else
 begin
   if AProcess.ProcessName<>"SVCHOST.EXE" then
     StringGrid1.Cells[2,StringGrid1.RowCount-1]:="SYSTEM"
   else
     begin
       if j=1 then  StringGrid1.Cells[2,StringGrid1.RowCount-1]:="NETWORK SERVICE";
       if j=2 then  StringGrid1.Cells[2,StringGrid1.RowCount-1]:="LOCAL SERVICE";
       inc(j);
     end;
 end;
Form1.DisplayProcessFiles(AProcess);
end;

procedure TForm1.StringGrid1DblClick(Sender: TObject);
var AProcess: THsNtProcessInfo;
begin
 with StringGrid1.Selection do
   if (StringGrid1.Cells[0,StringGrid1.RowCount]<> " ")  then
     DisplayProcessFiles (AProcess);
end;

procedure TForm1.DisplayProcessFiles(AProcess: THsNtProcessInfo);
var
S: TStringList;
I: Integer;
begin

S := TStringList.Create;
try
  NtHandles.GetProcessFiles (AProcess.Info.ProcessId, S);
  for I:=0 to Pred(S.Count) do begin
    StringGrid1.Cells[0,StringGrid1.RowCount]:="       "+IntToStr(i+1)+". "+S[I];
    StringGrid1.RowCount:=StringGrid1.RowCount+1;
    end;
finally
  S.Free;
end;
end;

procedure TForm1.miExitClick(Sender: TObject);
begin
close;
end;

end.


Еще раз большое спасибо за помощь!

---

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

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

Наверх

Память: 0.53 MB
Время: 0.06 c