Монитор процессов

Задача

Получить информацию по всем работающим процессам, включая информацию о потоках и используемых модулях. Управлять приоритетом процессов. Завершать процессы. Получить информацию о всех оконных элементах.

Решение




Комментарий

Ключевыми методами данного приложения являются:
  • Построение дерева процессов
  • Заполнение списка потоков процесса
  • Заполнение списка модулей, используемых процессом
  • Изменение приоритета выполнения процесса
  • Завершение процесса
  • Построение дерева окон
Элементы пользовательского интерфейса расположены на двух закладках. 

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

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

Построение дерева процессов



type

  TNodeData = class // на вырост - потом добавится ещё что-нибудь
    ProcessEntry: TProcessEntry32;
  end;


procedure TfmMain.RefreshProcessInfo;
var
  th32ProcessID: dword;
  lppe: TProcessEntry32;
  TreeNode: TTreeNode;
  NodeText: string;
  CurrentNodeID: dword;
  NodeData: TNodeData;
begin
  // запоминать позицию в дереве
  if twProcess.Selected <> nil then
    CurrentNodeID := TNodeData(twProcess.Selected.Data)
      .ProcessEntry.th32ProcessID
  else
    CurrentNodeID := 0; //
  // получения информации о выполняющихся в системе процессах
  th32ProcessID := 0;
  hSnapshot := CreateToolhelp32Snapshot(TH32CS_SNAPALL, th32ProcessID);
  lppe.dwSize := sizeOf(ProcessEntry32); // задать размер структуры
  twProcess.Items.Clear; // очистить дерево процессов
  Process32First(hSnapshot, lppe); // получить первый элемент
  repeat
    // найти родительский узел
    TreeNode := twProcess.Items.GetFirstNode;
    while TreeNode <> nil do
    begin
      if TNodeData(TreeNode.Data).ProcessEntry.th32ProcessID = lppe.th32ParentProcessID
      then
        Break;
      TreeNode := TreeNode.GetNext;
    end;
    NodeText := ExtractFileName(lppe.szExeFile);
    NodeData := TNodeData.Create;
    NodeData.ProcessEntry := lppe;
    TreeNode := twProcess.Items.AddChildObject(TreeNode, NodeText, NodeData);
    TreeNode.SelectedIndex := 1;
  until Process32Next(hSnapshot, lppe) = false;
  TreeNode := twProcess.Items.GetFirstNode;
  while TreeNode <> nil do
  begin
    if TNodeData(TreeNode.Data).ProcessEntry.th32ProcessID = CurrentNodeID then
    begin
      twProcess.Select(TreeNode);
      Break;
    end;
    TreeNode := TreeNode.GetNext;
  end;
  StBar.Panels.Items[1].Text := inttostr(twProcess.Items.Count);
end;

Заполнение списка потоков процесса

procedure TfmMain.RefreshThreadInfo(th32ProcessID: dword);
var
  lppe: tagThreadEntry32;
  ListItem: TListItem;
begin
  lppe.dwSize := sizeOf(tagThreadEntry32); // задать размер структуры
  lwThread.Clear; // очистить список процессов
  if Thread32First(hSnapshot, lppe) then // получить первый элемент
    repeat
      if lppe.th32OwnerProcessID = th32ProcessID then
      begin
        ListItem := lwThread.Items.Add;
        ListItem.Caption := inttostr(lppe.th32ThreadID);
        ListItem.SubItems.Add(inttostr(lppe.tpBasePri));
        ListItem.SubItems.Add(inttostr(lppe.tpDeltaPri));
      end;
    until Thread32Next(hSnapshot, lppe) = false;
end;

Заполнение списка модулей, используемых процессом

procedure TfmMain.RefreshModulInfo(th32ProcessID: dword);
var
  lppe: tagModuleEntry32;
  ListItem: TListItem;
  hMSnapshot: THandle;
begin
  hMSnapshot := CreateToolhelp32Snapshot(TH32CS_SNAPMODULE, th32ProcessID);
  lppe.dwSize := sizeOf(tagModuleEntry32); // задать размер структуры
  lwModule.Clear; // очистить список модулей
  if Module32First(hMSnapshot, lppe) then // получить первый элемент
    repeat
      ListItem := lwModule.Items.Add;
      ListItem.Caption := lppe.szModule;
      ListItem.SubItems.Add(lppe.szExePath);
      ListItem.SubItems.Add(inttostr(lppe.ProccntUsage));
      ListItem.SubItems.Add(inttostr(lppe.modBaseSize));
    until Module32Next(hMSnapshot, lppe) = false;
  CloseHandle(hMSnapshot);
  StBar.Panels.Items[3].Text := inttostr(lwModule.Items.Count);
  AjustModuleColumns;
end;

Изменение приоритета выполнения процесса

procedure TfmMain.cbSetPriorityCloseUp(Sender: TObject);
var
  H: THandle;
begin
  H := OpenProcess(PROCESS_SET_INFORMATION, false,    TNodeData(twProcess.Selected.Data).ProcessEntry.th32ProcessID);
  case cbSetPriority.ItemIndex of
    0:
      SetPriorityClass(H, IDLE_PRIORITY_CLASS);
    1:
      SetPriorityClass(H, NORMAL_PRIORITY_CLASS);
    2:
      SetPriorityClass(H, HIGH_PRIORITY_CLASS);
    3:
      SetPriorityClass(H, REALTIME_PRIORITY_CLASS);
  end;
  RefreshProcessInfo;
end;

Завершение процесса

procedure TfmMain.TerminateProc;
var
  Ret: BOOL;
  ProcID, Ex: Cardinal;
  Handlep: THandle;
begin
  if MessageDlg('ВНИМАНИЕ!' + ^J +
    'Завершение процесса может привести к нежелательным результатам,' + ^J +
    'в том числе к потере данных или нестабильной работе системы.' + ^J +
    'Вы действительно хотите завершить процесс "' + twProcess.Selected.Text +
    '"?', mtWarning, [mbYes, mbNo], 0) = mrYes then
  begin
    ProcID := TNodeData(twProcess.Selected.Data).ProcessEntry.th32ProcessID;
    Handlep := OpenProcess(PROCESS_TERMINATE, false, // handle inheritance flag
      ProcID); // process identifier
    Ret := TerminateProcess(Handlep, Ex);
    if Integer(Ret) = 0 then
      MessageDlg('Невозможно прервать "' + twProcess.Selected.Text + '"',
        mtInformation, [mbOK], 0)
    else;
    RefreshProcessInfo;
  end;
end;

Построение дерева окон

  TWinData = class
    ID: dword;
    Caption: string;
    ProcID: dword;
    ThreadID: dword;
    Visible: boolean;
    ClassName: string;
  end;


procedure TfmMain.RefreshWindowTree;
const
  Max_Char = 256;
var
  buflen: longint;
  buf: array [0 .. Max_Char] of Char;
  WinData: TWinData;
  ch: boolean;
begin
  ch := true;
  while hWindow <> 0 do
  begin
    WinData := TWinData.Create;
    buflen := GetWindowText(hWindow, @buf, Max_Char);
    begin
      if (buflen > 0) then
        WinData.Caption := String(buf)
      else
        WinData.Caption := '';
      WinData.ID := hWindow;
      WinData.ThreadID := GetWindowThreadProcessId(hWindow, @WinData.ProcID);
      WinData.Visible := IsWindowVisible(hWindow);
      GetClassName(hWindow, @buf, Max_Char);
      WinData.ClassName := String(buf);
      if ch then
      begin
        TreeNode := wTree.Items.AddChildObject(TreeNode, WinData.Caption + '  ['
          + WinData.ClassName + ']', WinData);
        ch := false;
      end
      else
        TreeNode := wTree.Items.AddObject(TreeNode, WinData.Caption + '  [' +
          WinData.ClassName + ']', WinData);
      if (buflen > 0) then
      begin
        TreeNode.ImageIndex := 3;
        TreeNode.SelectedIndex := 5;
      end
      else
      begin
        TreeNode.ImageIndex := 4;
        TreeNode.SelectedIndex := 2;
      end;
      RefreshWindowTree(wTree, GetWindow(hWindow, GW_CHILD), TreeNode);
    end;
    hWindow := GetWindow(hWindow, GW_HWNDNEXT);
  end;
end;

Верификация

Delphi XE5, Win7

Комментариев нет:

Отправить комментарий