Go Premium for a chance to win a PS4. Enter to Win

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 1557
  • Last Modified:

A script to check if a specific program is installed

Hi,

I have a script (from Rob Sampson) that checks for all installed programs in Add/Remove programs. I would like to have a script that checks for just on specific program (in this case Update for Windows XP (KB943729)). I have tried numerous powershell and VB scripts, but none were indicating the presence of the KB, except for Rob's script, which outputs all installed apps to an excel file.

It's the script at the bottom here:
http://www.experts-exchange.com/Programming/Languages/Q_23619694.html?sfQueryTermInfo=1+applic+check+instal+rob+script

Any help on this would be appreciated.
0
sherryfitzgroup
Asked:
sherryfitzgroup
  • 3
  • 2
1 Solution
 
RobSampsonCommented:
Hi, I have taken the relevant registry searching part out of my code for you to use here.

You should only need to change:
strComputer = "."
strAppToFind = "KB943729"

to suit.

Regards,

Rob.
Const HKEY_LOCAL_MACHINE = &H80000002
strKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall"
strComputer = "."
strAppToFind = "KB943729"
Set objRegistry = GetObject("winmgmts:"   & _
	"{impersonationLevel=Impersonate}!\\" & _
	strComputer & "\root\default:StdRegProv")
 
objRegistry.EnumKey HKEY_LOCAL_MACHINE, strKey, arrSubKeys
 
strFoundApp = ""
On Error Resume Next
For Each strSubKey In arrSubKeys
	objRegistry.GetStringValue HKEY_LOCAL_MACHINE, strKey & "\" & strSubKey, "DisplayName", strDisplayName
	objRegistry.GetStringValue HKEY_LOCAL_MACHINE, strKey & "\" & strSubKey, "DisplayVersion", strDisplayVersion
	objRegistry.GetStringValue HKEY_LOCAL_MACHINE, strKey & "\" & strSubKey, "InstallLocation", strInstallLocation
	
	If InStr(LCase(strDisplayName), LCase(strAppToFind)) > 0 Then strFoundApp = strDisplayName
	
	strDisplayName = vbEmpty
	strDisplayVersion = vbEmpty
	strInstallLocation = vbEmpty
Next
 
If strFoundApp = "" Then
	MsgBox "Could not find " & strAppToFind & " on " & strComputer
Else
	MsgBox "Found" & VbCrLf & strFoundApp & VbCrLf & "on " & strComputer
End If

Open in new window

0
 
sherryfitzgroupAuthor Commented:
Thanks for the quick reply Rob. It correctly detected the KB on my PC. How would I get it to check all computers in a txt file?
0
 
RobSampsonCommented:
Try this.....it will now take input from a "Computers.txt" text file, ping those computers, read their registry, and output the results of the search to a CSV file.

Regards,

Rob.
strInputFile = "Computers.txt"
strOutputFile = "Results.csv"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Const intForReading = 1
Const HKEY_LOCAL_MACHINE = &H80000002
strKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall"
strAppToFind = "KB943729"
 
strResults = """Computer"",""Searched For"",""Found"""
Set objFile = objFSO.OpenTextFile(strInputFile, intForReading, False)
While Not objFile.AtEndOfStream
	strComputer = objFile.ReadLine
	If Ping(strComputer) = True Then
		On Error Resume Next
		Set objRegistry = GetObject("winmgmts:"   & _
			"{impersonationLevel=Impersonate}!\\" & _
			strComputer & "\root\default:StdRegProv")
		
		If Err.Number = 0 Then
			On Error GoTo 0
			objRegistry.EnumKey HKEY_LOCAL_MACHINE, strKey, arrSubKeys
			 
			strFoundApp = ""
			On Error Resume Next
			For Each strSubKey In arrSubKeys
				objRegistry.GetStringValue HKEY_LOCAL_MACHINE, strKey & "\" & strSubKey, "DisplayName", strDisplayName
				objRegistry.GetStringValue HKEY_LOCAL_MACHINE, strKey & "\" & strSubKey, "DisplayVersion", strDisplayVersion
				objRegistry.GetStringValue HKEY_LOCAL_MACHINE, strKey & "\" & strSubKey, "InstallLocation", strInstallLocation
				
				If InStr(LCase(strDisplayName), LCase(strAppToFind)) > 0 Then strFoundApp = strDisplayName
				
				strDisplayName = vbEmpty
				strDisplayVersion = vbEmpty
				strInstallLocation = vbEmpty
			Next
			
			'If strFoundApp = "" Then
			'	MsgBox "Could not find " & strAppToFind & " on " & strComputer
			'Else
			'	MsgBox "Found" & VbCrLf & strFoundApp & VbCrLf & "on " & strComputer
			'End If
			strResults = strResults & VbCrLf & """" & strComputer & """,""" & strAppToFind & """,""" & strFoundApp & """"
		Else
			Err.Clear
			On Error GoTo 0
			strResults = strResults & VbCrLf & """" & strComputer & """,""" & strAppToFind & """,""FAILED TO CONNECT"""
		End If
	Else
		strResults = strResults & VbCrLf & """" & strComputer & """,""" & strAppToFind & """,""FAILED TO PING"""
	End If
Wend
objFile.Close
Set objFile = Nothing
 
Set objOutputFile = objFSO.CreateTextFile(strOutputFile, True)
objOutputFile.Write strResults
objOutputFile.Close
Set objOutputFile = Nothing
 
MsgBox "Done. Please see " & strOutputFile
 
Function Ping(strComputer)
	Dim objShell, boolCode
	Set objShell = CreateObject("WScript.Shell")
	boolCode = objShell.Run("Ping -n 1 -w 300 " & strComputer, 0, True)
	If boolCode = 0 Then
		Ping = True
	Else
		Ping = False
	End If
End Function

Open in new window

0
 
sherryfitzgroupAuthor Commented:
A1 Rob, you the man.
0
 
RobSampsonCommented:
Thanks for the grade.

Regards,

Rob.
0

Featured Post

Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

  • 3
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now