给你个例子： 模块中声明如下： Public Type LARGE_INTEGER lowpart As Long highpart As Long End TypePublic 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 Public Const REG_DWORD = 4 Public Const HKEY_DYN_DATA = &H80000006 Public 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 Public Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As LongPublic 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 Public Const SW_SHOWNORMAL = 1 Public Type SystemInfo dwOemId As Long dwPageSize As Long lpMinAppAddress As Long lpMaxAppAddress As Long dwActiveProcessorMask As Long dwNumberOfProcessors As Long dwProcessorType As Long dwAllocationGranularity As Long dwReserved As Long End Type Public Declare Sub GetSystemInfo Lib "kernel32" (lpSystemInfo As SystemInfo)
VB声明 Declare Sub GetSystemInfo Lib "kernel32" Alias "GetSystemInfo" (lpSystemInfo As SYSTEM_INFO) 说明 在一个SYSTEM_INFO结构中载入与底层硬件平台有关的信息 参数表 参数 类型及说明 lpSystemInfo SYSTEM_INFO，指定一个结构，用于装载适当的系统信息类型定义 Type SYSTEM_INFO ' 36 Bytes dwOemID As Long dwPageSize As Long lpMinimumApplicationAddress As Long lpMaximumApplicationAddress As Long dwActiveProcessorMask As Long dwNumberOrfProcessors As Long dwProcessorType As Long dwAllocationGranularity As Long wProcessorLevel As Integer wProcessorRevision As Integer End Type 说明 This structure contains information regarding the current computer system.SYSTEM_INFO ： 字段表 字段 类型与说明 dwOemID Long，System processor used. In Windows 95, this value is always set to zero (PROCESSOR_ARCHITECTURE_INTEL). In Windows NT, this value may be one of the following : PROCESSOR_ARCHITECTURE_INTEL, PROCESSOR_ARCHITECTURE_MIPS, PROCESSOR_ARCHITECTURE_ALPHA, PROCESSOR_ARCHITECTURE_PPC dwPageSize Long，Page size used. Also specifies the granularity of page protection and commitment. lpMinimumApplicationAddress Long，Contains the lowest memory address that applications and dynamic link libraries (DLLs) can access. lpMaximumApplicationAddress Long，Contains the highest memory address that applications and DLLs can access. dwActiveProcessorMask Long，Contains a mask representing the set of processors available on the system. Processor zero is indicated by bit zero being set. dwNumberOrfProcessors Long，The number of processors in this system. dwProcessorType Long，Obsolete, but maintained for backward compatibility. Can be one of the following values: PROCESSOR_INTEL_386, PROCESSOR_INTEL_486, PROCESSOR_INTEL_PENTIUM. The following are valid on Windows NT systems only: PROCESSOR_MIPS_R4000, PROCESSOR_ALPHA_21046 dwAllocationGranularity Long，Contains the allocation granularity used to allocate memory. This value is usually set to 64K. wProcessorLevel Integer，Specifies the processor level. This value depends on the PROCESSOR_ARCHITECTURE_* value in the dwOemID field. For PROCESSOR_ARCHITECTURE_INTEL, the valid values are currently: 3 for a 386 CPU, 4 for a 486 CPU, and 5 for a Pentium. wProcessorRevision Integer，Specifies the processor revision. This value depends on the PROCESSOR_ARCHITECTURE_* value in the dwOemID field.
Oem Id: 0 Page Size: 4096 Minimum Application Address: 65536 Maximum Application Address: 2147418111 Active Processor Mask: 1 Number of Processors: 1 Processor Type: 586 Allocation Granularity: 65536 Reserved: 134873094 哪个是序列号？
Oem Id: 0 Page Size: 4096 Minimum Application Address: 65536 Maximum Application Address: 2147418111 Active Processor Mask: 1 Number of Processors: 1 Processor Type: 586 Allocation Granularity: 65536 Reserved: 134873094 哪个是序列号？（无）
http://www.pdriver.com/display.asp?key_id=1440Private Declare Function getcpuid Lib "puid.dll" () As Long Private Sub Command1_Click() Text1 = getcpuid() End Sub
下面的例子完全用VB进行ASM编程的示例，本例获得CPU ID. 工程文件分为一个form1.frm 和一个模块module1.bas----------------------form1.frm的源文件---------------------VERSION 5.00 Begin VB.Form Form1 Caption = "Form1" ClientHeight = 1965 ClientLeft = 60 ClientTop = 345 ClientWidth = 3105 LinkTopic = "Form1" ScaleHeight = 1965 ScaleWidth = 3105 StartUpPosition = 2 'Bildschirmmitte Begin VB.CommandButton Command1 Caption = "Get CPU Name" Height = 495 Left = 840 TabIndex = 0 Top = 315 Width = 1425 End Begin VB.Label Label2 Alignment = 2 'Zentriert AutoSize = -1 'True BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 240 Left = 1515 TabIndex = 2 Top = 1065 Width = 60 End Begin VB.Label Label1 Alignment = 2 'Zentriert AutoSize = -1 'True BeginProperty Font Name = "Arial" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 285 Left = 1515 TabIndex = 1 Top = 1350 Width = 75 End End Attribute VB_Name = "Form1" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option ExplicitPrivate Sub Command1_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single) Label1 = "" Label2 = ""End SubPrivate Sub Command1_Click()
Label1 = GetCpuName() & " CPU" Label2 = "You have a" & IIf(InStr("AEIOU", Left$(Label1, 1)), "n", "")End Sub ------------------------------end---------------------------------下面是modu1e.bas的源代码----------------------module1.bas的源文件-------------------------- Option Explicit ' 'This shows how to incorporate machine code into VB ''''''''''''''''''''''''''''''''''''''''''''''''''' 'The example fills the array with a few machine instructions and then copies 'them to a procedure address. The modified procedure is then called thru 'CallWindowProc. The result of this specific machine code is your CPU Vendor Name. ' '########################################################################## 'Apparently it gets a Stack Pointer Error, but I don't know why; if anybody 'can fix that please let me know... [email protected] 'The Error is not present in the native compiled version; so I think it got 'something to do with the P-Code Calling Convention (strange though)... '########################################################################## ' 'Sub Dummy serves to reserve some space to copy the machine instructions into. ' ' 'Tested on Intel and AMD CPU's (uncompiled and compiled) ' ' Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long) Private x As LongPublic Function GetCpuName() As String
Dim MachineCode(0 To 35) As Byte Dim VarAddr As Long Dim FunctAddr As Long Dim EAX As Long Dim CPUName(1 To 12) As Byte
MachineCode(31) = &HC9 'leave MachineCode(32) = &HC2 'ret 16 I tried everything from 0 to 24 MachineCode(33) = &H10 ' but all produce the stack error MachineCode(34) = &H0
'tell cpuid what we want EAX = 0
'get address of Machine Code VarAddr = VarPtr(MachineCode(0))
'get address of Sub Dummy FunctAddr = GetAddress(AddressOf Dummy)
'copy the Machine Code to where it can be called CopyMemory ByVal FunctAddr, ByVal VarAddr, 35 '35 bytes machine code
'call it On Error Resume Next 'apparently it gets a stack pointer error when in P-Code but i dont know why CallWindowProc FunctAddr, EAX, VarPtr(CPUName(1)), VarPtr(CPUName(9)), VarPtr(CPUName(5)) 'Debug.Print Err; Err.Description 'MsgBox Err & Err.Description On Error GoTo 0
End FunctionPrivate Function GetAddress(Address As Long) As Long GetAddress = AddressEnd FunctionPrivate Sub Dummy() 'the code below just reserves some space to copy the machine code into 'it is never executed x = 0 x = 1 x = 2 x = 3 x = 4 x = 5 x = 6 x = 7 x = 8 x = 9 x = 10 x = 0 x = 1 x = 2 x = 3 x = 4 x = 5 x = 6 x = 7 x = 8 x = 9 x = 10
End Sub ------------------------------end--------------------------------------
参考一下，我得机器测试未通过(amd xp cpu) p2 300 ->pass[名称] 在VB里嵌入汇编[数据来源] 未知[源代码内容]下面的例子完全用VB进行ASM编程的示例，本例获得CPU ID. 工程文件分为一个form1.frm 和一个模块module1.bas ----------------------form1.frm的源文件--------------------- VERSION 5.00 Begin VB.Form Form1 Caption = "Form1" ClientHeight = 1965 ClientLeft = 60 ClientTop = 345 ClientWidth = 3105 LinkTopic = "Form1" ScaleHeight = 1965 ScaleWidth = 3105 StartUpPosition = 2 'Bildschirmmitte Begin VB.CommandButton Command1 Caption = "Get CPU Name" Height = 495 Left = 840 TabIndex = 0 Top = 315 Width = 1425 End Begin VB.Label Label2 Alignment = 2 'Zentriert AutoSize = -1 'True BeginProperty Font Name = "MS Sans Serif&q uot; Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 240 Left = 1515 TabIndex = 2 Top = 1065 Width = 60 End Begin VB.Label Label1 Alignment = 2 'Zentriert AutoSize = -1 'True BeginProperty Font Name = "Arial" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 285 Left = 1515 TabIndex = 1 Top = 1350 Width = 75 End End Attribute VB_Name = "Form1" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit Private Sub Command1_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single) Label1 = "" Label2 = "" End Sub Private Sub Command1_Click() Label1 = GetCpuName() & " CPU" Label2 = "You have a" & IIf(InStr("AEIOU&qu ot;, Left$(Label1, 1)), "n", "") End Sub ------------------------------end--------------------------------- 下面是modu1e.bas的源代码 ----------------------module1.bas的源文件-------------------------- Option Explicit ' 'This shows how to incorporate machine code into VB '''''''''''''''''''''''''''''''''''''' ''''''''''''' 'The example fills the array with a few machine instructions and then copies 'them to a procedure address. The modified procedure is then call ed thru 'CallWindowProc. The result of this specific machine code is your CPU Vendor Name. ' '##########################################################################'Apparently it gets a Stack Pointer Error, but I don't know why ; if anybody 'can fix that please let me know... [email protected] 'The Error is not present in the native compiled version; so I think it got 'something to do with the P-Code Calling Convention (strange thoug h)... '##########################################################################' 'Sub Dummy serves to reserve some space to copy the machine inst ructions into. ' ' 'Tested on Intel and AMD CPU's (uncompiled and compiled) ' ' Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam A s Long) As Long Private Declare Sub CopyMemory Lib "kernel32" Alias "R tlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long) Private x As Long Public Function GetCpuName() As String Dim MachineCode(0 To 35) As Byte Dim VarAddr As Long Dim FunctAddr As Long Dim EAX As Long Dim CPUName(1 To 12) As Byte 'set up machine code MachineCode(0) = &H55 'push ebp MachineCode(1) = &H8B 'move ebp,esp MachineCode(2) = &HEC MachineCode(3) = &H57 'push edi MachineCode(4) = &H52 'push edx MachineCode(5) = &H51 'push ecx MachineCode(6) = &H53 'push ebx MachineCode(7) = &H8B 'move eax,dword ptr [ebp+8] MachineCode(8) = &H45 MachineCode(9) = &H8 MachineCode(10) = &HF 'cpuid MachineCode(11) = &HA2 MachineCode(12) = &H8B 'mov edi,dword ptr [ebp+12] MachineCode(13) = &H7D MachineCode(14) = &HC MachineCode(15) = &H89 'move dword ptr [edi],ebx MachineCode(16) = &H1F MachineCode(17) = &H8B 'mov edi,dword ptr [ebp+16] MachineCode(18) = &H7D MachineCode(19) = &H10 MachineCode(20) = &H89 'move dword ptr [edi],ecx MachineCode(21) = &HF MachineCode(22) = &H8B 'mov edi,dword ptr [ebp+20] MachineCode(23) = &H7D MachineCode(24) = &H14 MachineCode(25) = &H89 'move dword ptr [edi],edx MachineCode(26) = &H17 MachineCode(27) = &H58 'pop ebx MachineCode(28) = &H59 'pop ecx MachineCode(29) = &H5A 'pop edx MachineCode(30) = &H55 'pop edi MachineCode(31) = &HC9 'leave MachineCode(32) = &HC2 'ret 16 I tried every thing from 0 to 24 MachineCode(33) = &H10 ' but all produce the stack error MachineCode(34) = &H0 'tell cpuid what we want EAX = 0 'get address of Machine Code VarAddr = VarPtr(MachineCode(0)) 'get address of Sub Dummy FunctAddr = GetAddress(AddressOf Dummy) 'copy the Machine Code to where it can be called CopyMemory ByVal FunctAddr, ByVal VarAddr, 35 '35 bytes mac hine code 'call it On Error Resume Next 'apparently it gets a stack pointer error when in P-Code but i dont know why CallWindowProc FunctAddr, EAX, VarPtr(CPUName(1)), VarPtr(CP UName(9)), VarPtr(CPUName(5)) 'Debug.Print Err; Err.Description 'MsgBox Err & Err.Description On Error GoTo 0 GetCpuName = StrConv(CPUName(), vbUnicode) 'UnicodeName End Function Private Function GetAddress(Address As Long) As Long GetAddress = Address End Function Private Sub Dummy() 'the code below just reserves some space to copy the machine code into 'it is never executed x = 0 x = 1 x = 2 x = 3 x = 4 x = 5 x = 6 x = 7 x = 8 x = 9 x = 10 x = 0 x = 1 x = 2 x = 3 x = 4 x = 5 x = 6 x = 7 x = 8 x = 9 x = 10 End Sub ------------------------------end-------------------------------------- 以上代码保存于： SourceCode Explorer(源代码数据库) 复制时间： 2003-8-8 23:51:36 软件版本： 1.0.857 软件作者： Shawls E-Mail： [email protected] QQ： 9181729
额，错了，是piii 450,那个p2得机器也死机了
Private Type LARGE_INTEGER lowpart As Long highpart As Long End TypePrivate 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 LongPrivate Const REG_DWORD = 4 Private Const HKEY_DYN_DATA = &H80000006Private 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 LongPrivate Declare Function RegOpenKey Lib "advapi32.dll" _ Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal _ lpSubKey As String, phkResult As Long) As LongPrivate 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 LongDim mix As Long Dim miy As LongPrivate Sub Command1_Click() End End SubPrivate Sub Form_Load() '将Form1的位置设置到屏幕右上角 Form1.Top = 1 Form1.Left = Screen.Width - Form1.WidthCall InitCPU Call OnTop End SubPrivate Sub Form_Resize() Picture1.Width = Me.ScaleWidth mix = Picture1.Width \ 30 End SubPrivate Sub Timer1_Timer() Dim lData As Long, lType As Long, lSize As Long Dim hKey As Long Dim l As Long Dim astr As StringQry = RegOpenKey(HKEY_DYN_DATA, "PerfStats\StatData", hKey)
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 SubPrivate 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 SubPrivate Sub OnTop() Const SWP_NOMOVE = &H2 Const SWP_NOSIZE = &H1 Const FLAGS = SWP_NOMOVE Or SWP_NOSIZE Const HWND_TOPMOST = -1 Const HWND_NOTOPMOST = -2If 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提供一个NT的（取自网友文章） －－－－－－－－－－－－ '建一个类，名称CPUOption 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 1000msOption Explicit Dim lngCPU As New CPU Private Sub Timer1_Timer() Text1 = lngCPU.Query End Sub
模块中声明如下：
Public Type LARGE_INTEGER
lowpart As Long
highpart As Long
End TypePublic 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
Public Const REG_DWORD = 4
Public Const HKEY_DYN_DATA = &H80000006
Public 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
Public Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As LongPublic 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
Public Const SW_SHOWNORMAL = 1
Public Type SystemInfo
dwOemId As Long
dwPageSize As Long
lpMinAppAddress As Long
lpMaxAppAddress As Long
dwActiveProcessorMask As Long
dwNumberOfProcessors As Long
dwProcessorType As Long
dwAllocationGranularity As Long
dwReserved As Long
End Type
Public Declare Sub GetSystemInfo Lib "kernel32" (lpSystemInfo As SystemInfo)
Private Sub Form_Load()
Dim System As SystemInfo
Dim cpuinfo As String
GetSystemInfo System
cpuinfo = "Oem Id: " & System.dwOemId & Chr(13) & Chr(10)
cpuinfo = cpuinfo & "Page Size: " & System.dwPageSize & Chr(13) & Chr(10)
cpuinfo = cpuinfo & "Minimum Application Address: " & System.lpMinAppAddress & Chr(13) & Chr(10)
cpuinfo = cpuinfo & "Maximum Application Address: " & System.lpMaxAppAddress & Chr(13) & Chr(10)
cpuinfo = cpuinfo & "Active Processor Mask: " & System.dwActiveProcessorMask & Chr(13) & Chr(10)
cpuinfo = cpuinfo & "Number of Processors: " & System.dwNumberOfProcessors & Chr(13) & Chr(10)
cpuinfo = cpuinfo & "Processor Type: " & System.dwProcessorType & Chr(13) & Chr(10)
cpuinfo = cpuinfo & "Allocation Granularity: " & System.dwAllocationGranularity & Chr(13) & Chr(10)
cpuinfo = cpuinfo & "Reserved: " & System.dwReserved
Label1.Caption = cpuinfo
End Sub
Declare Sub GetSystemInfo Lib "kernel32" Alias "GetSystemInfo" (lpSystemInfo As SYSTEM_INFO)
说明
在一个SYSTEM_INFO结构中载入与底层硬件平台有关的信息
参数表
参数 类型及说明
lpSystemInfo SYSTEM_INFO，指定一个结构，用于装载适当的系统信息类型定义
Type SYSTEM_INFO ' 36 Bytes
dwOemID As Long
dwPageSize As Long
lpMinimumApplicationAddress As Long
lpMaximumApplicationAddress As Long
dwActiveProcessorMask As Long
dwNumberOrfProcessors As Long
dwProcessorType As Long
dwAllocationGranularity As Long
wProcessorLevel As Integer
wProcessorRevision As Integer
End Type
说明
This structure contains information regarding the current computer system.SYSTEM_INFO ：
字段表 字段 类型与说明
dwOemID Long，System processor used. In Windows 95, this value is always set to zero (PROCESSOR_ARCHITECTURE_INTEL). In Windows NT, this value may be one of the following : PROCESSOR_ARCHITECTURE_INTEL, PROCESSOR_ARCHITECTURE_MIPS, PROCESSOR_ARCHITECTURE_ALPHA, PROCESSOR_ARCHITECTURE_PPC
dwPageSize Long，Page size used. Also specifies the granularity of page protection and commitment.
lpMinimumApplicationAddress Long，Contains the lowest memory address that applications and dynamic link libraries (DLLs) can access. lpMaximumApplicationAddress Long，Contains the highest memory address that applications and DLLs can access.
dwActiveProcessorMask Long，Contains a mask representing the set of processors available on the system. Processor zero is indicated by bit zero being set.
dwNumberOrfProcessors Long，The number of processors in this system.
dwProcessorType Long，Obsolete, but maintained for backward compatibility. Can be one of the following values: PROCESSOR_INTEL_386, PROCESSOR_INTEL_486, PROCESSOR_INTEL_PENTIUM. The following are valid on Windows NT systems only: PROCESSOR_MIPS_R4000, PROCESSOR_ALPHA_21046 dwAllocationGranularity Long，Contains the allocation granularity used to allocate memory. This value is usually set to 64K.
wProcessorLevel Integer，Specifies the processor level. This value depends on the PROCESSOR_ARCHITECTURE_* value in the dwOemID field. For PROCESSOR_ARCHITECTURE_INTEL, the valid values are currently: 3 for a 386 CPU, 4 for a 486 CPU, and 5 for a Pentium.
wProcessorRevision Integer，Specifies the processor revision. This value depends on the PROCESSOR_ARCHITECTURE_* value in the dwOemID field.
Page Size: 4096
Minimum Application Address: 65536
Maximum Application Address: 2147418111
Active Processor Mask: 1
Number of Processors: 1
Processor Type: 586
Allocation Granularity: 65536
Reserved: 134873094
哪个是序列号？
Page Size: 4096
Minimum Application Address: 65536
Maximum Application Address: 2147418111
Active Processor Mask: 1
Number of Processors: 1
Processor Type: 586
Allocation Granularity: 65536
Reserved: 134873094
哪个是序列号？（无）
http://www.csdn.net/cnshare/soft/9/9091.shtm
http://expert.csdn.net/Expert/topic/1880/1880883.xml?temp=3.420657E-02
一个下不了 一个不能用
Private Sub Command1_Click()
Text1 = getcpuid()
End Sub
试了几台机器都得到一样的数据
关注ing
CPU似乎没有序列号
我以前用微软的WMI也读了个号
也出显过相同的
http://expert.csdn.net/Expert/topic/1972/1972386.xml?temp=.3529016
http://expert.csdn.net/Expert/topic/1969/1969640.xml?temp=.2918817
http://expert.csdn.net/Expert/topic/1880/1880883.xml?temp=.9266626
http://expert.csdn.net/Expert/topic/1838/1838722.xml?temp=.7783167
http://expert.csdn.net/Expert/topic/1680/1680715.xml?temp=.3237268http://expert.csdn.net/Expert/topic/1328/1328644.xml?temp=.9751093
工程文件分为一个form1.frm 和一个模块module1.bas----------------------form1.frm的源文件---------------------VERSION 5.00
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 1965
ClientLeft = 60
ClientTop = 345
ClientWidth = 3105
LinkTopic = "Form1"
ScaleHeight = 1965
ScaleWidth = 3105
StartUpPosition = 2 'Bildschirmmitte
Begin VB.CommandButton Command1
Caption = "Get CPU Name"
Height = 495
Left = 840
TabIndex = 0
Top = 315
Width = 1425
End
Begin VB.Label Label2
Alignment = 2 'Zentriert
AutoSize = -1 'True
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 1515
TabIndex = 2
Top = 1065
Width = 60
End
Begin VB.Label Label1
Alignment = 2 'Zentriert
AutoSize = -1 'True
BeginProperty Font
Name = "Arial"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Left = 1515
TabIndex = 1
Top = 1350
Width = 75
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option ExplicitPrivate Sub Command1_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single) Label1 = ""
Label2 = ""End SubPrivate Sub Command1_Click()
Label1 = GetCpuName() & " CPU"
Label2 = "You have a" & IIf(InStr("AEIOU", Left$(Label1, 1)), "n", "")End Sub
------------------------------end---------------------------------下面是modu1e.bas的源代码----------------------module1.bas的源文件--------------------------
Option Explicit
'
'This shows how to incorporate machine code into VB
'''''''''''''''''''''''''''''''''''''''''''''''''''
'The example fills the array with a few machine instructions and then copies
'them to a procedure address. The modified procedure is then called thru
'CallWindowProc. The result of this specific machine code is your CPU Vendor Name.
'
'##########################################################################
'Apparently it gets a Stack Pointer Error, but I don't know why; if anybody
'can fix that please let me know... [email protected]
'The Error is not present in the native compiled version; so I think it got
'something to do with the P-Code Calling Convention (strange though)...
'##########################################################################
'
'Sub Dummy serves to reserve some space to copy the machine instructions into.
'
'
'Tested on Intel and AMD CPU's (uncompiled and compiled)
'
'
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
Private x As LongPublic Function GetCpuName() As String
Dim MachineCode(0 To 35) As Byte
Dim VarAddr As Long
Dim FunctAddr As Long
Dim EAX As Long
Dim CPUName(1 To 12) As Byte
'set up machine code
MachineCode(0) = &H55 'push ebp
MachineCode(1) = &H8B 'move ebp,esp
MachineCode(2) = &HEC
MachineCode(3) = &H57 'push edi
MachineCode(4) = &H52 'push edx
MachineCode(5) = &H51 'push ecx
MachineCode(6) = &H53 'push ebx
MachineCode(7) = &H8B 'move eax,dword ptr [ebp+8]
MachineCode(8) = &H45
MachineCode(9) = &H8
MachineCode(10) = &HF 'cpuid
MachineCode(11) = &HA2
MachineCode(12) = &H8B 'mov edi,dword ptr [ebp+12]
MachineCode(13) = &H7D
MachineCode(14) = &HC
MachineCode(15) = &H89 'move dword ptr [edi],ebx
MachineCode(16) = &H1F
MachineCode(17) = &H8B 'mov edi,dword ptr [ebp+16]
MachineCode(18) = &H7D
MachineCode(19) = &H10
MachineCode(20) = &H89 'move dword ptr [edi],ecx
MachineCode(21) = &HF
MachineCode(22) = &H8B 'mov edi,dword ptr [ebp+20]
MachineCode(23) = &H7D
MachineCode(24) = &H14
MachineCode(25) = &H89 'move dword ptr [edi],edx
MachineCode(26) = &H17
MachineCode(27) = &H58 'pop ebx MachineCode(28) = &H59 'pop ecx MachineCode(29) = &H5A 'pop edx MachineCode(30) = &H55 'pop edi
MachineCode(31) = &HC9 'leave MachineCode(32) = &HC2 'ret 16 I tried everything from 0 to 24
MachineCode(33) = &H10 ' but all produce the stack error
MachineCode(34) = &H0
'tell cpuid what we want
EAX = 0
'get address of Machine Code
VarAddr = VarPtr(MachineCode(0))
'get address of Sub Dummy
FunctAddr = GetAddress(AddressOf Dummy)
'copy the Machine Code to where it can be called
CopyMemory ByVal FunctAddr, ByVal VarAddr, 35 '35 bytes machine code
'call it
On Error Resume Next 'apparently it gets a stack pointer error when in P-Code but i dont know why
CallWindowProc FunctAddr, EAX, VarPtr(CPUName(1)), VarPtr(CPUName(9)), VarPtr(CPUName(5))
'Debug.Print Err; Err.Description
'MsgBox Err & Err.Description
On Error GoTo 0
GetCpuName = StrConv(CPUName(), vbUnicode) 'UnicodeName
End FunctionPrivate Function GetAddress(Address As Long) As Long GetAddress = AddressEnd FunctionPrivate Sub Dummy() 'the code below just reserves some space to copy the machine code into
'it is never executed x = 0
x = 1
x = 2
x = 3
x = 4
x = 5
x = 6
x = 7
x = 8
x = 9
x = 10
x = 0
x = 1
x = 2
x = 3
x = 4
x = 5
x = 6
x = 7
x = 8
x = 9
x = 10
End Sub
------------------------------end--------------------------------------
好像不是耶！
[email protected]
高手。
p2 300 ->pass[名称] 在VB里嵌入汇编[数据来源] 未知[源代码内容]下面的例子完全用VB进行ASM编程的示例，本例获得CPU ID.
工程文件分为一个form1.frm 和一个模块module1.bas
----------------------form1.frm的源文件---------------------
VERSION 5.00
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 1965
ClientLeft = 60
ClientTop = 345
ClientWidth = 3105
LinkTopic = "Form1"
ScaleHeight = 1965
ScaleWidth = 3105
StartUpPosition = 2 'Bildschirmmitte
Begin VB.CommandButton Command1
Caption = "Get CPU Name"
Height = 495
Left = 840
TabIndex = 0
Top = 315
Width = 1425
End
Begin VB.Label Label2
Alignment = 2 'Zentriert
AutoSize = -1 'True
BeginProperty Font
Name = "MS Sans Serif&q
uot;
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 1515
TabIndex = 2
Top = 1065
Width = 60
End
Begin VB.Label Label1
Alignment = 2 'Zentriert
AutoSize = -1 'True
BeginProperty Font
Name = "Arial"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Left = 1515
TabIndex = 1
Top = 1350
Width = 75
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub Command1_MouseDown(Button As Integer, Shift As Integer,
x As Single, Y As Single)
Label1 = ""
Label2 = ""
End Sub
Private Sub Command1_Click()
Label1 = GetCpuName() & " CPU"
Label2 = "You have a" & IIf(InStr("AEIOU&qu
ot;, Left$(Label1, 1)), "n", "")
End Sub
------------------------------end---------------------------------
下面是modu1e.bas的源代码
----------------------module1.bas的源文件--------------------------
Option Explicit
'
'This shows how to incorporate machine code into VB
''''''''''''''''''''''''''''''''''''''
'''''''''''''
'The example fills the array with a few machine instructions and
then copies
'them to a procedure address. The modified procedure is then call
ed thru
'CallWindowProc. The result of this specific machine code is your
CPU Vendor Name.
'
'##########################################################################'Apparently it gets a Stack Pointer Error, but I don't know why
; if anybody
'can fix that please let me know...
[email protected]
'The Error is not present in the native compiled version; so I
think it got
'something to do with the P-Code Calling Convention (strange thoug
h)...
'##########################################################################'
'Sub Dummy serves to reserve some space to copy the machine inst
ructions into.
'
'
'Tested on Intel and AMD CPU's (uncompiled and compiled)
'
'
Private Declare Function CallWindowProc Lib "user32" Alias
"CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd
As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam A
s Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "R
tlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbCopy
As Long)
Private x As Long
Public Function GetCpuName() As String Dim MachineCode(0 To 35) As Byte
Dim VarAddr As Long
Dim FunctAddr As Long
Dim EAX As Long
Dim CPUName(1 To 12) As Byte 'set up machine code
MachineCode(0) = &H55 'push ebp
MachineCode(1) = &H8B 'move ebp,esp
MachineCode(2) = &HEC
MachineCode(3) = &H57 'push edi
MachineCode(4) = &H52 'push edx
MachineCode(5) = &H51 'push ecx
MachineCode(6) = &H53 'push ebx
MachineCode(7) = &H8B 'move eax,dword ptr [ebp+8]
MachineCode(8) = &H45
MachineCode(9) = &H8
MachineCode(10) = &HF 'cpuid
MachineCode(11) = &HA2
MachineCode(12) = &H8B 'mov edi,dword ptr [ebp+12]
MachineCode(13) = &H7D
MachineCode(14) = &HC
MachineCode(15) = &H89 'move dword ptr [edi],ebx
MachineCode(16) = &H1F
MachineCode(17) = &H8B 'mov edi,dword ptr [ebp+16]
MachineCode(18) = &H7D
MachineCode(19) = &H10
MachineCode(20) = &H89 'move dword ptr [edi],ecx
MachineCode(21) = &HF
MachineCode(22) = &H8B 'mov edi,dword ptr [ebp+20]
MachineCode(23) = &H7D
MachineCode(24) = &H14
MachineCode(25) = &H89 'move dword ptr [edi],edx
MachineCode(26) = &H17
MachineCode(27) = &H58 'pop ebx
MachineCode(28) = &H59 'pop ecx
MachineCode(29) = &H5A 'pop edx
MachineCode(30) = &H55 'pop edi
MachineCode(31) = &HC9 'leave
MachineCode(32) = &HC2 'ret 16 I tried every
thing from 0 to 24
MachineCode(33) = &H10 ' but all
produce the stack error
MachineCode(34) = &H0
'tell cpuid what we want
EAX = 0
'get address of Machine Code
VarAddr = VarPtr(MachineCode(0))
'get address of Sub Dummy
FunctAddr = GetAddress(AddressOf Dummy)
'copy the Machine Code to where it can be called
CopyMemory ByVal FunctAddr, ByVal VarAddr, 35 '35 bytes mac
hine code
'call it
On Error Resume Next 'apparently it gets a stack pointer
error when in P-Code but i dont know why
CallWindowProc FunctAddr, EAX, VarPtr(CPUName(1)), VarPtr(CP
UName(9)), VarPtr(CPUName(5))
'Debug.Print Err; Err.Description
'MsgBox Err & Err.Description
On Error GoTo 0
GetCpuName = StrConv(CPUName(), vbUnicode) 'UnicodeName
End Function
Private Function GetAddress(Address As Long) As Long
GetAddress = Address
End Function
Private Sub Dummy()
'the code below just reserves some space to copy the machine
code into
'it is never executed
x = 0
x = 1
x = 2
x = 3
x = 4
x = 5
x = 6
x = 7
x = 8
x = 9
x = 10
x = 0
x = 1
x = 2
x = 3
x = 4
x = 5
x = 6
x = 7
x = 8
x = 9
x = 10
End Sub
------------------------------end--------------------------------------
以上代码保存于： SourceCode Explorer(源代码数据库)
复制时间： 2003-8-8 23:51:36
软件版本： 1.0.857
软件作者： Shawls
E-Mail： [email protected]
QQ： 9181729
lowpart As Long
highpart As Long
End TypePrivate 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 LongPrivate Const REG_DWORD = 4
Private Const HKEY_DYN_DATA = &H80000006Private 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 LongPrivate Declare Function RegOpenKey Lib "advapi32.dll" _
Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal _
lpSubKey As String, phkResult As Long) As LongPrivate 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 LongDim mix As Long
Dim miy As LongPrivate Sub Command1_Click()
End
End SubPrivate Sub Form_Load()
'将Form1的位置设置到屏幕右上角
Form1.Top = 1
Form1.Left = Screen.Width - Form1.WidthCall InitCPU
Call OnTop
End SubPrivate Sub Form_Resize()
Picture1.Width = Me.ScaleWidth
mix = Picture1.Width \ 30
End SubPrivate Sub Timer1_Timer()
Dim lData As Long, lType As Long, lSize As Long
Dim hKey As Long
Dim l As Long
Dim astr As StringQry = 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 SubPrivate 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 SubPrivate Sub OnTop()
Const SWP_NOMOVE = &H2
Const SWP_NOSIZE = &H1
Const FLAGS = SWP_NOMOVE Or SWP_NOSIZE
Const HWND_TOPMOST = -1
Const HWND_NOTOPMOST = -2If 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提供一个NT的（取自网友文章）
－－－－－－－－－－－－
'建一个类，名称CPUOption 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 1000msOption Explicit
Dim lngCPU As New CPU
Private Sub Timer1_Timer()
Text1 = lngCPU.Query
End Sub