This module type is used to discovery instances of Microsoft SQL Server 2012 Reporting Services. The module queries the registry and WMI for installation information.
Dim g_aDatabaseExcludeArray
Dim g_bDatabaseExclusion
Dim g_aJobExcludeArray
Dim g_bJobExclusion
Dim TargetComputer
Dim TargetComputerID
Dim IsTargetVirtualServer
Dim SourceID
Dim ManagedEntityID
Dim TargetNetBIOSName
Dim g_oUtil
Dim g_oSQL
Dim g_List
Call Main()
'==========================================================================
' Class: Util
' Description: Utility methods for logging, creating MOM alert
'==========================================================================
Class Util
' Used to say to LogMessage when/how to print the message.
Public DBG_NONE
Public DBG_ERROR
Public DBG_WARNING
Public DBG_TRACE
Public HKEY_LOCAL_MACHINE
'=============
' Method: Class_Initialize
' Description: This is the constructor
' Parameters:
'=============
Private Sub Class_Initialize()
' Initialize Debug level constants
DBG_TRACE = 1
DBG_WARNING = 2
DBG_ERROR = 3
DBG_NONE = 4
'by default only errors are logged
m_nDebugLevel = DBG_ERROR
Set m_oSafeRegistry = New SafeRegistry
m_oSafeRegistry.Connect(TargetComputer)
m_oSafeRegistry.SuppressionFlags = (m_oSafeRegistry.SUPPRESS_KEY_NOT_FOUND Or m_oSafeRegistry.SUPPRESS_VALUE_NOT_FOUND)
End Sub
'=============
' Method: SetDebugLevel
' Description: To change the debugging output level of information
' generated by this utility.
' Parameters:
' nLevel - Level, either DBG_NONE, DBG_TRACE,
' DBG_WARNING or DBG_ERROR
'=============
Public Sub SetDebugLevel(ByVal nLevel)
m_nDebugLevel = nLevel
End Sub
'=============
' Method: LogMessage
' Description: Log a debug message to ScriptContext
' Parameters:
' nLevel - Debug level for the message that we're logging.
' strMessage - The message to write to the trace.
'=============
Public Sub LogMessage( _
ByVal nLevel, _
ByVal strMessage _
)
If (nLevel >= m_nDebugLevel) Then
if (nLevel = DBG_ERROR) Then
Wscript.Echo "[Error]: " & strMessage
ElseIf (nLevel = DBG_WARNING) Then
Wscript.Echo "[Warning]: " & strMessage
ElseIf (nLevel = DBG_TRACE) Then
Wscript.Echo "[Trace]:" & strMessage
End If
End If
End Sub
'=============
' Method: SplitVerStr
' Description: Split a version string into integers.
' Parameters:
' strVer - The version string.
' iMajor - The output integer for major version.
' iMinor - The output integer for minor version.
'=============
Function SplitVerStr(ByVal strVer, ByRef iMajor, ByRef iMinor)
Dim iPos
Dim strMinor
iPos = InStr(strVer, ".")
if 0 = iPos then
iMajor = CInt(strVer)
iMinor = 0
Exit Function
end if
if 0 = iPos then
iMinor = CInt(strMinor)
else
iMinor = CInt(Left(strMinor, iPos))
end if
End Function
'=============
' Method: ReadRegistryValue
' Description: Used to read strings from the registry
' Parameters:
' Root - Root of the registry (HKEY_LOCAL_MACHINE, HKEY_USERS etc. Refer to constants defined earlier)
' strKeyPath - Key path for the Registry key to read
' (like "SOFTWARE\Microsoft\WindowsNT\CurrentVersion")
' strValueName - Name of the registry entry to read (like "SoftwareType")
'
' Returns:
' The value of the registry key specified. "Nothing" if it fails. Callee needs to handle null value return.
'=============
Public Function ReadRegistryValue(strKeyPath, strValueName)
Dim lResult
Dim strValueData
strValueData = m_oSafeRegistry.ReadStringValue(strKeyPath, strValueName, lResult)
If Not IsNull(strValueData) Then
Call LogMessage(DBG_TRACE, "Value of Registry Key: " & strKeyPath & "\" & strValueName & " = " & strValueData)
ReadRegistryValue = strValueData
Else
Call LogMessage(DBG_ERROR, "Reading Registry Key: " & strKeyPath & "\" & strValueName & " Failed!" )
ReadRegistryValue = empty
End If
End Function
End Class
Class Error
Private m_lNumber
Private m_sSource
Private m_sDescription
Private m_sHelpContext
Private m_sHelpFile
Public Sub Save()
m_lNumber = Err.number
m_sSource = Err.Source
m_sDescription = Err.Description
m_sHelpContext = Err.HelpContext
m_sHelpFile = Err.helpfile
End Sub
Public Sub Raise()
Err.Raise m_lNumber, m_sSource, m_sDescription, m_sHelpFile, m_sHelpContext
End Sub
Public Sub Clear()
m_lNumber = 0
m_sSource = ""
m_sDescription = ""
m_sHelpContext = ""
m_sHelpFile = ""
End Sub
Public Default Property Get Number()
Number = m_lNumber
End Property
Public Property Get Source()
Source = m_sSource
End Property
Public Property Get Description()
Description = m_sDescription
End Property
Public Property Get HelpContext()
HelpContext = m_sHelpContext
End Property
Public Property Get HelpFile()
HelpFile = m_sHelpFile
End Property
End Class
Class Registry
Public HKEY_CLASSES_ROOT
Public HKEY_CURRENT_USER
Public HKEY_LOCAL_MACHINE
Public HKEY_USERS
Public HKEY_CURRENT_CONFIG
Public HKEY_DYN_DATA
Public ERROR_ACCESS_DENIED
Public ERROR_KEY_NOT_FOUND
Public ERROR_VALUE_NOT_FOUND
Public SUCCESS
Public Sub Connect(ByVal sHostName)
Set m_oReg = GetObject("winmgmts://" & sHostName & "/root/default:StdRegProv")
End Sub
Public Property Get Hive()
Hive = m_lHive
End Property
Public Property Let Hive(ByVal lHive)
m_lHive = lHive
End Property
Public Function ReadDWORDValue(ByVal sKeyPath, ByVal sValueName, ByRef lResult)
Dim lValue
lResult = m_oReg.GetDWORDValue(m_lHive, sKeyPath, sValueName, lValue)
ReadDWORDValue = lValue
End Function
Public Function ReadStringValue(ByVal sKeyPath, ByVal sValueName, ByRef lResult)
Dim sValue
lResult = m_oReg.GetStringValue(m_lHive, sKeyPath, sValueName, sValue)
ReadStringValue = sValue
End Function
Public Function ReadMultiStringValue(ByVal sKeyPath, ByVal sValueName, ByRef lResult)
Dim aValues
lResult = m_oReg.GetMultiStringValue(m_lHive, sKeyPath, sValueName, aValues)
ReadMultiStringValue = aValues
End Function
Public Function EnumKeys(ByVal sKeyPath, ByRef lResult)
Dim aSubKeys
lResult = m_oReg.EnumKey(m_lHive, sKeyPath, aSubKeys)
EnumKeys = aSubKeys
End Function
Public Function CreateKey(ByVal sKeyPath)
CreateKey = m_oReg.CreateKey(m_lHive, sKeyPath)
End Function
Public Function WriteStringValue(ByVal sKeyPath, ByVal sValueName, ByVal sValue)
WriteStringValue = m_oReg.SetStringValue(m_lHive, sKeyPath, sValueName, sValue)
End Function
Public Function DeleteValue(ByVal sKeyPath, ByVal sValueName)
DeleteValue = m_oReg.DeleteValue(m_lHive, sKeyPath, sValueName)
End Function
Public Function ReadBinaryValue(ByVal sKeyPath, ByVal sValueName, ByRef lResult)
Dim aData
lResult = m_oReg.GetBinaryValue(m_lHive, sKeyPath, sValueName, aData)
ReadBinaryValue = aData
End Function
End Class
m_lSuppressionFlags = 0
Hive = HKEY_LOCAL_MACHINE
End Sub
Public Function Connect(ByVal sHostName)
Connect = False
m_sHost = sHostName
On Error Resume Next
m_oRegistry.Connect sHostName
m_oError.Save
On Error Goto 0
If m_oError.Number <> 0 Then
ThrowScriptErrorNoAbort "Failed to connect to the WMI registry provider on " & sHostName , m_oError
Else
Connect = True
End If
End Function
Public Property Get Hive()
Hive = m_oRegistry.Hive
End Property
Public Property Let Hive(ByVal lHive)
Select Case lHive
Case HKEY_CLASSES_ROOT
m_sHive = "HKCR"
Case HKEY_CURRENT_USER
m_sHive = "HKCU"
Case HKEY_LOCAL_MACHINE
m_sHive = "HKLM"
Case HKEY_USERS
m_sHive = "HKU"
Case HKEY_CURRENT_CONFIG
m_sHive = "HKCC"
Case HKEY_DYN_DATA
m_sHive = "HKDD"
Case Else
m_sHive = "Invalid"
End Select
m_oRegistry.Hive = lHive
End Property
Public Property Let SuppressionFlags(ByVal lValue)
m_lSuppressionFlags = lValue
End Property
Public Property Get SuppressionFlags()
SuppressionFlags = m_lSuppressionFlags
End Property
Public Function ReadDWORDValue(ByVal sKeyPath, ByVal sValueName, ByRef lResult)
ReadDWORDValue = Null
On Error Resume Next
ReadDWORDValue = m_oRegistry.ReadDWORDValue(sKeyPath, sValueName, lResult)
m_oError.Save
On Error Goto 0
If m_oError.Number <> 0 Then
ThrowScriptErrorNoAbort GET_ERROR_READING_REGISTRY_MESSAGE(m_sHost, m_sHive, sKeyPath, sValueName), m_oError
Exit Function
End If
HandleResult m_sHost, m_sHive, sKeyPath, sValueName, lResult
End Function
Public Function ReadStringValue(ByVal sKeyPath, ByVal sValueName, ByRef lResult)
ReadStringValue = Null
On Error Resume Next
ReadStringValue = m_oRegistry.ReadStringValue(sKeyPath, sValueName, lResult)
m_oError.Save
On Error Goto 0
If m_oError.Number <> 0 Then
ThrowScriptErrorNoAbort GET_ERROR_READING_REGISTRY_MESSAGE(m_sHost, m_sHive, sKeyPath, sValueName), m_oError
Exit Function
End If
HandleResult m_sHost, m_sHive, sKeyPath, sValueName, lResult
End Function
Public Function ReadMultiStringValue(ByVal sKeyPath, ByVal sValueName, ByRef lResult)
ReadMultiStringValue = Null
On Error Resume Next
ReadMultiStringValue = m_oRegistry.ReadMultiStringValue(sKeyPath, sValueName, lResult)
m_oError.Save
On Error Goto 0
If m_oError.Number <> 0 Then
ThrowScriptErrorNoAbort GET_ERROR_READING_REGISTRY_MESSAGE(m_sHost, m_sHive, sKeyPath, sValueName), m_oError
Exit Function
End If
HandleResult m_sHost, m_sHive, sKeyPath, sValueName, lResult
End Function
Public Function EnumKeys(ByVal sKeyPath, ByRef lResult)
EnumKeys = Null
On Error Resume Next
EnumKeys = m_oRegistry.EnumKeys(sKeyPath, lResult)
m_oError.Save
On Error Goto 0
If m_oError.Number <> 0 Then
ThrowScriptErrorNoAbort GET_ERROR_READING_KEY_MESSAGE(m_sHost, m_sHive, sKeyPath), m_oError
Exit Function
End If
HandleResult m_sHost, m_sHive, sKeyPath, "", lResult
End Function
Public Function CreateKey(ByVal sKeyPath)
Dim lResult
On Error Resume next
lResult = m_oRegistry.CreateKey(sKeyPath)
m_oError.Save
On Error Goto 0
If m_oError.Number <> 0 Then
ThrowScriptErrorNoAbort GET_ERROR_CREATING_KEY_MESSAGE(m_sHost, m_sHive, sKeyPath), m_oError
Exit Function
End If
HandleResult m_sHost, m_sHive, sKeyPath, "", lResult
CreateKey = lResult
End Function
Public Function WriteStringValue(ByVal sKeyPath, ByVal sValueName, ByVal sValue)
Dim lResult
On Error Resume Next
lResult = m_oRegistry.WriteStringValue(sKeyPath, sValueName, sValue)
m_oError.Save
On Error Goto 0
If m_oError.Number <> 0 Then
ThrowScriptErrorNoAbort GET_ERROR_WRITING_REGISTRY_MESSAGE(m_sHost, m_sHive, sKeyPath, sValueName), m_oError
Exit Function
End If
HandleResult m_sHost, m_sHive, sKeyPath, sValueName, lResult
WriteStringValue = lResult
End Function
Public Function DeleteValue(ByVal sKeyPath, ByVal sValueName)
Dim lResult
On Error Resume Next
lResult = m_oRegistry.DeleteValue(sKeyPath, sValueName)
m_oError.Save
On Error Goto 0
If m_oError.Number <> 0 Then
ThrowScriptErrorNoAbort GET_ERROR_DELETING_VALUE_MESSAGE(m_sHost, m_sHive, sKeyPath, sValueName), m_oError
Exit Function
End If
'#doc
'This method seems to return key not found even if it is the value that is not found.
'#end doc
If lResult = ERROR_KEY_NOT_FOUND Then lResult = ERROR_VALUE_NOT_FOUND
HandleResult m_sHost, m_sHive, sKeyPath, sValueName, lResult
DeleteValue = lResult
End Function
Public Function ReadBinaryValue(ByVal sKeyPath, ByVal sValueName, ByRef lResult)
ReadBinaryValue = Null
On Error Resume Next
ReadBinaryValue = m_oRegistry.ReadBinaryValue(sKeyPath, sValueName, lResult)
m_oError.Save
On Error Goto 0
If m_oError.Number <> 0 Then
ThrowScriptErrorNoAbort GET_ERROR_READING_REGISTRY_MESSAGE(m_sHost, m_sHive, sKeyPath, sValueName), m_oError
Exit Function
End If
HandleResult m_sHost, m_sHive, sKeyPath, sValueName, lResult
End Function
Private Sub HandleResult(ByVal sHost, ByVal sHive, ByVal sKeyPath, ByVal sValueName, ByVal lResult)
Select Case lResult
Case SUCCESS
Exit Sub
Case ERROR_ACCESS_DENIED
If (SuppressionFlags And SUPPRESS_ACCESS_DENIED) = 0 Then
ThrowScriptErrorNoAbort GET_REGISTRY_ACCESS_DENIED_MESSAGE(sHost, sHive, sKeyPath, sValueName), Err
Else
Wscript.Echo GET_REGISTRY_ACCESS_DENIED_MESSAGE(sHost, sHive, sKeyPath, sValueName)
End If
Case ERROR_VALUE_NOT_FOUND
If (SuppressionFlags And SUPPRESS_VALUE_NOT_FOUND) = 0 Then
ThrowScriptErrorNoAbort GET_REGISTRY_VALUE_NOT_FOUND_MESSAGE(sHost, sHive, sKeyPath, sValueName), Err
Else
Wscript.Echo GET_REGISTRY_VALUE_NOT_FOUND_MESSAGE(sHost, sHive, sKeyPath, sValueName)
End If
Case ERROR_KEY_NOT_FOUND
If (SuppressionFlags And SUPPRESS_KEY_NOT_FOUND) = 0 Then
ThrowScriptErrorNoAbort GET_REGISTRY_KEY_NOT_FOUND_MESSAGE(sHost, sHive, sKeyPath), Err
Else
Wscript.Echo GET_REGISTRY_KEY_NOT_FOUND_MESSAGE(sHost, sHive, sKeyPath)
End If
Case Else
If (SuppressionFlags And SUPPRESS_ALL) = 0 Then
ThrowScriptErrorNoAbort GET_ERROR_READING_REGISTRY_MESSAGE(sHost, sHive, sKeyPath, sValueName), Err
Else
Wscript.Echo GET_ERROR_READING_REGISTRY_MESSAGE(sHost, sHive, sKeyPath, sValueName)
End If
End Select
End Sub
Private Function GET_REGISTRY_ACCESS_DENIED_MESSAGE(ByVal sHost, ByVal sHive, ByVal sRegKey, ByVal sRegValue)
Const REGISTRY_ACCESS_DENIED_MESSAGE = "Access denied while reading registry value [\\{Host}\{Hive}\{RegKey}\{RegValue}]"
If sRegValue = "" Then sRegValue = DEFAULT_VALUE_NAME
Dim sResult
sResult = Replace(REGISTRY_ACCESS_DENIED_MESSAGE, "{RegKey}", sRegKey)
sResult = Replace(sResult, "{Hive}", sHive)
sResult = Replace(sResult, "{Host}", sHost)
GET_REGISTRY_ACCESS_DENIED_MESSAGE = Replace(sResult, "{RegValue}", sRegValue)
End Function
Private Function GET_REGISTRY_VALUE_NOT_FOUND_MESSAGE(ByVal sHost, ByVal sHive, ByVal sRegKey, ByVal sRegValue)
Const REGISTRY_VALUE_NOT_FOUND_MESSAGE = "Registry value [\\{Host}\{Hive}\{RegKey}\{RegValue}] not found"
If sRegValue = "" Then sRegValue = DEFAULT_VALUE_NAME
Dim sResult
sResult = Replace(REGISTRY_VALUE_NOT_FOUND_MESSAGE, "{RegKey}", sRegKey)
sResult = Replace(sResult, "{Hive}", sHive)
sResult = Replace(sResult, "{Host}", sHost)
GET_REGISTRY_VALUE_NOT_FOUND_MESSAGE = Replace(sResult, "{RegValue}", sRegValue)
End Function
Private Function GET_ERROR_READING_REGISTRY_MESSAGE(ByVal sHost, ByVal sHive, ByVal sRegKey, ByVal sRegValue)
Const ERROR_READING_REGISTRY_MESSAGE = "Error while reading registry value [\\{Host}\{Hive}\{RegKey}\{RegValue}]"
If sRegValue = "" Then sRegValue = DEFAULT_VALUE_NAME
Dim sResult
sResult = Replace(ERROR_READING_REGISTRY_MESSAGE, "{RegKey}", sRegKey)
sResult = Replace(sResult, "{Hive}", sHive)
sResult = Replace(sResult, "{Host}", sHost)
GET_ERROR_READING_REGISTRY_MESSAGE = Replace(sResult, "{RegValue}", sRegValue)
End Function
Private Function GET_REGISTRY_KEY_NOT_FOUND_MESSAGE(ByVal sHost, ByVal sHive, ByVal sRegKey)
Const REGISTRY_KEY_NOT_FOUND_MESSAGE = "Registry key [\\{Host}\{Hive}\{RegKey}] not found"
Dim sResult
sResult = Replace(REGISTRY_KEY_NOT_FOUND_MESSAGE, "{Hive}", sHive)
sResult = Replace(sResult, "{Host}", sHost)
GET_REGISTRY_KEY_NOT_FOUND_MESSAGE = Replace(sResult, "{RegKey}", sRegKey)
End Function
Private Function GET_ERROR_READING_KEY_MESSAGE(ByVal sHost, ByVal sHive, ByVal sRegKey)
Const ERROR_READING_KEY_MESSAGE = "Error while reading registry key [\\{Host}\{Hive}\{RegKey}]"
Dim sResult
sResult = Replace(ERROR_READING_KEY_MESSAGE, "{Hive}", sHive)
sResult = Replace(sResult, "{Host}", sHost)
GET_ERROR_READING_KEY_MESSAGE = Replace(sResult, "{RegKey}", sRegKey)
End Function
Private Function GET_ERROR_CREATING_KEY_MESSAGE(ByVal sHost, ByVal sHive, ByVal sRegKey)
Const ERROR_CREATING_KEY_MESSAGE = "Error while creating registry key [\\{Host}\{Hive}\{RegKey}]"
Dim sResult
sResult = Replace(ERROR_CREATING_KEY_MESSAGE, "{Hive}", sHive)
sResult = Replace(sResult, "{Host}", sHost)
GET_ERROR_CREATING_KEY_MESSAGE = Replace(sResult, "{RegKey}", sRegKey)
End Function
Private Function GET_ERROR_WRITING_REGISTRY_MESSAGE(ByVal sHost, ByVal sHive, ByVal sRegKey, ByVal sRegValue)
Const ERROR_WRITING_REGISTRY_MESSAGE = "Error while writing registry value [\\{Host}\{Hive}\{RegKey}\{RegValue}]"
If sRegValue = "" Then sRegValue = DEFAULT_VALUE_NAME
Dim sResult
sResult = Replace(ERROR_WRITING_REGISTRY_MESSAGE, "{RegKey}", sRegKey)
sResult = Replace(sResult, "{Hive}", sHive)
sResult = Replace(sResult, "{Host}", sHost)
GET_ERROR_WRITING_REGISTRY_MESSAGE = Replace(sResult, "{RegValue}", sRegValue)
End Function
Private Function GET_ERROR_DELETING_VALUE_MESSAGE(ByVal sHost, ByVal sHive, ByVal sRegKey, ByVal sRegValue)
Const ERROR_DELETING_VALUE_MESSAGE = "Error while deleting registry value [\\{Host}\{Hive}\{RegKey}\{RegValue}]"
If sRegValue = "" Then sRegValue = DEFAULT_VALUE_NAME
Dim sResult
sResult = Replace(ERROR_DELETING_VALUE_MESSAGE, "{RegKey}", sRegKey)
sResult = Replace(sResult, "{Hive}", sHive)
sResult = Replace(sResult, "{Host}", sHost)
GET_ERROR_DELETING_VALUE_MESSAGE = Replace(sResult, "{RegValue}", sRegValue)
End Function
End Class
'******************************************************************************
' Name - SQL - SQL Server Utility Class
'
'
Class SQL
Public HKEY_LOCAL_MACHINE
Public SQL_KEY_ROOT
Public SQL_KEY_ROOT_WOW64
Public SQL_KEY_ENGINE_INSTANCE_NAMES
Public SQL_KEY_ENGINE_INSTANCE_NAMES_WOW64
Public RS_KEY_ENGINE_INSTANCE_NAMES
Public RS_KEY_ENGINE_INSTANCE_NAMES_WOW64
Public AS_KEY_ENGINE_INSTANCE_NAMES
Public AS_KEY_ENGINE_INSTANCE_NAMES_WOW64
Public SQL_DEFAULT
Public SQL_KEY_NAMED
Public SQL_VAL_INSTINST
Public SERVICESTATE_GREEN
Public SERVICESTATE_YELLOW
Public SERVICESTATE_RED
Public DATABASE_EXCLUDE_FILENAME
Public DATABASE_EXCLUDE_DIRECTORY
Public JOB_EXCLUDE_FILENAME
Public JOB_EXCLUDE_DIRECTORY
public STANDARD_SQLSERVICETYPE_SQLSERVER
public STANDARD_SQLSERVICETYPE_SQLAGENT
public STANDARD_SQLSERVICETYPE_MSSEARCH
public STANDARD_SQLSERVICETYPE_MSDTS
public STANDARD_SQLSERVICETYPE_OLAP
public STANDARD_SQLSERVICETYPE_REPORT
public STANDARD_SQLSERVICETYPE_SQLBROWSER
public STANDARD_SQLSERVICETYPE_NOTIFICATION
public SERVICEADVANCEDPROPERTY_TYPE_STRING
public SERVICEADVANCEDPROPERTY_TYPE_FLAG
public SERVICEADVANCEDPROPERTY_TYPE_NUMBER
public SERVICEADVANCEDPROPERTY_NAME_VERSION
public SERVICEADVANCEDPROPERTY_NAME_SPLEVEL
public SERVICEADVANCEDPROPERTY_NAME_CLUSTERED
public SERVICEADVANCEDPROPERTY_NAME_INSTALLPATH
public SERVICEADVANCEDPROPERTY_NAME_DATAPATH
public SERVICEADVANCEDPROPERTY_NAME_LANGUAGE
public SERVICEADVANCEDPROPERTY_NAME_FILEVERSION
public SERVICEADVANCEDPROPERTY_NAME_VSNAME
public SERVICEADVANCEDPROPERTY_NAME_REGROOT
public SERVICEADVANCEDPROPERTY_NAME_SKU
public SERVICEADVANCEDPROPERTY_NAME_INSTANCEID
public SERVICEADVANCEDPROPERTY_NAME_STARTUPPARAMETERS
public SERVICEADVANCEDPROPERTY_NAME_SQLSTATES
public SERVICEADVANCEDPROPERTY_NAME_ERRORREPORTING
public SERVICEADVANCEDPROPERTY_NAME_DUMPDIR
public SERVICEADVANCEDPROPERTY_NAME_SQMREPORTING
public SERVICEADVANCEDPROPERTY_NAME_SKUNAME
public SERVICEADVANCEDPROPERTY_NAME_ISWOW64
public SERVICEADVANCEDPROPERTY_NAME_BROWSER
'******************************************************************************
' Name: Class_Initialize
'
' Purpose: Initialize the public methods of the class
'
' Parameters: None
'
' Returns: None
'
Private Sub Class_Initialize()
Set m_oSafeRegistry = New SafeRegistry
m_bConnectedToRegistry = m_oSafeRegistry.Connect(TargetComputer)
m_oSafeRegistry.SuppressionFlags = (m_oSafeRegistry.SUPPRESS_KEY_NOT_FOUND Or m_oSafeRegistry.SUPPRESS_VALUE_NOT_FOUND)
Public Property Get ConnectedToRegistry
ConnectedToRegistry = m_bConnectedToRegistry
End Property
'******************************************************************************
' Name: CreateConnectionFailureAlert
'
' Purpose: To generate an alert stating the reason for failing to connect to a SQL instance when it is running.
' Does nothing if the instance is not running.
'
' Parameters: sInstance, The SQL instance
' lErrNumber, The error number returned from the connection attempt
' sErrDescription, The error description returned from the connection attempt
'
' Returns: nothing
'
Public Sub CreateConnectionFailureAlert(sInstance, lErrNumber, sErrDescription)
If IsSQLServiceStarted(sInstance) = 1 Then
CreateAlert ALERT_WARNING, _
"SQL Server 2012 Service Availability", _
GetConnectionFailureMessage(sInstance, lErrNumber, sErrDescription), _
"", _
""
End If
End Sub
'******************************************************************************
' Name: GetRunningInstances
'
' Purpose:
'
' Parameters:
'
' Returns:
'
Public Function GetRunningInstances(ByVal aInstances, ByRef aNonRunningInstances)
Dim sWQLNameList
Dim sInstance
If Not IsArray(aInstances) Then Exit Function
For Each sInstance In aInstances
If sWQLNameList <> "" Then sWQLNameList = sWQLNameList & " or "
sWQLNameList = sWQLNameList & "Name = '" & GetSQLServiceName(sInstance) & "'"
Next
If sWQLNameList <> "" Then
Dim sWQLQuery
sWQLQuery = "select Name from Win32_Service where (" & sWQLNameList & ")"
Dim sNamespace
sNamespace = "winmgmts://" & TargetComputer & "/root/cimv2"
Dim oRunning
Set oRunning = WMIExecQuery(sNamespace, sWQLQuery & " and State = 'Running'")
Dim oNotRunning
Set oNotRunning = WMIExecQuery(sNamespace, sWQLQuery & " and State <> 'Running'")
aNonRunningInstances = CreateSQLInstanceArray(oNotRunning)
End If
End Function
'******************************************************************************
' Name: CreateSQLInstanceArray
'
' Purpose:
'
' Parameters:
'
' Returns:
'
Private Function CreateSQLInstanceArray(ByVal oServiceObjectSet)
Dim aInstances
If oServiceObjectSet.Count > 0 Then
ReDim aInstances(oServiceObjectSet.Count - 1)
Dim i
i = 0
Dim oService
For Each oService in oServiceObjectSet
aInstances(i) = GetSQLInstanceNameFromServiceName(oService.Name)
i = i + 1
Next
End If
CreateSQLInstanceArray = aInstances
End Function
'******************************************************************************
' Name: GetInstanceKeyRoot
'
' Purpose: Gets the path to the root registry key for the instance's
' registry values
'
' Parameters: sInstance - The SQL instance name
'
' Returns: the root registry path
'
Public Function GetInstanceKeyRoot(ByVal sServerType, ByVal sInstance, ByVal bIsWOW64)
Dim sInternalInstanceName
Select Case sServerType
Case "SQL"
'The condition below will be true if it is a 32 bit instance of sql on 64 bit OS
If (bIsWOW64) Then
sInternalInstanceName = ReadRegistryStringValue(SQL_KEY_ENGINE_INSTANCE_NAMES_WOW64, sInstance)
Else
sInternalInstanceName = ReadRegistryStringValue(SQL_KEY_ENGINE_INSTANCE_NAMES, sInstance)
End If
Case "RS"
If (bIsWOW64) Then
sInternalInstanceName = ReadRegistryStringValue(RS_KEY_ENGINE_INSTANCE_NAMES_WOW64, sInstance)
Else
sInternalInstanceName = ReadRegistryStringValue(RS_KEY_ENGINE_INSTANCE_NAMES, sInstance)
End If
Case "AS"
If (bIsWOW64) Then
sInternalInstanceName = ReadRegistryStringValue(AS_KEY_ENGINE_INSTANCE_NAMES_WOW64, sInstance)
Else
sInternalInstanceName = ReadRegistryStringValue(AS_KEY_ENGINE_INSTANCE_NAMES, sInstance)
End If
End Select
If (bIsWOW64)Then
GetInstanceKeyRoot = SQL_KEY_ROOT_WOW64 & "\" & sInternalInstanceName
Else
GetInstanceKeyRoot = SQL_KEY_ROOT & "\" & sInternalInstanceName
End If
End Function
'******************************************************************************
' Name: GetI nstanceKey
'
' Purpose: Gets the path to the registry key for the instance of a specified Server Type
'
' Parameters: sInstance - The SQL instance name
'
' Returns: the registry path
'
Public Function GetInstanceKey(ByVal sServerType, ByVal sInstance, ByVal sKey, ByVal bIs64Bit)
GetInstanceKey = GetInstanceKeyRoot(sServerType, sInstance,bIs64Bit) & "\" & sKey
End Function
'******************************************************************************
' Name: GetSQLInstanceKeyRoot
'
' Purpose: Gets the path to the root registry key for the instance's
' registry values
'
' Parameters: sInstance - The SQL instance name
'
' Returns: the root registry path
'
Public Function GetSQLInstanceKeyRoot(ByVal sInstance,ByVal bIs64Bit)
GetSQLInstanceKeyRoot = GetInstanceKeyRoot("SQL", sInstance,bIs64Bit)
End Function
'******************************************************************************
' Name: GetSQLInstanceKey
'
' Purpose: Gets the path to the registry key for the instance
'
' Parameters: sInstance - The SQL instance name
'
' Returns: the registry path
'
Public Function GetSQLInstanceKey(ByVal sInstance, ByVal sKey,ByVal bIs64Bit)
GetSQLInstanceKey = GetInstanceKey("SQL", sInstance, sKey, bIs64Bit)
End Function
'******************************************************************************
' Name: GetRSInstanceKey
'
' Purpose: Gets the path to the registry key for the instance
'
' Parameters: sInstance - The SQL instance name
'
' Returns: the registry path
'
Public Function GetRSInstanceKey(ByVal sInstance, ByVal sKey, ByVal bIs64Bit)
GetRSInstanceKey = GetInstanceKey("RS", sInstance, sKey, bIs64Bit)
End Function
'******************************************************************************
' Name: GetASInstanceKey
'
' Purpose: Gets the path to the registry key for the instance
'
' Parameters: sInstance - The SQL instance name
'
' Returns: the registry path
'
Public Function GetASInstanceKey(ByVal sInstance, ByVal sKey, ByVal bIs64Bit)
GetASInstanceKey = GetInstanceKey("AS", sInstance, sKey, bIs64Bit)
End Function
'******************************************************************************
' Name: GetConnectionFailureMessage
'
' Purpose: To generate a message stating the reason for failing to connect to a SQL instance
'
' Parameters: sInstance, The SQL instance
' lErrNumber, The error number returned from the connection attempt
' sErrDescription, The error description returned from the connection attempt
'
' Returns: The failure message
'
Public Function GetConnectionFailureMessage(sInstance, lErrNumber, sErrDescription)
Dim sFailureReason
Dim sSQLServiceName
sSQLServiceName = GetSQLServiceName(sInstance)
Dim sResult
Select Case IsSQLServiceStarted(sInstance)
Case -2
sFailureReason = "is not installed"
Case -1, 0
sFailureReason = "is not running"
Case 1
Const DB_CONNECTION_FAILURE_MESSAGE = "The SQL Server management pack script ""SQL Server 2012 Service Availability"" is unable to successfully connect to the SQL Server instance ""{ServiceName}"". The error message returned is ""{Description}"""
sResult = Replace(DB_CONNECTION_FAILURE_MESSAGE, "{ServiceName}", sSQLServiceName)
GetConnectionFailureMessage = Replace(sResult, "{Description}", sErrDescription)
Exit Function
End Select
Const DB_CONNECTION_NO_SERVICE_MESSAGE = "The SQL Server service ({ServiceName}) {FailureReason}."
sResult = Replace(DB_CONNECTION_NO_SERVICE_MESSAGE, "{ServiceName}", sSQLServiceName)
GetConnectionFailureMessage = Replace(sResult, "{FailureReason}", sFailureReason)
End Function
'******************************************************************************
' Name: IsSupportedVersion
'
' Purpose: Checks if this instance is supported
'
' Parameters: sInstance, the name of the instance to check
'
' Returns: True if Microsoft SQL Server 2012
' False if earlier than Microsoft SQL Server 2012
Public Function IsSupportedVersion(sInstance)
If Not ISNull(sResult) AND Left(sResult,iVersionSize) = SUPPORTED_VERSION Then
IsSupportedVersion = True
Call g_oUtil.LogMessage(g_oUtil.DBG_TRACE, "IsSupportedVersion True for: " & sInstance)
Else
IsSupportedVersion = False
Call g_oUtil.LogMessage(g_oUtil.DBG_TRACE, "IsSupportedVersion False for: " & sInstance)
End If
End Function
'*****************************************************************************
' Name: GetASServiceName
'
' Purpose:
' Parameters: sInstance, the name of the instance to return the service name for
' Returns: The service name
'
Public Function GetASServiceName( sInstanceName)
If sInstanceName = "MSSQLSERVER" Then
GetASServiceName= "MSSQLServerOLAPService"
Else
GetASServiceName = "MSOLAP$" & sInstanceName
End If
End Function
'******************************************************************************
' Name: IsServiceSupported
'
' Purpose: Checks if this service is supported by this management pack
'
' Parameters: sService, the name of the service to check
'
' Returns: True if Microsoft SQL Server 2012
' False if earlier than Microsoft SQL Server 2012
Public Function IsServiceSupported(sService)
Dim oServices
Set oServices = WMIExecQuery ("winmgmts:\\" & TargetComputer & "\root\Microsoft\SqlServer\ComputerManagement11", "select * from SqlService where ServiceName ='" & EscapeWQLString(sService) & "'")
IsServiceSupported = oServices.Count > 0
End Function
'******************************************************************************
' Name: GetSQLInstances
'
' Purpose: Gets the list of instances of SQL installed on
' the specified server. These are read through WMI
'
' Parameters: None
'
' Returns: A comma separated list of instances
'
Public Function GetSQLInstances()
Dim oServices, oService, sInstance, sInstances, sClusterName, bAddInstance
Set oServices = WMIExecQuery ("winmgmts:\\" & TargetComputer & "\root\Microsoft\SqlServer\ComputerManagement11", "select * from SqlService where SQLServiceType ='1'")
For Each oService in oServices
sInstance = InstanceNameFromServiceName(oService.ServiceName)
If IsSupportedVersion(sInstance) Then
If IsSupportedSku(sInstance) Then
sClusterName = ReadRegistryStringValue(GetSQLInstanceKey(sInstance, "Cluster"), "ClusterName")
If IsTargetVirtualServer Then
bAddInstance = (LCase(TargetNetBIOSName) = Lcase(sClusterName))
Else
bAddInstance = IsNull(sClusterName)
End If
If bAddInstance Then
If sInstances <> "" Then
sInstances = sInstances & ","
End If
sInstances = sInstances & sInstance
End If
End If
End If
Next
Call g_oUtil.LogMessage(g_oUtil.DBG_TRACE, "GetSQLInstances returning the following instances: " & sInstances)
GetSQLInstances = sInstances
End Function
'******************************************************************************
' Name: GetRSInstances
'
' Purpose: Gets the list of instances of Report Server installed on
' the specified server. These are read through WMI.
'
' Parameters: None
'
' Returns: A comma separated list of instances
'
Public Function GetRSInstances()
Dim oServices, oService, sInstances, vsname
Set oServices = WMIExecQuery ("winmgmts:\\" & TargetComputer & "\root\Microsoft\SqlServer\ComputerManagement11", "select * from SqlService where SQLServiceType ='6'")
For Each oService in oServices
If sInstances <> "" Then
sInstances = sInstances & ","
End If
sInstances = sInstances & InstanceNameFromServiceName(oService.ServiceName)
Next
Call g_oUtil.LogMessage(g_oUtil.DBG_TRACE, "GetRSInstances returning the following instances: " & sInstances)
GetRSInstances = sInstances
End Function
'******************************************************************************
' Name: GetASInstances
'
' Purpose: Gets the list of instances of Anlsysi Services installed on
' the specified server. These are read through WMI.
'
' Parameters: None
'
' Returns: A comma separated list of instances
'
Public Function GetASInstances()
Dim oServices, oService, sInstances, sInstance, iServiceType, vsname
Set oServices = WMIExecQuery ("winmgmts:\\" & TargetComputer & "\root\Microsoft\SqlServer\ComputerManagement11", "select * from SqlService where SQLServiceType ='5'")
iServiceType = 5
GetAllSeviceProperties oServices, iServiceType
For Each oService in oServices
sInstance = InstanceNameFromServiceName(oService.ServiceName)
If IsSupportedVersion(sInstance) Then
vsname = GetServiceAdvancedProperty(oService.ServiceName, SERVICEADVANCEDPROPERTY_NAME_VSNAME)
If vsname = null or vsname = "" or InStr(TargetComputer,vsname)>0 Then
If sInstances <> "" Then
sInstances = sInstances & ","
End If
sInstances = sInstances & sInstance
End If
End If
Next
Call g_oUtil.LogMessage(g_oUtil.DBG_TRACE, "GetASInstances returning the following instances: " & sInstances)
GetASInstances = sInstances
End Function
'******************************************************************************
' Name: Is64Bit
'
' Purpose: Checks if a Server is 64Bit
'
' Parameters: sInstance, the name of the instance to check
'
' Returns: True if 64Bit
' False if not 64bit
Public Function Is64Bit(sInstance)
Dim sKeyValue
Is64Bit = GetServiceAdvancedProperty(GetASServiceName(sInstance), SERVICEADVANCEDPROPERTY_NAME_ISWOW64)
End Function
'******************************************************************************
' Name: IsSupportedSku
'
' Purpose: Checks if the Sku is supported
'
' Parameters: sInstance, the name of the instance to check
'
' Returns: True if Microsoft MSDE
' False if Microsoft MSDE is not installed
Public Function IsSupportedSku(sInstance)
If Not IsNull(sSKU) Then
If sSKU = "Express Edition" Then
IsSupportedSku = True
Else
IsSupportedSku = True
Call g_oUtil.LogMessage(g_oUtil.DBG_TRACE, "IsSupportedSku True for: " & sInstance)
End If
Else
IsSupportedSku = False
End If
End Function
'******************************************************************************
' Name: IsClustered
'
' Purpose: Checks if an instance is clustered
'
' Parameters: sInstance, the name of the instance to check
'
' Returns: 1 if the instance is clustered
' 0 if the instance is not clustered
'
'******************************************************************************
' Name: IsSQLServiceStarted
'
' Purpose: Checks whether a given SQL service instance is running
'
' Parameters: sInstance, the name of the SQL instance to check
'
' Returns: 0 if the service is not started and not disabled
' 1 if the service is started
' -1 if the service is not started but the service is disabled
' -2 if there was a WMI Error getting the service status or the
' service does not exist
'
Public Function IsSQLServiceStarted(sInstance)
IsSQLServiceStarted = IsServiceStarted(GetSQLServiceName(sInstance))
End Function
'******************************************************************************
' Name: IsServiceStarted
'
' Purpose: Checks whether a given Windows service is running
'
' Parameters: sServiceName, the Windows service name (short)
'
' Returns: 0 if the service is not started and not disabled
' 1 if the service is started
' -1 if the service is not started but the service is disabled
' -2 if there was a WMI Error getting the service status or the
' service does not exist
'
Public Function IsServiceStarted(sServiceName)
Dim oService, sObjectString
sObjectString = "winmgmts:\\" & TargetComputer & "\root\cimv2"
On Error Resume Next
Err.Clear
'We want to do our own error handling here. No WMIGetObject().
Set oService = GetObject(sObjectString & ":Win32_Service.Name='" & EscapeWQLString(sServiceName) & "'")
If Err.number <> 0 Then
IsServiceStarted = -2
Else
If oService.State = "Running" Then
IsServiceStarted = 1
ElseIf oService.StartMode = "Disabled" Then
IsServiceStarted = -1
Else
IsServiceStarted = 0
End If
End If
Set oService = nothing
On Error Goto 0
End Function
'******************************************************************************
' Name: GetSQLInstanceNameFromServiceName
'
' Purpose:
'
' Parameters:
'
' Returns:
'
Public Function GetSQLInstanceNameFromServiceName(ByVal sServiceName)
If sServiceName = SQL_DEFAULT Then
GetSQLInstanceNameFromServiceName = SQL_DEFAULT
Else
GetSQLInstanceNameFromServiceName = Mid(sServiceName, 7)
End If
End Function
'******************************************************************************
' Name: GetSQLServiceName
'
' Purpose:
'
' Parameters: sInstance, the name of the instance to return the service name for
'
' Returns: The service name
'
Public Function GetSQLServiceName(sInstance)
If sInstance = SQL_DEFAULT Then
GetSQLServiceName = SQL_DEFAULT
Else
GetSQLServiceName = "MSSQL$" & sInstance
End If
End Function
'******************************************************************************
' Name: GetSQLInstanceName
'
' Purpose: Returns the SQL Server instance name or default
'
' Parameters: sName - The physical name of the SQL Server
' sInstance - The SQL Server instance name
'
' Returns: The default or named instance connection name
'
Public Function GetSQLInstanceName(sName, sInstance)
If sInstance = SQL_DEFAULT Then
GetSQLInstanceName = sName
Else
GetSQLInstanceName = sName & "\" & sInstance
End If
End Function
'******************************************************************************
' Name: CollectDatabaseExclusions
'
' Purpose: Collect the list of excluded databases
'
' Parameters: None
'
' Returns: None
'
Sub CollectDatabaseExclusions()
Dim oExcludeFile
Dim oFSO
Dim sExcludeDatabaseName
On Error Resume Next
Set oFSO = MomCreateObject("Scripting.FileSystemObject")
Set oExcludeFile = oFSO.OpenTextFile(DATABASE_EXCLUDE_DIRECTORY & DATABASE_EXCLUDE_FILENAME, 1)
If Err.number = 0 Then
Call g_oUtil.LogMessage(g_oUtil.DBG_TRACE, "Exclusions are defined for this server")
g_bDatabaseExclusion = True
sExcludeDatabaseName = oExcludeFile.ReadAll
g_aDatabaseExcludeArray = Split(sExcludeDatabaseName, vbcrlf)
oExcludeFile.Close
Else
g_bDatabaseExclusion = False
End If
On Error Goto 0
End Sub
'******************************************************************************
' Name: IsDatabaseExcluded
'
' Purpose: Determine if a specified database is exlcuded from monitoring
'
' Parameters: Instance name and Database name
'
' Returns: True or False
'
Function IsDatabaseExcluded(sInstanceName, sDatabaseName)
Dim sInstanceDatabaseName
Dim iArrayMembers
If g_bDatabaseExclusion Then
If sInstanceName = SQL_DEFAULT Then
sInstanceDatabaseName = sDatabaseName
Else
sInstanceDatabaseName = sInstanceName & "\" & sDatabaseName
End If
For iArrayMembers = 0 To UBound(g_aDatabaseExcludeArray)
If UCase(g_aDatabaseExcludeArray(iArrayMembers)) = UCase(sInstanceDatabaseName) Then
IsDatabaseExcluded = True
Call g_oUtil.LogMessage(g_oUtil.DBG_TRACE, "Database " & sDatabaseName & "on instance " & sInstanceName & " is excluded")
Exit Function
End If
Next
IsDatabaseExcluded = False
Else
IsDatabaseExcluded = False
End If
End Function
'******************************************************************************
' Name: CollectJobExclusions
'
' Purpose: Collect the list of excluded servers/jobs
'
' Parameters: None
'
' Returns: None
'
Sub CollectJobExclusions()
Dim oExcludeFile
Dim oFSO
Dim sExcludeServerName
On Error Resume Next
Set oFSO = MomCreateObject("Scripting.FileSystemObject")
Set oExcludeFile = oFSO.OpenTextFile(JOB_EXCLUDE_DIRECTORY & JOB_EXCLUDE_FILENAME, 1)
If Err.number = 0 Then
Call g_oUtil.LogMessage(g_oUtil.DBG_TRACE, "Exclusions are defined for this server")
g_bJobExclusion = True
sExcludeServerName = oExcludeFile.ReadAll
g_aJobExcludeArray = Split(sExcludeServerName, vbcrlf)
oExcludeFile.Close
Else
g_bJobExclusion = False
End If
On Error Goto 0
End Sub
'******************************************************************************
' Name: IsJobExcluded
'
' Purpose: Determine if a specified server/job is exlcuded from monitoring
'
' Parameters: Server name and Job name
'
' Returns: True or False
'
Function IsJobExcluded(sServerName, sJobName)
Dim sServerJobName
Dim iArrayMembers
If g_bJobExclusion Then
sServerJobName = sServerName & "\" & sJobName
For iArrayMembers = 0 To UBound(g_aJobExcludeArray)
If UCase(g_aJobExcludeArray(iArrayMembers)) = UCase(sServerJobName) Then
IsJobExcluded = True
Call g_oUtil.LogMessage(g_oUtil.DBG_TRACE, "Job " & sJobName & "on server " & sServerName & " is excluded")
Exit Function
End If
Next
IsJobExcluded = False
Else
IsJobExcluded = False
End If
End Function
'******************************************************************************
' Name: ReadRegistryStringValue
'
' Purpose: Return a string value from the registry (HKLM)
'
' Parameters: sKeyPath, the path to the key
' sValueName, the name of the value to return
'
' Returns: A string matching the contents of the value or null
'
Public Function ReadRegistryStringValue(sKeyPath, sValueName)
Dim lResult
ReadRegistryStringValue = m_oSafeRegistry.ReadStringValue(sKeyPath, sValueName, lResult)
End Function
'******************************************************************************
' Name: ReadRegistryMultiStringValue
'
' Purpose: Return a multi string value from the registry (HKLM)
'
' Parameters: sKeyPath, the path to the key
' sValueName, the name of the value to return
'
' Returns: A string matching the contents of the value or null
'
Public Function ReadRegistryMultiStringValue(sKeyPath, sValueName)
Dim lResult
ReadRegistryMultiStringValue = m_oSafeRegistry.ReadMultiStringValue(sKeyPath, sValueName, lResult)
End Function
'******************************************************************************
' Name: ReadRegistryDWORDValue
'
' Purpose: Return a DWORD value from the registry (HKLM)
'
' Parameters: sKeyPath, the path to the key
' sValueName, the name of the value to return
' sHostName, the computer to connect to
'
' Returns: A string matching the contents of the value or null
'
Public Function ReadRegistryDWORDValue(sKeyPath, sValueName)
Dim lResult
ReadRegistryDWORDValue = m_oSafeRegistry.ReadDWORDValue(sKeyPath, sValueName, lResult)
End Function
'******************************************************************************
' Name: GetAllSeviceProperties
'
' Purpose: Adds the properties of all the instances on the machine to a dictionary
'
' Parameters: oSQLServices, the object containing all the services of type iServiceType
' iServiceType, the type of the service
Public sub GetAllSeviceProperties(ByVal oSQLServices, ByVal iServiceType)
Dim oSQLService, oOptions, oOption
Set oOptions = WMIExecQuery("winmgmts:\\" & TargetComputer & "\root\Microsoft\SqlServer\ComputerManagement11" ,"select * from SqlServiceAdvancedProperty where SQLServiceType='" & EscapeWQLString(iServiceType) & "'" )
For Each oSQLService in oSQLServices
Dim sServiceName, dPropertiesList
Set dPropertiesList = CreateObject("Scripting.Dictionary")
sServiceName = oSQLService.ServiceName
For Each oOption in oOptions
If oOption.ServiceName = sServiceName Then
dPropertiesList.add oOption.PropertyName, oOption
End If
Next
If Not IsEmpty(dPropertiesList)Then
g_List.Add sServiceName, dPropertiesList
End If
Next
End Sub
'******************************************************************************
' Name: GetServiceAdvancedProperty
'
' Purpose: Return the specified property of the service
'
' Parameters: sServiceName, the name of the service
' sPropertyName, the name of the property to return
'
' Returns: A string, integer, boolean matching the contents of the value or null
'
Function GetServiceAdvancedProperty(sServiceName, sPropertyName)
Dim oOptions, oOption
Dim dServiceValues
GetServiceAdvancedProperty = ""
If (Not IsEmpty(g_List)) AND (g_List.Exists(sServiceName)) Then
Set dServiceValues = g_List.Item(sServiceName)
If(Not IsEmpty(dServiceValues)) AND (dServiceValues.Exists(sPropertyName)) Then
Set oOption = dServiceValues.Item(sPropertyName)
Select Case oOption.PropertyValueType
Case SERVICEADVANCEDPROPERTY_TYPE_STRING
GetServiceAdvancedProperty = oOption.PropertyStrValue
Case SERVICEADVANCEDPROPERTY_TYPE_FLAG
if oOption.PropertyNumValue = 0 then
GetServiceAdvancedProperty = FALSE
else
GetServiceAdvancedProperty = TRUE
end if
Case SERVICEADVANCEDPROPERTY_TYPE_NUMBER
GetServiceAdvancedProperty = oOption.PropertyNumValue
End Select
End If
End If
End Function
End Class
'******************************************************************************
Class ASClass
Private m_sInstanceName
Private m_bIs64Bit
Public Property Let InstanceName(ByVal sInstanceName)
m_sInstanceName = sInstanceName
End Property
Public Property Get InstanceName()
InstanceName = m_sInstanceName
End Property
Public Property Let Is64Bit(ByVal bIs64Bit)
m_bIs64Bit = bIs64Bit
End Property
Public Property Get Is64Bit()
Is64Bit = m_bIs64Bit
End Property
Public Property Get ServiceName()
If m_sInstanceName = "MSSQLSERVER" Then
ServiceName = "MSSQLServerOLAPService"
Else
ServiceName = "MSOLAP$" & m_sInstanceName
End If
End Property
Public Property Get ServiceClusterName()
ServiceClusterName = ""
ServiceClusterName = "ANALYSIS SERVICES"
If m_sInstanceName <> "MSSQLSERVER" Then
ServiceClusterName = ServiceClusterName & " (" & m_sInstanceName & ")"
End If
End Property
Public Property Get Version()
Dim Ver : Ver = CheckConfigurationValue("Setup", "PatchLevel", "REG_SZ")
If Ver = "" Then
Ver = CheckConfigurationValue("MSSQLServer\CurrentVersion", "CurrentVersion", "REG_SZ")
End If
Version = Ver
End Property
Public Property Get ServicePackVersion()
ServicePackVersion = CheckConfigurationValue("Setup", "SP", "REG_DWORD")
End Property
Public Property Get InstallPath()
InstallPath = CheckConfigurationValue("Setup", "SQLPath", "REG_SZ")
End Property
Public Property Get Edition()
Edition = CheckConfigurationValue("Setup", "Edition", "REG_SZ")
End Property
'For default instance name of SQL 2012 i.e MSSQLSERVER the performance counter object is MSAS11
'For named instance of SQL 2012 the performance counter object is MSOLAP$<Instance Name>
Public Property Get PerformanceCounterName()
if UCase (m_sInstanceName) = "MSSQLSERVER" Then
PerformanceCounterName = "MSAS11"
Else
PerformanceCounterName = "MSOLAP$" & m_sInstanceName
End If
End Property
Private Function CheckConfigurationValue(sAttributeKey, sValue, sKeyType)
Dim sKey, sResult
Call g_oUtil.LogMessage(g_oUtil.DBG_TRACE, "CheckConfigurationValue called with the following parameters: " & _
m_sInstanceName & ", " & _
sAttributeKey & ", " & _
sValue & ", ")
If sKeyType = "REG_SZ" Then
sResult = g_oSQL.ReadRegistryStringValue (sKey, sValue)
ElseIf sKeyType = "REG_DWORD" Then
sResult = g_oSQL.ReadRegistryDWORDValue (sKey, sValue)
End If
If Not IsNull (sResult) Then
CheckConfigurationValue = sResult
Else
CheckConfigurationValue = ""
Call g_oUtil.LogMessage(g_oUtil.DBG_TRACE, "CheckConfigurationValue returning nothing")
End If
End Function
End Class
Function WMIGetObject(ByVal sNamespace)
'
' WMIGetObject :: Returns the WMI object requested.
'
'
Dim oWMI
Dim e
Set e = New Error
On Error Resume Next
Set oWMI = GetObject(sNamespace)
e.Save
On Error Goto 0
If IsEmpty(oWMI) Then
ThrowScriptErrorNoAbort "Unable to open WMI Namespace '" & sNamespace & "'. Check to see if the WMI service is enabled and running, and ensure this WMI namespace exists.", e
ThrowEmptyDiscoveryData
End If
Set WMIGetObject = oWMI
End Function
Function WMIGetInstance(ByVal sNamespace, ByVal sInstance)
'
' WMIGetInstance :: Returns WMI Instance requested.
'
'
Dim oWMI, oInstance, nInstanceCount
Dim e
Set e = New Error
On Error Resume Next
Set oWMI = GetObject(sNamespace)
e.Save
On Error Goto 0
If IsEmpty(oWMI) Then
ThrowScriptErrorNoAbort "Unable to open WMI Namespace '" & sNamespace & "'. Check to see if the WMI service is enabled and running, and ensure this WMI namespace exists.", e
ThrowEmptyDiscoveryData
End If
On Error Resume Next
Set oInstance = oWMI.InstancesOf(sInstance)
e.Save
On Error Goto 0
If IsEmpty(oInstance) Or e.Number <> 0 Then
ThrowScriptError "The class name '" & sInstance & "' returned no instances. Please check to see if this is a valid WMI class name.", e
End If
'Determine if we queried a valid WMI class - Count will return 0 or empty
On Error Resume Next
nInstanceCount = oInstance.Count
e.Save
On Error Goto 0
If e.Number <> 0 Then
ThrowScriptError "The class name '" & sInstance & "' did not return any valid instances. Please check to see if this is a valid WMI class name.", e
End If
Set WMIGetInstance = oInstance
End Function
Function WMIExecQuery(ByVal sNamespace, ByVal sQuery)
'
' WMIExecQuery :: Executes the WMI query and returns the result set.
'
'
Dim oWMI, oQuery, nInstanceCount
Dim e
Set e = New Error
On Error Resume Next
Set oWMI = GetObject(sNamespace)
e.Save
On Error Goto 0
If IsEmpty(oWMI) Then
ThrowScriptErrorNoAbort "Unable to open WMI Namespace '" & sNamespace & "'. Check to see if the WMI service is enabled and running, and ensure this WMI namespace exists.", e
ThrowEmptyDiscoveryData
End If
On Error Resume Next
Set oQuery = oWMI.ExecQuery(sQuery)
e.Save
On Error Goto 0
If IsEmpty(oQuery) Or e.Number <> 0 Then
ThrowScriptError "The Query '" & sQuery & "' returned an invalid result set. Please check to see if this is a valid WMI Query.", e
End If
'Determine if we queried a valid WMI class - Count will return 0 or empty
On Error Resume Next
nInstanceCount = oQuery.Count
e.Save
On Error Goto 0
If e.Number <> 0 Then
ThrowScriptError "The Query '" & sQuery & "' did not return any valid instances. Please check to see if this is a valid WMI Query.", e
End If
Set WMIExecQuery = oQuery
End Function
Function WMIGetInstanceNoAbort(ByVal sNamespace, ByVal sInstance)
'
' WMIGetInstanceNoAbort :: Returns WMI Instance requested.
'
'
Dim oWMI, oInstance, nInstanceCount
On Error Resume Next
Set oWMI = GetObject(sNamespace)
If Not IsEmpty(oWMI) Then
Set oInstance = oWMI.InstancesOf(sInstance)
If Not IsEmpty(oInstance) And Err.Number = 0 Then
'Determine if we queried a valid WMI class - Count will return 0 or empty
nInstanceCount = oInstance.Count
If Err.Number = 0 Then
Set WMIGetInstanceNoAbort = oInstance
Exit Function
End If
End If
End If
On Error Goto 0
Set WMIGetInstanceNoAbort = Nothing
End Function
Function IsValidObject(ByVal oObject)
IsValidObject = False
If IsObject(oObject) Then
If Not oObject Is Nothing Then
IsValidObject = True
End If
End If
End Function
'*************************************************************************
'
' Purpose - Translates a Service Name such as MSSQL$MyInstance into an
' instance name compatible with the health state monitoring instance
Function InstanceNameFromServiceName(ByVal serviceName)
Dim instanceName
if(Instr(serviceName, "MSSQL$") > 0) Then
instanceName = Mid(serviceName, 7)
ElseIf(Instr(serviceName, "SQLAgent$") > 0) Then
instanceName = Mid(serviceName, 10)
ElseIf(Instr(serviceName, "SQLSERVERAGENT") > 0) Then
instanceName = "MSSQLSERVER"
ElseIf(Instr(serviceName, "ReportServer$") > 0) Then
instanceName = Mid(serviceName, 14)
ElseIf(Instr(serviceName, "ReportServer") > 0) Then
instanceName = "MSSQLSERVER"
ElseIf(Instr(serviceName, "MSSQLServerOLAPService") > 0) Then
instanceName = "MSSQLSERVER"
ElseIf(Instr(serviceName, "MSOLAP$") > 0) Then
instanceName = Mid(serviceName, 8)
Else
instanceName = serviceName
End If
InstanceNameFromServiceName = instanceName
End Function
Function GetWMIProperty(oWmi, sPropName, nCIMType, ErrAction)
Dim sValue, oWmiProp
If Not IsValidObject(oWmi) Then
If (ErrAction And ErrAction_ThrowError) = ErrAction_ThrowError Then _
ThrowScriptErrorNoAbort "Accessing property on invalid WMI object.", Err
If (ErrAction And ErrAction_Abort) = ErrAction_Abort Then _
Quit()
GetWMIProperty = ""
Exit Function
End If
On Error Resume Next
Set oWmiProp = oWmi.Properties_.Item(sPropName)
If Err.Number <> 0 Then
If (ErrAction And ErrAction_ThrowError) = ErrAction_ThrowError Then _
ThrowScriptErrorNoAbort "An error occurred while accessing WMI property: '" & sPropName & "'.", Err
If (ErrAction And ErrAction_Abort) = ErrAction_Abort Then _
Quit()
End If
On Error Goto 0
If IsValidObject(oWmiProp) Then
sValue = oWmiProp.Value
If IsNull(sValue) Then
'
' If value is null, return blank to avoid any issues
'
GetWMIProperty = ""
Else
Select Case (oWmiProp.CIMType)
Case wbemCimtypeString, wbemCimtypeSint16, wbemCimtypeSint32, wbemCimtypeReal32, wbemCimtypeReal64, wbemCimtypeSint8, wbemCimtypeUint8, wbemCimtypeUint16, wbemCimtypeUint32, wbemCimtypeSint64, wbemCimtypeUint64:
If Not oWmiProp.IsArray Then
GetWMIProperty = Trim(CStr(sValue))
Else
GetWMIProperty = Join(sValue, ", ")
End If
Case wbemCimtypeBoolean:
If sValue = 1 Or UCase(sValue) = "TRUE" Then
GetWMIProperty = "True"
Else
GetWMIProperty = "False"
End If
Case wbemCimtypeDatetime:
Dim sTmpStrDate
'
' First attempt to convert the whole wmi date string
'
sTmpStrDate = Mid(sValue, 5, 2) & "/" & _
Mid(sValue, 7, 2) & "/" & _
Left(sValue, 4) & " " & _
Mid (sValue, 9, 2) & ":" & _
Mid(sValue, 11, 2) & ":" & _
Mid(sValue, 13, 2)
If IsDate(sTmpStrDate) Then
GetWMIProperty = CDate(sTmpStrDate)
Else
'
' Second, attempt just to convert the YYYYMMDD
'
sTmpStrDate = Mid(sValue, 5, 2) & "/" & _
Mid(sValue, 7, 2) & "/" & _
Left(sValue, 4)
If IsDate(sTmpStrDate) Then
GetWMIProperty = CDate(sTmpStrDate)
Else
'
' Nothing works - return passed in string
'
GetWMIProperty = sValue
End If
End If
Case Else:
GetWMIProperty = ""
End Select
End If
Else
If (ErrAction And ErrAction_ThrowError) = ErrAction_ThrowError Then _
ThrowScriptErrorNoAbort "An error occurred while accessing WMI property: '" & sPropName & "'.", Err
If (ErrAction And ErrAction_Abort) = ErrAction_Abort Then _
Quit()
GetWMIProperty = ""
End If
If (ErrAction And ErrAction_Trace) = ErrAction_Trace Then _
Wscript.Echo " + " & sPropName & " :: '" & GetWMIProperty & "'"
End Function
'******************************************************************************
Function ThrowScriptErrorNoAbort(ByVal sMessage, ByVal oErr)
On Error Resume Next
Dim oAPITemp
Set oAPITemp = MOMCreateObject("MOM.ScriptAPI")
oAPITemp.LogScriptEvent "DiscoverSQL2012ASDiscovery.vbs", 4001, 1, sMessage & ". " & oErr.m_sDescription
End Function
'******************************************************************************
Function ThrowScriptError(Byval sMessage, ByVal oErr)
On Error Resume Next
ThrowScriptErrorNoAbort sMessage, oErr
Quit()
End Function
'******************************************************************************
Function MomCreateObject(ByVal sProgramId)
Dim oError
Set oError = New Error
On Error Resume Next
Set MomCreateObject = CreateObject(sProgramId)
oError.Save
On Error Goto 0
If oError.Number <> 0 Then ThrowScriptError "Unable to create automation object '" & sProgramId & "'", oError
End Function
Function EscapeWQLString (ByVal strValue)
ON ERROR RESUME NEXT
Err.Clear
EscapeWQLString = Replace(strValue, "'", "\'")
End Function
Sub Main()
Dim objParameters, strRunType, oNet, bInformationEvent, sMessage
Set objParameters = Wscript.Arguments
Set g_List = CreateObject("Scripting.Dictionary")
If objParameters.Count < 5 or objParameters.Count > 6 Then
Quit ()
End If
Set g_oSQL = new SQL
If Not g_oSQL.ConnectedToRegistry Then Quit()
Set g_oUtil = New Util
Call g_oUtil.SetDebugLevel(g_oUtil.DBG_TRACE)
Call g_oUtil.LogMessage(g_oUtil.DBG_TRACE, SCRIPT_NAME & " starting: at machine local time: " & CStr(Time))
Call DoServiceDiscovery()
Call g_oUtil.LogMessage(g_oUtil.DBG_TRACE, SCRIPT_NAME & " finished: at machine local time: " & CStr(Time))
End Sub
Function Quit()
WScript.Quit()
End Function
'******************************************************************************
' Name: DoServiceDiscovery
'
' Purpose: Service Discovery for Report Server attributes
'
' Parameters: None
'
' Returns: Nothing
'
Sub DoServiceDiscovery()
Dim i, aInsts
'log trace
Call g_oUtil.LogMessage(g_oUtil.DBG_TRACE, "Starting AS Discovery.")
Dim oAPI, oSQLDiscoveryData
Set oAPI = CreateObject("MOM.ScriptAPI")
set oSQLDiscoveryData = oAPI.CreateDiscoveryData(0, SourceId, ManagedEntityId)
aInsts = Split(g_oSQL.GetASInstances(), ",")
For i = 0 To UBound(aInsts)
DiscoverASInstance aInsts(i), oSQLDiscoveryData
Next
Call oAPI.Return(oSQLDiscoveryData)
End Sub
Sub DiscoverASInstance(ByVal sInstanceName, ByRef oSQLDiscoveryData)
Dim oASClass
Set oASClass = New ASClass
oASClass.InstanceName = sInstanceName
oASClass.Is64Bit = g_oSQL.Is64Bit(sInstanceName)
'submit the discovery data packet
Call g_oUtil.LogMessage(g_oUtil.DBG_TRACE, "Submitting Discovery data packet.")
call oSQLDiscoveryData.AddInstance(oASInstance)
End Sub
Sub ThrowEmptyDiscoveryData()
Dim oAPI, oSQLDiscoveryData
Set oAPI = CreateObject("MOM.ScriptAPI")
set oSQLDiscoveryData = oAPI.CreateDiscoveryData(0, SourceId, ManagedEntityId)
Call oAPI.Return(oSQLDiscoveryData)
Home
ENU 
Show References: