'MBSACLI XML Parser.vbs -- run MBSACLI with the /xmlout parameter
'                          and produce a readable text file
'
'DO NOT REMOVE THIS HEADER!
'
'Copyright Andrew ARONOFF 12 November 2009, http://www.silentrunners.org/
'This script is provided without any warranty, either express or implied
'It may not be copied or distributed without permission
'
'** YOU RUN THIS SCRIPT AT YOUR OWN RISK! **
'HEADER ENDS HERE

Option Explicit

Dim strRevNo : strRevNo = "04"

Dim flagTest
flagTest = False
'flagTest = True  'uncomment to skip MBSACLI.EXE execution

'Objects
Dim Wshso : Set Wshso = WScript.CreateObject("WScript.Shell")
Dim Fso : Set Fso = CreateObject("Scripting.FileSystemObject")
Dim WshoArgs : Set WshoArgs = WScript.Arguments
'Registry, OS collection, OS, Windows Update service collection,
'WU service, output file, std err file, XML output file,
'uninstalled hotfix collection, uninstalled hotfix
Dim oReg, colOS, oOS, colWUS, oWUS, oTxtFi, oSEFi, oXMLFi, oHFColl, oHF 
'MS Prouct collection, MS Product object, SelectSingleNode string
Dim oMSPColl, oMSP, strSSN

'Strings
'output string, line from text file, Script Path, registry location 
Dim strOut, strLine, ScrPath, strRegLoc
'XML file name, std err file name, output file name,
'Auto Updates service start mode, XML file contents
Dim strXMLFN, strXMLErrFN, strTxtFN, strAUStartMode, strXMLFi 
Dim strOSlc  'OS name in lower case

'Integers
'counter, error number, hotfix Type number, hotfix Severity number
Dim i, intErrNum, intType, intSeverity
Dim intHFCnt : intHFCnt = 0  'uninstalled hotfix counter

'Logical (Boolean)/flags
'WScript/CScript flag, registry access flag, Auto Updates service started
'OS is Vista, std error contains Windows Update Agent Result Code
Dim flagOut, flagAccess, logAUStarted
Dim flagVaW7 : flagVaW7 = False
Dim flagWUARC : flagWUARC = False

'Constants
Const HKLM = &H80000002, KQV = &H1, KSV = &H2, DQ = """"

'was the script launched via WSCRIPT.EXE or CSCRIPT.EXE?
If InStr(LCase(WScript.FullName),"wscript.exe") > 0 Then
 flagOut = "W"  'WScript
ElseIf InStr(LCase(WScript.FullName),"cscript.exe") > 0 Then
 flagOut = "C"  'CScript
Else  'echo and continue if it works
 flagOut = "C"  'assume CScript-compatible
 WScript.Echo "Neither " & DQ & "WSCRIPT.EXE" & DQ & " nor " &_
  DQ & "CSCRIPT.EXE" & DQ & " was detected as " &_ 
  "the script host." & vbCRLF & "This script" &_
  " will assume that the script host is CSCRIPT-compatible and will" &_ 
  vbCRLF & "use WScript.Echo for all messages."
End If  'script host

'use script directory for MBSACLI.EXE location and .XML/.TXT output 
ScrPath = Fso.GetParentFolderName(WScript.ScriptFullName) & "\" 

'test for presence of MBSACLI.EXE & WUSSCAN.DLL
If Not Fso.FileExists(ScrPath & "mbsacli.exe") Or _
 Not Fso.FileExists(ScrPath & "wusscan.dll") Then

 If flagOut = "W" Then
  MsgBox "This script must be located in the same directory as" &_
   vbCRLF & "MBSACLI.EXE and WUSSCAN.DLL.", _
   vbOKOnly + vbCritical + vbSystemModal,"Wrong Directory!"
 Else
  WScript.Echo "This script must be located in the same directory as" &_ 
   vbCRLF & "MBSACLI.EXE and WUSSCAN.DLL."
 End If

 WScript.Quit

End If

'check the O/S
Set colOS = GetObject("winmgmts:\root\cimv2").ExecQuery _
 ("Select * from Win32_OperatingSystem")

For Each oOS in colOS

 strOSlc = LCase(oOS.Name)

 If InStr(strOSlc,"windows 2000") = 0 And _
  InStr(strOSlc,"windows xp") = 0 And _
  InStr(strOSlc,"vista") = 0 And _
  InStr(strOSlc,"windows 7") = 0 Then

  If flagOut = "W" Then
   MsgBox "This script can only be run under Windows 2000, " &_
    "XP," & vbCRLF &_
    "Vista, or Windows 7.",vbOKOnly + vbCritical + vbSystemModal,"Wrong OS!"
  Else
   WScript.Echo "This script can only be run under Windows 2000, " &_
    "XP, Vista, or Windows 7."
  End If

  WScript.Quit

 End If

 'exclude all OS's except WVa & Wn7
 If InStr(strOSlc,"vista") <> 0 Or _
  InStr(strOSlc, "windows 7") <> 0 Then flagVaW7 = True

Next  'OS

Set colOS=Nothing

'if Vista or Windows 7 And on first pass, launch re-entry via
'Shell.Application with runas
If flagVaW7 And WshoArgs.length = 0 Then

 Dim oShellApp : Set oShellApp = CreateObject("Shell.Application")
 'Pass a bogus argument with leading blank space
 oShellApp.ShellExecute "wscript.exe", DQ & _
  WScript.ScriptFullName & DQ & " 1", "", "runas", 1

 WScript.Quit

End If

'check for Admin rights
strRegLoc = "System\CurrentControlSet\Control\Session Manager"

Set oReg = GetObject("winmgmts:root\default:StdRegProv")
intErrNum = oReg.CheckAccess(HKLM,strRegLoc,KQV + KSV,flagAccess)
Set oReg=Nothing

'if can't read & write to Session Manager,
'say Admin rights are needed & quit 
If Not flagAccess Then 

 If flagOut = "W" Then
  MsgBox "This script must be run as an Administrator.", _
   vbOKOnly + vbCritical + vbSystemModal,"Not an Admin!"
 Else
  WScript.Echo "This script must be run as an Administrator."
 End If

 WScript.Quit

End If  'flagAccess?

strXMLFN = "Hotfix Check Results.xml"
strXMLErrFN = "Hotfix Check StdErr.txt"
strTxtFN = "Hotfix Check Results.txt"

'find the status of Automatic Updates
Set colWUS = GetObject("winmgmts:").ExecQuery("SELECT * FROM " &_
 "Win32_Service WHERE Name = 'wuauserv'")

'save started state (T/F) & StartMode
For Each oWUS In colWUS : logAUStarted = oWUS.Started
strAUStartMode = oWUS.StartMode : Next

'if StartMode disabled, set to Manual
If LCase(strAUStartMode) = "disabled" Then
 For Each oWUS In colWUS : oWUS.ChangeStartMode("Manual") : Next
End If

'run mbsacli.exe
If flagOut = "W" Then
 Wshso.Popup "MBSACLI.EXE will now be launched." & vbCRLF &_
  "This may take several minutes.",2,"MBSACLI R" & strRevNo & " Launch", _ 
  vbOKOnly + vbInformation + vbSystemModal
Else
 WScript.Echo "MBSACLI.EXE will now be launched." & vbCRLF &_
  "This may take several minutes." & vbCRLF
End If

'_entire_ command line surrounded in quotes to handle ScrPath LFN
If Not flagTest Then Wshso.Run "%comspec% /C " & DQ &_
 DQ & ScrPath & "mbsacli.exe" & DQ & " /xmlout > " &_
 DQ & ScrPath & strXMLFN & DQ &_
 " 2> " & DQ & ScrPath & strXMLErrFN & DQ & DQ,0,True 

'create output text file (do not surround path\filename in quotes)
Set oTxtFi = Fso.OpenTextFile(ScrPath & strTxtFN,2,True,0)

'open StdErr FN and output results after first 4 lines to oTxtFi
Set oSEFi = Fso.OpenTextFile(ScrPath & strXMLErrFN,1,False,0) 

'skip first 4 lines of StdErr file, detect error if < 4 lines present 
On Error Resume Next
 For i = 1 To 4 : oSEFi.SkipLine : Next
 intErrNum = Err.Number : Err.Clear
On Error Goto 0

If intErrNum <> 0 Then
 strOut = "Truncated output"
Else

 'capture remaining lines for transfer to output file
 Do Until oSEFi.AtEndOfStream

  strLine = oSEFi.ReadLine
  If Trim(strLine) <> "" Then  'skip blank lines
   If strOut <> "" Then
    strOut = strOut & vbNewLine & strLine
   Else
    strOut = strLine
   End If

  'look for result code (0x########) & toggle flag
  If InStr(strLine,"(0x") <> 0 Then flagWUARC = True

  End If

 Loop

 'if result code in error, add URL
 If flagWUARC Then strOut = strOut & vbNewLine & vbNewLine & vbNewLine &_ 
  "FYI, Windows Update Agent Result Codes may be consulted here:" & vbNewLine &_ 
  "http://technet.microsoft.com/en-us/library/cc720442(WS.10).aspx"

End If

oSEFi.Close : Set oSEFi=Nothing

'if error string exists, output to file, display & quit
If strOut <> "" Then

 oTxtFi.WriteLine "MBSACLI.EXE error:" & vbNewLine & vbNewLine & strOut
 oTxtFi.Close : Set oTxtFi=Nothing

 If flagOut = "W" Then
  MsgBox "MBSACLI failed due to the following error:" & vbNewLine &_
   vbNewLine & strOut,vbOKOnly + vbCritical + vbSystemModal, _
   "MBSACLI Failure!"
 Else
  WScript.Echo "MBSACLI failed due to the following error:" & vbNewLine &_
   strOut
 End If

 WScript.Quit 

End If

'say that MBSACLI is done
If flagOut = "W" Then
 Wshso.Popup "MBSACLI.EXE has finished." & vbCRLF &_
  "The XML file will now be edited for illegal characters" & vbCRLF &_
  "and then translated to text. The results will be opened in Notepad.", _
  3,"XML >> TXT", vbOKOnly + vbInformation + vbSystemModal
Else
 WScript.Echo "MBSACLI.EXE has finished." & vbCRLF &_
  "The XML file will now be edited for illegal characters" & vbCRLF &_
  "and then translated to text and opened in Notepad."
End If

'remove any "®" characters from the XML file
'open text file, for reading,do not create,ASCII format
' (do not surround path\filename in quotes)
Set oXMLFi = Fso.OpenTextFile (ScrPath & strXMLFN,1,False,0)
strXMLFi = oXMLFi.ReadAll  'read everything in the text file
strXMLFi = Replace (strXMLFi, "®", "")  'remove all "®" characters
oXMLFi.Close
'open text file, for writing,do not create,ASCII format
' (do not surround path\filename in quotes)
Set oXMLFi = Fso.OpenTextFile (ScrPath & strXMLFN,2,False,0)
oXMLFi.Write strXMLFi  'write edited text into file
oXMLFi.Close
Set oXMLFi=Nothing

'create XML document
Set oXMLFi = CreateObject("MSXML2.DOMDocument")
oXMLFi.Load ScrPath & strXMLFN  'load XML output file

'check for XML syntax errors
If oXMLFi.ParseError.ErrorCode <> 0 Then
 oTxtFi.WriteLine "Error number " & oXMLFi.ParseError.ErrorCode &_ 
  " in XML file:" & vbNewLine & DQ & ScrPath & strXMLFN &_
  DQ & vbNewLine & vbNewLine &_
  "Error Description:" & vbNewLine &_ 
  oXMLFi.ParseError.Reason & vbNewLine & vbNewLine &_
  "(Note: This may not be the only error.)"

 If flagOut = "W" Then
  MsgBox "MBSACLI failed due to an error in the XML output file:" &_
   vbCRLF & DQ & ScrPath & strXMLFN & DQ,_
   vbOKOnly + vbCritical + vbSystemModal,"MBSACLI XML Error!"
 Else
  WScript.Echo "MBSACLI failed due to an error in the XML output file:" &_
   vbCRLF & DQ & ScrPath & strXMLFN & DQ
 End If

 WScript.Quit
End If

'start normal output
oTxtFi.WriteLine Space(27) & "Missing Hotfixes" & vbCRLF &_
 Space(27) & String(16,"-")

'select all "Check" nodes containing MS Product categories 
Set oMSPColl = oXMLFi.SelectNodes("//Check") 

'for each product category
For Each oMSP in oMSPColl

 'write category name and number of missing updates
 oTxtFi.WriteLine vbCRLF & "Product Update Category: " & oMSP.GetAttribute("Name") & vbCRLF &_ 
  Space(15) & "Status  : " & oMSP.SelectSingleNode("Advice").text 

 'assign missing updates
 strSSN = oMSP.SelectSingleNode("Advice").text 

 'if updates missing
 If strSSN <> "No security updates are missing." Then 

  'select collection of uninstalled hotfixes for this product category
  Set oHFColl = oMSP.SelectNodes("Detail/UpdateData[@IsInstalled='false']") 

  'for each uninstalled hotfix
  For Each oHF in oHFColl

   'increment the count (line number)
   intHFCnt = intHFCnt + 1 : strOut = ""

   'add line number & title
   strOut = vbNewLine & intHFCnt & ". " &_
    RtnOutputStr("","oHF.SelectSingleNode(""Title"").text","", _
    "(no title)") &  vbNewLine 
   'add Bulletin ID
   strOut = strOut & RtnOutputStr("","oHF.GetAttribute(""BulletinID"")", _
    " ","")
   'add KBID
   strOut = RTrim(strOut & RtnOutputStr("","oHF.GetAttribute(""KBID"")", _
    "","")) 

   'add Type
   intType = CInt(RtnOutputStr("","oHF.GetAttribute(""Type"")","","0"))
   Select Case intType
    Case 1 : strOut = strOut & ", Security Update"
    Case 2 : strOut = strOut & ", Service Pack"
    Case 3 : strOut = strOut & ", Update Rollup"
   End Select

   'add Severity
   intSeverity = CInt(RtnOutputStr("","oHF.GetAttribute(""Severity"")", _
    "","5"))
   Select Case intSeverity
    Case 4 : strOut = strOut & ", Maximum Severity: Critical"
    Case 3 : strOut = strOut & ", Maximum Severity: Important"
    Case 2 : strOut = strOut & ", Maximum Severity: Moderate"
    Case 1 : strOut = strOut & ", Maximum Severity: Low"
    Case 0 : strOut = strOut & ", Maximum Severity: (no rating)"
   End Select

   'add Bulletin URL & Download URL
   strOut = strOut & RtnOutputStr(vbNewLine & "Security Bulletin URL: ", _
    "oHF.SelectSingleNode(""References/BulletinURL"").text","","")
   strOut = strOut & RtnOutputStr(vbNewLine & "Download URL: ", _
    "oHF.SelectSingleNode(""References/DownloadURL"").text","","")

   'output hotfix entry
   oTxtFi.WriteLine strOut

  Next  'uninstalled hotfix

 End If  'updates missing?

Next  'product category

'reset objects 
oTxtFi.Close : Set oTxtFi=Nothing  'close the output file
Set oMSP=Nothing : Set oMSPColl=Nothing : Set oHF=Nothing : Set oHFColl=Nothing
Set oXMLFi=Nothing

'reset the Automatic Updates service to initial started state
If Not logAUStarted Then 
 For Each oWUS In colWUS : oWUS.StopService : Next
End If

'reset to Disabled if this was initial StartMode
If strAUStartMode = "Disabled" Then
 For Each oWUS In colWUS : oWUS.ChangeStartMode("Disabled") : Next 
End If

'display the output file in the default text editor
Wshso.Run "notepad.exe " & DQ & ScrPath & strTxtFN & DQ,1,False

'clean up
Set colWUS=Nothing
Set Fso=Nothing
Set WshoArgs=Nothing
Set Wshso=Nothing




'if XML field doesn't exist, return strMT
'if field exists And empty, return strMT
'if field populated, return strPrefix & Executed strIn & strSuffix
Function RtnOutputStr(strPrefix, strIn, strSuffix, strMT)

Dim strWk, intErrNum
On Error Resume Next
 Execute "strWk = " & strIn : intErrNum = Err.Number : Err.Clear
On Error Goto 0

If intErrNum <> 0 Then strWk = ""

If strWk = "" Or IsNull(strWk) Then
 RtnOutputStr = strMT : Exit Function
Else
 RtnOutputStr = strPrefix & strWk & strSuffix
End If

End Function


'R00
'2005-07-07, initial release

'R01
'captured MBSACLI.EXE StdErr
'parsed XML file with MSXML2.DOMDocument object

'R02
'deleted "Registered" ("®", Alt-0174) character before loading XML
'document to avoid parsing error, added Const DQ, removed OS suffix
'argument

'R03
'added Windows 7

'R04
'added parse by product category
'added revision number to launch announcement popup
'added URL if StdErr contains (probable) WUA Result Code

'** Update Revision Number on line #15! **