VB 查看进程CPU使用率
发布网友
发布时间：2022-04-25 11:10
共1个回答
热心网友
时间：2022-04-24 06:13
Private Type LARGE_INTEGER
lowpart As Long
highpart As Long
End Type
Private Declare Function QueryPerformanceCounter Lib _
"kernel32" (lpPerformanceCount As LARGE_INTEGER) _
As Long
Private Declare Function QueryPerformanceFrequency _
Lib "kernel32" (lpFrequency As LARGE_INTEGER) As Long
Private Const REG_DWORD = 4 ' 32-bit number
Private Const HKEY_DYN_DATA = &H80000006
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 RegOpenKey Lib "advapi32.dll" _
Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal _
lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" _
(ByVal hKey As Long) 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
Private Sub Form_DblClick()
'If the mouse is double clicked then end the
'program.
End
End Sub
Private Sub Form_Load()
'Positions the form at the top right corner of
'the screen regardless of monitor size.
Form1.Top = 1
Form1.Left = Screen.Width - Form1.Width
Call InitCPU
Call OnTop
End Sub
Private Sub SSPanel1_DblClick(Index As Integer)
Call Form_DblClick
End Sub
Private Sub Timer1_Timer()
Dim lData As Long, lType As Long, lSize As Long
Dim hKey As Long
Qry = RegOpenKey(HKEY_DYN_DATA, "PerfStats\StatData", hKey)
'If there's a problem accessing the registry
If Qry <> 0 Then
MsgBox "Can't Open Statistics Key"
End
End If
lType = REG_DWORD
lSize = 4
'Querying the registry for CPUUsage
Qry = RegQueryValueEx(hKey, "KERNEL\CPUUsage", _
0, lType, lData, lSize)
'clears the SSPanel boxes
Do Until SSPanel1(x).BackColor = &HC0C0C0
SSPanel1(x).BackColor = &HC0C0C0
x = x + 1
If x >= 10 Then Exit Do
Loop
'statbar is the variable that holds the CPU
'usage divided by 10.
'(ex. if 79% of the CPU is being used then
' statbar will hold the int(7.9) = 8)
statbar = Int(lData / 10)
If statbar >= 1 Then statbar = statbar - 1
'used to fill the SSPanel with the color green
'beginning with 0 and ending with the value of
'statbar.
For fillall = 0 To statbar
SSPanel1(fillall).BackColor = &HFF&
Next fillall
If Int(lData / 10) = 0 Then SSPanel1(0).BackColor = &HC0C0C0
'Print lData
'Label2.Caption = lData & "%"
Qry = RegCloseKey(hKey)
End Sub
Private Sub InitCPU()
Dim lData As Long, lType As Long, lSize As Long
Dim hKey As Long
Qry = RegOpenKey(HKEY_DYN_DATA, "PerfStats\StartStat", hKey)
If Qry <> 0 Then
MsgBox "Can't Open Statistics Key"
End
End If
lType = REG_DWORD
lSize = 4
Qry = RegQueryValueEx(hKey, "KERNEL\CPUUsage", 0, lType, lData, lSize)
Qry = RegCloseKey(hKey)
End Sub
Private Sub OnTop()
Const SWP_NOMOVE = &H2
Const SWP_NOSIZE = &H1
Const FLAGS = SWP_NOMOVE Or SWP_NOSIZE
Const HWND_TOPMOST = -1
Const HWND_NOTOPMOST = -2
If SetWindowPos(Form1.hwnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS) = True Then
success% = SetWindowPos(Form1.hwnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS)
End If
End Sub
Windows NT/2000 下
参考一下c的吧，没时间写成VB
主要是使用了Microsoft未公开的 NtQuerySystemInformation
需要ntdll.dll
一个VB获取CPU占用率的代码:
http://www.freevbcode.com/source/0806/processcpuusage.zip
