Замер степени использования процессора
Недавно в статье, посвящённой недокументированным возможностям Windows, я обнаружил интересный способ измерения степени использования процессора. Дело в том, что в Windows 9x существуют счётчики Performance Counters, которые можно включить из реестра, и в реестр же они будут посылать результаты замеров. Например загруженности процессора. Есть они и в NT, но доступ к ним сложнее.
К моему собственному удивлению результат перевода С на человеческий VB отлично заработал! По-сему, если Вашей программе нужно знать загруженность проца, или если Вы заинтересуетесь доступом в реестр из WinApi32, то Вы можете познакомиться с простеньким примером. Разумеется в полном варианте нужно было бы вставить проверку типа Windows (например через GetWindowsVersion), сворачивание в SysTray и т. п., но в "укороченном" виде Вам будет проще приспособить данную фичу Windows к своим потребностям.
Открыть нужный ключ:
Private Declare Function RegOpenKeyEx Lib "advapi32. dll" Alias "RegOpenKeyExA" ( _
ByVal hkey As Long, _
ByVal ulOptions As Long, _
ByVal samDesired As Long, _
phkResult As Long) As Long
hkey, lpSubKey - пути к ключу,
ulOptions - зарезервировано: должно быть ноль,
phkResult - переменная, получающая хэндл нужного ключа. Не забудьте потом закрыть.
Получить тип и значение параметра из ранее открытого ключа:
Private Declare Function RegQueryValueEx Lib "advapi32. dll" Alias "RegQueryValueExA" ( _
ByVal lpReserved As Long, _
lpType As Long, _
lpData As Any, _
hkey - хэндл открытого ранее ключа,
lpReserved - зарезервировано: должно быть ноль,
lpType - переменная, в которую будет возвращаться тип параметра
можно передать ноль, если тип не требуется (нам, кстати, передаст 3 - REGBINARY),
lpData - то, что нас интересует,
lpcbData - переменная, которая содержит длину буфера под lpData,
после выполнения будет содержать кол-во в действительности переданных байт
у нас - длина слова: 4. Если переменную заменить просто на 4 - тоже работает
Private Declare Function RegCloseKey Lib "advapi32. dll" (ByVal hkey As Long) As Long
Некоторые константы из API Viewer:
Private Const HKEYDYNDATA = &H80000006
&H1F0000
Private Const READCONTROL = &H20000
Private Const STANDARDRIGHTSREAD = (READCONTROL)
Private Const KEYQUERYVALUE = &H1
Private Const KEYSETVALUE = &H2
Private Const KEYCREATESUBKEY = &H4
Private Const KEYENUMERATESUBKEYS = &H8
Private Const KEYNOTIFY = &H10
Private Const KEYCREATELINK = &H20
Private Const SYNCHRONIZE = &H100000
KEYQUERYVALUE OR KEYSETVALUE OR _
KEYCREATESUBKEY Or KEYENUMERATESUBKEYS Or _
KEYNOTIFY Or KEYCREATELINK) And (Not SYNCHRONIZE))
Private Const KEYREAD = ((STANDARDRIGHTSREAD Or _
KEYQUERYVALUE Or KEYENUMERATESUBKEYS Or _
KEYNOTIFY) 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 cx As Long, _
ByVal cy As Long, _
ByVal WFlags As Long) As Long
А это наше:
Dim hkey As Long
Dim dwCPUUsage As Long
DimlpcbDataAsLongпо-моему действительно лучше выкинуть,
подставив в нужных местах 4. Ау, теоретики!
Dim bStart As Boolean
Private Sub FormLoad()
SetWindowPos Me. hwnd, -1, 0, 0, 0, 0, 3
видим всегда
End Sub
Private Sub cmdStartClick()
bStart = Not bStart
bStart - это Вкл-Выкл. См. далее
If bStart Then
если - True - начинаем
cmdStart. Caption = "&Stop"
меняем название кнопочки
Включаем счётчик, считывая значение соответствующего ключа:
If RegOpenKeyEx(HKEYDYNDATA, "PerfStats\StartStat", 0, KEYALLACCESS, _
hkey) <> 0 Then Exit Sub
"KERNEL\CPUUsage", 0, 0, dwCPUUsage, lpcbData
RegCloseKey hkey
закрыть ключ
Считываем значение прямо из реестра:
"PerfStats\StatData", 0, KEYREAD, _
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
закрыть ключ
до этого момента, остановить счётчик можно только перезагрузившись!!!
"PerfStats\StopStat", 0, KEYALLACCESS, _
hkey) <> 0 Then Exit Sub
"KERNEL\CPUUsage", 0, 0, dwCPUUsage, lpcbData
RegCloseKey hkey
Else
"&Start"
меняем название кнопочки и...
Caption = "Stoped..."
не даем себе впасть в уныние глядя на зависшие 100%
End If
Private Sub FormUnload(Cancel As Integer)
If bStart Then
cmdStartClick
End If
ленивые меня поймут;-)
End Sub
| 
