'SAXPAR.vbs -- Security Analyzer Xml PARser.vbs -- run MBSACLI.EXE with the /xmlout
' parameter and produce a readable text file in Unicode format
'
'DO NOT REMOVE THIS HEADER!
'
'Copyright Andrew ARONOFF 04 February 2014,
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 = "11"
'INSTRUCTIONS:
'
' Two files, "mbsacli.exe" and "wusscan.dll", must be located in the same
' directory as the script. These files can be obtained by installing
' "Microsoft Base Security Analyzer 2.3" (MBSA), available here:
'
http://SPAM URL/d301a
'
' The two files will be located in the main MBSA directory. After they
' are copied for use with this script, MBSA can be uninstalled.
'
' A single (optional) command line parameter is permitted -- a path for the report file
'
' There are 12 _optional_ parameters (assigned below):
'
' 1. report directory -- this can be overridden by the command line parameter
' 2. minimum severity level for missing hotfixes
' 3. directory for local catalog file "wsusscn2.cab" -- use of the local
' catalog file eliminates the need for an Internet connection
' 4. display of status and error messages
' 5. send report by e-mail
' ** parameters 6-12 are ignored if the report is not sent by e-mail **
' 6. use of SMTP authentification
' 7. use of Gmail SMTP
' 8. sender e-mail address
' 9. recipient e-mail address
' 10. the SMTP server name, if Gmail is not used
' 11-12. the username and password if SMTP authentification or Gmail is used
' To run this script as a Scheduled Task, set the message display parameter (
#4)
' to False and point the Task Scheduler to the script.
'
' The "Automatic Updates" service can be in any state. The initial state will be
' restored (unless the script aborts).
'==========START PARAMETER SECTION==========
'1 report directory -- terminating backslash is optional, must be enclosed in quotes
Dim strReportDir : strReportDir = ""
'2 minimum severity level reported -- integer (use no quotes)
' 0: default, all missing hotfixes listed
' 1: Low, Moderate, Important, and Critical severities listed
' 2: Moderate, Important and Critical severities listed
' 3: Important and Critical severities listed
' 4: Critical severity listed
Dim intMinSeverity : intMinSeverity = 0
'3. directory for local catalog file "wsusscn2.cab" --
' terminating backslash is optional, must be enclosed in quotes
' The script directory can be designated with a quote-enclosed dot: "."
Dim strCabFileDir : strCabFileDir = ""
'4 display status and error messages? -- True or False (use no quotes)
Dim logDisplayMsgs : logDisplayMsgs = True
'5 send report by e-mail? -- True or False (use no quotes)
Dim logEmailRpt : logEmailRpt = False
'<<<<<<<<<<
'parameters 6 - 12 are ignored if logEmailRpt = false
'>>>>>>>>>>
'6 use SMTP authentication? -- True or False (use no quotes)
Dim logSMTPAuth : logSMTPAuth = False
'7 use Gmail SMTP? -- True or False (use no quotes)
Dim logUseGmail : logUseGmail = False
'8 sender e-mail address -- enclose in quotes
' address may be in format: "FName LName
"
Dim strSenderEMA : strSenderEMA = ""
'9 destination e-mail address -- enclose in quotes
' address may be in format: "FName LName "
Dim strDestEMA : strDestEMA = ""
'10 vanilla SMTP server name -- enclose in quotes --
' can be left blank if Gmail SMTP server used
Dim strSMTPServer : strSMTPServer = ""
'11 User ID for SMTP authentification/Gmail -- enclose in quotes
Dim strUserID : strUserID = ""
'12 Password for SMTP authentication/Gmail -- enclose in quotes
Dim strUserPW : strUserPW = ""
'===========END PARAMETER SECTION===========
Dim flagTest
flagTest = False
'flagTest = True 'uncomment to skip MBSACLI.EXE execution
'check e-mail configuration
If Not logEmailRpt Then logUseGmail = False 'disable Gmail if e-mail not used
If logSMTPAuth And logUseGmail Then logUseGmail = False 'disable Gmail if SMTP auth used
If logUseGmail Then strDestEMA = strUserID & "@gmail.com" 'if Gmail used, form destination EMA from UserID
'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, temp file, std err file, XML output file,
'uninstalled hotfix collection, uninstalled hotfix
Dim oReg, colOS, oOS, colWUS, oWUS, oTxtFi, oTempFi, oSEFi, oXMLFi, oHFColl, oHF
'MS Product collection, MS Product object, SelectSingleNode string, Script Exec, Shell Application
Dim oMSPColl, oMSP, strSSN, oExec, oShellApp
Dim oNetwk : Set oNetwk = WScript.CreateObject("WScript.Network")
'Array (of compatible Windows versions)
Dim arWin : arWin = Array ("windows 2000", _
"windows xp", _
"windows server 2003", _
"windows server 2008", _
"windows server® 2008", _
"vista", _
"windows" & Chr(160) & "7", _
"windows 7")
'Strings
'output string, line from text file, Script Path, string buffer, e-mail msg text
Dim strOut, strLine, ScrPath, strBuffer, strMsg
'registry location
Dim strRegLoc : strRegLoc = "System\CurrentControlSet\Control\Session Manager"
Dim strArgUAC : strArgUAC = "" 'string found prefixed to cmd line parameter
'after relaunching script to provoke UAC prompt
'XML file name, std err file name, output file name,
'Auto Updates service start mode
Dim strXMLFN, strXMLErrFN, strTxtFN, strAUStartMode
Dim strOSlc 'OS name in lower case
Dim strTxtFNPath : strTxtFNPath = "" 'report file path
Dim strArg : strArg = "" 'WshoArg(0)
Dim strParam : strParam = "" 'MBSACLI.EXE command line parameters
Dim strRDEM : strRDEM = "" 'Report Directory Error Message
Dim strLCEM : strLCEM = "" 'Local Cab Error Message
Dim strMinSeverity : strMinSeverity = "" 'minimum severity title
Dim strStdErr : strStdErr = "" 'StdErr string
Dim strErrDesc 'Err description
'Integers
'counter, error number, hotfix Type number, hotfix Severity number
Dim i, intErrNum, intType, intSeverity
Dim intHFCnt : intHFCnt = 0 'uninstalled hotfix counter
Dim intPosn 'positioning variable
'convert to integer if not already done
intMinSeverity = CInt(intMinSeverity)
'Date
Dim datNow : datNow = Now 'script launch time
Select Case intMinSeverity
Case 0 : strMinSeverity = "(All missing hotfixes listed)"
Case 1 : strMinSeverity = "(Low, Moderate, Important, and Critical severities listed)"
Case 2 : strMinSeverity = "(Moderate, Important and Critical severities listed)"
Case 3 : strMinSeverity = "(Important and Critical severities listed)"
Case 4 : strMinSeverity = "(Critical severity listed)"
End Select
'Logical (Boolean)/flags
'WScript/CScript flag, registry access flag, Auto Updates service started
'OS is Vista or Windows 7, std error contains Windows Update Agent Result Code
'script running with elevated privileges, OS compatible with MBSACLI.EXE
Dim flagOut, flagAccess, logAUStarted
Dim flagVaW7 : flagVaW7 = False
Dim flagWUARC : flagWUARC = False
Dim flagOKOS : flagOKOS = False
'Constants
Const HKLM = &H80000002, KQV = &H1, KSV = &H2, DQ = """"
'CDO SMTP configuration parameters
Const cdoSendUsingMethod = "http://schemas.microsoft.com/cdo/configuration/sendusing"
Const cdoSendUsingPort = 2
Const cdoSMTPServer = "http://schemas.microsoft.com/cdo/configuration/smtpserver"
Const cdoSMTPAuthenticate = "http://schemas.microsoft.com/cdo/configuration/smtpauthenticate"
Const cdoSMTPServerPort = "http://schemas.microsoft.com/cdo/configuration/smtpserverport"
Const cdoSMTPConnectionTimeout = "http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout"
Const cdoSMTPUseSSL = "http://schemas.microsoft.com/cdo/configuration/smtpusessl"
Const cdoSendUserName = "http://schemas.microsoft.com/cdo/configuration/sendusername"
Const cdoSendPassword = "http://schemas.microsoft.com/cdo/configuration/sendpassword"
'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
If logDisplayMsgs Then
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 'DisplayMsgs?
End If 'script host
'use script directory for MBSACLI.EXE location and .XML output
ScrPath = Fso.GetParentFolderName(WScript.ScriptFullName)
'add trailing backslash to ScrPath if needed
If Right(Trim(ScrPath),1) <> "\" Then ScrPath = ScrPath & "\"
strTxtFNPath = ScrPath 'report file output is script dir by default
'check for "wsusscn2.cab" in directory provided as script parameter
If strCabFileDir <> "" Then
If strCabFileDir = "." Then strCabFileDir = ScrPath
'add trailing backslash to cab file directory if needed
If Right(Trim(strCabFileDir),1) <> "\" Then strCabFileDir = strCabFileDir & "\"
'fill parameter string if local cab file found
'the /nvc (no version check) and /nd (no download) parameters do not
'appear to have any effect
If Fso.FileExists(strCabFileDir & "wsusscn2.cab") Then
strParam = " /catalog " & DQ & strCabFileDir & "wsusscn2.cab" & DQ &_
" /nvc /nd"
Else
strLCEM = "The catalog file " & DQ & "wsusscn2.cab" & DQ &_
" cannot be found in the directory provided as a" & vbCRLF &_
"script parameter: " & DQ & strCabFileDir & DQ & vbCRLF &_
"The cab file will be downloaded to:" &_
vbCRLF & DQ & Wshso.ExpandEnvironmentStrings("%UserProfile%") &_
"\Local Settings\Application Data\Microsoft\MBSA\Cache\" & DQ
End If 'cab file exists in directory?
End If 'strCabFileDir not MT?
If strReportDir <> "" Then
If Fso.FolderExists(strReportDir) Then
strTxtFNPath = strReportDir
Else
strRDEM = "The report file directory " & DQ & strReportDir & DQ &_
" provided as a script parameter cannot be found." &_
vbCRLF & "The report file will be placed in the " &_
"script directory: " & DQ & ScrPath & DQ
End If 'FolderExists?
End If 'strReportDir Not MT?
'add backslash to report directory
If Right(Trim(strTxtFNPath),1) <> "\" Then strTxtFNPath = strTxtFNPath & "\"
'test for presence of MBSACLI.EXE & WUSSCAN.DLL
If Not Fso.FileExists(ScrPath & "mbsacli.exe") Or _
Not Fso.FileExists(ScrPath & "wusscan.dll") Then
If logDisplayMsgs 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
End If 'DisplayMsgs?
WScript.Quit
End If
'interpret command-line arguments
'store arg (quotes will be stripped!)
If WshoArgs.count > 0 Then strArg = WshoArgs(0)
'test arg for elevated privileges string
If Len(strArg) >= 7 Then
If InStr(strArg, "__UAC__") > 0 Then
strArgUAC = "__UAC__" 'toggle indicator variable
strArg = Replace (strArg,"__UAC__","",1,1,1) 'reset argument contents
End If
End If 'Len >= 7?
'if argument not MT, check for directory
If strArg <> "" Then
'if directory exists, assign report path
If Fso.FolderExists(strArg) Then
strTxtFNPath = strArg : strRDEM = ""
'append backslash if not already present
If Right(strTxtFNPath,1) <> "\" Then _
strTxtFNPath = strTxtFNPath & "\"
Else 'argument folder not found
If strRDEM = "" Then 'script parameter directory found or empty
strRDEM = "The report file directory " & DQ & strArg & DQ &_
" provided as a script argument cannot be found."
If strReportDir = "" Then 'parameter for script directory empty
strRDEM = strRDEM & vbCRLF & "The report will be placed in " &_
"the same directory as the script: " & ScrPath
Else 'parameter for script directory !MT
strRDEM = strRDEM & vbCRLF & "The report will be placed in " &_
"the directory " & DQ & strReportDir & DQ & " provided as a script parameter."
End If 'strReportDir MT?
Else 'append argument error to script parameter directory error
strRDEM = "The report file directory " & DQ & strArg & DQ &_
" provided as a script argument cannot be found." &_
vbCRLF & strRDEM
End If 'script parameter directory found?
End If 'folder exists?
End If 'strArg Not MT?
'check the O/S
Set colOS = GetObject("winmgmts:\root\cimv2").ExecQuery _
("Select * from Win32_OperatingSystem")
For Each oOS in colOS
strOSlc = LCase(oOS.Name)
For i = 0 To UBound(arWin)
If InStr(strOSlc,arWin(i)) <> 0 Then
flagOKOS = True : Exit For
End If
Next
If Not flagOKOS Then
If logDisplayMsgs Then
If flagOut = "W" Then
MsgBox "This script can only be run under Windows 2000, Windows 2000 Server," &_
vbCRLF &_
"XP, Windows Server 2003, Vista, Windows 7 or Windows Server 2008.", _
vbOKOnly + vbCritical + vbSystemModal,"Wrong OS!"
Else
WScript.Echo "This script can only be run under Windows 2000, " &_
"XP, Windows Server 2003," & vbCRLF & "Vista, Windows 7, or Windows Server 2008."
End If
End If 'DisplayMsgs?
WScript.Quit
End If 'allowed OS?
Exit For
Next 'OS
Set colOS=Nothing
'test for admin rights
'identify WVa/Wn7
If InStr(strOSlc,"vista") <> 0 Or _
InStr(strOSlc, "windows 7") <> 0 Or _
InStr(strOSlc, "windows" & Chr(160) & "7") <> 0 Then _
flagVaW7 = True
'check for Admin rights
Set oReg = GetObject("winmgmts:root\default:StdRegProv")
intErrNum = oReg.CheckAccess(HKLM,strRegLoc,KQV + KSV,flagAccess)
Set oReg=Nothing
'for WVa/Wn7, relaunch with admin rights unless elevated privileges already provided
If flagVaW7 Then
'if can't read & write to Session Manager and on second pass
If Not flagAccess And strArgUAC = "__UAC__" Then
If logDisplayMsgs Then
'warn about lack of admin rights and quit
MsgBox "This script was not able to acquire admin rights." &_
vbCRLF & vbCRLF &_
"This script must exit.",vbOKOnly + vbCritical + vbSystemModal, _
"Admin rights required!"
Else
WScript.Echo "This script was not able to acquire admin rights."
End If 'display messages?
WScript.Quit
'if can't read & write to Session Manager (and on initial pass)
ElseIf Not flagAccess Then
'prefix UAC relaunch string to a quote-enclosed argument
strArg = "__UAC__" & DQ & strArg & DQ
Set oShellApp = CreateObject("Shell.Application")
oShellApp.ShellExecute WScript.FullName, _
DQ & WScript.ScriptFullName & DQ & Space(1) & strArg, "", "runas", 1
WScript.Quit
End If 'flagAccess?
Else 'OS not Va or W7
'if can't read & write to Session Manager, say Admin rights are needed & quit
If Not flagAccess Then
If logDisplayMsgs 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
End If 'DisplayMsgs?
WScript.Quit
End If 'flagAccess?
End If 'WVA Or WN7?
'assign MBSACLI.EXE filename arguments
strXMLFN = "SAXPAR Results.xml"
strXMLErrFN = "SAXPAR StdErr.txt"
'form report file name
strTxtFN = "SAXPAR Results (" & oNetwk.ComputerName & ") " &_
Year(datNow) & "-" & Right("0" & Month(datNow),2) & "-" &_
Right("0" & Day(datNow),2) & " " &_
Right("0" & Hour(datNow),2) & "." & Right("0" & Minute(datNow),2) &_
"." & Right("0" & Second(datNow),2) & ".txt"
Set oNetwk=Nothing
'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 logDisplayMsgs Then
If flagOut = "W" Then
Wshso.Popup "MBSACLI.EXE will now be launched." & vbCRLF &_
"This may take several minutes.",2,"SAXPAR R" & strRevNo & " Launch", _
vbOKOnly + vbInformation + vbSystemModal
Else
WScript.Echo "MBSACLI.EXE will now be launched." & vbCRLF &_
"This may take several minutes." & vbCRLF
End If
End If 'DisplayMsgs?
'_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 /unicode > " &_
DQ & ScrPath & strXMLFN & DQ & strParam &_
" 2> " & DQ & ScrPath & strXMLErrFN & DQ & DQ,0,True
'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
Set oWUS=Nothing : Set colWUS=Nothing
'assign report file directory to script argument,
'script parameter or script directory
'create output text file (do not surround path\filename in quotes)
'for writing,create,Unicode format
Set oTxtFi = Fso.OpenTextFile(strTxtFNPath & strTxtFN,2,True,-1)
'add script ID
oTxtFi.WriteLine DQ & "SAXPAR.vbs" & DQ & " (Security Analyzer Xml PARser), " &_
"revision " & strRevNo & ", http://www.silentrunners.org/" & vbNewLine & vbNewLine
strBuffer = "" : strMsg = ""
'open StdErr FN and output results after first 4 lines to oTxtFi
Set oSEFi = Fso.OpenTextFile(ScrPath & strXMLErrFN,1,False,-1)
'skip first 4 lines of StdErr file, detect error if < 4 lines present
On Error Resume Next
For i = 1 To 4 : strStdErr = strStdErr & oSEFi.ReadLine : Next
intErrNum = Err.Number : Err.Clear
On Error Goto 0
If InStr(LCase(strStdErr),"version 2.0") > 0 Then
strOut = "MBSACLI.EXE (Version 2.0) is obsolete and " &_
"is incompatible with SAXPAR.vbs." & vbNewLine &_
"Update to Version 2.2 here: http://bit.ly/9m95Si" & vbNewLine
End If
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
strBuffer = "MBSACLI.EXE error:" & vbNewLine & vbNewLine & strOut
oTxtFi.WriteLine strBuffer : strMsg = strMsg & strBuffer
oTxtFi.Close : Set oTxtFi=Nothing
If logDisplayMsgs Then
If flagOut = "W" Then
MsgBox "MBSACLI.EXE failed due to the following error:" & vbNewLine &_
vbNewLine & strOut,vbOKOnly + vbCritical + vbSystemModal, _
"MBSACLI Failure!"
Else
WScript.Echo "MBSACLI.EXE failed due to the following error:" & vbNewLine &_
strOut
End If
End If 'DisplayMsgs?
WScript.Quit
End If
'say that MBSACLI is done
If logDisplayMsgs Then
If flagOut = "W" Then
Wshso.Popup "MBSACLI.EXE has finished." & vbCRLF &_
"The XML file will now be translated to text." & vbCRLF &_
"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 translated to text and opened in Notepad."
End If
End If 'DisplayMsgs?
'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
strBuffer = "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.)"
oTxtFi.WriteLine strBuffer : strMsg = strMsg & strBuffer
If logDisplayMsgs Then
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
End If 'DisplayMsgs?
WScript.Quit
End If
'start normal output
'output local cab file error
If strLCEM <> "" Then
oTxtFi.WriteLine strLCEM & vbNewLine
strMsg = strMsg & strLCEM & vbNewLine & vbNewLine
End If
'output report file directory errors
If strRDEM <> "" Then
oTxtFi.WriteLine strRDEM & vbNewLine
strMsg = strMsg & strRDEM & vbNewLine & vbNewLine
End If
intPosn = (72-Len(strMinSeverity))/2
strBuffer = Space(27) & "Missing Hotfixes" & vbCRLF &_
Space(27) & String(16,"-")
oTxtFi.WriteLine strBuffer : strMsg = strMsg & strBuffer
strBuffer = Space(intPosn) & strMinSeverity
oTxtFi.WriteLine strBuffer : strMsg = strMsg & vbNewLine & strBuffer
'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
strBuffer = vbNewLine & "Product Update Category: " & oMSP.GetAttribute("Name") & vbCRLF &_
Space(15) & "Status : " & oMSP.SelectSingleNode("Advice").text
oTxtFi.WriteLine strBuffer : strMsg = strMsg & vbNewLine & strBuffer
'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' and @Severity>='" & intMinSeverity & "']")
'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 : strMsg = strMsg & vbNewLine & strOut
Next 'uninstalled hotfix
End If 'updates missing?
Next 'product category
'reset objects
Set oMSP=Nothing : Set oMSPColl=Nothing : Set oHF=Nothing : Set oHFColl=Nothing
Set oXMLFi=Nothing
'if requested, send results by e-mail
If logEmailRpt Then
'send the message to PC Dr
Dim oEmail : Set oEmail = CreateObject("CDO.Message")
Dim oCDOCfg : Set oCDOCfg = oEmail.Configuration.Fields
oEmail.From = strSenderEMA
oEmail.To = strDestEMA
oEmail.Subject = strTxtFN
oEmail.Textbody = strMsg
'configure CDO SMTP
oCDOCfg (cdoSendUsingMethod) = cdoSendUsingPort
oCDOCfg (cdoSMTPServer) = strSMTPServer
oCDOCfg (cdoSMTPServerPort) = 25
oCDOCfg (cdoSMTPAuthenticate) = 0
oCDOCfg (cdoSMTPUseSSL) = False
'configure CDO SMTP for authentication or Gmail
If logSMTPAuth Then
oCDOCfg (cdoSMTPAuthenticate) = 1
oCDOCfg (cdoSendUserName) = strUserID
oCDOCfg (cdoSendPassword) = strUserPW
oCDOCfg (cdoSMTPConnectionTimeout) = 15
ElseIf logUseGmail Then
oCDOCfg (cdoSMTPServer) = "smtp.gmail.com"
oCDOCfg (cdoSMTPAuthenticate) = 1
oCDOCfg (cdoSendUserName) = strUserID
oCDOCfg (cdoSendPassword) = strUserPW
oCDOCfg (cdoSMTPUseSSL) = True
oCDOCfg (cdoSMTPServerPort) = 465
oCDOCfg (cdoSMTPConnectionTimeout) = 15
End If 'SMTP auth or Gmail?
oCDOCfg.Update
On Error Resume Next
Err.Clear : oEmail.Send : intErrNum = Err.Number : strErrDesc = Err.Description
On Error Goto 0
If intErrNum <> 0 Then _
oTxtFi.WriteLine vbNewLine & "The e-mail message containing the results could not be sent." &_
vbNewLine & "The error description is: " & strErrDesc
Else 'display results in Notepad
If logDisplayMsgs Then
Wshso.Run "notepad.exe " & DQ & strTxtFNPath & strTxtFN & DQ,1,False
End If 'logDisplayMsgs?
End If 'e-mail results or display in Notepad?
oTxtFi.Close : Set oTxtFi=Nothing 'close the output file
'clean up
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
'R05
'changed script name to "SAXPAR.vbs"
'added computer name in parentheses, date & time to report title
'added check for MBSACLI.EXE Version 2.0
'added script ID to report header
'added setting report directory via command line parameter or script parameter
'added setting local cab file directory as script parameter to
' run without an Internet connection
'added case severity filter and sending report by e-mail via script parameters
'added optional display of status and error messages
'added hidden check for elevated privileges in WVa/Wn7
'added Windows Server 2003 & 2008
'moved wuauserv service reset to immediately after MBSACLI launch
'added replacement of illegal XML characters by "(" + legal_chr + ")"
'R06
'eliminated use of argument to identify elevated privileges
'R07
'added check for WHOAMI.EXE and results file, quit if either not found
'R08
'added download location for MBSA 2.2
'R09
'MBSACLI.EXE XML output switched to Unicode format, obviating need to
' filter illegal characters; report file also switched to Unicode format
'StdErr output file interpreted as Unicode
'added download location for MBSA 2.2 in case of MBSACLI.EXE version error
'fixed identification of Windows 7 RTM
'R10
'added "windows 7" as a WMI OS identifier string with a space rather
'than Chr(160) as a separator; detect admin rights under WVa/Wn7 via
'registry rather than WHOAMI.EXE; prefix string to argument under
'WVa/Wn7 to detect relaunch (and avoid infinite loop if elevated
'privileges not obtained)
'R11
'updated version number/link for MBSA (2.3), detected Windows version
'via array instead of If statement
'** Update Revision Number on line #15 **