Fournisseur de l'état de script avec la source de données VBScript. Utilisé pour analyser les stratégies d'utilisateur personnalisées de base de données.
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:Error.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: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: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 = 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 = BuildConnectionString(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
'#Include File:SQLADODB.vbs
''''''''''''''''''''''''''''''''''''
''' Class ADODB
''''''''''''''''''''''''''''''''''''
Class ADODB
Dim ADOConnection
Private Sub Class_Initialize()
On Error Resume Next
Set ADOConnection = CreateObject("ADODB.Connection")
HandleError("Cannot create object 'ADODB.Connection' (ADODB.Class_Initialize).")
End Sub
Public Function Open(connectionString, provider, connectionTimeout)
On Error Resume Next
Open = false
if connectionString = "" Then
Err.Raise SCRIPT_EVENT_ID, "ADODB.Open()", "Argument 'connectionString' cannot be empty." , "", 0
End If
ADOConnection.ConnectionString = connectionString
if provider = "" Then
ADOConnection.Provider = "sqloledb"
Else
ADOConnection.Provider = provider
End If
if connectionTimeout <= 0 Then
ADOConnection.ConnectionTimeout = 30
Else
ADOConnection.ConnectionTimeout = connectionTimeout
End If
HandleError("Cannot initialize ADODB connection (ADODB.Open).")
ADOConnection.Open()
if Err.number = 0 Then
Open = True
End If
End Function
Public Function ExecuteQuery(query)
On Error Resume Next
Set ExecuteQuery = ADOConnection.Execute(query)
End Function
' Params argument should be a single parameter or a single-dimensional Array
' Parameter places in query should be marked as ?
' Order must be kept
'
' If you want to use named ones, you should start
' your query with something like "declare @paramname int = ?"
' and then use @paramname in the query text.
'
' int, bigint and NVarChar are supported for now, additional support can be added in the AddParam sub
Public Function ExecuteQueryWithParams(query, params)
On Error Resume Next
' Create a new Command object
Dim Cmd
Set Cmd = CreateObject("ADODB.Command")
' Specify the connection
Cmd.ActiveConnection = ADOConnection
' Specify command type and text
Cmd.CommandText = query
Cmd.CommandType = 1 ' adCmdText
' Create a new parameter
Dim i
If IsArray(params) Then
For i = 0 To UBound(params)
AddParam Cmd, params(i)
Next
Else
AddParam Cmd, params
End If
Set ExecuteQueryWithParams = Cmd.Execute
End Function
Sub AddParam(cmd, value)
Dim Parameter
Select Case VarType(value)
Case 2 ' int
Set Parameter = cmd.CreateParameter(, 3, 1, , value) ' , adInteger, adParamInput
Case 3 ' long
Set Parameter = cmd.CreateParameter(, 20, 1, , value) ' , adBigInt, adParamInput
Case 8 ' string
Set Parameter = cmd.CreateParameter(, 202, 1, Max(Len(value), 1), value) ' , adVarWChar, adParamInput
Case else
HandleError("Unknown parameter type: " & VarType(value))
End Select
cmd.Parameters.Append Parameter
End Sub
Function Max(a,b)
Max = a
If b > a then Max = b
End Function
Public Function Close()
On Error Resume Next
if Not IsNull(ADOConnection) Then
ADOConnection.Close()
HandleError("Cannot close ADODB connection (ADODB.Close).")
End If
End Function
Public Function HandleOpenConnectionErrorContinue(database, serverName, sqlInstanceName)
HandleOpenConnectionErrorContinue = true
if Err.number <> 0 Then
HandleOpenConnectionErrorContinue = false
Dim oError : Set oError = new Error
oError.Save()
Dim instanceIsRunning : instanceIsRunning = IsServiceRunning(sqlInstanceName)
On Error Resume Next
oError.Raise()
if ((Err.number and 65535) = 16389 or (Err.number and 65535) = 3661) and instanceIsRunning Then
Logger.LogError("Cannot login to database [" & serverName & "][" & sqlInstanceName & ":" & database & "] ")
Err.Clear
ElseIf (instanceIsRunning) Then
Logger.LogFormattedError("Cannot open ADODB connection. (Connection string: '" & ADOConnection.ConnectionString & "'.)")
Err.Clear
Else
Err.Clear
End If
On Error Goto 0
End If
End Function
Public Function HandleExecutionQueryErrorContinue(query, serverName, sqlInstanceName)
HandleExecutionQueryErrorContinue = true
if Err.number <> 0 Then
HandleExecutionQueryErrorContinue = false
Dim oError : Set oError = new Error
oError.Save()
Dim instanceIsRunning : instanceIsRunning = IsServiceRunning(sqlInstanceName)
On Error Resume Next
error.Raise()
if ((Err.number and 65535) = 16389 or (Err.number and 65535) = 3661) and instanceIsRunning Then
Logger.LogError("Cannot login to database [" & serverName & "][" & sqlInstanceName & ":" & ADOConnection.DefaultDatabase & "] ")
Err.Clear
ElseIf (instanceIsRunning) Then
Logger.LogFormattedError("Cannot execute query: '" & query & "'.")
Err.Clear
Else
Err.Clear
End If
On Error Goto 0
End If
End Function
Public Function IsServiceRunning(sInstance)
Dim sServiceName : sServiceName = GetSQLServiceName(sInstance)
Dim oService, sObjectString
sObjectString = "winmgmts:\\.\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
IsServiceRunning = false
Else
If oService.State = "Running" Then
IsServiceRunning = true
Else
IsServiceRunning = false
End If
End If
Set oService = Nothing
On Error GoTo 0
End Function
End Class
'#Include File:GetSQL2014DBPolicy.vbs
Const EVENT_TYPE_ERROR = 1
Const EVENT_TYPE_INFORMATION = 4
Const SQL_MONITORING_CONNECT_FAILURE = -1
Const SQL_MONITORING_QUERY_FAILURE = -2
Const SQL_MONITORING_SUCCESS = 0
Const SCRIPT_EVENT_ID = 4201
Dim oArgs
Set oArgs = WScript.Arguments
if oArgs.Count <> 5 Then
WScript.Quit -1
End If
Dim ConnectionString, TcpPort, ComputerName, ServiceName
Set oAPI = MOMCreateObject("MOM.ScriptAPI")
Set oBag = oAPI.CreatePropertyBag()
Dim state
state = GetServiceState(ComputerName, ServiceName)
if (state <> "Running") And (state <> "Unknown") Then
Call oAPI.Return(oBag)
WScript.Quit()
End If
If GetDBPolicyHealth(ConnectionString, TcpPort, ComputerName, InstanceName) >= 0 Then
'oAPI.LogScriptEvent "DatabaseUserPolicyMonitoring: " & ConnectionString, SCRIPT_EVENT_ID, EVENT_TYPE_INFORMATION, resultPolicyList
Call oAPI.Return(oBag)
Else
oAPI.LogScriptEvent "DatabaseUserPolicyMonitoring: " & ConnectionString, SCRIPT_EVENT_ID, EVENT_TYPE_ERROR, "An error has occurred while executing a query or establishing a connection to the server."
Call oAPI.Return(oBag)
WScript.Quit()
End If
'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
Function GetDBPolicyHealth(aConnectionString, sTcpPort, serverName, instanceName)
Dim e
Set e = New Error
Dim dbMsdbConnection : Set dbMsdbConnection = new ADODB
Dim res : res = SmartConnect(dbMsdbConnection, aConnectionString, sTcpPort, serverName, instanceName, "msdb")
if res = False Then
GetDBPolicyHealth = SQL_MONITORING_CONNECT_FAILURE
Exit Function
End If
e.Clear
'Select Policy Evaluation History
Dim query : query = " SELECT p.name AS policy_name, h.end_date, hd.target_query_expression_with_id, hd.result " & vbCrLf & _
" FROM syspolicy_policies p " & vbCrLf & _
" JOIN syspolicy_conditions c ON c.condition_id = p.condition_id " & vbCrLf & _
" LEFT OUTER JOIN syspolicy_policy_execution_history h ON h.policy_id = p.policy_id " & vbCrLf & _
" LEFT OUTER JOIN syspolicy_policy_execution_history_details_internal hd ON hd.history_id = h.history_id " & vbCrLf & _
" JOIN ( " & vbCrLf & _
" SELECT p.policy_id, max(h.end_date) AS last_date " & vbCrLf & _
" FROM syspolicy_policies p " & vbCrLf & _
" JOIN syspolicy_policy_execution_history h ON h.policy_id = p.policy_id " & vbCrLf & _
" GROUP BY p.policy_id " & vbCrLf & _
" ) pld ON pld.policy_id = p.policy_id AND pld.last_date = h.end_date " & vbCrLf & _
" WHERE c.facet = 'Database'"
Dim oResults : Set oResults = dbMsdbConnection.ExecuteQuery(query)
e.Save
On Error Goto 0
If e.Number <> 0 Then
GetDBPolicyHealth = SQL_MONITORING_QUERY_FAILURE
Exit Function
End If
Do While Not oResults.EOF
Dim policyName : policyName = oResults("policy_name").Value
Dim targetExpression : targetExpression = oResults("target_query_expression_with_id").Value
Dim evaluationResult : evaluationResult = oResults("result").Value
If Not IsNull(targetExpression) Then
Dim strDBID : strDBID = "/Database[@ID="
Dim startPos : startPos = InStr(targetExpression, strDBID) + Len(strDBID)
Dim endPos : endPos = InStr(startPos, targetExpression, "]")
Dim databaseID : databaseID = Mid(targetExpression, startPos, endPos - startPos)
e.Clear
On Error Resume Next
' query for the list of databases which are not database snapshots
query = " SELECT name FROM sys.databases " & vbCrLf & _
" WHERE database_id = ? "
Dim dbResults : Set dbResults = dbMsdbConnection.ExecuteQueryWithParams(query, databaseID)
e.Save
On Error Goto 0
If e.Number <> 0 Then
DiscoverPolicies = SQL_MONITORING_QUERY_FAILURE
Exit Function
End If
Dim databaseName
If Not dbResults.EOF Then
databaseName = dbResults("name").Value
End If
Call oBag.AddValue(databaseName & "." & policyName, evaluationResult)
Set dbResults = nothing
resultPolicyList = resultPolicyList & databaseName & "." & policyName & " = " & evaluationResult & vbCrLf
End If
oResults.MoveNext
Loop
Set oResults= nothing
dbMsdbConnection.Close
GetDBPolicyHealth = SQL_MONITORING_SUCCESS
End Function </Script></ScriptBody>
<TimeoutSeconds>$Config/TimeoutSeconds$</TimeoutSeconds>
</DataSource>
</MemberModules>
<Composition>
<Node ID="DS"/>
</Composition>
</Composite>
</ModuleImplementation>
<OutputType>System!System.PropertyBagData</OutputType>
</DataSourceModuleType>
Home
FRA 
Show References: