Процессы в памяти Опции

[arhimag]

Как получить активные процессы но компьютере, через Delphi? а именно их названия?

[Артемий]

Из Drkb:

Автор: Василий

Программа не видна по Ctrl+Alt+Del, и сама оттуда же может спрятать любой из процессов(правда, не все с самого начала "светятся" по Ctrl+Alt+Del) или завершить его. Простой пример для знакомства с ToolHelp32.
В исходном коде есть недоработки, например, процедура Delproc получает в качестве параметра строку, затем переводит ее в целочисленный тип(integer), хотя можно передавать сразу число. Заморочка была в проверке числа-индекса на подлинность, а так как я выдрал часть кода из более ранней своей проги, я не стал это менять, а просто подогнал до рабочей версии. Оптимизацией кода вы можете заняться сами по желанию(вы можете, если хотите, а если не хотите, то вы не обязаны, вы посто могли бы... да... )) Программа не работала в WinNT 4.0, но в Win9x работать должна.

unit main;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, tlhelp32, StdCtrls, ComCtrls, Buttons;

type
TForm1 = class(TForm)
ListBox1: TListBox;
Button1: TButton;
Button2: TButton;
Button4: TButton;
Button5: TButton;
StatusBar1: TStatusBar;
Button6: TButton;
procedure Button4Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure ListBox1Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
private
{ Private declarations }
procedure ListProcesses;
procedure Delproc(numb:string);
public
{ Public declarations }
end;

var
Form1: TForm1;
processID:array[1..50] of integer;

function RegisterServiceProcess(dwProcessID,dwType:integer):integer;stdcall;external 'kernel32.dll';

implementation

{$R *.DFM}

procedure TForm1.delproc(numb:string);
var
c1:Cardinal;
pe:TProcessEntry32;
s1,s2:string;
x:integer;
begin
x:=0;
try
Strtoint(numb);
except
Statusbar1.SimpleText:='Invalid number';
exit;
end;
c1:=CreateToolHelp32Snapshot(TH32CS_SnapProcess,0);
if c1=INVALID_HANDLE_VALUE then
begin
Statusbar1.SimpleText:='Process listing failed';
exit;
end;
try
pe.dwSize:=sizeof(pe);
if Process32First(c1,pe) then
repeat
inc(x);
s1:=ExtractFileName(pe.szExeFile);
s2:=ExtractFileExt(s1);
Delete(s1,length(s1)+1-length(s2),maxInt);
if x=strtoint(numb) then
if terminateprocess(OpenProcess(PROCESS_ALL_ACCESS,false,pe.th32ProcessID),1)
then begin
Statusbar1.SimpleText:='Process '+s1+' terminated.';
end
else Statusbar1.SimpleText:=('Couldnt terminate process'+pe.szExeFile);
until not Process32Next(c1,pe);
finally CloseHandle(c1);
end;
end;

procedure Tform1.ListProcesses;
var c1:Cardinal;
pe:TProcessEntry32;
s1,s2:string;
x:integer;
begin
X:=0;
c1:=CreateToolHelp32Snapshot(TH32CS_SnapProcess,0);
if c1=INVALID_HANDLE_VALUE then
begin
Statusbar1.SimpleText:=('Информация о процессах закрыта.');
exit;
end;
try
pe.dwSize:=sizeof(pe);
if Process32First(c1,pe) then
repeat
inc(x);
s1:=ExtractFileName(pe.szExeFile);
s2:=ExtractFileExt(s1);
Delete(s1,length(s1)+1-length(s2),maxInt);
Listbox1.Items.Add(Inttostr(x)+' '+s1+' : '+pe.szExeFile);
ProcessId[x]:=pe.th32ProcessID;
//ListBox1.Items.Add(inttostr(pe.th32ProcessID));
until not Process32Next(c1,pe);
finally CloseHandle(c1);
end;

end;



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

procedure TForm1.FormCreate(Sender: TObject);
begin
Button1.Enabled:=false;
Button5.Enabled:=false;
Button6.Enabled:=false;
ListProcesses;
if not (csDesigning in ComponentState) then
RegisterServiceProcess(GetCurrentProcessID,1);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
Listbox1.Clear;
ListProcesses;
end;

procedure TForm1.Button1Click(Sender: TObject);
var p:integer;
begin
//hide
with Listbox1 do
p:=Listbox1.Items.IndexOf(Listbox1.items[itemindex])+1;
if not (csDesigning in ComponentState) then
RegisterServiceProcess(ProcessID[p],1);
with Listbox1 do
StatusBar1.SimpleText:=(Listbox1.items[itemindex]+ ' hidden');
end;

procedure TForm1.Button5Click(Sender: TObject);
var p:integer;
begin
//show
with Listbox1 do
p:=Listbox1.Items.IndexOf(Listbox1.items[itemindex])+1;
if not (csDesigning in ComponentState) then
RegisterServiceProcess(ProcessID[p],0);
with Listbox1 do
StatusBar1.SimpleText:=(Listbox1.items[itemindex]+ ' shown');
end;

procedure TForm1.ListBox1Click(Sender: TObject);
begin
Button1.Enabled:=true;
Button5.Enabled:=true;
Button6.Enabled:=true;
end;

procedure TForm1.Button6Click(Sender: TObject);
var p:integer;
begin
with Listbox1 do
p:=Listbox1.Items.IndexOf(Listbox1.items[itemindex])+1;
delproc(inttostr(p));
end;

end.

[klem4]

Вот недавно делал лабу, тут еще добавление в БД, можно удалить

procedure TfrmProcList.btnGetProcListClick(Sender: TObject);
var
  N: DWORD;
  i, Module: Byte;
  _HANDLE: THandle;
  Error: PChar;
  s: array [byte] of Char;
  ModuleID:array[1..1] of dword;
  ProcessID:array[byte] of dword;

  ProcName, UserName: String;
  currentTime: TTime;

begin
  M.Lines.Clear;

  try
    EnumProcesses(@ProcessID, 255, N);
  except on E: Exception do begin
    MessageDlg('Не удалось получить список процессов', mtError, [mbOk], 0);
    Abort;
  end;
  end;

  N := SizeOf(ProcessID) div SizeOf(DWORD);
  FillChar(s, SizeOf(s), #0);
  UserName := GetUserFromWindows;
  currentTime := Now;

  tblUser.Append;
  tblUser.FieldByName('U_Name').AsString := UserName;
  tblUser.FieldByName('U_Time').AsDateTime := currentTime;
  tblUser.Post;

  tblProc.MasterSource := dsUser;
  tblProc.IndexName := 'idxP_UID';

  for i := 0 to pred(N) do try
    _HANDLE := OpenProcess(PROCESS_QUERY_INFORMATION+PROCESS_VM_READ
                                   +SYNCHRONIZE, false, ProcessID[i]);
    if _HANDLE > 0 then begin

      EnumProcessModules(_HANDLE, @ModuleID, 4, N);

      Module := GetModuleFileNameEx(_HANDLE, ModuleID[1], @s, SizeOf(s));

      if Module > 0 then begin

         ProcName := ExtractFileName(s);

         if (edtMask.Text = '') or (Pos(edtMask.Text, ProcName) <> 0) then
          M.Lines.Add(Format('%s : %d', [ ProcName , ProcessID[i] ]));

         tblProc.Append;
         tblProc.FieldByName('P_ProcName').AsString := ProcName;
         tblProc.FieldByName('P_ProcID').AsInteger := ProcessID[i];
         tblProc.Post;
      end;
    end;
  CloseHandle(_Handle);
  except on E: Exception do MessageDlg('Ошибка при обработке процесса: ' + E.Message, mtError, [mbOk], 0);
  end;

end;

 M.Lines.Add(Format('%s : %d', [ ProcName , ProcessID[i] ])); // M - Мемо

[arhimag]

klem4, а ты не мог бы весь код приложить? Просто что-то скомпилить не могу

Код

    EnumProcesses(@ProcessID, 255, N);

На это ругается

Добавлено через 8 мин.
Предыдущий вопрос снят, вопрос следующий вот нашел я процесс, например opera как мне получить сайты, на которых сейчас висит пользователь?

Сообщение отредактировано: arhimag - 12.05.2007 18:33

[volvo]

Если поможет, могу рассказать, как добраться до названий закладок (Tab-ов) в браузере Опера.

[arhimag]

Volvo, очень поможет, буду благодарен. А как добраться до названия закладок в FireFox и названия окна IE, случайно не знаешь?
Но даже за оперу буду очень благодарен.

Сообщение отредактировано: arhimag - 14.05.2007 14:27

[volvo]

Положи на форму TreeView, кнопку, и на OnClick кнопки вызывай вот это:

procedure TForm1.Sys_Windows_Tree(Node: TTreeNode;
  AHandle: HWND; ALevel: Integer);
type
  TRootNodeData = record
    Node: TTreeNode;
    PID: Cardinal;
  end;
var
  szClassName, szCaption, szLayoutName: array[0..MAXCHAR - 1] of Char;
  szFileName : array[0..MAX_PATH - 1] of Char;
  Result: String;
  PID, TID: Cardinal;
  I: Integer;
  RootItems: array of TRootNodeData;
  IsNew: Boolean;
begin
  while AHandle <> 0 do begin
    GetClassName(AHandle, szClassName, MAXCHAR);
    GetWindowText(AHandle, szCaption, MAXCHAR);
    if GetWindowModuleFilename(AHandle, szFileName, SizeOf(szFileName)) = 0 then
      FillChar(szFileName, 256, #0);
    TID := GetWindowThreadProcessId(AHandle, PID);

    AttachThreadInput(GetCurrentThreadId, TID, True);
    VerLanguageName(GetKeyboardLayout(TID) and $FFFF, szLayoutName, MAXCHAR);
    AttachThreadInput(GetCurrentThreadId, TID, False);

    Result := Format('%s [%s] Caption = %s, Handle = %d, Layout = %s',
      [String(szClassName), String(szFileName), String(szCaption),
      AHandle, String(szLayoutName)]);

    if ALevel in [0..1] then begin
      IsNew := True;
      for I := 0 to Length(RootItems) - 1 do
        if RootItems[I].PID = PID then begin
          Node := RootItems[I].Node;
          IsNew := False;
          Break;
        end;
      if IsNew then begin
        SetLength(RootItems, Length(RootItems) + 1);
        RootItems[Length(RootItems) - 1].PID := PID;
        RootItems[Length(RootItems) - 1].Node :=

          TreeView1.Items.AddChild(nil, 'PID: ' + IntToStr(PID));
        Node := RootItems[Length(RootItems) - 1].Node;
      end;
    end;

    Sys_Windows_Tree(TreeView1.Items.AddChild(Node, Result),
      GetWindow(AHandle, GW_CHILD), ALevel + 1);

    AHandle := GetNextWindow(AHandle, GW_HWNDNEXT);
  end;
end;

© Rouse_

Так как ProcessID тебе известен, то открой дерево этого процесса, и посмотри там, где я показал на скриншоте (находишь дочернее окно класса OpWindow, у которого есть потомок класса OUIWINDOW, и у него ищешь потомки классов OperaWindowClass -> OpWindow -> (все потомки этого окна - открытые на данный момент закладки Оперы))... То же самое можно сделать и не выводя ненужную информацию в TreeView...

С FireFox-ом все несколько сложнее: сами-то закладки найти можно, это окна в следующей иерархии:
MozillaUIWindowClass -> MozillaWindowClass -> (все дочерние окна - Tab-ы), но вот Caption их почему-то не определяется...

Так же можно посмотреть и то, что касается IE... Экспериментируй...

Добавлено через 3 мин.
А, да... Совсем забыл - вызывать вот так:

procedure TForm1.Button1Click(Sender: TObject);
begin
  Sys_Windows_Tree(nil, GetDesktopWindow, 0);
end;

Сообщение отредактировано: volvo - 14.05.2007 15:15

[arhimag]

Спасибо, помог. Буду дальше эксперементировать.