Модераторы: Snowy, bartram, MetalFan, bems, Poseidon, Riply
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Нагрузка отдельных потоков на систему 
V
    Опции темы
aktuba
Дата 4.6.2007, 11:53 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Смышленный
***


Профиль
Группа: Завсегдатай
Сообщений: 1915
Регистрация: 24.4.2006
Где: Планета Земля

Репутация: 2
Всего: 38
Есть такая задача: необходимо выяснить, на сколько каждый поток системы грузит саму систему. Как решить - понятия не имею, может подскажет кто?

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


--------------------
user posted image
PM MAIL WWW Skype   Вверх
Rennigth
Дата 4.6.2007, 12:29 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Участник Клуба
Сообщений: 1708
Регистрация: 21.6.2004
Где: Moscow

Репутация: 8
Всего: 76
Цитата(aktuba @  4.6.2007,  11:53 Найти цитируемый пост)
получить указатели на все потоки системы и определить, какой поток какому приложению соответствует...


хм:

Процессы:
Код

function GetProcessesList: TList;
var
  lSnapHandle: THandle;
  lProcStruct: PROCESSENTRY32;
  pProcStruct: PPROCESSENTRY32;
begin
  Result := TList.Create;
  lSnapHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  if lSnapHandle <> INVALID_HANDLE_VALUE then
  begin
    ZeroMemory(@lProcStruct, SizeOf(PROCESSENTRY32));
    lProcStruct.dwSize := SizeOf(PROCESSENTRY32);

    if Process32First(lSnapHandle, lProcStruct) then
    repeat
      pProcStruct := GetMemory(SizeOf(PROCESSENTRY32));
      MoveMemory(pProcStruct, @lProcStruct, SizeOf(PROCESSENTRY32));
      Result.Add(pProcStruct);
    until not Process32Next(lSnapHandle, lProcStruct);

    CloseHandle(lSnapHandle);
  end else
    raise EExternalException.Create(GetLastErrorString);
end;


Потоки:
Код

function GetThreadsOfProcess(APID: DWORD): TList;
var
  lSnap: THandle;
  lThread: THREADENTRY32;
  pThread: PTHREADENTRY32;
begin
  Result := TList.Create;
  lSnap := CreateToolhelp32Snapshot(TH32CS_SNAPTHREAD, 0);
  if (lSnap <> INVALID_HANDLE_VALUE) then
  begin
    lThread.dwSize := SizeOf(THREADENTRY32);
    if Thread32First(lSnap, lThread) then
    repeat
      if lThread.th32OwnerProcessID = APID then
      begin
        pThread := GetMemory(SizeOf(THREADENTRY32));
        MoveMemory(pThread, @lThread, SizeOf(THREADENTRY32));
        Result.Add(pThread);
      end;
    until not Thread32Next(lSnap, lThread);
    CloseHandle(lSnap);
  end else
    raise EExternalException.Create(GetLastErrorString);
end;


Но я думаю что проблема у тебя не с этим.

