Недавно в
статье, посвящённой
недокументированным
возможностям 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
