VB WMI 对象的示例代码

Attribute VB_Name  =   " ModuleWMI "

    'Powered by barenx
Option   Explicit
Private   Declare   Function ExpandEnvironmentStrings() Function ExpandEnvironmentStrings Lib "kernel32" Alias "ExpandEnvironmentStringsA" (ByVal lpSrc As String, ByVal lpDst As String, ByVal nSize As Long) As Long
Private Declare Function lstrlen()Function lstrlen Lib "kernel32" Alias "lstrlenW" (ByVal lpString As Long) As Long
Private Const MAX_PATH = 260
'***********************************************************************************************
'***********************************************************************************************

Public Function wmiBiosInfo()Function wmiBiosInfo() As String
   Dim BiosSet As SWbemObjectSet
   Dim bios As SWbemObject
   Dim Cnt As Long
   Dim Msg As String
Set BiosSet = GetObject("winmgmts:{impersonationLevel=impersonate}").InstancesOf("Win32_BIOS")
On Local Error Resume Next
For Each bios In BiosSet
wmiBiosInfo = wmiBiosInfo & "PrimaryBIOS" & vbTab & bios.PrimaryBIOS & vbCrLf
wmiBiosInfo = wmiBiosInfo & "Status" & vbTab & bios.Status & vbCrLf
    For Cnt = LBound(bios.BIOSVersion) To UBound(bios.BIOSVersion)
        wmiBiosInfo = wmiBiosInfo & "BIOSVersion strings" & vbTab & bios.BIOSVersion(Cnt) & vbCrLf
    Next Cnt
wmiBiosInfo = wmiBiosInfo & "Caption" & vbTab & bios.Caption & vbCrLf
wmiBiosInfo = wmiBiosInfo & "Description" & vbTab & bios.Description & vbCrLf
wmiBiosInfo = wmiBiosInfo & "Name" & vbTab & bios.Name & vbCrLf
wmiBiosInfo = wmiBiosInfo & "Manufacturer" & vbTab & bios.Manufacturer & vbCrLf
wmiBiosInfo = wmiBiosInfo & "ReleaseDate" & vbTab & bios.ReleaseDate & vbCrLf
wmiBiosInfo = wmiBiosInfo & "SerialNumber" & vbTab & bios.SerialNumber & vbCrLf
wmiBiosInfo = wmiBiosInfo & "SMBIOSBIOSVersion" & vbTab & bios.SMBIOSBIOSVersion & vbCrLf
wmiBiosInfo = wmiBiosInfo & "SMBIOSMajorVersion" & vbTab & bios.SMBIOSMajorVersion & vbCrLf
wmiBiosInfo = wmiBiosInfo & "SMBIOSMinorVersion" & vbTab & bios.SMBIOSMinorVersion & vbCrLf
wmiBiosInfo = wmiBiosInfo & "SMBIOSPresent" & vbTab & bios.SMBIOSPresent & vbCrLf
wmiBiosInfo = wmiBiosInfo & "SoftwareElementID" & vbTab & bios.SoftwareElementID & vbCrLf
    Select Case bios.SoftwareElementState
         Case 0: Msg = "deployable"
         Case 1: Msg = "installable"
         Case 2: Msg = "executable"
         Case 3: Msg = "running"
      End Select
wmiBiosInfo = wmiBiosInfo & "SoftwareElementState" & vbTab & Msg & vbCrLf
wmiBiosInfo = wmiBiosInfo & "Version" & vbTab & bios.Version & vbCrLf
wmiBiosInfo = wmiBiosInfo & "InstallableLanguages" & vbTab & bios.InstallableLanguages & vbCrLf
wmiBiosInfo = wmiBiosInfo & "CurrentLanguage" & vbTab & bios.CurrentLanguage & vbCrLf
    For Cnt = LBound(bios.ListOfLanguages) To UBound(bios.ListOfLanguages)
        wmiBiosInfo = wmiBiosInfo & "ListOfLanguages" & vbTab & bios.ListOfLanguages(Cnt) & vbCrLf
    Next Cnt
    For Cnt = LBound(bios.BiosCharacteristics) To UBound(bios.BiosCharacteristics)
        Select Case bios.BiosCharacteristics(Cnt)
            Case 0: Msg = "reserved"
            Case 1: Msg = "reserved"
            Case 2: Msg = "unknown"
            Case 3: Msg = "BIOS characteristics not supported"
            Case 4: Msg = "ISA supported"
            Case 5: Msg = "MCA supported"
            Case 6: Msg = "EISA supported"
            Case 7: Msg = "PCI supported"
            Case 8: Msg = "PC Card (PCMCIA) supported"
            Case 9: Msg = "Plug and Play supported"
            Case 10: Msg = "APM is supported"
            Case 11: Msg = "BIOS upgradable (Flash)"
            Case 12: Msg = "BIOS shadowing allowed"
            Case 13: Msg = "VL-VESA supported"
            Case 14: Msg = "ESCD support available"
            Case 15: Msg = "Boot from CD supported"
            Case 16: Msg = "Selectable boot supported"
            Case 17: Msg = "BIOS ROM socketed"
            Case 18: Msg = "Boot from PC card (PCMCIA) supported"
            Case 19: Msg = "EDD (Enhanced Disk Drive) specification supported"
            Case 20: Msg = "Int 13h, Japanese Floppy for NEC 9800 1.2mb (3.5, 1k b/s, 360 RPM) supported"
            Case 21: Msg = "Int 13h, Japanese Floppy for Toshiba 1.2mb (3.5, 360 RPM) supported"
            Case 22: Msg = "Int 13h, 5.25 / 360 KB floppy services supported"
            Case 23: Msg = "Int 13h, 5.25 /1.2MB floppy services supported"
            Case 24: Msg = "Int 13h 3.5 / 720 KB floppy services supported"
            Case 25: Msg = "Int 13h, 3.5 / 2.88 MB floppy services supported"
            Case 26: Msg = "Int 5h, print screen service supported"
            Case 27: Msg = "Int 9h, 8042 keyboard services supported"
            Case 28: Msg = "Int 14h, serial services supported"
            Case 29: Msg = "Int 17h, printer services supported"
            Case 30: Msg = "Int 10h, CGA/Mono video aervices supported"
            Case 31: Msg = "NEC PC-98"
            Case 32: Msg = "ACPI supported"
            Case 33: Msg = "USB Legacy supported"
            Case 34: Msg = "AGP supported"
            Case 35: Msg = "I2O boot supported"
            Case 36: Msg = "LS-120 boot supported"
            Case 37: Msg = "ATAPI ZIP drive boot supported"
            Case 38: Msg = "1394 boot supported"
            Case 39: Msg = "Smart battery supported"
         End Select
         wmiBiosInfo = wmiBiosInfo & "BIOS Characteristics" & vbTab & Msg & vbCrLf
      Next Cnt 'For cnt
wmiBiosInfo = wmiBiosInfo & vbCrLf
   Next bios 'For Each bios
End Function
'--end block--'
'***********************************************************************************************
'***********************************************************************************************

Public Function wmiDesktopInfo()Function wmiDesktopInfo() As String
   Dim DesktopSet As SWbemObjectSet
   Dim desktop As SWbemObject
   Dim Thiscol As Long
