VBScript to Find Installed Applications on Domain Members

Use this to find “TV Media” before installing Service Pack 2 on your network (I wrote this before Microsoft released patches to fix the incompability issue). This same script can be used to find any application that lists itself in the Add/Remove programs. This script requires Windows 2003 Server or Windows XP because it uses WMI ping functions. It will work under Windows 2000 if you remove the ping function and just query the workstation regardless of whether it can be pinged (requests will eventually timeout if the workstation is unavailable).

Script gets list of workstations from the domain. Then pings workstation to see if it is alive. If it is alive, it attempts to search the registry under the Uninstall list for an application name you can specify at the top of the script. Use cscript to run from a cmd prompt otherwise you will get a bunch of popup dialogs for the output. For larger networks, pipe the output to a tsv file and open with Excel so you can sort.

Place all this into a VBS file and run it. Also, this is colorized thanks to gVim for Windows (can't live without it now!).

' Script by Matthew Jenkins (mattjenkins@mljenkins.com)
' Written on September 20, 2004
'
' Set what application name you want to find here
sApplication = "TV Media"

'
' Ignore errors (we get these if permissions is denied while querying a computer)
On Error Resume Next

' Get computers from network
Set objWMIService = GetObject("winmgmts:root\directory\ldap")
Set colItems = objWMIService.ExecQuery("Select ds_cn, ds_location From ds_computer")

' Enumerate computers in network
For Each oComputer in colItems
        sComputer = oComputer.ds_cn

        ' See if computer is available (returns ping) and if so then query for the application, otherwise return DISCONNECTED
        If(bIsAlive(sComputer) = true) Then
                iResult = iFindApp(sComputer, sApplication)
                If(iResult = 1) Then
                        sInstalled = "INSTALLED"
                ElseIf(iResult = 2) Then
                        sInstalled = "not installed"
                ElseIf(iResult = 3) Then
                        sInstalled = "unable to query"
                End If

        Else
                sInstalled = "disconnected"
        End If

        WScript.Echo sComputer & vbTab & vbTab & sInstalled
Next

' *******************************************************************
' Pass in a computername and application to search for
' Returns 1 on installed, 2 if not installed, 3 if the client cannot be searched (permissions errors, ...)
Function iFindApp(sTargetHost, sApplication)
        On Error Resume Next

        ' Initialize some variables first
        iFindApp = 2
        sProgramName = ""
        sProgramVersion = ""
        sKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\"       ' key containing uninstall info

        ' Attempt to connect to client's registry
        Const HKLM = &H80000002 'HKEY_LOCAL_MACHINE
        Set oReg = GetObject("winmgmts:\\" & sTargetHost & "\root\default:StdRegProv")

        ' Ensure we connected ok to the client, if not just return false, it's probably not a valid Windows box
        If Err.Number <> 0 Then
                iFindApp = 3
                Exit Function
        End If

        ' Enumerate client registry looking for application
        oReg.EnumKey HKLM, sKeyPath, arrSubKeys ' get installed programs' subkeys
        For Each subKey In arrSubKeys ' get info from each installed program subkey
                ' attempt to get DisplayName
                If(oReg.GetStringValue(HKLM, sKeyPath & subKey, "DisplayName", sProgramName) <> 0) Then
                        ' if no DisplayName try for QuietDisplayName
                        oReg.GetStringValue HKLM, sKeyPath & subKey, "QuietDisplayName", sProgramName
                End If

                ' attempt to get DisplayVersion
                If(oReg.GetStringValue(HKLM, sKeyPath & subKey, "DisplayVersion", sProgramVersion) <> 0) Then
                        ' if no DisplayName try for QuietDisplayName
                        oReg.GetDWORDValue HKLM, sKeyPath & subKey, "VersionMajor", sProgramVersion
                End If

                ' If the name exists, return true
                If sProgramName = sApplication Then
                        iFindApp = 1
                        Exit Function
                End If
        Next
End Function


' *******************************************************************
' Pass in host to ping
' Returns true if ping successful, false if ping unsuccessful
Function bIsAlive(sTargetHost)
        sSourceHost     = "."                           ' computer that will send ping requests, normally the local computer
        bIsAlive = False                                ' normally we will return false, unless ping is successful

        Set objWMIService = GetObject("winmgmts:\\" & sSourceHost & "\root\cimv2")
        Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_PingStatus WHERE Address = '" + sTargetHost + "'")

        For Each oRow In colItems
                If oRow.StatusCode = 0 Then
                        bIsAlive = True
                End If
        Next
End Function

Return to Main