VB.NET，部分机器获取不了CPU号(高分急用)

VB 我不熟，下面是用汇编写的，我运行过可以的。

//--------------------------------

model small

586

stack

code

idstring db 49 dup('$')

start:

mov ax,@code

mov ds,ax

lea di,idstring

mov eax,80000002h

cpuid

mov dword ptr [di],eax

mov dword ptr [di+4],ebx

mov dword ptr [di+8],ecx

mov dword ptr [di+12],edx

mov eax,80000003h

cpuid

mov dword ptr [di+16],eax

mov dword ptr [di+20],ebx

mov dword ptr [di+24],ecx

mov dword ptr [di+28],edx

mov eax,80000004h

cpuid

mov dword ptr [di+32],eax

mov dword ptr [di+36],ebx

mov dword ptr [di+40],ecx

mov dword ptr [di+44],edx

mov ah,09h

lea dx,idstring

int 21h

mov ah,4ch

int 21h

end start

//-------------------------------------------------------

程序确实可以执行，输出CPU的ID等信息。

注意：DOS下或MS-DOS下使用。

Windows 9x下是通过读取注册表获取CPU占用，但是只能是整体，不可能细分到每个进程

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 _

"advapi32dll" 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 "advapi32dll" _

Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal _

lpSubKey As String, phkResult As Long) As Long

Private Declare Function RegCloseKey Lib "advapi32dll" _

