Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
' applications, but you may not reproduce
' or publish this code on any web site,
' online service, or distribute as source
' on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'/* Below used for listview column auto-resizing
Private Const LVM_FIRST As Long = &H1000
Private Const LVM_SETCOLUMNWIDTH As Long = (LVM_FIRST + 30)
Private Const LVSCW_AUTOSIZE As Long = -1
Private Const LVSCW_AUTOSIZE_USEHEADER As Long = -2
Private Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
Private Sub Form_Load()
With ListView1
.ListItems.Clear
.ColumnHeaders.Clear
.View = lvwReport
.Sorted = False
End With
Command1.Caption = "Computer System Info"
End Sub
Private Sub Command1_Click()
ListView1.ListItems.Clear
Call wmiComputerSystemInfo
Call lvAutosizeControl(ListView1)
End Sub
Private Sub lvAutosizeControl(lv As ListView)
Dim col2adjust As Long
'/* Size each column based on the maximum of
'/* EITHER the columnheader text width, or,
'/* if the items below it are wider, the
'/* widest list item in the column
For col2adjust = 0 To lv.ColumnHeaders.Count - 1
Call SendMessage(lv.hwnd, _
LVM_SETCOLUMNWIDTH, _
col2adjust, _
ByVal LVSCW_AUTOSIZE_USEHEADER)
Next
End Sub
Private Sub wmiComputerSystemInfo()
Dim ComputerSystemSet As SWbemObjectSet
Dim css As SWbemObject
Dim thiscol As Long
Dim itmx As ListItem
Dim msg As String
Dim cnt As Long
Set ComputerSystemSet = GetObject("winmgmts:{impersonationLevel=impersonate}"). _
InstancesOf("Win32_ComputerSystem")
'add a first column and initial parameters
With ListView1
.ListItems.Clear
.View = lvwReport
.Sorted = False
.ColumnHeaders.Clear
.ColumnHeaders.Add , , "WMI ComputerSystem Property"
'add class properties to column 1
.ListItems.Add , , "AdminPasswordStatus"
.ListItems.Add , , "AutomaticResetBootOption"
.ListItems.Add , , "AutomaticResetCapability"
.ListItems.Add , , "BootROMSupported"
.ListItems.Add , , "BootupState"
.ListItems.Add , , "Caption"
.ListItems.Add , , "ChassisBootupState"
.ListItems.Add , , "CurrentTimeZone"
.ListItems.Add , , "DaylightInEffect"
.ListItems.Add , , "Description"
.ListItems.Add , , "Domain"
.ListItems.Add , , "DomainRole"
.ListItems.Add , , "EnableDaylightSavingsTime"
.ListItems.Add , , "FrontPanelResetStatus"
.ListItems.Add , , "InfraredSupported"
.ListItems.Add , , "KeyboardPasswordStatus"
.ListItems.Add , , "Manufacturer"
.ListItems.Add , , "Model"
.ListItems.Add , , "Name"
.ListItems.Add , , "NetworkServerModeEnabled"
.ListItems.Add , , "NumberOfProcessors"
.ListItems.Add , , "PartOfDomain"
.ListItems.Add , , "PauseAfterReset"
.ListItems.Add , , "PowerOnPasswordStatus"
.ListItems.Add , , "PowerState"
.ListItems.Add , , "PowerSupplyState"
.ListItems.Add , , "PrimaryOwnerName"
.ListItems.Add , , "ResetCapability"
.ListItems.Add , , "ResetCount"
.ListItems.Add , , "ResetLimit"
.ListItems.Add , , "Status"
.ListItems.Add , , "SystemStartupDelay"
.ListItems.Add , , "SystemStartupSetting"
.ListItems.Add , , "SystemType"
.ListItems.Add , , "ThermalState"
.ListItems.Add , , "TotalPhysicalMemory"
.ListItems.Add , , "UserName"
.ListItems.Add , , "WakeUpType"
End With
For Each css In ComputerSystemSet
With ListView1
.ColumnHeaders.Add , , css.Name
thiscol = (.ColumnHeaders.Count - 1)
Select Case css.AdminPasswordStatus
Case 0: msg = "Disabled"
Case 1: msg = "Enabled"
Case 2: msg = "Not Implemented"
Case 3: msg = "Unknown"
Case Else: msg = ""
End Select
.ListItems(1).SubItems(thiscol) = msg
.ListItems(2).SubItems(thiscol) = css.AutomaticResetBootOption
.ListItems(3).SubItems(thiscol) = css.AutomaticResetCapability
.ListItems(4).SubItems(thiscol) = css.BootROMSupported
.ListItems(5).SubItems(thiscol) = css.BootupState
.ListItems(6).SubItems(thiscol) = css.Caption
Select Case css.ChassisBootupState
Case 1: msg = "Other"
Case 2: msg = "Unknown"
Case 3: msg = "Safe"
Case 4: msg = "Warning"
Case 5: msg = "Critical"
Case 6: msg = "Non-recoverable"
Case Else: msg = ""
End Select
.ListItems(7).SubItems(thiscol) = msg
.ListItems(8).SubItems(thiscol) = css.CurrentTimeZone
.ListItems(9).SubItems(thiscol) = css.DaylightInEffect
.ListItems(10).SubItems(thiscol) = css.Description
.ListItems(11).SubItems(thiscol) = css.Domain
Select Case css.DomainRole
Case 0: msg = "Standalone Workstation"
Case 1: msg = "Member Workstation"
Case 2: msg = "Standalone Server"
Case 3: msg = "Member Server"
Case 4: msg = "Backup Domain Controller"
Case 5: msg = "Primary Domain Controller"
Case Else: msg = ""
End Select
.ListItems(12).SubItems(thiscol) = msg
'The next item is available on Windows XP or later only.
'You will receive error 438 if the OS is less than Windows XP.
.ListItems(13).SubItems(thiscol) = css.EnableDaylightSavingsTime
Select Case css.FrontPanelResetStatus
Case 0: msg = "Disabled"
Case 1: msg = "Enabled"
Case 2: msg = "Not Implemented"
Case 3: msg = "Unknown"
Case Else: msg = ""
End Select
.ListItems(14).SubItems(thiscol) = msg
.ListItems(15).SubItems(thiscol) = css.InfraredSupported
Select Case css.KeyboardPasswordStatus
Case 0: msg = "Disabled"
Case 1: msg = "Enabled"
Case 2: msg = "Not Implemented"
Case 3: msg = "Unknown"
Case Else: msg = ""
End Select
.ListItems(16).SubItems(thiscol) = msg
.ListItems(17).SubItems(thiscol) = css.Manufacturer
.ListItems(18).SubItems(thiscol) = css.Model
.ListItems(19).SubItems(thiscol) = css.Name
.ListItems(20).SubItems(thiscol) = css.NetworkServerModeEnabled
.ListItems(21).SubItems(thiscol) = css.NumberOfProcessors
'The next item is available on Windows XP or later only.
'You will receive error 438 if the OS is less than Windows XP.
.ListItems(22).SubItems(thiscol) = css.PartOfDomain
.ListItems(23).SubItems(thiscol) = css.PauseAfterReset
Select Case css.PowerOnPasswordStatus
Case 0: msg = "Disabled"
Case 1: msg = "Enabled"
Case 2: msg = "Not Implemented"
Case 3: msg = "Unknown"
Case Else: msg = ""
End Select
.ListItems(24).SubItems(thiscol) = msg
Select Case css.PowerState
Case 0: msg = "Unknown"
Case 1: msg = "Full Power"
Case 2: msg = "Power Save - Low Power Mode"
Case 3: msg = "Power Save - Standby"
Case 4: msg = "Power Save - Unknown"
Case 5: msg = "Power Cycle"
Case 6: msg = "Power Off"
Case 7: msg = "Power Save - Warning"
Case Else: msg = ""
End Select
.ListItems(25).SubItems(thiscol) = msg
Select Case css.PowerSupplyState
Case 1: msg = "Other"
Case 2: msg = "Unknown"
Case 3: msg = "Save"
Case 4: msg = "Warning"
Case 5: msg = "Critical"
Case 6: msg = "Non-recoverable"
Case Else: msg = ""
End Select
.ListItems(26).SubItems(thiscol) = msg
.ListItems(27).SubItems(thiscol) = css.PrimaryOwnerName
Select Case css.ResetCapability
Case 1: msg = "Other"
Case 2: msg = "Unknown"
Case 3: msg = "Disabled"
Case 4: msg = "Enabled"
Case 5: msg = "Non-recoverable"
Case Else: msg = ""
End Select
.ListItems(28).SubItems(thiscol) = msg
.ListItems(29).SubItems(thiscol) = css.ResetCount
.ListItems(30).SubItems(thiscol) = css.ResetLimit
.ListItems(31).SubItems(thiscol) = css.Status
.ListItems(32).SubItems(thiscol) = css.SystemStartupDelay
.ListItems(33).SubItems(thiscol) = css.SystemStartupSetting
.ListItems(34).SubItems(thiscol) = css.SystemType
Select Case css.ThermalState
Case 1: msg = "Other"
Case 2: msg = "Unknown"
Case 3: msg = "Safe"
Case 4: msg = "Warning"
Case 5: msg = "Critical"
Case 6: msg = "Non-recoverable"
Case Else: msg = ""
End Select
.ListItems(35).SubItems(thiscol) = msg
.ListItems(36).SubItems(thiscol) = FormatNumber(css.TotalPhysicalMemory, 0)
.ListItems(37).SubItems(thiscol) = css.UserName
Select Case css.WakeUpType
Case 0: msg = "Reserved"
Case 1: msg = "Other"
Case 2: msg = "Unknown"
Case 3: msg = "APM Timer"
Case 4: msg = "Modem Ring"
Case 5: msg = "LAN Remote"
Case 6: msg = "Power Switch"
Case 7: msg = "PCI PME#"
Case 8: msg = "AC Power Restored"
Case Else: msg = ""
End Select
.ListItems(38).SubItems(thiscol) = msg
For cnt = LBound(css.SystemStartupOptions) To UBound(css.SystemStartupOptions)
Set itmx = ListView1.ListItems.Add(, , IIf(cnt = 0, "SystemStartupOptions", ""))
itmx.SubItems(1) = css.SystemStartupOptions(cnt)
Next
For cnt = LBound(css.Roles) To UBound(css.Roles)
Set itmx = ListView1.ListItems.Add(, , IIf(cnt = 0, "Roles", ""))
itmx.SubItems(1) = css.Roles(cnt)
Next
End With
Next
End Sub |