Este tipo de módulo é usado para descobrir instâncias do Mecanismo de Banco de Dados do Microsoft SQL Server 2008. O módulo consulta o Registro e a WMI para obter informações sobre a instalação e, em seguida, conecta-se a cada instância dos mecanismos de banco de dados para coletar informações de propriedade sobre a instância.
O intervalo de sondagem em segundos no qual a descoberta será executada.
SyncTime
string
$Config/SyncTime$
Hora da Sincronização
Hora em que será feita a descoberta inicial
ExcludeList
string
$Config/ExcludeList$
Lista de Exclusões
Uma lista separada por vírgulas das instâncias do mecanismo de banco de dados que devem ser excluídas da descoberta. É possível usar o caractere curinga * para excluir todas as instâncias.
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:SQL2008Constants.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\" & SQL_WMI_NAMESPACE)
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, 4001, 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, 4002, 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
Dim currentNamespace, sqlWmi
' Check Sql Server namespace existence
' because Seed Discovery treats Sql Server Native Client as Sql Server instance
currentNamespace = "winmgmts:\\" & TargetComputer & "\root\Microsoft\SqlServer"
On Error Resume Next
Set sqlWmi = GetObject(currentNamespace)
On Error GoTo 0
If IsEmpty(sqlWmi) then
GetSQLInstances = Null
Exit Function
End If
Set oVersionSpecificNamespace = WMIExecQuery(currentNamespace, "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)
For Each oService in oServices
sInstance = InstanceNameFromServiceName(oService.ServiceName)
If IsSupportedVersion(sInstance) Then
If IsSupportedSku(sInstance) Then
bIs64Bit = g_oSQL.Is64Bit(sInstance)
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
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
'
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)
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)
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
PTB 
Show References: