SQL Server 2016 メモリ最適化データベース ファイルグループ コンテナーの空き領域データ ソース

Microsoft.SQLServer.2016.DataSource.Container.FreeSpace (DataSourceModuleType)

データ ソースは SQL Server 2016 メモリ最適化データ データベース ファイルグループ コンテナーごとに空き領域を返します

Element properties:

TypeDataSourceModuleType
IsolationAny
AccessibilityInternal
RunAsMicrosoft.SQLServer.MonitoringAccount
OutputTypeSystem.PropertyBagData

Member Modules:

ID Module Type TypeId RunAs 
DS DataSource Microsoft.Windows.TimedScript.PropertyBagProvider Default
DatabaseAndContainerFilter ConditionDetection System.ExpressionFilter Default

Overrideable Parameters:

IDParameterTypeSelectorDisplay NameDescription
IntervalSecondsint$Config/IntervalSeconds$間隔 (秒)ワークフローを実行する定期的な実行間隔 (秒)。
SyncTimestring$Config/SyncTime$同期時刻24 時間形式で指定した同期時刻。省略可能です。
TimeoutSecondsint$Config/TimeoutSeconds$タイムアウト (秒)ワークフローが終了して失敗とマークされるまでの、ワークフローの許容実行時間を指定します。
ScriptDelayMsecint$Config/ScriptDelayMsec$スクリプト遅延 (ミリ秒)このパラメーターは、ワークフローによって実行される、連続する T-SQL クエリ間の遅延を設定します。これは、大量のターゲット オブジェクトが存在する際に、ワークフローによって生成されるフットプリントを削減するのに役立つ場合があります。このパラメーターを変更する前に Microsoft サポートに連絡してください。

Source Code:

<DataSourceModuleType ID="Microsoft.SQLServer.2016.DataSource.Container.FreeSpace" Accessibility="Internal" RunAs="GPMP!Microsoft.SQLServer.MonitoringAccount">
<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="ConnectionString" type="xsd:string"/>
<xsd:element xmlns:xsd="http://www.w3.org/2001/XMLSchema" name="ServerName" type="xsd:string"/>
<xsd:element xmlns:xsd="http://www.w3.org/2001/XMLSchema" name="SqlInstanceName" type="xsd:string"/>
<xsd:element xmlns:xsd="http://www.w3.org/2001/XMLSchema" name="DatabaseName" type="xsd:string"/>
<xsd:element xmlns:xsd="http://www.w3.org/2001/XMLSchema" name="DBFileId" 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="ScriptDelayMsec" type="xsd:int"/>
</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="ScriptDelayMsec" ParameterType="int" Selector="$Config/ScriptDelayMsec$"/>
</OverrideableParameters>
<ModuleImplementation>
<Composite>
<MemberModules>
<DataSource ID="DS" TypeID="Windows!Microsoft.Windows.TimedScript.PropertyBagProvider">
<IntervalSeconds>$Config/IntervalSeconds$</IntervalSeconds>
<SyncTime>$Config/SyncTime$</SyncTime>
<ScriptName>GetSQLDBFxContainerFreeSpace.vbs</ScriptName>
<Arguments>"$Config/ConnectionString$" "$Config/ServerName$" "$Config/SqlInstanceName$" "$Target/Host/Host/Host/Property[Type="SQL2016Core!Microsoft.SQLServer.2016.DBEngine"]/TcpPort$" "$Config/ScriptDelayMsec$"</Arguments>
<ScriptBody><Script>'#Include File:Common.vbs

Option Explicit
On Error Resume Next

Dim GlobalErrorList: Set GlobalErrorList = New ArrayList

SetLocale("en-us")
HandleErrorContinue("Cannot set en-us locale")

Const DEBUG_MODE = false
Const ManagementGroupName = "$Target/ManagementGroup/Name$"
Const ManagementGroupID = "$Target/ManagementGroup/Id$"
Const SQL_DEFAULT = "MSSQLSERVER"

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 ScriptExit()
Wscript.Quit 0
End Sub

Public Function GetSQLServiceName(sInstance)
If sInstance = SQL_DEFAULT Then
GetSQLServiceName = SQL_DEFAULT
Else
GetSQLServiceName = "MSSQL$" &amp; sInstance
End If
End Function

Function EscapeWQLString (ByVal strValue)
ON ERROR RESUME NEXT
Err.Clear

EscapeWQLString = Replace(Replace(strValue, "\", "\\"), "'", "\'")
End Function

Sub ReturnEmptyPropertyBag(opsMgrAPI)
Dim propertyBag
Set propertyBag = opsMgrAPI.scriptAPI.CreateTypedPropertyBag(2)
opsMgrAPI.scriptAPI.AddItem(propertyBag)
opsMgrAPI.scriptAPI.ReturnItems()
End Sub

'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://" &amp; sTargetComputer &amp; "/root/cimv2"
sQuery = "SELECT State FROM Win32_Service where Name = """ &amp; EscapeWQLString(sServiceName) &amp; """"

Set oWMI = GetObject(sNamespace)
Set objClasses = oWMI.ExecQuery(sQuery)

if objClasses.Count &gt;= 1 Then
sState = GetFirstItemFromWMIQuery(objClasses).Properties_.Item("State")
End If

If Err.number &lt;&gt; 0 Or objClasses.Count = 0 Then
sState = "Unknown"
End If

Err.Clear
GetServiceState = sState
End Function

'#Include File:SQL2016Constants.vbs

Const SQL_WMI_NAMESPACE = "ComputerManagement13"

Const MANAGEMENT_PACK_VERSION = "7.0.7.0"

'#Include File:Error.vbs

Const EVENT_TYPE_ERROR = 1

Class Error
Private m_lNumber
Private m_sSource
Private m_sDescription
Private m_sHelpContext
Private m_sHelpFile

Public Sub Save()
m_lNumber = Err.Number
m_sSource = Err.Source
m_sDescription = Err.Description
m_sHelpContext = Err.HelpContext
m_sHelpFile = Err.HelpFile
End Sub

Public Sub Raise()
Err.Raise m_lNumber, m_sSource, m_sDescription, m_sHelpFile, m_sHelpContext
End Sub

Public Sub Clear()
m_lNumber = 0
m_sSource = ""
m_sDescription = ""
m_sHelpContext = ""
m_sHelpFile = ""
End Sub

Public Default Property Get Number()
Number = m_lNumber
End Property
Public Property Get Source()
Source = m_sSource
End Property
Public Property Get Description()
Description = m_sDescription
End Property
Public Property Get HelpContext()
HelpContext = m_sHelpContext
End Property
Public Property Get HelpFile()
HelpFile = m_sHelpFile
End Property
End Class

Class ArrayList
Private m_itemArray

Private Sub Class_Initialize()
Me.Clear
End Sub

Private Sub AddItemToArray(ByRef itemArray, ByVal item)
ReDim Preserve itemArray(UBound(itemArray) + 1)
itemArray(UBound(itemArray)) = item
End Sub

Public Sub Clear()
m_itemArray = Array()
End Sub

Public Sub Add(item)
AddItemToArray m_itemArray, item
End Sub

Public Sub RemoveAt(index)
If index &lt; 0 Or index &gt; UBound(m_itemArray) Then
Exit Sub
End If
Dim newArr: newArr = Array()
Dim i
For i = 0 To UBound(m_itemArray)
If i &lt;&gt; index Then
Call AddItemToArray(newArr, m_itemArray(i))
End If
Next
m_itemArray = newArr
End Sub

Public Property Get Count()
Count = UBound(m_itemArray) + 1
End Property

Public Property Get ItemsArray()
ItemsArray = m_itemArray
End Property

Public Property Get IsEmpty()
IsEmpty = UBound(m_itemArray) &lt; 0
End Property
End Class

''''''''''''''''''''''''''''''''''''
''' ScriptLogger
''''''''''''''''''''''''''''''''''''
Class ScriptLogger
Dim sourceLogEvent

Private Sub Class_Initialize()
sourceLogEvent = "Management Group: " + ManagementGroupName + ". Script: " + WScript.ScriptName + ". Version: " + MANAGEMENT_PACK_VERSION
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)
If Err.number &lt;&gt; 0 Then
Me.LogError FormatErrorMessage(customMessage, "")
End If
End Function

Private Function ScriptInfo()
Dim commandLineInfo : commandLineInfo = WScript.ScriptFullName
Dim argument
For Each argument In WScript.Arguments
commandLineInfo = commandLineInfo &amp; " """ &amp; argument &amp; """"
Next
ScriptInfo = commandLineInfo
End Function
End Class

Function FormatErrorMessage(customMessage, instanceName)
FormatErrorMessage = customMessage
If Err.number &lt;&gt; 0 Then
Dim msg
msg =_
" Error Number: " &amp; CStr(Err.number) &amp; VbCrLf &amp; _
" Description: " &amp; Err.Description

If Not IsEmpty(instanceName) And instanceName &lt;&gt; "" Then
msg = msg &amp; VbCrLf &amp; " Instance: " &amp; instanceName
End If
If customMessage &lt;&gt; "" Then
msg = customMessage &amp; VbCrLf &amp; msg &amp; VbCrLf
End If
FormatErrorMessage = msg
End If
End Function

Function FormatDbErrorMessage(message, instanceName, dbName)
FormatDbErrorMessage = message &amp; VbCrLf &amp; _
" Instance: " &amp; instanceName &amp; VbCrLf &amp; _
" Database: " &amp; dbName
End Function

Function ThrowScriptErrorNoAbort(ByVal sMessage, ByVal oErr)
On Error Resume Next
Dim errorText: errorText = sMessage &amp; ": " &amp; oErr.Description
GlobalErrorList.Add errorText
End Function

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

Sub HandleError(customMessage)
Dim localLogger
If Err.number &lt;&gt; 0 Then
Set localLogger = new ScriptLogger
Call localLogger.LogFormattedError(customMessage)
Call Wscript.Quit(0)
End If
End Sub

Function HandleErrorContinue(customMessage)
HandleErrorContinue = True
If Err.number &lt;&gt; 0 Then
HandleErrorContinue = False
Call GlobalErrorList.Add(FormatErrorMessage(customMessage, ""))
Call Err.Clear()
End If
End Function

Function HandleErrorContinueEx(customMessage, instanceName)
HandleErrorContinueEx = True
If Err.number &lt;&gt; 0 Then
HandleErrorContinueEx = False
Call GlobalErrorList.Add(FormatErrorMessage(customMessage, instanceName))
Call Err.Clear()
End If
End Function

Function HandleSqlErrorContinue(adoConnection, customMessage, instanceName)
HandleSqlErrorContinue = True
If Err.Number &lt;&gt; 0 Then
HandleSqlErrorContinue = False
Dim sqlErr
Dim e: Set e = new Error
e.Save
On Error Resume Next
If adoConnection.Errors.Count &gt; 0 Then
Set sqlErr = adoConnection.Errors(0)
adoConnection.Errors.Clear
Call Err.Raise(sqlErr.Number, sqlErr.Source, sqlErr.Description)
Else
Call e.Raise()
End If
Call HandleErrorContinueEx(customMessage, instanceName)
End If
End Function

Function GetGlobalErrorListEventString()
GetGlobalErrorListEventString = ""
If Not GlobalErrorList.IsEmpty Then
GetGlobalErrorListEventString = "The next errors occurred:"&amp; vbNewLine &amp; Join(GlobalErrorList.ItemsArray, vbNewLine &amp; vbNewLine)
End If
End Function

Function GlobalErrorListToEventLog()
On Error Resume Next
If Not GlobalErrorList.IsEmpty Then
Dim localLogger: Set localLogger = New ScriptLogger
localLogger.LogWarning GetGlobalErrorListEventString()
End If
End Function

Function Quit()
WScript.Quit()
End Function

'#Include File:WMI.vbs

Function EscapeWQLString (ByVal strValue)
On Error Resume Next
Err.Clear
EscapeWQLString = Replace(Replace(strValue, "\", "\\"), "'", "\'")
End Function

Function ConnectToWMI(ComputerName, strNamespace)
Set ConnectToWMI = Nothing
Set ConnectToWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" &amp; ComputerName &amp; "\" &amp; strNamespace)
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 &lt;&gt; 0 Then
If (ErrAction And ErrAction_ThrowError) = ErrAction_ThrowError Then _
ThrowScriptErrorNoAbort "An error occurred while accessing WMI property: '" &amp; sPropName &amp; "'.", 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) &amp; "/" &amp; _
Mid(sValue, 7, 2) &amp; "/" &amp; _
Left(sValue, 4) &amp; " " &amp; _
Mid (sValue, 9, 2) &amp; ":" &amp; _
Mid(sValue, 11, 2) &amp; ":" &amp; _
Mid(sValue, 13, 2)
If IsDate(sTmpStrDate) Then
WMIGetProperty = CDate(sTmpStrDate)
Else

'
' Second, attempt just to convert the YYYYMMDD
'
sTmpStrDate = Mid(sValue, 5, 2) &amp; "/" &amp; _
Mid(sValue, 7, 2) &amp; "/" &amp; _
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: '" &amp; sPropName &amp; "'.", Err

If (ErrAction And ErrAction_Abort) = ErrAction_Abort Then _
Quit()

WMIGetProperty = ""

End If


If (ErrAction And ErrAction_Trace) = ErrAction_Trace Then _
WScript.Echo " + " &amp; sPropName &amp; " :: '" &amp; WMIGetProperty &amp; "'"

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 '" &amp; sNamespace &amp; "'. 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 &lt;&gt; 0 Then
ThrowScriptError "The Query '" &amp; sQuery &amp; "' 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 &lt;&gt; 0 Then
ThrowScriptError "The Query '" &amp; sQuery &amp; "' 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 = Nothing
Set oResult = oQuery.ItemIndex(0)
if Err.number &lt;&gt; 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:Registry.vbs

Class Registry
Public HKEY_CLASSES_ROOT
Public HKEY_CURRENT_USER
Public HKEY_LOCAL_MACHINE
Public HKEY_USERS
Public HKEY_CURRENT_CONFIG
Public HKEY_DYN_DATA

Public ERROR_ACCESS_DENIED
Public ERROR_KEY_NOT_FOUND
Public ERROR_VALUE_NOT_FOUND
Public SUCCESS

Private m_oReg
Private m_lHive

Private Sub Class_Initialize()
HKEY_CLASSES_ROOT = &amp;H80000000
HKEY_CURRENT_USER = &amp;H80000001
HKEY_LOCAL_MACHINE = &amp;H80000002
HKEY_USERS = &amp;H80000003
HKEY_CURRENT_CONFIG = &amp;H80000005
HKEY_DYN_DATA = &amp;H80000006

ERROR_ACCESS_DENIED = 5
ERROR_KEY_NOT_FOUND = 2
ERROR_VALUE_NOT_FOUND = 1
SUCCESS = 0

m_lHive = HKEY_LOCAL_MACHINE
End Sub

Public Sub Connect(ByVal sHostName)
Set m_oReg = GetObject("winmgmts://" &amp; sHostName &amp; "/root/default:StdRegProv")
End Sub

Public Property Get Hive()
Hive = m_lHive
End Property

Public Property Let Hive(ByVal lHive)
m_lHive = lHive
End Property

Public Function ReadDWORDValue(ByVal sKeyPath, ByVal sValueName, ByRef lResult)
Dim lValue
lResult = m_oReg.GetDWORDValue(m_lHive, sKeyPath, sValueName, lValue)
ReadDWORDValue = lValue
End Function

Public Function ReadStringValue(ByVal sKeyPath, ByVal sValueName, ByRef lResult)
Dim sValue
lResult = m_oReg.GetStringValue(m_lHive, sKeyPath, sValueName, sValue)
ReadStringValue = sValue
End Function

Public Function ReadMultiStringValue(ByVal sKeyPath, ByVal sValueName, ByRef lResult)
Dim aValues
lResult = m_oReg.GetMultiStringValue(m_lHive, sKeyPath, sValueName, aValues)
ReadMultiStringValue = aValues
End Function

Public Function EnumKeys(ByVal sKeyPath, ByRef lResult)
Dim aSubKeys
lResult = m_oReg.EnumKey(m_lHive, sKeyPath, aSubKeys)
EnumKeys = aSubKeys
End Function

Public Function EnumValues(ByVal sKeyPath, ByRef lResult)
Dim aNames, aTypes
lResult = m_oReg.EnumValues(m_lHive, sKeyPath, aNames, aTypes)
EnumValues = aNames
End Function

Public Function CreateKey(ByVal sKeyPath)
CreateKey = m_oReg.CreateKey(m_lHive, sKeyPath)
End Function

Public Function WriteStringValue(ByVal sKeyPath, ByVal sValueName, ByVal sValue)
WriteStringValue = m_oReg.SetStringValue(m_lHive, sKeyPath, sValueName, sValue)
End Function

Public Function DeleteValue(ByVal sKeyPath, ByVal sValueName)
DeleteValue = m_oReg.DeleteValue(m_lHive, sKeyPath, sValueName)
End Function

Public Function ReadBinaryValue(ByVal sKeyPath, ByVal sValueName, ByRef lResult)
Dim aData
lResult = m_oReg.GetBinaryValue(m_lHive, sKeyPath, sValueName, aData)
ReadBinaryValue = aData
End Function

End Class

'#Include File:ConnectionString.vbs

Function ArraysAreIntersected(ByRef arrA, ByRef arrB)
Dim itemA, itemB
ArraysAreIntersected = False
For Each itemA in arrA
For Each itemB in arrB
If itemA = itemB Then
ArraysAreIntersected = True
Exit Function
End If
Next
Next
End Function

Function ArrayContains(ByRef arr, ByRef searchItem)
ArrayContains = False
Dim item
For Each item In arr
If item = searchItem Then
ArrayContains = True
Exit Function
End If
Next
End Function

Const MAX_DRIVER_VERSION_STR = "99999999.99999999.99999999.99999999"

Function GetDriverVersionObj(oVersion)
Dim tpName, vVersion
tpName = TypeName(oVersion)
Select Case tpName
Case "DriverVersion"
Set vVersion = oVersion
Case "String"
Set vVersion = (new DriverVersion)(oVersion)
Case Else
Call Err.Raise(7100, "DriverVersion", "Parameter is not an instance of type DriverVersion.")
End Select
Set GetDriverVersionObj = vVersion
End Function

Class DriverVersion
Private m_major
Private m_minor
Private m_build
Private m_revision

Public Default Function Init(versionStr)
Parse(versionStr)
Set Init = Me
End Function

Private Sub Parse(vStr)
Dim parts, versionRegex, oRegex, matches
Set oRegex = New RegExp
oRegex.Pattern = "^(\d{1,8})(.\d{1,8}){0,3}$"
Set matches = oRegex.Execute(vStr)
If matches.Count = 0 Then
Call Err.Raise(7100, "DriverVersion", "Invalid version string.")
End If
parts = Split(vStr, ".")
m_major = CLng(parts(0))
m_minor = 0
m_build = 0
m_revision = 0
IF UBound(parts) &gt;= 1 Then
m_minor = CLng(parts(1))
If UBound(parts) &gt;= 2 Then
m_build = CLng(parts(2))
If UBound(parts) &gt;= 3 Then
m_revision = CLng(parts(3))
End If
End If
End If
End Sub

Public Function CompareTo(v)
Dim d
d = m_major - v.Major
If d &lt;&gt; 0 Then
CompareTo = d
Exit Function
End If
d = m_minor - v.Minor
If d &lt;&gt; 0 Then
CompareTo = d
Exit Function
End If
d = m_build - v.Build
If d &lt;&gt; 0 Then
CompareTo = d
Exit Function
End If
d = m_revision - v.Revision
CompareTo = d
End Function

Public Function ToString()
ToString = "" &amp; m_major &amp; "." &amp; m_minor &amp; "." &amp; m_build &amp; "." &amp; m_revision
End Function

Public Property Get Major()
Major = m_major
End Property

Public Property Get Minor()
Minor = m_minor
End Property

Public Property Get Build()
Build = m_build
End Property

Public Property Get Revision()
Revision = m_revision
End Property
End Class

Class VersionRange
Private m_startVersion
Private m_endVersion

Public Default Function Init(sStartVersion, sEndVersion)
Set m_startVersion = GetDriverVersionObj(sStartVersion)
Set m_endVersion = GetDriverVersionObj(sEndVersion)
Set Init = Me
End Function

Public Property Get StartVersion()
Set StartVersion = m_startVersion
End Property

Public Property Get EndVersion()
Set EndVersion = m_endVersion
End Property
End Class

Class DriverItem
Private m_name
Private m_nameVersion
Private m_driverVersion
Private m_parseObject

Public Default Function Init(sName, oNameVersion, oDriverVersion, ByRef oParseObject)
m_Name = sName
Set m_nameVersion = GetDriverVersionObj(oNameVersion)
Set m_driverVersion = GetDriverVersionObj(oDriverVersion)
Set m_parseObject = oParseObject
Set Init = Me
End Function

Public Property Get Name()
Name = m_name
End Property

Public Property Get NameVersion()
Set NameVersion = m_nameVersion
End Property

Public Property Get DriverVersion()
Set DriverVersion = m_driverVersion
End Property

Public Property Get ParseObject()
Set ParseObject = m_parseObject
End Property
End Class

Class DriverSelectorRule
Private m_nameRegexStr
Private m_nameRegex
Private m_versionRegexStr
Private m_versionRegex
Private m_nameMinVersion
Private m_nameMaxVersion
Private m_computerId
Private m_driverVersionArr

Public DriverCollection
Public IsNativeClient

Public Default Function Init(sNameRegex, sVersionRegex, sNameMinVersion, sNameMaxVersion, oVersionRangeArray)
m_computerId = "."
m_nameRegexStr = sNameRegex
Set m_nameRegex = New RegExp
m_nameRegex.Pattern = m_nameRegexStr
m_versionRegexStr = sVersionRegex
If Not IsNull(m_versionRegexStr) Then
If Len(m_versionRegexStr) &gt; 0 Then
Set m_versionRegex = New RegExp
m_versionRegex.Pattern = m_versionRegexStr
m_versionRegex.Global = True
End If
End If
Set m_nameMinVersion = GetDriverVersionObj(sNameMinVersion)
Set m_nameMaxVersion = GetDriverVersionObj(sNameMaxVersion)
m_driverVersionArr = oVersionRangeArray

DriverCollection = Array()
IsNativeClient = False
Set Init = Me
End Function

Private Function CheckVersion(oVersion, vMinVersion, vMaxVersion)
Dim vVersion: Set vVersion = GetDriverVersionObj(oVersion)
CheckVersion = vVersion.CompareTo(vMinVersion) &gt;= 0 And (vVersion.ToString() = MAX_DRIVER_VERSION_STR Or vMinVersion.CompareTo(vMaxVersion) = 0 Or vVersion.CompareTo(vMaxVersion) &lt; 0)
End Function

Public Function MatchName(sDriverName)
Dim matches
Set matches = m_nameRegex.Execute(sDriverName)
If matches.Count &gt; 0 Then
MatchName = True
Exit Function
End If
MatchName = False
End Function

Public Function GetNameVersion(sDriverName)
Dim sVersion, matches
If Not IsNull(m_versionRegexStr) Then
Set matches = m_versionRegex.Execute(sDriverName)
If matches.Count &gt; 0 Then
sVersion = matches(0).Value
End If
End If
If Not IsNull(sVersion) Then
Set GetNameVersion = GetDriverVersionObj(sVersion)
Else
Set GetNameVersion = GetDriverVersionObj("0")
End If
End Function

Public Function CheckNameVersion(oVersion)
CheckNameVersion = CheckVersion(oVersion, m_nameMinVersion, m_nameMaxVersion)
End Function

Public Function CheckDriverVersion(oVersion)
CheckDriverVersion = False
Dim driverVersionItem
For Each driverVersionItem In m_driverVersionArr
If CheckVersion(oVersion, driverVersionItem.StartVersion, driverVersionItem.EndVersion) Then
CheckDriverVersion = True
Exit For
End If
Next
End Function

Public Function GetDriverVersion(sDriverName)
Dim computerId, driverPath, sDllVersion, objFSO, oRegistry
Dim HKEY_LOCAL_MACHINE: HKEY_LOCAL_MACHINE = &amp;H80000002
Set oRegistry = GetObject("winmgmts:\\" &amp; m_computerId &amp; "\root\default:StdRegProv")
oRegistry.GetStringValue HKEY_LOCAL_MACHINE, "SOFTWARE\ODBC\ODBCINST.INI\" &amp; sDriverName, "Driver", driverPath
Set objFSO = CreateObject("Scripting.FileSystemObject")
sDllVersion = objFSO.GetFileVersion(driverPath)
Set GetDriverVersion = (new DriverVersion)(sDllVersion)
End Function

Public Sub AddDriver(ByRef oDriver)
ReDim Preserve DriverCollection(UBound(DriverCollection) + 1)
Set DriverCollection(UBound(DriverCollection)) = oDriver
End Sub

Public Sub ResetState()
DriverCollection = Array()
End Sub

Public Property Get DriverNameRegex()
DriverNameRegex = m_nameRegexStr
End Property

Public Property Get NameMinVersion()
Set NameMinVersion= m_nameMinVersion
End Property

Public Property Get NameMaxVersion()
Set NameMaxVersion = m_nameMaxVersion
End Property

Public Property Get VersionRangeCollection()
VersionRangeCollection = m_driverVersionArr
End Property

Public Property Get CollectionIsEmpty()
CollectionIsEmpty = UBound(DriverCollection) &lt; 0
End Property
End Class

Class DriverSelector
Private m_computerId
Private m_selectorRules(3)
Private m_selectedDriverName
Private m_processed
Private HKEY_LOCAL_MACHINE
Private m_defaultDriverName

Private m_ncli_ForceProtocolEncryption
Private m_ncli_TrustServerCertificate

Private m_ncli_tcpProtocolEnabled
Private m_ncli_smProtocolEnabled

Public ErrorCollection

Private Sub Class_Initialize()
Set m_selectorRules(0) = (new DriverSelectorRule)("^SQL\sServer\sNative\sClient\s\d{1,8}(\.\d{1,8})?$","\d{1,8}(\.\d{1,8})?$", "11.0", "11.0",_
Array(_
(new VersionRange)("2011.110.6020.0", MAX_DRIVER_VERSION_STR),_
(new VersionRange)("2011.110.5592.0", "2011.110.6000.0"),_
(new VersionRange)("2011.110.5347.0", "2011.110.5522.0")))
m_selectorRules(0).IsNativeClient = True
Set m_selectorRules(1) = (new DriverSelectorRule)("^ODBC\sDriver\s\d{1,8}(\.\d{1,8})?\sfor\sSQL\sServer$", "\d{1,8}(\.\d{1,8})?(?=\sfor\sSQL\sServer$)", "11.0", MAX_DRIVER_VERSION_STR,_
Array(_
(new VersionRange)("2014.120.4219.0", MAX_DRIVER_VERSION_STR),_
(new VersionRange)("2014.120.2546.0", "2014.120.4000.0")))
Set m_selectorRules(2) = (new DriverSelectorRule)("^SQL\sServer\sNative\sClient\s\d{1,8}(\.\d{1,8})?$", "\d{1,8}(\.\d{1,8})?$","0", MAX_DRIVER_VERSION_STR, Array((new VersionRange)("0", MAX_DRIVER_VERSION_STR)))
m_selectorRules(2).IsNativeClient = True
Set m_selectorRules(3) = (new DriverSelectorRule)("^ODBC\sDriver\s\d{1,8}(\.\d{1,8})?\sfor\sSQL\sServer$", "\d{1,8}(\.\d{1,8})?(?=\sfor\sSQL\sServer$)", "0", MAX_DRIVER_VERSION_STR, Array((new VersionRange)("0", MAX_DRIVER_VERSION_STR)))

m_computerId = "."
m_defaultDriverName = "SQL Server"
HKEY_LOCAL_MACHINE = &amp;H80000002
m_ncli_ForceProtocolEncryption = False
m_ncli_TrustServerCertificate = False
m_ncli_tcpProtocolEnabled = True
m_processed = False
Call ResetState()
End Sub

' Select most appropriate driver from filtered installed system (ODBC) drivers.
' select all available drivers
' Filter by driver name and version
' Intersected: check client and server have shared protocols
' tcp and np (Named Pipes) can work by network, sm can work only locally
' driver priorities: sm, tcp; np not used
'
' For native client need common client and server protocols
'
' Select latest namespace with highest version
' Select client protocols
' Select server protocols (enabled)
' Intersect client and server protocols
' Select odbc drivers related to inresected protocols
' We have 3 possible drivers:
' - ODBC (all protocols enabled)
' - Native Client (tcp, sm, np protocols)
' only native client can choose protocols through registry settings
' - Microsoft SQL Server (all protocols enabled)
Public Sub ProcessDrivers(enabledServerProtocols)
Dim ri, i, isSelected, currentSelect, oError
Set oError = New Error
Call ResetState()
On Error Resume Next

Dim client: Set client = GetClientParameters()

Dim ncProtocolsAreIntersected: ncProtocolsAreIntersected = ArraysAreIntersected(enabledServerProtocols, client.Protocols)
Call ProcessSystemOdbcDrivers(ncProtocolsAreIntersected)

oError.Save
If oError.Number &lt;&gt; 0 Then
Call AddError(oError)
m_selectedDriverName = m_defaultDriverName
m_processed = true
Exit Sub
End If
On Error GoTo 0

Dim driver: Set driver = SelectFreshDriver(m_selectorRules)

If Not driver Is Nothing Then
If driver.ParseObject.IsNativeClient Then
client.IsTcpProtocolEnabled = ArrayContains(client.Protocols, "tcp")
client.IsSharedMemoryProtocolEnabled = ArrayContains(client.Protocols, "sm")
End If
End If

If Not driver Is Nothing Then
client.DriverName = driver.Name
End If

' for compatibility fill deprecated
m_selectedDriverName = client.DriverName
m_ncli_ForceProtocolEncryption = client.IsForceProtocolEncryption
m_ncli_TrustServerCertificate = client.IsTrustServerCertificate
m_ncli_tcpProtocolEnabled = client.IsTcpProtocolEnabled
m_ncli_smProtocolEnabled = client.IsSharedMemoryProtocolEnabled

m_processed = True
End Sub

Private Function SelectFreshDriver(rules)
Set SelectFreshDriver = Nothing
Dim selected: Set selected = Nothing
Dim rule: Set selected = Nothing
Dim driver: Set selected = Nothing

For Each rule In rules
For Each driver In rule.DriverCollection
' select first if not selected
If selected Is Nothing Then
Set selected = driver
Else
' select fresh, compare driver with selected by name and
' version
if driver.NameVersion.CompareTo(selected.NameVersion) &gt;= 0 And _
driver.DriverVersion.CompareTo(selected.DriverVersion) &gt;= 0 Then
Set selected = driver
End If
End If
Next

' all rules have order by priority, if rule contains drivers, then
' selected with high priority
if Not selected Is Nothing Then
Exit For
End If
Next

Set SelectFreshDriver = selected
End Function

Private Function GetClientParameters()
Set GetClientParameters = Nothing
Dim params: Set params = (New ConnectionParams)(".")
params.Namespace = GetNsNameWithHighestVersion()
Call GetNativeClientSettings(params.Namespace, params)
params.Protocols = GetEnabledNativeClientProtocols(params.Namespace)
Set GetClientParameters = params
End Function

Private Sub ProcessOdbcDriver(driverName, protocolsAreIntersected)
Dim isInstalled, oRegistry, oNameVersion, oDriverVersion
Set oRegistry = GetObject("winmgmts:\\.\root\default:StdRegProv")

oRegistry.GetStringValue HKEY_LOCAL_MACHINE, "SOFTWARE\ODBC\ODBCINST.INI\ODBC Drivers", driverName, isInstalled
Dim selectorRule
For Each selectorRule In m_selectorRules
If (isInstalled &lt;&gt; "Installed") Then
Exit For
End If
If selectorRule.MatchName(driverName) Then
If (Not selectorRule.IsNativeClient) Or (selectorRule.IsNativeClient And protocolsAreIntersected) Then
Set oNameVersion = selectorRule.GetNameVersion(driverName)
If (selectorRule.CheckNameVersion(oNameVersion)) Then
Set oDriverVersion = selectorRule.GetDriverVersion(driverName)
If (selectorRule.CheckDriverVersion(oDriverVersion)) Then
selectorRule.AddDriver((new DriverItem)(driverName, oNameVersion, oDriverVersion, selectorRule))
Exit For
End If
End If
End If
End If
Next
End Sub

' Get available drivers in the system and fill rules drivers
' TODO: rename method
Private Sub ProcessSystemOdbcDrivers(protocolsAreIntersected)
Dim oRegistry, driverNames, paramValueTypes, i, oError
Set oError = New Error
Set oRegistry = GetObject("winmgmts:\\" &amp; m_computerId &amp; "\root\default:StdRegProv")
Call oRegistry.EnumValues(HKEY_LOCAL_MACHINE, "SOFTWARE\ODBC\ODBCINST.INI\ODBC Drivers", driverNames, paramValueTypes)
On Error Resume Next

Dim driverName
For Each driverName In driverNames
oError.Clear
Call ProcessOdbcDriver(driverName, protocolsAreIntersected)
oError.Save
If oError.Number &lt;&gt; 0 Then
Call AddError(oError)
End If
Next
End Sub

Private Function GetNsNameWithHighestVersion()
Dim rootNs: rootNs = "winmgmts:{impersonationLevel=impersonate}!\\.\root\Microsoft\SqlServer"
Dim oWMI: Set oWMI = GetObject(rootNs)
Dim namespaces: Set namespaces = oWMI.ExecQuery("SELECT Name FROM __NAMESPACE WHERE Name LIKE 'ComputerManagement%'")
Dim currentName: currentName = ""
Dim objItem
For Each objItem In namespaces
If objItem.Name &gt; currentName Then
currentName = objItem.Name
End If
Next
GetNsNameWithHighestVersion = rootNs &amp; "\" &amp; currentName
End Function

Private Sub GetNativeClientSettings(namespaceFullName, params)
On Error Resume Next
Err.Clear

Dim sNamespace, oWMI, objClasses, sState, sTargetComputer
Set oWMI = GetObject(namespaceFullName)
Set objClasses = Nothing

' query can fail, because native client not supported
Set objClasses = oWMI.ExecQuery("SELECT FlagName, FlagValue FROM ClientSettingsGeneralFlag")

' do nothing, its ok, just skip this settings
If (Err.Number &lt;&gt; 0) Or (objClasses Is Nothing) Then
Exit Sub
End If

Dim objItem
For Each objItem in objClasses
Select Case objItem.FlagName
Case "Force protocol encryption"
'm_ncli_ForceProtocolEncryption = objItem.FlagValue
params.IsForceProtocolEncryption = objItem.FlagValue
Case "Trust Server Certificate"
'm_ncli_TrustServerCertificate = objItem.FlagValue
params.IsTrustServerCertificate = objItem.FlagValue
End Select
Next
End Sub

Private Function GetEnabledNativeClientProtocols(namespaceFullName)
On Error Resume Next
Err.Clear

Dim oWMI: Set oWMI = GetObject(namespaceFullName)
Dim oQuery: Set oQuery = oWMI.ExecQuery("SELECT ProtocolName, ProtocolOrder FROM ClientNetworkProtocol")

If (oQuery.Count &gt; 0) And (Err.Number Is 0) Then
Dim protocolsArr: Set protocolsArr = New ArrayList
Dim protocolItem
For Each protocolItem In oQuery
If protocolItem.ProtocolOrder &gt; 0 Then
protocolsArr.Add LCase(protocolItem.ProtocolName)
End If
Next
GetEnabledNativeClientProtocols = protocolsArr.ItemsArray
Else
GetEnabledNativeClientProtocols = Array()
End If
End Function

Private Sub AddError(oError)
Dim newSize
newSize = UBound(ErrorCollection) + 1
ReDim Preserve ErrorCollection(newSize)
ErrorCollection(newSize) = "[" &amp; (oError.Number and 65535) &amp; "][" &amp; oError.Source &amp; "] " &amp; oError.Description
End Sub

Private Sub ResetState()
Dim pr
ErrorCollection = Array()
For Each pr In m_selectorRules
pr.ResetState()
Next
End Sub

Private Sub ThrowIfNotProcessed()
If Not m_processed Then
Call Err.Raise(SCRIPT_EVENT_ID, "", "Drivers are not processed. Call 'ProcessDrivers' first.")
End If
End Sub

Public Property Get HasErrors()
HasErrors = UBound(ErrorCollection) &gt;= 0
End Property

Public Property Get DriverName()
ThrowIfNotProcessed
DriverName = m_selectedDriverName
End Property

Public Property Get UseFqdn()
ThrowIfNotProcessed
UseFqdn = m_ncli_ForceProtocolEncryption And Not m_ncli_TrustServerCertificate
End Property

Public Property Get ClientTcpProtocolEnabled()
ThrowIfNotProcessed
ClientTcpProtocolEnabled = m_ncli_tcpProtocolEnabled
End Property

Public Property Get ClientSharedMemoryProtocolEnabled()
ThrowIfNotProcessed
ClientSharedMemoryProtocolEnabled = m_ncli_smProtocolEnabled
End Property
End Class

Const DriverSelector_DEFAULT_DRIVER_NAME = "SQL Server"

Class ConnectionParams
Public ComputerName
Public DriverName
Public Namespace
Public IsForceProtocolEncryption
Public IsTrustServerCertificate
Public IsTcpProtocolEnabled
Public IsSharedMemoryProtocolEnabled
Public Protocols

Public Default Function Init(sComputerName)
ComputerName = sComputerName
DriverName = DriverSelector_DEFAULT_DRIVER_NAME
Namespace = ""
IsForceProtocolEncryption = False
IsTrustServerCertificate = False
IsTcpProtocolEnabled = True
IsSharedMemoryProtocolEnabled = True
Set Init = Me
End Function
End Class

Class UniqueCollection
Private m_dict

Public Default Function Init()
Set m_dict = CreateObject("Scripting.Dictionary")
Set Init = Me
End Function

Public Sub PutItem(item)
If Not m_dict.Exists(item) Then
m_dict.add item, ""
End If
End Sub

Public Function Exists(item)
Exists = m_dict.Exists(item)
End Function

Public Function GetItems()
GetItems = m_dict.Keys()
End Function

Public Sub Clear()
m_dict.RemoveAll()
End Sub
End Class

Class SqlServerTcpIpSettings
Private m_listenAllIPs
Private m_ipSettings

Public Default Function Init(listenAllIps, ipSettings)
m_listenAllIPs = listenAllIps
Set m_ipSettings = ipSettings
Set Init = Me
End Function

Public Property Get ListenAllIPs()
ListenAllIPs = m_listenAllIPs
End Property

Public Property Get IpSettings()
Set IpSettings = m_ipSettings
End Property
End Class

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(Replace(strValue, "\", "\\"), "'", "\'")
End Function

Function furlEncode(vString,vEncDec)
Dim i
Dim aReserved(24,1)
'column 1
aReserved(0,0) = "%" '25
aReserved(1,0) = ";" '3B
aReserved(2,0) = "/" '2F
aReserved(3,0) = "?" '3F
aReserved(4,0) = ":" '3A
aReserved(5,0) = "@" '40
aReserved(6,0) = "&amp;" '26
aReserved(7,0) = "=" '3D
aReserved(8,0) = "+" '2B
aReserved(9,0) = "$" '24
aReserved(10,0) = "," '2C
aReserved(11,0) = " " '20
aReserved(12,0) = """" '22
aReserved(13,0) = "&lt;" '3C
aReserved(14,0) = "&gt;" '3E
aReserved(15,0) = "#" '23
aReserved(16,0) = "{" '7B
aReserved(17,0) = "}" '7D
aReserved(18,0) = "|" '7C
aReserved(19,0) = "\" '5C
aReserved(20,0) = "^" '5E
aReserved(21,0) = "~" '7E
aReserved(22,0) = "[" '5B
aReserved(23,0) = "]" '5D
aReserved(24,0) = "`" '60
'column 2
aReserved(0,1) = "%25"
aReserved(1,1) = "%3B"
aReserved(2,1) = "%2F"
aReserved(3,1) = "%3F"
aReserved(4,1) = "%3A"
aReserved(5,1) = "%40"
aReserved(6,1) = "%26"
aReserved(7,1) = "%3D"
aReserved(8,1) = "%2B"
aReserved(9,1) = "%24"
aReserved(10,1) = "%2C"
aReserved(11,1) = "%20"
aReserved(12,1) = "%22"
aReserved(13,1) = "%3C"
aReserved(14,1) = "%3E"
aReserved(15,1) = "%23"
aReserved(16,1) = "%7B"
aReserved(17,1) = "%7D"
aReserved(18,1) = "%7C"
aReserved(19,1) = "%5C"
aReserved(20,1) = "%5E"
aReserved(21,1) = "%7E"
aReserved(22,1) = "%5B"
aReserved(23,1) = "%5D"
aReserved(24,1) = "%60"

For i = 0 to Ubound(aReserved)
If vEncDec = "enc" Then
vString = Replace(vString,aReserved(i,0),aReserved(i,1))
End If
If vEncDec = "dec" Then
vString = Replace(vString,aReserved(i,1),aReserved(i,0))
End If
Next

furlEncode = vString
End Function

Class UtcDateOperations
Private m_wbemDate

Private Sub Class_Initialize()
Set m_wbemDate = CreateObject("WbemScripting.SWbemDateTime")
End Sub

Public Function DateToIso8601UtcString(objDate)
DateToIso8601UtcString = _
DatePart("yyyy", objDate) &amp; "-" &amp;_
Right("0" &amp; DatePart("m", objDate), 2) &amp; "-" &amp;_
Right("0" &amp; DatePart("d", objDate), 2) &amp;_
"T" &amp;_
Right("0" &amp; DatePart("h", objDate), 2) &amp; ":" &amp;_
Right("0" &amp; DatePart("n", objDate), 2) &amp; ":" &amp;_
Right("0" &amp; DatePart("s", objDate), 2) &amp;_
"Z"
End Function

Public Function Iso8601UtcStringToDate(sDate)
Dim oRegex: Set oRegex = New RegExp
oRegex.Pattern = "^(\d{4})-(\d\d)-(\d\d)(?:T|\s)(\d\d):(\d\d):(\d\d)Z$"

Dim matches: Set matches = oRegex.Execute(sDate)
If matches.Count = 0 Then
Err.Raise 4000, "", "Input date string is in invalid format"
End If

Dim year: year = CInt(matches(0).SubMatches(0))
Dim month: month = CInt(matches(0).SubMatches(1))
Dim day: day = CInt(matches(0).SubMatches(2))

Dim hour: hour = CInt(matches(0).SubMatches(3))
Dim minute: minute = CInt(matches(0).SubMatches(4))
Dim second: second = CInt(matches(0).SubMatches(5))

Dim resDate: resDate = DateSerial(year, month, day)
resDate = DateAdd("h", hour, resDate)
resDate = DateAdd("n", minute, resDate)
resDate = DateAdd("s", second, resDate)

Iso8601UtcStringToDate = resDate
End Function

Public Function GetUtcNow()
m_wbemDate.SetVarDate(Now())
GetUtcNow = CDate(m_wbemDate.GetVarDate(false))
End function

Public Function CheckSecondsElapsed(sDate, nSeconds)
Dim utcNow: utcNow = Me.GetUtcNow
Dim utcDate: utcDate = Iso8601UtcStringToDate(sDate)
CheckSecondsElapsed = DateDiff("s",utcDate,utcNow) &gt; nSeconds
End function
End Class

Function GetCacheKey(stateMpPrefix, sKeyName)
Dim oApi: Set oApi = CreateObject("MOM.ScriptAPI")
Dim regKey: regKey = oAPI.GetScriptStateKeyPath(ManagementGroupID)
regKey = regKey &amp; "\" &amp; stateMpPrefix &amp; "\" &amp; sKeyName
GetCacheKey = regKey
End Function

Function GetStringValueFromCache(sKeyName, sValueName, cacheExpirationTime)
Dim stateMpPrefix: stateMpPrefix = "SQL2016MP"
Dim sDateValueName: sDateValueName = sValueName &amp; "_CreationTime"

Dim udo: Set udo = New UtcDateOperations
Dim oReg: Set oReg = New Registry

Dim regKey: regKey = GetCacheKey(stateMpPrefix, sKeyName)

oReg.Hive = oReg.HKEY_LOCAL_MACHINE
oReg.Connect(".")

Dim lErrCode
Dim sDate: sDate = oReg.ReadStringValue(regKey, sDateValueName, lErrCode)

If lErrCode &lt;&gt; oReg.SUCCESS Then
Exit Function
End If

Dim sValue: sValue = oReg.ReadStringValue(regKey, sValueName, lErrCode)

If lErrCode &lt;&gt; oReg.SUCCESS Then
Exit Function
End If

If udo.CheckSecondsElapsed(sDate, cacheExpirationTime) Then
Exit Function
End If

GetStringValueFromCache = sValue
End Function

Function PutStringValueToCache(sKeyName, sValueName, sValue)
Dim stateMpPrefix: stateMpPrefix = "SQL2016MP"
Dim sDateValueName: sDateValueName = sValueName &amp; "_CreationTime"

Dim udo: Set udo = New UtcDateOperations
Dim oReg: Set oReg = New Registry

Dim regKey: regKey = GetCacheKey(stateMpPrefix, sKeyName)

Dim dUtcNow: dUtcNow = udo.GetUtcNow()

oReg.Hive = oReg.HKEY_LOCAL_MACHINE
oReg.Connect(".")

Call oReg.CreateKey(regKey)

Dim lErrCode

Call oReg.WriteStringValue(regKey, sValueName, sValue)
Call oReg.WriteStringValue(regKey, sDateValueName, udo.DateToIso8601UtcString(dUtcNow))
End Function

Function GetWMISingleValue(wmiProvider, query, propertyName)
Dim oQuery: Set oQuery = wmiProvider.ExecQuery(query)
If oQuery.Count = 0 Then
Err.Raise 4000, "", "Query '" &amp; query &amp; "' didn't return any objects"
End If
Dim colSettings: Set colSettings = GetFirstItemFromWMIQuery(oQuery)
GetWMISingleValue = colSettings.Properties_.Item(propertyName).Value
End Function

Class HostNameData
Public HostName
Public IsClustered

Public Default Function Init(sHostName, bIsClustered)
Me.HostName = sHostName
Me.IsClustered = bIsClustered
Set Init = Me
End function
End Class

Function GetSqlServerHostName(strDNSComputerName, instanceName, namespace)
Set GetSqlServerHostName = Nothing
Dim serviceName: serviceName = GetSQLServiceName(instanceName)
Dim escapedServiceName: escapedServiceName = EscapeWQLString(serviceName)

Dim wmiProvider: Set wmiProvider = ConnectToWMI(strDNSComputerName, "ROOT\Microsoft\SqlServer\" + namespace)

Dim isClustered: isClustered = GetWmiSingleValue(wmiProvider, "SELECT PropertyNumValue FROM SqlServiceAdvancedProperty WHERE PropertyName = 'CLUSTERED' AND SqlServiceType = 1 AND ServiceName = '" &amp; escapedServiceName &amp; "'", "PropertyNumValue")

Dim hostName
If isClustered = 0 Then
hostName = GetWmiSingleValue(wmiProvider, "SELECT HostName FROM SqlService WHERE SQLServiceType = 1 AND ServiceName = '" &amp; escapedServiceName &amp; "'", "HostName")
Else
hostName = GetWmiSingleValue(wmiProvider, "SELECT PropertyStrValue FROM SqlServiceAdvancedProperty WHERE PropertyName = 'VSNAME' AND SqlServiceType = 1 AND ServiceName = '" &amp; escapedServiceName &amp; "'", "PropertyStrValue")
End If

Set GetSqlServerHostName = (New HostNameData)(hostName, CBool(isClustered))
End Function

Function EscapeCacheValueName(name)
EscapeCacheValueName = Replace(name, "_", "__")
End Function

Function GetSqlServerHostNameEx(strDNSComputerName, instanceName, namespace)
Set GetSqlServerHostNameEx = Nothing
Dim cacheExpirationTime: cacheExpirationTime = 7200
Dim hostValueName: hostValueName = EscapeCacheValueName(strDNSComputerName)
Dim isClusteredValueName: isClusteredValueName = hostValueName &amp; "_IsClustered"
Dim isClusteredStr

On Error Resume Next
Call Err.Clear()
Dim hostName: hostName = GetStringValueFromCache("SqlHostNames", hostValueName, cacheExpirationTime)
If Err.Number = 0 And Not IsEmpty(hostName) Then
isClusteredStr = GetStringValueFromCache("SqlHostNames", isClusteredValueName, cacheExpirationTime)
If Err.Number = 0 And Not IsEmpty(isClusteredStr) Then
If isClusteredStr = "0" Or isClusteredStr = "1" Then
Set GetSqlServerHostNameEx = (New HostNameData)(hostName, CBool(isClusteredStr))
Exit Function
End If
End If
End If
Call Err.Clear()

On Error GoTo 0
Dim hostNameData: Set hostNameData = GetSqlServerHostName(strDNSComputerName, instanceName, namespace)

If hostNameData.IsClustered Then
isClusteredStr = "1"
Else
isClusteredStr = "0"
End If

On Error Resume Next
Call PutStringValueToCache("SqlHostNames", hostValueName, hostNameData.HostName)
Call PutStringValueToCache("SqlHostNames", isClusteredValueName, isClusteredStr)

Call Err.Clear()

Set GetSqlServerHostNameEx = hostNameData
End function

Function GetLocalHostName()
Dim wshShell: Set wshShell = CreateObject( "WScript.Shell" )
GetLocalHostName = wshShell.ExpandEnvironmentStrings("%COMPUTERNAME%")
End Function

Function DelimitSqlIdentifier(identifier)
DelimitSqlIdentifier = "[" + Replace(identifier, "]", "]]") + "]"
End Function

Function SqlTcpPortIsEmpty(tcpPort)
SqlTcpPortIsEmpty = (IsEmpty(tcpPort) Or tcpPort = "" Or tcpPort = "0")
End Function

Function GetDataSource(server, tcpPort)
Dim dataSource : dataSource = server
If Not SqlTcpPortIsEmpty(tcpPort) Then
Dim nameParts : nameParts = Split(dataSource, "\")
dataSource = nameParts(0) &amp; "," &amp; tcpPort
End If
GetDataSource = dataSource
End Function

Function BuildDataSourceFromParts(computerName, instanceName, tcpPort)
Dim dataSource : dataSource = computerName
If instanceName &lt;&gt; "MSSQLSERVER" Then
dataSource = computerName &amp; "\" &amp; instanceName
End If
BuildDataSourceFromParts = GetDataSource(dataSource, tcpPort)
End Function

Function GetConnectionString(driverName, dataSource, databaseName)
GetConnectionString = "Driver=" &amp; EscapeConnStringValue(driverName) &amp; ";Server=" &amp; EscapeConnStringValue(dataSource) &amp; ";Database=" &amp; EscapeConnStringValue(databaseName) &amp; ";Trusted_Connection=yes;"
End Function

Function GetEnabledSqlServerProtocols(namespaceName, computerName, instanceName)
Dim oWMI: Set oWMI = GetObject("winmgmts:\\" &amp; computerName &amp; "\root\Microsoft\SqlServer\" &amp; namespaceName)
Dim oQuery: Set oQuery = oWMI.ExecQuery("SELECT ProtocolName, Enabled FROM ServerNetworkProtocol WHERE InstanceName = '"&amp; EscapeWQLString(instanceName) &amp;"'")
If oQuery.Count &gt; 0 Then
Dim protocolsArr: Set protocolsArr = New ArrayList
Dim protocolItem
For Each protocolItem In oQuery
If protocolItem.Enabled Then
protocolsArr.Add LCase(protocolItem.ProtocolName)
End If
Next
GetEnabledSqlServerProtocols = protocolsArr.ItemsArray
Else
GetEnabledSqlServerProtocols = Array()
End If
End Function

Function GetSqlServerTcpIpSettings(instanceName, computerName)
ON ERROR RESUME NEXT
Dim oWMI, oQuery, tcpItem
Dim i, j
Dim uc: Set uc = (new UniqueCollection)()
Dim isListenAll: isListenAll = False
Dim ipSettings: Set ipSettings = CreateObject("Scripting.Dictionary")

Set oWMI = GetObject("winmgmts:\\" &amp; computerName &amp; "\root\Microsoft\SqlServer\"&amp; SQL_WMI_NAMESPACE)

Set oQuery = oWMI.ExecQuery("SELECT * FROM ServerNetworkProtocolProperty WHERE ProtocolName = 'Tcp' AND InstanceName = '"&amp; EscapeWQLString(instanceName) &amp;"' AND PropertyName = 'ListenOnAllIPs'")

If oQuery.Count &gt;0 Then
Dim isListenAllObj: Set isListenAllObj = GetFirstItemFromWMIQuery(oQuery)
If isListenAllObj.PropertyNumVal = 1 Then
isListenAll = True
End If
End If

Dim tcpPorts, tcpPort, processedPort

If isListenAll Then
Set oQuery = oWMI.ExecQuery("SELECT * FROM ServerNetworkProtocolProperty WHERE ProtocolName = 'Tcp' AND InstanceName = '"&amp; EscapeWQLString(instanceName) &amp;"' AND IPAddressName = 'IPAll' AND (PropertyName = 'TcpPort' OR PropertyName = 'TcpDynamicPorts') AND PropertyStrVal &lt;&gt; ''")
If oQuery.Count &gt; 0 Then
For Each tcpItem In oQuery
tcpPorts = Split(tcpItem.PropertyStrVal,",")
For Each tcpPort In tcpPorts
processedPort = Trim(tcpPort)
If Not SqlTcpPortIsEmpty(processedPort) Then
uc.PutItem(processedPort)
End If
Next
Next
ipSettings.add "IPAll", uc.GetItems()
End If
Else
Set oQuery = oWMI.ExecQuery("SELECT * FROM ServerNetworkProtocolProperty WHERE ProtocolName = 'Tcp' AND InstanceName = '"&amp; EscapeWQLString(instanceName) &amp;"' AND IPAddressName &lt;&gt; '' AND PropertyName = 'Enabled' AND PropertyNumVal = 1")
Dim ipItem
If oQuery.Count &gt; 0 Then
For Each ipItem In oQuery
Dim ipAddressName : ipAddressName = ipItem.IPAddressName
Dim oQuery2 : Set oQuery2 = oWMI.ExecQuery("SELECT * FROM ServerNetworkProtocolProperty WHERE ProtocolName = 'Tcp' AND InstanceName = '" &amp; EscapeWQLString(instanceName) &amp; "' AND IPAddressName = '" &amp; EscapeWQLString(ipAddressName) &amp; "' AND PropertyName = 'IpAddress' AND PropertyStrVal != ''")
If oQuery2.Count &gt; 0 Then
Dim ipAddress : ipAddress = GetFirstItemFromWMIQuery(oQuery2).PropertyStrVal
Dim oQuery3: Set oQuery3 = oWMI.ExecQuery("SELECT * FROM ServerNetworkProtocolProperty WHERE ProtocolName = 'Tcp' AND InstanceName = '"&amp; EscapeWQLString(instanceName) &amp;"' AND IPAddressName = '"&amp; EscapeWQLString(ipAddressName) &amp;"' AND (PropertyName = 'TcpPort' OR PropertyName = 'TcpDynamicPorts') AND PropertyStrVal &lt;&gt; ''")
If oQuery3.Count &gt; 0 Then
uc.Clear()
Dim portItem
For Each portItem In oQuery3
tcpPorts = Split(portItem.PropertyStrVal,",")
For Each tcpPort In tcpPorts
processedPort = Trim(tcpPort)
If Not SqlTcpPortIsEmpty(processedPort) Then
uc.PutItem(processedPort)
End If
Next
ipSettings.add ipAddress, uc.GetItems()
Next
End If
End If
Next
End If
End If
Set GetSqlServerTcpIpSettings = (new SqlServerTcpIpSettings)(isListenAll, ipSettings)
End Function

Function GetTcpPortsString(ByVal inputDataSource)
On Error Resume Next
Dim computerName, instanceName, pathArray

pathArray = Split(inputDataSource, "\")
computerName = pathArray(0)
instanceName = "MSSQLSERVER"
If (UBound(pathArray) &gt; 0) Then
instanceName = pathArray(1)
End If

Dim tcpIpSettings: Set tcpIpSettings = GetSqlServerTcpIpSettings(instanceName, computerName)
Dim upc : Set upc = (new UniqueCollection)()
Dim ip, port
For Each ip In tcpIpSettings.IpSettings.Keys
For Each port In tcpIpSettings.IpSettings.Item(ip)
upc.PutItem port
Next
Next
GetTcpPortsString = Join(upc.GetItems(),", ")
End Function

Public Sub SqlTestDestination(dbConnection, hostName, instanceName, isADODB)
Dim queryServerName, queryInstanceName
Dim destinationTestQuery: destinationTestQuery = "select CAST(SERVERPROPERTY('MachineName') AS nvarchar(128)) as ServerName, @@servicename as InstanceName"
On Error Goto 0
If 0 = Err.number Then
Dim queryResult
If isADODB Then
Set queryResult = dbConnection.ExecuteQueryTE(destinationTestQuery)
Else
Set queryResult = dbConnection.Execute(destinationTestQuery)
End If
If Not queryResult.EOF Then
queryServerName = UCase(queryResult("ServerName").Value)
queryInstanceName = UCase(queryResult("InstanceName").Value)
If (UCase(hostName) = queryServerName) And (UCase(instanceName) = queryInstanceName) Then
Exit Sub
End If
End If
dbConnection.Close()
Err.Raise 16389, "", "Connection target check failed: connected to " &amp; hostName &amp; "\" &amp; instanceName &amp; ", but got " &amp; queryServerName &amp; "\" &amp; queryInstanceName &amp; "."
End If
End Sub

Sub TryToConnectAndValidate(connectionObj, connectionString, timeout, hostName, instanceName, isADODB)
On Error GoTo 0
If isADODB Then
connectionObj.Open connectionString, "", timeout
Else
if (connectionObj.Mode &lt;&gt; 0) then
connectionObj.Close()
end if
connectionObj.ConnectionTimeout = timeout
connectionObj.Open connectionString
End If
SqlTestDestination connectionObj, hostName, instanceName, isADODB
End Sub

Function FormatConnectionErrorMessage(dataSource, lastError)
FormatConnectionErrorMessage = "Connection to data source '" &amp; dataSource &amp; "' failed: " &amp; lastError.Description
End Function

Function SmartConnectWithoutSQLADODB(ByVal inputDataSource, ByVal tcpPort, ByVal machineName, ByVal instanceName, ByVal databaseName)
On Error Resume Next
Set SmartConnectWithoutSQLADODB = Nothing
Dim dbMasterConnection, dataSource, connectionString, errorMessage
Dim targetName : targetName = inputDataSource
Dim lastError : Set lastError = new Error
Dim errorMessageList : Set errorMessageList = New ArrayList

Set dbMasterConnection = CreateObject("ADODB.Connection")

Dim cacheExpirationTime: cacheExpirationTime = (2 ^ 31) -1
Dim hostValueName: hostValueName = EscapeCacheValueName(machineName)
Dim instanceValueName: instanceValueName = EscapeCacheValueName(instanceName)
Dim paramsPath: paramsPath = "SmartConnectParams" &amp; "\" &amp; hostValueName &amp; "\" &amp; instanceValueName
Dim connectionStringPath: connectionStringPath = paramsPath &amp; "\" &amp; databaseName
connectionString = GetStringValueFromCache(connectionStringPath, "TargetDataSource", cacheExpirationTime)
Dim timeout: timeout = GetStringValueFromCache(paramsPath , "ConnectionTimeout", cacheExpirationTime)
Dim netBiosHostName: netBiosHostName = GetStringValueFromCache("SqlHostNames", hostValueName, cacheExpirationTime)

If connectionString &lt;&gt; "" And timeout &lt;&gt; "" And netBiosHostName &lt;&gt; "" Then
lastError.Clear
TryToConnectAndValidate dbMasterConnection, connectionString, timeout, netBiosHostName, instanceName, False
lastError.Save
If lastError.Number = 0 Then
Set SmartConnectWithoutSQLADODB = dbMasterConnection
Exit Function
Else
errorMessageList.Add FormatConnectionErrorMessage(dataSource, lastError)
End If
End If

Dim ds: Set ds = New DriverSelector

Dim netBiosHostNameData: Set netBiosHostNameData = GetSqlServerHostNameEx(machineName, instanceName, SQL_WMI_NAMESPACE)
lastError.Save

If lastError.Number &lt;&gt; 0 Then
GlobalErrorList.Add "Cannot get target instance machine's NetBios host name." &amp;_
"Computer name: " &amp; machineName &amp; vbNewLine &amp;_
"Error number: " &amp; lastError.Number &amp; vbNewLine &amp;_
"Error description:" &amp; lastError.Description
Set SmartConnectWithoutSQLADODB = Nothing
Exit Function
End If

netBiosHostName = netBiosHostNameData.HostName
Dim dnsHostName: dnsHostName = Split(machineName, ".")(0)

Dim enabledServerProtocols: enabledServerProtocols = GetEnabledSqlServerProtocols(SQL_WMI_NAMESPACE, machineName, instanceName)
If Not HandleErrorContinueEx("Cannot get a list of enabled Sql Server protocols", instanceName) Then
Exit Function
End If

ds.ProcessDrivers(enabledServerProtocols)
Dim selectedDriverName: selectedDriverName = ds.DriverName
Dim useFqdn: useFqdn = ds.UseFqdn
Dim hasErrors: hasErrors = ds.HasErrors


Dim connStr: connStr = inputDataSource

Call Err.Clear()

' Sql Server Shared Memory protocol require usage of host's NetBios name.
' Shared Memory usually the first in the driver's priority list.
' Rebuild data source string in the case of standalone Sql Server instance, NetBios host name differs
' from DNS host name and enabled Shared Memory on Client and Server

If netBiosHostName &lt;&gt; dnsHostName And Not netBiosHostNameData.IsClustered And ArrayContains(enabledServerProtocols, "sm") And ds.ClientSharedMemoryProtocolEnabled Then
Dim localHostName: localHostName = GetLocalHostName()
If Not HandleErrorContinue("Cannot get local machine's NetBios name") Then
Exit Function
End If
If netBiosHostName = localHostName Then
connStr = "lpc:" &amp; BuildDataSourceFromParts(netBiosHostName, instanceName, "")
End If
End If

'Connect using Sql Browser
dataSource = GetDataSource(connStr, "")
connectionString = GetConnectionString(selectedDriverName, dataSource, databaseName)
lastError.Clear
TryToConnectAndValidate dbMasterConnection, connectionString, 15, netBiosHostName, instanceName, False
lastError.Save
If lastError.Number = 0 Then
Set SmartConnectWithoutSQLADODB = dbMasterConnection
Call PutStringValueToCache(connectionStringPath, "TargetDataSource", connectionString)
Call PutStringValueToCache(paramsPath, "ConnectionTimeout", 15)
Exit Function
Else
errorMessageList.Add FormatConnectionErrorMessage(dataSource, lastError)
End If

'Try to connect through tcp/ip protocol only if it is enabled
If ArrayContains(enabledServerProtocols, "tcp") And ds.ClientTcpProtocolEnabled Then
Dim dsComputerName: dsComputerName = Split(inputDataSource, "\")(0)
Dim tcpIpSettings : Set tcpIpSettings = GetSqlServerTcpIpSettings(instanceName, dsComputerName)

If useFqdn Then
targetName = machineName
Else
targetName = dsComputerName
End if

Dim ip, port

'Use ports configured for all interfaces
If tcpIpSettings.ListenAllIPs Then
For Each port In tcpIpSettings.IpSettings.item("IPAll")
dataSource = GetDataSource(targetName, port)
connectionString = GetConnectionString(selectedDriverName, dataSource, databaseName)
lastError.Clear
TryToConnectAndValidate dbMasterConnection, connectionString, 10, netBiosHostName, instanceName, False
lastError.Save
If lastError.Number = 0 Then
Set SmartConnectWithoutSQLADODB = dbMasterConnection
Call PutStringValueToCache(connectionStringPath, "TargetDataSource", connectionString)
Call PutStringValueToCache(paramsPath, "ConnectionTimeout", 10)
Exit Function
Else
errorMessageList.Add FormatConnectionErrorMessage(dataSource, lastError)
End If
Next
Else
'Use one port from each interface
Dim upc : Set upc = (new UniqueCollection)()
For Each ip In tcpIpSettings.IpSettings.Keys
port = tcpIpSettings.IpSettings.Item(ip)(0)
If Not upc.Exists(port) Then
upc.PutItem port
dataSource = GetDataSource(targetName, port)
connectionString = GetConnectionString(selectedDriverName, dataSource, databaseName)
lastError.Clear
TryToConnectAndValidate dbMasterConnection, connectionString, 10, netBiosHostName, instanceName, False
lastError.Save
If lastError.Number = 0 Then
Set SmartConnectWithoutSQLADODB = dbMasterConnection
Call PutStringValueToCache(connectionStringPath, "TargetDataSource", connectionString)
Call PutStringValueToCache(paramsPath, "ConnectionTimeout", 10)
Exit Function
Else
errorMessageList.Add FormatConnectionErrorMessage(dataSource, lastError)
End If
End If
Next
'Go through all interfaces and ports
If Not useFqdn Then
For Each ip In tcpIpSettings.IpSettings.Keys
For Each port In tcpIpSettings.IpSettings.Item(ip)
dataSource = GetDataSource(ip, port)
connectionString = GetConnectionString(selectedDriverName, dataSource, databaseName)
lastError.Clear
TryToConnectAndValidate dbMasterConnection, connectionString, 10, netBiosHostName, instanceName, False
lastError.Save
If lastError.Number = 0 Then
Set SmartConnectWithoutSQLADODB = dbMasterConnection
Call PutStringValueToCache(connectionStringPath, "TargetDataSource", connectionString)
Call PutStringValueToCache(paramsPath, "ConnectionTimeout", 10)
Exit Function
Else
errorMessageList.Add FormatConnectionErrorMessage(dataSource, lastError)
End If
Next
Next
End If
End If
End If
GlobalErrorList.Add "Cannot connect to the target Sql Server instance. Connection log:" &amp; vbNewLine &amp; Join(errorMessageList.ItemsArray, vbNewLine)
End Function

Function SmartConnect(cnADOConnection, inputDataSource, tcpPort, machineName, instanceName, databaseName)
On Error Resume Next
SmartConnect = False
Dim dataSource, connectionString, errorMessage
Dim targetName : targetName = inputDataSource
Dim lastError : Set lastError = new Error
Dim errorMessageList : Set errorMessageList = New ArrayList

Dim cacheExpirationTime: cacheExpirationTime = (2 ^ 31) -1
Dim hostValueName: hostValueName = EscapeCacheValueName(machineName)
Dim instanceValueName: instanceValueName = EscapeCacheValueName(instanceName)
Dim paramsPath: paramsPath = "SmartConnectParams" &amp; "\" &amp; hostValueName &amp; "\" &amp; instanceValueName
Dim connectionStringPath: connectionStringPath = paramsPath &amp; "\" &amp; databaseName
connectionString = GetStringValueFromCache(connectionStringPath, "TargetDataSource", cacheExpirationTime)
Dim timeout: timeout = GetStringValueFromCache(paramsPath , "ConnectionTimeout", cacheExpirationTime)
Dim netBiosHostName: netBiosHostName = GetStringValueFromCache("SqlHostNames", hostValueName, cacheExpirationTime)

If connectionString &lt;&gt; "" And timeout &lt;&gt; "" And netBiosHostName &lt;&gt; "" Then
lastError.Clear
TryToConnectAndValidate cnADOConnection, connectionString, timeout, netBiosHostName, instanceName, True
lastError.Save
If lastError.Number = 0 Then
SmartConnect = True
Exit Function
Else
errorMessageList.Add FormatConnectionErrorMessage(dataSource, lastError)
End If
End If


Dim ds: Set ds = New DriverSelector

Dim netBiosHostNameData: Set netBiosHostNameData = GetSqlServerHostNameEx(machineName, instanceName, SQL_WMI_NAMESPACE)
lastError.Save

If lastError.Number &lt;&gt; 0 Then
GlobalErrorList.Add "Cannot get target instance machine's NetBios host name." &amp;_
"Computer name: " &amp; machineName &amp; vbNewLine &amp;_
"Error number: " &amp; lastError.Number &amp; vbNewLine &amp;_
"Error description:" &amp; lastError.Description
Exit Function
End If

netBiosHostName = netBiosHostNameData.HostName
Dim dnsHostName: dnsHostName = Split(machineName, ".")(0)

Dim enabledServerProtocols: enabledServerProtocols = GetEnabledSqlServerProtocols(SQL_WMI_NAMESPACE, netBiosHostName, instanceName)
If Not HandleErrorContinueEx("Cannot get a list of enabled Sql Server protocols", instanceName) Then
Exit Function
End If

ds.ProcessDrivers(enabledServerProtocols)
Dim selectedDriverName: selectedDriverName = ds.DriverName
Dim useFqdn: useFqdn = ds.UseFqdn
Dim hasErrors: hasErrors = ds.HasErrors

Dim connStr: connStr = inputDataSource

Call Err.Clear()

' Sql Server Shared Memory protocol require usage of host's NetBios name.
' Shared Memory usually the first in the driver's priority list.
' Rebuild data source string in the case of standalone Sql Server instance, NetBios host name differs
' from DNS host name and enabled Shared Memory on Client and Server

If netBiosHostName &lt;&gt; dnsHostName And Not netBiosHostNameData.IsClustered And ArrayContains(enabledServerProtocols, "sm") And ds.ClientSharedMemoryProtocolEnabled Then
Dim localHostName: localHostName = GetLocalHostName()
If Not HandleErrorContinue("Cannot get local machine's NetBios name") Then
Exit Function
End If
If netBiosHostName = localHostName Then
connStr = "lpc:" &amp; BuildDataSourceFromParts(netBiosHostName, instanceName, "")
End If
End If

'Connect using Sql Browser
dataSource = GetDataSource(connStr, "")
connectionString = GetConnectionString(selectedDriverName, dataSource, databaseName)
lastError.Clear
TryToConnectAndValidate cnADOConnection, connectionString, 15, netBiosHostName, instanceName, True
lastError.Save
If lastError.Number = 0 Then
SmartConnect = True
Call PutStringValueToCache(connectionStringPath, "TargetDataSource", connectionString)
Call PutStringValueToCache(paramsPath, "ConnectionTimeout", 15)
Exit Function
Else
errorMessageList.Add FormatConnectionErrorMessage(dataSource, lastError)
End If

'Try to connect through tcp/ip protocol only if it is enabled
If ArrayContains(enabledServerProtocols, "tcp") And ds.ClientTcpProtocolEnabled Then
Dim dsComputerName: dsComputerName = Split(inputDataSource, "\")(0)
Dim tcpIpSettings : Set tcpIpSettings = GetSqlServerTcpIpSettings(instanceName, dsComputerName)

If useFqdn Then
targetName = machineName
Else
targetName = dsComputerName
End if

Dim ip, port

'Use ports configured for all interfaces
If tcpIpSettings.ListenAllIPs Then
For Each port In tcpIpSettings.IpSettings.item("IPAll")
dataSource = GetDataSource(targetName, port)
connectionString = GetConnectionString(selectedDriverName, dataSource, databaseName)
lastError.Clear
TryToConnectAndValidate cnADOConnection, connectionString, 10, netBiosHostName, instanceName, True
lastError.Save
If lastError.Number = 0 Then
SmartConnect = True
Call PutStringValueToCache(connectionStringPath, "TargetDataSource", connectionString)
Call PutStringValueToCache(paramsPath, "ConnectionTimeout", 10)
Exit Function
Else
errorMessageList.Add FormatConnectionErrorMessage(dataSource, lastError)
End If
Next
Else
'Use one port from each interface
Dim upc : Set upc = (new UniqueCollection)()
For Each ip In tcpIpSettings.IpSettings.Keys
port = tcpIpSettings.IpSettings.Item(ip)(0)
If Not upc.Exists(port) Then
upc.PutItem port
dataSource = GetDataSource(targetName, port)
connectionString = GetConnectionString(selectedDriverName, dataSource, databaseName)
lastError.Clear
TryToConnectAndValidate cnADOConnection, connectionString, 10, netBiosHostName, instanceName, True
lastError.Save
If lastError.Number = 0 Then
SmartConnect = True
Call PutStringValueToCache(connectionStringPath, "TargetDataSource", connectionString)
Call PutStringValueToCache(paramsPath, "ConnectionTimeout", 10)
Exit Function
Else
errorMessageList.Add FormatConnectionErrorMessage(dataSource, lastError)
End If
End If
Next
'Go through all interfaces and ports
If Not useFqdn Then
For Each ip In tcpIpSettings.IpSettings.Keys
For Each port In tcpIpSettings.IpSettings.Item(ip)
dataSource = GetDataSource(ip, port)
connectionString = GetConnectionString(selectedDriverName, dataSource, databaseName)
lastError.Clear
TryToConnectAndValidate cnADOConnection, connectionString, 10, netBiosHostName, instanceName, True
lastError.Save
If lastError.Number = 0 Then
SmartConnect = True
Call PutStringValueToCache(connectionStringPath, "TargetDataSource", connectionString)
Call PutStringValueToCache(paramsPath, "ConnectionTimeout", 10)
Exit Function
Else
errorMessageList.Add FormatConnectionErrorMessage(dataSource, lastError)
End If
Next
Next
End If
End If
End If
GlobalErrorList.Add "Cannot connect to the target Sql Server instance. Connection log:" &amp; vbNewLine &amp; Join(errorMessageList.ItemsArray, vbNewLine)
End Function

'#Include File:Common-SecondPart.vbs

''''''''''''''''''''''''''''''''''''
''' 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")
' Specify the increased command timeout
ADOConnection.CommandTimeout = 60
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
If (ADOConnection.State &lt;&gt; 0) Then
ADOConnection.Close()
End If
ADOConnection.ConnectionString = connectionString

If provider &lt;&gt; "" Then
ADOConnection.Provider = provider
End If

if connectionTimeout &lt;= 0 Then
ADOConnection.ConnectionTimeout = 30
Else
ADOConnection.ConnectionTimeout = connectionTimeout
End If
HandleError("Cannot initialize ADODB connection (ADODB.Open).")

On Error GoTo 0

ADOConnection.Open()

End Function

Public Function ExecuteQuery(query)
On Error Resume Next
Set ExecuteQuery = Nothing
Set ExecuteQuery = ADOConnection.Execute(query)
End Function

Public Function ExecuteQueryTE(query)
On Error GoTo 0
Set ExecuteQueryTE = 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
Set ExecuteQueryWithParams = Nothing
' 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: " &amp; VarType(value))
End Select
cmd.Parameters.Append Parameter
End Sub

Function Max(a,b)
Max = a
If b &gt; 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 &lt;&gt; 0 Then
HandleOpenConnectionErrorContinue = false
Dim oError : Set oError = new Error
oError.Save()
Dim instanceIsRunning : instanceIsRunning = IsServiceRunning(sqlInstanceName, serverName)
On Error Resume Next
oError.Raise()
Dim errorStr

if ((Err.number and 65535) = 16389 or (Err.number and 65535) = 3661) and instanceIsRunning Then
Call LogError("Cannot login to database [" &amp; serverName &amp; "][" &amp; sqlInstanceName &amp; ":" &amp; database &amp; "]: " &amp; oError.Description)
Err.Clear
ElseIf (instanceIsRunning) Then
Call LogFormattedError("Cannot open ADODB connection. (Connection string: '" &amp; ADOConnection.ConnectionString &amp; "'.). Error Description: " &amp; oError.Description, sqlInstanceName)
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 &lt;&gt; 0 Then
HandleExecutionQueryErrorContinue = false
Dim oError : Set oError = new Error
oError.Save()
Dim instanceIsRunning : instanceIsRunning = IsServiceRunning(sqlInstanceName, serverName)
On Error Resume Next
oError.Raise()
if ((Err.number and 65535) = 16389 or (Err.number and 65535) = 3661) and instanceIsRunning Then
Call LogError("Cannot execute query [" &amp; serverName &amp; "][" &amp; sqlInstanceName &amp; ":" &amp; ADOConnection.DefaultDatabase &amp; "]: " &amp; oError.Description)
Err.Clear
ElseIf (instanceIsRunning) Then
Call LogFormattedError("Cannot execute query: " &amp; FormatLogQuery(query), sqlInstanceName)
Err.Clear
Else
Err.Clear
End If
On Error Goto 0
End If
End Function

Public Function IsServiceRunning(sInstance, serverName)
Dim sServiceName : sServiceName = GetSQLServiceName(sInstance)
Dim oService, sObjectString
sObjectString = "winmgmts:{impersonationLevel=impersonate}!\\" &amp; serverName &amp; "\root\cimv2"

On Error Resume Next
Err.Clear
'We want to do our own error handling here. No WMIGetObject().
Set oService = GetObject(sObjectString &amp; ":Win32_Service.Name='" &amp; EscapeWQLString(sServiceName) &amp; "'")
If Err.Number &lt;&gt; 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

Private Function FormatLogQuery(query)
Dim regex: Set regex = New RegExp
regex.Pattern = "\s{2,}"
regex.Global = True
FormatLogQuery = regex.Replace(query," ")
End function

Private Sub LogError(message)
On Error Resume Next
GlobalErrorList.Add message
End Sub

Private Sub LogFormattedError(message, instanceName)
Dim formattedMessage: formattedMessage = FormatErrorMessage(message, instanceName)
Call GlobalErrorList.Add(formattedMessage)
End Sub

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 &amp; serverName)
Dim colItems : Set colItems = objWMIService.ExecQuery(MOUNT_POINTS_QUERY)
HandleError(MOUNT_POINT_ERROR &amp; 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


Dim devStartIndex : dirStartIndex = InStr(objItem.Volume, """") + 1
Dim devEndIndex : dirEndIndex = InStr(dirStartIndex, objItem.Volume, """")
Dim DeviceID
DeviceID = Replace(Mid(objItem.Volume, dirStartIndex, dirEndIndex - dirStartIndex), "\\", "\")
point.DeviceID = DeviceID

point.Name = point.DeviceID &amp; 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 &amp; serverName)
Dim colItems : Set colItems = objWMIService.ExecQuery(VOLUME_QUERY)
HandleError(DISK_VOLUME_ERROR &amp; 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

MergeMountPointsIntoVolumeList Volumes, aMountPoints

Set GetVolumes = Volumes
End Function

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) &lt;&gt; "\" Then
Caption = Caption &amp; "\"
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 &amp; 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) &lt; 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) &gt; 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 &gt; 0 Then
sortedLess = SortArray(longerList)
Else
sortedLess = longerList
End If

If shorterListSize &gt; 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 &lt; longerListSize Then
Set ResultArray(i) = lessArray(i)
ElseIf i &gt; longerListSize Then
Set ResultArray(i) = greaterArray(i - longerListSize - 1)
Else
Set ResultArray(i) = pivotNode
End If
Next
MergeArrays = ResultArray
End Function
'#Include File:SQLFreeSpaceCalculator.vbs

''''''''''''''''''''''''''''''''''''
''' Class DBSpaceCalculator
''''''''''''''''''''''''''''''''''''
Class DBSpaceCalculator
Public FreeSpaceMB
Public FreeSpacePercent
Public FreeSpaceAutoGrowMB
Public FreeSpaceAutoGrowPercent
Public SizeMB
Public AllocatedFreeSpaceMB
Public AllocatedFreeSpacePercent
Public DiskFreeSpaceMB
Public DiskFreeSpacePercent
Public UsedSpaceMB
Public UsedSpacePercent
Public TotalSpaceMB
Public IsTotalAutoGrow
Private VolumeGrowthArray
Private DiskVolumesInfo

Public AzureMaxFileSizeMB
Public IsError
Public ErrorMessage
Private ReExpProvider
Private FSOProvider
Public LastShared
Public NoSizeAllocationInfo
public LastTotalSize

Private Sub Class_Initialize()
Set ReExpProvider = new regexp
ReExpProvider.IgnoreCase = true

Set FSOProvider = CreateObject("Scripting.FileSystemObject")
Me.LastShared = ""
Me.IsError = false
Me.ErrorMessage = ""

AzureMaxFileSizeMB = 1048576

FreeSpaceMB = 0
FreeSpacePercent = 0
UsedSpaceMB = 0
SizeMB = 0
FreeSpaceAutoGrowMB = 0
FreeSpaceAutoGrowPercent = 0
AllocatedFreeSpaceMB = 0
AllocatedFreeSpacePercent = 0
DiskFreeSpaceMB = 0
DiskFreeSpacePercent = 0
UsedSpacePercent = 0
TotalSpaceMB = 0
IsTotalAutoGrow = false
Set VolumeGrowthArray = CreateObject("Scripting.Dictionary")
End Sub

Public Default Function Init(diskVolumesInformation)
Set DiskVolumesInfo = diskVolumesInformation
Dim key
For Each key in DiskVolumesInfo.Volumes.Keys
VolumeGrowthArray.Add DiskVolumesInfo.Volumes.Item(key).DeviceID, 0
Next
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)) &gt; 0 Then
Set GetVolumeByPath = DiskVolumesInfo.Volumes.Item(DiskVolumesInfo.MountPoints.Item(mpKey).DeviceID)
Exit Function
End If
Next
Set GetVolumeByPath = Nothing
End Function

Public Function CalculateFxFreeSpace(dbFilesSet,takefullSet)
Dim HasFiles : HasFiles = False
Dim GroupUsedSpace : GroupUsedSpace = 0
Dim GroupAvailableSpace : GroupAvailableSpace = 0
Dim DiskArray : Set DiskArray = CreateObject("Scripting.Dictionary")
Do While Not dbFilesSet.EOF

HasFiles = True

Dim filePath : filePath = dbFilesSet("physical_name").Value

Dim fileSize : fileSize = CDbl(dbFilesSet("fileSize").Value)
GroupUsedSpace = GroupUsedSpace + fileSize
Dim GrowthSpaceMaxSize : GrowthSpaceMaxSize = CDbl(1.79769313486232E307)
Dim fileMaxSize : fileMaxSize = CLng(dbFilesSet("fileMaxSize").Value)
if fileMaxSize &lt;&gt; -1 And fileMaxSize &lt;&gt; 0 Then
GrowthSpaceMaxSize = fileMaxSize - fileSize
End If

Dim FreeSpaceDisk : FreeSpaceDisk = GetFreeSpaceDisk(filePath, fileSize)

Dim LogicalDriveGrowth : LogicalDriveGrowth = 0

If GrowthSpaceMaxSize &gt; FreeSpaceDisk Then
LogicalDriveGrowth = FreeSpaceDisk
Else
LogicalDriveGrowth = GrowthSpaceMaxSize
End If

Dim DicKey: DicKey = ""
if Me.LastShared = "" Then
Dim vol : Set vol = GetVolumeByPath(filePath)
DicKey = vol.DeviceID
Else
DicKey = Me.LastShared
End If

if Not DiskArray.Exists(DicKey) Then
DiskArray.Add DicKey, LogicalDriveGrowth
Else
Dim newSize: newSize = DiskArray.Item(DicKey) + LogicalDriveGrowth
If newSize &gt; FreeSpaceDisk Then
newSize = FreeSpaceDisk
End If
DiskArray.Item(DicKey) = newSize
End if
If Not takeFullSet Then
Exit Do
End If
dbFilesSet.MoveNext
Loop
Dim logicalDriveGrowthKey
for each logicalDriveGrowthKey in DiskArray
GroupAvailableSpace = GroupAvailableSpace + DiskArray.Item(logicalDriveGrowthKey)
Next
Me.FreeSpaceMB = GroupAvailableSpace
if Me.FreeSpaceMB &lt; 0 Then
Me.FreeSpaceMB = 0
End If

If HasFiles Then
Me.FreeSpacePercent = GroupAvailableSpace / (GroupUsedSpace + GroupAvailableSpace) * 100
if Me.FreeSpacePercent &lt; 0 Then
Me.FreeSpacePercent = 0
End If
Else
Me.FreeSpacePercent = 100
End If
End Function

Public Function CalculateFdFreeSpace(dbFilesSet)
Dim HasFiles : HasFiles = False
Dim GroupUsedSpace : GroupUsedSpace = 0
Dim GroupAvailableSpace : GroupAvailableSpace = 0
Dim DiskArray : Set DiskArray = CreateObject("Scripting.Dictionary")
Do While Not dbFilesSet.EOF

HasFiles = True

Dim filePath : filePath = dbFilesSet("physical_name").Value

Dim fileSize : fileSize = CDbl(dbFilesSet("fileSize").Value)
GroupUsedSpace = GroupUsedSpace + fileSize
Dim GrowthSpaceMaxSize : GrowthSpaceMaxSize = CDbl(1.79769313486232E307)
Dim fileMaxSize : fileMaxSize = CLng(dbFilesSet("fileMaxSize").Value)
if fileMaxSize &lt;&gt; -1 And fileMaxSize &lt;&gt; 0 Then
GrowthSpaceMaxSize = fileMaxSize - fileSize
End If

Dim FreeSpaceDisk : FreeSpaceDisk = GetFreeSpaceDisk(filePath, fileSize)

If (Me.IsError) Then
Exit Function
End If

Dim vol : Set vol = GetVolumeByPath(filePath)
Dim LogicalDriveGrowth : LogicalDriveGrowth = 0

If GrowthSpaceMaxSize &gt; FreeSpaceDisk Then
LogicalDriveGrowth = FreeSpaceDisk
Else
LogicalDriveGrowth = GrowthSpaceMaxSize
End If

if Not DiskArray.Exists(vol.DeviceID) Then
DiskArray.Add vol.DeviceID, LogicalDriveGrowth
Else
Dim newSize: newSize = DiskArray.Item(vol.DeviceID) + LogicalDriveGrowth
If newSize &gt; FreeSpaceDisk Then
newSize = FreeSpaceDisk
End If
DiskArray.Item(vol.DeviceID) = newSize
End if

dbFilesSet.MoveNext
Loop
Dim logicalDriveGrowthKey
for each logicalDriveGrowthKey in DiskArray
GroupAvailableSpace = GroupAvailableSpace + DiskArray.Item(logicalDriveGrowthKey)
Next
Me.FreeSpaceMB = GroupAvailableSpace
if Me.FreeSpaceMB &lt; 0 Then
Me.FreeSpaceMB = 0
End If

If HasFiles Then
Me.FreeSpacePercent = GroupAvailableSpace / (GroupUsedSpace + GroupAvailableSpace) * 100
if Me.FreeSpacePercent &lt; 0 Then
Me.FreeSpacePercent = 0
End If
Else
Me.FreeSpacePercent = 100
End If
End Function

Private Function GetFreeSpaceDisk(filePath, fileSize)
On Error Resume Next
Dim oMatches
Me.LastShared = ""
'Azure blob
'http://&lt;storage account&gt;.blob.core.windows.net/&lt;container&gt;/&lt;blob&gt;
'https://&lt;storage account&gt;.blob.core.windows.net/&lt;container&gt;/&lt;blob&gt;
ReExpProvider.Pattern = "^(https?:\/\/)?([\da-z\.-]+)\.([a-z\.]{2,6})([\/\w \.-]*)*\/?$"
Set oMatches = ReExpProvider.Execute(filePath)
If Not IsNull(oMatches) And Not oMatches is Nothing And Not IsEmpty(oMatches) Then
If oMatches.Count &gt; 0 Then
GetFreeSpaceDisk = Me.AzureMaxFileSizeMB - fileSize
Me.LastShared = filePath
Exit Function
End If
End If

'UNC = \\&lt;hostname&gt;\&lt;sharename&gt;[\&lt;objectname&gt;]*
ReExpProvider.Pattern = "^\\{2}(?:\?\\)?([^\\\:]+)\\([^\\\:]+)((?:\\[^\\\:]+)+(?:\\)?)+$"
Set oMatches = ReExpProvider.Execute(filePath)
If Not IsNull(oMatches) And Not oMatches is Nothing And Not IsEmpty(oMatches) Then
If oMatches.Count &gt; 0 Then
Dim oMatch
Dim errMessage : errMessage = ""
Set oMatch = oMatches(0)

If Not IsNull(oMatch) And Not oMatch is Nothing And Not IsEmpty(oMatch) Then
If oMatch.SubMatches.Count &gt;= 2 Then
Dim SMBShared
SMBShared = "\\" + oMatch.SubMatches(0) + "\" + oMatch.SubMatches(1)

Me.LastShared = SMBShared

GetFreeSpaceDisk = FSOProvider.getDrive(SMBShared).FreeSpace / 1024 /1024
Me.LastTotalSize = FSOProvider.getDrive(SMBShared).TotalSize / 1024 /1024
if Not IsEmpty(GetFreeSpaceDisk) Then
Exit Function
End If
errMessage = "Cannot get FreeSpace of SMB shared '" &amp; SMBShared &amp; "' ('" &amp; filePath &amp; "')" &amp; vbCrLf
End If
End If

If (len(errMessage) = 0) Then
errMessage = "Cannot get FreeSpace of SMB shared '" &amp; filePath &amp; "'" &amp; vbCrLf
End if

Me.ErrorMessage = Me.ErrorMessage + errMessage
Me.IsError = true
Exit Function
End if
end if

Dim vol : Set vol = GetVolumeByPath(filePath)
If Not vol is Nothing And Not IsNull(vol) And Not IsEmpty(vol) Then
GetFreeSpaceDisk = vol.FreeSpace / 1024 / 1024
Me.LastTotalSize = vol.Capacity / 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 '" &amp; diskName &amp; "'")
GetFreeSpaceDisk = disk.FreeSpace / 1024 / 1024
Me.LastTotalSize = disk.TotalSize / 1024 /1024
HandleError("Cannot get FreeSpace of disk '" &amp; diskName &amp; "'")
End Function

Public Function CalculateFreeSpace(dbFilesSet)
'On Error Resume Next

Me.LastShared = ""
Me.IsError = false
Me.ErrorMessage = ""

Dim GroupAvailableSpace : GroupAvailableSpace = 0
Dim GroupUsedSpace : GroupUsedSpace = 0
Dim GroupAvailableSpaceNoGrowth : GroupAvailableSpaceNoGrowth = 0
Dim GroupUsedSpaceNoGrowth : GroupUsedSpaceNoGrowth = 0
Dim noUsedSpaceInfo: noUsedSpaceInfo = False
Do While Not dbFilesSet.EOF
Dim filePath : filePath = dbFilesSet("physical_name").Value

Dim fileSize : fileSize = CDbl(dbFilesSet("fileSize").Value)
Dim fileUsedSpace : fileUsedSpace = CDbl(dbFilesSet("fileUsed").Value)
noUsedSpaceInfo = noUsedSpaceInfo or CBool(fileUsedSpace = -1)
GroupAvailableSpaceNoGrowth = GroupAvailableSpaceNoGrowth + fileSize
GroupUsedSpaceNoGrowth = GroupUsedSpaceNoGrowth + fileUsedSpace
GroupAvailableSpace = GroupAvailableSpace + fileSize
GroupUsedSpace = GroupUsedSpace + fileUsedSpace

Dim IsAutoGrow : IsAutoGrow = CBool(dbFilesSet("IsAutoGrow").Value = 1)
IsTotalAutoGrow = CBool(IsTotalAutoGrow Or IsAutoGrow)
if (IsAutoGrow) Then

Dim NumberGrowths : NumberGrowths = 0

Dim GrowthSpaceDisk : GrowthSpaceDisk = 0

Dim GrowthSpaceMaxSize : GrowthSpaceMaxSize = CDbl(1.79769313486232E307)
Dim fileMaxSize : fileMaxSize = CLng(dbFilesSet("fileMaxSize").Value)
Dim fileGrowth : fileGrowth = CLng(dbFilesSet("fileGrowth").Value)

Dim isPercentGrowth : isPercentGrowth = dbFilesSet("isPercentGrowth").Value

if Not isPercentGrowth Then 'FileGrowth not in Percent
fileGrowth = fileGrowth / 128
Else
fileGrowth = fileGrowth / 100
End If


if fileMaxSize &lt;&gt; -1 Then 'FileMaxSize Not Unlimited
'when the FileSize approaches the MaxSize, a large FileGrowth value can cause an error
'if the file tries to grow past the MaxSize value.
'calculate actual growth capacity
if isPercentGrowth Then 'FileGrowth in Percent
NumberGrowths = Fix(Log(fileMaxSize / fileSize) / Log(1 + fileGrowth))
GrowthSpaceMaxSize = (fileSize * ((1 + fileGrowth) ^ NumberGrowths)) - fileSize
Else
GrowthSpaceMaxSize = Fix((fileMaxSize - fileSize) / fileGrowth) * fileGrowth
End If
End If

Dim FreeSpaceDisk : FreeSpaceDisk = GetFreeSpaceDisk(filePath, fileSize)

If (Me.IsError) Then
Exit Function
End If

'when the FileSize approaches the limits of the logical disk, a large FileGrowth
'value can cause an error if the file tries to grow past the physical limit
'calculate actual growth capacity on disk
if isPercentGrowth Then 'FileGrowth in Percent
NumberGrowths = Fix(Log((FreeSpaceDisk + fileSize) / fileSize) / Log(1 + fileGrowth))
GrowthSpaceDisk = (fileSize * ((1 + fileGrowth) ^ NumberGrowths)) - fileSize
Else
GrowthSpaceDisk = Fix(FreeSpaceDisk / fileGrowth) * fileGrowth
End If

'with auto grow the growth allowed for a file with a max size is the minimum
'of either up to the max size or up to the limits of the logical drive.
'With max size unlimited, the growth allowed is not limited except by the limits of the logical drive
Dim GrowthAllowed : GrowthAllowed = GrowthSpaceDisk
if GrowthSpaceMaxSize &lt; GrowthSpaceDisk Then
GrowthAllowed = GrowthSpaceMaxSize
End If

'if there is no access to SMB share space shouldn't take into.
if Not (IsEmpty(FreeSpaceDisk)) Then

'add growth allowed for this file to hosting logical drive up to the free disk space capacity.
Dim LogicalDriveGrowth : LogicalDriveGrowth = 0

if (len(Me.LastShared) &gt; 0) Then
'save if no such SMB shared
if( VolumeGrowthArray.Exists(Me.LastShared)) Then
LogicalDriveGrowth = VolumeGrowthArray.Item(Me.LastShared)
Else
VolumeGrowthArray.Add Me.LastShared, 0
End if
'save result
If (LogicalDriveGrowth + GrowthAllowed &gt; FreeSpaceDisk) Then
VolumeGrowthArray.Item(Me.LastShared) = FreeSpaceDisk
Else
VolumeGrowthArray.Item(Me.LastShared) = LogicalDriveGrowth + GrowthAllowed
End If
'all job done
Me.LastShared = ""
Else
LogicalDriveGrowth = GetLogicalDriveGrowth(filePath)
If LogicalDriveGrowth + GrowthAllowed &gt; FreeSpaceDisk Then
SetLogicalDriveGrowth filePath, FreeSpaceDisk
Else
SetLogicalDriveGrowth filePath, LogicalDriveGrowth + GrowthAllowed
End If
End If
End If
End If
dbFilesSet.MoveNext
Loop

Dim logicalDriveGrowthKey
for each logicalDriveGrowthKey in VolumeGrowthArray
GroupAvailableSpace = GroupAvailableSpace + VolumeGrowthArray.Item(logicalDriveGrowthKey)
Next

Me.NoSizeAllocationInfo = noUsedSpaceInfo
Me.UsedSpaceMB = GroupUsedSpace
Me.FreeSpaceMB = GroupAvailableSpace - GroupUsedSpace

If GroupAvailableSpace &lt;&gt; 0 And Me.FreeSpaceMB &gt; 0 Then
Me.FreeSpacePercent = Me.FreeSpaceMB / GroupAvailableSpace * 100
Else
Me.FreeSpaceMB = 0
Me.FreeSpacePercent = 0
End If

Me.SizeMB = GroupAvailableSpaceNoGrowth

Me.FreeSpaceAutoGrowMB = GroupAvailableSpaceNoGrowth - GroupUsedSpaceNoGrowth
If GroupAvailableSpaceNoGrowth &lt;&gt; 0 And Me.FreeSpaceAutoGrowMB &gt; 0 Then
Me.FreeSpaceAutoGrowPercent = Me.FreeSpaceAutoGrowMB / GroupAvailableSpaceNoGrowth * 100
Else
Me.FreeSpaceAutoGrowMB = 0
Me.FreeSpaceAutoGrowPercent = 0
End If

Me.AllocatedFreeSpaceMB = Me.SizeMB - Me.UsedSpaceMB
if Me.AllocatedFreeSpaceMB &lt; 0 Then
Me.AllocatedFreeSpaceMB = 0
End If

Me.DiskFreeSpaceMB = Me.FreeSpaceMB - Me.AllocatedFreeSpaceMB
if Me.DiskFreeSpaceMB &lt; 0 Then
Me.DiskFreeSpaceMB = 0
End If

Me.TotalSpaceMB = Me.DiskFreeSpaceMB + Me.AllocatedFreeSpaceMB + Me.UsedSpaceMB

If TotalSpaceMB &lt;&gt; 0 Then
Me.AllocatedFreeSpacePercent = (Me.AllocatedFreeSpaceMB / TotalSpaceMB) * 100
Me.DiskFreeSpacePercent = (Me.DiskFreeSpaceMB / TotalSpaceMB) * 100
Me.UsedSpacePercent = (Me.UsedSpaceMB / TotalSpaceMB) * 100
Else
Me.AllocatedFreeSpacePercent = 0
Me.DiskFreeSpacePercent = 0
Me.UsedSpacePercent = 0
End If


End Function

Function GetLogicalDriveGrowth(filePath)
Dim vol : Set vol = GetVolumeByPath(filePath)
If Not IsNull(vol) And Not IsEmpty(vol) Then
GetLogicalDriveGrowth = VolumeGrowthArray.Item(vol.DeviceID)
End If
End Function

Function SetLogicalDriveGrowth(filePath, value)
Dim vol : Set vol = GetVolumeByPath(filePath)
If Not IsNull(vol) And Not IsEmpty(vol) Then
VolumeGrowthArray.Item(vol.DeviceID) = value
End If
End Function

End Class

'#Include File:GetSQLDBFxContainerFreeSpace.vbs

Const DB_STATE_ONLINE = 0
Const DB_STATE_RESTORING = 1
Const DB_STATE_RECOVERING = 2
Const DB_STATE_RECOVERY_PENDING = 3
Const DB_STATE_SUSPECT = 4
Const DB_STATE_EMERGENCY = 5
Const DB_STATE_OFFLINE = 6

Const SCRIPT_EVENT_ID = 4211

Function Main()
On Error Resume Next
Logger.LogDebug("Start...")
if WScript.Arguments.Count() &lt;&gt; 5 Then
WScript.Quit()
End If

Dim connectionStr : connectionStr = WScript.Arguments(0)
Dim serverName : serverName = WScript.Arguments(1)
Dim instanceName : instanceName = WScript.Arguments(2)
Dim TcpPort : TcpPort = WScript.Arguments(3)
Dim Delay : Delay = WScript.Arguments(4)

Logger.LogDebug("connectionStr = " &amp; connectionStr &amp; "; ServerName = " &amp; serverName &amp; "; instanceName = " &amp; instanceName)

GetAllDbFilesFreeSpace connectionStr, serverName, instanceName, TcpPort, Delay

Call GlobalErrorListToEventLog()

logger.LogDebug("End...")
End Function

Function GetAllDbFilesFreeSpace(connectionStr, serverName, instanceName, sTcpPort, Delay)
On Error Resume Next
Dim opsMgrAPI
Dim tcp : tcp = sTcpPort
Dim dbMasterConnection
Dim listDatabases
Dim hasItems: hasItems = False

Set opsMgrAPI = new OpsMgrAPI
Set dbMasterConnection = new ADODB

Dim serviceName , state
serviceName = GetSQLServiceName(instanceName)
state = GetServiceState(serverName, serviceName)
if (state &lt;&gt; "Running") And (state &lt;&gt; "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

Dim query : query = _
" SET NOCOUNT ON; " &amp; vbCrLf &amp; _
" DECLARE @HasAlwaysOn BIT; " &amp; vbCrLf &amp; _
" SET @HasAlwaysOn = (SELECT TOP 1 CASE WHEN OBJECT_ID('sys.availability_replicas') IS NOT NULL THEN 1 ELSE 0 END AS HasAlwaysOn " &amp; vbCrLf &amp; _
" FROM master.sys.syscolumns columns WHERE name = 'replica_id' AND id = OBJECT_ID('sys.databases')); " &amp; vbCrLf &amp; _
" IF @HasAlwaysOn IS NULL OR @HasAlwaysOn = 0 " &amp; vbCrLf &amp; _
" SELECT d.name, d.database_id, CAST(CASE WHEN dm.mirroring_guid IS NOT NULL OR d.is_in_standby = 1 THEN 1 ELSE 0 END AS BIT) AS needsMaster " &amp; vbCrLf &amp; _
" FROM sys.databases d WITH(NOLOCK) " &amp; vbCrLf &amp; _
" JOIN sys.database_mirroring dm WITH(NOLOCK) ON d.database_id = dm.database_id " &amp; vbCrLf &amp; _
" WHERE [state] = 0 " &amp; vbCrLf &amp; _
" AND source_database_id IS NULL AND collation_name IS NOT NULL AND is_read_only = 0 AND is_in_standby = 0 AND user_access != 1; " &amp; vbCrLf &amp; _
" ELSE " &amp; vbCrLf &amp; _
" SELECT d.name, d.database_id, CAST(CASE WHEN d.replica_id IS NOT NULL OR dm.mirroring_guid IS NOT NULL OR d.is_in_standby = 1 THEN 1 ELSE 0 END AS BIT) AS needsMaster " &amp; vbCrLf &amp; _
" FROM sys.databases d WITH(NOLOCK) " &amp; vbCrLf &amp; _
" JOIN sys.database_mirroring dm WITH(NOLOCK) ON d.database_id = dm.database_id " &amp; vbCrLf &amp; _
" LEFT JOIN( " &amp; vbCrLf &amp; _
" SELECT drs.is_local, d2.database_id, drs.is_primary_replica AS db_is_primary_replica " &amp; vbCrLf &amp; _
" , CASE WHEN d2.replica_id IS NULL THEN 0 ELSE 1 END AS is_replica " &amp; vbCrLf &amp; _
" , CASE WHEN drs.is_primary_replica = 1 THEN ar.primary_role_allow_connections ELSE ar.secondary_role_allow_connections END AS role_allow_connections " &amp; vbCrLf &amp; _
" , CASE WHEN drs.is_suspended = 0 THEN -1 ELSE suspend_reason END AS db_suspended_state " &amp; vbCrLf &amp; _
" FROM sys.databases d2 WITH(NOLOCK) " &amp; vbCrLf &amp; _
" JOIN sys.dm_hadr_database_replica_states drs WITH(NOLOCK) ON drs.database_id = d2.database_id " &amp; vbCrLf &amp; _
" JOIN sys.availability_replicas ar WITH(NOLOCK) ON d2.replica_id = ar.replica_id " &amp; vbCrLf &amp; _
" ) df ON df.database_id = d.database_id " &amp; vbCrLf &amp; _
" WHERE d.[state] = 0 AND collation_name IS NOT NULL " &amp; vbCrLf &amp; _
" AND source_database_id IS NULL AND is_read_only = 0 AND is_in_standby = 0 AND user_access != 1 " &amp; vbCrLf &amp; _
" AND (df.database_id IS NULL OR (df.is_local = 1 AND ((df.is_replica = 0) OR (df.is_replica = 1 AND df.role_allow_connections &gt; 1 AND (db_suspended_state &lt;= 0 OR (db_suspended_state = 5 AND db_is_primary_replica = 1)))))) " &amp; vbCrLf &amp; _
" AND d.name NOT IN ('master', 'model', 'msdb', 'tempdb'); "

Set listDatabases = dbMasterConnection.ExecuteQuery(query)
If dbMasterConnection.HandleExecutionQueryErrorContinue(query, serverName, instanceName) Then
If Not listDatabases.EOF Then
Dim diskVolumesInfo : Set diskVolumesInfo = (new DiskVolumeInformation)(serverName)
Dim dbRows: dbRows = listDatabases.GetRows
Dim rowNumber
For rowNumber = LBound(dbRows, 2) To UBound(dbRows, 2)
Dim databaseName : databaseName = dbRows(0,rowNumber)
Dim databaseID : databaseID = dbRows(1,rowNumber)
Dim needsMaster : needsMaster = dbRows(2,rowNumber)

If (Len("" &amp; databaseName) &gt; 0) Then
dbMasterConnection.ADOConnection.DefaultDatabase = databaseName
If HandleSqlErrorContinue(dbMasterConnection.ADOConnection, "Cannot connect to database '" &amp; databaseName &amp; "'", instanceName) Then
query = "SET NOCOUNT ON " &amp; vbCrLf &amp; _
"SELECT df.file_id, df.size / 128.0 as fileSize, " &amp; vbCrLf &amp; _
" CASE WHEN df.max_size = -1 OR df.max_size = 268435456 THEN -1 ELSE df.max_size / 128.0 END as fileMaxSize, "

If Not needsMaster Then
query = query &amp; " df.physical_name " &amp; vbCrLf &amp; _
" FROM sys.data_spaces ds WITH (NOLOCK) " &amp; vbCrLf &amp; _
" INNER JOIN sys.database_files df WITH (NOLOCK) ON (ds.data_space_id = df.data_space_id) " &amp; vbCrLf &amp; _
" WHERE ds.type = 'FX'"
Else
query = query &amp; " mf.physical_name " &amp; vbCrLf &amp; _
" FROM sys.data_spaces ds " &amp; vbCrLf &amp; _
" INNER JOIN sys.database_files df WITH (NOLOCK) ON ds.data_space_id = df.data_space_id " &amp; vbCrLf &amp; _
" INNER JOIN sys.master_files mf WITH (NOLOCK) ON df.file_id = mf.file_id AND mf.database_id = ?" &amp; vbCrLf &amp; _
" WHERE ds.type = 'FX'"
End If

Dim listFiles : Set listFiles = dbMasterConnection.ExecuteQueryWithParams(query, databaseID)
If dbMasterConnection.HandleExecutionQueryErrorContinue(query, serverName, instanceName) Then
Do While Not listFiles.EOF
Dim ContainerId : ContainerId = listFiles("file_id").Value
Dim AllocatedSizeMB: AllocatedSizeMB = listFiles("fileSize").Value
Dim spaceCalculator : Set spaceCalculator = (new DBSpaceCalculator)(diskVolumesInfo)
Call spaceCalculator.CalculateFxFreeSpace(listFiles,false)

If Err.Number = 0 And Not spaceCalculator.IsError Then
Dim propertyBag : Set propertyBag = opsMgrAPI.scriptAPI.CreateTypedPropertyBag(2)
Call propertyBag.AddValue("Database", databaseName)
Call propertyBag.AddValue("ContainerId", ContainerId)
Call propertyBag.AddValue("FreeSpaceSpaceMB", spaceCalculator.FreeSpaceMB)
Call propertyBag.AddValue("FreeSpacePercent", spaceCalculator.FreeSpacePercent)
Call propertyBag.AddValue("DriveTotalSizeMB", spaceCalculator.LastTotalSize)
Call propertyBag.AddValue("AllocatedSizeMB", AllocatedSizeMB)
opsMgrAPI.scriptAPI.AddItem(propertyBag)
hasItems = True
Else
Call HandleErrorContinueEx("Error occurred during free space calculation for database '" &amp; databaseName &amp; "'", instanceName)
If spaceCalculator.IsError Then
Call GlobalErrorList.Add(FormatDbErrorMessage(spaceCalculator.ErrorMessage, instanceName, databaseName))
End If
End If
listFiles.MoveNext
Loop
End If
End If
Else
Logger.LogDebug("Error occurred during free space calculation for (database:'" &amp; databaseName &amp; "';databaseID:" &amp; databaseID &amp; ")")
End If
Next
End If
End If
dbMasterConnection.Close()

If hasItems Then
opsMgrAPI.scriptAPI.ReturnItems()
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>