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:SQL2012Constants.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, 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
'#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 < 5 Then
WScript.Quit -1
End If
Dim sInstanceName, sFqdn, sAccount, sMachineName, sServiceName
' 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
sDefaultDomainNC = GetRootNamingContext()
' 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
' 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 naming context
Function GetRootNamingContext()
Dim oRootDse, sRootNamingContext
Set oRootDse = GetObject("GC://RootDSE")
If Not (oRootDse Is Nothing) Then
' Need to confirm search in Domain or forest
' If search in domain, we need to get DefaultNamingContext
' Otherwise, we need to get rootDomainNamingContext
sRootNamingContext = oRootDse.Get("defaultNamingContext")
End If
GetRootNamingContext = 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 </Script></ScriptBody>
<TimeoutSeconds>$Config/TimeoutSeconds$</TimeoutSeconds>
</DataSource>
</MemberModules>
<Composition>
<Node ID="DS"/>
</Composition>
</Composite>
</ModuleImplementation>
<OutputType>System!System.PropertyBagData</OutputType>
</DataSourceModuleType>