Microsoft SQL Server 2008 Mirroring Scripted State Provider (with two level of Host Tcp param)

Microsoft.SQLServer.2008.Mirroring.ScriptedStateProviderTwoLevelHostTcp (DataSourceModuleType)

This datasource provides information based on specified script execution.

Element properties:

TypeDataSourceModuleType
IsolationAny
AccessibilityInternal
RunAsDefault
OutputTypeSystem.PropertyBagData

Member Modules:

ID Module Type TypeId RunAs 
DS DataSource Microsoft.Windows.TimedScript.PropertyBagProvider Default

Overrideable Parameters:

IDParameterTypeSelectorDisplay NameDescription
IntervalSecondsint$Config/IntervalSeconds$Interval (sec)
SyncTimestring$Config/SyncTime$Synchronization Time
TimeoutSecondsint$Config/TimeoutSeconds$Timeout (sec)

Source Code:

<DataSourceModuleType ID="Microsoft.SQLServer.2008.Mirroring.ScriptedStateProviderTwoLevelHostTcp" Accessibility="Internal">
<Configuration>
<xsd:element xmlns:xsd="http://www.w3.org/2001/XMLSchema" name="ScriptName" type="xsd:string"/>
<xsd:element xmlns:xsd="http://www.w3.org/2001/XMLSchema" name="ScriptBody" type="xsd:string"/>
<xsd:element xmlns:xsd="http://www.w3.org/2001/XMLSchema" name="IntervalSeconds" type="xsd:integer"/>
<xsd:element xmlns:xsd="http://www.w3.org/2001/XMLSchema" name="SyncTime" type="xsd:string"/>
<xsd:element xmlns:xsd="http://www.w3.org/2001/XMLSchema" name="TimeoutSeconds" type="xsd:integer"/>
<xsd:element xmlns:xsd="http://www.w3.org/2001/XMLSchema" name="ConnectionString" type="xsd:string"/>
</Configuration>
<OverrideableParameters>
<OverrideableParameter ID="IntervalSeconds" ParameterType="int" Selector="$Config/IntervalSeconds$"/>
<OverrideableParameter ID="SyncTime" ParameterType="string" Selector="$Config/SyncTime$"/>
<OverrideableParameter ID="TimeoutSeconds" ParameterType="int" Selector="$Config/TimeoutSeconds$"/>
</OverrideableParameters>
<ModuleImplementation>
<Composite>
<MemberModules>
<DataSource ID="DS" TypeID="Windows!Microsoft.Windows.TimedScript.PropertyBagProvider">
<IntervalSeconds>$Config/IntervalSeconds$</IntervalSeconds>
<SyncTime>$Config/SyncTime$</SyncTime>
<ScriptName>$Config/ScriptName$</ScriptName>
<Arguments>"$Config/ConnectionString$" "$Target/Host/Host/Property[Type="SQL!Microsoft.SQLServer.DBEngine"]/TcpPort$"</Arguments>
<ScriptBody><Script>'#Include File:Common.vbs

Option Explicit
SetLocale("en-us")

Dim oAPI
Set oAPI = MOMCreateObject("MOM.ScriptAPI")

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 &lt;&gt; 0 Then ThrowScriptError "Unable to create automation object '" &amp; sProgramId &amp; "'", oError
End Function

'#Include File:ConnectionString.vbs

Function BuildConnectionString(strServer, strDatabase)
ON ERROR RESUME NEXT
Err.Clear

Dim dataSource
dataSource = BuildServerName(strServer, "")
BuildConnectionString = "Data Source=" &amp; EscapeConnStringValue(dataSource) &amp; ";Initial Catalog=" &amp; EscapeConnStringValue(strDatabase) &amp; ";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 &lt;&gt; "0") And (tcpPort &lt;&gt; "")) Then
dataSource = dataSource &amp; "," &amp; tcpPort
End If
BuildConnectionStringWithPort = "Data Source=" &amp; EscapeConnStringValue(dataSource) &amp; ";Initial Catalog=" &amp; EscapeConnStringValue(strDatabase) &amp; ";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 &gt; 1) Then
instanceName = pathArray(1)
End If

serverName = strServer

Set oWMI = GetObject("winmgmts:\\" &amp; computerName &amp; "\root\Microsoft\SqlServer\" &amp; SQL_WMI_NAMESPACE)
Set oQuery = oWMI.ExecQuery("SELECT * FROM ServerNetworkProtocolProperty WHERE ProtocolName = 'Tcp' AND InstanceName = '"&amp; EscapeWQLString(instanceName) &amp;"' AND PropertyName = 'ListenOnAllIPs'")

If oQuery.Count &gt;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 = '"&amp; EscapeWQLString(instanceName) &amp;"' AND IPAddressName = 'IPAll' AND (PropertyName = 'TcpPort' OR PropertyName = 'TcpDynamicPorts') AND PropertyStrVal &lt;&gt; ''")

If (oQuery.Count &gt; 0) Then
tcp = oQuery.ItemIndex(0).PropertyStrVal

If ((tcp &lt;&gt; "0") And (tcp &lt;&gt; "")) Then
serverName = serverName &amp; "," &amp; tcp
Else tcp = ""
End If
End If
Else
Set oQuery = oWMI.ExecQuery("SELECT * FROM ServerNetworkProtocolProperty WHERE ProtocolName = 'Tcp' AND InstanceName = '"&amp; EscapeWQLString(instanceName) &amp;"' AND IPAddressName &lt;&gt; '' AND PropertyName = 'Enabled' AND PropertyNumVal = 1")
If (oQuery.Count &gt; 0) Then
Dim ipAddressName
ipAddressName = oQuery.ItemIndex(0).IPAddressName
Set oQuery = oWMI.ExecQuery("SELECT * FROM ServerNetworkProtocolProperty WHERE ProtocolName = 'Tcp' AND InstanceName = '"&amp; EscapeWQLString(instanceName) &amp;"' AND IPAddressName = '"&amp; EscapeWQLString(ipAddressName) &amp;"' AND (PropertyName = 'TcpPort' OR PropertyName = 'TcpDynamicPorts') AND PropertyStrVal &lt;&gt; ''")
If (oQuery.Count &gt; 0) Then
tcp = oQuery.ItemIndex(0).PropertyStrVal
End If
Set oQuery = oWMI.ExecQuery("SELECT * FROM ServerNetworkProtocolProperty WHERE ProtocolName = 'Tcp' AND InstanceName = '"&amp; EscapeWQLString(instanceName) &amp;"' AND IPAddressName = '"&amp; EscapeWQLString(ipAddressName) &amp;"' AND PropertyName = 'IpAddress' AND PropertyStrVal &lt;&gt; ''")
If (oQuery.Count &gt; 0) Then
ip = oQuery.ItemIndex(0).PropertyStrVal
End If
If ip &lt;&gt; "" Then
serverName = ip
End If
If ((tcp &lt;&gt; "0") And (tcp &lt;&gt; "")) Then
serverName = servername &amp; "," &amp; tcp
Else tcp = ""
End If
End If
End If
End If
On Error Goto 0
BuildServerName = serverName
End Function'#Include File:ErrorHandling.vbs

Const EVENT_TYPE_ERROR = 1

Class Error
Private m_lNumber
Private m_sSource
Private m_sDescription
Private m_sHelpContext
Private m_sHelpFile
Public Sub Save()
m_lNumber = Err.number
m_sSource = Err.Source
m_sDescription = Err.Description
m_sHelpContext = Err.HelpContext
m_sHelpFile = Err.helpfile
End Sub
Public Sub Raise()
Err.Raise m_lNumber, m_sSource, m_sDescription, m_sHelpFile, m_sHelpContext
End Sub
Public Sub Clear()
m_lNumber = 0
m_sSource = ""
m_sDescription = ""
m_sHelpContext = ""
m_sHelpFile = ""
End Sub
Public Default Property Get Number()
Number = m_lNumber
End Property
Public Property Get Source()
Source = m_sSource
End Property
Public Property Get Description()
Description = m_sDescription
End Property
Public Property Get HelpContext()
HelpContext = m_sHelpContext
End Property
Public Property Get HelpFile()
HelpFile = m_sHelpFile
End Property
End Class

Function ThrowScriptErrorNoAbort(ByVal sMessage, ByVal oErr)
On Error Resume Next
oAPI.LogScriptEvent WScript.ScriptName, 4001, EVENT_TYPE_ERROR, sMessage &amp; ". " &amp; oErr.Description
End Function

Function ThrowScriptError(ByVal sMessage, ByVal oErr)
On Error Resume Next
ThrowScriptErrorNoAbort sMessage, oErr
Quit()
End Function

Sub WriteToEventLogAndExit(ByVal message)
oAPI.LogScriptEvent WScript.ScriptName, 4002, EVENT_TYPE_ERROR, message
WScript.Quit()
End Sub
'#Include File:DatabaseHelpers.vbs

Function ExtractHostNameFromEndpoint(ByVal sEndpoint)
If sEndpoint = "" Then
ExtractHostNameFromEndpoint = ""
Exit Function
End If
Dim oRegEx, oMatches
Set oRegEx = MomCreateObject("VBScript.RegExp")
oRegEx.Pattern = "://(.+):"
Set oMatches = oRegEx.Execute(sEndpoint)
If oMatches.Count &gt; 0 Then
If oMatches(0).SubMatches.Count &gt; 0 Then
ExtractHostNameFromEndpoint = oMatches(0).SubMatches(0)
Else
ExtractHostNameFromEndpoint = sEndpoint
End If
Else
ExtractHostNameFromEndpoint = sEndpoint
End If
End Function

Function GetMirroringLevelName(ByVal nSafetyLevel, ByVal sWitnessName)
GetMirroringLevelName = "Unknown state"
If nSafetyLevel = 1 Then
GetMirroringLevelName = "High-performance mode"
Else
If sWitnessName = "" Then
GetMirroringLevelName = "High-safety mode without automatic failover"
Else
GetMirroringLevelName = "High-safety mode with automatic failover"
End If
End If
End Function

Function IsExcluded(ByVal sDatabase, ByVal sExcludeList)
Dim aExcludes, bMatch, nIndex

bMatch = False
If Trim(sExcludeList) = "*" Then
bMatch = True
Else
aExcludes = Split(sExcludeList, ",")
For nIndex = 0 To UBound(aExcludes)
If LCase(sDatabase) = LCase(Trim(aExcludes(nIndex))) Then
bMatch = True
End If
Next
End If
IsExcluded = bMatch
End Function


$Config/ScriptBody$
</Script></ScriptBody>
<TimeoutSeconds>$Config/TimeoutSeconds$</TimeoutSeconds>
</DataSource>
</MemberModules>
<Composition>
<Node ID="DS"/>
</Composition>
</Composite>
</ModuleImplementation>
<OutputType>System!System.PropertyBagData</OutputType>
</DataSourceModuleType>