提供 SQL Server 執行個體 SPN 組態的相關資訊。
Type | DataSourceModuleType |
Isolation | Any |
Accessibility | Internal |
RunAs | Microsoft.SQLServer.SQLDefaultAccount |
OutputType | System.PropertyBagData |
ID | Module Type | TypeId | RunAs |
---|---|---|---|
DS | DataSource | Microsoft.Windows.TimedScript.PropertyBagProvider | Default |
ID | ParameterType | Selector | Display Name | Description |
---|---|---|---|---|
IntervalSeconds | int | $Config/IntervalSeconds$ | 間隔 (秒) | |
SyncTime | string | $Config/SyncTime$ | 同步處理時間 | |
TimeoutSeconds | int | $Config/TimeoutSeconds$ | 逾時 (秒) | |
SearchScope | string | $Config/SearchScope$ | 搜尋範圍 | 搜尋範圍是網域或組織單位時,請使用 LDAP 搜尋。 搜尋範圍是樹系時,可以使用通用類別目錄 (GC) 搜尋,解析所有磁碟分割內的查詢。 數值清單: LDAP GC |
<DataSourceModuleType ID="Microsoft.SQLServer.2008.SPNConfigurationStateProvider" Accessibility="Internal" RunAs="SQL!Microsoft.SQLServer.SQLDefaultAccount">
<Configuration>
<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="ComputerNetworkName" type="xsd:string"/>
<xsd:element xmlns:xsd="http://www.w3.org/2001/XMLSchema" name="NetbiosComputerName" type="xsd:string"/>
<xsd:element xmlns:xsd="http://www.w3.org/2001/XMLSchema" name="InstanceName" type="xsd:string"/>
<xsd:element xmlns:xsd="http://www.w3.org/2001/XMLSchema" name="Account" type="xsd:string"/>
<xsd:element xmlns:xsd="http://www.w3.org/2001/XMLSchema" name="ServiceName" type="xsd:string"/>
<xsd:element xmlns:xsd="http://www.w3.org/2001/XMLSchema" name="TimeoutSeconds" type="xsd:int"/>
<xsd:element xmlns:xsd="http://www.w3.org/2001/XMLSchema" name="SearchScope" 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$"/>
<OverrideableParameter ID="SearchScope" ParameterType="string" Selector="$Config/SearchScope$"/>
</OverrideableParameters>
<ModuleImplementation>
<Composite>
<MemberModules>
<DataSource ID="DS" TypeID="Windows!Microsoft.Windows.TimedScript.PropertyBagProvider">
<IntervalSeconds>$Config/IntervalSeconds$</IntervalSeconds>
<SyncTime>$Config/SyncTime$</SyncTime>
<ScriptName>GetSQL2008SPNState.vbs</ScriptName>
<Arguments>$Config/ComputerNetworkName$ $Config/NetbiosComputerName$ $Config/InstanceName$ "$Config/Account$" $Config/ServiceName$ $Config/SearchScope$</Arguments>
<ScriptBody> '#Include File:Initialize.vbs
Option Explicit
SetLocale("en-us")
Function Quit()
WScript.Quit()
End Function
Function IsValidObject(ByVal oObject)
IsValidObject = False
If IsObject(oObject) Then
If Not oObject Is Nothing Then
IsValidObject = True
End If
End If
End Function
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:SQL2008Constants.vbs
Const SQL_WMI_NAMESPACE = "ComputerManagement10"
'#Include File:Error.vbs
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
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: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:SQLSPNMonitoring.vbs
' Copyright (c) Microsoft Corporation. All rights reserved.
' This script takes one parameters of the sql instance
' returns whether the SPN of SQL is correct.
Const SCRIPT_ERRORNUMBER = 4001
' Validate the arguments.
Dim oArgs
Set oArgs = WScript.Arguments
If oArgs.Count < 6 Then
WScript.Quit -1
End If
Dim sInstanceName, sFqdn, sAccount, sMachineName, sServiceName, sSearchScope
sFqdn = oArgs(0)
sMachineName = oArgs(1)
sInstanceName = oArgs(2)
sAccount = oArgs(3)
sServiceName = oArgs(4)
sSearchScope = oArgs(5)
' Create the objects.
Dim oAPI, oBag
Set oAPI = CreateObject("MOM.ScriptAPI")
Set oBag = oAPI.CreatePropertyBag()
' Prepare account name for virtual service account
Dim sVirtualAccountName
sVirtualAccountName = "NT SERVICE\"
If StringEqualsInsensitive(sInstanceName, "MSSQLSERVER") Then
sVirtualAccountName = sVirtualAccountName & "MSSQLSERVER"
Else
sVirtualAccountName = sVirtualAccountName & "MSSQL$" & sInstanceName
End If
'get Domain DC=onecity,DC=corp,DC=fabrikam,DC=com
Dim sDefaultDomainNC
On Error Resume Next
if StringContainsInsensitive(sSearchScope, "GC") Or (StringContainsInsensitive(sSearchScope, "Global") and StringContainsInsensitive(sSearchScope, "Catalog")) then
sDefaultDomainNC = GetRootDomainNamingContext()
else
sDefaultDomainNC = GetDefaultRootNamingContext()
end if
' Log a information message if it's not domain joined.
If Err.number <> 0 Then
Call HandleError(4, "The computer is not domain joined.")
End If
On Error Goto 0
' If domain NC is null, it's not domain joined computer, skip.
If IsNull(sDefaultDomainNC) Or sDefaultDomainNC = "" Then
Call SilentQuit()
End If
' If sFqdn doesn't include domain
dim sDomainNC
sDomainNC = Replace(sDefaultDomainNC, ",DC=", ".")
sDomainNC = Replace(sDomainNC, "DC=", ".")
if InStr(1, LCase(sFqdn), LCase(sDomainNC)) = 0 Then
sFqdn = sFqdn & sDomainNC
End If
' Get the expected Account
Dim sExpectedAccount
' For LocalService and NetworkService account, we need to check both strings with space and without space.
If StringEqualsInsensitive(sAccount, "NT AUTHORITY\NETWORK SERVICE") Or StringEqualsInsensitive(sAccount, "NT AUTHORITY\NETWORKSERVICE") Or _
StringEqualsInsensitive(sAccount, "NT AUTHORITY\LOCAL SERVICE") Or StringEqualsInsensitive(sAccount, "NT AUTHORITY\LOCALSERVICE") Or _
StringEqualsInsensitive(sAccount, "LOCALSYSTEM") Or StringEqualsInsensitive(sAccount, sVirtualAccountName) Then
sExpectedAccount = LCase(sMachineName) & "$"
Else
' If the service account in a local account, skip
Dim sDomainPart
sDomainPart = GetDomainPart(sAccount)
If StringEqualsInsensitive(sDomainPart, sFqdn) Or StringEqualsInsensitive(sDomainPart, sMachineName) Or _
StringEqualsInsensitive(sDomainPart, ".") Or StringEqualsInsensitive(sDomainPart, "LOCALHOST") Or _
StringEqualsInsensitive(sDomainPart, "") Then
Call SilentQuit()
End If
sExpectedAccount = LCase(GetAccountOnly(sAccount))
End If
Dim dRequiredSpns, sSpn
Set dRequiredSpns = CreateObject("Scripting.Dictionary")
' Query protocols from WMI
Dim sWMIQuery, colProtocals, oProtocal
sWMIQuery = "SELECT ProtocolName FROM ServerNetworkProtocol where Enabled = true and InstanceName = '" & EscapeWQLString(sInstanceName) & "'"
Set colProtocals = WMIExecQuery ("winmgmts:\\" & sFqdn & "\root\Microsoft\SqlServer\" & SQL_WMI_NAMESPACE, sWMIQuery)
For Each oProtocal In colProtocals
If Not IsNull(oProtocal) Then
Select Case oProtocal.ProtocolName
Case "Tcp"
' Get the sql tcp ports.
Dim dTcpPorts, sPort
' TODO: the oProtocal.MultiIpConfigurationSupport is always true..
Set dTcpPorts = GetSqlTcpPorts(sInstanceName)
' Add required SPN for each tcp port
For Each sPort in dTcpPorts
If sPort <> "0" Then
sSpn = "MSSQLSvc/" & sFqdn & ":" & sPort
Call dRequiredSpns.Add(sSpn, sSpn)
End If
Next
Case "Np"
If StringEqualsInsensitive(sInstanceName, "MSSQLSERVER") = True Then
sSpn = "MSSQLSvc/" & sFqdn
Else
sSpn = "MSSQLSvc/" & sFqdn & ":" & sInstanceName
End If
Call dRequiredSpns.Add(sSpn, sSpn)
Case Else
' Do nothing.
End Select
End If
Next
'phase 2 Query AD..
Dim dSamAccountNames, sSamAccountName
Dim sMissingSpnList, sMisplacedSpnList, sDuplicateSpnList
Dim bSpnExistOnServiceAccount, bSpnExistOnNonServiceAccount, bHasIssue
bHasIssue = False
' For each required spn, query the AD.
For Each sSpn in dRequiredSpns
bSpnExistOnServiceAccount = False
bSpnExistOnNonServiceAccount = False
' Query the AD for the spn
Set dSamAccountNames = SearchADForSpn(sSpn, sDefaultDomainNC)
' If failed to query the AD, skip check
If dSamAccountNames is Nothing Then
Call SilentQuit()
End If
' For each account object returned, check if the samAccountName matches the expected value.
For Each sSamAccountName in dSamAccountNames
If LCase(sSamAccountName) = sExpectedAccount Then
bSpnExistOnServiceAccount = True
Else
bSpnExistOnNonServiceAccount = True
End If
Next
If Not bSpnExistOnServiceAccount And Not bSpnExistOnNonServiceAccount Then
bHasIssue = True
sMissingSpnList = sMissingSpnList & sSpn & ", "
End If
If Not bSpnExistOnServiceAccount And bSpnExistOnNonServiceAccount Then
bHasIssue = True
' We dint find the SPN on the Expected account, so all the existing SamAccountNames are incorrect.
For Each sSamAccountName in dSamAccountNames
sMisplacedSpnList = sMisplacedSpnList & sSpn & " - " & sSamAccountName & ", "
Next
End If
If bSpnExistOnServiceAccount And bSpnExistOnNonServiceAccount Then
bHasIssue = True
' We just want to include the SamAccountNames that doesnt match the Excepted Account
For Each sSamAccountName in dSamAccountNames
If LCase(sSamAccountName) <> sExpectedAccount Then
sDuplicateSpnList = sDuplicateSpnList & sSpn & " - " & sSamAccountName & ", "
End If
Next
End If
Next
' add result to the property bag and return.
Call oBag.AddValue("HasIssue", bHasIssue)
Call oBag.AddValue("MissingSpnList", NormalizeSpnList(sMissingSpnList))
Call oBag.AddValue("MisplacedSpnList", NormalizeSpnList(sMisplacedSpnList))
Call oBag.AddValue("DuplicateSpnList", NormalizeSpnList(sDuplicateSpnList))
Call oAPI.Return(oBag)
WScript.Quit()
' Quit silently
Sub SilentQuit()
Call oBag.AddValue("HasIssue", False)
Call oAPI.Return(oBag)
WScript.Quit()
End Sub
' return if the string equals insensitively
Function StringEqualsInsensitive(strA, strB)
If LCase(strA) = LCase(strB) Then
StringEqualsInsensitive = True
Else
StringEqualsInsensitive = False
End If
End Function
' return if the string contains substring insensitively
Function StringContainsInsensitive(strA, strB)
If InStr(LCase(strA), LCase(strB)) > 0 Then
StringContainsInsensitive = True
Else
StringContainsInsensitive = False
End If
End Function
' This function accept "domain\account" input, returns "account"
' If the input is "account@domain", return "account"
Function GetAccountOnly(sAccount)
Dim iPos
' Check if the account is in "account@domain" format.
iPos = InStr(sAccount, "@")
If iPos > 1 Then
GetAccountOnly = Left(sAccount, iPos - 1)
Exit Function
End If
iPos = InStr(sAccount, "\")
If iPos > 0 Then
GetAccountOnly = Right(sAccount, Len(sAccount) - iPos)
Else
GetAccountOnly = sAccount
End If
End Function
' This function accept "domain\account" input, returns "domain"
' If the input is "account@domain", return "domain"
Function GetDomainPart(sAccount)
Dim iPos
' Check if the account is in "account@domain" format.
iPos = InStr(sAccount, "@")
If iPos > 0 Then
GetDomainPart = Right(sAccount, Len(sAccount) - iPos)
Exit Function
End If
iPos = InStr(sAccount, "\")
If iPos > 1 Then
GetDomainPart = Left(sAccount, iPos-1)
Else
GetDomainPart = ""
End If
End Function
' Remove the last "," if exists
Function NormalizeSpnList(sSpnList)
Dim iLen
iLen = Len(sSpnList)
If iLen > 2 Then
NormalizeSpnList = Left(sSpnList, iLen - 2)
Else
NormalizeSpnList = sSpnList
End If
End Function
' The function search the AD for the give SPN
Function SearchADForSpn(sSpn, sDefaultDomainNC)
Dim sBase, sFilter, sAttribs, sDepth, sQuery
' Use GC query here to improve the performance?
' If we query the entire forest, we have to use GC query.
sBase = "<GC://" & sDefaultDomainNC & ">"
' Build the query string.
sFilter = "(servicePrincipalName=" & sSpn & ")"
sAttribs = "samAccountName"
sDepth = "subTree"
sQuery = sBase & ";" & sFilter & ";" & sAttribs & ";" & sDepth
' Do the search
Dim oResults
On Error Resume Next
Set oResults = ExecuteADQuery(sQuery)
' Log a warning message if query failed.
If Err.number <> 0 Then
Call HandleError(2, "Failed to execute the query '" & sQuery & "' in the Active Directory.")
Set SearchADForSpn = Nothing
Exit Function
End If
On Error Goto 0
Dim dSamAccountName, sSamAccountName
Set dSamAccountName = CreateObject("Scripting.Dictionary")
' Add the samAccountName to the dictionary
Do While Not oResults.EOF
sSamAccountName = oResults("samAccountName")
Call dSamAccountName.Add(sSamAccountName, sSamAccountName)
oResults.MoveNext
Loop
Set SearchADForSpn = dSamAccountName
End Function
' This function get the sql tcp ports.
Function GetSqlTcpPorts(sInstanceName)
Dim sTcpPort, sWMIQuery, iListenOnAllIPs
Dim dSqlTcpPorts, colProtocalProperties, oProperty
Set dSqlTcpPorts = CreateObject("Scripting.Dictionary")
' Get ListenOnAllIPs property
sWMIQuery = "SELECT PropertyName, PropertyNumVal FROM ServerNetworkProtocolProperty WHERE ProtocolName = 'Tcp' And PropertyName = 'ListenOnAllIPs' And InstanceName = '" & EscapeWQLString(sInstanceName) & "'"
Set colProtocalProperties = WMIExecQuery ("winmgmts:\\" & sFqdn & "\root\Microsoft\SqlServer\" & SQL_WMI_NAMESPACE, sWMIQuery)
For Each oProperty in colProtocalProperties
If Not IsNull(oProperty) Then
iListenOnAllIPs = oProperty.PropertyNumVal
Exit For
End If
Next
If iListenOnAllIPs = 1 Then
Call GetTcpPort(sInstanceName, "IPAll", dSqlTcpPorts)
Else
Dim oIPAddress, colIPAddressNames
sWMIQuery = "SELECT IPAddressName FROM ServerNetworkProtocolIPAddress WHERE ProtocolName = 'Tcp' And Enabled = true And InstanceName = '" & EscapeWQLString(sInstanceName) & "'"
Set colIPAddressNames = WMIExecQuery ("winmgmts:\\" & sFqdn & "\root\Microsoft\SqlServer\" & SQL_WMI_NAMESPACE, sWMIQuery)
For Each oIPAddress in colIPAddressNames
If Not IsNull(oIPAddress) Then
Call GetTcpPort(sInstanceName, oIPAddress.IPAddressName, dSqlTcpPorts)
End If
Next
End If
Set GetSqlTcpPorts = dSqlTcpPorts
End Function
Sub AddIfNotExist(ByRef dic, value)
If Not dic.Exists(value) Then
Call dic.Add(value, value)
End If
End Sub
' Get the TCP port for the given IPAddressName.
Sub GetTcpPort(sInstanceName, sIPAddressName, ByRef dic)
Dim sWMIQuery
Dim oProtocalProperty, colProtocalProperties
sWMIQuery = "SELECT PropertyName, PropertyStrVal FROM ServerNetworkProtocolProperty WHERE ProtocolName = 'Tcp' And IpAddressName = '" & EscapeWQLString(sIPAddressName) & "' And InstanceName = '" & EscapeWQLString(sInstanceName) & "'"
Set colProtocalProperties = WMIExecQuery ("winmgmts:\\" & sFqdn & "\root\Microsoft\SqlServer\" & SQL_WMI_NAMESPACE, sWMIQuery)
For Each oProtocalProperty In colProtocalProperties
If IsNull(oProtocalProperty) = False Then
If oProtocalProperty.PropertyName = "TcpPort" And oProtocalProperty.PropertyStrVal <> "" And IsNumeric(oProtocalProperty.PropertyStrVal) Then
Call AddIfNotExist(dic, oProtocalProperty.PropertyStrVal)
ElseIf oProtocalProperty.PropertyName = "TcpDynamicPorts" And oProtocalProperty.PropertyStrVal <> "" And IsNumeric(oProtocalProperty.PropertyStrVal) Then
Call AddIfNotExist(dic, oProtocalProperty.PropertyStrVal)
End If
End If
Next
End Sub
' This function return the root domain naming context
Function GetRootDomainNamingContext()
Dim oRootDse, sRootNamingContext
Set oRootDse = GetObject("GC://RootDSE")
If Not (oRootDse Is Nothing) Then
sRootNamingContext = oRootDse.Get("rootDomainNamingContext")
End If
GetRootDomainNamingContext = sRootNamingContext
End Function
' This function return the default root naming context
Function GetDefaultRootNamingContext()
Dim oRootDse, sRootNamingContext
Set oRootDse = GetObject("LDAP://RootDSE")
If Not (oRootDse Is Nothing) Then
sRootNamingContext = oRootDse.Get("defaultNamingContext")
End If
GetDefaultRootNamingContext = sRootNamingContext
End Function
' Execute the AD query.
Function ExecuteADQuery(sQuery)
Dim oConnection
Set oConnection = CreateObject("ADODB.Connection")
oConnection.Open "Data Source=Active Directory Provider;Provider=ADsDSOObject"
If Err.number = 0 Then
Set ExecuteADQuery = oConnection.Execute(sQuery)
Else
Set ExecuteADQuery = Nothing
End If
End Function
' Handle the error: log the error in the event log.
Sub HandleError(iLevel, sMessage)
Dim sLog
' Log message
sLog = sMessage & Vbcrlf & _
"Description: " & Err.Description & Vbcrlf & _
"Error Number: 0x" & Hex(Err.number) & Vbcrlf & _
"Source: " & Err.Source
Call oAPI.LogScriptEvent(WScript.ScriptName, SCRIPT_ERRORNUMBER, iLevel, sLog)
Call Err.Clear()
End Sub
</ScriptBody>
<TimeoutSeconds>$Config/TimeoutSeconds$</TimeoutSeconds>
</DataSource>
</MemberModules>
<Composition>
<Node ID="DS"/>
</Composition>
</Composite>
</ModuleImplementation>
<OutputType>System!System.PropertyBagData</OutputType>
</DataSourceModuleType>