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,595 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
Comment Utility
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
Comment Utility
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
Comment Utility
would be happy to modify it to better suit if need be.



zf
0
 

Author Comment

by:vithal_m
Comment Utility
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
Comment Utility
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
Comment Utility
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
Top 6 Sources for Identifying Threat Actor TTPs

Understanding your enemy is essential. These six sources will help you identify the most popular threat actor tactics, techniques, and procedures (TTPs).

 

Author Comment

by:vithal_m
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
Looks to also use WMI


zf
0

Featured Post

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

This is pretty cool.  The purpose of this VB Script is to help you document where JAR (Java ARchive) files and specifically java class files are located so that you can address issues seen with a client or that you can speak intelligently with a dev…
This article is the result of a quest to better understand Task Scheduler 2.0 and all the newer objects available in vbscript in this version over  the limited options we had scripting in Task Scheduler 1.0.  As I started my journey of knowledge I f…
Internet Business Fax to Email Made Easy - With eFax Corporate (http://www.enterprise.efax.com), you'll receive a dedicated online fax number, which is used the same way as a typical analog fax number. You'll receive secure faxes in your email, fr…
In this seventh video of the Xpdf series, we discuss and demonstrate the PDFfonts utility, which lists all the fonts used in a PDF file. It does this via a command line interface, making it suitable for use in programs, scripts, batch files — any pl…

744 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

9 Experts available now in Live!

Get 1:1 Help Now