registry.vbs - vbscript script by ActiveXperts Software
registry.vbs checks value of a registry key on the local or remote system.
Use registry.vbs directly from ActiveXperts Network Monitor; in the Manager's 'Monitor' menu, select 'New Check (Script)' and select registry.vbs. Configure the required parameter, or press 'Load a working sample'.
In ActiveXperts Network Monitor, Administrators can use three different scripting languages: Powershell, VBScript and SSH.
registry.vbs script code
' ///////////////////////////////////////////////////////////////////////////////
' // ActiveXperts Network Monitor - VBScript based checks
' // For more information about ActiveXperts Network Monitor and VBScript, visit
' // http://www.activexperts.com/support/network-monitor/online/vbscript/
' ///////////////////////////////////////////////////////////////////////////////
Option Explicit
' Declaration of global variables
Dim SYSDATA, SYSEXPLANATION ' SYSDATA is displayed in the 'Data' column in the Manager; SYSEXPLANATION in the 'LastResponse' column
' Constants - return values
Const retvalUnknown = 1 ' ActiveXperts Network Monitor functions should always return True (-1, Success), False (0, Error) or retvalUnknown (1, Uncertain)
' Constants - registry defines
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 REG_SZ = 1
Const REG_EXPAND_SZ = 2
Const REG_BINARY = 3
Const REG_DWORD = 4
Const REG_MULTI_SZ = 7
' // To test a function outside Network Monitor (e.g. using CSCRIPT from the
' // command line), remove the comment character (') in the following lines:
' Dim strResult
' strResult = CheckRegistry( "vm28r2", "vm28r12", "HKLM", "SYSTEM\CurrentControlSet\services\Tcpip\Parameters", "Hostname", "VM28R2" )
' WScript.Echo "Return value: [" & strResult & "]"
' WScript.Echo "SYSDATA: [" & SYSDATA & "]"
' WScript.Echo "SYSEXPLANATION: [" & SYSEXPLANATION & "]"
Function CheckRegistry ( strHost, strAltCredentials, strRootKey, strPath, strValueName, strValue )
' Description:
' Check value of a registry key on the local or remote system
' Parameters:
' 1) strHost As String - Hostname or IP address of the computer you want to check
' 2) strAltCredentials As String - Specify an empty string to use Network Monitor service credentials.
' To use alternate credentials, enter a server that is defined in Server Credentials table.
' (To define Server Credentials, choose Tools->Options->Server Credentials)
' 3) Root Key for the registry (i.e. HKLM, HKCU etc).
' 4) Key Path (i.e. SYSTEM\CurrentControlSet\ ).
' 5) Value Name, name of the value.
' 6) Value to match.
' Usage:
' CheckRegistry ( "<Hostname | IP>", "<Empty String | Server>", "<RootKey>", "<KeyPath>", "<ValueName>", "<Match>" )
' Sample:
' CheckRegistry ( "localhost", "", "HKLM", "SYSTEM\CurrentControlSet\services\Tcpip\Parameters", "Hostname", "VM28R2" )
Dim objRegService
Dim strAltLogin, strAltPassword
CheckRegistry = retvalUnknown ' Default return value, and will be shown as a yellow (uncertain) icon in the Manager
SYSDATA = "" ' SYSDATA displayed in the 'Data' column in the Manager
SYSEXPLANATION = "" ' SYSEXPLANATION displayed in the 'LastResponse' column in the Manager
' If alternate credentials are specified, retrieve the alternate login and password from the ActiveXperts global settings
If( strAltCredentials <> "" ) Then
If( Not getCredentials( strHost, strAltCredentials, strAltLogin, strAltPassword, SYSEXPLANATION )) Then
Exit Function
End If
End If
If( Not getRegistryObject( strHost, strAltLogin, strAltPassword, objRegService, SYSEXPLANATION ) ) Then
Exit Function
End If
If( Not getRegistryValue( objRegService, strRootKey, strPath, strValueName ) ) Then
Exit Function
End If
If ( UCase ( SYSDATA ) = UCase ( strValue ) ) Then
SYSEXPLANATION = "Value retrieved, positive match"
CheckRegistry = True
Else
SYSEXPLANATION = "Value retrieved, no match"
CheckRegistry = False
End If
End Function
' //////////////////////////////////////////////////////////////////////////////
' // --- Private Functions section ---
' // Private functions names should start with a lower case character, so they
' // will not be listed in the Network Monitor's function browser.
' //////////////////////////////////////////////////////////////////////////////
Function getCredentials( strHost, strAltCredentials, BYREF strAltLogin, BYREF strAltPassword, BYREF strSysExplanation )
Dim objNMServerCredentials
strAltLogin = ""
strAltPassword = ""
strSysExplanation = ""
getCredentials = False
If( strAltCredentials = "" ) Then
' No alternate credentials specified, so login and password are empty and service credentials will be used
getCredentials = True
Exit Function
End If
Set objNMServerCredentials = CreateObject( "ActiveXperts.NMServerCredentials" )
strAltLogin = objNMServerCredentials.GetLogin( strAltCredentials )
strAltPassword = objNMServerCredentials.GetPassword( strAltCredentials )
If( strAltLogin = "" ) Then
getCredentials = False
strSysExplanation = "No alternate credentials defined for [" & strAltCredentials & "]. In the Manager application, select 'Options' from the 'Tools' menu and select the 'Server Credentials' tab to enter alternate credentials"
Exit Function
End If
getCredentials = True
End Function
' //////////////////////////////////////////////////////////////////////////////
Function getRegistryValue ( objReg, strRootKey, strPath, strValueName )
Dim strValue, arrValueNames, arrValueTypes, n, j, hKey, arrBytes
' When root key name is invalid, the function defaults to HKLM
hKey = getRootKeyValue ( strRootKey )
' Set default error which is used in case the value is not found
getRegistryValue = False
SYSEXPLANATION = "Unable to access value [" & strValueName & "]. Most probably the value does not exist in the selected path."
if ( objReg.EnumValues ( hKey, strPath, arrValueNames, arrValueTypes ) <> 0 ) Then
SYSEXPLANATION = "Unable to access key [" & strPath & "]. Most probably the key does not exist."
Exit Function
End If
For n = 0 To UBound ( arrValueNames )
If ( strValueName = arrValueNames ( n ) ) Then
Select Case arrValueTypes ( n )
Case REG_SZ
objReg.GetStringValue hKey, strPath, strValueName, strValue
Case REG_EXPAND_SZ
objReg.GetExpandedStringValue hKey, strPath, strValueName, strValue
Case REG_BINARY
objReg.GetBinaryValue hKey, strPath, strValueName, arrBytes
For j = 0 to Ubound ( arrBytes )
If ( Len ( Hex ( arrBytes ( j ) ) ) = 1 ) Then
strValue = strValue + "0" + Hex ( arrBytes ( j ) )
Else
strValue = strValue + Hex ( arrBytes ( j ) )
End If
Next
Case REG_DWORD
objReg.GetDWORDValue hKey, strPath, strValueName, strValue
Case REG_MULTI_SZ
objReg.GetMultiStringValue hKey, strPath, strValueName, strValue
End Select
' When Found
SYSEXPLANATION = ""
SYSDATA = strValue
getRegistryValue = True
End If
Next
End Function
' //////////////////////////////////////////////////////////////////////////////
Function getRootKeyValue ( strRootKey )
' Default:
getRootKeyValue = HKEY_LOCAL_MACHINE
' Make UpperCase
strRootKey = UCase ( strRootKey )
If ( ( strRootKey = "HKLM" ) Or ( strRootKey = "HKEY_LOCAL_MACHINE" ) ) Then
getRootKeyValue = HKEY_LOCAL_MACHINE
End If
If ( ( strRootKey = "HKCU" ) Or ( strRootKey = "HKEY_CURRENT_USER" ) ) Then
getRootKeyValue = HKEY_CURRENT_USER
End If
If ( ( strRootKey = "HKCR" ) Or ( strRootKey = "HKEY_CLASSES_ROOT" ) ) Then
getRootKeyValue = HKEY_CLASSES_ROOT
End If
If ( strRootKey = "HKEY_USERS" ) Then
getRootKeyValue = HKEY_USERS
End If
If ( strRootKey = "HKEY_CURRENT_CONFIG" ) Then
getRootKeyValue = HKEY_CURRENT_CONFIG
End If
End Function
' //////////////////////////////////////////////////////////////////////////////
Function getRegistryObject ( strHost, strAltLogin, strAltPassword, BYREF objRegService, BYREF strSysExplanation )
On Error Resume Next
Dim objNMServerCredentials, objSWbemLocator, objWMIService, strUsername, strPassword
If ( strAltLogin = "" ) Then
' Connect to remote host on same domain using same security context
Set objRegService = GetObject ("winmgmts:{impersonationLevel=impersonate}!\\" & strHost & "\root\default:StdRegProv")
Else
Set objSWbemLocator = CreateObject( "WbemScripting.SWbemLocator" )
Set objWMIService = objSWbemLocator.ConnectServer ( strHost, "Root\DEFAULT", strAltLogin, strAltPassword )
If ( Err.Number <> 0 ) Then
objWMIService = Nothing
getRegistryObject = False
SYSEXPLANATION = "Unable to access [" & strHost & "]. Possible reasons: WMI not running on the remote server, Windows firewall is blocking WMI calls, insufficient rights, or remote server down"
Exit Function
End If
objWMIService.Security_.ImpersonationLevel = 3
Set objRegService = objWMIService.Get ( "StdRegProv" )
End If
If ( Err.Number <> 0 ) Then
objRegService = Nothing
getRegistryObject = False
SYSEXPLANATION = "Unable to access '" & strHost & "'. Possible reasons: no WMI installed on the remote server, no rights to access remote WMI service, or remote server down"
Exit Function
End If
getRegistryObject = True
On Error Goto 0
End Function
' //////////////////////////////////////////////////////////////////////////////