[xNeKiToSx]

привет всем. как можно получить список запущеных процессов (а не окон) и делать различные операции(приоритет, завершение, проверка пользователя и занятой ОП)?... прийму любые ссылки на статьи спасибо заранее за помощь) у меня есть исходник диспетчера задач. хорошая штука но все равно не могу с него ничего слить))) в коде путаюсь... помогите написать программу типа - кнопка и мемо. нажимаю на кнопку и в мемо список текущих процессов... все заранее спасибо!

[angvelem]

Подойдёт?

Код:

procedure TForm1.Button1Click(Sender: TObject);
var
  Wnd: hWnd;
  buff: array[0..127] of Char;
begin
  ListBox1.Clear;
  Wnd := GetWindow(Handle, GW_HWNDFIRST);
  while Wnd <> 0 do
  begin
    if (Wnd <> Application.Handle) and IsWindowVisible(Wnd) and (GetWindow(Wnd, GW_OWNER) = 0) and (GetWindowText(Wnd, buff, SizeOf(buff)) <> 0) then
    begin
      GetWindowText(Wnd, buff, SizeOf(buff));
      ListBox1.Items.Add(StrPas(buff));
    end;
    Wnd := GetWindow(Wnd, GW_HWNDNEXT);
  end;
  ListBox1.ItemIndex := 0;
end;

вот ещё:

Код:

procedure GetProcessList(var sl: TStrings);
var
  pe : TProcessEntry32;
  ph, snap : THandle; //дескрипторы процесса и снимка
  mh : hmodule; //дескриптор модуля
  procs : array[0..$FFF] of dword; //массив для хранения дескрипторов процессов
  count, cm : cardinal; //количество процессов
  I : Integer;
  ModName: array[0..max_path] of char; //имя модуля
begin
  sl.Clear;
  if Win32Platform = VER_PLATFORM_WIN32_WINDOWS then
  begin //если это Win9x
    snap := CreateToolhelp32Snapshot(th32cs_snapprocess, 0);
    if integer(snap) = -1 then
    begin
      exit;
    end
    else
    begin
      pe.dwSize := sizeof(pe);
      if Process32First(snap, pe) then
        repeat
          sl.Add(string(pe.szExeFile));
        until not Process32Next(snap, pe);
    end;
  end
  else
  begin //Если WinNT/2000/XP
    if not EnumProcesses(@procs, sizeof(procs), count) then
      Exit;

    for I := 0 to count div 4 - 1 do
    begin
      ph := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ,
        False, procs[i]);
      if ph > 0 then
      begin
        EnumProcessModules(ph, @mh, 4, cm);
        GetModuleFileNameEx(ph, mh, ModName, sizeof(ModName));
        sl.Add(string(ModName));
        CloseHandle(ph);
      end;
    end;
  end;
end;

Пример использования: 

procedure TForm1.Button1Click(Sender: TObject);
var
  tmp: TStrings;
begin
  tmp := memo1.Lines;
  GetProcessList(tmp);
end;

[xNeKiToSx]

спасибо большое, сейчас проверю)

[xNeKiToSx]

хм неизвестный индетификатор EnumProcesses(@procs, sizeof(procs), count)

[xNeKiToSx]

спасибо) разобрался) 2 код хорош)

[Zorkov Igor]

Код:

function AdjustCurrentProcessPrivileges(PrivilegeName: WideString): Boolean;
var
  TokenHandle: THandle;
  TokenPrivileges: TTokenPrivileges;
  ReturnLength: DWORD;
begin
  Result := False;
  try
    if OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, TokenHandle) then
    begin
      try
        LookupPrivilegeValueW(nil, PWideChar(PrivilegeName), TokenPrivileges.Privileges[0].Luid);
        TokenPrivileges.PrivilegeCount := 1;
        TokenPrivileges.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
        if AdjustTokenPrivileges(TokenHandle, False, TokenPrivileges, 0, nil, ReturnLength) then
          Result := True;
      finally
        CloseHandle(TokenHandle);
      end;
    end;
  except
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  //Получаем привилегии отладчика что бы можно было открывать и завершать системные процессы
  AdjustCurrentProcessPrivileges('SeDebugPrivilege');
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  ProcessHandle: THandle;
begin
  ProcessHandle:= OpenProcess(PROCESS_TERMINATE, True, StrToInt(Edit1.Text));
  if ProcessHandle <> 0 then
  begin
    try
      if not TerminateProcess(ProcessHandle, 0) then
        ShowMessage('Невозмжно завершить процесс (' + Edit1.Text + ')');
    finally
      CloseHandle(ProcessHandle);
    end;
  end
  else
  begin
    ShowMessage('Невозмжно открыть процесс (' + Edit1.Text + ')');
  end;
end;

[Zorkov Igor]

В разных ОС для некоторых процессов получить имя пользователя можно только с помощью драйвера

Код:

procedure TForm1.Button1Click(Sender: TObject);
var
  ReturnLength: DWORD;
  peUse: SID_NAME_USE;
  SIDAndAttributes: PSIDAndAttributes;
  Domain, Name: PWideChar;
  ProcessHandle, TokenHandle: THandle;
begin
  // Vista и выше PROCESS_QUERY_LIMITED_INFORMATION = $1000;
  ProcessHandle := OpenProcess(PROCESS_QUERY_INFORMATION, True, StrToInt(Edit1.Text));
  if ProcessHandle <> 0 then
  begin
    try
      if OpenProcessToken(ProcessHandle, TOKEN_QUERY, TokenHandle) then
      begin
        try
          GetTokenInformation(TokenHandle, TokenUser, nil, 0, ReturnLength);
          GetMem(SIDAndAttributes, ReturnLength);
          if SIDAndAttributes <> nil then
          begin
            try
              if GetTokenInformation(TokenHandle, TokenUser, SIDAndAttributes, ReturnLength, ReturnLength) then
              begin
                ReturnLength := MAX_PATH;
                GetMem(Name, ReturnLength);
                GetMem(Domain, ReturnLength);
                try
                  if LookupAccountSidW(nil, SIDAndAttributes.SID, Name, ReturnLength, Domain, ReturnLength, peUse) then
                    ShowMessage(Domain + '/' + Name);
                finally
                  FreeMem(Name);
                  FreeMem(Domain);
                end;
              end;
            finally
              FreeMem(SIDAndAttributes, ReturnLength);
            end;
          end;
        finally
          CloseHandle(TokenHandle);
        end;
      end;
    finally
      CloseHandle(ProcessHandle);
    end;
  end
  else
  begin
    ShowMessage('Невозможно открыть процесс (' + Edit1.Text + ')');
  end;
end;

[Zorkov Igor]

Код:

procedure TForm1.Button1Click(Sender: TObject);
const
  ABOVE_NORMAL_PRIORITY_CLASS = $00008000;
  BELOW_NORMAL_PRIORITY_CLASS = $00004000;
var
  ProcessHandle: THandle;
begin
  ProcessHandle := OpenProcess(PROCESS_SET_INFORMATION, True, StrToInt(Edit1.Text));
  if ProcessHandle <> 0 then
  begin
    try
      if not SetPriorityClass(ProcessHandle, HIGH_PRIORITY_CLASS) then
        ShowMessage('Невозможно установить приоритет процессу (' + Edit1.Text + ')');
    finally
      CloseHandle(ProcessHandle);
    end;
  end
  else
  begin
    ShowMessage('Невозможно открыть процесс (' + Edit1.Text + ')');
  end;
end;

[Zorkov Igor]

Код:

procedure TForm1.Button1Click(Sender: TObject);
const
  ABOVE_NORMAL_PRIORITY_CLASS = $00008000;
  BELOW_NORMAL_PRIORITY_CLASS = $00004000;
  PROCESS_QUERY_LIMITED_INFORMATION = $1000;
var
  ProcessHandle: THandle;
  PriorityClass: DWORD;
begin
  ProcessHandle := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_QUERY_INFORMATION, True, StrToInt(Edit1.Text));
  if ProcessHandle <> 0 then
  begin
    try
      PriorityClass := GetPriorityClass(ProcessHandle);
      case PriorityClass of
        IDLE_PRIORITY_CLASS:
          ShowMessage('Приоритет процесса (' + Edit1.Text + '): IDLE_PRIORITY_CLASS');
        BELOW_NORMAL_PRIORITY_CLASS:
          ShowMessage('Приоритет процесса (' + Edit1.Text + '): BELOW_NORMAL_PRIORITY_CLASS');
        NORMAL_PRIORITY_CLASS:
          ShowMessage('Приоритет процесса (' + Edit1.Text + '): NORMAL_PRIORITY_CLASS');
        ABOVE_NORMAL_PRIORITY_CLASS:
          ShowMessage('Приоритет процесса (' + Edit1.Text + '): ABOVE_NORMAL_PRIORITY_CLASS');
        HIGH_PRIORITY_CLASS:
          ShowMessage('Приоритет процесса (' + Edit1.Text + '): HIGH_PRIORITY_CLASS');
        REALTIME_PRIORITY_CLASS:
          ShowMessage('Приоритет процесса (' + Edit1.Text + '): REALTIME_PRIORITY_CLASS');
      end;
    finally
      CloseHandle(ProcessHandle);
    end;
  end
  else
  begin
    ShowMessage('Невозможно открыть процесс (' + Edit1.Text + ')');
  end;
end;

[Zorkov Igor]

Код:

procedure TForm1.Timer1Timer(Sender: TObject);
var
  SnapShot: THandle;
  ProcessEntry32: TProcessEntry32;
  ProcessHandle: THandle;
  PriorityClass: DWORD;
begin
  ListBox1.Items.BeginUpdate;
  try
    ListBox1.Items.Clear;
    SnapShot := CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS, 0);
    if SnapShot <> INVALID_HANDLE_VALUE then
    begin
      try
        ProcessEntry32.dwSize := SizeOf(TProcessEntry32);
        while Process32Next(SnapShot, ProcessEntry32) = True do
        begin
          PriorityClass:= 0;

          ProcessHandle := OpenProcess(PROCESS_QUERY_INFORMATION, True, ProcessEntry32.th32ProcessID);

          if ProcessHandle <> 0 then
          begin
            try
              PriorityClass:= GetPriorityClass(ProcessHandle);
            finally
              CloseHandle(ProcessHandle);
            end;
          end;

          ListBox1.Items.Add(ProcessEntry32.szExeFile  + ' Приоритет: ' + IntToStr(PriorityClass));
        end;
      finally
        CloseHandle(SnapShot);
      end;
    end;
  finally
    ListBox1.Items.EndUpdate;
  end;
end;

[Helpix]

Сообщение от xNeKiToSx

спасибо) разобрался) 2 код хорош)

Если разобрался, так поделись с другими?

Подключить еще нужно в uses Psapi и tlhelp32