Retrieving Serial Numbers

[eimroda]

Hi! I am assigned by my boss to retrieve the serial numbers of the following: Hard Disk, CPU, Video Card, Memory(RAM), Motherboard and monitor. Is it possible to do it in vb? please help...

[James Stanich]

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

[James Stanich]

Hard Drive Serial Number

Public Declare Function GetVolumeSerialNumber Lib "kernel32.dll" 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
Public Function VolumeSerialNumber(ByVal RootPath As String) As String
    Dim VolLabel As String
    Dim VolSize As Long
    Dim Serial As Long
    Dim MaxLen As Long
    Dim Flags As Long
    Dim Name As String
    Dim NameSize As Long
    Dim s As String
 
    If GetVolumeSerialNumber(RootPath, VolLabel, VolSize, Serial, MaxLen, Flags, Name, NameSize) Then
        'Create an 8 character string
        s = Format(Hex(Serial), "00000000")
        'Adds the '-' between the first 4 characters and the last 4 characters
        VolumeSerialNumber = Left(s, 4) + "-" + Right(s, 4)
    Else
        'If the call to API function fails the function returns a zero serial number
        VolumeSerialNumber = "0000-0000"
    End If
End Function
 
' Usage : 
 
GotNum = VolumeSerialNumber("C:\")
 
 
' OR ##########################
 
Public Function SerialNumber() As Long 
 
Dim fso As Object 
 
Set fso = CreateObject("Scripting.FileSystemObject") 
 
Dim Drive As Object 
 
Set Drive = fso.GetDrive(fso.GetDriveName
(fso.GetAbsolutePathName(App.Path))) 
 
SerialNumber = Abs(Drive.SerialNumber) 
 
Set fso = Nothing 
 
Set Drive = Nothing 
 
End Function

If Hard Drive is Formatted, a different Serail Number will be generated (I think).

[James Stanich]

More from Hack :

Private Type MEMORYSTATUS
    dwLength As Long
    dwMemoryLoad As Long
    dwTotalPhys As Long
    dwAvailPhys As Long
    dwTotalPageFile As Long
    dwAvailPageFile As Long
    dwTotalVirtual As Long
    dwAvailVirtual As Long
End Type
 
Private Declare Sub GlobalMemoryStatus Lib "kernel32" (lpBuffer As MEMORYSTATUS)
 
Dim MS As MEMORYSTATUS
MS.dwLength = Len(MS)
GlobalMemoryStatus MS
MsgBox MS.dwMemoryLoad & " percentage memory used"
MsgBox MS.dwTotalPhys & " total amount of physical memory in bytes"
MsgBox MS.dwAvailPhys & " available physical memory"
MsgBox MS.dwTotalPageFile & " total amount of memory in the page file"
MsgBox MS.dwAvailPageFile & " available amount of memory in the page file"
MsgBox MS.dwTotalVirtual & " total amount of virtual memory"
MsgBox MS.dwAvailVirtual & " available virtual memory"
 
Private Declare Sub GetSystemInfo Lib "kernel32" (lpSystemInfo As SYSTEM_INFO)
Private Type SYSTEM_INFO
        dwOemID As Long
        dwPageSize As Long
        lpMinimumApplicationAddress As Long
        lpMaximumApplicationAddress As Long
        dwActiveProcessorMask As Long
        dwNumberOrfProcessors As Long
        dwProcessorType As Long
        dwAllocationGranularity As Long
        dwReserved As Long
End Type
 
Dim InfoResult As SYSTEM_INFO
GetSystemInfo InfoResult
MsgBox "Your CPU type is " & InfoResult.dwProcessorType
MsgBox "You have " & InfoResult.dwNumberOrfProcessors & " processor(s)"

[VB IT]

How I Can Get Processor Serial Number In Windows 98? (WMI Not install in Win98)