使用WMI获取系统信息

简介:
 
   WMI是英文Windows Management
   Instrumentation的简写，它的功能主要是：访问本地主机的一些信息和服务，可以管理远程计算机（当然你必须要拥有足够的权限），比如：重启，关机，关闭进程，创建进程等。
 
实例如下:
 
'用WMI,先工程-引用 Microsoft WMI Scripting V1.1 Library
 
 添加一窗体，在窗体上添加Command，ListView，Picture控件
窗体代码如下：
Option Explicit
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属性"
      .ColumnHeaders.Add , , "值"
      .View = lvwReport
      .Sorted = False
   End With
   Command1.Caption = "系统信息"
End Sub
Private Sub Command1_Click()
   ListView1.ListItems.Clear
   Call wmiOperatingSystemInfo
   Call lvAutosizeControl(ListView1)
   SetBackColor ListView1, Picture1
End Sub
Private Sub lvAutosizeControl(lv As ListView)
   Dim col2adjust As Long
   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
   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
   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
   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
      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
      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)"
      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.ListItem
a86a
s.Add(, , "CurrentTimeZone")
      itmx.SubItems(1) = obj.CurrentTimeZone
      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
添加一标准模块，模块代码如下：
Public Sub SetBackColor(lvList As ListView, picBoard As PictureBox, Optional FirstColor As ColorConstants = &HE2F1E3, Optional SecondColor As ColorConstants = vbWhite)
    '只有详细资料格式的情况下才有这种显示出的需要
    If lvList.View = lvwReport Then
        Dim iHeight As Single
        Dim i As Long
        iHeight = 0
        lvList.Visible = False
        i = lvList.ListItems.Count + 1
        lvList.ListItems.Add i, "Test"
        iHeight = lvList.ListItems(i).Height
        lvList.ListItems.Remove i
        lvList.Visible = True
        iHeight = iHeight + Screen.TwipsPerPixelY * 2
        With picBoard
            .Cls
            .AutoRedraw = True
            .BackColor = lvList.BackColor
            .ScaleMode = vbTwips
            .Visible = False
            .Font = lvList.Font
            .Width = lvList.Width
            .Height = iHeight * 2
        End With
        picBoard.Line (0, 0)-(picBoard.Width, picBoard.Height / 2), &HE2F1E3, BF
        picBoard.Line (0, picBoard.Height / 2)-(picBoard.Width, picBoard.Height), vbWhite, BF
        lvList.PictureAlignment = lvwTile
        lvList.Picture = picBoard.Image
    End If
End Sub
本程序在Windows2000+VB6.0环境下测试通过。