Question

vb程序CPU占用率

不需要全部的CPU的占用率，只要目前VB做的这个程序运行时的CPU占用率及内存使用率即可！

Answer 1

抄的代码，如果能用，采纳时选能解决。FrmMain

Option Explicit
'********************************************************************************
'* CPUUsage 1.0
'* ----------------
'*
'* This program is total FREEWARE.
'*
'* It use the registry to get the CPU usage in percent.
'*
'* You can also move the form without title bar and close it with the right button.
'*
'* Happy programming !
'*
'*
'********************************************************************************

' The CPUUsage object
Private CPU As New CPUUsage
Private Avg As Long ' Average of CPU Usage
Private Sum As Long
Private Index As Long

Private Sub Form_Load()
' First, open the "StartStat " key
CPU.InitCPUUsage
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Timer.Enabled = False
Set CPU = Nothing
Cancel = 0
End Sub

Private Sub Frame1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call Form_MouseDown(Button, Shift, X, Y)
End Sub

Private Sub pctPrg_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
Unload Me
End
End If
Call Form_MouseDown(Button, Shift, X, Y)
End Sub

Private Sub Timer_Timer()
'Get the CPU Usage every second
Dim tmp As Long
tmp = CPU.GetCPUUsage
Sum = Sum + tmp
Index = Index + 1
Avg = Int(Sum / Index)
'Draw the bar
pctPrg.Cls
pctPrg.Line (0, 0)-(tmp, 18), , BF
pctPrg.Line (Avg, 0)-(Avg, 18), &HFF
pctPrg.Line (Avg + 1, 0)-(Avg + 1, 18), &HFF
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim rc As Long
rc = ReleaseCapture
rc = SendMessage(hwnd, WM_NCLBUTTONDOWN, LP_HT_CAPTION, ByVal 0&)
End Sub

Mudula Api

Option Explicit
'Const&Functions used for the FormMove methods
Public Const LP_HT_CAPTION = 2
Public Const WM_NCLBUTTONDOWN = &HA1

Declare Function ReleaseCapture Lib "user32 " () As Long
Declare Function SendMessage Lib "user32 " Alias "SendMessageA " (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

cls:CPUUsage

Option Explicit

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 Const REG_DWORD = 4
Private Const HKEY_DYN_DATA = &H80000006
'Initiate the key
Public Sub InitCPUUsage()
Dim Data As Long, Typ As Long, Size As Long
Dim hKey As Long, hRet As Long

hRet = RegOpenKey(HKEY_DYN_DATA, "PerfStats\StartStat ", hKey)
hRet = RegQueryValueEx(hKey, "KERNEL\CPUUsage ", 0, REG_DWORD, Data, 4)
hRet = RegCloseKey(hKey)
End Sub
'Get the cpu info via gfx meter
Public Function GetCPUUsage() As Long
Dim Data As Long, Typ As Long, Size As Long
Dim hKey As Long
Dim hRet As Long

hRet = RegOpenKey(HKEY_DYN_DATA, "PerfStats\StatData ", hKey)
hRet = RegQueryValueEx(hKey, "KERNEL\CPUUsage ", 0&, REG_DWORD, Data, 4)
GetCPUUsage = Data
hRet = RegCloseKey(hKey)
End Function

Answer 2

你是说想看到现在进行的这个VB程序的CPU占用率和内存使用率?在任务管理器里就有啊,360里面好像也有的.