CustomInv_AddRemoveProgram.vbs
' Inventory system for programs
' For use with Altiris/SMP Agent
' Create Objects, Define Constants and Variables
'*****************************************************************************
Option Explicit
'On Error Resume Next
'No user-edit required below this line
'Initialize Objects
Dim objWSHShell: Set objWSHShell = CreateObject("WScript.Shell")
Dim objWSHNetwork: Set objWSHNetwork = CreateObject("WScript.Network")
Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim strComputer: strComputer = objWSHNetwork.ComputerName
Dim RemoteStdRegProvClass: Set RemoteStdRegProvClass = GetObject("winmgmts:{impersonationLevel=impersonate}!//" & strComputer & "/root/default:StdRegProv")
Dim RemoteCIMv2Namespace: Set RemoteCIMv2Namespace = GetObject("winmgmts:{impersonationLevel=impersonate}!//" & strComputer & "/root/cimv2")
Dim Products: Set Products = CreateObject("ADODB.Recordset")
Dim UniqueProductNames: Set UniqueProductNames = CreateObject("Scripting.Dictionary")
'Define Constants
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Const adVarChar = 200
Const MaxCharacters = 255
Const HKCR = &H80000000: Const HKEY_CLASSES_ROOT = &H80000000
Const HKCU = &H80000001: Const HKEY_CURRENT_USER = &H80000001
Const HKLM = &H80000002: Const HKEY_LOCAL_MACHINE = &H80000002
Const HKU = &H80000003: Const HKEY_USERS = &H80000003
Const HKCC = &H80000002: Const HKEY_CURRENT_CONFIG = &H80000005
Const HKDD = &H80000002: Const HKEY_DYN_DATA = &H80000006
'Dimension Variables
Dim intErrorCount: intErrorCount = 0
Dim blnActionStarted: blnActionStarted = False
Dim strScriptPath: strScriptPath = WScript.ScriptFullName
Dim Component
Dim Resource, hDefKey, sSubKeyName, sValueName, ProviderArchitecture
'Dimension non-variable path locations (Initialize objects must be done prior to this)
Dim systemDrive: systemDrive = objWSHShell.ExpandEnvironmentStrings("%systemdrive%")
Dim winDir: winDir = objWSHShell.ExpandEnvironmentStrings("%windir%")
'Dimension variable path locations (Dimension non-variable path locations must be done prior to this)
Dim tagDir: tagDir = objFSO.BuildPath(systemDrive, "\TagDir")
Dim supportDir: supportDir = objFSO.BuildPath(systemDrive, "\Support")
Dim appsDir: appsDir = objFSO.BuildPath(supportDir, "Apps")
Dim system32Dir: system32Dir = objFSO.BuildPath(winDir, "system32")
Dim scriptDir: scriptDir = Replace(strScriptPath, WScript.ScriptName, "")
Dim logFilesDir: logFilesDir = objFSO.BuildPath(system32Dir, "LogFiles")
'Dimension file locations (Dimension non-variable path locations must be done prior to this)
Dim scriptLogFile: scriptLogFile = objFSO.BuildPath(logFilesDir, "InventoryPrograms_" & strComputer & ".log")
' Begin Logging
Dim objLog: Set objLog = objFSO.OpenTextFile(scriptLogFile, ForWriting, True)
If Err.Number Then WScript.Quit(Err.Number)
' 32/64 bit check
Dim x86RegKey, x64RegKey, x86ProgramFiles, x64ProgramFiles
If Is32BitOS = True Then
x86RegKey = "SOFTWARE"
x64RegKey = ""
x86ProgramFiles = objWSHShell.ExpandEnvironmentStrings("%ProgramFiles%")
x64ProgramFiles = ""
ElseIf Is64BitOS = True Then
x86RegKey = "SOFTWARE\Wow6432Node"
x64RegKey = "SOFTWARE"
x86ProgramFiles = objWSHShell.ExpandEnvironmentStrings("%ProgramFiles(x86)%")
x64ProgramFiles = objWSHShell.ExpandEnvironmentStrings("%ProgramFiles%")
End If
WScript.Echo ""
DumpProductsRecordsetToFile()
SendToSMPServer()
objLog.WriteLine "ADODB.Recordset.Products.Recordcount = " & Products.Recordcount
ScriptExit(0)
' Support Functions
'*****************************************************************************
Function GetRegValue(Resource, HIVE, strKeyPath, strValueName, ValueType)
On Error Resume Next
Dim ValueData
Select Case LCase(ValueType)
Case "string"
'GetStringValue(HIVE, strKeyPath, strValueName, ValueData
Case "dword"
RemoteStdRegProvClass.GetDWORDValue HIVE, strKeyPath, strValueName, ValueData
Case "binary"
RemoteStdRegProvClass.GetBinaryValue HIVE, strKeyPath, strValueName, ValueData
Case "array"
RemoteStdRegProvClass.GetMultiStringValue HIVE, strKeyPath, strValueName, ValueData
Case "expanded"
RemoteStdRegProvClass.GetExpandedStringValue HIVE, strKeyPath, strValueName, ValueData
Case Else
GetRegValue = "Undefined"
End Select
If Err.Number Then
Err.Clear
If LCase(ValueType) = "binary" or LCase(ValueType) = "expanded" Then
GetRegValue = Array("Undefined")
Else
GetRegValue = "Undefined"
End If
Else
GetRegValue = ValueData
End If
End Function
Sub ScriptExit(intCode)
Set objWSHShell = Nothing
Set RemoteStdRegProvClass = Nothing
objLog.Close
Set objLog = Nothing
Set objFSO = Nothing
WScript.Quit(intCode)
End Sub
Sub BuildProductsRecordset()
On Error Resume Next
' Common
Products.Fields.Append "Name", adVarChar, MaxCharacters
Products.Fields.Append "Version", adVarChar, MaxCharacters
Products.Open
Dim PreviousCount: PreviousCount = 0
Dim Name, Version, Product, UniqueName
' Windows Installer Version
WScript.StdOut.Write "Windows Installer (MSI.DLL): "
Name = "Windows Installer"
'Get the windows folder location
Dim OperatingSystem, SystemDirectory
For Each OperatingSystem in RemoteCIMv2Namespace.ExecQuery("SELECT SystemDirectory FROM Win32_OperatingSystem")
SystemDirectory = OperatingSystem.SystemDirectory
Next
If RemoteCIMv2Namespace.ExecQuery("SELECT Version FROM CIM_Datafile WHERE Name = '" & Replace(objFSO.BuildPath(SystemDirectory, "msi.dll"), "\", "\\") & "'").Count = 1 Then
For Each Product In RemoteCIMv2Namespace.ExecQuery("SELECT Version FROM CIM_Datafile WHERE Name = '" & Replace(objFSO.BuildPath(SystemDirectory, "msi.dll"), "\", "\\") & "'")
Version = Product.Version
If IsNull(Name) = True Then Name = ""
If IsNull(Version) = True Then Version = ""
UniqueName = Replace(Name & Version, " ", "", 1, -1, vbTextCompare)
If ((Len(Name) > 0) And (Len(UniqueName) > 0)) And UniqueProductNames.Exists(UniqueName) = False Then
UniqueProductNames.Add UniqueName, UniqueName
Products.AddNew
Products("Name").Value = Name
Products("Version").Value = Version
Products.Update
End If
Next
End If
WScript.StdOut.WriteLine (Products.Recordcount - PreviousCount) & "/" & Products.Recordcount
PreviousCount = Products.Recordcount
' 32-bit
Dim Key, KeyNames, KeyName
ProviderArchitecture = 32
' Get applications for Uninstall registry
WScript.StdOut.Write "Uninstall (" & ProviderArchitecture & "-bit) registry key: "
Key = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall"
KeyNames = EnumKey(".", HKEY_LOCAL_MACHINE, Key, ProviderArchitecture)
If IsNull(KeyNames) = False Then
For Each KeyName In KeyNames
Name = GetStringValue(".", HKLM, Key & "\" & KeyName, "DisplayName", ProviderArchitecture)
Version = GetStringValue(".", HKLM, Key & "\" & KeyName, "DisplayVersion", ProviderArchitecture)
If IsNull(Name) = True Then Name = ""
If IsNull(Version) = True Then Version = ""
UniqueName = Replace(Name & Version, " ", "", 1, -1, vbTextCompare)
If ((Len(Name) > 0) And (Len(UniqueName) > 0)) And UniqueProductNames.Exists(UniqueName) = False Then
UniqueProductNames.Add UniqueName, UniqueName
Products.AddNew
Products("Name").Value = Name
Products("Version").Value = Version
Products.Update
End If
Next
End If
WScript.StdOut.WriteLine (Products.Recordcount - PreviousCount) & "/" & Products.Recordcount
PreviousCount = Products.Recordcount
' Get applications for ActiveSetup registry
WScript.StdOut.Write "Active Setup Installed Components (" & ProviderArchitecture & "-bit) registry key: "
Key = "SOFTWARE\Microsoft\Active Setup\Installed Components"
KeyNames = EnumKey(".", HKEY_LOCAL_MACHINE, Key, ProviderArchitecture)
If IsNull(KeyNames) = False Then
For Each KeyName In KeyNames
Name = GetStringValue(".", HKLM, Key & "\" & KeyName, "DisplayName", ProviderArchitecture)
Version = GetStringValue(".", HKLM, Key & "\" & KeyName, "DisplayVersion", ProviderArchitecture)
If IsNull(Name) = True Then Name = ""
If IsNull(Version) = True Then Version = ""
Version = Replace(Version, ",", ".")
UniqueName = Replace(Name & Version, " ", "", 1, -1, vbTextCompare)
If ((Len(Name) > 0) And (Len(UniqueName) > 0)) And UniqueProductNames.Exists(UniqueName) = False Then
UniqueProductNames.Add UniqueName, UniqueName
Products.AddNew
Products("Name").Value = Name
Products("Version").Value = Version
Products.Update
End If
Next
End If
WScript.StdOut.WriteLine (Products.Recordcount - PreviousCount) & "/" & Products.Recordcount
PreviousCount = Products.Recordcount
' Add InstallShield ISScript versions
WScript.StdOut.Write "ISScript (" & ProviderArchitecture & "-bit) registry key: "
Key = "SOFTWARE\Installshield\Driver"
KeyNames = EnumKey(".", HKEY_LOCAL_MACHINE, Key, ProviderArchitecture)
If IsNull(KeyNames) = False Then
For Each KeyName In KeyNames
Name = "ISScript"
Version = KeyName
If IsNull(Name) = True Then Name = ""
If IsNull(Version) = True Then Version = ""
If Len(Version) = 4 Then Version = Left(Version, 2) & "." & Right(Version, 2)
Version = Replace(Version, ",", ".")
UniqueName = Replace(Name & Version, " ", "", 1, -1, vbTextCompare)
If ((Len(Name) > 0) And (Len(UniqueName) > 0)) And UniqueProductNames.Exists(UniqueName) = False Then
UniqueProductNames.Add UniqueName, UniqueName
Products.AddNew
Products("Name").Value = Name
Products("Version").Value = Version
Products.Update
End If
Next
End If
WScript.StdOut.WriteLine (Products.Recordcount - PreviousCount) & "/" & Products.Recordcount
PreviousCount = Products.Recordcount
' SysConfig version
WScript.StdOut.Write "US Cellular (" & ProviderArchitecture & "-bit) registry key: "
Key = "SOFTWARE"
KeyName = "US Cellular"
Name = "System Configuration Script"
Version = GetStringValue(".", HKLM, Key & "\" & KeyName, "ImageInfo", ProviderArchitecture)
If IsNull(Version) = True Then Version = ""
UniqueName = Replace(Name & Version, " ", "", 1, -1, vbTextCompare)
If ((Len(Name) > 0) And (Len(UniqueName) > 0)) And UniqueProductNames.Exists(UniqueName) = False Then
UniqueProductNames.Add UniqueName, UniqueName
Products.AddNew
Products("Name").Value = Name
Products("Version").Value = Version
Products.Update
End If
WScript.StdOut.WriteLine (Products.Recordcount - PreviousCount) & "/" & Products.Recordcount
PreviousCount = Products.Recordcount
' 64-bit
If Is64BitOS = True Then
ProviderArchitecture = 64
' Get applications for Uninstall registry
WScript.StdOut.Write "Uninstall (" & ProviderArchitecture & "-bit) registry key: "
Key = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall"
KeyNames = EnumKey(".", HKEY_LOCAL_MACHINE, Key, ProviderArchitecture)
If IsNull(KeyNames) = False Then
For Each KeyName In KeyNames
Name = GetStringValue(".", HKLM, Key & "\" & KeyName, "DisplayName", ProviderArchitecture)
Version = GetStringValue(".", HKLM, Key & "\" & KeyName, "DisplayVersion", ProviderArchitecture)
If IsNull(Name) = True Then Name = ""
If IsNull(Version) = True Then Version = ""
UniqueName = Replace(Name & Version, " ", "", 1, -1, vbTextCompare)
If ((Len(Name) > 0) And (Len(UniqueName) > 0)) And UniqueProductNames.Exists(UniqueName) = False Then
UniqueProductNames.Add UniqueName, UniqueName
Products.AddNew
Products("Name").Value = Name
Products("Version").Value = Version
Products.Update
End If
Next
End If
WScript.StdOut.WriteLine (Products.Recordcount - PreviousCount) & "/" & Products.Recordcount
PreviousCount = Products.Recordcount
' Get applications for ActiveSetup registry
WScript.StdOut.Write "Active Setup Installed Components (" & ProviderArchitecture & "-bit) registry key: "
Key = "SOFTWARE\Microsoft\Active Setup\Installed Components"
KeyNames = EnumKey(".", HKEY_LOCAL_MACHINE, Key, ProviderArchitecture)
If IsNull(KeyNames) = False Then
For Each KeyName In KeyNames
Name = GetStringValue(".", HKLM, Key & "\" & KeyName, "DisplayName", ProviderArchitecture)
Version = GetStringValue(".", HKLM, Key & "\" & KeyName, "DisplayVersion", ProviderArchitecture)
If IsNull(Name) = True Then Name = ""
If IsNull(Version) = True Then Version = ""
Version = Replace(Version, ",", ".")
UniqueName = Replace(Name & Version, " ", "", 1, -1, vbTextCompare)
If ((Len(Name) > 0) And (Len(UniqueName) > 0)) And UniqueProductNames.Exists(UniqueName) = False Then
UniqueProductNames.Add UniqueName, UniqueName
Products.AddNew
Products("Name").Value = Name
Products("Version").Value = Version
Products.Update
End If
Next
End If
WScript.StdOut.WriteLine (Products.Recordcount - PreviousCount) & "/" & Products.Recordcount
PreviousCount = Products.Recordcount
' Add InstallShield ISScript versions
WScript.StdOut.Write "ISScript (" & ProviderArchitecture & "-bit) registry key: "
Key = "SOFTWARE\Installshield\Driver"
KeyNames = EnumKey(".", HKEY_LOCAL_MACHINE, Key, ProviderArchitecture)
If IsNull(KeyNames) = False Then
For Each KeyName In KeyNames
Name = "ISScript"
Version = KeyName
If IsNull(Name) = True Then Name = ""
If IsNull(Version) = True Then Version = ""
If Len(Version) = 4 Then Version = Left(Version, 2) & "." & Right(Version, 2)
Version = Replace(Version, ",", ".")
UniqueName = Replace(Name & Version, " ", "", 1, -1, vbTextCompare)
If ((Len(Name) > 0) And (Len(UniqueName) > 0)) And UniqueProductNames.Exists(UniqueName) = False Then
UniqueProductNames.Add UniqueName, UniqueName
Products.AddNew
Products("Name").Value = Name
Products("Version").Value = Version
Products.Update
End If
Next
End If
WScript.StdOut.WriteLine (Products.Recordcount - PreviousCount) & "/" & Products.Recordcount
PreviousCount = Products.Recordcount
' SysConfig version
WScript.StdOut.Write "US Cellular (" & ProviderArchitecture & "-bit) registry key: "
Key = "SOFTWARE"
KeyName = "US Cellular"
Name = "System Configuration Script"
Version = GetStringValue(".", HKLM, Key & "\" & KeyName, "ImageInfo", ProviderArchitecture)
If IsNull(Version) = True Then Version = ""
UniqueName = Replace(Name & Version, " ", "", 1, -1, vbTextCompare)
If ((Len(Name) > 0) And (Len(UniqueName) > 0)) And UniqueProductNames.Exists(UniqueName) = False Then
UniqueProductNames.Add UniqueName, UniqueName
Products.AddNew
Products("Name").Value = Name
Products("Version").Value = Version
Products.Update
End If
WScript.StdOut.WriteLine (Products.Recordcount - PreviousCount) & "/" & Products.Recordcount
PreviousCount = Products.Recordcount
End If
End Sub
Sub DumpProductsRecordsetToFile()
Products.Filter = ""
If Products.Fields.Count = 0 Then BuildProductsRecordset()
If Products.Fields.Count = 0 Then Exit Sub
Products.MoveFirst
Products.Sort = "Name"
Do Until Products.EOF = True
objLog.WriteLine "ADODB.Recordset.Products: Name: " & Products("Name") & ", Version: " & Products("Version")
Products.MoveNext
Loop
End Sub
Sub SendToSMPServer()
' User-defined constants
' Initialize Objects
Dim SectionEntryIndex, SectionEntry, SectionEntries: Set SectionEntries = CreateObject("Scripting.Dictionary")
' Define Constants
' Dimension Public Variables
Dim DataClassGuid, DataClassInstance, DataBlockInstance, RowInstance
' Dimension non-variable path locations (Initialize Objects must be done prior to this)
' Dimension variable path locations (Dimension non-variable path locations must be done prior to this)
' Dimension file locations (Dimension non-variable path locations must be done prior to this)
'Create instance of Altiris NSE component
Dim AeXNSEvent: Set AeXNSEvent = CreateObject ("Altiris.AeXNSEvent")
' Set the header data of the NSE
' This specifies the iteam as a Basic Inventory Capture Item (This should not be modified)
AeXNSEvent.To = "{1592B913-72F3-4C36-91D2-D4EDA21D2F96}"
AeXNSEvent.Priority = 1
' This is the Guid assigned to the Data Class within SMP.
' CAUTION: This changes every time the Data Class definition is modified!
DataClassGuid = "{037DC6F3-1E5F-41C4-8B5A-81E2DF068A44}"
' Create section based on Data Class guid
Set DataClassInstance = AeXNSEvent.AddDataClass (DataClassGuid)
Set DataBlockInstance = AeXNSEvent.AddDataBlock (DataClassInstance)
' ################# MODIFY BELOW THIS LINE #################
Products.Filter = ""
Products.MoveFirst
Do While Products.EOF = False
SectionEntryIndex = -1
SectionEntry = Products("Name").Value
SectionEntryIndex = SectionEntryIndex + 1
If VarType(SectionEntry) = vbString Then SectionEntries.Add SectionEntryIndex, SectionEntry
SectionEntry = Products("Version").Value
SectionEntryIndex = SectionEntryIndex + 1
If VarType(SectionEntry) = vbString Then SectionEntries.Add SectionEntryIndex, SectionEntry
'################# MODIFY ABOVE THIS LINE #################
If SectionEntries.Count > 0 Then
'Add a new row
Set RowInstance = DataBlockInstance.AddRow
'Set columns
Dim DictionaryKey, DictionaryKeys: DictionaryKeys = SectionEntries.Keys
For Each DictionaryKey In DictionaryKeys
RowInstance.SetField DictionaryKey, SectionEntries.Item(DictionaryKey)
Next
End If
SectionEntries.RemoveAll
Products.MoveNext
Loop
' Queue NSE for upload
AeXNSEvent.SendQueued
End Sub
Function Is64BitHW()
Is64BitHW = False
Dim Processors, Processor: Set Processors = RemoteCIMv2Namespace.ExecQuery ("SELECT Architecture FROM Win32_Processor")
For Each Processor In Processors
If Processor.Architecture = 9 Then
Is64BitHW = True
Exit For
End If
Next
End Function
Function Is32BitHW()
Is32BitHW = False
Dim Processors, Processor: Set Processors = RemoteCIMv2Namespace.ExecQuery ("SELECT Architecture FROM Win32_Processor")
For Each Processor In Processors
If Processor.Architecture = 0 Then
Is32BitHW = True
Exit For
End If
Next
End Function
Function Is64BitOS()
Is64BitOS = False
Dim Processors, Processor: Set Processors = RemoteCIMv2Namespace.ExecQuery ("SELECT AddressWidth FROM Win32_Processor")
For Each Processor In Processors
If Processor.AddressWidth = 64 Then
Is64BitOS = True
Exit For
End If
Next
End Function
Function Is32BitOS()
Is32BitOS = False
Dim Processors, Processor: Set Processors = RemoteCIMv2Namespace.ExecQuery ("SELECT AddressWidth FROM Win32_Processor")
For Each Processor In Processors
If Processor.AddressWidth = 32 Then
Is32BitOS = True
Exit For
End If
Next
End Function
Function GetStringValue (ByVal Resource, ByVal hDefKey, ByVal sSubKeyName, ByVal sValueName, ByVal ProviderArchitecture)
Const wbemAuthenticationLevelPktPrivacy = 6
Const wbemImpersonationLevelImpersonate = 3
Dim oCtx: Set oCtx = CreateObject("WbemScripting.SWbemNamedValueSet")
oCtx.Add "__ProviderArchitecture", ProviderArchitecture
oCtx.Add "__RequiredArchitecture", True
Dim oLocator: Set oLocator = CreateObject("Wbemscripting.SWbemLocator")
oLocator.Security_.ImpersonationLevel = wbemImpersonationLevelImpersonate
oLocator.Security_.AuthenticationLevel = wbemAuthenticationLevelPktPrivacy
Dim oReg: Set oReg = oLocator.ConnectServer(Resource, "root\default", "", "", , , , oCtx).Get("StdRegProv")
Dim oInParams: Set oInParams = oReg.Methods_("GetStringValue").InParameters
oInParams.hDefKey = hDefKey
oInParams.sSubKeyName = sSubKeyName
oInParams.sValueName = sValueName
Dim oOutParams: Set oOutParams = oReg.ExecMethod_("GetStringValue", oInParams, , oCtx)
GetStringValue = oOutParams.sValue
End Function
Function EnumKey (ByVal Resource, ByVal hDefKey, ByVal sSubKeyName, ByVal ProviderArchitecture)
Const wbemAuthenticationLevelPktPrivacy = 6
Const wbemImpersonationLevelImpersonate = 3
Dim oCtx: Set oCtx = CreateObject("WbemScripting.SWbemNamedValueSet")
oCtx.Add "__ProviderArchitecture", ProviderArchitecture
oCtx.Add "__RequiredArchitecture", True
Dim oLocator: Set oLocator = CreateObject("Wbemscripting.SWbemLocator")
oLocator.Security_.ImpersonationLevel = wbemImpersonationLevelImpersonate
oLocator.Security_.AuthenticationLevel = wbemAuthenticationLevelPktPrivacy
Dim oReg: Set oReg = oLocator.ConnectServer(Resource, "root\default", "", "", , , , oCtx).Get("StdRegProv")
Dim oInParams: Set oInParams = oReg.Methods_("EnumKey").InParameters
oInParams.hDefKey = hDefKey
oInParams.sSubKeyName = sSubKeyName
Dim oOutParams: Set oOutParams = oReg.ExecMethod_("EnumKey", oInParams, , oCtx)
EnumKey = oOutParams.sNames
End Function
