VB WMI 对象的示例代码

http://www.diybl.com/course/3_program/vb/2008331/107856.html

Attribute VB_Name = "ModuleWMI"
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(dd.capabilities) To UBound(dd.capabilities)
    Select Case dd.capabilities(capcount)
               Case 0: Msg = "Unknown "
               Case 1: Msg = "Other "
               Case 2: Msg = "Sequential Access "
               Case 3: Msg = "Random Access "
               Case 4: Msg = "Supports Writing "
               Case 5: Msg = "Encryption "
               Case 6: Msg = "Compression "
               Case 7: Msg = "Supports Removable Media "
               Case 8: Msg = "Manual Cleaning "
               Case 9: Msg = "Automatic Cleaning "
               Case 10: Msg = "SMART Notification "
               Case 11: Msg = "Supports Dual Sided Media "
               Case 12: Msg = "Ejection Prior to Drive Dismount Not Required"
    End Select
wmiDiskDriveInfo = wmiDiskDriveInfo & Msg & vbTab
Next capcount
wmiDiskDriveInfo = wmiDiskDriveInfo & vbCrLf
Next dd
''--end block--''
End Function
''***********************************************************************************************
''***********************************************************************************************

Public Function wmiVideoControllerInfo()Function wmiVideoControllerInfo() As String
   Dim wmiObjSet As SWbemObjectSet
   Dim obj As SWbemObject
   Dim Msg As String
wmiVideoControllerInfo = wmiVideoControllerInfo & "Processor" & vbTab
wmiVideoControllerInfo = wmiVideoControllerInfo & "BPS" & vbTab
wmiVideoControllerInfo = wmiVideoControllerInfo & "Hres" & vbTab
wmiVideoControllerInfo = wmiVideoControllerInfo & "Vres" & vbTab
wmiVideoControllerInfo = wmiVideoControllerInfo & "Freq" & vbTab
wmiVideoControllerInfo = wmiVideoControllerInfo & "Colours" & vbTab
wmiVideoControllerInfo = wmiVideoControllerInfo & "rf min" & vbTab
wmiVideoControllerInfo = wmiVideoControllerInfo & "rf max" & vbTab
wmiVideoControllerInfo = wmiVideoControllerInfo & "Vmode" & vbTab
wmiVideoControllerInfo = wmiVideoControllerInfo & "Mem" & vbTab
wmiVideoControllerInfo = wmiVideoControllerInfo & "AdapterDACType" & vbTab
wmiVideoControllerInfo = wmiVideoControllerInfo & vbCrLf
   Set wmiObjSet = GetObject("winmgmts:{impersonationLevel=impersonate}").InstancesOf("Win32_VideoController")
   On Local Error Resume Next
   For Each obj In wmiObjSet
wmiVideoControllerInfo = wmiVideoControllerInfo & obj.VideoProcessor & vbTab
wmiVideoControllerInfo = wmiVideoControllerInfo & obj.CurrentBitsPerPixel & vbTab
wmiVideoControllerInfo = wmiVideoControllerInfo & obj.CurrentHorizontalResolution & vbTab
wmiVideoControllerInfo = wmiVideoControllerInfo & obj.CurrentVerticalResolution & vbTab
wmiVideoControllerInfo = wmiVideoControllerInfo & obj.CurrentRefreshRate & vbTab
wmiVideoControllerInfo = wmiVideoControllerInfo & obj.CurrentNumberOfColors & vbTab
wmiVideoControllerInfo = wmiVideoControllerInfo & obj.MinRefreshRate & vbTab
wmiVideoControllerInfo = wmiVideoControllerInfo & obj.MaxRefreshRate & vbTab
    Select Case obj.CurrentScanMode
         Case 1: Msg = "other"
         Case 2: Msg = "unknwn"
         Case 3: Msg = "intrlcd"
         Case 4: Msg = "nintrlcd"
    End Select
wmiVideoControllerInfo = wmiVideoControllerInfo & Msg & vbTab
      Select Case obj.VideoMemoryType
         Case 1: Msg = "other"
         Case 2: Msg = "unknown"
         Case 3: Msg = "VRAM"
         Case 4: Msg = "DRAM"
         Case 5: Msg = "SRAM"
         Case 6: Msg = "WRAM"
         Case 7: Msg = "EDO RAM"
         Case 8: Msg = "Burst Synchronous DRAM"
         Case 9: Msg = "Pipelined Burst SRAM"
         Case 10: Msg = "CDRAM"
         Case 11: Msg = "3DRAM"
         Case 12: Msg = "SDRAM"
         Case 13: Msg = "SGRAM"
      End Select
wmiVideoControllerInfo = wmiVideoControllerInfo & Msg & vbTab
wmiVideoControllerInfo = wmiVideoControllerInfo & obj.AdapterDACType & vbTab
wmiVideoControllerInfo = wmiVideoControllerInfo & vbCrLf
Next obj
End Function
''--end block--''
''***********************************************************************************************
''***********************************************************************************************

Public Function wmiDisplayConfiguration()Function wmiDisplayConfiguration() As String
   Dim dcSet As SWbemObjectSet
   Dim dc As SWbemObject
   Dim Msg As String
wmiDisplayConfiguration = wmiDisplayConfiguration & "Caption" & vbTab
wmiDisplayConfiguration = wmiDisplayConfiguration & "Driver ver" & vbTab
wmiDisplayConfiguration = wmiDisplayConfiguration & "LogPixels" & vbTab
wmiDisplayConfiguration = wmiDisplayConfiguration & "PelsH" & vbTab
wmiDisplayConfiguration = wmiDisplayConfiguration & "PelsV" & vbTab
wmiDisplayConfiguration = wmiDisplayConfiguration & "Spec ver" & vbTab
wmiDisplayConfiguration = wmiDisplayConfiguration & vbCrLf
   Set dcSet = GetObject("winmgmts:{impersonationLevel=impersonate}").InstancesOf("Win32_DisplayConfiguration")
