跪求:VB获取CPU温度代码!!!
发布网友
发布时间：2022-04-25 04:52
共1个回答
热心网友
时间：2023-10-27 07:37
我空间有个CPU 资源占用曲线图For VB6http://user.qzone.qq.com/652359858/blog/1245500104Option Explicit
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 Declare Function PdhVbOpenQuery Lib "PDH.DLL" (ByRef QueryHandle As Long) As Long
Private Declare Function PdhVbAddCounter Lib "PDH.DLL" (ByVal QueryHandle As Long, ByVal CounterPath As String, ByRef CounterHandle As Long) As Long
Private Declare Function PdhCollectQueryData Lib "PDH.DLL" (ByVal QueryHandle As Long) As Long
Private Declare Function PdhVbGetDoubleCounterValue Lib "PDH.DLL" (ByVal CounterHandle As Long, ByRef CounterStatus As Long) As Double
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 GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Const SW_SHOWNORMAL = 1
Private Const VER_PLATFORM_WIN32_NT = 2
Private Const lType = 4
Private Const lSize = 4
Private Const HKEY_DYN_DATA As Long = &H80000006
Dim sk As Long
Dim HQ As Long
Dim counter As Long
Dim once As Boolean
Dim px As Integer
Dim py As Integer
Dim nx As Integer
Dim ny As Integer
Dim graph As Boolean
Dim a As Integer
Private Const HWND_TOPMOST = -1
Private Const HWND_NOTOPMOST = -2
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
Private Const OOMPS = SWP_NOSIZE Or SWP_NOMOVE
Private Const OFFSET = 500
Private Function IsOsWinXP() As Boolean
Dim vi As OSVERSIONINFO
vi.dwOSVersionInfoSize = Len(vi)
Call GetVersionEx(vi)
IsOsWinXP = (vi.dwPlatformId = VER_PLATFORM_WIN32_NT)
End Function
Private Sub Form_Load()
once = True
pic.ForeColor = vbGreen
px = 0
py = pic.Height
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 2 Then PopupMenu mnu
End Sub
Private Sub Form_Resize()
If pic.Height <= label1.Height + 500 Then pic.Height = label1.Height + 500
pic.Cls
px = 0
py = pic.Height
nx = 0
ny = pic.Height
a = 0
End Sub
Private Sub Timer1_Timer()
Dim lData As Long
Dim hKey As Long
Dim r As Long
If once = True Then
init
once = False
End If
If IsOsWinXP Then
Call PdhCollectQueryData(HQ)
r = CLng(PdhVbGetDoubleCounterValue(counter, lData))
label1.Caption = r & "%"
Else
Call RegOpenKey(HKEY_DYN_DATA, "PerfStats\StartStat", hKey)
Call RegQueryValueEx(hKey, "KERNEL\CPUUsage", 0, lType, lData, lSize)
Call RegCloseKey(hKey)
Call RegOpenKey(HKEY_DYN_DATA, "PerfStats\StatData", sk)
Call RegQueryValueEx(sk, "KERNEL\CPUUsage", 0, lType, lData, lSize)
r = CLng(lData)
End If
a = a + 35
If r >= 70 Then
pic.ForeColor = vbRed
label1.ForeColor = vbRed
Else
pic.ForeColor = vbGreen
label1.ForeColor = vbGreen
End If
If graph = False Then
If r <> 0 Then
pic.Line (a, pic.Height - OFFSET)-(a, pic.Height - OFFSET - (r / 100) * pic.Height)
Else
pic.PSet (a, pic.Height - OFFSET)
End If
Else
nx = a
ny = pic.Height - (r / 100) * pic.Height
pic.Line (px, py - OFFSET)-(nx, ny - OFFSET)
px = nx
py = ny
End If
If a > pic.Width Then
a = 0
pic.Cls
nx = 0
ny = 0
px = 0
py = 0
End If
End Sub
Private Sub init()
Dim lData As Long
Dim hKey As Long
Dim r As Long
If IsOsWinXP Then
Call PdhVbOpenQuery(HQ)
Call PdhVbAddCounter(HQ, "\Processor(0)\% Processor Time", counter)
Call PdhCollectQueryData(HQ)
Call PdhVbGetDoubleCounterValue(counter, lData)
End If
End Sub
Private Sub interval_Click()
Dim ival As String
ival = InputBox("请输出绘图刷新间隔毫秒数 : (默认为200ms) ")
If ival <> "" And IsNumeric(ival) Then Timer1.interval = ival
End Sub
Private Sub lg_click()
graph = True
a = 0
pic.Cls
nx = 0
ny = 0
px = 0
py = pic.Height
End Sub
Private Sub bg_click()
graph = False
a = 0
pic.Cls
nx = 0
ny = 0
px = 0
py = pic.Height
End Sub
Private Sub ot_click()
If ot.Checked = False Then
Call SetWindowPos(Me.hwnd, HWND_TOPMOST, 0&, 0&, 0&, 0&, OOMPS)
ot.Checked = True
Else
Call SetWindowPos(Me.hwnd, HWND_NOTOPMOST, 0&, 0&, 0&, 0&, OOMPS)
ot.Checked = False
End If
End Sub
