VPF::Мониторинг процессов - Форум программистов

Pellegrino

Дата 13.3.2007, 19:07 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 32
Регистрация: 13.3.2007
Где: Russian Federatio n

Репутация: нет
Всего: нет

Дали задание создать приложение со следующими свойствами:
1.1.1    Используя компонент ListBox, построить список процессов, выполняющихся в системе.
1.1.2     Для выбранного процесса вывести сведения о его приоритете и количестве  потоков, об используемых им кучах используя компонент StringGrid. Процесс выбирать с помощью мыши в списке из окна Listboxа.
1.1.3     Добавить возможность завершения процессов системы с указанием процесса курсором окна ListBox. Проверить работу приложения.

Пункт 1 и 3 я выполнил, а вот со втором проблема как делать не знаю. Может, у кого есть что-то подобное готовое? Вот мой код:

Код


unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    Label1: TLabel;
    Button1: TButton;
    ListView1: TListView;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    BitBtn3: TBitBtn;
    Label2: TLabel;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    procedure Button1Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  SH: Thandle;
  Num, I: Integer;
  PPE: TProcessEntry32;
  Pr_names : array [0..50] of string;
begin
  Num := 0;
  SH := CreateToolHelp32SnapShot(Th32cs_SnapAll, 0);
  PPE.dwSize := sizeof (ProcessEntry32);
  Process32First(SH, PPE);
  Pr_Names [Num] := PPE.szExeFile;

  while Process32Next(SH, PPE) do begin
    Num := Num + 1;
    // Храним в самой строке и ProcessID
    Pr_Names [Num] := '(' + inttostr(ppe.th32ProcessID) + ') ' + PPE.szExeFile;
  end;

  Listbox1.Clear;
  for I := 0 to Num do Listbox1.Items.Add(Pr_Names[I]);
  CloseHandle(SH)
end;
function ProcessTerminate(dwPID:Cardinal):Boolean;
var
  hToken:THandle;
  SeDebugNameValue:Int64;
  tkp:TOKEN_PRIVILEGES;
  ReturnLength:Cardinal;
  hProcess:THandle;
begin
  Result:=false;
  if not OpenProcessToken(GetCurrentProcess(),
           TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY,
           hToken)
  then exit;

  if not LookupPrivilegeValue(nil, 'SeDebugPrivilege', SeDebugNameValue) then begin
    CloseHandle(hToken);
    exit;
  end;

  tkp.PrivilegeCount:= 1;
  tkp.Privileges[0].Luid := SeDebugNameValue;
  tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;

  AdjustTokenPrivileges(hToken,false,tkp,SizeOf(tkp),tkp,ReturnLength);
  if GetLastError()<> ERROR_SUCCESS then exit;

  hProcess := OpenProcess(PROCESS_TERMINATE, FALSE, dwPID);
  if hProcess = 0 then exit;

  if not TerminateProcess(hProcess, DWORD(-1)) then exit;
  CloseHandle( hProcess );

  tkp.Privileges[0].Attributes := 0;
  AdjustTokenPrivileges(hToken, FALSE, tkp, SizeOf(tkp), tkp, ReturnLength);
  if GetLastError() <>  ERROR_SUCCESS then exit;

  Result:=true;
end;


procedure TForm1.BitBtn1Click(Sender: TObject);
begin
showmessage('Good Bay!');
Close;
end;

procedure TForm1.Button3Click(Sender: TObject);
var
Sh    : Thandle;
Th    : TTHREADENTRY32;
LstIt : TlistItem;
  begin
      Sh  := CreateToolHelp32Snapshot (TH32CS_SNAPALL,0);
      Th.dwSize :=  sizeof (TTHREADEntry32);
      Thread32First(sh,Th);
      ListView1.Items.Clear;
      LstIt :=ListView1.Items.Add;
      LstIt.Caption:=IntToStr(Th.th32OwnerProcessID);
      LstIt.SubItems.Add(IntToStr(Th.tpBasePri));
   repeat
      LstIt :=ListView1.Items.Add;
      LstIt.Caption:=IntToStr(Th.th32OwnerProcessID);
      LstIt.SubItems.Add(IntToStr(Th.tpBasePri))
   until not  Thread32Next (sh,Th);
      CloseHandle(Sh);
  end;




procedure TForm1.ListBox1Click(Sender: TObject);
begin
   BitBtn2.Enabled := (ListBox1.ItemIndex <> -1);
end;

procedure TForm1.BitBtn2Click(Sender: TObject);
var s: string;
begin
  s := ListBox1.Items[ListBox1.ItemIndex];
  s := copy(s, pos('(', s) + 1, pos(')', s) - pos('(', s) - 1);
  showmessage('процесс #' + s + ' был завершен');

  ProcessTerminate(strtoint(s));
   
end;

procedure TForm1.BitBtn3Click(Sender: TObject);
var
Sh    : Thandle;
Th    : TTHREADENTRY32;
LstIt : TlistItem;
  begin
      Sh  := CreateToolHelp32Snapshot (TH32CS_SNAPALL,0);
      Th.dwSize :=  sizeof (TTHREADEntry32);
      Thread32First(sh,Th);
      ListView1.Items.Clear;
      LstIt :=ListView1.Items.Add;
      LstIt.Caption:=IntToStr(Th.th32OwnerProcessID);
      LstIt.SubItems.Add(IntToStr(Th.tpBasePri));
   repeat
      LstIt :=ListView1.Items.Add;
      LstIt.Caption:=IntToStr(Th.th32OwnerProcessID);
      LstIt.SubItems.Add(IntToStr(Th.tpBasePri))
   until not  Thread32Next (sh,Th);
      CloseHandle(Sh);
  end;

procedure TForm1.N3Click(Sender: TObject);
begin
Close;
end;

end.

MetalFan

Дата 13.3.2007, 19:17 (ссылка)

(нет голосов)

Загрузка ...

Аццкий Сотона

Профиль
Группа: Комодератор
Сообщений: 3815
Регистрация: 2.10.2006
Где: Moscow

Репутация: 16
Всего: 128

пробегало уже нечто подобное не раз... поищи на форуме

--------------------

There are always someone smarter than you...

bartram

Дата 14.3.2007, 09:31 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Комодератор
Сообщений: 1606
Регистрация: 22.2.2004
Где: Russia, Samara

Репутация: 3
Всего: 29

Компонент один есть

Цитата

madKernel encapsulates win32 APIs about processes, threads, windows, modules and much more. There are some holes in the API set Windows offers. madKernel tries to fill the holes by using undocumented stuff. Of course everything (including the undocumented stuff) works under all operating systems, from Windows 95 to Windows 2003.

madKernel is able to work on its own. However, some of the undocumented functionality only works in combination with madCodeHook.

Here comes a list of the most important features:
Processes:
· enumeration (including full file path)
· encapsulation of all important APIs
· a lot of undocumented functionality
· injecting DLLs into another process
· executing funtions in the context of another process
· much much more...
Threads:
· enumeration (including "foreign" processes)
· encapsulation of all important APIs
· a lot of undocumented functionality (e.g. OpenThread)
Windows:
· enumeration
· encapsulation of all important APIs
TrayIcons:
· enumeration (including images, including foreign processes)
· everything is undocumented here, but works alright, of course
Modules:
· enumeration (including foreign processes)
· enumeration of imported and exported functions
Handles:
· enumeration (including foreign processes)
· everything is undocumented here
Events:
· encapsulation of all APIs
· some undocumented functionality
Mutexes:

Источник
Там и найдешь ссылку на скачку, компонент бесплатный

--------------------

В каждом из нас спит гений, но с каждым днем все крепче ;-)
bartram.ru
Twitter
user posted image

Pellegrino

Дата 14.3.2007, 13:08 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 32
Регистрация: 13.3.2007
Где: Russian Federatio n

Репутация: нет
Всего: нет

Да, размерчик у компонента приличный… Мне, что ни будь поконкретнее?
Вот нашел тут одну ссылку, но она на C, а как перегнать на Delphi? И что она собственно делает то?

Код


Мониторинг выполняющихся в системе процессов – основа всех приложений для наблюдения за работой информационных систем и их пользователей. Для отслеживания появления в системе новых приложений или завершения выполнявшихся можно использовать два способа:
1.    периодическое выполнение снимка состояния системы и его анализ, для чего приложение, рассмотренное в п.1.1.1, подключается к обработчику прерываний таймера. Это просто, но неэффективно – приложения не запускаются и не завершаются то и дело.
2.    подключение к процедуре запуска и завершения процессов с помощью функции ядра PsSetCreateProcessNotifyRoutine(), описанной в Windows 2000 DDK, путем регистрации функции обратного вызова. Это не так просто, как хотелось бы, но более эффективно.

1.4 Функция NtQuerySystemInformation

Различная системная информация доступна через функцию NtQuerySystemInformation.
Описание приведено в стиле С для интересующихся.
NTSTATUS  NtQuerySystemInformation(
IN SYSTEM_INFORMATION_CLASS SystemInformationClass,
IN OUT PVOID SystemInformation,
IN ULONG SystemInformationLength,
OUT PULONG ReturnLength OPTIONAL
        );
SystemInformationClass указывает тип информации, которую необходимо получить, SystemInformation - это указатель на результирующий буфер,
SystemInformationLength - размер этого буфера,
ReturnLength – количество записанных байт.
        Для перечисления запущенных процессов следует установить в параметр SystemInformationClass значение SystemProcessesAndThreadsInformation.
        #define SystemInformationClass 5
        Возвращаемая структура в буфере SystemInformation:
        typedef struct _SYSTEM_PROCESSES {
                ULONG NextEntryDelta;
                ULONG ThreadCount;
                ULONG Reserved1[6];
                LARGE_INTEGER CreateTime;
                LARGE_INTEGER UserTime;
                LARGE_INTEGER KernelTime;
                UNICODE_STRING ProcessName;
                KPRIORITY BasePriority;
                ULONG ProcessId;
                ULONG InheritedFromProcessId;
                ULONG HandleCount;
                ULONG Reserved2[2];
                VM_COUNTERS VmCounters;
                IO_COUNTERS IoCounters;  // только Windows 2000
                SYSTEM_THREADS Threads[1];
        } SYSTEM_PROCESSES, *PSYSTEM_PROCESSES;

bartram

Дата 14.3.2007, 16:24 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Комодератор
Сообщений: 1606
Регистрация: 22.2.2004
Где: Russia, Samara

Репутация: 3
Всего: 29

Цитата(Pellegrino @ 14.3.2007, 13:08

)

Да, размерчик у компонента приличный… Мне, что ни будь поконкретнее?

Pellegrino, там просто это компонент не один, там есть ещё компоненты которые тебе пригодились бы. Зачем переводить что то с Си когда для Delphi уже давно все написано smile

Не знаю почему для тебя размер имеет такое большое значение, он как раз удовлетворяет все твои потребности smile

Если не согласен, юзай поиск по форуму smile

--------------------

В каждом из нас спит гений, но с каждым днем все крепче ;-)
bartram.ru
Twitter
user posted image

Pellegrino

Дата 14.3.2007, 20:05 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 32
Регистрация: 13.3.2007
Где: Russian Federatio n

Репутация: нет
Всего: нет

Да мне нужно всего то, что бы из ListBox’a выбрать процесс нажать кнопочку и в другом ListBox’e, что бы появились сведения о приоритете процесса и количестве его потоков.

bartram

Дата 14.3.2007, 23:15 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Комодератор
Сообщений: 1606
Регистрация: 22.2.2004
Где: Russia, Samara

Репутация: 3
Всего: 29

Цитата(Pellegrino @ 14.3.2007, 20:05

)

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

Вот некоторые из них

Код


CONST  //Статус константы
  STATUS_SUCCESS              = NTStatus($00000000);
  STATUS_ACCESS_DENIED        = NTStatus($C0000022);
  STATUS_INFO_LENGTH_MISMATCH = NTStatus($C0000004);
  SEVERITY_ERROR              = NTStatus($C0000000);

Код


Function ZwQueryInformationProcess(
                                ProcessHandle:THANDLE;
                                ProcessInformationClass:DWORD;
                                ProcessInformation:pointer;
                                ProcessInformationLength:ULONG;
                                ReturnLength:PULONG):NTStatus;stdcall;
                                external 'ntdll.dll';

Код


Function ZwQuerySystemInformation(ASystemInformationClass: dword;
                                  ASystemInformation: Pointer;
                                  ASystemInformationLength: dword;
                                  AReturnLength:PCardinal): NTStatus;
                                  stdcall;external 'ntdll.dll';

Код


const// SYSTEM_INFORMATION_CLASS 
  SystemBasicInformation                  =    0;
  SystemProcessorInformation              =    1;
  SystemPerformanceInformation          =    2;
  SystemTimeOfDayInformation            =    3;
  SystemNotImplemented1                =    4;
  SystemProcessesAndThreadsInformation    =    5;
  SystemCallCounts                        =    6;
  SystemConfigurationInformation          =    7;
  SystemProcessorTimes                 =    8;
  SystemGlobalFlag                     =    9;
  SystemNotImplemented2                =    10;
  SystemModuleInformation              =    11;
  SystemLockInformation                    =    12;
  SystemNotImplemented3                    =    13;
  SystemNotImplemented4                 =    14;
  SystemNotImplemented5                    =    15;
  SystemHandleInformation               =    16;
  SystemObjectInformation                  =    17;
  SystemPagefileInformation             =    18;
  SystemInstructionEmulationCounts        =    19;
  SystemInvalidInfoClass                =    20;
  SystemCacheInformation                  =    21;
  SystemPoolTagInformation             =    22;
  SystemProcessorStatistics                =    23;
  SystemDpcInformation                 =    24;
  SystemNotImplemented6                    =    25;
  SystemLoadImage                          =    26;
  SystemUnloadImage                        =    27;
  SystemTimeAdjustment                  =    28;
  SystemNotImplemented7                =    29;
  SystemNotImplemented8                    =    30;
  SystemNotImplemented9                =    31;
  SystemCrashDumpInformation           =    32;
  SystemExceptionInformation           =    33;
  SystemCrashDumpStateInformation       =    34;
  SystemKernelDebuggerInformation      =    35;
  SystemContextSwitchInformation          =    36;
  SystemRegistryQuotaInformation          =    37;
  SystemLoadAndCallImage                =    38;
  SystemPrioritySeparation              =    39;
  SystemNotImplemented10               =    40;
  SystemNotImplemented11               =    41;
  SystemInvalidInfoClass2               =    42;
  SystemInvalidInfoClass3              =    43;
  SystemTimeZoneInformation             =    44;
  SystemLookasideInformation           =    45;
  SystemSetTimeSlipEvent               =    46;
  SystemCreateSession                  =    47;
  SystemDeleteSession                   =    48;
  SystemInvalidInfoClass4               =    49;
  SystemRangeStartInformation          =    50;
  SystemVerifierInformation            =    51;
  SystemAddVerifier                     =    52;
  SystemSessionProcessesInformation    =    53;


type
PClientID = ^TClientID;
TClientID = packed record
 UniqueProcess:cardinal;
 UniqueThread:cardinal;
end;

Это сообщение отредактировал(а) bartram - 14.3.2007, 23:17

--------------------

В каждом из нас спит гений, но с каждым днем все крепче ;-)
bartram.ru
Twitter
user posted image

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: WinAPI и системное программирование \| Следующая тема »