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
.ColumnHeaders.Add , , "WMI Property"
.ColumnHeaders.Add , , "Value(s)"
.View = lvwReport
.Sorted = False
End With
Command1.Caption = "OS Info"
End Sub
Private Sub Command1_Click()
ListView1.ListItems.Clear
Call wmiOperatingSystemInfo
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 Function SplitDateTimeBias(ByVal leasedate As String, _
leasedatepart As String, _
leasetimepart As String) As Long
'takes a datetime returned by the
'Win32_NetworkAdapterConfiguration
'and splits out the date and time
'components, returns them in the
'leasedatepart and leasetimepart
'passed variables, and returns the
'bias to be applied to the resultant date.
Dim pos As Long
Dim bias As Long
pos = InStr(leasedate, ".")
If pos > 0 Then
bias = StripTimeZoneBias(leasedate)
leasedatepart = Left$(leasedate, 8)
leasetimepart = Mid$(leasedate, 9, pos - Len(leasedatepart) - 1)
leasedatepart = InsertInString(leasedatepart, "-", 5, "")
leasedatepart = InsertInString(leasedatepart, "-", 8, "")
leasetimepart = InsertInString(leasetimepart, ":", 3, "")
leasetimepart = InsertInString(leasetimepart, ":", 6, "")
SplitDateTimeBias = bias
Else
End If
End Function
Private Function InsertInString(ByVal sOriginal As String, _
sReplace As String, _
nField As Long, _
sDelimeter As String) As String
'c 1998 Mario Lavignasse
'Abbott Scientific
'Replaces or inserts a string into a (any char) delimeted string
'
'Syntax:
'sOriginal: string of interest, returned unchanged
'sReplace: replacement or insert chr(s)
'nField: 1-based position for the insert/replace to begin
'sDelimeter: string to insert/replace. If empty, sReplace is
' inserted, if present sDelimeter is replaced by sReplace.
'
'Examples:
'Inserting:
' x = InsertInString("Hello World", "Hello ", 7, "")
' (x="Hello Hello World")
'
'Replacing:
' x = InsertInString("Hello World", "Hello ", 7, "World")
' (x="Hello Hello")
Dim nCount As Long
Dim nStart As Long
Dim nLast As Long
Do While InStr(nStart + 1, sOriginal, sDelimeter) > 0
nStart = InStr(nStart + 1, sOriginal, sDelimeter)
nCount = nCount + 1
If nCount >= nField Then
Exit Do
End If
nLast = nStart
Loop
Select Case nCount
Case 1
InsertInString = sReplace & Mid$(sOriginal, nStart)
Case Is >= nField
InsertInString = Mid$(sOriginal, 1, nLast) & _
sReplace & Mid$(sOriginal, nStart)
Case Else
InsertInString = sOriginal & _
String$((nField - 1) - nCount, sDelimeter) & _
sReplace
End Select
End Function
Private Function StripTimeZoneBias(leasedate As String) As Long
Dim pos As Long
Dim tmp As String
pos = InStr(leasedate, "-")
If pos = 0 Then
pos = InStr(leasedate, "+")
If pos = 0 Then
StripTimeZoneBias = 0
Else
End If
Else
tmp = Mid$(leasedate, pos, Len(leasedate))
leasedate = Mid$(leasedate, 1, pos - 1)
StripTimeZoneBias = CLng(tmp)
End If
End Function
Private Sub wmiOperatingSystemInfo()
Dim wmiObjSet As SWbemObjectSet
Dim obj As SWbemObject
Dim msg As String
Dim itmx As ListItem
'working vars for returning the date info
Dim dtb As String
Dim d As String
Dim t As String
Dim bias As Long
On Local Error Resume Next
Set wmiObjSet = GetObject("winmgmts:{impersonationLevel=impersonate}")._
InstancesOf("Win32_OperatingSystem")
For Each obj In wmiObjSet
'version info
Set itmx = ListView1.ListItems.Add(, , "Operating System")
itmx.SubItems(1) = obj.Caption
Set itmx = ListView1.ListItems.Add(, , "Version")
itmx.SubItems(1) = obj.Version
Set itmx = ListView1.ListItems.Add(, , "BuildNumber")
itmx.SubItems(1) = obj.BuildNumber
Set itmx = ListView1.ListItems.Add(, , "BuildType")
itmx.SubItems(1) = obj.BuildType
Set itmx = ListView1.ListItems.Add(, , "Latest Service Pack")
itmx.SubItems(1) = obj.CSDVersion
Set itmx = ListView1.ListItems.Add(, , "EncryptionLevel")
itmx.SubItems(1) = obj.EncryptionLevel & "-bit"
Set itmx = ListView1.ListItems.Add(, , "OSType")
Select Case obj.OSType
Case 15: msg = "WIN3x"
Case 16: msg = "WIN95"
Case 17: msg = "WIN98"
Case 18: msg = "WINNT"
Case 19: msg = "WINCE"
Case Else: msg = "non-windows - see MSDN for complete list"
End Select
itmx.SubItems(1) = msg
'system info
Set itmx = ListView1.ListItems.Add(, , "BootDevice")
itmx.SubItems(1) = obj.BootDevice
Set itmx = ListView1.ListItems.Add(, , "RegisteredUser")
itmx.SubItems(1) = obj.RegisteredUser
Set itmx = ListView1.ListItems.Add(, , "SerialNumber")
itmx.SubItems(1) = obj.SerialNumber
Set itmx = ListView1.ListItems.Add(, , "Status")
itmx.SubItems(1) = obj.Status
Set itmx = ListView1.ListItems.Add(, , "SystemDevice")
itmx.SubItems(1) = obj.SystemDevice
Set itmx = ListView1.ListItems.Add(, , "SystemDrive")
itmx.SubItems(1) = obj.SystemDrive
Set itmx = ListView1.ListItems.Add(, , "WindowsDirectory")
itmx.SubItems(1) = obj.WindowsDirectory
Set itmx = ListView1.ListItems.Add(, , "SystemDirectory")
itmx.SubItems(1) = obj.SystemDirectory
Set itmx = ListView1.ListItems.Add(, , "LocalDateTime")
dtb = obj.LocalDateTime
bias = SplitDateTimeBias(dtb, d, t)
itmx.SubItems(1) = Format$(d, "dddd mmm d, yyyy") & " " & _
Format$(t, "hh:mm") & _
" (includes " & bias & " bias)"
Set itmx = ListView1.ListItems.Add(, , "InstallDate")
dtb = obj.InstallDate
bias = SplitDateTimeBias(dtb, d, t)
itmx.SubItems(1) = Format$(d, "dddd mmm d, yyyy") & _
" at " & _
Format$(t, "hh:mm") & _
" (includes " & bias & " bias)"
Set itmx = ListView1.ListItems.Add(, , "LastBootUpTime")
dtb = obj.LastBootUpTime
bias = SplitDateTimeBias(dtb, d, t)
itmx.SubItems(1) = Format$(d, "dddd mmm d, yyyy") & _
" at " & _
Format$(t, "hh:mm") & _
" (includes " & bias & " bias)"
'locale, language and codeset info
Set itmx = ListView1.ListItems.Add(, , "OSLanguage")
itmx.SubItems(1) = obj.OSLanguage
Set itmx = ListView1.ListItems.Add(, , "CodeSet")
itmx.SubItems(1) = obj.CodeSet
Set itmx = ListView1.ListItems.Add(, , "Locale")
itmx.SubItems(1) = obj.Locale
Set itmx = ListView1.ListItems.Add(, , "CountryCode")
itmx.SubItems(1) = obj.CountryCode
Set itmx = ListView1.ListItems.Add(, , "CurrentTimeZone")
itmx.SubItems(1) = obj.CurrentTimeZone
'performance and memory info
Set itmx = ListView1.ListItems.Add(, , "ForegroundApplicationBoost")
Select Case obj.ForegroundApplicationBoost
Case 0: msg = "none"
Case 1: msg = "minimum"
Case 2: msg = "maximum (default)"
End Select
itmx.SubItems(1) = msg
Set itmx = ListView1.ListItems.Add(, , "TotalVisibleMemorySize")
itmx.SubItems(1) = FormatNumber(obj.TotalVisibleMemorySize, 0)
Set itmx = ListView1.ListItems.Add(, , "FreePhysicalMemory")
itmx.SubItems(1) = FormatNumber(obj.FreePhysicalMemory, 0)
Set itmx = ListView1.ListItems.Add(, , "TotalVirtualMemorySize")
itmx.SubItems(1) = FormatNumber(obj.TotalVirtualMemorySize, 0)
Set itmx = ListView1.ListItems.Add(, , "FreeVirtualMemory")
itmx.SubItems(1) = FormatNumber(obj.FreeVirtualMemory, 0)
Set itmx = ListView1.ListItems.Add(, , "FreeSpaceInPagingFiles")
itmx.SubItems(1) = FormatNumber(obj.FreeSpaceInPagingFiles, 0)
Set itmx = ListView1.ListItems.Add(, , "SizeStoredInPagingFiles")
itmx.SubItems(1) = FormatNumber(obj.SizeStoredInPagingFiles, 0)
Next
End Sub |
