This module type is used to discovery instances of Microsoft SQL Server 2008 Reporting Services. The module queries the registry and WMI for installation information.
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 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 2008 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 bIs64Bit)
Dim sInternalInstanceName
Select Case sServerType
Case "SQL"
If (bIs64Bit ) Then
sInternalInstanceName = ReadRegistryStringValue(SQL_KEY_ENGINE_INSTANCE_NAMES_WOW64, sInstance)
Else
sInternalInstanceName = ReadRegistryStringValue(SQL_KEY_ENGINE_INSTANCE_NAMES, sInstance)
End If
Case "RS"
If (bIs64Bit ) Then
sInternalInstanceName = ReadRegistryStringValue(RS_KEY_ENGINE_INSTANCE_NAMES_WOW64, sInstance)
Else
sInternalInstanceName = ReadRegistryStringValue(RS_KEY_ENGINE_INSTANCE_NAMES, sInstance)
End If
End Select
If(bIs64Bit) Then
GetInstanceKeyRoot = SQL_KEY_ROOT_WOW64 & "\" & sInternalInstanceName
Else
GetInstanceKeyRoot = SQL_KEY_ROOT & "\" & sInternalInstanceName
End If
End Function
'******************************************************************************
' Name: GetInstanceKey
'
' 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)
GetSQLInstanceKeyRoot = GetInstanceKeyRoot("SQL", sInstance)
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)
GetSQLInstanceKey = GetInstanceKey("SQL", sInstance, sKey)
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: 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 2008 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 2008
' False if earlier than Microsoft SQL Server 2008
Public Function IsSupportedVersion(sInstance)
Dim iVersionSize, bIs64Bit
iVersionSize = Len(SUPPORTED_VERSION)
Dim sKey, sValue, sAttributeKey, sResult
bIs64Bit = is64Bit(sInstance)
If IsNull(sResult) Or sResult = "" Then
sKey = GetRSInstanceKey(sInstance, "MSSQLServer\CurrentVersion", bIs64Bit)
sResult = g_oSQL.ReadRegistryStringValue(sKey, "CurrentVersion")
End If
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: 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 2008
' False if earlier than Microsoft SQL Server 2008
Public Function IsServiceSupported(sService)
Dim oServices
Set oServices = WMIExecQuery ("winmgmts:\\" & TargetComputer & "\root\Microsoft\SqlServer\ComputerManagement10", "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\ComputerManagement10", "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, sInstance, iServiceType, objSysInfo, strComputerName
Set objSysInfo = CreateObject( "WinNTSystemInfo" )
strComputerName = objSysInfo.ComputerName
If InStr(TargetComputer,strComputerName)>0 Then
Set oServices = WMIExecQuery ("winmgmts:\\" & TargetComputer & "\root\Microsoft\SqlServer\ComputerManagement10", "select * from SqlService where SQLServiceType ='6'")
iServiceType = 6
GetAllSeviceProperties oServices, iServiceType
For Each oService in oServices
sInstance = InstanceNameFromServiceName(oService.ServiceName)
If IsSupportedVersion(sInstance) Then
If sInstances <> "" Then
sInstances = sInstances & ","
End If
sInstances = sInstances & sInstance
End If
Next
End If
Call g_oUtil.LogMessage(g_oUtil.DBG_TRACE, "GetRSInstances returning the following instances: " & sInstances)
GetRSInstances = 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(GetRSServiceName(sInstance), SERVICEADVANCEDPROPERTY_NAME_ISWOW64)
End Function
'*****************************************************************************
' Name: GetRSServiceName
'
' Purpose:
' Parameters: sInstance, the name of the instance to return the service name for
' Returns: The service name
'
Public Function GetRSServiceName( sInstanceName)
If sInstanceName = "MSSQLSERVER" Then
GetRSServiceName = "ReportServer"
Else
GetRSServiceName = "ReportServer$" & sInstanceName
End If
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)
Dim sSKU
sSKU = GetServiceAdvancedProperty(GetSQLServiceName(sInstance), SERVICEADVANCEDPROPERTY_NAME_SKUNAME)
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
'
Public Function IsClustered(sInstance)
IsClustered = GetServiceAdvancedProperty(GetSQLServiceName(sInstance), SERVICEADVANCEDPROPERTY_NAME_CLUSTERED)
End Function
'******************************************************************************
' 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: 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\ComputerManagement10" ,"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
'******************************************************************************
' Name - SQL - Reporting ServicesUtility Class
'
'
Class RSClass
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 = "ReportServer"
Else
ServiceName = "ReportServer$" & m_sInstanceName
End If
End Property
Public Property Get ServiceClusterName()
ServiceClusterName = ""
ServiceClusterName = "REPORTING 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
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 & ", ")
sKey = g_oSQL.GetRSInstanceKey(m_sInstanceName, sAttributeKey, m_bIs64Bit) '& "\" & sAttributeKey
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
'******************************************************************************
' Subs and Functions
'
'
Function EscapeWQLString (ByVal strValue)
ON ERROR RESUME NEXT
Err.Clear
EscapeWQLString = Replace(strValue, "'", "\'")
End Function
Dim FILENAME, wfolder, fso, VCSInstalled
'Dim objLogFile
'*** VCS Specific ***
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))
'*** VCS Specific ***
Dim objTextFile, objShell, objScriptExec, strAPIState, strComputer,objReg,strKeyPath
Set fso = CreateObject("Scripting.FileSystemObject")
Set wfolder = fso.GetSpecialFolder(WindowsFolder)
const KEY_QUERY_VALUE = &H0001
const HKEY_LOCAL_MACHINE = &H80000002
strComputer = "."
Set objReg=GetObject("winmgmts:"_
& "{impersonationLevel=impersonate}!\\" &_
strComputer & "\root\default:StdRegProv")
strKeyPath = "SOFTWARE\VERITAS\VCS\Base"
' Does the account under which the script runs have the right to query the SYSTEM\CurrentControlSet key
objReg.CheckAccess HKEY_LOCAL_MACHINE, strKeyPath, KEY_QUERY_VALUE, VCSInstalled
If VCSInstalled = true Then
'objLogFile.WriteLine("VCS is installed")
'Calling the VCSApi utility to check the instance state
Call g_oUtil.LogMessage(g_oUtil.DBG_TRACE, SCRIPT_NAME & " Calling the VCSApi utility to check the instance state")
Set objShell = CreateObject("WScript.Shell")
Set objScriptExec = objShell.Exec("%VCS_HOME%\Bin\MOMUtil.exe Lanman VirtualName")
FILENAME = wfolder + "\\Temp\\VCSDiscoverSQL2008RSDiscovery_" + TargetComputer +".txt"
Set objTextFile = fsO.OpenTextFile(FILENAME, ForWriting, True)
strAPIState = objScriptExec.StdOut.ReadAll
if strAPIState <> "" Then
If InStr(1,strAPIState,"No Resources are configured",1) > 0 Then
objTextFile.WriteLine("")
ElseIf InStr (1, strAPIState, "error", 1) > 0 Then
Call g_oUtil.LogMessage(g_oUtil.DBG_TRACE, "VCSApi Utility: VCS failed to check the instance state")
Dim vcsError
Set vcsError = New Error
ThrowScriptError strAPIState, vcsError
Else
'objLogFile.WriteLine(strAPIState)
objTextFile.WriteLine(strAPIState)
objTextFile.close()
'Get the Instance and Lanman pair with service group
Dim strTempArr
Set objTextFile = fsO.OpenTextFile(FILENAME, ForReading, True)
If objTextFile.AtEndOfline <> True Then
strAPIState = objTextFile.ReadLine
strTempArr = Split(strAPIState, ",")
Do While objTextFile.AtEndOfLine <> True
If (StrComp("Instance", strTempArr(0), 1) = 0 ) Then
If (StrComp(TargetNetBIOSName, strTempArr(1), 1) = 0) Then
'Discovery running for virtual computer so exit with empty discovery data
objTextFile.close()
Call ThrowEmptyDiscoveryData()
WScript.Quit
End If
End If
strAPIState = objTextFile.ReadLine
strTempArr = Split(strAPIState, ",")
Loop
End If
End If
End If
objTextFile.close()
End If
'*** VCS Specific ***
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
Function ThrowScriptErrorNoAbort(ByVal sMessage, ByVal oErr)
On Error Resume Next
Dim oAPITemp
Set oAPITemp = MOMCreateObject("MOM.ScriptAPI")
oAPITemp.LogScriptEvent "DiscoverSQL2008RSDiscovery.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 WMIGetProperty(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()
WMIGetProperty = ""
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
'
WMIGetProperty = ""
Else
Select Case (oWmiProp.CIMType)
Case wbemCimtypeString, wbemCimtypeSint16, wbemCimtypeSint32, wbemCimtypeReal32, wbemCimtypeReal64, wbemCimtypeSint8, wbemCimtypeUint8, wbemCimtypeUint16, wbemCimtypeUint32, wbemCimtypeSint64, wbemCimtypeUint64:
If Not oWmiProp.IsArray Then
WMIGetProperty = Trim(CStr(sValue))
Else
WMIGetProperty = Join(sValue, ", ")
End If
Case wbemCimtypeBoolean:
If sValue = 1 Or UCase(sValue) = "TRUE" Then
WMIGetProperty = "True"
Else
WMIGetProperty = "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
WMIGetProperty = 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
WMIGetProperty = CDate(sTmpStrDate)
Else
'
' Nothing works - return passed in string
'
WMIGetProperty = sValue
End If
End If
Case Else:
WMIGetProperty = ""
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()
WMIGetProperty = ""
End If
If (ErrAction And ErrAction_Trace) = ErrAction_Trace Then _
Wscript.Echo " + " & sPropName & " :: '" & WMIGetProperty & "'"
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 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"
Else
instanceName = serviceName
End If
InstanceNameFromServiceName = instanceName
End Function
'******************************************************************************
' Name: DoServiceDiscovery
'
' Purpose: Service Discovery for Report Server attributes
'
' Parameters: None
'
' Returns: Nothing
'
Sub DoServiceDiscovery()
Dim i, aInsts
Dim oRSInstance
Set oRSInstance = oSQLDiscoveryData.CreateClassInstance("$MPElement[Name='MSSQL2008Discovery!Microsoft.SQLServer.2008.ReportingServices']$")
With oRSInstance
.AddProperty "$MPElement[Name='Windows!Microsoft.Windows.Computer']/PrincipalName$", TargetComputerID
.AddProperty "$MPElement[Name='SQL!Microsoft.SQLServer.ServerRole']/InstanceName$", oRSClass.InstanceName
.AddProperty "$MPElement[Name='SQL!Microsoft.SQLServer.ServerRole']/Type$", "Reporting Services"
.AddProperty "$MPElement[Name='SQL!Microsoft.SQLServer.ReportingServices']/ServiceName$", oRSClass.ServiceName
.AddProperty "$MPElement[Name='SQL!Microsoft.SQLServer.ReportingServices']/ServiceClusterName$", oRSClass.ServiceClusterName
.AddProperty "$MPElement[Name='SQL!Microsoft.SQLServer.ReportingServices']/Version$", oRSClass.Version
.AddProperty "$MPElement[Name='SQL!Microsoft.SQLServer.ReportingServices']/ServicePackVersion$", oRSClass.ServicePackVersion
.AddProperty "$MPElement[Name='SQL!Microsoft.SQLServer.ReportingServices']/Edition$", oRSClass.Edition
.AddProperty "$MPElement[Name='SQL!Microsoft.SQLServer.ReportingServices']/InstallPath$", oRSClass.InstallPath
End With
'submit the discovery data packet
Call g_oUtil.LogMessage(g_oUtil.DBG_TRACE, "Submitting Discovery data packet.")
call oSQLDiscoveryData.AddInstance(oRSInstance)
End Sub
Sub ThrowEmptyDiscoveryData()
Dim oAPI, oSQLDiscoveryData
Set oAPI = CreateObject("MOM.ScriptAPI")
set oSQLDiscoveryData = oAPI.CreateDiscoveryData(0, SourceId, ManagedEntityId)
Call oAPI.Return(oSQLDiscoveryData)
End Sub </Script></ScriptBody>
<TimeoutSeconds>$Config/TimeoutSeconds$</TimeoutSeconds>
</DataSource>
</MemberModules>
<Composition>
<Node ID="DS"/>
</Composition>
</Composite>
</ModuleImplementation>
<OutputType>System!System.Discovery.Data</OutputType>
</DataSourceModuleType>
Home
Show References: