Is there a way to get the ID # of the CPU, much like you would of the HDrive, in VB?
Printable View
Is there a way to get the ID # of the CPU, much like you would of the HDrive, in VB?
*bump*
VB Code:
Private Declare Function GetVolumeInformation Lib "kernel32" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long Private Sub GetVolume(PathName As String, DrvVolumeName As String, DrvSerialNo As String) Dim r As Long Dim pos As Integer Dim hword As Long Dim HiHexStr As String Dim lword As Long Dim LoHexStr As String Dim VolumeSN As Long Dim MaxFNLen As Long Dim UnusedStr As String Dim UnusedVal1 As Long Dim UnusedVal2 As Long 'pad the strings DrvVolumeName$ = Space$(14) UnusedStr$ = Space$(32) 'do what it says r = GetVolumeInformation(PathName, DrvVolumeName, Len(DrvVolumeName), VolumeSN&, UnusedVal1, UnusedVal2, UnusedStr, Len(UnusedStr$)) 'error check If r& = 0 Then Exit Sub 'determine the volume label pos = InStr(DrvVolumeName, Chr$(0)) If pos Then DrvVolumeName = Left$(DrvVolumeName, pos - 1) If Len(Trim$(DrvVolumeName)) = 0 Then DrvVolumeName = "(no label)" hword = HiWord(VolumeSN) lword = LoWord(VolumeSN) HiHexStr = Format$(Hex(hword), "0000") LoHexStr = Format$(Hex(lword), "0000") DrvSerialNo = HiHexStr & "-" & LoHexStr End Sub Private Function HiWord(dw As Long) As Integer HiWord = (dw And &HFFFF0000) \ &H10000 End Function Private Function LoWord(dw As Long) As Integer If dw And &H8000& Then LoWord = dw Or &HFFFF0000 Else LoWord = dw And &HFFFF& End If End Function Private Sub Command1_Click() 'To Display The Volume Name And Serial Number: Dim PathName As String Dim DrvVolumeName As String Dim DrvSerialNo As String PathName$ = "c:\" GetVolume PathName, DrvVolumeName, DrvSerialNo MsgBox "Drive Statistics for " & UCase$(PathName) & ": " & "Volume Label " & DrvVolumeName & ", " & "Volume Serial No " & DrvSerialNo End Sub
No no no, CPU serial num, not hd
This is the best I could find, but I don't think it has what you want. If you found anything, post it. :)
It would help if I included the link :rolleyes:
http://www.mvps.org/vbnet/index.html...systeminfo.htm
This Question has come up twice today!
Here's some code from http://www.freevbcode.com/ShowCode.Asp?ID=1576
VB Code:
'***********************************************************\ 'NOTES: 'YOU MUST HAVE WMI SDK INSTALLED. YOU CAN GET IT AT 'http://msdn.microsoft.com/downloads/sdks/wmi/default.asp 'Remember to add it in Project References! '*********************************************************************** Private asCpuPaths() As String Private m_objCPUSet As SWbemObjectSet Private m_objWMINameSpace As SWbemServices Option Explicit Private Sub cmdDone_Click() Unload Me End Sub Private Sub Form_Load() Dim oCpu As SWbemObject 'WMI Object, in this case, local CPUs Dim sPath As String, sCaption As String Dim lElement As Long ReDim asCpuPaths(0) As String On Error GoTo ErrorHandler 'Get Default NameSpace, which will be the one for the local machine Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2 Set m_objWMINameSpace = GetObject("winmgmts:") lstCPU.Clear 'Get CPU set Set m_objCPUSet = m_objWMINameSpace.InstancesOf("Win32_Processor") sCaption = m_objCPUSet.Count & " processor" If m_objCPUSet.Count <> 1 Then sCaption = sCaption & "s" sCaption = sCaption & " detected on this machine" lblTitle.Caption = sCaption 'Populate list box with CPU names For Each oCpu In m_objCPUSet With oCpu sPath = .Path_ & "" If sPath <> "" Then lstCPU.AddItem .Name 'save path to array, so on machines with multiple CPUs, 'each can be identified and their info loaded into text box lElement = IIf(asCpuPaths(0) = "", 0, UBound(asCpuPaths) + 1) ReDim Preserve asCpuPaths(lElement) As String asCpuPaths(lElement) = sPath End If End With Next If lstCPU.ListCount <> 0 Then lstCPU.ListIndex = 0 CleanUp: Set oCpu = Nothing Exit Sub ErrorHandler: MsgBox "CPU Information could not be displayed due to the following error: " & Err.Description, , "WMI Demo Failed" GoTo CleanUp End Sub Private Sub Form_Unload(Cancel As Integer) Set m_objCPUSet = Nothing Set m_objWMINameSpace = Nothing End Sub Private Sub lstCPU_Click() Dim oCpu As SWbemObject 'Refer to SDK documentation for more detail about each of these properties Dim sInfoString As String On Error Resume Next Set oCpu = m_objCPUSet(asCpuPaths(lstCPU.ListIndex)) With oCpu sInfoString = "Description: " & .Description & vbCrLf sInfoString = sInfoString & "Processor ID: " & .ProcessorID & vbCrLf sInfoString = sInfoString & "Status: " & .Status & vbCrLf sInfoString = sInfoString & "Manufacturer: " & .Manufacturer & vbCrLf sInfoString = sInfoString & "Availability: " & AvailabilityToString(.Availability) & vbCrLf sInfoString = sInfoString & "Load Percentage: " & .LoadPercentage & vbCrLf sInfoString = sInfoString & "Current Clock Speed: " & .CurrentClockSpeed & " MHz" & vbCrLf sInfoString = sInfoString & "Maximum Clock Speed: " & .MaxClockSpeed & vbCrLf sInfoString = sInfoString & "Level 2 Cache Size: " & .L2CacheSize & vbCrLf sInfoString = sInfoString & "Level 2 Cache Speed: " & .L2CacheSpeed & vbCrLf sInfoString = sInfoString & "Power Management Supported: " & .PowerManagementSupported End With txtCpu.Text = sInfoString End Sub 'Conversions from code to string were developed 'based on information in WMI SDK documentation Private Function AvailabilityToString(Code As Integer) As String Dim sAns As String Select Case Code Case 1, 2 sAns = "Unknown" Case 3 sAns = "Running/Full Power" Case 4 sAns = "Warning" Case 5 sAns = "In Test" Case 6 sAns = "Not Applicable" Case 7 sAns = "Power Off" Case 8 sAns = "Off Line" Case 9 sAns = "Off Duty" Case 10 sAns = "Degraded" Case 11 sAns = "Not Installed" Case 12 sAns = "Install Error" Case 13 sAns = "Power Save - Unknown" Case 14 sAns = "Power Save - Low Power Mode" Case 15 sAns = "Power Save - Standby" Case 16 sAns = "Power Cycle" Case 17 sAns = "Power Save - Warning" Case Else sAns = "Unknown" End Select AvailabilityToString = sAns End Function