счетчики производительности

Тема в разделе "Delphi - Система", создана пользователем NetDigger, 9 дек 2004.

Статус темы:
Закрыта.
  1. NetDigger

    NetDigger Гость

    Здравствуйте, уважаемые!
    Возможно ли для отдельного процесса вывести насколько он загружает процессор, сколько байт считал и т.п. информацию, которую возможно извлечь из PDH. Нужно НЕ ДЛЯ МАШИНЫ В ЦЕЛОМ, а ДЛЯ ОТДЕЛЬНО ВЫБРАННОГО ПРОЦЕССА
     
  2. Barmutik

    Barmutik Гость

    А если попробовать для получения времени GetProcessTimes и GetProcessIoCounters для чтения\записи..

    Не уверен что абсолютно то что ты искал ..
     
  3. NetDigger

    NetDigger Гость

    Хмм, все облазил - в какой модуль подключать для GetProcessIOCounters?
     
  4. Barmutik

    Barmutik Гость

    А ни в каком ... самому декларить надо...

    Да и кстати .. можно обратить внимание ещё на вот эту функцию: NtQuerySystemInformation
     
  5. NetDigger

    NetDigger Гость

    Что-то вообще траблы большие: не могу я ее корректно экспортировать эту GetProccessIO

    IO_COUNTERS = ^_IO_COUNTERS;
    _IO_COUNTERS = record
    ReadOperationCount: int64;
    WriteOperationCount: int64;
    OtherOperationCount: int64;
    ReadTransferCount: int64;
    WriteTransferCount: int64;
    OtherTransferCount: int64;
    End;


    var
    Form1: TForm1;
    function GetProcessIoCounters(hProcess: THandle; PIO_COUNTERS:pointer):Boolean; stdcall; external 'kernel32.dll';

    procedure TForm1.Button1Click(Sender: TObject);
    Var
    PIDArray: array [0..1023] of DWORD;
    cb: DWORD;
    I: Integer;
    ProcCount: Integer;
    hProcess: THandle;
    M : IO_COUNTERS;
    begin
    EnumProcesses(@PIDArray, SizeOf(PIDArray), cb);
    ProcCount := cb div SizeOf(DWORD);
    getMem( m, sizeof(_IO_COUNTERS));
    for I := 0 to ProcCount - 1 do
    begin
    hProcess := OpenProcess(PROCESS_QUERY_INFORMATION or
    PROCESS_VM_READ,
    False,
    PIDArray);
    if not(GetProcessIoCounters( hProcess, M)) then Halt;
    End;

    end;
     
  6. Barmutik

    Barmutik Гость

    А в чём конретно проблема ?

    Я взял Ваш код .. с мелкими модификациями у меня всё чудно работает ...

    Вот мой пример для текущго процесса:

    Код (Text):
    var
    hProcess: THandle;
    M : _IO_COUNTERS;
    begin
    hProcess := GetCurrentProcess;
    if not GetProcessIoCounters( hProcess, @M) then
     ShowMessage('Error')
    else
    begin
     Caption := IntToStr(M.ReadOperationCount) + ' ' + IntToStr(M.WriteOperationCount) +
      ' ' + IntToStr(M.ReadTransferCount);
    end;
    Единственное что ...
    Код (Text):
    function GetProcessIoCounters(hProcess: THandle; PIO_COUNTERS: IO_COUNTERS):Boolean; stdcall; external 'kernel32.dll';
    вместо Вашего объявления
    Код (Text):
    function GetProcessIoCounters(hProcess: THandle; PIO_COUNTERS:pointer):Boolean; stdcall; external 'kernel32.dll';
     
  7. NetDigger

    NetDigger Гость

    Прошу прощения - сказывается то, что уже третьи сутки подряд на ногах...Однако с currentProcess действительно все ок - а с остальным не очень. Разберемся. сенкс
     
Загрузка...
Статус темы:
Закрыта.

Поделиться этой страницей