HOME MP3 MIDI

Замер скорости процессора.

Недавно в статье, посвящённой недокументированным возможностям Windows, я обнаружил интересный способ измерения степени использования процессора. Дело в том, что в Windows 9x существуют счётчики Performance Counters, которые можно включить из реестра, и в реестр же они будут посылать результаты замеров. Например загруженности процессора. Есть они и в NT, но доступ к ним сложнее.

К моему собственному удивлению результат перевода Си на человеческий VB отлично заработал! По-сему, если Вашей программе нужно знать загруженность проца, или если Вы заинтересуетесь доступом в реестр из WinApi32, то Вы можете познакомиться с простеньким примером. Разумеется в полном варианте нужно было бы вставить проверку типа Windows (например через GetWindowsVersion), сворачивание в SysTray и т.п., но в "укороченном" виде Вам будет проще приспособить данную фичу Windows к своим потребностям.

Итак. Если у Вас не NT. Расположите на форме кнопочку. Назовём её cmdStart. Как водится, в раздел General Declarations вставляем:

'*************************************************************************
'Открыть нужный ключ:

Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" ( _
ByVal hkey As Long, _
ByVal pSubKey As String, _
ByVal ulOptions As Long, _
ByVal samDesired As Long, _
phkResult As Long) As Long
'hkey, lpSubKey - пути к ключу,
'ulOptions - зарезервировано: должно быть ноль,
'samDesired - тип доступа: комбинация предопределённых констант,
'phkResult - переменная, получающая хэндл нужного ключа. Не забудьте потом закрыть.

'Получить тип и значение параметра из ранее открытого ключа:

Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" ( _
ByVal hkey As Long, _
ByVal lpValueName As String, _
ByVal lpReserved As Long, _
lpType As Long, _
lpData As Any, _
lpcbData As Long) As Long
'hkey - хэндл открытого ранее ключа,
'lpValueName - имя параметра, который нужно прочитать,
'lpReserved - зарезервировано: должно быть ноль,
'lpType - переменная, в которую будет возвращаться тип параметра
'можно передать ноль, если тип не требуется (нам, кстати, передаст 3 - REG_BINARY),
'lpData - то, что нас интересует,
'lpcbData - переменная, которая содержит длину буфера под lpData,
'после выполнения будет содержать кол-во в действительности переданных байт
'у нас - длина слова: 4. Если переменную заменить просто на 4 - тоже работает

'Закрытие ранее открытого ключа:

Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hkey As Long) As Long

'Некоторые константы из API Viewer:
Private Const HKEY_DYN_DATA = &H80000006

Private Const STANDARD_RIGHTS_ALL = &H1F0000
Private Const READ_CONTROL = &H20000
Private Const STANDARD_RIGHTS_READ = (READ_CONTROL)
Private Const KEY_QUERY_VALUE = &H1
Private Const KEY_SET_VALUE = &H2
Private Const KEY_CREATE_SUB_KEY = &H4
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const KEY_NOTIFY = &H10
Private Const KEY_CREATE_LINK = &H20
Private Const SYNCHRONIZE = &H100000

Private Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL OR _
KEY_QUERY_VALUE OR KEY_SET_VALUE OR _
KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or _
KEY_NOTIFY Or KEY_CREATE_LINK) And (Not SYNCHRONIZE))
Private Const KEY_READ = ((STANDARD_RIGHTS_READ Or _
KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or _
KEY_NOTIFY) And (Not SYNCHRONIZE))

'Для служебных нужд:

'Самый ресурсощедящий способ выждать паузу (в миллисекундах):

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

'Всегда пригодится:
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, _
ByVal hWndInsertAfter As Long, _
ByVal x As Long, _
ByVal y As Long, _
ByVal cx As Long, _
ByVal cy As Long, _
ByVal WFlags As Long) As Long

'А это наше:
Dim hkey As Long
Dim dwCPUUsage As Long
Dim lpcbData As Long'по-моему действительно лучше выкинуть,
        'подставив в нужных местах 4. Ау, теоретики!
Dim bStart As Boolean

Private Sub Form_Load()
  SetWindowPos Me.hwnd, -1, 0, 0, 0, 0, 3
  'видим всегда
End Sub

Private Sub cmdStart_Click()
  bStart = Not bStart
  'bStart - это Вкл-Выкл. См. далее
    If bStart Then
    'если - True - начинаем
    cmdStart.Caption = "&Stop"    
    'меняем название кнопочки

    'Включаем счётчик, считывая значение соответствующего ключа:
    If RegOpenKeyEx(HKEY_DYN_DATA, "PerfStats\StartStat", 0, KEY_ALL_ACCESS, _
                hkey) <> 0 Then Exit Sub
    lpcbData = 4
    RegQueryValueEx hkey, "KERNEL\CPUUsage", 0, 0, dwCPUUsage, lpcbData
    RegCloseKey hkey
    'закрыть ключ

    'Считываем значение прямо из реестра:
    If RegOpenKeyEx(HKEY_DYN_DATA, "PerfStats\StatData", 0, KEY_READ, _
                hkey) <> 0 Then Exit Sub
    Do While bStart
    'пока ещё раз не нажмём на кнопочку
      RegQueryValueEx hkey, "KERNEL\CPUUsage", 0, 0, dwCPUUsage, lpcbData
      Sleep 500
      'интервал опроса - полсекунды
      Caption = Str$(dwCPUUsage) & "%"
      'Любуемся!!!
      DoEvents
      'даём жить
    Loop
    RegCloseKey hkey
    'закрыть ключ

    'останавливаем счётчик. Если Вы прервали выполнение программы
    'до этого момента, остановить счётчик можно только перезагрузившись!!!
    'Проверено:((

    If RegOpenKeyEx(HKEY_DYN_DATA, "PerfStats\StopStat", 0, KEY_ALL_ACCESS, _
                hkey) <> 0 Then Exit Sub
    lpcbData = 4
    RegQueryValueEx hkey, "KERNEL\CPUUsage", 0, 0, dwCPUUsage, lpcbData
    RegCloseKey hkey
    'помним всегда!
  Else
    cmdStart.Caption = "&Start"
    'меняем название кнопочки и...
    Caption = "Stoped..."
    'не даем себе впасть в уныние глядя на зависшие 100%
  End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
  If bStart Then
    cmdStart_Click
  End If
  'ленивые меня поймут;-)
End Sub

Mikle Kassirov