用vb监视cpu的使用情况！变态老板要！３００分送！

[allboy]

今天一定要完成，求大家帮忙！

[叶帆]

'上面的联结提供的是98的
我提供一个NT的（取自网友文章）
－－－－－－－－－－－－
'建一个类，名称CPU

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
－－－－－－－－－－－－－－
’添一个文本框，和一个timer 1000ms

Option Explicit
Dim lngCPU As New CPU
Private Sub Timer1_Timer()
Text1 = lngCPU.Query
End Sub

[flc]

xuexi学习

[Amountain]

ding

[守城小轩]

网上好像有这样的文章
去搜一下吧

[allboy]

up 急

[守城小轩]

这里有
http://zhanet.myrice.com/data/200109/1708105901.htm

[龙华]

'-------该代码作者名为 陈锐--------
Private Type LARGE_INTEGER
lowpart As Long
highpart As Long
End Type

Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As _
Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long

Private Const REG_DWORD = 4
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

Dim mix As Long
Dim miy As Long

Private Sub Command1_Click()
End
End Sub

Private Sub Form_Load()
'将Form1的位置设置到屏幕右上角
Form1.Top = 1
Form1.Left = Screen.Width - Form1.Width

Call InitCPU
Call OnTop
End Sub

Private Sub Form_Resize()
Picture1.Width = Me.ScaleWidth
mix = Picture1.Width \ 30
End Sub

Private Sub Timer1_Timer()
Dim lData As Long, lType As Long, lSize As Long
Dim hKey As Long
Dim l As Long
Dim astr As String

Qry = RegOpenKey(HKEY_DYN_DATA, "PerfStats\StatData", hKey)

If Qry <> 0 Then
MsgBox "注册表打开错误!"
End
End If

lType = REG_DWORD
lSize = 4

'从注册表中获得CPU的占用率
Qry = RegQueryValueEx(hKey, "KERNEL\CPUUsage", _
0, lType, lData, lSize)

statbar = Int(lData / 10)
Picture1.Cls
Picture1.Line (0, 0)-(Int(Picture1.Width * (lData / 100)), Picture1.Width), 1, BF
astr = "%" + Str(lData)
l = TextOut(Picture1.hdc, mix, 0, astr, Len(astr))

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 "注册表打开错误!"
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

[legendxia]

http://www.sijiqing.com/vbgood/code/index.asp?action=read&id=1030

这可是源码啊！

[Gelim]

up!

[守城小轩]

谢谢 收到

[射天狼]

UP~~

[snail2011]

我是不会的.

[yunfeng007]

哦

[allboy]

以上揭贴

[allboy]

http://expert.csdn.net/Expert/topic/2349/2349379.xml?temp=.4327967
http://expert.csdn.net/Expert/topic/2349/2349374.xml?temp=.9918177
http://expert.csdn.net/Expert/topic/2349/2349381.xml?temp=.7925379
请以上兄弟来领分!

[allboy]

下班揭贴

[j4sxw]

UP

[txlicenhe]

up