Link to home
Start Free TrialLog in
Avatar of danlein
danleinFlag for United States of America

asked on

Need to enumerate applications from the registry then separate them via vbscript

Hey all,

I have gotten some script down but need to finish it off.  What it needs to do is pull subkeys and values from the uninstall key of the registry.  That part is done.  

The part I need to complete is having the version numbers reference an If statement (If it is less than x but greater than y, write this line) and I need to have the script query certain values at  the top of the result file.  

I have attached the existing code below as well as what the result should look like along with the 2 values that need to be at the top.  

Thanks! 
const HKEY_CLASSES_ROOT  = &H80000000
const HKEY_CURRENT_USER  = &H80000001
const HKEY_LOCAL_MACHINE = &H80000002
const HKEY_USERS     = &H80000003
const HKEY_CURRENT_CONFIG = &H80000004
const HKEY_DYN_DATA    = &H80000005
Dim fso, OutMsg1, OutMsg, strData
Dim sp2
Dim DisplayVerSP1, DisplayVerSP2


strComputer = "."

set oWsh = createobject("wscript.shell")

Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" _ 
     & strComputer & "\root\default:StdRegProv")
     
Set fso = CreateObject("Scripting.FileSystemObject")
Set objTextFile = fso.OpenTextFile("results.txt", 2, True)     
sp2 = "12.0.6000"


strKeyPath = "software\microsoft\windows\currentversion\uninstall" 
' Root level
oReg.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrSubKeys
objTextFile.WriteLine "Usual Installed Office Applications" & vbTab &  "SP1 or SP2" & vbTab & _
"Version Number" & vbTab & "Product Name" & vbNewLine
sMatch = "Offic"

For Each subkey In arrSubKeys
 on Error resume Next
 sDisplayName = oWsh.Regread("HKLM\" & strKeyPath & "\" & subkey & "\DisplayName")
 if err.number = 0 Then 
  on error goto 0
  if instr(sDisplayName, sMatch) > 0 Then
   On Error Resume Next
  sDisplayVersion = oWsh.Regread("HKLM\" & strKeyPath & "\" & subkey & "\DisplayVersion")
     If Err.Number = 0 Then  
'Results    
If sDisplayVersion < sp2 Then
DisplayVerSP1 = "  "
Else
DisplayVerSP1 = "SP2"
End If
	
	objTextFile.WriteLine subkey & vbTab & "   " & DisplayVerSP1 & vbTab & sDisplayVersion & vbTab & sDisplayName 
	
	End If

   On Error GoTo 0
  end If
 end If
Next
on error goto 0

'Message Box for Results
OutMsg1 = MsgBox("Would you like to open the text file?", vbYesNo, "Product ID Output")

If OutMsg1 = vbYes Then
	oWsh.Run("notepad " & "results.txt")
End If

If OutMsg1 = vbNo Then
	OutMsg2 = MsgBox("The results are located in the same directory as this script", 64, "Product ID Output")
End If

Open in new window

'These are some of the values that need to be at the top of the list
"{90120000-0011-0000-0000-0000000FF1CE"},_
"{90120000-0015-0409-0000-0000000FF1CE"},_
"{90120000-0016-0409-0000-0000000FF1CE"}_


'Variables for If Statements
sp2 = "12.0.6400"
sp1 = "12.0.6300"

'Originally I had this, but needs to change to reflect all items below 6300 as well
If sDisplayVersion < sp2 Then
DisplayVerSP1 = "SP1"
Else
If sDisplayVersion < sp1 Then
DisplayVerSP1 = "SP2"
End If

'This is what the end result should look like

Usual Installed Office Applications	SP1 or SP2	Version Number	Product Name

{388E4B09-3E71-4649-8921-F44A3A2954A7}	   SP2		8.0.60940.0	Microsoft Visual Studio 2005 Tools for Office Runtime
{8FB53850-246A-3507-8ADE-0060093FFEA6}	   SP2		9.0.30729	Visual Studio Tools for the Office system 3.0 Runtime
{90120000-0015-0409-0000-0000000FF1CE}	   SP2		12.0.6425.1000	Microsoft Office Access MUI (English) 2007

Updated Installed Office Applications	SP1 or SP2	Version Number	Product Name

{388E4B09-3E71-4649-8921-F44A3A2954A7}	   SP2		8.0.60940.0	Microsoft Visual Studio 2005 Tools for Office Runtime
{8FB53850-246A-3507-8ADE-0060093FFEA6}	   SP2		9.0.30729	Visual Studio Tools for the Office system 3.0 Runtime
{90120000-0015-0409-0000-0000000FF1CE}	   SP2		12.0.6425.1000	Microsoft Office Access MUI (English) 2007

Open in new window

Avatar of RobSampson
RobSampson
Flag of Australia image
Hi, wouldn't you do:
If sDisplayVersion <= sp1 Then
DisplayVerSP1 = "SP1"
ElseIf sDisplayVersion >= sp2 Then
DisplayVerSP1 = "SP2"
End If