On Local Error Resume Next
   For Each dc In dcSet
wmiDisplayConfiguration = wmiDisplayConfiguration & dc.Caption & vbTab
wmiDisplayConfiguration = wmiDisplayConfiguration & dc.DriverVersion & vbTab
wmiDisplayConfiguration = wmiDisplayConfiguration & dc.LogPixels & vbTab
wmiDisplayConfiguration = wmiDisplayConfiguration & dc.PelsHeight & vbTab
wmiDisplayConfiguration = wmiDisplayConfiguration & dc.PelsWidth & vbTab
wmiDisplayConfiguration = wmiDisplayConfiguration & dc.SpecificationVersion & vbTab
wmiDisplayConfiguration = wmiDisplayConfiguration & vbCrLf
   Next dc
End Function
''--end block--''
''***********************************************************************************************
''***********************************************************************************************

Private Function ChangeEnvironmentToPath()Function ChangeEnvironmentToPath(ByVal sEnvironPath As String) As String
Dim buff As String
   buff = Space$(MAX_PATH)
   Call ExpandEnvironmentStrings(sEnvironPath, buff, Len(buff))
   ChangeEnvironmentToPath = Left$(buff, lstrlen(StrPtr(buff)))
End Function
Public Function wmiEnvironmentInfo()Function wmiEnvironmentInfo() As String
wmiEnvironmentInfo = wmiEnvironmentInfo & "Variable Name" & vbTab
wmiEnvironmentInfo = wmiEnvironmentInfo & "Environment Value" & vbTab
wmiEnvironmentInfo = wmiEnvironmentInfo & "Expanded String" & vbTab
wmiEnvironmentInfo = wmiEnvironmentInfo & vbCrLf
   Dim EnvSet As SWbemObjectSet
   Dim env As SWbemObject
   Set EnvSet = GetObject("winmgmts:{impersonationLevel=impersonate}").InstancesOf("Win32_Environment")
On Local Error Resume Next
  For Each env In EnvSet
wmiEnvironmentInfo = wmiEnvironmentInfo & env.Name & vbTab
wmiEnvironmentInfo = wmiEnvironmentInfo & env.VariableValue & vbTab
wmiEnvironmentInfo = wmiEnvironmentInfo & ChangeEnvironmentToPath(env.VariableValue) & vbTab
wmiEnvironmentInfo = wmiEnvironmentInfo & vbCrLf
   Next env
End Function
''--end block--''
''***********************************************************************************************
''***********************************************************************************************

Public Function wmiKeyboardInfo()Function wmiKeyboardInfo() As String
   Dim wmiObjSet  As SWbemObjectSet
   Dim obj        As SWbemObject
   Dim Thiscol    As Long
   On Local Error Resume Next
wmiKeyboardInfo = wmiKeyboardInfo & "WMI Property" & vbTab
wmiKeyboardInfo = wmiKeyboardInfo & "Value" & vbTab
wmiKeyboardInfo = wmiKeyboardInfo & vbCrLf
Set wmiObjSet = GetObject("winmgmts:{impersonationLevel=impersonate}").InstancesOf("Win32_Keyboard")
   For Each obj In wmiObjSet
wmiKeyboardInfo = wmiKeyboardInfo & "Description" & vbTab & obj.Description & vbCrLf
wmiKeyboardInfo = wmiKeyboardInfo & "Name" & vbTab & obj.Name & vbCrLf
wmiKeyboardInfo = wmiKeyboardInfo & "Caption" & vbTab & obj.Caption & vbCrLf
wmiKeyboardInfo = wmiKeyboardInfo & "Status" & vbTab & obj.Status & vbCrLf
wmiKeyboardInfo = wmiKeyboardInfo & "Availability" & vbTab & IIf(obj.Availability, obj.Availability, "null") & vbCrLf
wmiKeyboardInfo = wmiKeyboardInfo & "Layout" & vbTab & obj.Layout & vbCrLf
wmiKeyboardInfo = wmiKeyboardInfo & "NumberOfFunctionKeys" & vbTab & obj.NumberOfFunctionKeys & vbCrLf
wmiKeyboardInfo = wmiKeyboardInfo & "DeviceID" & vbTab & obj.DeviceID & vbCrLf
wmiKeyboardInfo = wmiKeyboardInfo & "PNPDeviceID" & vbTab & obj.PNPDeviceID & vbCrLf
wmiKeyboardInfo = wmiKeyboardInfo & vbCrLf
Next obj
End Function
''--end block--''
''***********************************************************************************************
''***********************************************************************************************

Public Function wmiBaseBoardInfo()Function wmiBaseBoardInfo() As String
wmiBaseBoardInfo = wmiBaseBoardInfo & "Product" & vbTab
wmiBaseBoardInfo = wmiBaseBoardInfo & "Manufacturer" & vbTab
   Dim BaseBoardSet As SWbemObjectSet
   Dim bb As SWbemObject
Set BaseBoardSet = GetObject("winmgmts:{impersonationLevel=impersonate}").InstancesOf("Win32_BaseBoard")
On Local Error Resume Next
For Each bb In BaseBoardSet
wmiBaseBoardInfo = wmiBaseBoardInfo & "Manufacturer" & vbTab & bb.Manufacturer & vbCrLf
wmiBaseBoardInfo = wmiBaseBoardInfo & "Caption" & vbTab & bb.Caption & vbCrLf
wmiBaseBoardInfo = wmiBaseBoardInfo & "ConfigOptions" & vbTab & bb.ConfigOptions & vbCrLf
wmiBaseBoardInfo = wmiBaseBoardInfo & "CreationClassName" & vbTab & bb.CreationClassName & vbCrLf
wmiBaseBoardInfo = wmiBaseBoardInfo & "Depth" & vbTab & bb.Depth & vbCrLf
wmiBaseBoardInfo = wmiBaseBoardInfo & "Description" & vbTab & bb.Description & vbCrLf
wmiBaseBoardInfo = wmiBaseBoardInfo & "Height" & vbTab & bb.Height & vbCrLf
wmiBaseBoardInfo = wmiBaseBoardInfo & "HostingBoard" & vbTab & bb.HostingBoard & vbCrLf
wmiBaseBoardInfo = wmiBaseBoardInfo & "HotSwappable" & vbTab & bb.HotSwappable & vbCrLf
wmiBaseBoardInfo = wmiBaseBoardInfo & "InstallDate" & vbTab & bb.InstallDate & vbCrLf
wmiBaseBoardInfo = wmiBaseBoardInfo & "Model" & vbTab & bb.Model & vbCrLf
wmiBaseBoardInfo = wmiBaseBoardInfo & "Name" & vbTab & bb.Name & vbCrLf
wmiBaseBoardInfo = wmiBaseBoardInfo & "OtherIdentifyingInfo" & vbTab & bb.OtherIdentifyingInfo & vbCrLf
wmiBaseBoardInfo = wmiBaseBoardInfo & "PartNumber" & vbTab & bb.PartNumber & vbCrLf
wmiBaseBoardInfo = wmiBaseBoardInfo & "PoweredOn" & vbTab & bb.PoweredOn & vbCrLf
wmiBaseBoardInfo = wmiBaseBoardInfo & "Product" & vbTab & bb.Product & vbCrLf
wmiBaseBoardInfo = wmiBaseBoardInfo & "Removable" & vbTab & bb.Removable & vbCrLf
wmiBaseBoardInfo = wmiBaseBoardInfo & "Replaceable" & vbTab & bb.Replaceable & vbCrLf
wmiBaseBoardInfo = wmiBaseBoardInfo & "RequirementsDescription" & vbTab & bb.RequirementsDescription & vbCrLf
wmiBaseBoardInfo = wmiBaseBoardInfo & "RequiresDaughterBoard" & vbTab & bb.RequiresDaughterBoard & vbCrLf
wmiBaseBoardInfo = wmiBaseBoardInfo & "SerialNumber" & vbTab & bb.SerialNumber & vbCrLf
wmiBaseBoardInfo = wmiBaseBoardInfo & "SKU" & vbTab & bb.SKU & vbCrLf
wmiBaseBoardInfo = wmiBaseBoardInfo & "SlotLayout" & vbTab & bb.SlotLayout & vbCrLf
wmiBaseBoardInfo = wmiBaseBoardInfo & "SpecialRequirements" & vbTab & bb.SpecialRequirements & vbCrLf
wmiBaseBoardInfo = wmiBaseBoardInfo & "Status" & vbTab & bb.Status & vbCrLf
wmiBaseBoardInfo = wmiBaseBoardInfo & "Tag" & vbTab & bb.Tag & vbCrLf
wmiBaseBoardInfo = wmiBaseBoardInfo & "Version" & vbTab & bb.Version & vbCrLf
wmiBaseBoardInfo = wmiBaseBoardInfo & "Weight" & vbTab & bb.Weight & vbCrLf
wmiBaseBoardInfo = wmiBaseBoardInfo & "Width" & vbTab & bb.Width & vbCrLf
wmiBaseBoardInfo = wmiBaseBoardInfo & vbCrLf
   Next bb
End Function
''--end block--''
''***********************************************************************************************
''***********************************************************************************************

Public Function wmiDesktopMonitorInfo()Function wmiDesktopMonitorInfo() As String
   Dim dtmSet As SWbemObjectSet
   Dim dtm As SWbemObject
   Dim Msg As String
wmiDesktopMonitorInfo = wmiDesktopMonitorInfo & "Device ID" & vbTab
wmiDesktopMonitorInfo = wmiDesktopMonitorInfo & "Caption" & vbTab
wmiDesktopMonitorInfo = wmiDesktopMonitorInfo & "Manu" & vbTab
wmiDesktopMonitorInfo = wmiDesktopMonitorInfo & "Stat" & vbTab
wmiDesktopMonitorInfo = wmiDesktopMonitorInfo & "Availability" & vbTab
wmiDesktopMonitorInfo = wmiDesktopMonitorInfo & vbCrLf
   Set dtmSet = GetObject("winmgmts:{impersonationLevel=impersonate}").InstancesOf("Win32_DesktopMonitor")
On Local Error Resume Next
For Each dtm In dtmSet
wmiDesktopMonitorInfo = wmiDesktopMonitorInfo & dtm.DeviceID & vbTab
wmiDesktopMonitorInfo = wmiDesktopMonitorInfo & dtm.Caption & vbTab
wmiDesktopMonitorInfo = wmiDesktopMonitorInfo & dtm.MonitorManufacturer & vbTab
wmiDesktopMonitorInfo = wmiDesktopMonitorInfo & dtm.Status & vbTab
    Select Case dtm.Availability
         Case 1: Msg = "other"
         Case 2: Msg = "unknown "
         Case 3: Msg = "running/full power"
         Case 4: Msg = "warning "
         Case 5: Msg = "in test "
         Case 6: Msg = "not applicable "
         Case 7: Msg = "power off "
         Case 8: Msg = "off line "
         Case 9: Msg = "off duty "
         Case 10: Msg = "degraded "
         Case 11: Msg = "not installed "
         Case 12: Msg = "install error "
         Case 13: Msg = "power save - unknown "
         Case 14: Msg = "power save - low power mode "
         Case 15: Msg = "power save - standby "
         Case 16: Msg = "power cycle "
         Case 17: Msg = "power save - warning "
         Case 18: Msg = "paused "
         Case 19: Msg = "not ready "
         Case 20: Msg = "not configured "
         Case 21: Msg = "quiesced"
    End Select
wmiDesktopMonitorInfo = wmiDesktopMonitorInfo & Msg & vbTab
wmiDesktopMonitorInfo = wmiDesktopMonitorInfo & vbCrLf
Next dtm
End Function
''--end block--''
''***********************************************************************************************
''***********************************************************************************************

Private Function SplitDateTimeBias()Function SplitDateTimeBias(ByVal leasedate As String, leasedatepart As String, leasetimepart As String) As Long
Dim pos As Long, 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
End If
End Function
Private Function InsertInString()Function InsertInString(ByVal sOriginal As String, sReplace As String, nField As Long, sDelimeter As String) As String
Dim nCount As Long, nStart As Long, 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()Function StripTimeZoneBias(leasedate As String) As Long
Dim pos As Long, tmp As String
pos = InStr(leasedate, "-")
   If pos = 0 Then
      pos = InStr(leasedate, "+")
      If pos = 0 Then
         StripTimeZoneBias = 0
      End If
   Else
      tmp = Mid$(leasedate, pos, Len(leasedate))
      leasedate = Mid$(leasedate, 1, pos - 1)
      StripTimeZoneBias = CLng(tmp)
   End If
End Function
Public Function wmiOperatingSystemInfo()Function wmiOperatingSystemInfo() As String
   Dim wmiObjSet As SWbemObjectSet
   Dim obj As SWbemObject
   Dim Msg As String
   Dim dtb As String
   Dim d As String
   Dim t As String
   Dim bias As Long
wmiOperatingSystemInfo = wmiOperatingSystemInfo & "WMI Property" & vbTab
wmiOperatingSystemInfo = wmiOperatingSystemInfo & "Value(s)" & vbTab
wmiOperatingSystemInfo = wmiOperatingSystemInfo & vbCrLf
On Local Error Resume Next
Set wmiObjSet = GetObject("winmgmts:{impersonationLevel=impersonate}").InstancesOf("Win32_OperatingSystem")
For Each obj In wmiObjSet
wmiOperatingSystemInfo = wmiOperatingSystemInfo & "Operating System" & vbTab & obj.Caption & vbCrLf
wmiOperatingSystemInfo = wmiOperatingSystemInfo & "Version" & vbTab & obj.Version & vbCrLf
wmiOperatingSystemInfo = wmiOperatingSystemInfo & "BuildNumber" & vbTab & obj.BuildNumber & vbCrLf
wmiOperatingSystemInfo = wmiOperatingSystemInfo & "BuildType" & vbTab & obj.BuildType & vbCrLf
wmiOperatingSystemInfo = wmiOperatingSystemInfo & "Latest Service Pack" & vbTab & obj.CSDVersion & vbCrLf
wmiOperatingSystemInfo = wmiOperatingSystemInfo & "EncryptionLevel" & vbTab & obj.EncryptionLevel & "-bit" & vbCrLf
      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
wmiOperatingSystemInfo = wmiOperatingSystemInfo & "OSType" & vbTab & Msg & vbCrLf
wmiOperatingSystemInfo = wmiOperatingSystemInfo & "BootDevice" & vbTab & obj.BootDevice & vbCrLf
wmiOperatingSystemInfo = wmiOperatingSystemInfo & "RegisteredUser" & vbTab & obj.RegisteredUser & vbCrLf
wmiOperatingSystemInfo = wmiOperatingSystemInfo & "SerialNumber" & vbTab & obj.SerialNumber & vbCrLf
wmiOperatingSystemInfo = wmiOperatingSystemInfo & "Status" & vbTab & obj.Status & vbCrLf
wmiOperatingSystemInfo = wmiOperatingSystemInfo & "SystemDevice" & vbTab & obj.SystemDevice & vbCrLf
wmiOperatingSystemInfo = wmiOperatingSystemInfo & "SystemDrive" & vbTab & obj.SystemDrive & vbCrLf
wmiOperatingSystemInfo = wmiOperatingSystemInfo & "WindowsDirectory" & vbTab & obj.WindowsDirectory & vbCrLf
wmiOperatingSystemInfo = wmiOperatingSystemInfo & "SystemDirectory" & vbTab & obj.SystemDirectory & vbCrLf
    dtb = obj.LocalDateTime
    bias = SplitDateTimeBias(dtb, d, t)
wmiOperatingSystemInfo = wmiOperatingSystemInfo & "LocalDateTime" & vbTab & Format$(d, "dddd mmm d, yyyy") & " " & Format$(t, "hh:mm") & " (includes " & bias & " bias)" & vbCrLf
    dtb = obj.InstallDate
    bias = SplitDateTimeBias(dtb, d, t)
wmiOperatingSystemInfo = wmiOperatingSystemInfo & "InstallDate" & vbTab & Format$(d, "dddd mmm d, yyyy") & " at " & Format$(t, "hh:mm") & " (includes " & bias & " bias)" & vbCrLf
    dtb = obj.LastBootUpTime
    bias = SplitDateTimeBias(dtb, d, t)
