Wednesday, December 19, 2007

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


'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
objFile2.WriteLine strComputer & "," & Reachable(strComputer) & ",N/A"
End If

Set objFile = 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
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
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 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 Function


Mon said...

This is very helpful stuff. Most especially if you're a SMS administrator and you're pushing an application to thousands of machines (I don't rely much on status reports, they fail sometimes) Use this stuff and it'll return the reports/status that you need.

Thanks for creating this script sir Edwin! God bless and more power!

bassplayer said...

I was challenged by your requirement. Like I said, feel free to suggest what topics you would like to see in the posts