Page 1 of 1

WMI remote access alternative user authenction

Posted: Thu Jun 30, 2011 2:21 am
by w216uhk
Would this modficiation allow for the WMI to be used remotley:

Set objLocator = CreateObject( "WbemScripting.SWbemLocator" ) Set objWMIService = objLocator.ConnectServer (strPC, "root/cimv2", strUserName, strPassword) objWMIService.Security_.impersonationlevel = 3 Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!" & _ strPC & "rootcimv2")

Full code below (not wirrten by me), also would there be an easy way to inculde MS hotfixes also in the software listing

Code: Select all

	<html><head>
	<meta http-equiv="Content-Type" content="text/html; charset=windows-1252">
	<title>Software Uninstall Utility</title>
	<HTA:APPLICATION APPLICATIONNAME="UninstallUtility" ID="objUninstallUtility"  VERSION="1.5" BORDER="dialog" APPLICATIONNAME="UninstallUtility"  SCROLL="no" CONTEXTMENU="no" SINGLEINSTANCE="yes"  WINDOWSTATE="normal"/> 
	<style type="text/css">body { font-family: "trebuchet ms", calibri, helvetica, sans-serif, "Times New Roman"; cursor: default;}input { font-family: "trebuchet ms", calibri, helvetica, sans-serif, "Times New Roman"; border: #000033 2px solid;}input.button { color: black; cursor: hand; background-color: white; border: #000033 2px solid; font-weight: bold;}input.btnhov {  border-color: #000033; background-color: #cccccc;}input.text {  height: 27px; padding-left: 5px; padding-bottom: 0px;}input.disabled {  color: #888888; border-color: #888888; cursor: default;}select { font-family: "trebuchet ms", calibri, helvetica, sans-serif, "Times New Roman"; border: #000033 1px solid; height: 23px;}table.softwaretable { border: 1px solid black; border-collapse: collapse; table-layout: fixed;}table.softwaretable th { border-top: 1px solid black; border-bottom: 1px solid black; background-color: black; color: white; padding: 1px 5px;}table.softwaretable td { border-top: 1px solid black; border-bottom: 1px solid black; padding: 1px 5px;}span.spanlink { color: blue; cursor: hand;}h3 { font-style: italic;}.hidden { display: none; visibility: hidden;}#DataArea { overflow: auto; height: 90%; width: 100%;}</style>
	</head>
	<script language="VBScript">
	 Const HKEY_USERS = &H80000003 Const HKEY_LOCAL_MACHINE = &H80000002 Const adVarChar = 200 Const adDate = 7 Const MaxCharacters = 255  Dim strPC, intSWCount, booSoftwareNameSort, booVendorSort Dim booVersionSort, booInstallDateSort  Set objFSO = CreateObject("Scripting.FileSystemObject") Set objShell = CreateObject("Wscript.Shell") Set DataList = CreateObject("ADOR.Recordset")  strUserName = UserPassword.Value strPassword = UserName.Value strPC = MachineName.Value  '#--------------------------------------------------------------------------    '# SUBROUTINE.....: ShowSoftwareItems()    '# PURPOSE........: Retrieves a list of installed software    '# ARGUMENTS......:     '# EXAMPLE........:     '# NOTES..........:     '#-------------------------------------------------------------------------- Sub ShowSoftwareItems()  On Error Resume Next    document.body.style.cursor = "wait"  PauseScript(0)    Set DataList = CreateObject("ADOR.Recordset")    booSoftwareNameSort = 1  booVendorSort = 0  booVersionSort = 0  booInstallDateSort = 1  intSWCount = 0    WMIError.className = "hidden"  NotFoundArea.className = "hidden"  PSExecError.className = "hidden"  DataArea.className = ""  btnShowSW.Disabled = True  btnShowSW.className = "disabled"  txtComputerName.Disabled = True  txtComputerName.className = "text disabled"  txtComputerName.style.fontweight = "bold"  txtComputerName.Title = ""  btnShowSW.Title = ""    If IsNull(txtComputerName.Value) OR txtComputerName.Value = "" OR txtComputerName.Value = "." Then   txtComputerName.Value = objShell.ExpandEnvironmentStrings("%COMPUTERNAME%")  End If  txtComputerName.Value = UCase(txtComputerName.Value)  strPC = txtComputerName.Value    If NOT Reachable(strPC) Then   ResetForm()   NotFoundArea.className = ""   DataArea.className = "hidden"   document.body.style.cursor = "default"   Exit Sub  End If    DataArea.InnerHTML = "<h3>Fetching Software info for " & strPC & ", please wait.</h3>"  PauseScript(1)    DataList.Fields.Append "SoftwareName", adVarChar, MaxCharacters  DataList.Fields.Append "Vendor", adVarChar, MaxCharacters  DataList.Fields.Append "Version", adVarChar, MaxCharacters  DataList.Fields.Append "InstallDate", adDate  DataList.Fields.Append "UninstallString", adVarChar, MaxCharacters  DataList.Fields.Append "SilentString", adVarChar, MaxCharacters  DataList.Fields.Append "ID", adVarChar, MaxCharacters  DataList.Open    strHTML = "<form name=""softwareform"" method=""post"">" & _  "<table class=""softwaretable"">" & _   "<tr>" & _    "<th style=""width:30%;text-align:left;cursor:hand;"" " & _     "title=""Sort by Software Title"" onClick=SortSoftwareItems(1)>" & _     "Software Title   ^</th>" & _    "<th style=""width:24%;text-align:left;cursor:hand;"" " & _     "title=""Sort by Vendor"" onClick=SortSoftwareItems(2)>Vendor</th>" & _    "<th style=""width:15%;text-align:left;cursor:hand;"" " & _     "title=""Sort by Version"" onClick=SortSoftwareItems(3)>Version</th>" & _    "<th style=""width:15%;cursor:hand;"" " & _     "title=""Sort by Install Date"" onClick=SortSoftwareItems(4)>Install Date</th>" & _    "<th style=""width:8%;""> </th>" & _    "<th style=""width:8%;""> </th>" & _   "</tr>"    Err.Clear    Set objLocator = CreateObject( "WbemScripting.SWbemLocator" )  Set objWMIService = objLocator.ConnectServer (strPC, "root/cimv2", strUserName, strPassword)  objWMIService.Security_.impersonationlevel = 3  Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!" & _  strPC & "rootcimv2")    Set objReg = GetObject("winmgmts://" & strPC & "/root/default:StdRegProv")    If Err.Number <> 0 Then   ResetForm()   WMIError.className = ""   DataArea.className = "hidden"   document.body.style.cursor = "default"   Exit Sub  End If
	  DataArea.InnerHTML = "<h3>Fetching Software info for " & strPC & ", please wait..</h3>"  PauseScript(1)    strKeyPath = "SOFTWAREMicrosoftWindowsCurrentVersionUninstall"  objReg.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrSubkeys    For Each objItem In arrSubKeys   strValueName = "DisplayName"   strSubPath = strKeyPath & "" & objItem   objReg.GetExpandedStringValue HKEY_LOCAL_MACHINE,strSubPath,strValueName,strValue      If strValue <> "" AND InStr(strValue, "Hotfix") = 0 AND _   InStr(strValue, "Security Update") = 0 AND _   InStr(strValue, "Update for Windows") = 0 Then    booHide = 0    objReg.GetDwordValue HKEY_LOCAL_MACHINE,strSubPath, _    "SystemComponent",booHide    If booHide <> 1 OR IsNull(booHide) OR booHide = "" Then     intSWCount = intSWCount + 1     strName = strValue     objReg.GetExpandedStringValue HKEY_LOCAL_MACHINE,strSubPath, _     "DisplayVersion",strVersion     objReg.GetExpandedStringValue HKEY_LOCAL_MACHINE,strSubPath, _     "InstallDate",intInstallDate     objReg.GetExpandedStringValue HKEY_LOCAL_MACHINE,strSubPath, _     "Publisher",strVendor     objReg.GetExpandedStringValue HKEY_LOCAL_MACHINE,strSubPath, _     "UninstallString",strUninstallString     objReg.GetExpandedStringValue HKEY_LOCAL_MACHINE,strSubPath, _     "QuietUninstallString",strSilentString          If IsNull(intInstallDate) OR intInstallDate = "" Then      dtmInstallDate = " "      Else        dtmInstallDate = MID(intInstallDate,7,2) & _       "/" & MID(intInstallDate,5,2) & "/" & _       LEFT(intInstallDate,4)       If NOT IsDate(dtmInstallDate) Then        dtmInstallDate = " "       End If     End If     If IsNull(strName) OR strName = "" Then      strSoftwareName = " "     End If     If IsNull(strVendor) OR strVendor = "" Then      strVendor = " "     End If     If IsNull(strVersion) OR strVersion = "" Then      strVersion = " "     End If          If InStr(Lcase(strUninstallString), "msiexec.exe") > 0 Then      strSilentString = strUninstallString & " /qn /norestart"     End If
	     DataList.AddNew          REM DataList("SoftwareName") = strName     REM DataList("Value") = strName & "||" & strVendor & _     REM "||" & strVersion & "||" & dtmInstallDate & _     REM "||" & strUninstallString & "||" & strSilentString          REM If Err.Number <> 0 Then      REM DataList("Value") = strName & "||" & strVendor & _      REM "||" & strVersion & "||" & dtmInstallDate & _      REM "|| || "      REM Err.Clear     REM End If          If intSWCount < 10 Then intSWCount = "0" & intSWCount          DataList("SoftwareName") = strName     DataList("Vendor") = strVendor     DataList("Version") = strVersion     DataList("InstallDate") = dtmInstallDate     DataList("UninstallString") = strUninstallString     DataList("SilentString") = strSilentString     DataList("ID") = intSWCount          DataList.Update    End If   End If  Next    DataArea.InnerHTML = "<h3>Fetching Software info for " & strPC & ", please wait...</h3>"  PauseScript(1)    Set objLocator = CreateObject( "WbemScripting.SWbemLocator" )  Set objWMIService = objLocator.ConnectServer (strPC, "root/cimv2", strUserName, strPassword)  objWMIService.Security_.impersonationlevel = 3  Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!" & _  strPC & "rootcimv2")    Set colComputer = objWMIService.ExecQuery _   ("Select * from Win32_ComputerSystem")   For Each objItem In colComputer   strLoggedOn = objItem.UserName  Next
	  strRemoteSID = GetSIDFromUser(strLoggedOn)    strKeyPath = strRemoteSID & "SOFTWAREMicrosoftWindowsCurrentVersionUninstall"  objReg.EnumKey HKEY_USERS, strKeyPath, arrSubkeys  For Each objItem In arrSubKeys   strValueName = "DisplayName"   strSubPath = strKeyPath & "" & objItem   objReg.GetExpandedStringValue HKEY_USERS,strSubPath,strValueName,strValue      If strValue <> "" AND InStr(strValue, "Hotfix") = 0 AND _   InStr(strValue, "Security Update") = 0 AND _   InStr(strValue, "Update for Windows") = 0 Then    booHide = 0    objReg.GetDwordValue HKEY_LOCAL_MACHINE,strSubPath, _    "SystemComponent", booHide    If booHide <> 1 OR IsNull(booHide) OR booHide = "" Then     intSWCount = intSWCount + 1     strName = strValue     objReg.GetExpandedStringValue HKEY_USERS,strSubPath, _     "DisplayVersion",strVersion     objReg.GetExpandedStringValue HKEY_USERS,strSubPath, _     "InstallDate",intInstallDate     objReg.GetExpandedStringValue HKEY_USERS,strSubPath, _     "Publisher",strVendor     objReg.GetExpandedStringValue HKEY_USERS,strSubPath, _     "UninstallString",strUninstallString     objReg.GetExpandedStringValue HKEY_USERS,strSubPath, _     "QuietUninstallString",strSilentString     If IsNull(intInstallDate) OR intInstallDate = "" Then      dtmInstallDate = " "      Else        dtmInstallDate = MID(intInstallDate,7,2) & _       "/" & MID(intInstallDate,5,2) & "/" & _       LEFT(intInstallDate,4)       If NOT IsDate(dtmInstallDate) Then        dtmInstallDate = " "       End If     End If     If IsNull(strName) OR strName = "" Then      strSoftwareName = " "     End If     If IsNull(strVendor) OR strVendor = "" Then      strVendor = " "     End If     If IsNull(strVersion) OR strVersion = "" Then      strVersion = " "     End If          If InStr(Lcase(strUninstallString), "msiexec.exe") > 0 Then      strSilentString = strUninstallString & " /qn /norestart"     End If          DataList.AddNew     REM DataList("SoftwareName") = strName     REM DataList("Value") = strName & "||" & strVendor & _     REM "||" & strVersion & "||" & dtmInstallDate & _     REM "||" & strUninstallString & "||" & strSilentString          REM If Err.Number <> 0 Then      REM DataList("Value") = strName & "||" & strVendor & _      REM "||" & strVersion & "||" & dtmInstallDate & _      REM "|| || "      REM Err.Clear     REM End If          If intSWCount < 10 Then intSWCount = "0" & intSWCount          DataList("SoftwareName") = strName     DataList("Vendor") = strVendor     DataList("Version") = strVersion     DataList("InstallDate") = dtmInstallDate     DataList("UninstallString") = strUninstallString     DataList("SilentString") = strSilentString     DataList("ID") = intSWCount          DataList.Update     End If   End If  Next
	  DataList.Sort = "SoftwareName"    DataArea.InnerHTML = "<h3>Fetching Software info for " & strPC & ", please wait....</h3>"  PauseScript(1)    DataList.MoveFirst  Do Until DataList.EOF   strSoftwareName = DataList.Fields.Item("SoftwareName")   strVendor = DataList.Fields.Item("Vendor")   strVersion = DataList.Fields.Item("Version")   dtmInstallDate = DataList.Fields.Item("InstallDate")   strUninstallString = DataList.Fields.Item("UninstallString")   strSilentString = DataList.Fields.Item("SilentString")   intID = DataList.Fields.Item("ID")   DataList.MoveNext      strSoftwareSearch = Replace(strSoftwareName, " ", "_")      If InStr(LCase(strUninstallString), "msiexec.exe") > 0 Then    strSilentString = Replace(strUninstallString, _     "MsiExec.exe /I", "MsiExec.exe /norestart /quiet /X")    strUninstallString = Replace(strUninstallString, _     "MsiExec.exe /I", "MsiExec.exe /X")   End If      strUninstallString = Replace(strUninstallString, Chr(34), "{Chr(34)}")   strUninstallString = Replace(strUninstallString, "'", "{APOS}")   strUninstallString = Replace(strUninstallString, " ", "{SPACE}")   strEncodedSWName = Replace(strSoftwareName, " ", "{SPACE}")   strEncodedSWName = Replace(strEncodedSWName, Chr(34), "{Chr(34)}")   strEncodedSWName = Replace(strEncodedSWName, "'", "{APOS}")   strSilentString = Replace(strSilentString, Chr(34), "{Chr(34)}")   strSilentString = Replace(strSilentString, "'", "{APOS}")   strSilentString = Replace(strSilentString, " ", "{SPACE}")      strNewValue = strSoftwareName & "||" & strVendor & "||" & strVersion & "||" & _    dtmInstallDate & "||" & strUninstallString & "||" & strSilentString & "||" & intID      strHTML = strHTML & "<tr>"   strHTML = strHTML & "<td><span class=""spanlink"" onClick=OpenURL(""http://www.google.com/search?q=" & _    strSoftwareSearch & """) title=""Search Google for '" & strSoftwareName & "'"">" & strSoftwareName & _    "</span><input type=""hidden"" name=""hdnValue" & intID & """ value=""" & strNewValue & """></td>"   strHTML = strHTML & "<td>" & strVendor & "</td>"   strHTML = strHTML & "<td>" & strVersion & "</td>"   strHTML = strHTML & "<td style=""text-align:center;"">" & dtmInstallDate & "</td>"   strHTML = strHTML & "<td style=""text-align:center;""><input class=""button"" type=""button"" " & _    "style=""width:70;height:23px;"" value=""Uninstall"" id=""btnUninstall" & intID & """ title=""Uninstall '" & _    strSoftwareName & "' interactively"" onClick=UninstallSoftware(""" & strUninstallString & _    "||" & strEncodedSWName & "||0"") onMouseOver=""btnMouseOver(me)"" onMouseOut=""btnMouseOut(me)""></td>"   strHTML = strHTML & "<td style=""text-align:center;""><input class=""button"" type=""button"" " & _    "style=""width:70;height:23px;"" value=""Silent"" id=""btnSilent" & intID & """ title=""Uninstall '" & _    strSoftwareName & "' silently"" onClick=UninstallSoftware(""" & strSilentString & _    "||" & strEncodedSWName & "||1"") onMouseOver=""btnMouseOver(me)"" onMouseOut=""btnMouseOut(me)""> </td>"   strHTML = strHTML & "</tr>"   Loop    strHTML = strHTML & "</table></form>"
	  DataArea.InnerHTML = strHTML
	  For j = 1 To intSWCount   strUninstallString = ""   strSilentString = ""
	   If j < 10 Then j = "0" & j      strValue = document.getElementById("hdnValue" & j).Value   arrValues = Split(strValue, "||")      strUninstallString = arrValues(4)   strSilentString = arrValues(5)      If strUninstallString = "" Then    document.getElementById("btnUninstall" & j).Disabled = True     document.getElementById("btnUninstall" & j).className = "disabled"    document.getElementById("btnUninstall" & j).Title = ""   End If   If strSilentString = "" Then    document.getElementById("btnSilent" & j).Disabled = True    document.getElementById("btnSilent" & j).className = "disabled"    document.getElementById("btnSilent" & j).Title = ""   End If  Next
	  BottomBar.className = ""  NumItemsSpan.InnerHTML = intSWCount & " items"    document.body.style.cursor = "default" End Sub  '#--------------------------------------------------------------------------    '# SUBROUTINE.....: SortSoftwareItems(intSort)    '# PURPOSE........: Sorts the list of installed software    '# ARGUMENTS......: intSort = index of row to sort    '# EXAMPLE........: SortSoftwareItems(2)    '# NOTES..........: The above example would sort the Vendor row    '#-------------------------------------------------------------------------- Sub SortSoftwareItems(intSort)  On Error Resume Next    document.body.style.cursor = "wait"  PauseScript(0)    Select Case intSort   Case 1    booVendorSort = 0    booVersionSort = 0    booInstallDateSort = 1        If booSoftwareNameSort = 0 Then     booSoftwareNameSort = 1     strSortHTML = "Software Title   ^"     DataList.Sort = "SoftwareName ASC"     Else      booSoftwareNameSort = 0      strSortHTML = "Software Title   <span style=""font-size:0.6em"">v</span>"      DataList.Sort = "SoftwareName DESC"    End If       strHTML = "<form name=""softwareform"" method=""post"">" & _    "<table class=""softwaretable"">" & _     "<tr>" & _      "<th style=""width:30%;text-align:left;cursor:hand;"" " & _       "title=""Sort by Software Title"" onClick=SortSoftwareItems(1)>" & _       strSortHTML & "</th>" & _      "<th style=""width:24%;text-align:left;cursor:hand;"" " & _       "title=""Sort by Vendor"" onClick=SortSoftwareItems(2)>Vendor</th>" & _      "<th style=""width:15%;text-align:left;cursor:hand;"" " & _       "title=""Sort by Version"" onClick=SortSoftwareItems(3)>Version</th>" & _      "<th style=""width:15%;cursor:hand;"" " & _       "title=""Sort by Install Date"" onClick=SortSoftwareItems(4)>Install Date</th>" & _      "<th style=""width:8%;""> </th>" & _      "<th style=""width:8%;""> </th>" & _     "</tr>"   Case 2    booSoftwareNameSort = 0    booVersionSort = 0    booInstallDateSort = 1        If booVendorSort = 0 Then     booVendorSort = 1     strSortHTML = "Vendor   ^"     DataList.Sort = "Vendor ASC"     Else      booVendorSort = 0      strSortHTML = "Vendor   <span style=""font-size:0.6em"">v</span>"      DataList.Sort = "Vendor DESC"    End If        strHTML = "<form name=""softwareform"" method=""post"">" & _    "<table class=""softwaretable"">" & _     "<tr>" & _      "<th style=""width:30%;text-align:left;cursor:hand;"" " & _       "title=""Sort by Software Title"" onClick=SortSoftwareItems(1)>Software Title</th>" & _      "<th style=""width:24%;text-align:left;cursor:hand;"" " & _       "title=""Sort by Vendor"" onClick=SortSoftwareItems(2)>" & _       strSortHTML & "</th>" & _      "<th style=""width:15%;text-align:left;cursor:hand;"" " & _       "title=""Sort by Version"" onClick=SortSoftwareItems(3)>Version</th>" & _      "<th style=""width:15%;cursor:hand;"" " & _       "title=""Sort by Install Date"" onClick=SortSoftwareItems(4)>Install Date</th>" & _      "<th style=""width:8%;""> </th>" & _      "<th style=""width:8%;""> </th>" & _     "</tr>"   Case 3    booSoftwareNameSort = 0    booVendorSort = 0    booInstallDateSort = 1        If booVersionSort = 0 Then     booVersionSort = 1     strSortHTML = "Version   ^"     DataList.Sort = "Version ASC"     Else      booVersionSort = 0      strSortHTML = "Version   <span style=""font-size:0.6em"">v</span>"      DataList.Sort = "Version DESC"    End If        strHTML = "<form name=""softwareform"" method=""post"">" & _    "<table class=""softwaretable"">" & _     "<tr>" & _      "<th style=""width:30%;text-align:left;cursor:hand;"" " & _       "title=""Sort by Software Title"" onClick=SortSoftwareItems(1)>Software Title</th>" & _      "<th style=""width:24%;text-align:left;cursor:hand;"" " & _       "title=""Sort by Vendor"" onClick=SortSoftwareItems(2)>Vendor</th>" & _      "<th style=""width:15%;text-align:left;cursor:hand;"" " & _       "title=""Sort by Version"" onClick=SortSoftwareItems(3)>" & _       strSortHTML & "</th>" & _      "<th style=""width:15%;cursor:hand;"" " & _       "title=""Sort by Install Date"" onClick=SortSoftwareItems(4)>Install Date</th>" & _      "<th style=""width:8%;""> </th>" & _      "<th style=""width:8%;""> </th>" & _     "</tr>"   Case 4    booSoftwareNameSort = 0    booVendorSort = 0    booVersionSort = 0        If booInstallDateSort = 0 Then     booInstallDateSort = 1     strSortHTML = "Install Date   ^"     DataList.Sort = "InstallDate ASC"     Else      booInstallDateSort = 0      strSortHTML = "Install Date   <span style=""font-size:0.6em"">v</span>"      DataList.Sort = "InstallDate DESC"    End If        strHTML = "<form name=""softwareform"" method=""post"">" & _    "<table class=""softwaretable"">" & _     "<tr>" & _      "<th style=""width:30%;text-align:left;cursor:hand;"" " & _       "title=""Sort by Software Title"" onClick=SortSoftwareItems(1)>Software Title</th>" & _      "<th style=""width:24%;text-align:left;cursor:hand;"" " & _       "title=""Sort by Vendor"" onClick=SortSoftwareItems(2)>Vendor</th>" & _      "<th style=""width:15%;text-align:left;cursor:hand;"" " & _       "title=""Sort by Version"" onClick=SortSoftwareItems(3)>Version</th>" & _      "<th style=""width:15%;cursor:hand;"" " & _       "title=""Sort by Install Date"" onClick=SortSoftwareItems(4)>" & _       strSortHTML & "</th>" & _      "<th style=""width:8%;""> </th>" & _      "<th style=""width:8%;""> </th>" & _     "</tr>"  End Select    DataList.MoveFirst  Do Until DataList.EOF   strSoftwareName = DataList.Fields.Item("SoftwareName")   strVendor = DataList.Fields.Item("Vendor")   strVersion = DataList.Fields.Item("Version")   dtmInstallDate = DataList.Fields.Item("InstallDate")   strUninstallString = DataList.Fields.Item("UninstallString")   strSilentString = DataList.Fields.Item("SilentString")   intID = DataList.Fields.Item("ID")   DataList.MoveNext      strSoftwareSearch = Replace(strSoftwareName, " ", "_")      If InStr(LCase(strUninstallString), "msiexec.exe") > 0 Then    strSilentString = Replace(strUninstallString, _     "MsiExec.exe /I", "MsiExec.exe /norestart /quiet /X")    strUninstallString = Replace(strUninstallString, _     "MsiExec.exe /I", "MsiExec.exe /X")   End If      strUninstallString = Replace(strUninstallString, Chr(34), "{Chr(34)}")   strUninstallString = Replace(strUninstallString, "'", "{APOS}")   strUninstallString = Replace(strUninstallString, " ", "{SPACE}")   strEncodedSWName = Replace(strSoftwareName, " ", "{SPACE}")   strEncodedSWName = Replace(strEncodedSWName, Chr(34), "{Chr(34)}")   strEncodedSWName = Replace(strEncodedSWName, "'", "{APOS}")   strSilentString = Replace(strSilentString, Chr(34), "{Chr(34)}")   strSilentString = Replace(strSilentString, "'", "{APOS}")   strSilentString = Replace(strSilentString, " ", "{SPACE}")      strNewValue = strSoftwareName & "||" & strVendor & "||" & strVersion &
	 "||" & _    dtmInstallDate & "||" & strUninstallString & "||" & strSilentString & "||" & intID      strHTML = strHTML & "<tr>"   strHTML = strHTML & "<td><span class=""spanlink"" onClick=OpenURL(""http://www.google.com/search?q=" & _    strSoftwareSearch & """) title=""Search Google for '" & strSoftwareName & "'"">" & strSoftwareName & _    "</span><input type=""hidden"" name=""hdnValue" & intID & """ value=""" & strNewValue & """></td>"   strHTML = strHTML & "<td>" & strVendor & "</td>"   strHTML = strHTML & "<td>" & strVersion & "</td>"   strHTML = strHTML & "<td style=""text-align:center;"">" & dtmInstallDate & "</td>"   strHTML = strHTML & "<td style=""text-align:center;""><input class=""button"" type=""button"" " & _    "style=""width:70;height:23px;"" value=""Uninstall"" id=""btnUninstall" & intID & """ title=""Uninstall '" & _    strSoftwareName & "' interactively"" onClick=UninstallSoftware(""" & strUninstallString & _    "||" & strEncodedSWName & "||0"") onMouseOver=""btnMouseOver(me)"" onMouseOut=""btnMouseOut(me)""></td>"   strHTML = strHTML & "<td style=""text-align:center;""><input class=""button"" type=""button"" " & _    "style=""width:70;height:23px;"" value=""Silent"" id=""btnSilent" & intID & """ title=""Uninstall '" & _    strSoftwareName & "' silently"" onClick=UninstallSoftware(""" & strSilentString & _    "||" & strEncodedSWName & "||1"") onMouseOver=""btnMouseOver(me)"" onMouseOut=""btnMouseOut(me)""> </td>"   strHTML = strHTML & "</tr>"   Loop    strHTML = strHTML & "</table></form>"
	  DataArea.InnerHTML = strHTML
	  For j = 1 To intSWCount   strUninstallString = ""   strSilentString = ""
	   If j < 10 Then j = "0" & j      strValue = document.getElementById("hdnValue" & j).Value   arrValues = Split(strValue, "||")      strUninstallString = arrValues(4)   strSilentString = arrValues(5)      If strUninstallString = "" Then    document.getElementById("btnUninstall" & j).Disabled = True     document.getElementById("btnUninstall" & j).className = "disabled"    document.getElementById("btnUninstall" & j).Title = ""   End If   If strSilentString = "" Then    document.getElementById("btnSilent" & j).Disabled = True    document.getElementById("btnSilent" & j).className = "disabled"    document.getElementById("btnSilent" & j).Title = ""   End If  Next    document.body.style.cursor = "default" End Sub  '#--------------------------------------------------------------------------    '# SUBROUTINE.....: btnMouseOver(objButton)    '# PURPOSE........: onMouseOver routine to change colour of uninstall '#      buttons    '# ARGUMENTS......: objButton = button name    '# EXAMPLE........: btnMouseOver("btnUninstall01")    '# NOTES..........:     '#-------------------------------------------------------------------------- Sub btnMouseOver(objButton)  document.GetElementById(objButton)  objButton.className = "button btnhov" End Sub  '#--------------------------------------------------------------------------    '# SUBROUTINE.....: btnMouseOut(objButton)    '# PURPOSE........: onMouseOut routine to change colour of uninstall '#      buttons    '# ARGUMENTS......: objButton = button name    '# EXAMPLE........: btnMouseOut("btnUninstall01")    '# NOTES..........:     '#-------------------------------------------------------------------------- Sub btnMouseOut(objButton)  document.GetElementById(objButton)  objButton.className = "button" End Sub  '#--------------------------------------------------------------------------    '# SUBROUTINE.....: OpenURL(strURL)    '# PURPOSE........: Opens the supplied URL in default browser    '# ARGUMENTS......: strURL = URL    '# EXAMPLE........: OpenURL("http://www.google.com"    '# NOTES..........: Any spaces in URL must be encoded as underscores ( _ )    '#--------------------------------------------------------------------------  Sub OpenURL(strURL)  strURL = Replace(strURL, "_", " ")  objShell.Run(Chr(34) & strURL & Chr(34)) End Sub  '#--------------------------------------------------------------------------    '# SUBROUTINE.....: UninstallSoftware(strValue)    '# PURPOSE........: Remotely uninstalls software    '# ARGUMENTS......: strValue = uninstall string and software title    '# EXAMPLE........: UninstallSoftware("c:uninstall.exe||MS Stuff")    '# NOTES..........: Uses PSExec or Rctrlx to perform install    '#-------------------------------------------------------------------------- Sub UninstallSoftware(strValue)  arrValues = Split(strValue, "||")  strUninstallString = arrValues(0)  strSoftwareName = arrValues(1)  booSilent = arrValues(2)    If booSilent = 1 Then   strSilent = "silently"   Else strSilent = "interactively"  End If    strUninstallString = Replace(strUninstallString, "{Chr(34)}", Chr(34))  strUninstallString = Replace(strUninstallString, "{APOS}", "'")  strUninstallString = Replace(strUninstallString, "{SPACE}", " ")  strSoftwareName = Replace(strSoftwareName, "{Chr(34)}", Chr(34))  strSoftwareName = Replace(strSoftwareName, "{APOS}", "'")  strSoftwareName = Replace(strSoftwareName, "{SPACE}", " ")    strPath = objShell.ExpandEnvironmentStrings("%path%")  arrPaths = Split(strPath, ";")  For i = 0 To UBound(arrPaths)   strPathFolder = arrPaths(i) & ""   strPathFolder = Replace(strPathFolder, "", "")   strPathFolder = Replace(LCase(strPathFolder), "%systemroot%", _   objShell.ExpandEnvironmentStrings("%systemroot%"))   If objFSO.FileExists(strPathFolder & "psexec.exe") Then strPSExecInPath = 1   If objFSO.FileExists(strPathFolder & "rctrlx.exe") Then strRctrlxInPath = 1  Next
	  If strPSExecInPath = 0 AND strRctrlxInPath = 0 Then   For i = 0 To UBound(arrPaths)    strPathFolder = arrPaths(i) & ""    strPathFolder = Replace(strPathFolder, "", "")    strPathFolder = Replace(LCase(strPathFolder), "%systemroot%", _    objShell.ExpandEnvironmentStrings("%systemroot%"))    strHTML = strHTML & LCase(strPathFolder) & "<br />"   Next      SystemPathSpan.InnerHTML = strHTML     txtComputerName.Disabled = False   btnShowSW.Disabled = False   txtComputerName.className = "text"   btnShowSW.className = "button"   txtComputerName.Title = "Computer Name"   btnShowSW.Title = "Show software list"   PSExecError.className = ""   DataArea.className = "hidden"   BottomBar.className = "hidden"      Exit Sub  End If    Err.Clear    If strRctrlxInPath = 1 Then   objShell.Run "%COMSPEC% /c rctrlx " & strPC & " /i /app " & _   strUninstallString, 0   Else    objShell.Run "%COMSPEC% /c psexec -i " & strPC & " " & _    strUninstallString, 0  End If
	  MsgBox strSoftwareName & " is now being uninstalled " & strSilent & _  " on " & UCase(strPC) & ".", vbInformation, "Software Uninstall Utility" End Sub  '#--------------------------------------------------------------------------    '# SUBROUTINE.....: ExportSoftwareDetails()    '# PURPOSE........: Export the details for the Software Items    '# ARGUMENTS......:     '# EXAMPLE........:     '# NOTES..........:     '#-------------------------------------------------------------------------- Sub ExportSoftwareDetails()  On Error Resume Next    document.body.style.cursor = "wait"  PauseScript(0)
	  strTemp = objShell.ExpandEnvironmentStrings("%TEMP%")    Select Case ExportSelect.Value   Case 1    Set objFile = objFSO.CreateTextFile(strTemp & "SoftwareDetails" & strPC & ".csv",True)    objFile.WriteLine "Software Items on " & strPC    objFile.WriteLine ""    objFile.WriteLine "Total: " & intSWCount & " Applications"    objFile.WriteLine ""    objFile.WriteLine "Name,Vendor,Version,Install Date"   Case 2    Const xlContinuous = 1    Const xlThin = 2    Const xlAutomatic = -4105        strExcelPath = objShell.RegRead("HKLMSOFTWAREMicrosoftWindowsCurrentVersionApp Pathsexcel.exe")          If strExcelPath = "" Then     MsgBox "Unable to export. Excel does not appear to be installed.", vbExclamation, "PC Management Utility"     Exit Sub    End If        Set objExcel = CreateObject("Excel.Application")    objExcel.Visible = False    Set objWorkBook = objExcel.WorkBooks.Add    Set objWorksheet = objWorkbook.Worksheets(1)    objExcel.DisplayAlerts = False    For i = 1 to 3     objWorkbook.Worksheets(2).Delete    Next    objExcel.DisplayAlerts = True    objWorksheet.Name = "Software Details"        objWorkSheet.Cells(1, 1) = "Software Items on " & strPC    objWorkSheet.Cells(3, 1) = "Total: " & intSWCount & " Applications"
	    intStartRow = 6        objWorkSheet.Cells(5, 1) = "Name"    objWorkSheet.Cells(5, 2) = "Vendor"    objWorkSheet.Cells(5, 3) = "Version"    objWorkSheet.Cells(5, 4) = "Install Date"   Case 3    Set objFile = objFSO.CreateTextFile(strTemp & "SoftwareDetails" & strPC & ".htm",True)    objFile.WriteLine "<style type=""text/css"">"    objFile.WriteLine "body{background-color:#CEF0FF;}"    objFile.WriteLine "table.export{border-width:1px;border-spacing:1px;border-style:solid;border-color:gray;border-collapse:collapse;}"    objFile.WriteLine "table.export th{border-width:1px;padding:1px;border-style:solid;border-color:gray;padding:2px 7px 2px 7px;}"    objFile.WriteLine "table.export td{border-width:1px;padding:1px;border-style:dotted;border-color:gray;padding:2px 7px 2px 7px;}"    objFile.WriteLine ".backtotop a {font-size:0.9em;}"    objFile.WriteLine "</style>"    objFile.WriteLine "<div style=""font-weight:bold;""><a name =""top"">Software Items on " & strPC & "</a><p>"    objFile.WriteLine "Total: " & intSWCount & " Applications<p></div>"    objFile.WriteLine "<table class=""export"">"    objFile.WriteLine " <tr>"    objFile.WriteLine "  <th style=""text-align:left;"">"    objFile.WriteLine "   Name"    objFile.WriteLine "  </th>"    objFile.WriteLine "  <th>"    objFile.WriteLine "   Google"    objFile.WriteLine "  </th>"    objFile.WriteLine "  <th style=""text-align:left;"">"    objFile.WriteLine "   Vendor"    objFile.WriteLine "  </th>"    objFile.WriteLine "  <th style=""text-align:left;"">"    objFile.WriteLine "   Version"    objFile.WriteLine "  </th>"    objFile.WriteLine "  <th>"    objFile.WriteLine "   Install Date"    objFile.WriteLine "  </th>"    objFile.WriteLine " </tr>"  End Select        DataList.Sort = "SoftwareName"    DataList.MoveFirst  Do Until DataList.EOF   strSoftwareName = DataList.Fields.Item("SoftwareName")   strSoftwareVendor = DataList.Fields.Item("Vendor")   strSoftwareVersion = DataList.Fields.Item("Version")   dtmSoftwareDate = DataList.Fields.Item("InstallDate")   DataList.MoveNext      If strSoftwareName = " " Then strSoftwareName = ""   If strSoftwareVendor = " " Then strSoftwareVendor = ""   If strSoftwareVersion = " " Then strSoftwareVersion = ""   If dtmSoftwareDate = " " Then dtmSoftwareDate = ""      If IsDate(dtmSoftwareDate) Then dtmSoftwareDate = CDate(dtmSoftwareDate)      Select Case ExportSelect.Value    Case 1     strSoftwareName = EncodeCsv(strSoftwareName)     strSoftwareVendor = EncodeCsv(strSoftwareVendor)     strSoftwareVersion = EncodeCsv(strSoftwareVersion)     dtmSoftwareDate = EncodeCsv(dtmSoftwareDate)          strCSV = strCSV & strSoftwareName & "," & _     strSoftwareVendor & "," & strSoftwareVersion & "," & _     dtmSoftwareDate & vbCrLf    Case 2     objWorkSheet.Cells(intStartRow, 1) = strSoftwareName     objWorkSheet.Cells(intStartRow, 2) = strSoftwareVendor     objWorkSheet.Cells(intStartRow, 3) = strSoftwareVersion     objWorkSheet.Cells(intStartRow, 4) = dtmSoftwareDate     intStartRow = intStartRow + 1    Case 3     objFile.WriteLine " <tr>"     objFile.WriteLine "  <td>"     objFile.WriteLine "   " & strSoftwareName     objFile.WriteLine "  </td>"     objFile.WriteLine "  <td>"     objFile.WriteLine "    <a target=_blank href=""http://www.google.com/search?q=" & _      strSoftwareName & """>Search</a>"      objFile.WriteLine "  </td>"     objFile.WriteLine "  <td>"     objFile.WriteLine "   " & strSoftwareVendor     objFile.WriteLine "  </td>"     objFile.WriteLine "  <td>"     objFile.WriteLine "   " & strSoftwareVersion     objFile.WriteLine "  </td>"     objFile.WriteLine "  <td>"     objFile.WriteLine "   " & dtmSoftwareDate     objFile.WriteLine "  </td>"     objFile.WriteLine " </tr>"   End Select  Loop  
	  Select Case ExportSelect.Value   Case 1    objFile.WriteLine strCSV    objFile.Close    Set objFile = Nothing    objShell.Run strTemp & "SoftwareDetails" & strPC & ".csv"   Case 2    Set objRange = objWorkSheet.Range("A1:Z5")    Set objRange2 = objWorkSheet.Range("A5:D" & intStartRow - 1)    Set objRangeH = objWorkSheet.Range("A5:D5")        objRange.Font.Bold = True    objRange2.Borders.LineStyle = xlContinuous    objRange2.Borders.Weight = xlThin    objRange2.Borders.ColorIndex = xlAutomatic    objRangeH.AutoFilter        objWorksheet.Range("A6").Select    objExcel.ActiveWindow.FreezePanes = "True"    objWorksheet.Range("A1").Select        objWorkSheet.Columns("A:ZZ").EntireColumn.AutoFit    objExcel.DisplayAlerts = False    objExcel.ActiveWorkbook.SaveAs(strTemp & "SoftwareDetails" & strPC & ".xls")    objExcel.Visible = True    Set objExcel = Nothing   Case 3    strHTMLTempDir = Replace(LCase(strTemp), "c:", "file:///c:")    strHTMLTempDir = Replace(strHTMLTempDir, "", "/")        objFile.WriteLine "</table>"    objFile.WriteLine "<p class=""backtotop""><a href=""" & strHTMLTempDir & "/SoftwareDetails" & _    strPC & ".htm#top"">[..back to top..]</a></p>"    objFile.Close    Set objFile = Nothing    objShell.Run strTemp & "SoftwareDetails" & strPC & ".htm"   End Select    ExportSelect.Value = 0    document.body.style.cursor = "default" End Sub  '#--------------------------------------------------------------------------    '# SUBROUTINE.....: PauseScript(intPause)    '# PURPOSE........: Pauses the script    '# ARGUMENTS......: intPause = number of milliseconds to pause    '# EXAMPLE........: PauseScript(1000)    '# NOTES..........: Above example will pause script for 1 second    '#-------------------------------------------------------------------------- Sub PauseScript(intPause)  objShell.Run "%COMSPEC% /c ping -w " & intPause & " -n 1 1.0.0.0", 0, True End Sub  '#--------------------------------------------------------------------------    '# SUBROUTINE.....: ResetForm()    '# PURPOSE........: Reset the form    '# ARGUMENTS......:     '# EXAMPLE........:     '# NOTES..........:     '#-------------------------------------------------------------------------- Sub ResetForm()  strPC = ""  txtComputerName.Value = ""  txtComputerName.Disabled = False  btnShowSW.Disabled = False  txtComputerName.className = "text"  btnShowSW.className = "button"  txtComputerName.Title = "Computer Name"  btnShowSW.Title = "Show software list"    BottomBar.className = "hidden"  DataArea.InnerHTML = ""  NumItemsSpan.InnerHTML = ""  txtComputerName.Focus() End Sub
	 '#--------------------------------------------------------------------------    '# SUBROUTINE.....: Window_onLoad()    '# PURPOSE........: Sets Window size    '# ARGUMENTS......:     '# EXAMPLE........:     '# NOTES..........:     '#--------------------------------------------------------------------------  Sub Window_onLoad  self.ResizeTo 1110,775  VersionSpan.InnerHTML = objUninstallUtility.Version End Sub
	 '#-------------------------------------------------------------------------- '#  FUNCTION.......: Reachable(strPC) '#  PURPOSE........: Checks whether the remote PC is online '#  ARGUMENTS......: strPC = PC on which to perform action '#  EXAMPLE........: Reachable(PC1) '#  NOTES..........:   '#-------------------------------------------------------------------------- Function Reachable(strPC)  Set objWMIService2 = GetObject("winmgmts:.rootcimv2")  Set colPing = objWMIService2.ExecQuery _   ("Select * from Win32_PingStatus Where Address = '" & strPC & "'")  For Each objItem in colPing   If IsNull(objItem.StatusCode) Or objItem.Statuscode <> 0 Then    Reachable = False    Else     Reachable = True   End If  Next End Function  '#-------------------------------------------------------------------------- '#  FUNCTION.......: GetSIDFromUser(strUserName) '#  PURPOSE........: Gets the SID

WMI remote access alternative user authenction

Posted: Thu Jun 30, 2011 4:56 am
by jvierra
Yes it will work remotely.
To get hotfixes use the Win32_QuickFixEngineering class.