wmiOperatingSystemInfo = wmiOperatingSystemInfo & "LastBootUpTime" & vbTab & Format$(d, "dddd mmm d, yyyy") & " at " & Format$(t, "hh:mm") & " (includes " & bias & " bias)" & vbCrLf
wmiOperatingSystemInfo = wmiOperatingSystemInfo & "OSLanguage" & vbTab & obj.OSLanguage & vbCrLf
wmiOperatingSystemInfo = wmiOperatingSystemInfo & "CodeSet" & vbTab & obj.CodeSet & vbCrLf
wmiOperatingSystemInfo = wmiOperatingSystemInfo & "Locale" & vbTab & obj.Locale & vbCrLf
wmiOperatingSystemInfo = wmiOperatingSystemInfo & "CountryCode" & vbTab & obj.CountryCode & vbCrLf
wmiOperatingSystemInfo = wmiOperatingSystemInfo & "CurrentTimeZone" & vbTab & obj.CurrentTimeZone & vbCrLf
      Select Case obj.ForegroundApplicationBoost
         Case 0: Msg = "none"
         Case 1: Msg = "minimum"
         Case 2: Msg = "maximum (default)"
      End Select
wmiOperatingSystemInfo = wmiOperatingSystemInfo & "ForegroundApplicationBoost" & vbTab & Msg & vbCrLf
wmiOperatingSystemInfo = wmiOperatingSystemInfo & "TotalVisibleMemorySize" & vbTab & FormatNumber(obj.TotalVisibleMemorySize, 0) & vbCrLf
wmiOperatingSystemInfo = wmiOperatingSystemInfo & "FreePhysicalMemory" & vbTab & FormatNumber(obj.FreePhysicalMemory, 0) & vbCrLf
wmiOperatingSystemInfo = wmiOperatingSystemInfo & "TotalVirtualMemorySize" & vbTab & FormatNumber(obj.TotalVirtualMemorySize, 0) & vbCrLf
wmiOperatingSystemInfo = wmiOperatingSystemInfo & "FreeVirtualMemory" & vbTab & FormatNumber(obj.FreeVirtualMemory, 0) & vbCrLf
wmiOperatingSystemInfo = wmiOperatingSystemInfo & "FreeSpaceInPagingFiles" & vbTab & FormatNumber(obj.FreeSpaceInPagingFiles, 0) & vbCrLf
wmiOperatingSystemInfo = wmiOperatingSystemInfo & "SizeStoredInPagingFiles" & FormatNumber(obj.SizeStoredInPagingFiles, 0) & vbCrLf
wmiOperatingSystemInfo = wmiOperatingSystemInfo & vbCrLf
Next obj
End Function
''--end block--''
''***********************************************************************************************
''***********************************************************************************************

Public Function wmiPointingDeviceInfo()Function wmiPointingDeviceInfo() As String
   Dim wmiObjSet  As SWbemObjectSet
   Dim obj        As SWbemObject
   Dim Msg        As String
   Dim Thiscol    As Long
On Local Error Resume Next
   
  ''add first column and set initial parameters
wmiPointingDeviceInfo = wmiPointingDeviceInfo & "WMI Property" & vbTab
wmiPointingDeviceInfo = wmiPointingDeviceInfo & "Description" & vbTab
wmiPointingDeviceInfo = wmiPointingDeviceInfo & "Status" & vbTab
wmiPointingDeviceInfo = wmiPointingDeviceInfo & "ConfigManagerErrorCode" & vbTab
wmiPointingDeviceInfo = wmiPointingDeviceInfo & "Manufacturer" & vbTab
wmiPointingDeviceInfo = wmiPointingDeviceInfo & "Name" & vbTab
wmiPointingDeviceInfo = wmiPointingDeviceInfo & "HardwareType" & vbTab
wmiPointingDeviceInfo = wmiPointingDeviceInfo & "DeviceInterface" & vbTab
wmiPointingDeviceInfo = wmiPointingDeviceInfo & "DoubleSpeedThreshold" & vbTab
wmiPointingDeviceInfo = wmiPointingDeviceInfo & "Handedness" & vbTab
wmiPointingDeviceInfo = wmiPointingDeviceInfo & "NumberOfButtons" & vbTab
wmiPointingDeviceInfo = wmiPointingDeviceInfo & "PointingType" & vbTab
wmiPointingDeviceInfo = wmiPointingDeviceInfo & "QuadSpeedThreshold" & vbTab
wmiPointingDeviceInfo = wmiPointingDeviceInfo & "DeviceID" & vbTab
wmiPointingDeviceInfo = wmiPointingDeviceInfo & "PNPDeviceID" & vbTab
wmiPointingDeviceInfo = wmiPointingDeviceInfo & vbCrLf
Set wmiObjSet = GetObject("winmgmts:{impersonationLevel=impersonate}").InstancesOf("Win32_PointingDevice")
For Each obj In wmiObjSet
wmiPointingDeviceInfo = wmiPointingDeviceInfo & obj.Description & vbTab
wmiPointingDeviceInfo = wmiPointingDeviceInfo & obj.Description & vbTab
wmiPointingDeviceInfo = wmiPointingDeviceInfo & obj.Status & vbTab
        Select Case obj.ConfigManagerErrorCode
            Case 0: Msg = "This device is working properly."
            Case 1: Msg = "This device is not configured correctly."
            Case 2: Msg = "Windows cannot load the driver for this device."
            Case 3: Msg = "The driver might be corrupted, or your system " & "may be running low on memory or other resources."
            Case 4: Msg = "This device is not working properly. One of its " & "drivers or your registry might be corrupted."
            Case 5: Msg = "The driver for this device needs a resource " & "that Windows cannot manage."
            Case 6: Msg = "The boot configuration for this device " & "conflicts with other devices."
            Case 7: Msg = "Cannot filter."
            Case 8: Msg = "The driver loader for the device is missing."
            Case 9: Msg = "This device is not working properly because" & "the controlling firmware is reporting the " & "resources for the device incorrectly."
            Case 10: Msg = "This device cannot start."
            Case 11: Msg = "This device failed."
            Case 12: Msg = "This device cannot find enough free " & "resources that it can use."
            Case 13: Msg = "Windows cannot verify this device''s resources."
            Case 14: Msg = "This device cannot work properly until " & "you restart your computer."
            Case 15: Msg = "This device is not working properly because " & "there is probably a re-enumeration problem."
            Case 16: Msg = "Windows cannot identify all the resources this device uses."
            Case 17: Msg = "This device is asking for an unknown resource type."
            Case 18: Msg = "Reinstall the drivers for this device."
            Case 19: Msg = "Failure using the VXD loader."
            Case 20: Msg = "Your registry might be corrupted."
            Case 21: Msg = "System failure: Try changing the driver for this device. " & "If that does not work, see your hardware " & "documentation. Windows is removing this device."
            Case 22: Msg = "This device is disabled."
            Case 23: Msg = "System failure: Try changing the driver for " & "this device. If that doesn''t work, see your " & "hardware documentation."
            Case 24: Msg = "This device is not present, is not working " & "properly, or does not have all its drivers installed."
            Case 25: Msg = "Windows is still setting up this device."
            Case 26: Msg = "Windows is still setting up this device."
            Case 27: Msg = "This device does not have valid log configuration."
            Case 28: Msg = "The drivers for this device are not installed."
            Case 29: Msg = "This device is disabled because the firmware of " & "the device did not give it the required resources."
            Case 30: Msg = "This device is using an Interrupt Request (IRQ) " & "resource that another device is using."
            Case 31: Msg = "This device is not working properly because Windows " & "cannot load the drivers required for this device."
         End Select
wmiPointingDeviceInfo = wmiPointingDeviceInfo & Msg & vbTab
wmiPointingDeviceInfo = wmiPointingDeviceInfo & obj.Manufacturer & vbTab
wmiPointingDeviceInfo = wmiPointingDeviceInfo & obj.Name & vbTab
wmiPointingDeviceInfo = wmiPointingDeviceInfo & obj.HardwareType & vbTab
         Select Case obj.DeviceInterface
            Case 1: Msg = "Other"
            Case 2: Msg = "Unknown"
            Case 3: Msg = "Serial"
            Case 4: Msg = "PS/2"
            Case 5: Msg = "Infrared"
            Case 6: Msg = "HP-HIL"
            Case 7: Msg = "Bus mouse"
            Case 8: Msg = "ADB (Apple Desktop Bus)"
            Case 160: Msg = "Bus mouse DB-9"
            Case 161: Msg = "Bus mouse micro-DIN"
            Case 162: Msg = "USB"
         End Select
wmiPointingDeviceInfo = wmiPointingDeviceInfo & Msg & vbTab
wmiPointingDeviceInfo = wmiPointingDeviceInfo & obj.DoubleSpeedThreshold & vbTab
wmiPointingDeviceInfo = wmiPointingDeviceInfo & obj.Handedness & vbTab
wmiPointingDeviceInfo = wmiPointingDeviceInfo & obj.NumberOfButtons & vbTab
wmiPointingDeviceInfo = wmiPointingDeviceInfo & obj.PointingType & vbTab
wmiPointingDeviceInfo = wmiPointingDeviceInfo & obj.QuadSpeedThreshold & vbTab
wmiPointingDeviceInfo = wmiPointingDeviceInfo & obj.DeviceID & vbTab
wmiPointingDeviceInfo = wmiPointingDeviceInfo & obj.PNPDeviceID & vbTab
wmiPointingDeviceInfo = wmiPointingDeviceInfo & vbCrLf
Next obj
End Function
''--end block--''
''***********************************************************************************************
''***********************************************************************************************

Public Function wmiSystemSlotInfo()Function wmiSystemSlotInfo() As String
   Dim wmiObjSet  As SWbemObjectSet
   Dim obj        As SWbemObject
   Dim Thiscol    As Long
   Dim capcount   As Long
   Dim Msg        As String
   Dim Cnt        As Long
On Local Error Resume Next
wmiSystemSlotInfo = wmiSystemSlotInfo & "WMI Property" & vbTab
wmiSystemSlotInfo = wmiSystemSlotInfo & "Number" & vbTab
wmiSystemSlotInfo = wmiSystemSlotInfo & "Description" & vbTab
wmiSystemSlotInfo = wmiSystemSlotInfo & "Tag" & vbTab
wmiSystemSlotInfo = wmiSystemSlotInfo & "Status" & vbTab
wmiSystemSlotInfo = wmiSystemSlotInfo & "ConnectorPinout" & vbTab
wmiSystemSlotInfo = wmiSystemSlotInfo & "CurrentUsage" & vbTab
wmiSystemSlotInfo = wmiSystemSlotInfo & "MaxDataWidth" & vbTab
wmiSystemSlotInfo = wmiSystemSlotInfo & "PMESignal" & vbTab
wmiSystemSlotInfo = wmiSystemSlotInfo & "Shared" & vbTab
wmiSystemSlotInfo = wmiSystemSlotInfo & "SupportsHotPlug" & vbTab
wmiSystemSlotInfo = wmiSystemSlotInfo & "VccMixedVoltageSupport" & vbTab
wmiSystemSlotInfo = wmiSystemSlotInfo & "ConnectorType" & vbTab
wmiSystemSlotInfo = wmiSystemSlotInfo & vbCrLf
Set wmiObjSet = GetObject("winmgmts:{impersonationLevel=impersonate}").InstancesOf("Win32_SystemSlot")
For Each obj In wmiObjSet
wmiSystemSlotInfo = wmiSystemSlotInfo & obj.SlotDesignation & vbTab
wmiSystemSlotInfo = wmiSystemSlotInfo & IIf(obj.Number, obj.Number, "null") & vbTab
wmiSystemSlotInfo = wmiSystemSlotInfo & obj.Description & vbTab
wmiSystemSlotInfo = wmiSystemSlotInfo & obj.Tag & vbTab
wmiSystemSlotInfo = wmiSystemSlotInfo & obj.Status & vbTab
wmiSystemSlotInfo = wmiSystemSlotInfo & IIf(obj.ConnectorPinout, obj.ConnectorPinout, "null") & vbTab
         Select Case obj.CurrentUsage
            Case 0: Msg = "Reserved"
            Case 1: Msg = "Other"
            Case 2: Msg = "Unknown"
            Case 3: Msg = "Available"
            Case 4: Msg = "In use"
         End Select
wmiSystemSlotInfo = wmiSystemSlotInfo & Msg & vbTab
         Select Case obj.MaxDataWidth
            Case 0: Msg = "8"
            Case 1: Msg = "16"
            Case 2: Msg = "32"
            Case 3: Msg = "64"
            Case 4: Msg = "128"
         End Select
wmiSystemSlotInfo = wmiSystemSlotInfo & Msg & vbTab
wmiSystemSlotInfo = wmiSystemSlotInfo & obj.PMESignal & vbTab
wmiSystemSlotInfo = wmiSystemSlotInfo & obj.Shared & vbTab
wmiSystemSlotInfo = wmiSystemSlotInfo & obj.SupportsHotPlug & vbTab
    For Cnt = LBound(obj.VccMixedVoltageSupport) To UBound(obj.VccMixedVoltageSupport)
        Select Case obj.VccMixedVoltageSupport(Cnt)
               Case 0: Msg = Msg & "Unknown  "
               Case 1: Msg = Msg & "Other  "
               Case 2: Msg = Msg & "3.3v  "
               Case 3: Msg = Msg & "5v  "
               Case Else: Msg = ""
        End Select
    Next Cnt
wmiSystemSlotInfo = wmiSystemSlotInfo & Msg & vbTab
    For capcount = LBound(obj.ConnectorType) To UBound(obj.ConnectorType)
            Select Case obj.ConnectorType(capcount)
               Case 0: Msg = " Unknown"
               Case 1: Msg = " Other"
               Case 2: Msg = " Male"
               Case 3: Msg = " Female"
               Case 4: Msg = " Shielded"
               Case 5: Msg = " Unshielded"
               Case 6: Msg = " SCSI (A) High-Density (50 pins)"
               Case 7: Msg = " SCSI (A) Low-Density (50 pins)"
               Case 8: Msg = " SCSI (P) High-Density (68 pins)"
               Case 9: Msg = " SCSI SCA-I (80 pins)"
               Case 10: Msg = "SCSI SCA-II (80 pins)"
               Case 11: Msg = "SCSI Fibre Channel (DB-9, Copper)"
               Case 12: Msg = "SCSI Fibre Channel (Fibre)"
               Case 13: Msg = "SCSI Fibre Channel SCA-II (40 pins)"
               Case 14: Msg = "SCSI Fibre Channel SCA-II (20 pins)"
               Case 15: Msg = "SCSI Fibre Channel BNC"
               Case 16: Msg = "ATA 3-1/2 Inch (40 pins)"
               Case 17: Msg = "ATA 2-1/2 Inch (44 pins)"
               Case 18: Msg = "ATA-2"
               Case 19: Msg = "ATA-3"
               Case 20: Msg = "ATA/66"
               Case 21: Msg = "DB-9"
               Case 22: Msg = "DB-15"
               Case 23: Msg = "DB-25"
               Case 24: Msg = "DB-36"
               Case 25: Msg = "RS-232C"
               Case 26: Msg = "RS-422"
               Case 27: Msg = "RS-423"
               Case 28: Msg = "RS-485"
               Case 29: Msg = "RS-449"
               Case 30: Msg = "V.35"
               Case 31: Msg = "X.21"
               Case 32: Msg = "IEEE-488"
               Case 33: Msg = "AUI"
               Case 34: Msg = "UTP Category 3"
               Case 35: Msg = "UTP Category 4"
               Case 36: Msg = "UTP Category 5"
               Case 37: Msg = "BNC"
               Case 38: Msg = "RJ11"
               Case 39: Msg = "RJ45"
               Case 40: Msg = "Fiber MIC"
               Case 41: Msg = "Apple AUI"
               Case 42: Msg = "Apple GeoPort"
               Case 43: Msg = "PCI"
               Case 44: Msg = "ISA"
               Case 45: Msg = "EISA"
               Case 46: Msg = "VESA"
               Case 47: Msg = "PCMCIA"
               Case 48: Msg = "PCMCIA Type I"
               Case 49: Msg = "PCMCIA Type II"
               Case 50: Msg = "PCMCIA Type III"
               Case 51: Msg = "ZV Port"
               Case 52: Msg = "CardBus"
               Case 53: Msg = "USB"
               Case 54: Msg = "IEEE 1394"
               Case 55: Msg = "HIPPI"
               Case 56: Msg = "HSSDC (6 pins)"
               Case 57: Msg = "GBIC"
               Case 58: Msg = "DIN"
               Case 59: Msg = "Mini-DIN"
               Case 60: Msg = "Micro-DIN"
               Case 61: Msg = "PS/2"
               Case 62: Msg = "Infrared"
               Case 63: Msg = "HP-HIL"
               Case 64: Msg = "Access.bus"
               Case 65: Msg = "NuBus"
               Case 66: Msg = "Centronics"
               Case 67: Msg = "Mini-Centronics"
               Case 68: Msg = "Mini-Centronics Type-14"
               Case 69: Msg = "Mini-Centronics Type-20"
               Case 70: Msg = "Mini-Centronics Type-26"
               Case 71: Msg = "Bus Mouse"
               Case 72: Msg = "ADB"
               Case 73: Msg = "AGP"
               Case 74: Msg = "VME Bus"
               Case 75: Msg = "VME64"
               Case 76: Msg = "Proprietary"
               Case 77: Msg = "Proprietary Processor Card Slot"
               Case 78: Msg = "Proprietary Memory Card Slot"
               Case 79: Msg = "Proprietary I/O Riser Slot"
               Case 80: Msg = "PCI-66MHZ"
               Case 81: Msg = "AGP2X"
               Case 82: Msg = "AGP4X"
            End Select
    Next capcount
wmiSystemSlotInfo = wmiSystemSlotInfo & Msg & vbTab
wmiSystemSlotInfo = wmiSystemSlotInfo & vbCrLf
Next obj
End Function
''--end block--''
''***********************************************************************************************
''***********************************************************************************************
Public Function wmiComputerSystemInfo()Function wmiComputerSystemInfo() As String
   Dim ComputerSystemSet As SWbemObjectSet
   Dim Css As SWbemObject
   Dim Thiscol As Long
   Dim Msg As String
   Dim Cnt As Long
On Error Resume Next
Set ComputerSystemSet = GetObject("winmgmts:{impersonationLevel=impersonate}").InstancesOf("Win32_ComputerSystem")
wmiComputerSystemInfo = wmiComputerSystemInfo & "WMI ComputerSystem Property" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "AdminPasswordStatus" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "AutomaticResetBootOption" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "AutomaticResetCapability" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "BootROMSupported" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "BootupState" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "Caption" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "ChassisBootupState" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "CurrentTimeZone" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "DaylightInEffect" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "Description" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "Domain" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "DomainRole" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "EnableDaylightSavingsTime" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "FrontPanelResetStatus" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "InfraredSupported" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "KeyboardPasswordStatus" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "Manufacturer" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "Model" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "Name" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "NetworkServerModeEnabled" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "NumberOfProcessors" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "PartOfDomain" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "PauseAfterReset" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "PowerOnPasswordStatus" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "PowerState" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "PowerSupplyState" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "PrimaryOwnerName" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "ResetCapability" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "ResetCount" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "ResetLimit" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "Status" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "SystemStartupDelay" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "SystemStartupSetting" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "SystemType" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "ThermalState" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "TotalPhysicalMemory" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "UserName" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "WakeUpType" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "SystemStartupOptions" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "Roles" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & vbCrLf
For Each Css In ComputerSystemSet
         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
wmiComputerSystemInfo = wmiComputerSystemInfo & Css.Name & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & Msg & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & Css.AutomaticResetBootOption & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & Css.AutomaticResetCapability & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & Css.BootROMSupported & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & Css.BootupState & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & Css.Caption & vbTab
         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
wmiComputerSystemInfo = wmiComputerSystemInfo & Msg & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & Css.CurrentTimeZone & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & Css.DaylightInEffect & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & Css.Description & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & Css.Domain & vbTab
         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
wmiComputerSystemInfo = wmiComputerSystemInfo & Msg & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & Css.EnableDaylightSavingsTime & vbTab
         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
wmiComputerSystemInfo = wmiComputerSystemInfo & Msg & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & Css.InfraredSupported & vbTab
         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
wmiComputerSystemInfo = wmiComputerSystemInfo & Msg & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & Css.Manufacturer & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & Css.Model & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & Css.Name & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & Css.NetworkServerModeEnabled & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & Css.NumberOfProcessors & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & Css.PartOfDomain & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & Css.PauseAfterReset & vbTab
         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
wmiComputerSystemInfo = wmiComputerSystemInfo & Msg & vbTab
         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
wmiComputerSystemInfo = wmiComputerSystemInfo & Msg & vbTab
        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
wmiComputerSystemInfo = wmiComputerSystemInfo & Msg & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & Css.PrimaryOwnerName & vbTab
          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
wmiComputerSystemInfo = wmiComputerSystemInfo & Msg & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & Css.ResetCount & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & Css.ResetLimit & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & Css.Status & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & Css.SystemStartupDelay & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & Css.SystemStartupSetting & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & Css.SystemType & vbTab
          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
wmiComputerSystemInfo = wmiComputerSystemInfo & Msg & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & FormatNumber(Css.TotalPhysicalMemory, 0) & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & Css.UserName & vbTab
          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
wmiComputerSystemInfo = wmiComputerSystemInfo & Msg & vbTab
         Msg = ""
         For Cnt = LBound(Css.SystemStartupOptions) To UBound(Css.SystemStartupOptions)
            Msg = Msg & Css.SystemStartupOptions(Cnt) & "-And-"
         Next Cnt
wmiComputerSystemInfo = wmiComputerSystemInfo & Msg & vbTab
         Msg = ""
         For Cnt = LBound(Css.Roles) To UBound(Css.Roles)
            Msg = Msg & Css.Roles(Cnt) & "-And-"
         Next Cnt
wmiComputerSystemInfo = wmiComputerSystemInfo & Msg & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & vbCrLf
Next Css
End Function
''--end block--''
''***********************************************************************************************
''***********************************************************************************************