tmp_cimv2_win32_classes_props_quals_insts_htm_release_0.vbs

' WMI Report builder
' release 0
' 02 02 2017
' omegastripes@yandex.ru

Const wbemFlagUseAmendedQualifiers = 131072
Set oWnd = CreateOutputWindow("WMI Report", 1200, 800)

sDesktopPath = CreateObject("WScript.Shell").SpecialFolders.Item("Desktop")
Set oService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\Root\CIMV2") ' SWbemServicesEx
Set oSWbemDateTime = CreateObject("WbemScripting.SWbemDateTime")

REM ' hardware + software
REM aClsList = Array("Win32_PnPEntity", "Win32_SystemEnclosure", "Win32_BaseBoard", "Win32_MotherboardDevice", "Win32_OnBoardDevice", "Win32_Bus", "Win32_SystemSlot", "Win32_Processor", "Win32_CacheMemory", "Win32_PhysicalMemory", "Win32_MemoryDevice", "Win32_MemoryArray", "Win32_PhysicalMemoryArray", "Win32_DeviceMemoryAddress", "Win32_DMAChannel", "Win32_PortConnector", "Win32_PortResource", "Win32_ParallelPort", "Win32_SerialPort", "Win32_SerialPortConfiguration", "Win32_Keyboard", "Win32_PointingDevice", "Win32_SoundDevice", "Win32_VideoController", "CIM_VideoControllerResolution", "Win32_NetworkAdapter", "Win32_NetworkAdapterConfiguration", "Win32_DesktopMonitor", "Win32_FloppyDrive", "Win32_DiskDrive", "Win32_CDROMDrive", "Win32_OperatingSystem", "Win32_ComputerSystem", "Win32_BIOS", "Win32_StartupCommand", "Win32_Product", "Win32_SoftwareFeature", "Win32_ClassicCOMClassSetting")

' hardware
aClsList = Array("Win32_PnPEntity", "Win32_SystemEnclosure", "Win32_BaseBoard", "Win32_MotherboardDevice", "Win32_OnBoardDevice", "Win32_Bus", "Win32_SystemSlot", "Win32_Processor", "Win32_CacheMemory", "Win32_PhysicalMemory", "Win32_MemoryDevice", "Win32_MemoryArray", "Win32_PhysicalMemoryArray", "Win32_DeviceMemoryAddress", "Win32_DMAChannel", "Win32_PortConnector", "Win32_PortResource", "Win32_ParallelPort", "Win32_SerialPort", "Win32_SerialPortConfiguration", "Win32_Keyboard", "Win32_PointingDevice", "Win32_SoundDevice", "Win32_VideoController", "CIM_VideoControllerResolution", "Win32_NetworkAdapter", "Win32_NetworkAdapterConfiguration", "Win32_DesktopMonitor", "Win32_FloppyDrive", "Win32_DiskDrive", "Win32_CDROMDrive")

REM ' software
REM aClsList = Array("Win32_OperatingSystem", "Win32_ComputerSystem", "Win32_BIOS", "Win32_StartupCommand", "Win32_Product", "Win32_SoftwareFeature", "Win32_ClassicCOMClassSetting")