(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

Form1Top = 1

Form1Left = ScreenWidth - Form1Width

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(79) = 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

'Label2Caption = 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(Form1hwnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS) = True Then

success% = SetWindowPos(Form1hwnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS)

End If

End Sub

Windows NT/2000 下

参考一下c的吧，没时间写成VB

主要是使用了Microsoft未公开的 NtQuerySystemInformation

需要ntdlldll

一个VB获取CPU占用率的代码:

>

Private Type CounterInfo

hCounter As Long

strName As String

End Type

Private Declare Function PdhCollectQueryData Lib "PDHDLL" (ByVal QueryHandle As Long) As PDH_STATUS

Private Declare Function PdhVbGetDoubleCounterValue Lib "PDHDLL" (ByVal CounterHandle As Long, ByRef CounterStatus As Long) As Double

Private Declare Function PdhOpenQuery Lib "PDHDLL" (ByVal Reserved As Long, ByVal dwUserData As Long, ByRef hQuery As Long) As PDH_STATUS

Private Declare Function PdhVbAddCounter Lib "PDHDLL" (ByVal QueryHandle As Long, ByVal CounterPath As String, ByRef CounterHandle As Long) As PDH_STATUS

Dim Counters(0 To 99) As CounterInfo

Dim hQuery As Long

Enum PDH_STATUS

PDH_CSTATUS_VALID_DATA = &H0

PDH_CSTATUS_NEW_DATA = &H1

PDH_CSTATUS_NO_MACHINE = &H800007D0

PDH_CSTATUS_NO_INSTANCE = &H800007D1

PDH_MORE_DATA = &H800007D2

PDH_CSTATUS_ITEM_NOT_VALIDATED = &H800007D3

PDH_RETRY = &H800007D4

PDH_NO_DATA = &H800007D5

PDH_CALC_NEGATIVE_DENOMINATOR = &H800007D6

PDH_CALC_NEGATIVE_TIMEBASE = &H800007D7

PDH_CALC_NEGATIVE_VALUE = &H800007D8

PDH_DIALOG_CANCELLED = &H800007D9

PDH_CSTATUS_NO_OBJECT = &HC0000BB8

PDH_CSTATUS_NO_COUNTER = &HC0000BB9

PDH_CSTATUS_INVALID_DATA = &HC0000BBA

PDH_MEMORY_ALLOCATION_FAILURE = &HC0000BBB

PDH_INVALID_HANDLE = &HC0000BBC

PDH_INVALID_ARGUMENT = &HC0000BBD

PDH_FUNCTION_NOT_FOUND = &HC0000BBE

PDH_CSTATUS_NO_COUNTERNAME = &HC0000BBF

PDH_CSTATUS_BAD_COUNTERNAME = &HC0000BC0

PDH_INVALID_BUFFER = &HC0000BC1

PDH_INSUFFICIENT_BUFFER = &HC0000BC2

PDH_CANNOT_CONNECT_MACHINE = &HC0000BC3

PDH_INVALID_PATH = &HC0000BC4

PDH_INVALID_INSTANCE = &HC0000BC5

PDH_INVALID_DATA = &HC0000BC6

PDH_NO_DIALOG_DATA = &HC0000BC7

PDH_CANNOT_READ_NAME_STRINGS = &HC0000BC8

End Enum

Private Sub UpdateValues()

Dim dblCounterValue As Double

Dim pdhStatus As Long

Dim strInfo As String

Dim i As Long

PdhCollectQueryData (hQuery)

dblCounterValue = _

PdhVbGetDoubleCounterValue(Counters(i)hCounter, pdhStatus)

If (pdhStatus = PDH_CSTATUS_VALID_DATA) _

Or (pdhStatus = PDH_CSTATUS_NEW_DATA) Then

MsgBox "CPU使用情况:" & Format$(dblCounterValue, "00") & "%"

End If

End Sub

Private Sub AddCounter(strCounterName As String, hQuery As Long)

Dim pdhStatus As PDH_STATUS

Dim hCounter As Long

pdhStatus = PdhVbAddCounter(hQuery, strCounterName, hCounter)

Counters(currentCounterIdx)hCounter = hCounter

currentCounterIdx = currentCounterIdx + 1

End Sub

Private Sub Form_Load()

Dim pdhStatus As PDH_STATUS

pdhStatus = PdhOpenQuery(0, 1, hQuery)

AddCounter "\Processor(0)\% Processor Time", hQuery

UpdateValues

End Sub

截下来的代码

tmpstr=""

set fso=createObject("scriptingfilesystemObject")

Set dc = fsoDrives

for each d in dc

If disReady Then

    tmpstr=tmpstr & "磁盘" & dDriveLetter & ":" & vbcrlf &_

    "可用空间：" & (dAvailableSpace/1024/1024/1024) & " GB" & vbcrlf &_

    "空余空间：" & (dFreeSpace/1024/1024/1024) & " GB"  &vbcrlf &_

    "总空间大小：" & (dTotalSize/1024/1024/1024) & " GB"  &vbcrlf &_

    "文件系统：" & dFileSystem & vbcrlf &_

    "驱动器类型：" & dDriveType &vbcrlf &_

    "是否就绪：" & dIsReady &vbcrlf &_

    "路径：" & dPath &vbcrlf &_

    "根目录：" & dRootFolder &vbcrlf &_

    "序列号：" & dSerialNumber &vbcrlf &_

    "共享名：" & dShareName &vbcrlf &_

    "卷名：" & dVolumeName &vbcrlf &vbcrlf

 End If

Next

msgbox tmpstr

朋友，这是你的电脑“丢失”或“误删”了“系统文件”，或“系统文件”被病

毒和“顽固”木马“破坏”，我给你8套方案！

（答案原创，严禁盗用，如有雷同，纯属山寨！）

（提示：360急救箱不能联网，就先用：（5）网络修复，重启电脑，或者使

用：离线模式）

1下载个：“360系统急救箱”！（安全模式下，联网使用，效果更好！）

（注意：已经安装了“360安全卫士”的朋友，直接打开“木马云查杀”，

点击:快速扫描，扫描结束后，中间有：没有问题，请用360急救箱，点击它！）

1先点：“开始急救”查杀病毒，删除后，“立即重启”！

2重启开机后，再点开“文件恢复区”，全选，点：“彻底删除文件”和“可

疑启动项”！

3再点开“系统修复”，“全选”，再“立即修复”文件！（关键一步）

4再点开：“dll文件恢复”，扫描一下，如果没有就行了，如果有丢失，添

加恢复，手动添加，立即恢复！

5点开：“网络修复”，点：“开始修复”，重启电脑！（关键一步）

2。用“360安全卫士”里“系统修复”，点击“使用360安全网址导航”，“一

键修复”！（关键一步）

3。用“360安全卫士”的“扫描插件”，然后再“清理插件”，把它删除！

4。再用“360杀毒双引擎版”，勾选“自动处理扫描出的病毒威胁”，用“全盘

扫描”和“自定义扫描”，扫出病毒木马，再点删除！

重启电脑后，来到“隔离区”，点“彻底删除”！

5。使用360安全卫士的“木马查杀”，全盘扫描，完毕再“自定义扫描”！

扫出木马或恶意病毒程序，就点删除！

重启电脑后，来到“文件恢复区”，点“彻底删除”！

6。如果还是不行，试试：“金山急救箱”的扩展扫描和“金山网盾”，一键修

复！或者：可牛免费杀毒，浏览器医生，浏览器修复，立即扫描，立即修复！

7。再不行，重启电脑，开机后，按F8，回车，回车，进到“安全模式”里，

“高级启动选项”里，“最后一次正确配置”，按下去试试，看看效果！

8。实在不行，做“一键还原”系统！（

以上就是关于VB.NET，部分机器获取不了CPU号(高分急用)全部的内容，包括:VB.NET，部分机器获取不了CPU号(高分急用)、VB 查看进程CPU使用率、求VB代码：得到CPU占用率等相关内容解答，如果想了解更多相关内容，可以关注我们，你们的支持是我们更新的动力！