Dim wshshell 
Set wshshell = CreateObject("wscript.shell")
Dim message 
Dim strSubKey
Dim objRegistry
Dim arrSubKeys(), retval
Dim strDisplayName, strDisplayVersion, strInstallLocation
Const HKEY_LOCAL_MACHINE = &H80000002
Const strKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall"
Dim objwmiservice 


If WScript.Arguments.Count = 1 Then
	strComputer = WScript.Arguments(0)
Else
	strComputer = wshShell.ExpandEnvironmentStrings("%COMPUTERNAME%")
	strComputer = InputBox("Check Patches on what PC","What is it?",strComputer)
End If 

If strcomputer = "" Then WScript.Quit
strComputer = UCase(strComputer)

Dim colitems, Item, objitem, strDescription, strPatch
retval = wshshell.PopUp("Checking All Patches on " & strComputer & vbCrLf & "Be patient, this can take a while", 2, "Loading...", vbInformation + vbOKOnly)

On Error Resume Next
message = "Patches on " & strComputer & vbCrLf & VbCrLf
message = message & "From QuickFixEngineering:" & vbCrLf & vbCrLf

    If MYOSVer < 5.1 Then ' too bad.  Must risk hanging WMI calls
        Set objwmiservice = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
    Else
        Const wbemConnectFlagUseMaxWait = 128
        Dim objLocator
        Set objLocator = CreateObject("WbemScripting.SWbemLocator")
        Set objwmiservice = objLocator.ConnectServer(strComputer, "\root\cimv2", , , , , wbemConnectFlagUseMaxWait)
    End If

Dim strWQL
    strWQL = "SELECT HotFixID, Description FROM Win32_QuickFixEngineering " & _
   "where HotFixID <> 'File 1'"
Set colitems = objwmiservice.ExecQuery(strWQL, , 48)
If Not IsEmpty(colitems) Then
    
    For Each objitem In colitems
    If Err <> 0 Then
        retval = MsgBox("Cannot reach WMI on " & strComputer, vbCritical + vbOKOnly, "Error")
       WScript.Quit
    End If
    
        If (objitem.Description) = "" Then
            strDescription = "(No Description Available)"
        Else
            strDescription = objitem.Description
        End If
        

        strPatch = objitem.HotFixID & " - " & strDescription
        message = message & strPatch & vbCrLf
    Next
End If

Set objRegistry = GetObject("winmgmts:" & _
    "{impersonationLevel=Impersonate}!\\" & _
    strComputer & "\root\default:StdRegProv")

objRegistry.EnumKey HKEY_LOCAL_MACHINE, strKey, arrSubKeys

message = message & vbCrLf & "From Add or Remove Programs:" & vbCrLf & vbCrLf

On Error Resume Next
For Each strSubKey In arrSubKeys
If (InStr(LCase(strSubKey), "update") > 0) Or (InStr(LCase(strSubKey), "kb") > 0) Then
    objRegistry.GetStringValue HKEY_LOCAL_MACHINE, _
        strKey & "\" & strSubKey, "DisplayName", strDisplayName

    message = message & strSubKey & " - " & strDisplayName & vbCrLf
    strDisplayName = vbEmpty
End If

Next

Const strIEKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\Internet Settings"


message = message & vbCrLf & vbCrLf & "From Internet Explorer:" & vbCrLf
Dim strValueName, strIEPatches
strValueName = "MinorVersion"
objRegistry.GetStringValue HKEY_LOCAL_MACHINE, strIEKey, strValueName, strIEPatches

message = message & Replace(strIEPatches, ";", vbCrLf)


Dim oExec
Set oExec = wshshell.Exec("%comspec% /c dir /b \\" & strComputer & "\admin$\$* /ah")

If oExec.ExitCode <> 0 Then
     'wscript.Echo "Warning: Non-zero exit code, " & oExec.ExitCode
End If

Dim strUninstPatches
Dim tArray, strLine

 While Not oExec.StdOut.AtEndOfStream
      strLine = LCase(oExec.StdOut.ReadLine)
         If InStr(strLine, "uninstall") > 0 Then
            tArray = Split(strLine, "uninstall")
            strLine = tArray(1)

            strUninstPatches = strUninstPatches & strLine & vbCrLf
           ReDim tArray(2)
         End If
     Wend

    strUninstPatches = Replace(strUninstPatches, "$", "")
    strUninstPatches = Replace(strUninstPatches, "_", "")
    strUninstPatches = Replace(strUninstPatches, vbCrLf & vbCrLf, vbCrLf)
    message = message & vbCrLf & vbCrLf & "From Uninstall Directory " & vbCrLf & strUninstPatches


IEMessage message,"Patches on " & strcomputer,"lt Blue",600,600,True


'================ Functions and Subs ==============
Sub IEMessage(message,strTitle,strBGColor,iHeight,IWidth,bPrint)
	Dim oIE, oPage
	Dim strComputer, strBorder, strFont
	Dim strFormatOn, strFormatOff, iTSView
	Set oIE = CreateObject("InternetExplorer.Application")
	iTSview = 0 	'1 for troubleshooting, allows view source menu
	strBorder = 1	'Best appearance is strBorder 1 
	strFont = "Arial"
	oIE.Navigate "about:blank" 
	oIE.AddressBar = False
	oIE.Height = iHeight
	oIE.Width = IWidth	
	oIE.MenuBar = iTSView 
	oIE.ToolBar = iTSView	
	oIE.StatusBar = False
	oIE.Left = 50
	oIE.Top = 50
	oIE.Visible = 1

	message = Replace(message,vbcrlf,"<br>"& vbcrlf)

	Do While (oIE.Busy)
		Wscript.Sleep 250
	Loop
	
	Set oPage = oIE.Document
	oPage.Open

	oPage.Writeln "<html><head><title>" & strTitle & "</title></head>"
	oPage.Writeln "<body bgcolor='"& strBGcolor & "'>"
	oPage.Writeln "<Font face ='"& strFont & "'>"
	oPage.Writeln "<Center><h2>" & strTitle & "</center></h2>"
	oPage.Writeln "<Span>" & Message & "</Span><br>"
	If bPrint Then 
		oPage.WriteLn "<input id=runbutton  type='button' value='Print' name='printbtn' onClick='window.print();'>"
	End If 
	oPage.Writeln "</font></body></html>"
	oPage.Write()
	oPage.Close 
End Sub