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