sUserPc = CreateObject("WScript.Shell").ExpandEnvironmentStrings("%username%@%computername%")
sReportPath = Left(WScript.ScriptFullName, InstrRev(WScript.ScriptFullName, ".") - 1) & "_" & sUserPc & ".htm"
oWnd.write "<p>Report started: " & Now & "</p>"
oWnd.write "<p>" & sUserPc & "</p>"
oWnd.write "<h1>WMI Classes</h1><p>" & A2HT(aClsList) & "</p>"
j = 1
For Each sClass In aClsList
    Set oClass = oService.Get(sClass, wbemFlagUseAmendedQualifiers) ' SWbemObjectEx
    ' class qualifiers
    s = "<h1>" & sClass & "</h1><p>Qualifiers</p><p><table><tr><th>Qualifier</th><th>Value</th></tr>"
    For Each oQualifier In oClass.Qualifiers_
        s = s & "<tr><td>" & oQualifier.Name & "</td>"
        If IsArray(oQualifier.Value) Then
            s = s & "<td>" & A2HT(oQualifier.Value) & "</td></tr>"
        Else
            s = s & "<td>" & SafeHtml(oQualifier.Value) & "</td></tr>" ' \n\r\t
        End If
    Next
    s = s & "</table></p>"
    oWnd.write s
    ' properties
    k = 1
    s = "<p>Properties</p><p><table><tr><th>Property</th><th>Qualifier</th><th>Value</th>"
    Set oProperties = CreateObject("Scripting.Dictionary")
    For Each oProperty In oClass.Properties_
        Set oQuals = CreateObject("Scripting.Dictionary")
        For Each oQualifier In oProperty.Qualifiers_
            oQuals(oQualifier.Name) = oQualifier.Value
        Next
        CreateMap oQuals, "Values", "ValueMap", oValueMap, bValuesExists, bValueMapExists
        CreateMap oQuals, "BitValues", "BitMap", oBitMap, bBitValuesExists, bBitMapExists
        lQualCount = oQuals.Count
        If bValueMapExists Or bBitMapExists Then lQualCount = lQualCount - 1
        sprp = "<td rowspan=""" & lQualCount & """>" & oProperty.Name & "</td>"
        bPropRow = True
        For Each sQual In oQuals
            Select Case sQual
                Case "ValueMap", "BitMap"
                Case Else
                    s = s & "<tr>"
                    If bPropRow Then
                        s = s & sprp
                        bPropRow = False
                    End If
                    Select Case sQual
                        Case "Values"
                            If bValueMapExists Then s = s & "<td>Values, ValueMap</td>" Else s = s & "<td>Values</td>"
                            s = s & "<td>" & D2HT(oValueMap) & "</td>"
                        Case "BitValues"
                            If bBitMapExists Then s = s & "<td>BitValues, BitMap</td>" Else s = s & "<td>BitValues</td>"
                            s = s & "<td>" & D2HT(oBitMap) & "</td>"
                        Case Else
                            s = s & "<td>" & sQual & "</td>"
                            If IsArray(oQuals(sQual)) Then
                                s = s & "<td>" & A2HT(oQuals(sQual)) & "</td>"
                            Else
                                s = s & "<td>" & SafeHtml(oQuals(sQual)) & "</td>" ' \n\r\t
                            End If
                    End Select
                    s = s & "</tr>"
            End Select
        Next
        If oQuals.Exists("Units") Then
            sUnits = " " & oQuals("Units")
        Else
            sUnits = ""
        End If
        bCimDateTime = oQuals("CIMTYPE") = "datetime"
        oProperties(oProperty.Name) = Array(oQuals, bValuesExists, oValueMap, bBitValuesExists, oBitMap, sUnits, bCimDateTime)
        oWnd.document.title = "WMI Report: Class " & sClass & " (" & j & " of " & (UBound(aClsList) + 1) & "), Property " & k
        k = k + 1
    Next
    s = s & "</table></p>"
    oWnd.write s
    ' instances
    k = 1
    s = "<p>Instances</p><p><table><tr>"
    For Each sProperty In oProperties
        s = s & "<th>" & sProperty & "</th>"
    Next
    s = s & "</tr>"
    For Each oInstance In oService.InstancesOf(sClass)
        s = s & "<tr>"
        For Each sProperty In oProperties
            v = oInstance.Properties_.Item(sProperty).Value
            Select Case True
                Case IsNull(v) v = "N/A"
                Case IsArray(v) v = A2HT(v)
                Case v = "" v = "-"
                Case Else
                    Select Case True
                        Case oProperties(sProperty)(1) ' bValuesExists
                            If oProperties(sProperty)(2).Exists(CStr(v)) Then
                                v = oProperties(sProperty)(2)(CStr(v))
                            Else
                                v = "(" & v & ")"
                            End If
                            v = SafeHtml(v) & oProperties(sProperty)(5)
                        Case oProperties(sProperty)(3) ' bBitValuesExists
                            v = A2HT(GetMapBits(v, oProperties(sProperty)(4)))
                        Case oProperties(sProperty)(6) ' cim_datetime
                            oSWbemDateTime.Value = v
                            v = CStr(oSWbemDateTime.GetVarDate(True))
                        Case Else
                            v = SafeHtml(v) & oProperties(sProperty)(5)
                    End Select
            End Select
            s = s & "<td>" & v & "</td>"
        Next
        s = s & "</tr>"
        oWnd.document.title = "WMI Report: Class " & sClass & " (" & j & " of " & (UBound(aClsList) + 1) & "), Instance " & k
        k = k + 1
    Next
    s = s & "</table></p>"
    oWnd.write s
    j = j + 1
Next
oWnd.write "<p>Report completed: " & Now & "</p>"

s0 = oWnd.document.getElementsByTagName("style")(0).outerHTML
s1 = oWnd.document.getElementById("output").innerHTML
s = "<html><head>" & s0 & "</head><body>" & s1 & "</body></html>"
WriteTextFile s, sReportPath, -1
oWnd.document.title = "WMI Report"
CreateObject("WScript.Shell").Run sReportPath



Function GetMapBits(ByVal v, oBitMap)
    Dim i
    With CreateObject("Scripting.Dictionary")
        For i = 31 To 0 Step -1
            If v >= 2 ^ i Then
                If oBitMap.Exists(CStr(i)) Then .Item(.Count) = oBitMap(CStr(i))
                v = v - 2 ^ i
            End If
        Next
        GetMapBits = .Items()
    End With
End Function

Function SafeHtml(ByVal s)
    s = Replace(s, "&", "&amp;", 1, -1, 0)
    s = Replace(s, "<", "&lt;", 1, -1, 0)
    s = Replace(s, ">", "&gt;", 1, -1, 0)
    s = Replace(s, vbCrLf, "<br>", 1, -1, 0)
    s = Replace(s, vbCr, "<br>", 1, -1, 0)
    s = Replace(s, vbLf, "<br>", 1, -1, 0)
    s = Replace(s, chr(9), "&nbsp;&nbsp;&nbsp;&nbsp;", 1, -1, 0)
    s = Replace(s, "  ", " &nbsp;", 1, -1, 0)
    SafeHtml = Replace(s, "&nbsp; ", "&nbsp;&nbsp;", 1, -1, 0)
End Function

Sub CreateMap(oQuals, Items, ItemMap, oMap, bItemsExists, bItemMapExists)
    Dim aItems, aItemMap, i
    bItemsExists = oQuals.Exists(Items)
    If bItemsExists Then
        Set oMap = CreateObject("Scripting.Dictionary")
        aItems = oQuals(Items)
        bItemMapExists = oQuals.Exists(ItemMap)
        If bItemMapExists Then
            aItemMap = oQuals(ItemMap)
            For i = 0 To UBound(aItems)
                If oMap.Exists(aItemMap(i)) Then
                    oMap(aItemMap(i)) = oMap(aItemMap(i)) & "|" & aItems(i) ' inexplicable duplicates
                Else
                    oMap(aItemMap(i)) = aItems(i)
                End If
            Next
        Else
            For i = 0 To UBound(aItems)
                oMap(CStr(i)) = aItems(i)
            Next
        End If
    Else
        bItemMapExists = False
        Set oMap = Nothing
    End If
End Sub

Function D2HT(oDict)
    Dim sKey
    D2HT = "<table>"
    For Each sKey In oDict
        D2HT = D2HT & "<tr><td>" & sKey & "</td><td>" & SafeHtml(oDict(sKey)) & "</td></tr>"
    Next
    D2HT = D2HT & "</table>"
End Function

Function A2HT(aList)
    Dim sItem
    A2HT = A2HT & "<table>"
    For Each sItem In aList
        A2HT = A2HT & "<tr><td>" & SafeHtml(sItem) & "</td></tr>"
    Next
    A2HT = A2HT & "</table>"
End Function

Sub WriteTextFile(sContent, sPath, lFormat) ' 27 01 2015
    ' lFormat -2 - System default, -1 - Unicode, 0 - ASCII
    With CreateObject("Scripting.FileSystemObject").OpenTextFile(sPath, 2, True, lFormat)
        .Write sContent
        .Close
    End With
End Sub

Function CreateOutputWindow(sTitle, lWidth, lHeight)
    ' source http://forum.script-coding.com/viewtopic.php?pid=75356#p75356
    Dim sSignature, oShellWnd, oProc
    On Error Resume Next
    sSignature = Left(CreateObject("Scriptlet.TypeLib").Guid, 38)
    Do
        Set oProc = CreateObject("WScript.Shell").Exec("mshta ""about:<head><script>moveTo(-32000,-32000);document.title=' '</script><hta:application id=app border=thick minimizebutton=yes maximizebutton=yes scroll=no showintaskbar=yes contextmenu=yes selection=yes innerborder=no icon=""""/><object id='shell' classid='clsid:8856F961-340A-11D0-A96B-00C04FD705A2'><param name=RegisterAsBrowser value=1></object><script>shell.putproperty('" & sSignature & "',document.parentWindow);</script></head>""")
        Do
            If oProc.Status > 0 Then Exit Do
            For Each oShellWnd In CreateObject("Shell.Application").Windows
                Set CreateOutputWindow = oShellWnd.GetProperty(sSignature)
                If Err Then
                    Err.Clear
                    WScript.Sleep 1
                Else
                    With CreateOutputWindow
                        With .document
                            .title = sTitle
                            .getElementsByTagName("head")(0).appendChild(.createElement("style"))
                            .styleSheets(0).cssText = "* {font-family: consolas, courier new; font-size: 10pt;} h1 {font-size: 14pt;} table {border-collapse: collapse; background: transparent;} td, th {border: black 1px solid; vertical-align: top; padding: 2px 5px;} #output {width: 100%; height: 100%; padding: 3px; overflow-x: auto; overflow-y: scroll;}"
                            .body.style.background = "buttonface"
                            .body.innerHTML = "<div id='output'></div>"
                        End With
                        .resizeTo .screen.availWidth, .screen.availHeight
                        .resizeTo lWidth + .screen.availWidth - .document.body.offsetWidth, lHeight + .screen.availHeight - .document.body.offsetHeight
                        .moveTo (.screen.availWidth - lWidth) \ 2, (.screen.availHeight - lHeight) \ 2
                        .execScript "var hostWScript, hostQuit = function() {hostWScript.Timeout = 1; hostWScript.Quit();};"
                        Set .hostWScript = WScript
                        Set .document.body.onunload = .hostQuit
                        .execScript "var write = function(s) {output.appendChild(document.createElement('div')).innerHTML = s};"
                    End With
                    Exit Function
                End If
            Next
        Loop
    Loop
End Function