This module type is used to discover instances of Microsoft SQL Server 2014 Databases. The module connects to SQL Server and discovers all databases together with properties.
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
'#Include File:SQL2014Constants.vbs
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:ConnectionString.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 = oQuery.ItemIndex(0)
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 = oQuery.ItemIndex(0).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 = oQuery.ItemIndex(0).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 = oQuery.ItemIndex(0).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 = oQuery.ItemIndex(0).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'#Include File:SQLDatabaseDiscovery.vbs
'Copyright (c) Microsoft Corporation. All rights reserved.
' Parameters that should be passed to this script
' Parameters that should be passed to this script
' 0 MPElement ID ($MPElement$)
' 1 Target Id for ME this rule is running against ($Target/Id$)
' 2 Computer ID
' 3 Computer FQDN
' 4 SQL Connection String for the instance that the DBs are being discovered on
' 5 SQL Instance that this rule is being run for
' 6 Exlcuded database list (prefixed with Exclude:)
Set oAPI = MOMCreateObject("MOM.ScriptAPI")
set oSQLDiscoveryData = oAPI.CreateDiscoveryData(0, SourceId, ManagedEntityId)
If DoDatabaseDiscovery(InstanceName, ConnectionString, oSQLDiscoveryData, TcpPort) >= 0 Then
StoreExcludeDatabaseListToRegistry InstanceName, ExcludeList
oAPI.LogScriptEvent "DatabaseDiscovery:" & InstanceName, 4201, 4, "Database for SQL instance '" + InstanceName + "' discovers successfully."
Else
oSQLDiscoveryData.IsSnapshot = False
End If
Call oAPI.Return(oSQLDiscoveryData)
WScript.Quit()
' This function should be used to escape Database Name parameter
Function EscapeDBName (ByVal strValue)
ON ERROR RESUME NEXT
Err.Clear
EscapeDBName = Replace(strValue, "]", "]]")
End Function
Sub WriteToEventLogAndExit(ByVal message)
oAPI.LogScriptEvent WScript.ScriptName, 4201, EVENT_TYPE_ERROR, message
WScript.Quit()
End Sub
Function DoDatabaseDiscovery(ByVal sSqlInstance, ByVal sSQLConnectionString, ByVal oDisc, ByVal tcp)
If Len(ExcludeList) < 0 Then
WriteToEventLogAndExit("Database exclusion list invalid in DBDiscovery. Aborting discovery.")
End If
Dim e
Set e = New Error
Dim cnADOConnection
Set cnADOConnection = MomCreateObject("ADODB.Connection")
cnADOConnection.Provider = "sqloledb"
cnADOConnection.ConnectionTimeout = 30
Dim cnADOConnectionGroup
Set cnADOConnectionGroup = MomCreateObject("ADODB.Connection")
cnADOConnectionGroup.Provider = "sqloledb"
cnADOConnectionGroup.ConnectionTimeout = 30
Dim strProv
strProv = BuildConnectionStringWithPort(sSQLConnectionString, "master", tcp)
e.Clear
On Error Resume Next
cnADOConnection.Open strProv
e.Save
'get fresh tcp port and try to connect again
if 0 <> Err.number then
e.Clear
Err.Clear
strProv = BuildConnectionString(sSQLConnectionString, "master")
cnADOConnection.Open strProv
e.Save
if 0 <> Err.number then
'Error event in here
DoDatabaseDiscovery = SQL_DISCOVERY_CONNECT_FAILURE
Exit Function
end if
end if
On Error Goto 0
Dim oResults, gResults,pResult
e.Clear
On Error Resume Next
Set oResults = cnADOConnection.Execute("SELECT name, state_desc, resource_pool_id as resource_pool_id FROM sys.databases WHERE source_database_id IS NULL")
e.Save
On Error Goto 0
If e.Number <> 0 Then
DoDatabaseDiscovery = SQL_DISCOVERY_QUERY_FAILURE
Exit Function
End If
On Error Resume Next
Set pResult = cnADOConnection.Execute("select Count(pool_id) from sys.dm_resource_governor_resource_pools")
e.Save
On Error Goto 0
If e.Number <> 0 Then
DoDatabaseDiscovery = SQL_DISCOVERY_QUERY_FAILURE
Exit Function
End If
Dim iDBRow, iRow, sFileType
Dim iPos, iPos2, iTemp, bDBAuto, bLogAuto
Dim oDBResults, oDBInstance, sDBSize, sDBStatus
Dim sDBName, sDBState
Dim dDBSize, dLogSize
Dim sDBOwner
Dim oPool, oPoolRel, sPool, sPoolName
Dim NumberOfPool
NumberOfPool = pResult(0).Value
Do While Not oResults.EOF
sDBName = oResults(0)
sDBState = oResults(1)
sPool = oResults(2)
'sPoolName = oResults(3)
If Not(IsExcluded(SDBName)) Then
Set oDBInstance = oSQLDiscoveryData.CreateClassInstance(SQL_DATABASE_CLASS)
' Set basic DB properties
With oDBInstance
.AddProperty "$MPElement[Name='Windows!Microsoft.Windows.Computer']/PrincipalName$", TargetComputerID
.AddProperty "$MPElement[Name='Microsoft.SQLServer.2014.ServerRole']/InstanceName$", sSqlInstance
.AddProperty "$MPElement[Name='Microsoft.SQLServer.2014.Database']/DatabaseName$", sDBName
End With
' Only do further discovery for DB that is online - sp_helpdb wont return state for offline databases
' To do - may want to add owner, created, dbid and compat level to discovery, collation etc.
If sDBState = "ONLINE" Then
On Error Resume Next
Set oDBResults = cnADOConnection.Execute("sp_helpdb [" & EscapeDBName(sDBName) & "]")
e.Save
On Error Goto 0
Select Case e.Number
Case 0
On Error Resume Next
sDBSize = Trim(oDBResults(1))
e.Save
On Error Goto 0
If e.Number = 0 Then
sDBSize = Trim(oDBResults(1))
sDBStatus = Split(oDBResults(5),",")
sDBOwner = oDBResults(2)
Set oDBResults = oDBResults.NextRecordset
bDBAuto = false
bLogAuto = false
dDBSize = 0
dLogSize = 0
Do While Not oDBResults.EOF
sFileType = oDBResults(7)
If LCase(sFileType) = "data only" Then
If (Trim(oDBResults(6)) <> "0%") And (Trim(oDBResults(6)) <> "0 KB") Then
bDBAuto = true
End If
End If
If LCase(sFileType) = "log only" Then
If (Trim(oDBResults(6)) <> "0%") And (Trim(oDBResults(6)) <> "0 KB") Then
bLogAuto = true
End If
End If
oDBResults.MoveNext
Loop
With oDBInstance
.AddProperty "$MPElement[Name='Microsoft.SQLServer.2014.Database']/RecoveryModel$", Split(sDBStatus(3),"=")(1)
.AddProperty "$MPElement[Name='Microsoft.SQLServer.2014.Database']/Updateability$", Split(sDBStatus(1),"=")(1)
.AddProperty "$MPElement[Name='Microsoft.SQLServer.2014.Database']/UserAccess$", Split(sDBStatus(2),"=")(1)
.AddProperty "$MPElement[Name='Microsoft.SQLServer.2014.Database']/Collation$", Split(sDBStatus(5),"=")(1)
.AddProperty "$MPElement[Name='Microsoft.SQLServer.2014.Database']/DatabaseAutogrow$", CStr(bDBAuto)
.AddProperty "$MPElement[Name='Microsoft.SQLServer.2014.Database']/LogAutogrow$", CStr(bLogAuto)
If Not(IsNull(sDBOwner)) Then
.AddProperty "$MPElement[Name='Microsoft.SQLServer.2014.Database']/Owner$", sDBOwner
End If
End With
End If
Case ERR_CANNOT_INSERT_NULL
' Throw error to event log in here
' Error text will be "The system stored procedure sp_helpdb, which is used to gather information about the databases, has returned an error that may indicate that it cannot determine the db owner for the database [" & strDBName & ']. Here are the details: sp_helpdb @dbName='" & strDBName & "' on SQL Server Instance: " & strSQLServerInstanceName & ". Error number: " & e.Number & ", Error Information: " & e.Description, _
Case Else
' Throw error to event log in here
' Error text will be "Could not execute sp_helpdb @dbname=N'" & Replace(strDBName, "'", "''") & "' on SQL Server Instance: " & strSQLServerInstanceName & ". Error number: " & e.Number & ", Error Information: " & e.Description, _
End Select
Set oDBResults = nothing
End If
'create source
'
'We have to check if there is only one pool. Because Hekaton was implemented in Enterprise Edition.
'Enterprise Edition has two build-in resource pools they are internal and default and customer can add his own pools.
'
sPoolName = ""
If NumberOfPool > 1 Then
Set oPool = Nothing
If IsNull( sPool ) Then
On Error Resume Next
' query for the list of databases which are not database snapshots
strProv = BuildConnectionString(sSQLConnectionString, sDBName)
cnADOConnectionGroup.Open strProv
e.Save
Set gResults = cnADOConnectionGroup.Execute("SELECT name FROM sys.filegroups WHERE type = 'FX'")
e.Save
if Not gResults.EOF Then
Set oPool = oSQLDiscoveryData.CreateClassInstance(SQL_DEFAULTPOOL_CLASS)
Set oPoolRel = oSQLDiscoveryData.CreateRelationshipInstance(SQL_DATABASE_REFERENCES_APPLICATION_POOL)
sPool = 2
End if
cnADOConnectionGroup.Close
On Error Goto 0
Else
Set oPool = oSQLDiscoveryData.CreateClassInstance(SQL_DEDICATED_CLASS)
Set oPoolRel = oSQLDiscoveryData.CreateRelationshipInstance(SQL_DATABASE_REFERENCES_APPLICATION_POOL)
End If
'if there is no FX group when sPool will be null
If Not IsNull( sPool ) Then
'let's get a pool name.
Dim poolResult
On Error Resume Next
Set poolResult = cnADOConnection.Execute("select name,pool_id from sys.dm_resource_governor_resource_pools where pool_id = " & sPool)
e.Save
On Error Goto 0
if Not poolResult.EOF Then
sPoolName = poolResult(0).Value
With oPool
.AddProperty "$MPElement[Name='Microsoft.SQLServer.2014.ResourcePool']/PoolID$", sPool
.AddProperty "$MPElement[Name='Microsoft.SQLServer.2014.ResourcePool']/Name$", sPoolName
.AddProperty "$MPElement[Name='Windows!Microsoft.Windows.Computer']/PrincipalName$", TargetComputerID
.AddProperty "$MPElement[Name='Microsoft.SQLServer.2014.ServerRole']/InstanceName$", sSqlInstance
.AddProperty "$MPElement[Name='System!System.Entity']/DisplayName$", sPoolName
End With
'create relationship
oPoolRel.Source = oDBInstance
oPoolRel.Target = oPool
Call oSQLDiscoveryData.AddInstance(oPoolRel)
End if
End If
End If
' Add DB to the Instance List and move to next DB
call oSQLDiscoveryData.AddInstance(oDBInstance)
End If
oResults.MoveNext
Loop
Set oResults = nothing
cnADOConnection.Close
DoDatabaseDiscovery = SQL_DISCOVERY_SUCCESS
End Function
Function ConvertSizeStringToNumber(sSizeString)
' Remove the KB and return a valid double
sSizeString = Replace(sSizeString, " KB", "")
ConvertSizeStringToNumber = CDbl(sSizeString)
End Function
Function IsExcluded (sDatabase)
Dim aExcludes
Dim match
Dim i
match = false
If Trim(ExcludeList) = "*" Then
match = true
Else
aExcludes = Split(ExcludeList, ",")
For i = 0 To UBound(aExcludes)
If LCase(sDatabase) = LCase(Trim(aExcludes(i))) Then
match = true
End If
Next
End If
IsExcluded = match
End Function
Function StoreExcludeDatabaseListToRegistry(instanceName, ExcludeList)
Dim regKey
Dim oError
Set oError = New Error
On Error Resume Next
regKey = oAPI.GetScriptStateKeyPath("$Target/ManagementGroup/Id$")
regKey = "HKEY_LOCAL_MACHINE\" + regKey + "\" + instanceName + "\DatabaseExcludeList"
oError.Save
On Error Goto 0
If oError.Number <> 0 Then ThrowScriptError "Unable to get database exclude list registry key", oError
Dim wShell
Set wShell = MOMCreateObject("WScript.Shell")
On Error Resume Next
wShell.RegWrite regKey, ExcludeList
oError.Save
On Error Goto 0
If oError.Number <> 0 Then ThrowScriptError "Unable to save database exclude list to registry ", oError
End Function
Home
Show References: