WMI remote access alternative user authenction

Batch, ASP, JScript, Kixtart, etc.
Forum rules
Do not post any licensing information in this forum.

Any code longer than three lines should be added as code using the 'Select Code' dropdown menu or attached as a file.
This topic is 12 years and 8 months old and has exceeded the time allowed for comments. Please begin a new topic or use the search feature to find a similar but newer topic.
Locked
User avatar
w216uhk
Posts: 34
Last visit: Wed Jul 16, 2014 7:33 am

WMI remote access alternative user authenction

Post 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
jvierra
Posts: 15439
Last visit: Tue Nov 21, 2023 6:37 pm
Answers: 30
Has voted: 4 times
Been upvoted: 33 times

WMI remote access alternative user authenction

Post by jvierra »

Yes it will work remotely.
To get hotfixes use the Win32_QuickFixEngineering class.
This topic is 12 years and 8 months old and has exceeded the time allowed for comments. Please begin a new topic or use the search feature to find a similar but newer topic.
Locked