CPU Serial Number...

[AnT]

Is there a way to get the ID # of the CPU, much like you would of the HDrive, in VB?

[AnT]

*bump*

[Hack]

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

[AnT]

No no no, CPU serial num, not hd

[Hack]

This is the best I could find, but I don't think it has what you want. If you found anything, post it.

[Hack]

It would help if I included the link

http://www.mvps.org/vbnet/index.html...systeminfo.htm

[MartinSmith]

This Question has come up twice today!

Here's some code from http://www.freevbcode.com/ShowCode.Asp?ID=1576

'***********************************************************\
'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