Точно выяснить сколько поток хавает процессорного времени (читай тактов проца на единицу времени(не забывай что зависит от мощности проца)) думаю не получися :( Винда так устроена...

Объясни подробнее что ты хочешь, что тебе надо в итоге? 

Привелегиями не обойдешся?




--------------------
(* Honesta mors turpi vita potior *)
PM MAIL ICQ   Вверх
aktuba
Дата 4.6.2007, 12:30 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Смышленный
***


Профиль
Группа: Завсегдатай
Сообщений: 1915
Регистрация: 24.4.2006
Где: Планета Земля

Репутация: 2
Всего: 38
Получение списка процессов и потоков к этим процессам сделал. А вот как теперь определить, насколько каждый из потоков в отдельности грузит систему - не знаю. Кто-нибудь поможет?


--------------------
user posted image
PM MAIL WWW Skype   Вверх
MetalFan
Дата 4.6.2007, 12:40 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


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


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

Репутация: 16
Всего: 128
эт врядли узнаешь. система не предоставляет такой информации вроде...


--------------------
There are always someone smarter than you...
PM MAIL   Вверх
aktuba
Дата 4.6.2007, 12:56 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Смышленный
***


Профиль
Группа: Завсегдатай
Сообщений: 1915
Регистрация: 24.4.2006
Где: Планета Земля

Репутация: 2
Всего: 38
Цитата

Объясни подробнее что ты хочешь, что тебе надо в итоге? 

Привелегиями не обойдешся?


Привелегиями не обойдусь =((( Надо выяснить, насколько каждый поток каждого процесса грузит систему. Если еще точнее - то насколько каждый поток ОПРЕДЕЛЕННОГО приложения грузит систему ("сколько поток хавает процессорного времени"). Вот именно эту задачу и надо решить...


--------------------
user posted image
PM MAIL WWW Skype   Вверх
aktuba
Дата 4.6.2007, 14:06 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Смышленный
***


Профиль
Группа: Завсегдатай
Сообщений: 1915
Регистрация: 24.4.2006
Где: Планета Земля

Репутация: 2
Всего: 38
Так, есть зацепка: GetThreadTimes

Делаю так:
Код

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, TLHelp32;

type
  TForm1 = class(TForm)
    Button1: TButton;
    ListBox1: TListBox;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
    procedure LoadProcessID(Str:TStrings);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

const
  THREAD_SUSPEND_RESUME  = $00000002;

function OpenThread(dwDesiredAccess: DWord; bInheritHandle: Bool; dwThreadId: DWord): DWord; stdcall; external 'kernel32.dll';

{$R *.dfm}

function FileTimeToDateTime(ftFileTime : _FILETIME):TDateTime;
var
  SysTime : _SYSTEMTIME;
begin
  FileTimeToLocalFileTime(ftFileTime,ftFileTime);
  FileTimeToSystemTime(ftFileTime, SysTime);
  Result := EncodeDate(SysTime.wYear, SysTime.wMonth, SysTime.wDay)+
    EncodeTime(SysTime.wHour, SysTime.wMinute, SysTime.wSecond, SysTime.wMilliseconds);
end;

function NTSetPrivilege(sPrivilege: string; bEnabled: Boolean): Boolean; 
var 
  hToken: THandle; 
  TokenPriv: TOKEN_PRIVILEGES; 
  PrevTokenPriv: TOKEN_PRIVILEGES; 
  ReturnLength: Cardinal; 
begin 
  Result := True; 
  // Only for Windows NT/2000/XP and later. 
  if not (Win32Platform = VER_PLATFORM_WIN32_NT) then Exit; 
  Result := False; 

  // obtain the processes token 
  if OpenProcessToken(GetCurrentProcess(), 
    TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) then 
  begin 
    try 
      // Get the locally unique identifier (LUID) . 
      if LookupPrivilegeValue(nil, PChar(sPrivilege), 
        TokenPriv.Privileges[0].Luid) then 
      begin 
        TokenPriv.PrivilegeCount := 1; // one privilege to set 

        case bEnabled of 
          True: TokenPriv.Privileges[0].Attributes  := SE_PRIVILEGE_ENABLED; 
          False: TokenPriv.Privileges[0].Attributes := 0; 
        end; 

        ReturnLength := 0; // replaces a var parameter 
        PrevTokenPriv := TokenPriv; 

        // enable or disable the privilege 

        AdjustTokenPrivileges(hToken, False, TokenPriv, SizeOf(PrevTokenPriv), 
          PrevTokenPriv, ReturnLength); 
      end; 
    finally 
      CloseHandle(hToken); 
    end; 
  end; 
  // test the return value of AdjustTokenPrivileges. 
  Result := GetLastError = ERROR_SUCCESS; 
  if not Result then 
    raise Exception.Create(SysErrorMessage(GetLastError)); 
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
  Listbox1.Items.Clear;
  LoadProcessID(ListBox1.Items);
end;

procedure TForm1.LoadProcessID(Str: TStrings);
var
  HProcess, H:    THandle;
  Process32:   TProcessEntry32;
  Next:        BOOL;
  HThread:     THandle;
  Thread32:    TThreadEntry32;
  Next2:       BOOL;
  i:           Integer;
  TempS:       String;
  tm1, tm2, tm3, tm4: TFileTime;
begin
  Process32.dwSize:=SizeOf(TProcessEntry32);
  HProcess:=CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS,0);
  Thread32.dwSize:=SizeOf(TThreadEntry32);
  HThread:=CreateToolHelp32Snapshot(TH32CS_SNAPTHREAD,0);
  if not (Process32First(HProcess,Process32) and Thread32First(HThread,Thread32)) then
    begin
    ShowMessage('Error Operation!');
    Exit;
    end;
  Repeat
  TempS:='Èìÿ ïðîöåññà: '+String(Process32.szExeFile)+' - PID: '+IntToStr(Process32.th32ProcessID);
  Str.Add(TempS);
  i:=0;
     Repeat
     if Thread32.th32OwnerProcessID=Process32.th32ProcessID then
       begin
       Inc(i);
       NTSetPrivilege('SeDebugPrivilege', True);
       H := OpenThread(THREAD_SUSPEND_RESUME, False, Thread32.th32ThreadID);
       if H = 0 then
        ShowMessage(SysErrorMessage(GetLastError));
       GetThreadTimes(H, tm1, tm2, tm3, tm4);
       TempS:='        Ïîòîê'+IntToStr(i)+' - TID: '+IntToStr(Thread32.th32ThreadID) + ' time=' + TimeToStr(FileTimeToDateTime(tm3));
       Str.Add(TempS);
       end;
     Next2:=Thread32Next(HThread,Thread32);
     Until not Next2;
  Thread32First(HThread,Thread32);
  Next:=Process32Next(HProcess,Process32);
  Until not Next;
  CloseHandle(HThread);
  CloseHandle(HProcess);
end;

end.


К сожалению tm1, tm2, tm3, tm4 для всех(!!!) потоков одинаковы. Почему???

Это сообщение отредактировал(а) aktuba - 4.6.2007, 15:36


--------------------
user posted image
PM MAIL WWW Skype   Вверх
Rennigth
Дата 4.6.2007, 15:44 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Участник Клуба
Сообщений: 1708
Регистрация: 21.6.2004
Где: Moscow

Репутация: 8
Всего: 76
aktuba, Для GetThreadTimes OpenThread должен выполняться с флагом 
Код

  THREAD_QUERY_INFORMATION = $0040;

времена получаются уже разными, но пока не понял что они означают. Курим дальше...



--------------------
(* Honesta mors turpi vita potior *)
PM MAIL ICQ   Вверх
aktuba
Дата 4.6.2007, 16:47 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Смышленный
***


Профиль
Группа: Завсегдатай
Сообщений: 1915
Регистрация: 24.4.2006
Где: Планета Земля

Репутация: 2
Всего: 38
Цитата

Для GetThreadTimes OpenThread должен выполняться с флагом


Да, это я переделал почти сразу. Но как теперь получить нормальное время - не пойму. Кстати, спасибо Yanis-у, если вместо стандартной TimeToStr использовать:

Код

function TimeToStr(d: TDateTime): string;
var
  h, m, s, ms: Word;
begin
  DecodeTime(d, h, m, s, ms);
  Result := Format('%d:%d', [s, ms]);
end;


то результат более вразумительный... Но это еще далеко не решение =((( А время бежит  smile 


--------------------
user posted image
PM MAIL WWW Skype   Вверх
dumb
Дата 4.6.2007, 17:23 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


sceloglauxalbifacies
****


Профиль
Группа: Экс. модератор
Сообщений: 2929
Регистрация: 16.6.2006

Репутация: 7
Всего: 158
Цитата(aktuba @  4.6.2007,  16:47 Найти цитируемый пост)
если вместо стандартной TimeToStr

а зачем она тут вообще? это ж просто число тиков 100-наносекундных:
Цитата(msdn)

Thread kernel mode and user mode times are amounts of time. For example, if a thread has spent one second in kernel mode, this function will fill the FILETIME structure specified by lpKernelTime with a 64-bit value of ten million. That is the number of 100-nanosecond units in one second.

работай просто с 64-битными числами.

ps. одного вызова NTSetPrivilege('SeDebugPrivilege', True); будет вполне достаточно... smile
PM MAIL   Вверх
aktuba
Дата 4.6.2007, 18:22 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Смышленный
***


Профиль
Группа: Завсегдатай
Сообщений: 1915
Регистрация: 24.4.2006
Где: Планета Земля

Репутация: 2
Всего: 38
Цитата

а зачем она тут вообще? это ж просто число тиков 100-наносекундных:


тогда вопрос: 
Код

GetThreadTimes(H, tm1, tm2, tm3, tm4);


возвращает 4 параметра, как из них получить секунды? т.е. как "число тиков 100-наносекундных" перевести в нормальное время?


--------------------
user posted image
PM MAIL WWW Skype   Вверх
dumb
Дата 4.6.2007, 18:36 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


sceloglauxalbifacies
****


Профиль
Группа: Экс. модератор
Сообщений: 2929
Регистрация: 16.6.2006

Репутация: 7
Всего: 158
Цитата(aktuba @  4.6.2007,  18:22 Найти цитируемый пост)
возвращает 4 параметра, как из них получить секунды? т.е. как "число тиков 100-наносекундных" перевести в нормальное время?

первые два - перевести функцией FileTimeToSystemTime в "обычное" системное время.

последние два - разделить на 10 000 000 (обрати внимание на цитату из предыдущего моего поста) и получишь в секундах.
PM MAIL   Вверх
aktuba
Дата 4.6.2007, 18:55 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Смышленный
***


Профиль
Группа: Завсегдатай
Сообщений: 1915
Регистрация: 24.4.2006
Где: Планета Земля

Репутация: 2
Всего: 38
Цитата

оследние два - разделить на 10 000 000 (обрати внимание на цитату из предыдущего моего поста) и получишь в секундах. 


вот это как-раз и интересует, но я не понял как это так... что-то у меня не сходиться:
user posted image
user posted image

Вот код:
Код

procedure TForm1.LoadProcessID(Str: TStrings);
var
  HProcess, H:    THandle;
  Process32:   TProcessEntry32;
  Next:        BOOL;
  HThread:     THandle;
  Thread32:    TThreadEntry32;
  Next2:       BOOL;
  i:           Integer;
  TempS:       String;
  tm1, tm2, tm3, tm4, tm: TFileTime;
begin
  if not NTSetPrivilege('SeDebugPrivilege', True) then
    begin
      ShowMessage('Error NTSetPrivilege');
      Exit;
    end;  
  Process32.dwSize:=SizeOf(TProcessEntry32);
  HProcess:=CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS,0);
  Thread32.dwSize:=SizeOf(TThreadEntry32);
  HThread:=CreateToolHelp32Snapshot(TH32CS_SNAPTHREAD,0);
  if not (Process32First(HProcess,Process32) and Thread32First(HThread,Thread32)) then
    begin
    ShowMessage('Error Operation!');
    Exit;
    end;
  Repeat
  TempS:='Имя процесса: '+String(Process32.szExeFile)+' - PID: '+IntToStr(Process32.th32ProcessID);
  Str.Add(TempS);
  i:=0;
    Repeat
      if Thread32.th32OwnerProcessID=Process32.th32ProcessID then
        begin
          Inc(i);
          if Thread32.th32ThreadID <> 0 then
            begin
              H := OpenThread($0040, False, Thread32.th32ThreadID);
              if H = 0 then
                ShowMessage(SysErrorMessage(GetLastError));
              GetThreadTimes(H, tm1, tm2, tm3, tm4);
              tm.dwLowDateTime := tm1.dwLowDateTime - tm3.dwLowDateTime;
              tm.dwHighDateTime := tm1.dwHighDateTime - tm3.dwHighDateTime;
              TempS:='        Поток'+IntToStr(i)+' - TID: '+IntToStr(Thread32.th32ThreadID) +
                ' time=' + FloatToStrF(Int64(tm3) / 10000000, ffFixed, 15, 2);
              Str.Add(TempS);
            end;
        end;
     Next2:=Thread32Next(HThread,Thread32);
     Until not Next2;
  Thread32First(HThread,Thread32);
  Next:=Process32Next(HProcess,Process32);
  Until not Next;
  CloseHandle(HThread);
  CloseHandle(HProcess);
end;



--------------------
user posted image
PM MAIL WWW Skype   Вверх
dumb
Дата 4.6.2007, 19:13 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


sceloglauxalbifacies
****


Профиль
Группа: Экс. модератор
Сообщений: 2929
Регистрация: 16.6.2006

Репутация: 7
Всего: 158
так ты только kernel-time выводишь, а taskmgr, видимо tm3+tm4(user-time)...
PM MAIL   Вверх
aktuba
Дата 4.6.2007, 20:58 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Смышленный
***


Профиль
Группа: Завсегдатай
Сообщений: 1915
Регистрация: 24.4.2006
Где: Планета Земля

Репутация: 2
Всего: 38
Так-с... Ну, вроде работает, оцените, plz... Может кто-что предложит...

На рапиде, т.к. на форум положить не получилось =(


--------------------
user posted image
PM MAIL WWW Skype   Вверх
  
 Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: WinAPI и системное программирование"
Snowybartram
MetalFanbems
PoseidonRrader
Riply

Запрещено:

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами

  • Литературу по Delphi обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи
  • 99% ответов по WinAPI можно найти в MSDN Library, оставшиеся 1% здесь

Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Snowy, bartram, MetalFan, bems, Poseidon, Rrader, Riply.
 
1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: WinAPI и системное программирование | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




[ Время генерации скрипта: 0.1581 ]   [ Использовано запросов: 21 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
 По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.