Open in new window


Rob.
Avatar of danlein
danlein
Flag of United States of America image

ASKER

There are 3 values that need to be found. Origina, SP1 and SP2
Avatar of RobSampson
RobSampson
Flag of Australia image
Maybe something like this?

Rob.
const HKEY_CLASSES_ROOT  = &H80000000
const HKEY_CURRENT_USER  = &H80000001
const HKEY_LOCAL_MACHINE = &H80000002
const HKEY_USERS     = &H80000003
const HKEY_CURRENT_CONFIG = &H80000004
const HKEY_DYN_DATA    = &H80000005
Dim fso, OutMsg1, OutMsg, strData
Dim DisplayVer


strComputer = "."

set oWsh = createobject("wscript.shell")

Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" _ 
     & strComputer & "\root\default:StdRegProv")
     
Set fso = CreateObject("Scripting.FileSystemObject")
Set objTextFile = fso.OpenTextFile("results.txt", 2, True)

strKeyPath = "software\microsoft\windows\currentversion\uninstall" 
' Root level
oReg.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrSubKeys
objTextFile.WriteLine "Usual Installed Office Applications" & vbTab &  "SP Level" & vbTab & _
"Version Number" & vbTab & "Product Name" & vbNewLine
sMatch = "Offic"

For Each subkey In arrSubKeys
	On Error resume Next
	sDisplayName = oWsh.Regread("HKLM\" & strKeyPath & "\" & subkey & "\DisplayName")
	If err.number = 0 Then 
		On error goto 0
		If instr(sDisplayName, sMatch) > 0 Then
			On Error Resume Next
			sDisplayVersion = oWsh.Regread("HKLM\" & strKeyPath & "\" & subkey & "\DisplayVersion")
			If Err.Number = 0 Then  
				'Results    
				If sDisplayVersion < "12.0.6300" Then
					DisplayVer = "None"
				ElseIf sDisplayVersion <= "12.0.6400" Then
					DisplayVer = "SP1"
				ElseIf sDisplayVersion > "12.0.6400" Then
					DisplayVer = "SP2"
				End If
				objTextFile.WriteLine subkey & vbTab & DisplayVer & vbTab & sDisplayVersion & vbTab & sDisplayName 
			End If
			On Error GoTo 0
		End If
	End If
	Err.Clear
Next
on error goto 0

'Message Box for Results
OutMsg1 = MsgBox("Would you like to open the text file?", vbYesNo, "Product ID Output")

If OutMsg1 = vbYes Then
	oWsh.Run("notepad " & "results.txt")
End If

If OutMsg1 = vbNo Then
	OutMsg2 = MsgBox("The results are located in the same directory as this script", 64, "Product ID Output")
End If

Open in new window

Avatar of danlein
danlein
Flag of United States of America image

ASKER

K.  That scratches the first part.  I'll work on the values, but that's my issue.  
Next part is what was scratching my head over a bit was how to separate them.  I have a list of subkeys that need to be enumerated at the top.
I'd assume run it separately, but can't quite get it out right.  Basically, given a few keys, such as these:

{90120000-0011-0000-0000-0000000FF1CE},
{90120000-0015-0409-0000-0000000FF1CE},
{90120000-0016-0409-0000-0000000FF1CE}

These need to be searched for first and put in the file at the top of the list as shown below, followed by the remaining keys

Usual Installed Office Applications                           SP1 or SP2           Version Number      Product Name

{90120000-0011-0000-0000-0000000FF1CE}         None            8.0.60940.0      Microsoft Visual Studio 2005 Tools for Office Runtime
{90120000-0015-0409-0000-0000000FF1CE}         None            9.0.30729      Visual Studio Tools for the Office system 3.0 Runtime
{90120000-0016-0409-0000-0000000FF1CE}         SP2            12.0.6425.1000      Microsoft Office Access MUI (English) 2007

Updated Installed Office Applications                   SP1 or SP2           Version Number      Product Name

{388E4B09-3E71-4649-8921-F44A3A2954A7}         None            8.0.60940.0      Microsoft Visual Studio 2005 Tools for Office Runtime
{8FB53850-246A-3507-8ADE-0060093FFEA6}        None            9.0.30729      Visual Studio Tools for the Office system 3.0 Runtime
{90120000-0015-0409-0000-0000000FF1CE}         SP2            12.0.6425.1000      Microsoft Office Access MUI (English) 2007


Let me know if I can provide further information.  Also, those keys are not what the products really are, just an example

Avatar of RobSampson
RobSampson
Flag of Australia image
OK, try it this way.

What I've done is use two dictionary objects, one for the top items you need, and one for the rest.  The subkeys you put in the top will have the relevant data added to those dictionary keys, and the rest will be added to the other dictionary.  After all of the registry keys have been enumerated, the "top" dictionary will be output first, followed by the "therest" dictionary.

Regards,

Rob.
const HKEY_CLASSES_ROOT  = &H80000000
const HKEY_CURRENT_USER  = &H80000001
const HKEY_LOCAL_MACHINE = &H80000002
const HKEY_USERS     = &H80000003
const HKEY_CURRENT_CONFIG = &H80000004
const HKEY_DYN_DATA    = &H80000005
Dim fso, OutMsg1, OutMsg, strData
Dim DisplayVer


strComputer = "."

Set dctTop = CreateObject("Scripting.Dictionary")
dctTop.Add "{90120000-0115-0409-0000-0000000FF1CE}", ""
dctTop.Add "{90120000-001A-0409-0000-0000000FF1CE}", ""
dctTop.Add "{90120000-001F-0409-0000-0000000FF1CE}", ""

Set dctTheRest = CreateObject("Scripting.Dictionary")

set oWsh = createobject("wscript.shell")

Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" _ 
     & strComputer & "\root\default:StdRegProv")
     
Set fso = CreateObject("Scripting.FileSystemObject")
Set objTextFile = fso.OpenTextFile("results.txt", 2, True)

strKeyPath = "software\microsoft\windows\currentversion\uninstall" 
' Root level
oReg.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrSubKeys
objTextFile.WriteLine "Usual Installed Office Applications" & vbTab &  "SP Level" & vbTab & _
"Version Number" & vbTab & "Product Name" & vbNewLine
sMatch = "Offic"

For Each subkey In arrSubKeys
	On Error resume Next
	sDisplayName = oWsh.Regread("HKLM\" & strKeyPath & "\" & subkey & "\DisplayName")
	If err.number = 0 Then 
		On error goto 0
		If instr(sDisplayName, sMatch) > 0 Then
			On Error Resume Next
			sDisplayVersion = oWsh.Regread("HKLM\" & strKeyPath & "\" & subkey & "\DisplayVersion")
			If Err.Number = 0 Then  
				'Results    
				If sDisplayVersion < "12.0.6300" Then
					DisplayVer = "None"
				ElseIf sDisplayVersion <= "12.0.6400" Then
					DisplayVer = "SP1"
				ElseIf sDisplayVersion > "12.0.6400" Then
					DisplayVer = "SP2"
				End If
				If dctTop.Exists(subkey) = True Then
					dctTop(subkey) = vbTab & DisplayVer & vbTab & sDisplayVersion & vbTab & sDisplayName
				Else
					dctTheRest.Add subkey, vbTab & DisplayVer & vbTab & sDisplayVersion & vbTab & sDisplayName
				End If
			End If
			On Error GoTo 0
		End If
	End If
	Err.Clear
Next
on error goto 0

For Each subkey In dctTop
	objTextFile.WriteLine subkey & dctTop(subkey)
Next
For Each subkey In dctTheRest
	objTextFile.WriteLine subkey & dctTheRest(subkey)
Next

'Message Box for Results
OutMsg1 = MsgBox("Would you like to open the text file?", vbYesNo, "Product ID Output")

If OutMsg1 = vbYes Then
	oWsh.Run("notepad " & "results.txt")
End If

If OutMsg1 = vbNo Then
	OutMsg2 = MsgBox("The results are located in the same directory as this script", 64, "Product ID Output")
End If

Open in new window

Avatar of danlein
danlein
Flag of United States of America image

ASKER

Looks good so far.. Still needs to be separated be a space and another title line.

What we have currently is:

Title1
Data1
Data2
------------------
What it should look like, and please see previous post, or just duplicate code and I will edit the language is:

Title 1
Data1

Title 2
Data 2
------------------

Thanks!
ASKER CERTIFIED SOLUTION
Avatar of RobSampson
RobSampson
Flag of Australia image
Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of danlein
danlein
Flag of United States of America image

ASKER

K.  Looks damn good.  Now one last thing, and only because I know it may be an issue.  In the dictionary (I didn't think about doing it this way), if the key doesn't exist, can we have it return some text, under say, sDisplayName, that the product is not installed, or "Not Installed"
Avatar of RobSampson
RobSampson
Flag of Australia image
Yes, if you're talking about the ones in the dctTop, you just need to test for cases where the rest of the data hasn't been added to that item.

Change
For Each subkey In dctTop
	objTextFile.WriteLine subkey & dctTop(subkey)
Next

Open in new window


to this
For Each subkey In dctTop
	If dctTop(subkey) <> "" Then
		objTextFile.WriteLine subkey & dctTop(subkey)
	Else
		objTextFile.WriteLine subkey & vbTab & "Not Installated"
	End If
Next

Open in new window


Regards,

Rob.
Avatar of danlein
danlein
Flag of United States of America image

ASKER

Thank you sir.  Works as I need for now.   Much appreciated.
Avatar of RobSampson
RobSampson
Flag of Australia image
No problem. Thanks for the grade.

Regards,

Rob.