Solved

VBScript Required. Script to query registry on all PCs in Domain and report back all installed software.

Posted on 2009-05-06
13
1,596 Views
Last Modified: 2012-05-06
Hello Experts,

Iam in urgent need of a VBScript that can query registry on all computers in the domain and then report back the following in a .csv or which ever is the best way to record such large amount of data. If we can also include the ability to choose the OUs as an option that would be great.

I am looking at other scripts from Rob but it looks like it doesnt suit my requirements..

example. "Domain Inventory.csv"

Column1              Column2
Computer name: %name%
Logged user: %username%
Installed Apps: %Apps%

Happy to provide more info.
0
Comment
Question by:vithal_m
  • 8
  • 5
13 Comments
 
LVL 12

Expert Comment

by:zoofan
ID: 24321408
I wrote this one about a year ago, does do what you need?

grabs all apps listed in uninstall key from the registry(basically everything in add/remove)
is feed from a txt file list of pc names.
and outputs to a csv file.

http://www.experts-exchange.com/OS/Microsoft_Operating_Systems/Q_22735065.html




zf
0
 
LVL 12

Expert Comment

by:zoofan
ID: 24321410
The code.





zf
'===Start copy: getapps.vbs===

' ---------------------------------------------------------------'

' getappversions.vbs

' 'Sample VBScript to query remote computers

' 'and return versions for word and excel.

' ''Author Riley C. aka ZooFan

' '''Version 2.9 - August 2007

' ''''www.experts-exchange.com question ID: 22735065

' ---------------------------------------------------------------'

'

Option Explicit

Const ForReading = 1, ForWriting = 2, ForAppending = 3 'FileObject Access Type

Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0 'FileObject Format Type

Dim objFso

Dim objWshshell

Dim objOutputFile

Dim strCurPath

Dim dte

Dim tme

Dim arrPCnames()

Dim intPCLoop      

Dim strNewFile

Dim strPCFile

Dim objPCOutputFile

      Set objFso = CreateObject("Scripting.FileSystemObject")

      Set objWshshell = WScript.CreateObject("WScript.Shell")

      strCurPath = CreateObject("Scripting.FileSystemObject").GetAbsolutePathName(".")

      dte = Replace(FormatDateTime(date(),vbshortdate),"/","-")

      tme = Replace(Replace(FormatDateTime(now(),vbLongtime),":","-")," ","")

      strNewFile = strCurPath & "\" & tme & "_" & dte & ".csv"

      strPCFile = InputBox("Please enter the full path and file" & VbCrLf & "name of the file with the computer names.","Get application versions from remote computers..")

            If Not objFso.FileExists(strPCFile) Then

                  MsgBox "You must enter a valid full path and file name!",vbOKOnly,"Get application versions from remote computers.."

                WScript.Quit(0)

            Elseif strPCFile = "" Then

                  MsgBox "You must enter a filename!",vbOKOnly,"Get application versions from remote computers.."

                WScript.Quit(0)

            Else

            Call createoutputfile(strNewFile)

            Call readpclist(strPCFile)

            Set objOutputFile = objFso.OpenTextFile(strNewFile,ForWriting,TristateUseDefault)

                  objOutputFile.WriteLine("Computer,Apps List")

                                                 For intPCLoop = LBound(arrPCnames) To UBound(arrPCnames)

                                                objOutputFile.WriteLine(arrPCnames(intPCLoop) & "," & InstalledApps(arrPCnames(intPCLoop)))

                                                Next

                              objOutputFile.Close                                                

                  MsgBox "File has been processed, and results saved in " & strNewFile ,vbOKOnly,"Get application versions from remote computers."      

            End If

      WScript.Quit(0)                                    

Sub readpclist(strPcList)

Dim objPCnames

Dim objReadFile

Dim intLneCount

      Set objPCnames = objFso.GetFile(strPCFile)

      Set objReadFile = objPCnames.OpenAsTextStream(ForReading, TristateUseDefault)

            Do Until objReadFile.AtEndOfStream

                  ReDim Preserve arrPCnames(intLneCount)

                  arrPCnames(intLneCount) = objReadFile.ReadLine

                  intLneCount = intLneCount + 1

            Loop

      objReadFile.Close

End sub                                    

Sub createoutputfile(strNewFileName)

            If objFso.FileExists(strNewFileName) Then

                  objFso.deleteFile(strNewFileName)

            Else

                  Set objOutputFile = objFso.CreateTextFile(strNewFileName)

                  objOutputFile.Close      

            End If

End Sub

Function InstalledApps(strPcName)

Dim appsFile

Dim strRegValue

Dim strKey

Dim intRegTest

Dim strBaseKey

Dim arSubKeys()

Dim strValue

Dim iErr

Dim iErr2

Dim testConn

Dim errMess

 Const HKLM = &H80000002 'HKEY_LOCAL_MACHINE

 On Error Resume Next

      Set testConn = GetObject("winmgmts:\\" & strPcName,"Root\CIMV2")

      iErr = Hex(Err.Number)

      Select Case Ucase(iErr)

          Case "1AD"

                         Set strRegValue = GetObject("winmgmts://" & strPcName & "/root/default:StdRegProv")

                         iErr2 = Hex(Err.Number)

                               Select Case Ucase(iErr2)

                                     Case "1AD"

                                           strBaseKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\"

                                           intRegTest = strRegValue.EnumKey(HKLM, strBaseKey, arSubKeys)

                                          For Each strKey In arSubKeys

                                                intRegTest = strRegValue.GetStringValue(HKLM, strBaseKey & strKey, "DisplayName", strValue)

                                                      If intRegTest <> 0 Then

                                                            strRegValue.GetStringValue HKLM, strBaseKey & strKey, "QuietDisplayName", strValue

                                                      End If

                                                      If strValue <> "" Then

                                                            InstalledApps = InstalledApps & strValue & ","

                                                      End If

                                          Next

                                    Case Else

                                          InstalledApps = Err.Description      

                              End Select

                  Case Else

                        InstalledApps = Err.Description

            End Select
 

End Function

'===End copy: getapps.vbs===

Open in new window

0
 
LVL 12

Expert Comment

by:zoofan
ID: 24321415
would be happy to modify it to better suit if need be.



zf
0
 

Author Comment

by:vithal_m
ID: 24321423
Hello Zoofan,

Thanks for the quick reply.

does this code grab only Windows Installer based apps or all installed apps?

thanks,
VM
0
 
LVL 12

Expert Comment

by:zoofan
ID: 24321434
Grabs all apps listed/registered in

HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall

so both.


zf
0
 
LVL 12

Accepted Solution

by:
zoofan earned 500 total points
ID: 24321517
Here is a modified version so you can do it by OU,

edit line 27 to the OU path you wish to run against(does a recursive search to include sub ou's)

Output file is csv to same directory the script is run from.


zf
'===Start copy: getapps.vbs===

' ---------------------------------------------------------------'

' getapps.vbs

' 'Sample VBScript to query remote computers

' 'for list of installed apps

' ''Author Riley C. aka ZooFan

' '''Version 3.0 - May 2009

' ''http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_24387274.html#a24321434

' ---------------------------------------------------------------'

'

Option Explicit

Const ForReading = 1, ForWriting = 2, ForAppending = 3 'FileObject Access Type

Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0 'FileObject Format Type

Dim objFso

Dim objWshshell

Dim objOutputFile

Dim strCurPath

Dim dte

Dim tme

Dim strNewFile

Dim arrPCnames()

Dim intPCLoop      

Dim objPCOutputFile

Dim strOUpath
 

'Edit To OU path To start does a recussive search

strOUpath = "OU=computers,DC=domain,DC=com"
 

      Set objFso = CreateObject("Scripting.FileSystemObject")

      Set objWshshell = WScript.CreateObject("WScript.Shell")

      strCurPath = CreateObject("Scripting.FileSystemObject").GetAbsolutePathName(".")

      dte = Replace(FormatDateTime(date(),vbshortdate),"/","-")

      tme = Replace(Replace(FormatDateTime(now(),vbLongtime),":","-")," ","")

      strNewFile = strCurPath & "\" & tme & "_" & dte & ".csv"

     

            Call createoutputfile(strNewFile)

            Call createpclist(strOUpath,arrPCnames)

            Set objOutputFile = objFso.OpenTextFile(strNewFile,ForWriting,TristateUseDefault)

                  objOutputFile.WriteLine("Computer,Apps List")

                                                 For intPCLoop = LBound(arrPCnames) To UBound(arrPCnames)

                                                objOutputFile.WriteLine(arrPCnames(intPCLoop) & "," & InstalledApps(arrPCnames(intPCLoop)))

                                                Next

                              objOutputFile.Close                                                

                  MsgBox "File has been processed, and results saved in " & strNewFile ,vbOKOnly,"Get application versions from remote computers."      

       

      WScript.Quit(0)                                    

                                  

Sub createoutputfile(strNewFileName)

            If objFso.FileExists(strNewFileName) Then

                  objFso.deleteFile(strNewFileName)

            Else

                  Set objOutputFile = objFso.CreateTextFile(strNewFileName)

                  objOutputFile.Close      

            End If

End Sub

Function InstalledApps(strPcName)

Dim appsFile

Dim strRegValue

Dim strKey

Dim intRegTest

Dim strBaseKey

Dim arSubKeys()

Dim strValue

Dim iErr

Dim iErr2

Dim testConn

Dim errMess

 Const HKLM = &H80000002 'HKEY_LOCAL_MACHINE

 On Error Resume Next

      Set testConn = GetObject("winmgmts:\\" & strPcName,"Root\CIMV2")

      iErr = Hex(Err.Number)

      Select Case Ucase(iErr)

          Case "1AD"

                         Set strRegValue = GetObject("winmgmts://" & strPcName & "/root/default:StdRegProv")

                         iErr2 = Hex(Err.Number)

                               Select Case Ucase(iErr2)

                                     Case "1AD"

                                           strBaseKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\"

                                           intRegTest = strRegValue.EnumKey(HKLM, strBaseKey, arSubKeys)

                                          For Each strKey In arSubKeys

                                                intRegTest = strRegValue.GetStringValue(HKLM, strBaseKey & strKey, "DisplayName", strValue)

                                                      If intRegTest <> 0 Then

                                                            strRegValue.GetStringValue HKLM, strBaseKey & strKey, "QuietDisplayName", strValue

                                                      End If

                                                      If strValue <> "" Then

                                                            InstalledApps = InstalledApps & strValue & ","

                                                      End If

                                          Next

                                    Case Else

                                          InstalledApps = Err.Description      

                              End Select

                  Case Else

                        InstalledApps = Err.Description

            End Select

 

End Function
 

Function createPClist(strOUstart,arrName)

	Const ADS_SCOPE_SUBTREE = 2  

 	Dim strCommon  

 	Dim i,j

 	Set strCommon = CreateObject("ADODB.Connection")  

 	strCommon.Provider = "ADsDSOObject" 

 	strCommon.Open "Active Directory Provider" 

 	Dim strQueryString  

 	Set strQueryString = CreateObject("ADODB.Command")  

 	Set strQueryString.ActiveConnection = strCommon   

 	strQueryString.CommandText =  "SELECT name " & _  

 	                  "FROM 'LDAP://" & strOUstart & "' " & _  

 	                  "WHERE objectClass='computer' " & _  

 	                  "ORDER BY name"

 	strQueryString.Properties("Page Size") = 1000  

 	strQueryString.Properties("Searchscope") = ADS_SCOPE_SUBTREE  

 	 

 	Dim  strReturn  

 	Set strReturn = strQueryString.Execute  

 	strReturn.MoveFirst  

 	i = 0

 	j = 1

 	ReDim arrname(j)

 	Do Until strReturn.EOF  

 		

 	  arrName(i) = strReturn(0)  

 	  i = i + 1

 	  j = i + 1

 	  ReDim Preserve arrName(j)

 	  strReturn.MoveNext  

 	Loop

End Function
 

'===End copy: getapps.vbs===

Open in new window

0
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 

Author Comment

by:vithal_m
ID: 24321616
thanks for the reply.

I would like to exclude Hotfixes from this list. is it possible?

thanks,VM
0
 
LVL 12

Expert Comment

by:zoofan
ID: 24321648
As there is no common key(element) that will cover ALL hot fixes, about the only thing I could do for that would be to exclude everything that starts with KB(knowledge Base) XXXXXXX from the list.

zf
0
 

Author Comment

by:vithal_m
ID: 24321669
that would be great.and also sorry for doing this..can we have some check as an option and exclude servers from the list. just add a pop up button after i input the computers list files. do you wan to exclude server yes or no.

I know that you can use this
ProductType from ("Win32_OperatingSystem") and check if its a server. If ProductType =1 it is a server. it anything else is a workstation or laptop etc..

Thanks heaps.
VM.
0
 

Author Comment

by:vithal_m
ID: 24321842
I ran the above script and got the following message for the first 70 machines
"The remote server machine does not exist or is unavailable"
I have manually pinged the machines and they respond. Remote registry is enabled.


0
 
LVL 12

Assisted Solution

by:zoofan
zoofan earned 500 total points
ID: 24322255
make sure WMI is running and functioning correctly as well, the connection goes in thru WMI.  also requires admin account,  firewall rules can also block WMI requests.

you can test the wmi connection with the script below if you want.
edit line 5 to test a diffent computer.

zf
Option Explicit

 

On Error Resume Next

 

Const DEFAULT_COMPUTER  = "localhost"

Const DEFAULT_NAMESPACE = "root\cimv2"

 

Dim objLoc

Dim objWmi

Dim strSysname

Dim strNamespace

Dim strUsername

Dim strPassword

Dim blnQuiet

 

strSysname   = DEFAULT_COMPUTER

strNamespace = DEFAULT_NAMESPACE

strUsername  = ""

strPassword  = ""

blnQuiet     = False

If fctIsAlive(strSysname) Then

 If Not blnQuiet Then

  WScript.Echo "ICMP Ping for " & strSysname & " passed."

  WScript.Echo "Connecting to namespace " & strNamespace & " . . ."

 End If

 Set objLoc = WScript.CreateObject("WbemScripting.SWbemLocator")

 Set objWmi = objLoc.ConnectServer(strSysname, strNamespace, strUsername, strPassword)

 If Err.Number Then

  If Not blnQuiet Then

   WScript.Echo "Unable to connect to WMI: " & Err.Description

  End If

  Err.Clear

  WScript.Quit(2)

 Else

  Set objWmi = Nothing

  Set objLoc = Nothing

  If Not blnQuiet Then

   WScript.Echo "WMI successfully connected."

  End If

  WScript.Quit(0)

 End If

Else

 If Not blnQuiet Then

  WScript.Echo "ICMP Ping for " & strSysname & " failed."

 End If

 WScript.Quit(1)

End If

 

Function fctIsAlive(strHostOrIP)

 

Dim objSh, objCmd, strCmd

 

strCmd     = "%ComSpec% /C %SystemRoot%\system32\ping.exe -n 1 " & strHostOrIP & " | " _

           & "%SystemRoot%\system32\find.exe /c /i " & Chr(34) & "ttl=" & Chr(34)

Set objSh  = WScript.CreateObject("WScript.Shell")

Set objCmd = objSh.Exec(strCmd)

fctIsAlive = CBool(Trim(objCmd.StdOut.ReadAll))

Set objCmd = Nothing

Set objSh  = Nothing

 

End Function

Open in new window

0
 

Author Comment

by:vithal_m
ID: 24322295
I was searching on google for something and bumped into this...this script works but the formatting is totally out. This does not have the WMI issue. and WMI is turned on all PCs by default.

' This code developed by Timothy Brigham July 2006.
' Revisions made Oct 2007

' This is designed to be run by an administrator to audit the software installed
' throughout a domain. You will need to adjust the LDAP query to reflect your local
' configuration. You may additionally define OUs to restrict and speed up the search.

' Much of this code collected from various usenet sources.

' Revision 2 - includes logging to a text file

' This is Tim Brigham. Revision 2 of my software audit software is available now,
' including logging to a text file. The default path for the saved audit is
' C:\TimSoftwareAudit.txt, but can be edited by changing the path below.

' Please note that the oContainer item with the LDAP query does not
' need to point to the root of the domain. I use this script frequently
' on specific OUs. The easiest way to do determine the LDAP syntax is to use an
' LDAP browser, such as adsiedit from Microsoft. Simply copy and paste in
' the distinguishedName attribute.

' If you have any questions, please comtact me at timbrigham@gmail.com.

Set fso = CreateObject("Scripting.FileSystemObject")

' **************************************************
' make any changes here to set properties of the audit


Set oContainer=GetObject("LDAP://DC=au,DC=challenger,DC=net")
Set LogFile = fso.CreateTextFile("C:\TimSoftwareAudit.csv", True)

' no changes should be needed under this point
' **************************************************


Dim oContainer

ListComputers oContainer
Set oContainer = Nothing

Sub ListComputers(oObject)
Dim Object
For Each Object in oObject
  If Object.Class = "organizationalUnit" Then
    ListComputers ( Object )
  End If

  If Object.Class = "computer" Then
    Name = Object.Name
    Name = Mid( Name, 4 )

    'WScript.Echo "Computer Name: "
    'WScript.Echo Name

    LogFile.WriteLine("Computer Name:,"+Name)
   ' LogFile.WriteLine(Name)

    On Error Resume Next

    'WScript.Echo "Logged in User(s): "
    UserName = GetUser(Name)
   ' WScript.Echo UserName
    LogFile.WriteLine("Logged in User(s):,"+UserName)
    'LogFile.WriteLine(UserName)


    'WScript.Echo "Installed Applications: " 
    Installed = InstalledApplications(Name)
    'WScript.Echo Installed
    'WScript.Echo ""
    'WScript.Echo ""
    LogFile.WriteLine "Installed Applications"
      LogFile.WriteLine(","+Installed)
   ' LogFile.WriteLine("")
    LogFile.WriteLine("")


  End If
Next

End Sub

Function GetUser( strComputer )
  Set objWMIService = GetObject("winmgmts:" _
      & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
  Set colComputer = objWMIService.ExecQuery _
      ("Select * from Win32_ComputerSystem")
  For Each objComputer in colComputer
      GetUser = GetUser & objComputer.UserName & vblf
  Next
End Function

Function InstalledApplications(node)
 Const HKLM = &H80000002 'HKEY_LOCAL_MACHINE
 Set oRegistry = _
  GetObject("winmgmts:{impersonationLevel=impersonate}!\\" _
  & node & "/root/default:StdRegProv")
 sBaseKey = _
  "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\"
 iRC = oRegistry.EnumKey(HKLM, sBaseKey, arSubKeys)
 For Each sKey In arSubKeys
  iRC = oRegistry.GetStringValue( _
   HKLM, sBaseKey & sKey, "DisplayName", sValue)
  If iRC <> 0 Then
   oRegistry.GetStringValue _
    HKLM, sBaseKey & sKey, "QuietDisplayName", sValue
  End If
  If sValue <> "" Then
   InstalledApplications = _
    InstalledApplications & sValue & vbCrLf
  End If
 Next
End Function
0
 
LVL 12

Expert Comment

by:zoofan
ID: 24326938
Looks to also use WMI


zf
0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Hello again, all.  For those of you that have been following along, you'll know that this is my third article on this topic (though it is not Part III).  This article is sort of remedial, and probably the topic with which I should have started the s…
Over the years I have built up my own little library of code snippets that I refer to when programming or writing a script.  Many of these have come from the web or adaptations from snippets I find on the Web.  Periodically I add to them when I come…
This Micro Tutorial will teach you how to censor certain areas of your screen. The example in this video will show a little boy's face being blurred. This will be demonstrated using Adobe Premiere Pro CS6.
This is used to tweak the memory usage for your computer, it is used for servers more so than workstations but just be careful editing registry settings as it may cause irreversible results. I hold no responsibility for anything you do to the regist…

912 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

18 Experts available now in Live!

Get 1:1 Help Now