Add(Memo,3167362,294,266)
{
 Left=90
 Top=240
 Width=440
 Height=215
 ScrollBars=3
}
Add(Button,12287583,175,287)
{
 Left=15
 Top=240
 link(onClick,8779930:doEnum,[])
}
Add(InlineCode,8779930,231,287)
{
 WorkPoints=#6:doEnum|
 EventPoints=#9:onProcess|
 Code=#15:unit HiAsmUnit;|0:|9:interface|0:|30:uses Kol, Windows,Share,Debug;|0:|5:type |36:  PPerfDataBlock = ^TPerfDataBlock; |26:  TPerfDataBlock = record |37:    Signature: array[0..3] of WCHAR; |25:    LittleEndian: DWORD; |20:    Version: DWORD; |21:    Revision: DWORD; |28:    TotalByteLength: DWORD; |25:    HeaderLength: DWORD; |27:    NumObjectTypes: DWORD; |28:    DefaultObject: Longint; |29:    SystemTime: TSystemTime; |29:    PerfTime: TLargeInteger; |29:    PerfFreq: TLargeInteger; |36:    PerfTime100nSec: TLargeInteger; |29:    SystemNameLength: DWORD; |29:    SystemNameOffset: DWORD; |7:  end; |0:|38:  PPerfObjectType = ^TPerfObjectType; |27:  TPerfObjectType = record |28:    TotalByteLength: DWORD; |29:    DefinitionLength: DWORD; |25:    HeaderLength: DWORD; |33:    ObjectNameTitleIndex: DWORD; |29:    ObjectNameTitle: LPWSTR; |33:    ObjectHelpTitleIndex: DWORD; |29:    ObjectHelpTitle: LPWSTR; |24:    DetailLevel: DWORD; |24:    NumCounters: DWORD; |29:    DefaultCounter: Longint; |27:    NumInstances: Longint; |21:    CodePage: DWORD; |29:    PerfTime: TLargeInteger; |29:    PerfFreq: TLargeInteger; |7:  end; |0:|52:  PPerfCounterDefinition = ^TPerfCounterDefinition; |34:  TPerfCounterDefinition = record |23:    ByteLength: DWORD; |34:    CounterNameTitleIndex: DWORD; |30:    CounterNameTitle: LPWSTR; |34:    CounterHelpTitleIndex: DWORD; |30:    CounterHelpTitle: LPWSTR; |27:    DefaultScale: Longint; |24:    DetailLevel: DWORD; |24:    CounterType: DWORD; |24:    CounterSize: DWORD; |26:    CounterOffset: DWORD; |7:  end; |0:|54:  PPerfInstanceDefinition = ^TPerfInstanceDefinition; |35:  TPerfInstanceDefinition = record |23:    ByteLength: DWORD; |35:    ParentObjectTitleIndex: DWORD; |33:    ParentObjectInstance: DWORD; |23:    UniqueID: Longint; |23:    NameOffset: DWORD; |23:    NameLength: DWORD; |7:  end; |0:|42:  PPerfCounterBlock = ^TPerfCounterBlock; |29:  TPerfCounterBlock = record |23:    ByteLength: DWORD; |6:  end;|0:|0:|4:type|28: THiAsmClass = class(TDebug)|10:   private|0:|9:   public|23:   onProcess:THI_Event;|49:   procedure doEnum(var _Data:TData; Index:word);|0:|5: end;|0:|14:implementation|0:|63:function FillProcessesList(var slProcesses: PStrList): Boolean;|5:const|56:  INCREMENTAL_SIZE     = 32768; // Шаг увеличения буфера|58:  INITIAL_BUFFER_SIZE  = 65536; // Начальный размер буфера|57:  PROCESS_OBJECT_INDEX = 230;   // Индекс объекта Process|67:  PID_OBJECT_INDEX     = 784;   // Индекс счетчика ID Process (PID)|3:var|41:  buflen: DWORD; // текущий размер буфера|46:  PerfData: PPerfDataBlock; // PERF_DATA_BLOCK|47:  PerfObj: PPerfObjectType; // PERF_OBJECT_TYPE|72:  PerfCntr, CurCntr: PPerfCounterDefinition;  // PERF_COUNTER_DEFINITION|65:  PerfInst: PPerfInstanceDefinition;  // PERF_INSTANCE_DEFINITION|68:  PerfCntrBlk, PtrToCntr: PPerfCounterBlock;   // PERF_COUNTER_BLOCK|38:  i,k,j: Integer; // счетчики в циклах|42:  process_name: String; // выходная строка|55:  pData: PLargeInteger; // Указатель на данные счетчика|5:begin|18:  Result := False;|32:  buflen := INITIAL_BUFFER_SIZE;|55:  GetMem(PerfData, buflen); // Выделяем начальный буфер|5:  try|39:    // Пытаемся заполнить буфер данными|48:    while RegQueryValueEx(HKEY_PERFORMANCE_DATA,|63:                          PChar(Int2Str(PROCESS_OBJECT_INDEX)),|61:                          nil,nil,Pointer(PerfData), @buflen)|46:                          = ERROR_MORE_DATA do|71:    begin  // Если буфер маленький, то увеличиваем его и снова пытаемся|35:      inc(buflen,INCREMENTAL_SIZE);|35:      ReallocMem(PerfData, buflen);|8:    end;|75:    RegCloseKey(HKEY_PERFORMANCE_DATA); // Обязательно закрываем этот ключ.|80:    // Получаем указатель на первую структуру PERF_OBJECT_TYPE (первый инфоблок)|72:    PerfObj := PPerfObjectType(DWORD(PerfData) + PerfData.HeaderLength);|46:    // Перебираем все полученные типы объектов|48:    for i := 0 to PerfData.NumObjectTypes - 1 do|9:    begin|41:      // Ищем объект Process (индекс 230)|65:      if PerfObj.ObjectNameTitleIndex = PROCESS_OBJECT_INDEX then|11:      begin|77:        // Запоминаем расположение описаний счетчиков PERF_COUNTER_DEFINITION|59:        PerfCntr := PPerfCounterDefinition(DWORD(PerfObj) +|42:                    PerfObj.HeaderLength);|61:        // Получаем экземпляры объекта Process, если они есть|40:        if PerfObj.NumInstances > 0 then|13:        begin|76:          // Получаем указатель на первую структуру PERF_INSTANCE_DEFINITION|62:          PerfInst := PPerfInstanceDefinition(DWORD(PerfObj) +|72:                                              PerfObj.DefinitionLength);|46:          // Перебираем все экземпляры объекта|51:          for k := 0 to PerfObj.NumInstances - 1 do|15:          begin|62:            // Получаем имя текущего экземпляра (имя процесса)|72:            process_name := WideCharToString(PWideChar(DWORD(PerfInst) +|67:                                             PerfInst.NameOffset));|68:            // Если имя равно '_Total', то пропускаем этот экземпляр|59:            // т.к. это суммарные данные для всех процессов|53:            if process_name = '_Total' then Continue;|75:            // Получаем указатель на первый счетчик PERF_COUNTER_DEFINITION|32:            CurCntr := PerfCntr;|73:            // Получаем указатель на данные счетчиков текущего экземпляра|33:            // PERF_COUNTER_BLOCK|60:            PtrToCntr := PPerfCounterBlock(DWORD(PerfInst) +|46:                         PerfInst.ByteLength);|57:            //Перебираем все счетчики для каждого объекта|52:            for j := 0 to PerfObj.NumCounters - 1 do|17:            begin|54:              // Получаем указатель на данные счетчика|73:              pData := Pointer(DWORD(PtrToCntr) + CurCntr.CounterOffset);|63:              // Если счетчик - это ID Process, то читаем его и|44:              // добавляем в выходную строку|70:              if CurCntr.CounterNameTitleIndex = PID_OBJECT_INDEX then|44:              process_name := process_name +|68:                              '; PID = ' + Int2Str(Integer(pData^));|56:              // Получаем указатель на следующий счетчик|64:              CurCntr := PPerfCounterDefinition(DWORD(CurCntr) +|46:                         CurCntr.ByteLength); |18:            end;  |54:            // Добавляем выходную строку в TStringList|42:            slProcesses.Add(process_name);|40:            // Функция сработала успешно|27:            Result := True;|64:            // Получаем указатель на следующий экземпляр объекта|64:            // Он находится сразу за данными текущего экземпляра|62:            PerfCntrBlk := PPerfCounterBlock(DWORD(PerfInst) +|66:                                             PerfInst.ByteLength);|68:            PerfInst := PPerfInstanceDefinition(DWORD(PerfCntrBlk) +|72:                                                PerfCntrBlk.ByteLength);|14:          end;|12:        end;|10:      end;|52:      // Получаем указатель на следующий тип объекта|75:      PerfObj := PPerfObjectType(DWORD(PerfObj) + PerfObj.TotalByteLength);|8:    end;|9:  finally|57:    // В любом случае освобождаем память, занятую буфером|22:    FreeMem(PerfData);|6:  end;|4:end;|0:|29:procedure THiAsmClass.doEnum;|26:var slProcesses: PStrList;|20:    bRes: Boolean;  |5:begin|28:  slProcesses := NewStrList;|41:  bRes := FillProcessesList(slProcesses);|43:  _hi_onEvent(onProcess, slProcesses.Text);|18:  if not bRes then|83:  _hi_onEvent(onProcess, 'к сожелению не получилось получить процессы из реестра');|19:  slProcesses.Free;|4:end;|0:|0:|4:end.|
 link(onProcess,3167362:doText,[])
}