wmiDesktopInfo = wmiDesktopInfo & "WMI Property" & vbTab
wmiDesktopInfo = wmiDesktopInfo & "BorderWidth" & vbTab
wmiDesktopInfo = wmiDesktopInfo & "CoolSwitch" & vbTab
wmiDesktopInfo = wmiDesktopInfo & "CursorBlinkRate" & vbTab
wmiDesktopInfo = wmiDesktopInfo & "DragFullWindows" & vbTab
wmiDesktopInfo = wmiDesktopInfo & "GridGranularity" & vbTab
wmiDesktopInfo = wmiDesktopInfo & "IconSpacing" & vbTab
wmiDesktopInfo = wmiDesktopInfo & "IconTitleFaceName" & vbTab
wmiDesktopInfo = wmiDesktopInfo & "IconTitleSize" & vbTab
wmiDesktopInfo = wmiDesktopInfo & "IconTitleWrap" & vbTab
wmiDesktopInfo = wmiDesktopInfo & "Pattern" & vbTab
wmiDesktopInfo = wmiDesktopInfo & "ScrSaveActive" & vbTab
wmiDesktopInfo = wmiDesktopInfo & "ScrSaveExecutable" & vbTab
wmiDesktopInfo = wmiDesktopInfo & "ScrSaveSecure" & vbTab
wmiDesktopInfo = wmiDesktopInfo & "ScrSaveTimeout" & vbTab
wmiDesktopInfo = wmiDesktopInfo & "Wallpaper" & vbTab
wmiDesktopInfo = wmiDesktopInfo & "WallpaperStretched" & vbTab
wmiDesktopInfo = wmiDesktopInfo & "WallpaperTiled" & vbTab
wmiDesktopInfo = wmiDesktopInfo & vbCrLf
   Set DesktopSet = GetObject("winmgmts:{impersonationLevel=impersonate}").InstancesOf("Win32_Desktop")
    
    For Each desktop In DesktopSet
wmiDesktopInfo = wmiDesktopInfo & desktop.Name & vbTab
wmiDesktopInfo = wmiDesktopInfo & desktop.BorderWidth & vbTab
wmiDesktopInfo = wmiDesktopInfo & desktop.CoolSwitch & vbTab
wmiDesktopInfo = wmiDesktopInfo & desktop.CursorBlinkRate & vbTab
wmiDesktopInfo = wmiDesktopInfo & desktop.DragFullWindows & vbTab
wmiDesktopInfo = wmiDesktopInfo & desktop.GridGranularity & vbTab
wmiDesktopInfo = wmiDesktopInfo & desktop.IconSpacing & vbTab
wmiDesktopInfo = wmiDesktopInfo & desktop.IconTitleFaceName & vbTab
wmiDesktopInfo = wmiDesktopInfo & desktop.IconTitleSize & vbTab
wmiDesktopInfo = wmiDesktopInfo & desktop.IconTitleWrap & vbTab
wmiDesktopInfo = wmiDesktopInfo & desktop.Pattern & vbTab
wmiDesktopInfo = wmiDesktopInfo & desktop.ScreenSaverActive & vbTab
wmiDesktopInfo = wmiDesktopInfo & desktop.ScreenSaverExecutable & vbTab
wmiDesktopInfo = wmiDesktopInfo & desktop.ScreenSaverSecure & vbTab
wmiDesktopInfo = wmiDesktopInfo & desktop.ScreenSaverTimeout & vbTab
wmiDesktopInfo = wmiDesktopInfo & desktop.Wallpaper & vbTab
wmiDesktopInfo = wmiDesktopInfo & desktop.WallpaperStretched & vbTab
wmiDesktopInfo = wmiDesktopInfo & desktop.WallpaperTiled
wmiDesktopInfo = wmiDesktopInfo & vbCrLf
    Next desktop
End Function
'--end block--'
'***********************************************************************************************
'***********************************************************************************************

Public Function wmiDiskDriveInfo()Function wmiDiskDriveInfo() As String
   Dim DiskDriveSet As SWbemObjectSet
   Dim dd As SWbemObject
   Dim Thiscol As Long
   Dim capcount As Long
   Dim Msg As String
   Dim sflag As String  'used in err trap
On Local Error Resume Next
wmiDiskDriveInfo = wmiDiskDriveInfo & "WMI Property" & vbTab
wmiDiskDriveInfo = wmiDiskDriveInfo & "ID: Description" & vbTab
wmiDiskDriveInfo = wmiDiskDriveInfo & "ID: Index" & vbTab
wmiDiskDriveInfo = wmiDiskDriveInfo & "ID: DeviceID" & vbTab
wmiDiskDriveInfo = wmiDiskDriveInfo & "ID: Caption" & vbTab
wmiDiskDriveInfo = wmiDiskDriveInfo & "ID: Manufacturer" & vbTab
wmiDiskDriveInfo = wmiDiskDriveInfo & "ID: Model" & vbTab
wmiDiskDriveInfo = wmiDiskDriveInfo & "ID: InterfaceType" & vbTab
wmiDiskDriveInfo = wmiDiskDriveInfo & "ID: MediaLoaded" & vbTab
wmiDiskDriveInfo = wmiDiskDriveInfo & "ID: MediaType" & vbTab
wmiDiskDriveInfo = wmiDiskDriveInfo & "Phyical: Status" & vbTab
wmiDiskDriveInfo = wmiDiskDriveInfo & "Phyical: Size" & vbTab
wmiDiskDriveInfo = wmiDiskDriveInfo & "Phyical: Partitions" & vbTab
wmiDiskDriveInfo = wmiDiskDriveInfo & "Phyical: BytesPerSector" & vbTab
wmiDiskDriveInfo = wmiDiskDriveInfo & "Phyical: SectorsPerTrack" & vbTab
wmiDiskDriveInfo = wmiDiskDriveInfo & "Phyical: TotalCylinders" & vbTab
wmiDiskDriveInfo = wmiDiskDriveInfo & "Phyical: TotalHeads" & vbTab
wmiDiskDriveInfo = wmiDiskDriveInfo & "Phyical: TotalTracks" & vbTab
wmiDiskDriveInfo = wmiDiskDriveInfo & "Phyical: TracksPerCylinder"
wmiDiskDriveInfo = wmiDiskDriveInfo & "Disk Capabilities:" & vbTab
wmiDiskDriveInfo = wmiDiskDriveInfo & vbCrLf
Set DiskDriveSet = GetObject("winmgmts:{impersonationLevel=impersonate}").InstancesOf("Win32_DiskDrive")
   For Each dd In DiskDriveSet
wmiDiskDriveInfo = wmiDiskDriveInfo & dd.Description & " " & dd.Index & vbTab
wmiDiskDriveInfo = wmiDiskDriveInfo & dd.Description & vbTab
wmiDiskDriveInfo = wmiDiskDriveInfo & dd.Index & vbTab
wmiDiskDriveInfo = wmiDiskDriveInfo & dd.DeviceID & vbTab
wmiDiskDriveInfo = wmiDiskDriveInfo & dd.Caption & vbTab
wmiDiskDriveInfo = wmiDiskDriveInfo & dd.Manufacturer & vbTab
wmiDiskDriveInfo = wmiDiskDriveInfo & dd.Model & vbTab
wmiDiskDriveInfo = wmiDiskDriveInfo & dd.InterfaceType & vbTab
wmiDiskDriveInfo = wmiDiskDriveInfo & dd.MediaLoaded & vbTab
wmiDiskDriveInfo = wmiDiskDriveInfo & dd.MediaType & vbTab
wmiDiskDriveInfo = wmiDiskDriveInfo & dd.Status & vbTab
wmiDiskDriveInfo = wmiDiskDriveInfo & FormatNumber(dd.Size, 0) & vbTab
wmiDiskDriveInfo = wmiDiskDriveInfo & dd.Partitions & vbTab
wmiDiskDriveInfo = wmiDiskDriveInfo & FormatNumber(dd.BytesPerSector, 0) & vbTab
wmiDiskDriveInfo = wmiDiskDriveInfo & FormatNumber(dd.SectorsPerTrack, 0) & vbTab
wmiDiskDriveInfo = wmiDiskDriveInfo & FormatNumber(dd.TotalCylinders, 0) & vbTab
wmiDiskDriveInfo = wmiDiskDriveInfo & dd.TotalHeads & vbTab
wmiDiskDriveInfo = wmiDiskDriveInfo & dd.TotalTracks & vbTab
wmiDiskDriveInfo = wmiDiskDriveInfo & dd.TracksPerCylinder & vbTab
For capcount = LBound