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...
Printable View
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...
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
Hard Drive Serial Number
VB Code:
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).
More from Hack :
VB Code:
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)"
How I Can Get Processor Serial Number In Windows 98? (WMI Not install in Win98)