Option Explicit Const HKEY_LOCAL_MACHINE = &H80000002 Dim arrSubKeys Dim bln64bit, blnFilter, blnRegEx, blnTab Dim i, int32bit, int64bit, intFound, intValid Dim colItems, colPings, objItem, objRE, objReg, objStatus, objWMIService Dim strComputer, strDateZZZ, strFilter, strHive, strKeyZZZ, strKeyPath Dim strMsg, strNameZZZ, strPrgZZZ, strQuery, strQuietUnstZZZ, strUninstallZZZ, strVersionZZZ bln64bit = False blnFilter = False blnRegEx = False int32bit = 0 int64bit = 0 strHive = HKEY_LOCAL_MACHINE strMsg = "" With WScript.Arguments If .Unnamed.Count > 0 Then Syntax intValid = 0 If .Named.Exists( "F" ) Then strFilter = .Named.Item( "F" ) If strFilter = "" Then Syntax intValid = intValid + 1 blnFilter = True If .Named.Exists( "R" ) Then intValid = intValid + 1 blnRegEx = True Set objRE = New RegExp End If End If If .Named.Exists( "M" ) Then intValid = intValid + 1 strComputer = Trim( .Named.Item( "M" ) ) If strComputer = "" Then Syntax Else strComputer = "." End If If .Named.Exists( "T" ) Then intValid = intValid + 1 blnTab = True Else blnTab = False End If If .Named.Count <> intValid Then Syntax End With ' Use custom error handling, just in case the remote computer ' won't respond or this script runs on a Windows 2000 computer On Error Resume Next Set objWMIService = GetObject( "winmgmts://./root/cimv2" ) Set colItems = objWMIService.ExecQuery( "SELECT * FROM Win32_Processor", , 48 ) For Each objItem in colItems If objItem.AddressWidth = 64 Then bln64bit = True End If Next If strComputer <> "." Then strQuery = "SELECT * FROM Win32_PingStatus WHERE Address='" & strComputer & "'" Set colPings = objWMIService.ExecQuery( strQuery ) For Each objStatus in colPings If IsNull( objStatus.StatusCode ) Or objStatus.StatusCode <> 0 Then strMsg = "Computer " & strComputer & " did not respond." & vbCrLf Syntax End If Next Set colPings = Nothing Set objWMIService = Nothing End If Set objReg = GetObject( "winmgmts:{impersonationLevel=impersonate}!//" & strComputer & "/root/default:StdRegProv" ) If Err Then If strComputer = "." Then strMsg = "Error connecting to the local WMI Standard Registry Provider." & vbCrLf Else strMsg = "Error connecting to " & strComputer & "'s WMI StdReg Provider." & vbCrLf End If Syntax End If On Error Goto 0 If blnTab Then strMsg = """Program Name""" & vbTab & """Program Version""" & vbTab & """Install Date""" & vbTab & """Unique Identifier""" & vbTab & """Uninstall String""" & vbCrLf End If ' This is where uninstall info for 32-bit apps is stored in 32-bit ' Windows, or uninstall info for 64-bit apps in 64-bit Windows strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall" intFound = 0 strMsg = strMsg & ListApps( strHive, strKeyPath ) ' 64-bit check, added after a tip by Christopher A. LaRue If bln64bit Then ' This is where uninstall info for 32-bit apps is stored in 64-bit Windows strKeyPath = "SOFTWARE\Wow6432Node\Microsoft\Windows\CurrentVersion\Uninstall" int64bit = intFound intFound = 0 strMsg = strMsg & ListApps( strHive, strKeyPath ) int32bit = intFound strMsg = strMsg & vbCrLf & " " & int64bit & " 64-bit programs and " & int32bit & " 32-bit programs found" Else strMsg = strMsg & vbCrLf & " " & intFound & " programs found" End If WScript.Echo strMsg Set objReg = Nothing Set objRE = Nothing Function ListApps( myHive, myKeyPath ) Dim arrSubKeys Dim strDate, strKey, strName, strPrg, strQuietUnst, strUninstall, strVersion ListApps = "" objReg.EnumKey myHive, myKeyPath, arrSubKeys If UBound( arrSubKeys ) > -1 Then intFound = UBound( arrSubKeys ) + 1 For i = 0 To UBound( arrSubKeys ) strDate = "" strName = "" strQuietUnst = "" strUninstall = "" strVersion = "" strKey = myKeyPath & "\" & arrSubKeys(i) objReg.GetStringValue myHive, strKey, "DisplayName", strName objReg.GetStringValue myHive, strKey, "DisplayVersion", strVersion objReg.GetStringValue myHive, strKey, "InstallDate", strDate objReg.GetExpandedStringValue myHive, strKey, "UninstallString", strUninstall objReg.GetExpandedStringValue myHive, strKey, "QuietUninstallString", strQuietUnst If Trim( strQuietUnst ) <> "" Then strUninstall = strQuietUnst If blnTab Then strPrg = """" & strName & """" & vbTab _ & """" & strVersion & """" & vbTab _ & """" & strDate & """" & vbTab _ & """" & arrSubKeys(i) & """" & vbTab _ & """" & strUninstall & """" & vbCrLf Else strPrg = "Program Name = " & strName & vbCrLf _ & "Program Version = " & strVersion & vbCrLf _ & "Install Date = " & strDate & vbCrLf _ & "Unique Identifier = " & arrSubKeys(i) & vbCrLf _ & "Uninstall String = " & strUninstall & vbCrLf & vbCrLf End If If Trim( strName ) <> "" Then If blnFilter Then If blnRegEx Then objRE.Global = False objRE.IgnoreCase = True objRE.Pattern = strFilter If objRE.Test( strName ) Then ListApps = ListApps & strPrg End If Else If InStr( 1, strName, strFilter, vbTextCompare ) Then ListApps = ListApps & strPrg End If End If Else ListApps = ListApps & strPrg End If End If Next End If End Function Sub Syntax strMsg = strMsg & vbCrLf _ & UCase( WScript.ScriptName ) & ", Version 3.01" _ & vbCrLf _ & "List or search uninstall command lines" _ & vbCrLf & vbCrLf _ & "Usage: CSCRIPT.EXE //NoLogo " & UCase( WScript.ScriptName ) _ & " [/M:""computer""] [/F:""filter"" [/R]] [/T]" _ & vbCrLf & vbCrLf _ & "Where: /M:""computer"" specifies a remote computer to be queried" _ & vbCrLf _ & " (default is the local computer)" _ & vbCrLf _ & " /F:""filter"" narrows down the search result to programs whose" _ & vbCrLf _ & " descriptive name contains the string ""filter""" _ & vbCrLf _ & " /R interprets the filter string as a regular expression" _ & vbCrLf _ & " /T displays tab delimited results (default: list)" _ & vbCrLf & vbCrLf _ & "Written by Rob van der Woude" _ & vbCrLf _ & "http://www.robvanderwoude.com" WScript.Echo strMsg WScript.Quit 1 End Sub