Как узнать загрузку проца под XP?

Программирование на Visual Basic, главный форум. Обсуждение тем программирования на VB 1—6.
Даже если вы плохо разбираетесь в VB и программировании вообще — тут вам помогут. В разумных пределах, конечно.
Правила форума
Темы, в которых будет сначала написано «что нужно сделать», а затем просьба «помогите», будут закрыты.
Читайте требования к создаваемым темам.
Лёха_Virus
Продвинутый пользователь
Продвинутый пользователь
 
Сообщения: 168
Зарегистрирован: 24.03.2003 (Пн) 17:13
Откуда: Анграск

Как узнать загрузку проца под XP?

Сообщение Лёха_Virus » 27.12.2004 (Пн) 21:22

Здраствуйте друзья программеры!
Помогите пожалуста... 4-е сутки маюсь...
под 98 и Ме определял через реестр (HKEY_DYN_DATA). Но в XP зачем то этот раздел убрали :x
Нужно определить загрузку в %.
Заранее спасибо.

XairOn
Постоялец
Постоялец
Аватара пользователя
 
Сообщения: 324
Зарегистрирован: 19.07.2004 (Пн) 20:20
Откуда: Irkutsk region

Сообщение XairOn » 27.12.2004 (Пн) 21:40

Я не знаю как :-(

|kerish|
Постоялец
Постоялец
 
Сообщения: 831
Зарегистрирован: 22.10.2004 (Пт) 0:31

Сообщение |kerish| » 27.12.2004 (Пн) 23:46

Я бы выложил тебе пример, но на форуме косяк какой-то. Файлы не выкладываются. По-крайней мере у меня.

GM
programador
programador
 
Сообщения: 1427
Зарегистрирован: 24.06.2003 (Вт) 15:56
Откуда: 194.67.52.100

Сообщение GM » 28.12.2004 (Вт) 2:51

Помню что нужно юзать недокументированию ф-цию NtQuerySystemInformation. Как только пример найду - выложу.
الفيجوال بيسك الرابح

GM
programador
programador
 
Сообщения: 1427
Зарегистрирован: 24.06.2003 (Вт) 15:56
Откуда: 194.67.52.100

Сообщение GM » 28.12.2004 (Вт) 3:02

Дык и у меня проблемы с закачкой, что это в последнее время твориться с форумом :?: Ладнов вот модуль, далее надеюсь сам разберешся:
NT
Код: Выделить всё
'clsCPUUsageNT- copyright й 2001, The KPD-Team
'Visit our site at http://www.allapi.net
'or email us at KPDTeam@allapi.net
Option Explicit
Private Const SYSTEM_BASICINFORMATION = 0&
Private Const SYSTEM_PERFORMANCEINFORMATION = 2&
Private Const SYSTEM_TIMEINFORMATION = 3&
Private Const NO_ERROR = 0
Private Type LARGE_INTEGER
    dwLow As Long
    dwHigh As Long
End Type
Private Type SYSTEM_BASIC_INFORMATION
    dwUnknown1 As Long
    uKeMaximumIncrement As Long
    uPageSize As Long
    uMmNumberOfPhysicalPages As Long
    uMmLowestPhysicalPage As Long
    uMmHighestPhysicalPage As Long
    uAllocationGranularity As Long
    pLowestUserAddress As Long
    pMmHighestUserAddress As Long
    uKeActiveProcessors As Long
    bKeNumberProcessors As Byte
    bUnknown2 As Byte
    wUnknown3 As Integer
End Type
Private Type SYSTEM_PERFORMANCE_INFORMATION
    liIdleTime As LARGE_INTEGER
    dwSpare(0 To 75) As Long
End Type
Private Type SYSTEM_TIME_INFORMATION
    liKeBootTime As LARGE_INTEGER
    liKeSystemTime As LARGE_INTEGER
    liExpTimeZoneBias  As LARGE_INTEGER
    uCurrentTimeZoneId As Long
    dwReserved As Long
End Type
Private Declare Function NtQuerySystemInformation Lib "ntdll" (ByVal dwInfoType As Long, ByVal lpStructure As Long, ByVal dwSize As Long, ByVal dwReserved As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Private liOldIdleTime As LARGE_INTEGER
Private liOldSystemTime As LARGE_INTEGER
Public Sub Initialize()
    Dim SysTimeInfo As SYSTEM_TIME_INFORMATION
    Dim SysPerfInfo As SYSTEM_PERFORMANCE_INFORMATION
    Dim Ret As Long
    'get new system time
    Ret = NtQuerySystemInformation(SYSTEM_TIMEINFORMATION, VarPtr(SysTimeInfo), LenB(SysTimeInfo), 0&)
    If Ret <> NO_ERROR Then
        Debug.Print "Error while initializing the system's time!", vbCritical
        Exit Sub
    End If
    'get new CPU's idle time
    Ret = NtQuerySystemInformation(SYSTEM_PERFORMANCEINFORMATION, VarPtr(SysPerfInfo), LenB(SysPerfInfo), ByVal 0&)
    If Ret <> NO_ERROR Then
        Debug.Print "Error while initializing the CPU's idle time!", vbCritical
        Exit Sub
    End If
    'store new CPU's idle and system time
    liOldIdleTime = SysPerfInfo.liIdleTime
    liOldSystemTime = SysTimeInfo.liKeSystemTime
End Sub
Public Function Query() As Long
    Dim SysBaseInfo As SYSTEM_BASIC_INFORMATION
    Dim SysPerfInfo As SYSTEM_PERFORMANCE_INFORMATION
    Dim SysTimeInfo As SYSTEM_TIME_INFORMATION
    Dim dbIdleTime As Currency
    Dim dbSystemTime As Currency
    Dim Ret As Long
    Query = -1
    'get number of processors in the system
    Ret = NtQuerySystemInformation(SYSTEM_BASICINFORMATION, VarPtr(SysBaseInfo), LenB(SysBaseInfo), 0&)
    If Ret <> NO_ERROR Then
        Debug.Print "Error while retrieving the number of processors!", vbCritical
        Exit Function
    End If
    'get new system time
    Ret = NtQuerySystemInformation(SYSTEM_TIMEINFORMATION, VarPtr(SysTimeInfo), LenB(SysTimeInfo), 0&)
    If Ret <> NO_ERROR Then
        Debug.Print "Error while retrieving the system's time!", vbCritical
        Exit Function
    End If
    'get new CPU's idle time
    Ret = NtQuerySystemInformation(SYSTEM_PERFORMANCEINFORMATION, VarPtr(SysPerfInfo), LenB(SysPerfInfo), ByVal 0&)
    If Ret <> NO_ERROR Then
        Debug.Print "Error while retrieving the CPU's idle time!", vbCritical
        Exit Function
    End If
    'CurrentValue = NewValue - OldValue
    dbIdleTime = LI2Currency(SysPerfInfo.liIdleTime) - LI2Currency(liOldIdleTime)
    dbSystemTime = LI2Currency(SysTimeInfo.liKeSystemTime) - LI2Currency(liOldSystemTime)
    'CurrentCpuIdle = IdleTime / SystemTime
    If dbSystemTime <> 0 Then dbIdleTime = dbIdleTime / dbSystemTime
    'CurrentCpuUsage% = 100 - (CurrentCpuIdle * 100) / NumberOfProcessors
    dbIdleTime = 100 - dbIdleTime * 100 / SysBaseInfo.bKeNumberProcessors + 0.5
    Query = Int(dbIdleTime)
    'store new CPU's idle and system time
    liOldIdleTime = SysPerfInfo.liIdleTime
    liOldSystemTime = SysTimeInfo.liKeSystemTime
End Function
Private Function LI2Currency(liInput As LARGE_INTEGER) As Currency
    CopyMemory LI2Currency, liInput, LenB(liInput)
End Function
Public Sub Terminate()
    'nothing to do
End Sub

9x, так на всякий случай
Код: Выделить всё
'clsCPUUsage - copyright й 2001, The KPD-Team
'Visit our site at http://www.allapi.net
'or email us at KPDTeam@allapi.net
Option Explicit
Private Const STANDARD_RIGHTS_ALL = &H1F0000
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 READ_CONTROL = &H20000
Private Const STANDARD_RIGHTS_READ = (READ_CONTROL)
Private Const HKEY_DYN_DATA = &H80000006
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 Const ERROR_SUCCESS = 0&
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
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
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private hKey As Long, dwDataSize As Long, dwCpuUsage As Byte, dwType As Long
Public Sub Initialize()
    'start the counter by reading the value of the 'StartStat' key
    If RegOpenKeyEx(HKEY_DYN_DATA, "PerfStats\StartStat", 0, KEY_ALL_ACCESS, hKey) <> ERROR_SUCCESS Then
        Debug.Print "Error while initializing counter"
        Exit Sub
    End If
    dwDataSize = 4 'Length of Long
    RegQueryValueEx hKey, "KERNEL\CPUUsage", ByVal 0&, dwType, dwCpuUsage, dwDataSize
    RegCloseKey hKey
    'get current counter's value
    If RegOpenKeyEx(HKEY_DYN_DATA, "PerfStats\StatData", 0, KEY_READ, hKey) <> ERROR_SUCCESS Then
        Debug.Print "Error while opening counter key"
        Exit Sub
    End If
End Sub
Public Function Query() As Long
    dwDataSize = 4 'size of Long
    'Query the counter
    RegQueryValueEx hKey, "KERNEL\CPUUsage", ByVal 0&, dwType, dwCpuUsage, dwDataSize
    Query = CLng(dwCpuUsage)
End Function
Public Sub Terminate()
    RegCloseKey hKey
    'stopping the counter
    If RegOpenKeyEx(HKEY_DYN_DATA, "PerfStats\StopStat", 0, KEY_ALL_ACCESS, hKey) <> ERROR_SUCCESS Then
        Debug.Print "Error while stopping counter"
        Exit Sub
    End If
    dwDataSize = 4 'length of Long
    RegQueryValueEx hKey, "KERNEL\CPUUsage", ByVal 0&, dwType, dwCpuUsage, dwDataSize
    RegCloseKey hKey
End Sub

الفيجوال بيسك الرابح

Лёха_Virus
Продвинутый пользователь
Продвинутый пользователь
 
Сообщения: 168
Зарегистрирован: 24.03.2003 (Пн) 17:13
Откуда: Анграск

Сообщение Лёха_Virus » 28.12.2004 (Вт) 7:34

спасибо! где-то видел подобный (под нт) пример на делфи :) потом посматрел у себя что нет такой функции и не придал особоо значения :)

Sebas
Неуловимый Джо
Неуловимый Джо
Аватара пользователя
 
Сообщения: 3626
Зарегистрирован: 12.02.2002 (Вт) 17:25
Откуда: столько наглости такие вопросы задавать

Сообщение Sebas » 28.12.2004 (Вт) 10:48

Можно использовать Win32_Processor & WMI .

или счётцик НТ
- Я никогда не понимал, почему они приходят ко мне чтобы умирать?

sebas<-@->mail.ru

Ramzes
Скромный человек
Скромный человек
Аватара пользователя
 
Сообщения: 5004
Зарегистрирован: 12.04.2003 (Сб) 11:59
Откуда: Из гробницы :)

Сообщение Ramzes » 28.12.2004 (Вт) 11:01

|kerish| писал(а):Я бы выложил тебе пример, но на форуме косяк какой-то. Файлы не выкладываются. По-крайней мере у меня.


Чует мое сердце, что, где-то, кто-то, что-то напартачил :roll: не у тебя одного файлы не выкладиваються!!!!

GAL
Обычный пользователь
Обычный пользователь
Аватара пользователя
 
Сообщения: 69
Зарегистрирован: 05.11.2004 (Пт) 15:57

Сообщение GAL » 29.12.2004 (Ср) 13:55

Люди, а можно подробнее об этом. Я взял этот модуль, поюзал, как мог - не понял. Разъясните подробнее, пожалуйста!
Мне советовали выкрасить шкуру. Нелепый совет. Крашеный ли волк, стриженый ли волк, он все равно не похож на пуделя. (c) М. А. Булгаков

Лёха_Virus
Продвинутый пользователь
Продвинутый пользователь
 
Сообщения: 168
Зарегистрирован: 24.03.2003 (Пн) 17:13
Откуда: Анграск

Сообщение Лёха_Virus » 29.12.2004 (Ср) 14:06

чё тут непонятного... сначала вызываешь процедуру Initialize. а потом когда надо вызываешь функцию Query которая возвращает значение - загрузку проца в процентах.


Вернуться в Visual Basic 1–6

Кто сейчас на конференции

Сейчас этот форум просматривают: Google-бот и гости: 9

    TopList