Das periodische Intervall in Sekunden, in dem der Workflow ausgeführt werden soll.
SyncTime
string
$Config/SyncTime$
Synchronisierungszeit
Die in einem 24-Stunden-Format angegebene Synchronisierungszeit. Kann ausgelassen werden.
TimeoutSeconds
int
$Config/TimeoutSeconds$
Timeout (Sekunden)
Gibt die Zeit an, die der Workflow ausgeführt werden darf, bevor er geschlossen und als fehlgeschlagen markiert wird.
ScriptDelayMsec
int
$Config/ScriptDelayMsec$
Skriptverzögerung (Millisekunden)
Über diesen Parameter wird die Verzögerung zwischen aufeinanderfolgenden T-SQL-Abfragen festgelegt, die durch den Workflow ausgeführt werden. Dadurch lässt sich die Ressourcenbeanspruchung durch diesen Workflow bei einer großen Anzahl an Zielobjekten reduzieren. Halten Sie Rücksprache mit dem Microsoft-Support, bevor Sie diesen Parameter ändern.
Dim WShell, FSO, Logger
CreateGlobalObjects()
Main()
''''''''''''''''''''''''''
''' Global Functions
''''''''''''''''''''''''''
Sub CreateGlobalObjects()
Set WShell = CreateObject("wscript.shell")
HandleError("Cannot create object 'wscript.shell' (CreateGlobalObjects).")
Set FSO = CreateObject("Scripting.FileSystemObject")
HandleError("Cannot create object 'Scripting.FileSystemObject'(CreateGlobalObjects).")
Set Logger = new ScriptLogger
HandleError("Cannot create object 'ScriptLogger'(CreateGlobalObjects).")
End Sub
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
Sub ScriptExit()
Wscript.Quit 0
End Sub
Public Function GetSQLServiceName(sInstance)
If sInstance = SQL_DEFAULT Then
GetSQLServiceName = SQL_DEFAULT
Else
GetSQLServiceName = "MSSQL$" & sInstance
End If
End Function
Function EscapeWQLString (ByVal strValue)
ON ERROR RESUME NEXT
Err.Clear
EscapeWQLString = Replace(strValue, "'", "\'")
End Function
Sub ReturnEmptyPropertyBag(opsMgrAPI)
Dim propertyBag
Set propertyBag = opsMgrAPI.scriptAPI.CreateTypedPropertyBag(2)
opsMgrAPI.scriptAPI.AddItem(propertyBag)
opsMgrAPI.scriptAPI.ReturnItems()
End Sub
'#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
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
''''''''''''''''''''''''''''''''''''
''' ScriptLogger
''''''''''''''''''''''''''''''''''''
Class ScriptLogger
Dim sourceLogEvent
Private Sub Class_Initialize()
sourceLogEvent = "Management Group: " + ManagementGroupName + ". Script: " + WScript.ScriptName
End Sub
Private Sub Class_Terminate()
End Sub
Public Property Get ErrorEventType
ErrorEventType = 1
End Property
Public Property Get WarningEventType
WarningEventType = 2
End Property
Public Property Get InfoEventType
InfoEventType = 4
End Property
Private Function LogEvent (message, eventType)
On Error Resume Next
Dim oAPI
Set oAPI = CreateObject("MOM.ScriptAPI")
Call oAPI.LogScriptEvent(sourceLogEvent, SCRIPT_EVENT_ID, eventType, message)
End Function
Public Function LogDebug(message)
if DEBUG_MODE Then
WScript.StdOut.WriteLine message
LogEvent message, Me.InfoEventType
End If
End Function
Public Function LogError(message)
if DEBUG_MODE Then
WScript.StdOut.WriteLine message
End If
LogEvent message, Me.ErrorEventType
End Function
Public Function LogWarning(message)
if DEBUG_MODE Then
WScript.StdOut.WriteLine message
End If
LogEvent message, Me.WarningEventType
End Function
Public Function LogFormattedError(customMessage)
Dim msg
If Not (Err.number = 0) Then
msg = Replace(" Error Number: #P1# " & VbCrLf & " Description: #P2# ", "#P1#", CStr(Err.number) )
msg = Replace(msg, "#P2#", Err.Description )
msg = customMessage & VbCrLf & msg & VbCrLf
'msg = msg & " [" & Me.ScriptInfo() & "]"
Me.LogError(msg)
End If
End Function
Private Function ScriptInfo()
Dim commandLineInfo : commandLineInfo = WScript.ScriptFullName
Dim argument
For Each argument In WScript.Arguments
commandLineInfo = commandLineInfo & " """ & argument & """"
Next
ScriptInfo = commandLineInfo
End Function
End Class
''''''''''''''''''''''''''''''''''''
''' Class OpsMgrAPI
''''''''''''''''''''''''''''''''''''
Class OpsMgrAPI
Dim scriptAPI
Private Sub Class_Initialize()
On Error Resume Next
Set scriptAPI = CreateObject("MOM.ScriptAPI")
HandleError("Cannot create object 'MOM.ScriptAPI' (OpsMgrAPI.Class_Initialize).")
End Sub
End Class
'#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:GetDiskVolumeInformation.vbs
'''''''''''''''''''''''''''''''''''''
''' Assembling Volumes Collection '''
'''''''''''''''''''''''''''''''''''''
Const WMI_LINK = "winmgmts:{impersonationLevel=impersonate}!\\{0}\root\cimv2"
Const MOUNT_POINTS_QUERY = "select Directory, Volume from Win32_Mountpoint"
Const VOLUME_QUERY = "select DeviceID, Name, Caption, Label, FileSystem, Capacity, FreeSpace from Win32_Volume"
Const WMI_ERROR = "Can't get WMI object on "
Const MOUNT_POINT_ERROR = "Can't select Mount Point data from WMI object on "
Const DISK_VOLUME_ERROR = "Can't select Disk Volume data from WMI object on "
Const FIND_BY_DEVICEID_ERROR = "Couldn't find volume by DeviceID "
'Main class which is supposed to be used in external scripts
Class DiskVolumeInformation
Public MountPoints
Public Volumes
Public Default Function Initialize(serverName)
Set MountPoints = SortMountPoints(GetMountPoints(serverName))
Set Volumes = GetVolumes(serverName, MountPoints)
Set Initialize = Me
End Function
End Class
Class MountPoint
Public Name
Public Caption
Public DeviceID
End Class
Function GetMountPoints(serverName)
On Error Resume Next
Dim MountPoints : Set MountPoints = CreateObject("Scripting.Dictionary")
Dim objWMIService : Set objWMIService = GetObject(Replace(WMI_LINK, "{0}", serverName))
HandleError(WMI_ERROR & serverName)
Dim colItems : Set colItems = objWMIService.ExecQuery(MOUNT_POINTS_QUERY)
HandleError(MOUNT_POINT_ERROR & serverName)
Dim objItem
For Each objItem In colItems
Dim point : set point = new MountPoint
Dim dirStartIndex : dirStartIndex = InStr(objItem.Directory, """") + 1
Dim dirEndIndex : dirEndIndex = InStr(dirStartIndex, objItem.Directory, """")
Dim Directory
Directory = LCase(Replace(Mid(objItem.Directory, dirStartIndex, dirEndIndex - dirStartIndex), "\\", "\"))
point.Caption = Directory
point.Name = point.DeviceID & point.Caption
MountPoints.Add point.Name, point
Next
Set GetMountPoints = MountPoints
End Function
Class DiskVolume
Public FileSystem
Public Capacity
Public FreeSpace
Public Name
Public DeviceID
Public Label
Public Paths()
Private pSize
Public Function AddPath(path)
pSize = pSize + 1
ReDim Preserve Paths(pSize)
Paths(pSize) = path
End Function
Private Sub Class_Initialize
pSize = -1
End Sub
End Class
Function GetVolumes(serverName, aMountPoints)
Dim Volumes : Set Volumes = CreateObject("Scripting.Dictionary")
Dim objWMIService : Set objWMIService = GetObject(Replace(WMI_LINK, "{0}", serverName))
HandleError(WMI_ERROR & serverName)
Dim colItems : Set colItems = objWMIService.ExecQuery(VOLUME_QUERY)
HandleError(DISK_VOLUME_ERROR & serverName)
Dim objItem
For Each objItem In colItems
Dim vol : set vol = new DiskVolume
vol.Capacity = objItem.Capacity
vol.FileSystem = objItem.FileSystem
vol.FreeSpace = objItem.FreeSpace
vol.Name = objItem.Name
vol.AddPath objItem.Caption
vol.DeviceID = objItem.DeviceID
vol.Label = objItem.Label
Volumes.Add vol.DeviceID, vol
Next
Function SearchVolumeCaption(aVolumes, aCaption)
Dim k
For Each k In aVolumes.Keys
Dim p
For p = 0 To UBound(aVolumes.Item(k).Paths)
If aVolumes.Item(k).Paths(p) = aCaption Then
SearchVolumeCaption = True
Exit Function
End If
Next
Next
SearchVolumeCaption = false
End Function
Function SearchVolumeDeviceID(aVolumes, aDeviceID)
Dim k
For Each k In aVolumes.Keys
If aVolumes.Item(k).DeviceID = aDeviceID Then
Set SearchVolumeDeviceID = aVolumes.Item(k)
Exit Function
End If
Next
Set SearchVolumeDeviceID = Nothing
End Function
Function MergeMountPointsIntoVolumeList(Volumes, MountPoints)
Dim key
For Each key in MountPoints.Keys
Dim Caption : Caption = MountPoints.Item(key).Caption
'Adding backslash in the end of the path is necessary for
'matching the path stored in volumes class, also it prevents
'invalid equality among folders with long composite names like
'"C:\Program Files" and "C:\Program"
If Right(Caption, 1) <> "\" Then
Caption = Caption & "\"
End If
'Search for Mount Points which are not listed among Volumes
Dim found : found = SearchVolumeCaption(Volumes, Caption)
If Not found Then
'Search for the equivalent Volume
Dim equalVolume : Set equalVolume = SearchVolumeDeviceID(Volumes, MountPoints.Item(key).DeviceID)
HandleError(FIND_BY_DEVICEID_ERROR & MountPoints.Item(key).DeviceID)
If Not equalVolume Is Nothing And Not IsNull(equalVolume) And Not IsEmpty(equalVolume) Then
equalVolume.AddPath Caption
End If
End If
Next
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''
''' Sorting Mount Points descending by path length '''
''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function SortMountPoints(aMountPoints)
'Convert dictionary to array
Dim MPArray()
Dim i : i = 0
Dim key
For Each key in aMountPoints.Keys
ReDim Preserve MPArray(i)
Set MPArray(i) = aMountPoints.Item(key)
i = i + 1
Next
'Sorting array
Dim SortedArray : SortedArray = SortArray(MPArray)
'Converting back to dictionary
Set SortMountPoints = CreateObject("Scripting.Dictionary")
Dim a
For Each a in SortedArray
SortMountPoints.Add a.Caption, a
Next
End Function
Function SortArray(arr)
If UBound(arr) < 1 Then
SortArray = arr
Exit Function
End If
Dim pivotIndex : pivotIndex = UBound(arr) 'Select last element as pivot
Dim pivot : Set pivot = arr(pivotIndex)
ReDim Preserve arr(UBound(arr) - 1) 'Remove pivot element
Dim longerList()
Dim shorterList()
Dim longerListSize : longerListSize = 0
Dim shorterListSize : shorterListSize = 0
'Put the elements with longer path than pivot to longerList
'and the elements with shorter path to shorterList
Dim a
For Each a in arr
If Len(a.Caption) > Len(pivot.Caption) Then
ReDim Preserve longerList(longerListSize)
Set longerList(longerListSize) = a
longerListSize = longerListSize + 1
Else
ReDim Preserve shorterList(shorterListSize)
Set shorterList(shorterListSize) = a
shorterListSize = shorterListSize + 1
End If
Next
Dim sortedLess, sortedGreater
If longerListSize > 0 Then
sortedLess = SortArray(longerList)
Else
sortedLess = longerList
End If
If shorterListSize > 0 Then
sortedGreater = SortArray(shorterList)
Else
sortedGreater = shorterList
End If
SortArray = MergeArrays(sortedLess, longerListSize, pivot, sortedGreater, shorterListSize)
End Function
Function MergeArrays(lessArray, longerListSize, pivotNode, greaterArray, shorterListSize)
Dim arraySize : arraySize = longerListSize + shorterListSize
Dim ResultArray()
ReDim ResultArray(arraySize)
Dim i
For i = 0 To UBound(ResultArray)
If i < longerListSize Then
Set ResultArray(i) = lessArray(i)
ElseIf i > longerListSize Then
Set ResultArray(i) = greaterArray(i - longerListSize - 1)
Else
Set ResultArray(i) = pivotNode
End If
Next
MergeArrays = ResultArray
End Function
'#Include File:SQLFxContainerFreeSpaceCalculator.vbs
''''''''''''''''''''''''''''''''''''
''' Class DBFxContainerSpaceCalculator
''''''''''''''''''''''''''''''''''''
'if RAM <= 16 GB 16MB/1Mb (data/delta)
Const containerDataFileSize16MB = 16
Const containerDeltaFileSize1MB = 1
'if RAM > 16 GB 128MB/8Mb (data/delta)
Const containerDataFileSize128MB = 128
Const containerDeltaFileSize8MB = 8
'max pairs
Const containerMaxPair = 8192
Class DBFxContainerSpaceCalculator
'driver free space MB
Public FreeSpaceMB
'Free space percent
Public FreeSpacePercent
'data/delta
Public DataFilePairSizeMB
Public DriveTotalSize
Public DriveFreeSpace
'
Public MountPoint
'
Private DiskVolumesInfo
Private Sub Class_Initialize()
FreeSpaceMB = 0
FreeSpacePercent = 0
End Sub
Public Default Function Init(diskVolumesInformation)
Set DiskVolumesInfo = diskVolumesInformation
Set Init = Me
End Function
Private Function GetVolumeByPath(filePath)
Dim mpKey
For Each mpKey In DiskVolumesInfo.MountPoints.Keys
If InStr(LCase(filePath), LCase(DiskVolumesInfo.MountPoints.Item(mpKey).Caption)) > 0 Then
Set GetVolumeByPath = DiskVolumesInfo.Volumes.Item(DiskVolumesInfo.MountPoints.Item(mpKey).DeviceID)
Exit Function
End If
Next
End Function
Private Function FillInLocalProperties(filePath)
On Error Resume Next
Dim vol : Set vol = GetVolumeByPath(filePath)
If Not IsNull(vol) And Not vol is Nothing And Not IsEmpty(vol) Then
Me.MountPoint = vol.Name
Me.DriveTotalSize = vol.Capacity /1024 /1024
Me.DriveFreeSpace = vol.FreeSpace /1024 /1024
Exit Function
End If
Dim diskName : diskName = Left(filePath, 1)
Dim disk : Set disk = FSO.GetDrive(diskName)
HandleError("Cannot get object of disk '" & diskName & "'")
Me.MountPoint = diskName
HandleError("Cannot get mount point of disk '" & diskName & "'")
Me.DriveTotalSize = disk.TotalSize /1024 /1024
HandleError("Cannot get TotalSize of disk '" & diskName & "'")
Me.DriveFreeSpace = disk.FreeSpace /1024 /1024
HandleError("Cannot get FreeSpace of disk '" & diskName & "'")
End Function
Private Function GetTotalPhysicalMemory(computerName)
Set objWMI = GetObject("winmgmts:\\" & computerName & "\root\cimv2")
Set oQuery = objWMI.ExecQuery ("Select * from Win32_ComputerSystem")
If oQuery.Count > 0 Then
Dim computer
Set computer = GetFirstItemFromWMIQuery(oQuery)
Dim TotalPhysicalMemory
TotalPhysicalMemory = computer.TotalPhysicalMemory /1024/1024/1024
If TotalPhysicalMemory > 16 Then
Me.DataFilePairSizeMB = containerDataFileSize128MB + containerDeltaFileSize8MB
End If
End If
End Function
Public Function CalculateFreeSpace(path, number, allocated, serverName)
'get driver size
Dim containerPath : containerPath = path
Dim NumberOfFiles : NumberOfFiles = number
Dim AllocatedSpace : AllocatedSpace = allocated
if (NumberOfFiles + (Me.DriveFreeSpace \ Me.DataFilePairSizeMB)) >= containerMaxPair Then
DriveFreeSpaceHK = (containerMaxPair-NumberOfFiles)*Me.DataFilePairSizeMB
Else
DriveFreeSpaceHK = (Me.DriveFreeSpace \ Me.DataFilePairSizeMB)*Me.DataFilePairSizeMB
End If
Me.FreeSpaceMB = DriveFreeSpaceHK
Me.FreeSpacePercent = ((DriveFreeSpaceHK)*100)/(DriveFreeSpaceHK + AllocatedSpace)
End Function
End Class'#Include File:GetSQLDBFxContainerFreeSpace.vbs
Public Function GetSQLServiceName(sInstance)
If sInstance = "MSSQLSERVER" Then
GetSQLServiceName = "MSSQLSERVER"
Else
GetSQLServiceName = "MSSQL$" & sInstance
End If
End Function
'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
''' Returns -1: If DB is not in AlwaysOn
''' Returns 0: If DB is in AlwaysOn and replica allow connections is NO
''' Returns 1: If DB is in AlwaysOn and replica allow connections is YES
Function AlwaysOnReplicaAllowConnections(aDbConnection, aDatabaseID)
AlwaysOnReplicaAllowConnections = -1
Dim query : query = " SELECT columns.id, " & _
" CASE WHEN OBJECT_ID('sys.availability_replicas') IS NOT NULL THEN 1 ELSE 0 END AS HasAlwaysOn " & _
" FROM sys.syscolumns columns where name = 'replica_id' and id = OBJECT_ID('sys.databases')"
Dim result : Set result = aDbConnection.ExecuteQuery(query)
If Not result.EOF Then
If result("HasAlwaysOn").Value = 1 Then
query = " SELECT d.name, d.database_id, " & _
" CASE WHEN d.replica_id IS NULL THEN 0 ELSE 1 END AS is_replica, " & _
" ar.secondary_role_allow_connections " & _
" FROM sys.databases d " & _
" JOIN sys.availability_replicas ar on d.replica_id = ar.replica_id " & _
" JOIN sys.servers s ON s.name = ar.replica_server_name AND s.server_id = 0 /*local server*/" & _
" WHERE d.database_id = ? "
Set result = aDbConnection.ExecuteQueryWithParams(query, aDatabaseID)
If Not result.EOF Then
If result("is_replica").Value = 1 Then
If (result("secondary_role_allow_connections").Value <= 1) Then
AlwaysOnReplicaAllowConnections = 0
Else
AlwaysOnReplicaAllowConnections = 1
End If
End If
End If
End If
End If
End Function
Function GetAllDbFilesFreeSpace(connectionStr, serverName, instanceName, sTcpPort, Delay)
On Error Resume Next
Dim opsMgrAPI
Dim tcp : tcp = sTcpPort
Dim dbMasterConnection
Dim listDatabases
Dim query : query = "SELECT name, database_id FROM sys.databases " & _
" WHERE (state = ? OR state = ?) " & _
" AND source_database_id IS NULL AND is_read_only = 0" & _
" AND name not in ('master', 'model', 'msdb', 'tempdb')"
Set opsMgrAPI = new OpsMgrAPI
Set dbMasterConnection = new ADODB
Dim serviceName , state
serviceName = GetSQLServiceName(instanceName)
state = GetServiceState(serverName, serviceName)
if (state <> "Running") And (state <> "Unknown") Then
Call ReturnEmptyPropertyBag(opsMgrAPI)
Exit Function
End If
Dim res : res = SmartConnect(dbMasterConnection, connectionStr, tcp, serverName, instanceName, "master")
if res = False Then
Call ReturnEmptyPropertyBag(opsMgrAPI)
Exit Function
End If
Set listDatabases = dbMasterConnection.ExecuteQueryWithParams(query, Array(DB_STATE_NORMAL, DB_STATE_STANDBY))
if dbMasterConnection.HandleExecutionQueryErrorContinue(query, serverName, instanceName) Then
Dim diskVolumesInfo : Set diskVolumesInfo = (new DiskVolumeInformation)(serverName)
Do While Not listDatabases.EOF
Dim databaseName : databaseName = listDatabases("name").Value
Dim databaseID : databaseID = listDatabases("database_id").Value
Dim replicaAllowConnections : replicaAllowConnections = AlwaysOnReplicaAllowConnections(dbMasterConnection, databaseID)
If replicaAllowConnections <> 0 Then
Dim dbConnection : Set dbConnection = new ADODB
If SmartConnect(dbConnection, connectionStr, tcp, serverName, instanceName, databaseName) Then
query = "SET NOCOUNT ON " & vbCrLf & _
"SELECT " & vbCrLf & _
" mf.name as 'ContainerName', " & vbCrLf & _
" mf.file_id as 'ContainerId', " & vbCrLf & _
" mf.physical_name as 'ContainerPath' " & vbCrLf & _
" FROM sys.master_files as mf WITH (NOLOCK) " & vbCrLf & _
" WHERE mf.database_id = ? AND mf.type IN (2) AND mf.is_read_only = 0 " & vbCrLf & _
" Group By mf.name, mf.file_id, mf.physical_name "
Dim listFiles : Set listFiles = dbConnection.ExecuteQueryWithParams(query, databaseID)
if dbConnection.HandleExecutionQueryErrorContinue(query, serverName, instanceName) Then
Do While Not listFiles.EOF
Dim ContainerName : ContainerName = listFiles("ContainerName").Value
Dim ContainerId : ContainerId = listFiles("ContainerId").Value
Dim ContainerPath : ContainerPath = listFiles("ContainerPath").Value
Dim AllocatedSizeMB : AllocatedSizeMB = 0
Dim UsedSizeMB : UsedSizeMB = 0
Dim NumberOfFiles : NumberOfFiles = 0
query = "SET NOCOUNT ON " & vbCrLf & _
" select " & vbCrLf & _
" convert (float,SUM(chf.file_size_in_bytes))/convert (float,(1024*1024)) as AllocatedSizeMB, " & vbCrLf & _
" convert (float,SUM(chf.file_size_used_in_bytes))/convert (float,(1024*1024)) as UsedSizeMB, " & vbCrLf & _
" Sum(CASE WHEN chf.state = 2 THEN 1 Else 0 End) as NumberOfFiles " & vbCrLf & _
" from sys.dm_db_xtp_checkpoint_files as chf" & vbCrLf & _
" WHERE chf.container_id = ? "
Dim listSpace : Set listSpace = dbConnection.ExecuteQueryWithParams(query, ContainerId)
if dbConnection.HandleExecutionQueryErrorContinue(query, serverName, instanceName) Then
if Not listSpace.EOF Then
AllocatedSizeMB = CDbl(listSpace("AllocatedSizeMB").Value)
UsedSizeMB = CDbl(listSpace("UsedSizeMB").Value)
NumberOfFiles = CDbl(listSpace("NumberOfFiles").Value)
End if
Dim spaceCalculator : Set spaceCalculator = (new DBFxContainerSpaceCalculator)(diskVolumesInfo)
Call spaceCalculator.CalculateFreeSpace(ContainerPath, NumberOfFiles, AllocatedSizeMB, serverName)
Logger.LogDebug( "Database = " & databaseName & vbCrLf & _
" AllocatedSizeMB = " & AllocatedSizeMB & vbCrLf & _
" UsedSizeMB = " & UsedSizeMB & vbCrLf & _
" NumberOfFiles = " & NumberOfFiles & vbCrLf & _
" ContainerName = " & ContainerName & vbCrLf & _
" ContainerId = " & ContainerId & vbCrLf & _
" ContainerPath = " & ContainerPath & vbCrLf & _
" DriveTotalSizeMB = " & spaceCalculator.DriveTotalSize & vbCrLf & _
" FreeSpaceSpaceMB = " & spaceCalculator.FreeSpaceMB & vbCrLf & _
" FreeSpacePercent = " & spaceCalculator.FreeSpacePercent )
Dim propertyBag
Set propertyBag = opsMgrAPI.scriptAPI.CreateTypedPropertyBag(2)
WScript.Sleep(Delay)
listFiles.MoveNext
Loop
End If
dbConnection.Close()
End If
End If
listDatabases.MoveNext
Loop
End If
dbMasterConnection.Close()
Dim items
Set items = opsMgrAPI.scriptAPI.ReturnItems()
if Not IsEmpty(items) Then
items
Else
Call ReturnEmptyPropertyBag(opsMgrAPI)
End If
End Function </Script></ScriptBody>
<TimeoutSeconds>$Config/TimeoutSeconds$</TimeoutSeconds>
</DataSource>
<ConditionDetection ID="DatabaseAndContainerFilter" TypeID="System!System.ExpressionFilter">
<Expression>
<And>
<Expression>
<SimpleExpression>
<ValueExpression>
<XPathQuery Type="String">Property[@Name='Database']</XPathQuery>
</ValueExpression>
<Operator>Equal</Operator>
<ValueExpression>
<Value Type="String">$Config/DatabaseName$</Value>
</ValueExpression>
</SimpleExpression>
</Expression>
<Expression>
<SimpleExpression>
<ValueExpression>
<XPathQuery Type="Double">Property[@Name='ContainerId']</XPathQuery>
</ValueExpression>
<Operator>Equal</Operator>
<ValueExpression>
<Value Type="Double">$Config/DBFileId$</Value>
</ValueExpression>
</SimpleExpression>
</Expression>
</And>
</Expression>
</ConditionDetection>
</MemberModules>
<Composition>
<Node ID="DatabaseAndContainerFilter">
<Node ID="DS"/>
</Node>
</Composition>
</Composite>
</ModuleImplementation>
<OutputType>System!System.PropertyBagData</OutputType>
</DataSourceModuleType>