This module type is used to discovery instances of Microsoft SQL Server 2014 Database Engine. The module queries the registry and WMI for installation information and then connects to each instance of database engines found to gather property information about the instance.
Function IsValidObject(ByVal oObject)
IsValidObject = False
If IsObject(oObject) Then
If Not oObject Is Nothing Then
IsValidObject = True
End If
End If
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
Public Function GetSQLServiceName(sInstance)
If sInstance = SQL_DEFAULT Then
GetSQLServiceName = SQL_DEFAULT
Else
GetSQLServiceName = "MSSQL$" & sInstance
End If
End Function
'The function returns service or "Unknown" state
'Input:
' server - compute name
' service - system service name
'Output:
' service state or "Unknown" state
Function GetServiceState( sTargetComputer, sServiceName)
On Error Resume Next
Dim sNamespace, sQuery, oWMI, objClasses, sState
sNamespace = "winmgmts://" & sTargetComputer & "/root/cimv2"
sQuery = "SELECT State FROM Win32_Service where Name = """ & EscapeWQLString(sServiceName) & """"
Set oWMI = GetObject(sNamespace)
Set objClasses = oWMI.ExecQuery(sQuery)
if objClasses.Count >= 1 Then
sState = GetFirstItemFromWMIQuery(objClasses).Properties_.Item("State")
End If
If Err.number <> 0 Or objClasses.Count = 0 Then
sState = "Unknown"
End If
Err.Clear
GetServiceState = sState
End Function
'#Include File:SQL2014Constants.vbs
Function BuildConnectionString(strServer, strDatabase)
ON ERROR RESUME NEXT
Err.Clear
Dim dataSource
dataSource = BuildServerName(strServer, "")
BuildConnectionString = "Data Source=" & EscapeConnStringValue(dataSource) & ";Initial Catalog=" & EscapeConnStringValue(strDatabase) & ";Integrated Security=SSPI"
End Function
Function BuildConnectionStringWithPort(ByVal strServer, ByVal strDatabase, ByVal tcpPort)
ON ERROR RESUME NEXT
Err.Clear
Dim dataSource
dataSource = strServer
If ((tcpPort <> "0") And (tcpPort <> "")) Then
dataSource = dataSource & "," & tcpPort
End If
BuildConnectionStringWithPort = "Data Source=" & EscapeConnStringValue(dataSource) & ";Initial Catalog=" & EscapeConnStringValue(strDatabase) & ";Integrated Security=SSPI"
End Function
' This function should be used to escape Connection String keywords.
Function EscapeConnStringValue (ByVal strValue)
ON ERROR RESUME NEXT
Err.Clear
EscapeConnStringValue = """" + Replace(strValue, """", """""") + """"
End Function
Function EscapeWQLString (ByVal strValue)
ON ERROR RESUME NEXT
Err.Clear
EscapeWQLString = Replace(strValue, "'", "\'")
End Function
Function GetTcpPort (ByVal strServer)
ON ERROR RESUME NEXT
Err.Clear
Dim tcpPort
tcpPort = ""
Call BuildServerName(strServer, tcpPort)
GetTcpPort = tcpPort
End Function
Function BuildServerName(ByVal strServer, ByRef tcp)
ON ERROR RESUME NEXT
Err.Clear
Dim pathArray, instanceName, computerName, ip, serverName
Dim oWMI, oQuery
ip= ""
pathArray = Split(strServer, "\")
computerName = pathArray(0)
instanceName = "MSSQLSERVER"
if (pathArray.Count > 1) Then
instanceName = pathArray(1)
End If
serverName = strServer
Set oWMI = GetObject("winmgmts:\\" & computerName & "\root\Microsoft\SqlServer\ComputerManagement12")
Set oQuery = oWMI.ExecQuery("SELECT * FROM ServerNetworkProtocolProperty WHERE ProtocolName = 'Tcp' AND InstanceName = '"& EscapeWQLString(instanceName) &"' AND PropertyName = 'ListenOnAllIPs'")
If oQuery.Count >0 Then
Dim isListenAll
Set isListenAll = GetFirstItemFromWMIQuery(oQuery)
If(isListenAll.PropertyNumVal = 1) Then
Set oQuery = oWMI.ExecQuery("SELECT * FROM ServerNetworkProtocolProperty WHERE ProtocolName = 'Tcp' AND InstanceName = '"& EscapeWQLString(instanceName) &"' AND IPAddressName = 'IPAll' AND (PropertyName = 'TcpPort' OR PropertyName = 'TcpDynamicPorts') AND PropertyStrVal <> ''")
If (oQuery.Count > 0) Then
tcp = GetFirstItemFromWMIQuery(oQuery).PropertyStrVal
If ((tcp <> "0") And (tcp <> "")) Then
serverName = serverName & "," & tcp
Else tcp = ""
End If
End If
Else
Set oQuery = oWMI.ExecQuery("SELECT * FROM ServerNetworkProtocolProperty WHERE ProtocolName = 'Tcp' AND InstanceName = '"& EscapeWQLString(instanceName) &"' AND IPAddressName <> '' AND PropertyName = 'Enabled' AND PropertyNumVal = 1")
If (oQuery.Count > 0) Then
Dim ipAddressName
ipAddressName = GetFirstItemFromWMIQuery(oQuery).IPAddressName
Set oQuery = oWMI.ExecQuery("SELECT * FROM ServerNetworkProtocolProperty WHERE ProtocolName = 'Tcp' AND InstanceName = '"& EscapeWQLString(instanceName) &"' AND IPAddressName = '"& EscapeWQLString(ipAddressName) &"' AND (PropertyName = 'TcpPort' OR PropertyName = 'TcpDynamicPorts') AND PropertyStrVal <> ''")
If (oQuery.Count > 0) Then
tcp = GetFirstItemFromWMIQuery(oQuery).PropertyStrVal
End If
Set oQuery = oWMI.ExecQuery("SELECT * FROM ServerNetworkProtocolProperty WHERE ProtocolName = 'Tcp' AND InstanceName = '"& EscapeWQLString(instanceName) &"' AND IPAddressName = '"& EscapeWQLString(ipAddressName) &"' AND PropertyName = 'IpAddress' AND PropertyStrVal <> ''")
If (oQuery.Count > 0) Then
ip = GetFirstItemFromWMIQuery(oQuery).PropertyStrVal
End If
If ip <> "" Then
serverName = ip
End If
If ((tcp <> "0") And (tcp <> "")) Then
serverName = servername & "," & tcp
Else tcp = ""
End If
End If
End If
End If
On Error Goto 0
BuildServerName = serverName
End Function
Public Function IsValidDestination(dbConnection, serverName, instanceName, isADODB)
Dim destinationTestQuery
destinationTestQuery = "select SERVERPROPERTY('MachineName') as ServerName, @@servicename as InstanceName"
if 0 = Err.number then
Dim queryResult
if isADODB then
Set queryResult = dbConnection.ExecuteQuery(destinationTestQuery)
else
Set queryResult = dbConnection.Execute(destinationTestQuery)
end if
if Not queryResult.EOF then
Dim queryServerName : queryServerName = UCase(queryResult("ServerName").Value)
Dim queryInstanceName : queryInstanceName = UCase(queryResult("InstanceName").Value)
Dim serverNameWithoutDomain : serverNameWithoutDomain = serverName
Dim dotPosition : dotPosition = InStr(1, serverName, ".")
if Not IsNull(dotPosition) And (dotPosition > 0) then
serverNameWithoutDomain = Left(serverName, dotPosition - 1)
end if
if (UCase(serverNameWithoutDomain) = queryServerName) And (UCase(instanceName) = queryInstanceName) then
IsValidDestination = true
Exit Function
end if
end if
end if
IsValidDestination = false
End Function
'NOTE: This will NOT work without SQLADODB.vbs /DKalinin/
'RETURNS:
Public Function SmartConnect(cnADOConnection, connectionStr, tcp, serverName, instanceName, databaseName)
ON ERROR RESUME NEXT
'try to use SQL server browser
Dim strProv : strProv = BuildConnectionStringWithPort(connectionStr, databaseName, "")
Err.Clear
Dim res : res = cnADOConnection.Open(strProv, "sqloledb", 10)
'use original tcp port and try to connect again
if (0 <> Err.number) Or (Not IsValidDestination(cnADOConnection, serverName, instanceName, true)) then
strProv = BuildConnectionStringWithPort(connectionStr, databaseName, tcp)
Err.Clear
res = cnADOConnection.Open(strProv, "sqloledb", 10)
'get fresh tcp port and try to connect again
if (0 <> Err.number) Or (Not IsValidDestination(cnADOConnection, serverName, instanceName, true)) then
Err.Clear
strProv = BuildConnectionString(connectionStr, databaseName)
res = cnADOConnection.Open(strProv, "sqloledb", 30)
if (0 <> Err.number) Or (Not IsValidDestination(cnADOConnection, serverName, instanceName, true)) then
cnADOConnection.HandleOpenConnectionErrorContinue databaseName, serverName, instanceName
SmartConnect = False
Exit Function
end if
end if
end if
SmartConnect = res
End Function
'NOTE: This WILL work without SQLADODB.vbs /DKalinin/
Public Function SmartConnectWithoutSQLADODB(connectionStr, tcp, serverName, instanceName, databaseName)
ON ERROR RESUME NEXT
Dim cnADOConnection
Set cnADOConnection = MomCreateObject("ADODB.Connection")
cnADOConnection.Provider = "sqloledb"
cnADOConnection.ConnectionTimeout = 30
'try to use SQL server browser
Dim strProv : strProv = BuildConnectionStringWithPort(connectionStr, databaseName, "")
Err.Clear
cnADOConnection.Open strProv
'use original tcp port and try to connect again
if (0 <> Err.number) Or (Not IsValidDestination(cnADOConnection, serverName, instanceName, false)) then
Err.Clear
strProv = BuildConnectionStringWithPort(connectionStr, databaseName, tcp)
cnADOConnection.Open strProv
'get fresh tcp port and try to connect again
if (0 <> Err.number) Or (Not IsValidDestination(cnADOConnection, serverName, instanceName, false)) then
Err.Clear
strProv = BuildConnectionString(connectionStr, databaseName)
cnADOConnection.Open strProv
if (0 <> Err.number) Or (Not IsValidDestination(cnADOConnection, serverName, instanceName, false)) then
cnADOConnection.HandleOpenConnectionErrorContinue databaseName, serverName, instanceName
Set SmartConnectWithoutSQLADODB = Nothing
Exit Function
end if
end if
end if
Set SmartConnectWithoutSQLADODB = cnADOConnection
End Function
For i = 0 to Ubound(aReserved)
If vEncDec = "enc" Then
vString = Replace(vString,aReserved(i,0),aReserved(i,1))
End If
If vEncDec = "dec" Then
vString = Replace(vString,aReserved(i,1),aReserved(i,0))
End If
Next
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
Function ThrowScriptErrorNoAbort(ByVal sMessage, ByVal oErr)
On Error Resume Next
Dim oAPITemp
Set oAPITemp = MOMCreateObject("MOM.ScriptAPI")
oAPITemp.LogScriptEvent WScript.ScriptName, 4201, 1, sMessage & ". " & oErr.Description
End Function
Function ThrowScriptError(Byval sMessage, ByVal oErr)
On Error Resume Next
ThrowScriptErrorNoAbort sMessage, oErr
Quit()
End Function
Sub HandleError(customMessage)
Dim localLogger
If Not (Err.number = 0) Then
Set localLogger = new ScriptLogger
localLogger.LogFormattedError(customMessage)
Wscript.Quit 0
End If
End Sub
Function HandleErrorContinue(customMessage)
Dim localLogger
HandleErrorContinue = False
If Not (Err.number = 0) Then
Set localLogger = new ScriptLogger
localLogger.LogFormattedError(customMessage)
Err.Clear
HandleErrorContinue = True
End If
End Function
'#Include File:Registry.vbs
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 EnumValues(ByVal sKeyPath, ByRef lResult)
Dim aNames, aTypes
lResult = m_oReg.EnumValues(m_lHive, sKeyPath, aNames, aTypes)
EnumValues = aNames
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
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 EnumValues(ByVal sKeyPath, ByRef lResult)
EnumValues = Null
On Error Resume Next
EnumValues = m_oRegistry.EnumValues(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
Class RegistryWrapper
Private REG_SOFTWARE
Private REG_SOFTWARE_WOW64
Private Sub Class_Initialize()
REG_SOFTWARE = "Software"
REG_SOFTWARE_WOW64 = "Software\Wow6432Node"
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)
End Sub
Public Property Get ConnectedToRegistry
ConnectedToRegistry = m_bConnectedToRegistry
End Property
Public Function ReadRegistryStringValue(sKeyPath, sValueName)
Dim lResult
ReadRegistryStringValue = m_oSafeRegistry.ReadStringValue(sKeyPath, sValueName, lResult)
End Function
Public Function ReadRegistryMultiStringValue(sKeyPath, sValueName)
Dim lResult
ReadRegistryMultiStringValue = m_oSafeRegistry.ReadMultiStringValue(sKeyPath, sValueName, lResult)
End Function
Public Function ReadRegistryDWORDValue(sKeyPath, sValueName)
Dim lResult
ReadRegistryDWORDValue = m_oSafeRegistry.ReadDWORDValue(sKeyPath, sValueName, lResult)
End Function
Public Function GetSoftwarePath(ByVal sRelativePath, ByVal bIsWOW64)
If (bIsWOW64) Then
GetSoftwarePath = REG_SOFTWARE & "\" & sRelativePath
Else
GetSoftwarePath = REG_SOFTWARE_WOW64 & "\" & sRelativePath
End If
End Function
End Class
'#Include File:Util.vbs
' 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
'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
'#Include File:WMI.vbs
Function EscapeWQLString (ByVal strValue)
On Error Resume Next
Err.Clear
EscapeWQLString = Replace(strValue, "'", "\'")
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 & "'"
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 GetFirstItemFromWMIQuery(ByRef oQuery)
ON ERROR RESUME NEXT
Err.Clear
Dim oResult
Set oResult = oQuery.ItemIndex(0)
if Err.number <> 0 then
Err.Clear
Dim oObject
For Each oObject in oQuery
Set oResult = oObject
Exit For
Next
end if
Set GetFirstItemFromWMIQuery = oResult
End Function
'#Include File:SQLDBEngineDiscovery.vbs
'Copyright (c) Microsoft Corporation. All rights reserved.
' Discover instances of SQL Server DB Engines
' Targeted at Windows Server class - takes 4 or 5 arguments
' Works agentlessly and against Virtaul servers (Wolfpack cluster)
' Arg 0 : SourceID
' Arg 1 : MP Element ID
' Arg 2 : Computer ID
' Arg 3 : FQDN
' Arg 4 : NETBIOS Name (required for clustered SQL discovery)
' Arg 5 : Exlcuded instance list (prefixed with Exclude:)
' Arg 6 : Optional Boolean - true indicates this is a virtual Windows server (Wolfpack)
Dim SCRIPT_NAME : SCRIPT_NAME = "SQL Server " & SQL_VERSION & " DB Engine Discovery"
Dim TargetComputer
Dim TargetComputerID
Dim IsTargetVirtualServer
Dim SourceID
Dim ManagedEntityID
Dim TargetNetBIOSName
Dim ExcludeList
Dim g_oSQL
Dim g_oUtil
Dim g_List
Call Main()
'******************************************************************************
' 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_TOOLS_PATH
Public SQL_TOOLS_PATH_WOW64
Public SQL_DEFAULT
Public SQL_KEY_NAMED
Public SQL_KEY_NAMED_WOW64
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
SQL_TOOLS_PATH = "SOFTWARE\Microsoft\Microsoft SQL Server\" & SQL_VERSION_NUMBER & "0\Tools\ClientSetup"
SQL_TOOLS_PATH_WOW64 = "SOFTWARE\Wow6432Node\Microsoft\Microsoft SQL Server\" & SQL_VERSION_NUMBER & "0\Tools\ClientSetup"
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 " & SQL_VERSION & " Service Availability", _
GetConnectionFailureMessage(sInstance, lErrNumber, sErrDescription), _
"", _
""
End If
End Sub
Sub WriteToEventLogAndExit(ByVal message)
Dim oAPITemp
Set oAPITemp = CreateObject("MOM.ScriptAPI")
oAPITemp.LogScriptEvent WScript.ScriptName, 4201, EVENT_TYPE_ERROR, message
WScript.Quit()
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, 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: 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 {Version} 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, "{Version}", SQL_VERSION)
sResult = Replace(sResult, "{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 is of specific version
' False otherwise
'
Public Function IsSupportedVersion(sInstance)
If Left(GetSQLServerVersion(GetSQLServiceName(sInstance)), Len(SQL_VERSION_NUMBER)) = SQL_VERSION_NUMBER 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 is of specific version
' False otherwise
'
Public Function IsServiceSupported(sService)
Dim oServices
Set oServices = WMIExecQuery ("winmgmts:\\" & TargetComputer & "\root\Microsoft\SqlServer\" & SQL_WMI_NAMESPACE, "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(ByRef dSQLInstancesList)
Dim oVersionSpecificNamespace
Dim oServices, oService, sInstance, sInstances, sClusterName, bAddInstance, bIs64Bit
' Brief check if appropriate namespace exists:
' Assuming "SqlServer" namespace is there because we have seed already discovered
' So it's only required to check for particular version
Set oVersionSpecificNamespace = WMIExecQuery("winmgmts:\\" & TargetComputer & "\root\Microsoft\SqlServer", "select * from __NAMESPACE where Name ='" & SQL_WMI_NAMESPACE & "'")
If (oVersionSpecificNamespace.Count = 0) Then
GetSQLInstances = Null
Exit Function
End If
Set oServices = WMIExecQuery ("winmgmts:\\" & TargetComputer & "\root\Microsoft\SqlServer\" & SQL_WMI_NAMESPACE, "select * from SqlService where SQLServiceType ='1'")
Set dSQLInstancesList = CreateDictionaryFromObject(oServices, SERVICE_NAME)
GetAllSQLSeviceProperties(oServices)
'*** VCS Specific ***
Dim AddInstance, NotFound
Dim strPairs, i, SQLConfigured
Dim strAPIState, objTextFile, strSysInstPairs
SQLConfigured = False
If VCSInstalled = true Then
FILENAME = wfolder + "\\Temp\\VCSDiscoverSQL2014DBEngineDiscovery_" + TargetComputer +".txt"
Set objTextFile = fso.OpenTextFile(FILENAME,ForReading, true)
If objTextFile.AtEndOfline <> True Then
SQLConfigured = True
strAPIState = objTextFile.ReadLine
strPairs = Split(strAPIState, ",")
If objTextFile.AtEndOfline <> True Then
strAPIState = objTextFile.ReadLine
strSysInstPairs = Split(strAPIState, "@")
End If
objTextFile.close()
End If
End If
'*** VCS Specific ***
For Each oService in oServices
sInstance = InstanceNameFromServiceName(oService.ServiceName)
If IsSupportedVersion(sInstance) Then
If IsSupportedSku(sInstance) Then
bIs64Bit = g_oSQL.Is64Bit(sInstance)
'*** VCS Specific ***
AddInstance = 0
NotFound = 1
If VCSInstalled = true Then
If SQLConfigured Then
For i= 0 to Ubound(strPairs) step 3
if (Len(strPairs(i)) = 0 ) then
strPairs(i) = "MSSQLSERVER"
End if
If (StrComp(sInstance, strPairs(i), 1) = 0) then
NotFound =0
If (StrComp(TargetNetBIOSName, strPairs(i+1), 1) = 0) then
'Discovery for VC
'objLogFile.WriteLine("Virtual node")
AddInstance = 1
Exit For
Else
'Discovery for Other Node
'objLogFile.WriteLine("Other node")
Dim j, SearchString
For j = 0 To UBound(strSysInstPairs)
SearchString = ":" + sInstance + ":"
If (InStr(1, strSysInstPairs(j), SearchString, 1) > 0) Then
SearchString = "," + TargetNetBIOSName + ","
If (InStr(1, strSysInstPairs(j), SearchString, 1) > 0) Then
' Configured on system
AddInstance = 0
Else
If (InStr(1, strVirtualServers, SearchString, 1) > 0) Then
'Discovery is running for Virtual Servers
AddInstance = 0
Else
' Discovery for Physical Server
AddInstance = 1
End If
End If
End If
Next
Exit For
End If
End If
Next
If (i > Ubound(strPairs)) Then
' Instance is not configured under VCS
SearchString = "," + TargetNetBIOSName + ","
If (InStr(1, strVirtualServers, SearchString, 1) > 0) then
'Discovery for Virtual Computer
NotFound = 0
AddInstance = 0
Else
' Instance not configured and Discovery for physical computer
AddInstance = 1
End If
End If
Else
AddInstance = 1
End If 'DB is not configured with VCS
Else 'if vcs not installed
AddInstance = 1
End If
if AddInstance =1 Then
'objLogFile.WriteLine("Adding instance for computer:"+TargetNetBIOSName)
'*** VCS Specific ***
sClusterName = ReadRegistryStringValue(GetSQLInstanceKey(sInstance, "Cluster", bIs64Bit), "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
Else
g_List.Remove oService.ServiceName
End If
Else
g_List.Remove oService.ServiceName
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
Set oServices = WMIExecQuery ("winmgmts:\\" & TargetComputer & "\root\Microsoft\SqlServer\" & SQL_WMI_NAMESPACE, "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: 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(GetSQLServiceName(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)
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
Public Function EnumValues(ByVal sKeyPath, ByRef lResult)
EnumValues = m_oSafeRegistry.EnumValues(sKeyPath, lResult)
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: CreateDictionaryFromObject
'
' Purpose: Executing WMI query takes alot of time. So we use this function to
' store the result in a dictionary and use it instead of executing
' WMI query again and again
' Parameters: oOptions, theObject to be stored locally
'
' Returns: A dictionary
'
Public Function CreateDictionaryFromObject(ByVal oOptions, ByVal sKeyValue)
Dim aInstanceValue
Set aInstanceValue = CreateObject("Scripting.Dictionary")
If oOptions.Count > 0 Then
Dim oServiceValue
For Each oServiceValue in oOptions
Select Case sKeyValue
Case PROPERTY_NAME
aInstanceValue.Add oServiceValue.PropertyName, oServiceValue
Case SERVICE_NAME
aInstanceValue.Add oServiceValue.ServiceName, oServiceValue
End Select
Next
End If
Set CreateDictionaryFromObject = aInstanceValue
End Function
'******************************************************************************
' Name: GetAllSQLSeviceProperties
'
' Purpose: This function retrieves all the properties of all the SQL Instances
' Running on the machine and stores it in a global object g_List.
' The data is retrieved by a WMI query.
' Parameters: oSQLServices, theObject to be stored locally
'
Public Sub GetAllSQLSeviceProperties(ByVal oSQLServices)
Dim oSQLService, oOptions, oOption
Set oOptions = WMIExecQuery("winmgmts:\\" & TargetComputer & "\root\Microsoft\SqlServer\" & SQL_WMI_NAMESPACE, "select * from SqlServiceAdvancedProperty where SQLServiceType='1'" )
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
Public Function GetSQLServerVersion (sServiceName)
GetSQLServerVersion = "0.0.0.0"
Dim bIs64Bit : bIs64Bit = GetServiceAdvancedProperty(sServiceName, SERVICEADVANCEDPROPERTY_NAME_ISWOW64)
Dim instanceKeyRoot : instanceKeyRoot = GetInstanceKeyRoot("SQL", GetSQLInstanceNameFromServiceName(sServiceName), bIs64Bit)
Dim Version : Version = ReadRegistryStringValue(instanceKeyRoot & "\Setup", "PatchLevel")
If Version = "" Then
Version = ReadRegistryStringValue(instanceKeyRoot & "\MSSQLServer\CurrentVersion", "CurrentVersion")
End If
GetSQLServerVersion = Version
End Function
'******************************************************************************
' Name: GetFullTextSearchInstances
'
' Purpose: Gets the list of instances of FullTextSearch installed on
' the specified server. These are read through WMI
'
' Parameters: None
'
' Returns: The list of Full Text Search Instances if they are installed, an empty string if it is not
'
Public Function GetFullTextSearchInstances()
Dim sFTSInstances, sFTSInstance, sFTSInstanceName, sInstance
GetFullTextSearchInstances = ""
Set sFTSInstances = WMIExecQuery ("winmgmts:\\" & TargetComputer & "\root\Microsoft\SqlServer\" & SQL_WMI_NAMESPACE, "select * from SqlService where SQLServiceType ='9' or SQLServiceType ='3'")
Set GetFullTextSearchInstances = CreateDictionaryFromObject(sFTSInstances, SERVICE_NAME)
End Function
'******************************************************************************
' Name: GetFullTextSearchServiceName
'
' Purpose: Gets the name of the Full text search service name if is is insalled on
' the specified server. Otherwise it returns a ""
'
' Parameters: None
'
' Returns: The name of Full Text Search Service if they are installed, an empty string if it is not
'
Public Function GetFullTextSearchServiceName(ByVal sFTSInstanceName, ByVal dList)
GetFullTextSearchServiceName = "-"
If Not IsEmpty(dList) Then
If (dList.Exists(sFTSInstanceName)) Then
GetFullTextSearchServiceName = CStr(dList.Item(sFTSInstanceName).ServiceName)
End If
End If
End Function
'******************************************************************************
' Name: GetServiceAdvancedProperty
'
' Purpose: Return a DWORD value from the registry (HKLM)
'
' 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.Count > 0 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
Class SQLClass
Private m_sInstanceName
Private m_bIs64Bit
Public Property Let SQLServerInstanceName(ByVal sInstanceName)
m_sInstanceName = sInstanceName
End Property
Public Property Get SQLServerInstanceName()
SQLServerInstanceName = m_sInstanceName
End Property
Public Property Let SQLServerIs64Bit(ByVal bIs64Bit)
m_bIs64Bit = bIs64Bit
End Property
Public Property Get SQLServerIs64Bit()
SQLServerIs64Bit = m_bIs64Bit
End Property
Public Property Get Replication()
Replication = SQLAttributeConversion(SQL_REPLICATION_ATTRIBUTE_ID, CheckConfigurationValue("Replication", "IsInstalled", "REG_DWORD"))
End Property
Public Property Get SQLServerVersion()
Dim Version : Version = CheckConfigurationValue("Setup", "PatchLevel", "REG_SZ")
If Version = "" Then
Version = CheckConfigurationValue("MSSQLServer\CurrentVersion", "CurrentVersion", "REG_SZ")
End If
SQLServerVersion = Version
End Property
Public Property Get Edition()
Edition = CheckConfigurationValue("Setup", "Edition", "REG_SZ")
End Property
Public Property Get AuthenticationMode()
AuthenticationMode = SQLAttributeConversion(SQL_AUTHENTICATION_MODE_ATTRIBUTE_ID, CheckConfigurationValue("MSSQLServer", "LoginMode", "REG_DWORD"))
End Property
Public Property Get Language()
Language = g_oSQL.GetServiceAdvancedProperty(g_oSQL.GetSQLServiceName(m_sInstanceName), g_oSQL.SERVICEADVANCEDPROPERTY_NAME_LANGUAGE)
End Property
Public Property Get ServicePackVersion()
Dim ServicePack
ServicePack = g_oSQL.GetServiceAdvancedProperty(g_oSQL.GetSQLServiceName(m_sInstanceName), g_oSQL.SERVICEADVANCEDPROPERTY_NAME_SPLEVEL)
If IsNull(ServicePack) Then
ServicePack = ""
End If
ServicePackVersion = ServicePack
End Property
Public Property Get AuditLevel()
AuditLevel = SQLAttributeConversion(SQL_AUDIT_LEVEL_ATTRIBUTE_ID, CheckConfigurationValue("MSSQLServer", "AuditLevel", "REG_DWORD"))
End Property
Public Property Get InstallPath()
InstallPath = g_oSQL.GetServiceAdvancedProperty(g_oSQL.GetSQLServiceName(m_sInstanceName), g_oSQL.SERVICEADVANCEDPROPERTY_NAME_INSTALLPATH)
End Property
Public Property Get ToolsPath()
If (m_bIs64Bit) Then
ToolsPath = g_oSQL.ReadRegistryStringValue(g_oSQL.SQL_TOOLS_PATH_WOW64, "SQLPath")
Else
ToolsPath = g_oSQL.ReadRegistryStringValue(g_oSQL.SQL_TOOLS_PATH, "SQLPath")
End If
If (IsNull(ToolsPath)) Then
ToolsPath = ""
End If
End Property
Public Property Get EnableErrorReporting()
If g_oSQL.GetServiceAdvancedProperty(g_oSQL.GetSQLServiceName(m_sInstanceName), g_oSQL.SERVICEADVANCEDPROPERTY_NAME_ERRORREPORTING) Then
EnableErrorReporting = "True"
Else
EnableErrorReporting = "False"
End If
End Property
Public Property Get ReplicationWorkingDirectory()
Dim strVal
strVal = CheckConfigurationValue("Replication", "WorkingDirectory", "REG_SZ")
If "" = strVal Then
strVal = "N/A"
End If
ReplicationWorkingDirectory = strVal
End Property
Public Property Get ReplicationDistributionDatabase()
Dim strVal
strVal = CheckConfigurationValue("Replication", "DistributionDB", "REG_SZ")
If "" = strVal Then
strVal = "N/A"
End If
ReplicationDistributionDatabase = strVal
End Property
Public Property Get ConnectionName()
If m_sInstanceName = "MSSQLSERVER" Then
ConnectionName = ""
Else
ConnectionName = "\" & m_sInstanceName
End If
End Property
Public Property Get ServiceName()
If m_sInstanceName = "MSSQLSERVER" Then
ServiceName = "MSSQLSERVER"
Else
ServiceName = "MSSQL$" & m_sInstanceName
End If
End Property
Public Property Get ServiceClusterName()
ServiceClusterName = ""
If Cluster Then
ServiceClusterName = "SQL SERVER"
If m_sInstanceName <> "MSSQLSERVER" Then
ServiceClusterName = ServiceClusterName & " (" & m_sInstanceName & ")"
End If
End If
End Property
Public Property Get FullTextSearchServiceName()
If m_sInstanceName = "MSSQLSERVER" Then
FullTextSearchServiceName = SQL_FULLTEXTSEARCH_SERVICENAME
Else
FullTextSearchServiceName = SQL_FULLTEXTSEARCH_SERVICENAME & "$" & m_sInstanceName
End If
End Property
Public Property Get FullTextSearchServiceClusterName()
FullTextSearchServiceClusterName = ""
If Cluster Then
FullTextSearchServiceClusterName = SQL_FULLTEXTSEARCH_SERVICECLUSTERNAME
If m_sInstanceName <> "MSSQLSERVER" Then
FullTextSearchServiceClusterName = FullTextSearchServiceClusterName & " (" & m_sInstanceName & ")"
End If
End If
End Property
Public Property Get AgentName()
If m_sInstanceName = "MSSQLSERVER" Then
AgentName = "SQLSERVERAGENT"
Else
AgentName = "SQLAgent$" & m_sInstanceName
End If
End Property
Public Property Get AgentClusterName()
AgentClusterName = ""
If Cluster Then
AgentClusterName = "SQL SERVER AGENT"
If m_sInstanceName <> "MSSQLSERVER" Then
AgentClusterName = AgentClusterName & " (" & m_sInstanceName & ")"
End If
End If
End Property
Public Property Get Cluster()
If g_oSQL.IsClustered(m_sInstanceName) = "True" Then
Cluster = "True"
Else
Cluster = "False"
End If
End Property
Public Property Get ServiceAccount(sServiceName, dSQLServerInstances )
Dim oServiceAccount
Set oServiceAccount = dSQLServerInstances.Item(sServiceName)
ServiceAccount = oServiceAccount.StartName
End Property
Public Property Get InstanceID()
InstanceID = g_oSQL.GetServiceAdvancedProperty(g_oSQL.GetSQLServiceName(m_sInstanceName), g_oSQL.SERVICEADVANCEDPROPERTY_NAME_INSTANCEID)
End Property
Public Function GetStartupParameters()
Dim sKeyRoot, dValues, lResult, sValueName, sValue, dParameters
sKeyRoot = g_oSQL.GetSQLInstanceKeyRoot(m_sInstanceName, m_bIs64Bit) & "\MSSQLServer\Parameters"
dValues = g_oSQL.EnumValues(sKeyRoot, lResult)
Set dParameters = CreateObject("Scripting.Dictionary")
If Not IsNull(dValues) Then
For Each sValueName In dValues
sValue = CheckConfigurationValue("MSSQLServer\Parameters", sValueName, "REG_SZ")
If Left(sValue, 1) = "-" And Not dParameters.Exists(Left(sValue, 2)) Then
dParameters.Add Left(sValue, 2), Right(sValue, Len(sValue) -2)
End If
Next
End If
Set GetStartupParameters = dParameters
End Function
''******************************************************************************
' Name: CheckConfigurationValue
'
' Purpose: Read an instance specific registry key and returns the value
'
' Parameters:
'
' Returns: Value is specified registry key
'
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.GetSQLInstanceKeyRoot(m_sInstanceName, 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
'******************************************************************************
' Name: SQLAttributeConversion
'
' Purpose: Conversion for SQL Server attributes
'
' Parameters:
' strName - Name of the attribute
' sValue - Value of the attribute
'
' Returns: Nothing
'
Private Function SQLAttributeConversion(strName, sValue)
SQLAttributeConversion = ""
Select Case strName
Case SQL_AUTHENTICATION_MODE_ATTRIBUTE_ID
If IsNumeric(sValue) Then
If sValue = 1 Then
SQLAttributeConversion = "Windows Authentication Mode"
Else
SQLAttributeConversion = "Mixed Mode (Windows Authentication and SQL Server Authentication)"
End If
End If
Case SQL_AUDIT_LEVEL_ATTRIBUTE_ID
If IsNumeric(sValue) Then
Select Case sValue
Case 0
SQLAttributeConversion = "None"
Case 1
SQLAttributeConversion = "Success"
Case 2
SQLAttributeConversion = "Failure"
Case 3
SQLAttributeConversion = "All"
End Select
End If
Case SQL_ENABLE_ERROR_REPORTING_ATTRIBUTE_ID
If IsNumeric(sValue) Then
If sValue <> 0 Then
SQLAttributeConversion = "True"
Else
SQLAttributeConversion = "False"
End If
End If
Case SQL_REPLICATION_ATTRIBUTE_ID
If IsNumeric(sValue) Then
If sValue = 1 Then
SQLAttributeConversion = "True"
Else
SQLAttributeConversion = "False"
End If
End If
End Select
End Function
End Class
'******************************************************************************
' Subs and Functions
'
'*** VCS Specific ***
Const WindowsFolder = 0
Const ForWriting = 2
Const ForReading = 1
Const VCS_STRNAME = "Veritas Cluster Server MOM utility"
Dim FILENAME, wfolder, fso, VCSInstalled, strVirtualServers
'Dim objLogFile
'*** VCS Specific ***
Sub Main()
Dim oParams
Set oParams = WScript.Arguments
Set g_List = CreateObject("Scripting.Dictionary")
If oParams.Count < 6 Or oParams.Count > 7 Then
Quit()
End If
If oParams.Count = 7 Then
If LCase(oParams(6)) = "true" Then
IsTargetVirtualServer = True
Else
IsTargetVirtualServer = False
End If
Else
IsTargetVirtualServer = False
End If
Set oParams = Nothing
Set g_oSQL = New SQL
If Not g_oSQL.ConnectedToRegistry Then Quit()
Set g_oUtil = New Util
Call g_oUtil.SetDebugLevel(g_oUtil.DBG_NONE)
Call g_oUtil.LogMessage(g_oUtil.DBG_TRACE, SCRIPT_NAME & " Starting discovery for computer: " & TargetComputer)
'*** 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 SQLServer Instance")
FILENAME = wfolder + "\\Temp\\VCSDiscoverSQL2014DBEngineDiscovery_" + 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
'Write Instance and Lanman information to file
strAPIState = Left(strAPIState, len(strAPIState)- 2)
'objLogFile.WriteLine(strAPIState)
objTextFile.WriteLine(strAPIState)
objTextFile.WriteLine("Writing Lanman Information")
'objLogFile.WriteLine("Writing Lanman Information")
Set objScriptExec = objShell.Exec("%VCS_HOME%\Bin\MOMUtil.exe Lanman VirtualName")
strAPIState = objScriptExec.StdOut.ReadAll
objTextFile.WriteLine(strAPIState)
'objLogFile.WriteLine(strAPIState)
objTextFile.close()
'Get the Instance and Lanman pair with service group
Dim nGrp, strInst, strTempArr, strInstInfo, strPair, strInstArr, strInstSysPair
Set objTextFile = fsO.OpenTextFile(FILENAME, ForReading, True)
Do While objTextFile.AtEndOfline <> True
strAPIState = objTextFile.ReadLine
If (StrComp("Writing Lanman Information", strAPIState, 1) = 0) then
strInst = Right(strInst, len(strInst) - 1)
strInstArr = Split(strInst, ",")
strAPIState = objTextFile.ReadLine
strTempArr = Split(strAPIState, ",")
Do While objTextFile.AtEndOfLine <> True
If (StrComp("Instance", strTempArr(0), 1) = 0 ) Then
'Search this virtual comp for all instances
strVirtualServers = strVirtualServers + ","+ strTempArr(1) + ","
For nGrp = 0 To Ubound(strInstArr)
strInstInfo = Split(strInstArr(nGrp), "@")
'Compare if the lanman resource is same as sql group
If (StrComp(strTempArr(2), strInstInfo(1), 1) = 0) Then
strPair = strPair + "," + strInstInfo(0)+","+ strTempArr(1)+"," + strInstInfo(2)
'Exit For
End If
Next
End If
strAPIState = objTextFile.ReadLine
strTempArr = Split(strAPIState, ",")
Loop
Else
'First Get the SQL group information
strTempArr = Split(strAPIState, ",")
If (StrComp("Instance", strTempArr(0), 1) = 0 ) Then
strInst= strInst + "," + strTempArr(1)+"@"+ strTempArr(2)+"@"+strTempArr(3)
strInstSysPair = strInstSysPair + "@:" + strTempArr(1) + ":"
Else
strInstSysPair = strInstSysPair + ","+ strTempArr(0)+","
End If
End If
Loop
If (len(strPair) > 0) Then
strPair = Right(strPair, len(strPair) - 1)
End If
objTextFile.close()
Set objTextFile = fsO.OpenTextFile(FILENAME, ForWriting, True)
objTextFile.WriteLine(strPair)
objTextFile.WriteLine(strInstSysPair)
End If
Else
'objLogFile.WriteLine("SQL 2014 Not Configured")
Set objScriptExec = objShell.Exec("%VCS_HOME%\Bin\MOMUtil.exe Lanman VirtualName")
strAPIState = objScriptExec.StdOut.ReadAll
objTextFile.WriteLine(strAPIState)
'objLogFile.WriteLine(strAPIState)
objTextFile.close()
'Get the Instance and Lanman pair with service group
Set objTextFile = fsO.OpenTextFile(FILENAME, ForReading, True)
Do While objTextFile.AtEndOfline <> True
strAPIState = objTextFile.ReadLine
strTempArr = Split(strAPIState, ",")
If (StrComp("Instance", strTempArr(0), 1) = 0 ) Then
strVirtualServers = strVirtualServers + ","+ strTempArr(1) + ","
strPair = strPair + "," + "SQL2014DBNotConfiguredUnderVCS," + strTempArr(1) + ",Dummy"
End If
Loop
If (Len(strPair) > 0) Then
strPair = Right(strPair, Len(strPair) - 1)
End If
objTextFile.close()
Set objTextFile = fsO.OpenTextFile(FILENAME, ForWriting, True)
objTextFile.WriteLine(strPair)
End If
objTextFile.close()
End If
'*** VCS Specific ***
Call DoServiceDiscovery()
Call g_oUtil.LogMessage(g_oUtil.DBG_TRACE, SCRIPT_NAME & " Finished discovery for computer: " & TargetComputer)
Dim i, aInsts
Dim dSQLServerInstances, dFullTextSearchServiceNames
'log trace
Call g_oUtil.LogMessage(g_oUtil.DBG_TRACE, "Starting SQL Discovery.")
If Len(ExcludeList) < 0 Then
WriteToEventLogAndExit("Instance exclusion list invalid in DBEngineDiscovery. Aborting discovery.")
End If
Dim oAPI, oSQLDiscoveryData
Set oAPI = CreateObject("MOM.ScriptAPI")
Set oSQLDiscoveryData = oAPI.CreateDiscoveryData(0, SourceId, ManagedEntityId)
Dim sInstances : sInstances = g_oSQL.GetSQLInstances(dSQLServerInstances)
If Not IsNull(sInstances) Then
aInsts = Split(sInstances, ",")
Set dFullTextSearchServiceNames = g_oSQL.GetFullTextSearchInstances()
For i = 0 To UBound(aInsts)
If Not(IsExcluded(aInsts(i))) Then DiscoverSQLInstance aInsts(i), oSQLDiscoveryData, dSQLServerInstances , dFullTextSearchServiceNames
Next
End If
Call oAPI.Return(oSQLDiscoveryData)
match = False
If Trim(ExcludeList) = "*" Then
match = True
Else
aExcludes = Split(ExcludeList, ",")
For i = 0 To UBound(aExcludes)
If LCase(sInstance) = LCase(Trim(aExcludes(i))) Then
match = True
End If
Next
End If
IsExcluded = match
Sub DiscoverSQLInstance(ByVal sInstanceName, ByRef oSQLDiscoveryData, ByRef dSQLServerInstances , ByRef dFullTextSearchServiceNames)
Dim oSQLClass, oDiscoveryData
Set oSQLClass = New SQLClass
oSQLClass.SQLServerInstanceName = sInstanceName
oSQLClass.SQLServerIs64Bit = g_oSQL.Is64Bit(sInstanceName)
'submit the discovery data packet
Call g_oUtil.LogMessage(g_oUtil.DBG_TRACE, "Submitting Discovery data packet.")
Call oSQLDiscoveryData.AddInstance(oSQLInstance)
Dim oResourcePoolGroup
Set oResourcePoolGroup = oSQLDiscoveryData.CreateClassInstance(SQL_RESOURCEPOOLGROUP_CLASS)
With oResourcePoolGroup
.AddProperty "$MPElement[Name='Windows!Microsoft.Windows.Computer']/PrincipalName$", TargetComputerID
.AddProperty "$MPElement[Name='MSSQL2014Discovery!Microsoft.SQLServer.2014.ServerRole']/InstanceName$", oSQLClass.SQLServerInstanceName
.AddProperty "$MPElement[Name='System!System.Entity']/DisplayName$", "Resource Pool Group"
End With
'submit the discovery data packet
Call g_oUtil.LogMessage(g_oUtil.DBG_TRACE, "Submitting ResourcePoolGroup Discovery data packet.")
Call oSQLDiscoveryData.AddInstance(oResourcePoolGroup)
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: