Check if an application is installed on workstations

Last week, a friend of mine asked me if there is a way to determine if an application is installed in a workstation. He was planning to deploy IBM Lotus Sametime Connect on their network but didn't know which workstations already have it. I already have a script which audits a workstation's hardware and software so I was thinking of using this ith a little modification. He has a list of workstations in their network and he wants to use this as a reference. Here's a script which reads the text file computerList.txt containing the hostnames of workstations in your network, tries to run a PING test to see if the workstation is reachable and, if it is, runs the script to check if the application is installed. All of these generates a result which is written to a text file in CSV format so that anybody can open it in Excel to generate reports. Management loves Excel.

One thing to note is that you can change the application name to anything you wish provided you know the complete application name as stored in your Add/Remove Programs or the registry. If you want to read the hostnames from your Active Directory infrastructure, check out the script written by Matthew Jenkins (I actually validated my script against his as it is always good to have your work checked). So Raymond, this post is for you. You no longer have to go thru all 2000+ workstations in your network

Dim loopCount, directory, objFSO,objFile,objFSO2,objFile2


'Gets the directory where our script is running from
directory = CreateObject("Scripting.FileSystemObject").GetParentFolderName(Wscript.ScriptFullName)





Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(directory & "\computerList.txt", 1)





'===LOG of servers with successful PING
strFilePath = directory & "\Results.csv"
Set objFSO2 = CreateObject("Scripting.FileSystemObject")
' Open the file for write access.
On Error Resume Next
Set objFile2 = objFSO2.OpenTextFile(strFilePath, 2, True, 0)
If (Err.Number <> 0) Then
On Error GoTo 0
Wscript.Echo "File " & strFilePath & " cannot be opened"
Set objFSO2 = Nothing
End If
On Error GoTo 0





'Write HEADER
objFile2.WriteLine "SERVER,PING STATUS, SOFTWARE INSTALLED"


'variable to search for a specified application
strApp="IBM Lotus Sametime Connect"


Do Until objFile.AtEndOfStream
strComputer = objFile.ReadLine
If Reachable(strComputer)="Success" Then
intResult = SearchApp(strComputer, strApp)
If(intResult = 1) Then
strInstalled = "INSTALLED"
ElseIf(intResult = 2) Then
strInstalled = "NONE"
ElseIf(intResult = 3) Then
strInstalled = "UNABLE TO QUERY"
End If


objFile2.WriteLine strComputer & ",SUCCESS," & strInstalled
Else
objFile2.WriteLine strComputer & "," & Reachable(strComputer) & ",N/A"
End If
Loop



objFile.Close
Set objFSO =NOTHING
Set objFile = NOTHING


objFile2.Close
Set objFSO2 =NOTHING
Set objFile2 = NOTHING


MSGBOX "Finished"





'===================================
' Function SearchApp(strComputer, sApplication)
On Error Resume Next


' Initialize some variables first
SearchApp = 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:\\" & strComputer & "\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
SearchApp = 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
SearchApp = 1
Exit Function
End If
Next
End Function


'===================
Function Reachable(strComputername)


Dim wmiQuery, objWMIService, objPing, objStatus


wmiQuery = "Select * From Win32_PingStatus Where Address = '" & strComputer & "'"


Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
Set objPing = objWMIService.ExecQuery(wmiQuery)


For Each objStatus in objPing


SELECT CASE objStatus.StatusCode
CASE 0
Reachable="Success"
CASE 11001
Reachable="Buffer Too Small"
CASE 11002
Reachable="Destination Net Unreachable"
CASE 11003
Reachable="Destination Host Unreachable"
CASE 11004
Reachable="Destination Protocol Unreachable"
CASE 11005
Reachable="Destination Port Unreachable"
CASE 11006
Reachable="No Resources"
CASE 11007
Reachable="Bad Option"
CASE 11008
Reachable="Hardware Error"
CASE 11009
Reachable="Packet Too Big"
CASE 11010
Reachable="Request Timed Out"
CASE 11011
Reachable="Bad Request"
CASE 11012
Reachable="Bad Route"
CASE 11013
Reachable="TimeToLive Expired Transit"
CASE 11014
Reachable="TimeToLive Expired Reassembly"
CASE 11015
Reachable="Parameter Problem"
CASE 11016
Reachable="Source Quench"
CASE 11017
Reachable="Option Too Big"
CASE 11018
Reachable="Bad Destination"
CASE 11032
Reachable="Negotiating IPSEC"
CASE 11050
Reachable="General Failure"
END SELECT
Next
End Function