This module type is used to discovery instances of Microsoft SQL Server 2012 Database Engine. The module queries the registry and WMI for installation information, and then connects to each instance of database engines found to gather property information about the instance.
Dim GlobalErrorList: Set GlobalErrorList = New ArrayList
Function IsValidObject(ByVal oObject)
IsValidObject = False
If IsObject(oObject) Then
If Not oObject Is Nothing Then
IsValidObject = True
End If
End If
End Function
Function MomCreateObject(ByVal sProgramId)
Dim oError
Set oError = New Error
On Error Resume Next
Set MomCreateObject = CreateObject(sProgramId)
oError.Save
On Error GoTo 0
If oError.Number <> 0 Then ThrowScriptError "Unable to create automation object '" & sProgramId & "'", oError
End Function
Public Function GetSQLServiceName(sInstance)
If sInstance = SQL_DEFAULT Then
GetSQLServiceName = SQL_DEFAULT
Else
GetSQLServiceName = "MSSQL$" & sInstance
End If
End Function
'The function returns service or "Unknown" state
'Input:
' server - compute name
' service - system service name
'Output:
' service state or "Unknown" state
Function GetServiceState( sTargetComputer, sServiceName)
On Error Resume Next
Dim sNamespace, sQuery, oWMI, objClasses, sState
sNamespace = "winmgmts://" & sTargetComputer & "/root/cimv2"
sQuery = "SELECT State FROM Win32_Service where Name = """ & EscapeWQLString(sServiceName) & """"
Set oWMI = GetObject(sNamespace)
Set objClasses = oWMI.ExecQuery(sQuery)
if objClasses.Count >= 1 Then
sState = GetFirstItemFromWMIQuery(objClasses).Properties_.Item("State")
End If
If Err.number <> 0 Or objClasses.Count = 0 Then
sState = "Unknown"
End If
Err.Clear
GetServiceState = sState
End Function
'#Include File:SQL2012Constants.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
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) >= 1 Then
m_minor = CLng(parts(1))
If UBound(parts) >= 2 Then
m_build = CLng(parts(2))
If UBound(parts) >= 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 <> 0 Then
CompareTo = d
Exit Function
End If
d = m_minor - v.Minor
If d <> 0 Then
CompareTo = d
Exit Function
End If
d = m_build - v.Build
If d <> 0 Then
CompareTo = d
Exit Function
End If
d = m_revision - v.Revision
CompareTo = d
End Function
Public Function ToString()
ToString = "" & m_major & "." & m_minor & "." & m_build & "." & 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
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) > 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) >= 0 And (vVersion.ToString() = MAX_DRIVER_VERSION_STR Or vMinVersion.CompareTo(vMaxVersion) = 0 Or vVersion.CompareTo(vMaxVersion) < 0)
End Function
Public Function MatchName(sDriverName)
Dim matches
Set matches = m_nameRegex.Execute(sDriverName)
If matches.Count > 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 > 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 = &H80000002
Set oRegistry = GetObject("winmgmts:\\" & m_computerId & "\root\default:StdRegProv")
oRegistry.GetStringValue HKEY_LOCAL_MACHINE, "SOFTWARE\ODBC\ODBCINST.INI\" & 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) < 0
End Property
End Class
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)))
' 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 <> 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) >= 0 And _
driver.DriverVersion.CompareTo(selected.DriverVersion) >= 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
On Error GoTo 0
Set oRegistry = GetObject("winmgmts:\\.\root\default:StdRegProv")
Call oRegistry.GetStringValue(HKEY_LOCAL_MACHINE, "SOFTWARE\ODBC\ODBCINST.INI\ODBC Drivers", driverName, isInstalled)
Dim selectorRule
For Each selectorRule In m_selectorRules
If isInstalled <> "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
Private Sub ProcessSystemOdbcDrivers(protocolsAreIntersected)
Dim oRegistry, driverNames, paramValueTypes, i, oError
Set oError = New Error
Set oRegistry = GetObject("winmgmts:\\" & m_computerId & "\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 <> 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 > currentName Then
currentName = objItem.Name
End If
Next
GetNsNameWithHighestVersion = rootNs & "\" & 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 <> 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 > 0) And (Err.Number Is 0) Then
Dim protocolsArr: Set protocolsArr = New ArrayList
Dim protocolItem
For Each protocolItem In oQuery
If protocolItem.ProtocolOrder > 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) = "[" & (oError.Number and 65535) & "][" & oError.Source & "] " & 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) >= 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
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
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) & "-" &_
Right("0" & DatePart("m", objDate), 2) & "-" &_
Right("0" & DatePart("d", objDate), 2) &_
"T" &_
Right("0" & DatePart("h", objDate), 2) & ":" &_
Right("0" & DatePart("n", objDate), 2) & ":" &_
Right("0" & DatePart("s", objDate), 2) &_
"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))
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) > nSeconds
End function
End Class
Function GetCacheKey(stateMpPrefix, sKeyName)
Dim oApi: Set oApi = CreateObject("MOM.ScriptAPI")
Dim regKey: regKey = oAPI.GetScriptStateKeyPath(ManagementGroupID)
regKey = regKey & "\" & stateMpPrefix & "\" & sKeyName
GetCacheKey = regKey
End Function
Function GetStringValueFromCache(sKeyName, sValueName, cacheExpirationTime)
Dim stateMpPrefix: stateMpPrefix = "SQLMPSP1"
Dim sDateValueName: sDateValueName = sValueName & "_CreationTime"
Dim udo: Set udo = New UtcDateOperations
Dim oReg: Set oReg = New Registry
Dim regKey: regKey = GetCacheKey(stateMpPrefix, sKeyName)
Dim lErrCode
Dim sDate: sDate = oReg.ReadStringValue(regKey, sDateValueName, lErrCode)
If lErrCode <> oReg.SUCCESS Then
Exit Function
End If
Dim sValue: sValue = oReg.ReadStringValue(regKey, sValueName, lErrCode)
If lErrCode <> 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 = "SQLMPSP1"
Dim sDateValueName: sDateValueName = sValueName & "_CreationTime"
Dim udo: Set udo = New UtcDateOperations
Dim oReg: Set oReg = New Registry
Dim regKey: regKey = GetCacheKey(stateMpPrefix, sKeyName)
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 '" & query & "' 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 = '" & escapedServiceName & "'", "PropertyNumValue")
Dim hostName
If isClustered = 0 Then
hostName = GetWmiSingleValue(wmiProvider, "SELECT HostName FROM SqlService WHERE SQLServiceType = 1 AND ServiceName = '" & escapedServiceName & "'", "HostName")
Else
hostName = GetWmiSingleValue(wmiProvider, "SELECT PropertyStrValue FROM SqlServiceAdvancedProperty WHERE PropertyName = 'VSNAME' AND SqlServiceType = 1 AND ServiceName = '" & escapedServiceName & "'", "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 & "_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) & "," & tcpPort
End If
GetDataSource = dataSource
End Function
Function BuildDataSourceFromParts(computerName, instanceName, tcpPort)
Dim dataSource : dataSource = computerName
If instanceName <> "MSSQLSERVER" Then
dataSource = computerName & "\" & instanceName
End If
BuildDataSourceFromParts = GetDataSource(dataSource, tcpPort)
End Function
Function GetConnectionString(driverName, dataSource, databaseName)
GetConnectionString = "Driver=" & EscapeConnStringValue(driverName) & ";Server=" & EscapeConnStringValue(dataSource) & ";Database=" & EscapeConnStringValue(databaseName) & ";Trusted_Connection=yes;"
End Function
Function GetEnabledSqlServerProtocols(namespaceName, computerName, instanceName)
Dim oWMI: Set oWMI = GetObject("winmgmts:\\" & computerName & "\root\Microsoft\SqlServer\" & namespaceName)
Dim oQuery: Set oQuery = oWMI.ExecQuery("SELECT ProtocolName, Enabled FROM ServerNetworkProtocol WHERE InstanceName = '"& EscapeWQLString(instanceName) &"'")
If oQuery.Count > 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:\\" & computerName & "\root\Microsoft\SqlServer\"& SQL_WMI_NAMESPACE)
Set oQuery = oWMI.ExecQuery("SELECT * FROM ServerNetworkProtocolProperty WHERE ProtocolName = 'Tcp' AND InstanceName = '"& EscapeWQLString(instanceName) &"' AND PropertyName = 'ListenOnAllIPs'")
If oQuery.Count >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 = '"& EscapeWQLString(instanceName) &"' AND IPAddressName = 'IPAll' AND (PropertyName = 'TcpPort' OR PropertyName = 'TcpDynamicPorts') AND PropertyStrVal <> ''")
If oQuery.Count > 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 = '"& EscapeWQLString(instanceName) &"' AND IPAddressName <> '' AND PropertyName = 'Enabled' AND PropertyNumVal = 1")
Dim ipItem
If oQuery.Count > 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 = '" + EscapeWQLString(instanceName) + "' AND IPAddressName = '" + EscapeWQLString(ipAddressName) + "' AND PropertyName = 'IpAddress' AND PropertyStrVal != ''")
If oQuery2.Count > 0 Then
Dim ipAddress : ipAddress = GetFirstItemFromWMIQuery(oQuery2).PropertyStrVal
Dim oQuery3: Set oQuery3 = oWMI.ExecQuery("SELECT * FROM ServerNetworkProtocolProperty WHERE ProtocolName = 'Tcp' AND InstanceName = '"& EscapeWQLString(instanceName) &"' AND IPAddressName = '"& EscapeWQLString(ipAddressName) &"' AND (PropertyName = 'TcpPort' OR PropertyName = 'TcpDynamicPorts') AND PropertyStrVal <> ''")
If oQuery3.Count > 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) > 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 " & hostName & "\" & instanceName & ", but got " & queryServerName & "\" & queryInstanceName & "."
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.State <> 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 '" & dataSource & "' failed: " & 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" & "\" & hostValueName & "\" & instanceValueName
Dim connectionStringPath: connectionStringPath = paramsPath & "\" & databaseName
connectionString = GetStringValueFromCache(connectionStringPath, "TargetDataSource", cacheExpirationTime)
Dim timeout: timeout = GetStringValueFromCache(paramsPath , "ConnectionTimeout", cacheExpirationTime)
Dim netBiosHostName: netBiosHostName = GetStringValueFromCache("SqlHostNames", hostValueName, cacheExpirationTime)
If connectionString <> "" And timeout <> "" And netBiosHostName <> "" 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 <> 0 Then
GlobalErrorList.Add "Cannot get target instance machine's NetBios host name." & vbNewLine &_
"Computer name: " & machineName & vbNewLine &_
"Error number: " & lastError.Number & vbNewLine &_
"Error description:" & lastError.Description
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 <> 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:" & 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:" & vbNewLine & 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" & "\" & hostValueName & "\" & instanceValueName
connectionString = GetStringValueFromCache(paramsPath, "TargetDataSource", cacheExpirationTime)
Dim connectionStringPath: connectionStringPath = paramsPath & "\" & databaseName
Dim timeout: timeout = GetStringValueFromCache(connectionStringPath , "ConnectionTimeout", cacheExpirationTime)
Dim netBiosHostName: netBiosHostName = GetStringValueFromCache("SqlHostNames", hostValueName, cacheExpirationTime)
If connectionString <> "" And timeout <> "" And netBiosHostName <> "" 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 <> 0 Then
GlobalErrorList.Add "Cannot get target instance machine's NetBios host name." & vbNewLine &_
"Computer name: " & machineName & vbNewLine &_
"Error number: " & lastError.Number & vbNewLine &_
"Error description:" & lastError.Description
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 <> 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:" & 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:" & vbNewLine & Join(errorMessageList.ItemsArray, vbNewLine)
End Function
Public Sub Save()
m_lNumber = Err.Number
m_sSource = Err.Source
m_sDescription = Err.Description
m_sHelpContext = Err.HelpContext
m_sHelpFile = Err.HelpFile
End Sub
Public Sub Raise()
Err.Raise m_lNumber, m_sSource, m_sDescription, m_sHelpFile, m_sHelpContext
End Sub
Public Sub Clear()
m_lNumber = 0
m_sSource = ""
m_sDescription = ""
m_sHelpContext = ""
m_sHelpFile = ""
End Sub
Public Default Property Get Number()
Number = m_lNumber
End Property
Public Property Get Source()
Source = m_sSource
End Property
Public Property Get Description()
Description = m_sDescription
End Property
Public Property Get HelpContext()
HelpContext = m_sHelpContext
End Property
Public Property Get HelpFile()
HelpFile = m_sHelpFile
End Property
End Class
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 < 0 Or index > UBound(m_itemArray) Then
Exit Sub
End If
Dim newArr: newArr = Array()
Dim i
For i = 0 To UBound(m_itemArray)
If i <> 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) < 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)
Dim msg
If Err.number <> 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 & " """ & argument & """"
Next
ScriptInfo = commandLineInfo
End Function
End Class
Function FormatErrorMessage(customMessage, instanceName)
FormatErrorMessage = customMessage
If Err.number <> 0 Then
Dim msg
msg =_
" Error Number: " & CStr(Err.number) & VbCrLf & _
" Description: " & Err.Description
If Not IsEmpty(instanceName) And instanceName <> "" Then
msg = msg & VbCrLf & " Instance: " & instanceName
End If
If Not IsEmpty(customMessage) And customMessage <> "" Then
msg = customMessage & VbCrLf & msg & VbCrLf
End If
FormatErrorMessage = msg
End If
End Function
Function FormatDbErrorMessage(message, instanceName, dbName)
FormatDbErrorMessage = message & VbCrLf & _
" Instance: " & instanceName & VbCrLf & _
" Database: " & dbName
End Function
Function ThrowScriptErrorNoAbort(ByVal sMessage, ByVal oErr)
On Error Resume Next
Dim errorText: errorText = sMessage & ": " & oErr.Description
GlobalErrorList.Add errorText
End Function
Function ThrowScriptError(Byval sMessage, ByVal oErr)
On Error Resume Next
Dim oAPITemp: Set oAPITemp = MOMCreateObject("MOM.ScriptAPI")
oAPITemp.LogScriptEvent ("Management Group: " + ManagementGroupName + ". Script: " + WScript.ScriptName + ". Version: " + MANAGEMENT_PACK_VERSION), 4001, 1, sMessage & ". " & oErr.Description
Quit()
End Function
Sub HandleError(customMessage)
Dim localLogger
If Err.number <> 0 Then
Set localLogger = new ScriptLogger
Call localLogger.LogFormattedError(customMessage)
Call Wscript.Quit(0)
End If
End Sub
Function HandleErrorContinue(customMessage)
Dim localLogger
HandleErrorContinue = True
If Err.number <> 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 <> 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 <> 0 Then
HandleSqlErrorContinue = False
Dim sqlErr
Dim e: Set e = new Error
e.Save
On Error Resume Next
If adoConnection.Errors.Count > 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:"& vbNewLine & Join(GlobalErrorList.ItemsArray, vbNewLine & 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: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
Public Sub Connect(ByVal sHostName)
Set m_oReg = GetObject("winmgmts://" & sHostName & "/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
m_lSuppressionFlags = 0
Hive = HKEY_LOCAL_MACHINE
End Sub
Public Function Connect(ByVal sHostName)
Connect = False
m_sHost = sHostName
On Error Resume Next
m_oRegistry.Connect sHostName
m_oError.Save
On Error GoTo 0
If m_oError.Number <> 0 Then
ThrowScriptErrorNoAbort "Failed to connect to the WMI registry provider on " & sHostName , m_oError
Else
Connect = True
End If
End Function
Public Property Get Hive()
Hive = m_oRegistry.Hive
End Property
Public Property Let Hive(ByVal lHive)
Select Case lHive
Case HKEY_CLASSES_ROOT
m_sHive = "HKCR"
Case HKEY_CURRENT_USER
m_sHive = "HKCU"
Case HKEY_LOCAL_MACHINE
m_sHive = "HKLM"
Case HKEY_USERS
m_sHive = "HKU"
Case HKEY_CURRENT_CONFIG
m_sHive = "HKCC"
Case HKEY_DYN_DATA
m_sHive = "HKDD"
Case Else
m_sHive = "Invalid"
End Select
m_oRegistry.Hive = lHive
End Property
Public Property Let SuppressionFlags(ByVal lValue)
m_lSuppressionFlags = lValue
End Property
Public Property Get SuppressionFlags()
SuppressionFlags = m_lSuppressionFlags
End Property
Public Function ReadDWORDValue(ByVal sKeyPath, ByVal sValueName, ByRef lResult)
ReadDWORDValue = Null
On Error Resume Next
ReadDWORDValue = m_oRegistry.ReadDWORDValue(sKeyPath, sValueName, lResult)
m_oError.Save
On Error GoTo 0
If m_oError.Number <> 0 Then
ThrowScriptErrorNoAbort GET_ERROR_READING_REGISTRY_MESSAGE(m_sHost, m_sHive, sKeyPath, sValueName), m_oError
Exit Function
End If
HandleResult m_sHost, m_sHive, sKeyPath, sValueName, lResult
End Function
Public Function ReadStringValue(ByVal sKeyPath, ByVal sValueName, ByRef lResult)
ReadStringValue = Null
On Error Resume Next
ReadStringValue = m_oRegistry.ReadStringValue(sKeyPath, sValueName, lResult)
m_oError.Save
On Error GoTo 0
If m_oError.Number <> 0 Then
ThrowScriptErrorNoAbort GET_ERROR_READING_REGISTRY_MESSAGE(m_sHost, m_sHive, sKeyPath, sValueName), m_oError
Exit Function
End If
HandleResult m_sHost, m_sHive, sKeyPath, sValueName, lResult
End Function
Public Function ReadMultiStringValue(ByVal sKeyPath, ByVal sValueName, ByRef lResult)
ReadMultiStringValue = Null
On Error Resume Next
ReadMultiStringValue = m_oRegistry.ReadMultiStringValue(sKeyPath, sValueName, lResult)
m_oError.Save
On Error GoTo 0
If m_oError.Number <> 0 Then
ThrowScriptErrorNoAbort GET_ERROR_READING_REGISTRY_MESSAGE(m_sHost, m_sHive, sKeyPath, sValueName), m_oError
Exit Function
End If
HandleResult m_sHost, m_sHive, sKeyPath, sValueName, lResult
End Function
Public Function EnumKeys(ByVal sKeyPath, ByRef lResult)
EnumKeys = Null
On Error Resume Next
EnumKeys = m_oRegistry.EnumKeys(sKeyPath, lResult)
m_oError.Save
On Error GoTo 0
If m_oError.Number <> 0 Then
ThrowScriptErrorNoAbort GET_ERROR_READING_KEY_MESSAGE(m_sHost, m_sHive, sKeyPath), m_oError
Exit Function
End If
HandleResult m_sHost, m_sHive, sKeyPath, "", lResult
End Function
Public Function EnumValues(ByVal sKeyPath, ByRef lResult)
EnumValues = Null
On Error Resume Next
EnumValues = m_oRegistry.EnumValues(sKeyPath, lResult)
m_oError.Save
On Error GoTo 0
If m_oError.Number <> 0 Then
ThrowScriptErrorNoAbort GET_ERROR_READING_KEY_MESSAGE(m_sHost, m_sHive, sKeyPath), m_oError
Exit Function
End If
HandleResult m_sHost, m_sHive, sKeyPath, "", lResult
End Function
Public Function CreateKey(ByVal sKeyPath)
Dim lResult
On Error Resume Next
lResult = m_oRegistry.CreateKey(sKeyPath)
m_oError.Save
On Error GoTo 0
If m_oError.Number <> 0 Then
ThrowScriptErrorNoAbort GET_ERROR_CREATING_KEY_MESSAGE(m_sHost, m_sHive, sKeyPath), m_oError
Exit Function
End If
HandleResult m_sHost, m_sHive, sKeyPath, "", lResult
CreateKey = lResult
End Function
Public Function WriteStringValue(ByVal sKeyPath, ByVal sValueName, ByVal sValue)
Dim lResult
On Error Resume Next
lResult = m_oRegistry.WriteStringValue(sKeyPath, sValueName, sValue)
m_oError.Save
On Error GoTo 0
If m_oError.Number <> 0 Then
ThrowScriptErrorNoAbort GET_ERROR_WRITING_REGISTRY_MESSAGE(m_sHost, m_sHive, sKeyPath, sValueName), m_oError
Exit Function
End If
HandleResult m_sHost, m_sHive, sKeyPath, sValueName, lResult
WriteStringValue = lResult
End Function
Public Function DeleteValue(ByVal sKeyPath, ByVal sValueName)
Dim lResult
On Error Resume Next
lResult = m_oRegistry.DeleteValue(sKeyPath, sValueName)
m_oError.Save
On Error GoTo 0
If m_oError.Number <> 0 Then
ThrowScriptErrorNoAbort GET_ERROR_DELETING_VALUE_MESSAGE(m_sHost, m_sHive, sKeyPath, sValueName), m_oError
Exit Function
End If
'#doc
'This method seems to return key not found even if it is the value that is not found.
'#end doc
If lResult = ERROR_KEY_NOT_FOUND Then lResult = ERROR_VALUE_NOT_FOUND
HandleResult m_sHost, m_sHive, sKeyPath, sValueName, lResult
DeleteValue = lResult
End Function
Public Function ReadBinaryValue(ByVal sKeyPath, ByVal sValueName, ByRef lResult)
ReadBinaryValue = Null
On Error Resume Next
ReadBinaryValue = m_oRegistry.ReadBinaryValue(sKeyPath, sValueName, lResult)
m_oError.Save
On Error GoTo 0
If m_oError.Number <> 0 Then
ThrowScriptErrorNoAbort GET_ERROR_READING_REGISTRY_MESSAGE(m_sHost, m_sHive, sKeyPath, sValueName), m_oError
Exit Function
End If
HandleResult m_sHost, m_sHive, sKeyPath, sValueName, lResult
End Function
Private Sub HandleResult(ByVal sHost, ByVal sHive, ByVal sKeyPath, ByVal sValueName, ByVal lResult)
Select Case lResult
Case SUCCESS
Exit Sub
Case ERROR_ACCESS_DENIED
If (SuppressionFlags And SUPPRESS_ACCESS_DENIED) = 0 Then
ThrowScriptErrorNoAbort GET_REGISTRY_ACCESS_DENIED_MESSAGE(sHost, sHive, sKeyPath, sValueName), Err
Else
WScript.Echo GET_REGISTRY_ACCESS_DENIED_MESSAGE(sHost, sHive, sKeyPath, sValueName)
End If
Case ERROR_VALUE_NOT_FOUND
If (SuppressionFlags And SUPPRESS_VALUE_NOT_FOUND) = 0 Then
ThrowScriptErrorNoAbort GET_REGISTRY_VALUE_NOT_FOUND_MESSAGE(sHost, sHive, sKeyPath, sValueName), Err
Else
WScript.Echo GET_REGISTRY_VALUE_NOT_FOUND_MESSAGE(sHost, sHive, sKeyPath, sValueName)
End If
Case ERROR_KEY_NOT_FOUND
If (SuppressionFlags And SUPPRESS_KEY_NOT_FOUND) = 0 Then
ThrowScriptErrorNoAbort GET_REGISTRY_KEY_NOT_FOUND_MESSAGE(sHost, sHive, sKeyPath), Err
Else
WScript.Echo GET_REGISTRY_KEY_NOT_FOUND_MESSAGE(sHost, sHive, sKeyPath)
End If
Case Else
If (SuppressionFlags And SUPPRESS_ALL) = 0 Then
ThrowScriptErrorNoAbort GET_ERROR_READING_REGISTRY_MESSAGE(sHost, sHive, sKeyPath, sValueName), Err
Else
WScript.Echo GET_ERROR_READING_REGISTRY_MESSAGE(sHost, sHive, sKeyPath, sValueName)
End If
End Select
End Sub
Private Function GET_REGISTRY_ACCESS_DENIED_MESSAGE(ByVal sHost, ByVal sHive, ByVal sRegKey, ByVal sRegValue)
Const REGISTRY_ACCESS_DENIED_MESSAGE = "Access denied while reading registry value [\\{Host}\{Hive}\{RegKey}\{RegValue}]"
If sRegValue = "" Then sRegValue = DEFAULT_VALUE_NAME
Dim sResult
sResult = Replace(REGISTRY_ACCESS_DENIED_MESSAGE, "{RegKey}", sRegKey)
sResult = Replace(sResult, "{Hive}", sHive)
sResult = Replace(sResult, "{Host}", sHost)
GET_REGISTRY_ACCESS_DENIED_MESSAGE = Replace(sResult, "{RegValue}", sRegValue)
End Function
Private Function GET_REGISTRY_VALUE_NOT_FOUND_MESSAGE(ByVal sHost, ByVal sHive, ByVal sRegKey, ByVal sRegValue)
Const REGISTRY_VALUE_NOT_FOUND_MESSAGE = "Registry value [\\{Host}\{Hive}\{RegKey}\{RegValue}] not found"
If sRegValue = "" Then sRegValue = DEFAULT_VALUE_NAME
Dim sResult
sResult = Replace(REGISTRY_VALUE_NOT_FOUND_MESSAGE, "{RegKey}", sRegKey)
sResult = Replace(sResult, "{Hive}", sHive)
sResult = Replace(sResult, "{Host}", sHost)
GET_REGISTRY_VALUE_NOT_FOUND_MESSAGE = Replace(sResult, "{RegValue}", sRegValue)
End Function
Private Function GET_ERROR_READING_REGISTRY_MESSAGE(ByVal sHost, ByVal sHive, ByVal sRegKey, ByVal sRegValue)
Const ERROR_READING_REGISTRY_MESSAGE = "Error while reading registry value [\\{Host}\{Hive}\{RegKey}\{RegValue}]"
If sRegValue = "" Then sRegValue = DEFAULT_VALUE_NAME
Dim sResult
sResult = Replace(ERROR_READING_REGISTRY_MESSAGE, "{RegKey}", sRegKey)
sResult = Replace(sResult, "{Hive}", sHive)
sResult = Replace(sResult, "{Host}", sHost)
GET_ERROR_READING_REGISTRY_MESSAGE = Replace(sResult, "{RegValue}", sRegValue)
End Function
Private Function GET_REGISTRY_KEY_NOT_FOUND_MESSAGE(ByVal sHost, ByVal sHive, ByVal sRegKey)
Const REGISTRY_KEY_NOT_FOUND_MESSAGE = "Registry key [\\{Host}\{Hive}\{RegKey}] not found"
Dim sResult
sResult = Replace(REGISTRY_KEY_NOT_FOUND_MESSAGE, "{Hive}", sHive)
sResult = Replace(sResult, "{Host}", sHost)
GET_REGISTRY_KEY_NOT_FOUND_MESSAGE = Replace(sResult, "{RegKey}", sRegKey)
End Function
Private Function GET_ERROR_READING_KEY_MESSAGE(ByVal sHost, ByVal sHive, ByVal sRegKey)
Const ERROR_READING_KEY_MESSAGE = "Error while reading registry key [\\{Host}\{Hive}\{RegKey}]"
Dim sResult
sResult = Replace(ERROR_READING_KEY_MESSAGE, "{Hive}", sHive)
sResult = Replace(sResult, "{Host}", sHost)
GET_ERROR_READING_KEY_MESSAGE = Replace(sResult, "{RegKey}", sRegKey)
End Function
Private Function GET_ERROR_CREATING_KEY_MESSAGE(ByVal sHost, ByVal sHive, ByVal sRegKey)
Const ERROR_CREATING_KEY_MESSAGE = "Error while creating registry key [\\{Host}\{Hive}\{RegKey}]"
Dim sResult
sResult = Replace(ERROR_CREATING_KEY_MESSAGE, "{Hive}", sHive)
sResult = Replace(sResult, "{Host}", sHost)
GET_ERROR_CREATING_KEY_MESSAGE = Replace(sResult, "{RegKey}", sRegKey)
End Function
Private Function GET_ERROR_WRITING_REGISTRY_MESSAGE(ByVal sHost, ByVal sHive, ByVal sRegKey, ByVal sRegValue)
Const ERROR_WRITING_REGISTRY_MESSAGE = "Error while writing registry value [\\{Host}\{Hive}\{RegKey}\{RegValue}]"
If sRegValue = "" Then sRegValue = DEFAULT_VALUE_NAME
Dim sResult
sResult = Replace(ERROR_WRITING_REGISTRY_MESSAGE, "{RegKey}", sRegKey)
sResult = Replace(sResult, "{Hive}", sHive)
sResult = Replace(sResult, "{Host}", sHost)
GET_ERROR_WRITING_REGISTRY_MESSAGE = Replace(sResult, "{RegValue}", sRegValue)
End Function
Private Function GET_ERROR_DELETING_VALUE_MESSAGE(ByVal sHost, ByVal sHive, ByVal sRegKey, ByVal sRegValue)
Const ERROR_DELETING_VALUE_MESSAGE = "Error while deleting registry value [\\{Host}\{Hive}\{RegKey}\{RegValue}]"
If sRegValue = "" Then sRegValue = DEFAULT_VALUE_NAME
Dim sResult
sResult = Replace(ERROR_DELETING_VALUE_MESSAGE, "{RegKey}", sRegKey)
sResult = Replace(sResult, "{Hive}", sHive)
sResult = Replace(sResult, "{Host}", sHost)
GET_ERROR_DELETING_VALUE_MESSAGE = Replace(sResult, "{RegValue}", sRegValue)
End Function
End Class
Class RegistryWrapper
Private REG_SOFTWARE
Private REG_SOFTWARE_WOW64
Private Sub Class_Initialize()
REG_SOFTWARE = "Software"
REG_SOFTWARE_WOW64 = "Software\Wow6432Node"
Set m_oSafeRegistry = New SafeRegistry
m_bConnectedToRegistry = m_oSafeRegistry.Connect(TargetComputer)
m_oSafeRegistry.SuppressionFlags = (m_oSafeRegistry.SUPPRESS_KEY_NOT_FOUND Or m_oSafeRegistry.SUPPRESS_VALUE_NOT_FOUND)
End Sub
Public Property Get ConnectedToRegistry
ConnectedToRegistry = m_bConnectedToRegistry
End Property
Public Function ReadRegistryStringValue(sKeyPath, sValueName)
Dim lResult
ReadRegistryStringValue = m_oSafeRegistry.ReadStringValue(sKeyPath, sValueName, lResult)
End Function
Public Function ReadRegistryMultiStringValue(sKeyPath, sValueName)
Dim lResult
ReadRegistryMultiStringValue = m_oSafeRegistry.ReadMultiStringValue(sKeyPath, sValueName, lResult)
End Function
Public Function ReadRegistryDWORDValue(sKeyPath, sValueName)
Dim lResult
ReadRegistryDWORDValue = m_oSafeRegistry.ReadDWORDValue(sKeyPath, sValueName, lResult)
End Function
Public Function GetSoftwarePath(ByVal sRelativePath, ByVal bIsWOW64)
If (bIsWOW64) Then
GetSoftwarePath = REG_SOFTWARE & "\" & sRelativePath
Else
GetSoftwarePath = REG_SOFTWARE_WOW64 & "\" & sRelativePath
End If
End Function
End Class
'#Include File:Util.vbs
' Used to say to LogMessage when/how to print the message.
Public DBG_NONE
Public DBG_ERROR
Public DBG_WARNING
Public DBG_TRACE
Public HKEY_LOCAL_MACHINE
'by default only errors are logged
m_nDebugLevel = DBG_ERROR
Set m_oSafeRegistry = New SafeRegistry
m_oSafeRegistry.Connect(TargetComputer)
m_oSafeRegistry.SuppressionFlags = (m_oSafeRegistry.SUPPRESS_KEY_NOT_FOUND Or m_oSafeRegistry.SUPPRESS_VALUE_NOT_FOUND)
End Sub
'=============
' Method: SetDebugLevel
' Description: To change the debugging output level of information
' generated by this utility.
' Parameters:
' nLevel - Level, either DBG_NONE, DBG_TRACE,
' DBG_WARNING or DBG_ERROR
'=============
Public Sub SetDebugLevel(ByVal nLevel)
m_nDebugLevel = nLevel
End Sub
'=============
' Method: LogMessage
' Description: Log a debug message to ScriptContext
' Parameters:
' nLevel - Debug level for the message that we're logging.
' strMessage - The message to write to the trace.
'=============
Public Sub LogMessage( _
ByVal nLevel, _
ByVal strMessage _
)
If (nLevel >= m_nDebugLevel) Then
If (nLevel = DBG_ERROR) Then
WScript.Echo "[Error]: " & strMessage
ElseIf (nLevel = DBG_WARNING) Then
WScript.Echo "[Warning]: " & strMessage
ElseIf (nLevel = DBG_TRACE) Then
WScript.Echo "[Trace]:" & strMessage
End If
End If
End Sub
'=============
' Method: SplitVerStr
' Description: Split a version string into integers.
' Parameters:
' strVer - The version string.
' iMajor - The output integer for major version.
' iMinor - The output integer for minor version.
'=============
Function SplitVerStr(ByVal strVer, ByRef iMajor, ByRef iMinor)
Dim iPos
Dim strMinor
iPos = InStr(strVer, ".")
If 0 = iPos Then
iMajor = CInt(strVer)
iMinor = 0
Exit Function
End If
If 0 = iPos Then
iMinor = CInt(strMinor)
Else
iMinor = CInt(Left(strMinor, iPos))
End If
End Function
'=============
' Method: ReadRegistryValue
' Description: Used to read strings from the registry
' Parameters:
' Root - Root of the registry (HKEY_LOCAL_MACHINE, HKEY_USERS etc. Refer to constants defined earlier)
' strKeyPath - Key path for the Registry key to read
' (like "SOFTWARE\Microsoft\WindowsNT\CurrentVersion")
' strValueName - Name of the registry entry to read (like "SoftwareType")
'
' Returns:
' The value of the registry key specified. "Nothing" if it fails. Callee needs to handle null value return.
'=============
Public Function ReadRegistryValue(strKeyPath, strValueName)
Dim lResult
Dim strValueData
strValueData = m_oSafeRegistry.ReadStringValue(strKeyPath, strValueName, lResult)
If Not IsNull(strValueData) Then
Call LogMessage(DBG_TRACE, "Value of Registry Key: " & strKeyPath & "\" & strValueName & " = " & strValueData)
ReadRegistryValue = strValueData
Else
Call LogMessage(DBG_ERROR, "Reading Registry Key: " & strKeyPath & "\" & strValueName & " Failed!" )
ReadRegistryValue = Empty
End If
End Function
End Class
'#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}!\\" & ComputerName & "\" & 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 <> 0 Then
If (ErrAction And ErrAction_ThrowError) = ErrAction_ThrowError Then _
ThrowScriptErrorNoAbort "An error occurred while accessing WMI property: '" & sPropName & "'.", Err
If (ErrAction And ErrAction_Abort) = ErrAction_Abort Then _
Quit()
End If
On Error GoTo 0
If IsValidObject(oWmiProp) Then
sValue = oWmiProp.Value
If IsNull(sValue) Then
'
' If value is null, return blank to avoid any issues
'
WMIGetProperty = ""
Else
Select Case (oWmiProp.CIMType)
Case wbemCimtypeString, wbemCimtypeSint16, wbemCimtypeSint32, wbemCimtypeReal32, wbemCimtypeReal64, wbemCimtypeSint8, wbemCimtypeUint8, wbemCimtypeUint16, wbemCimtypeUint32, wbemCimtypeSint64, wbemCimtypeUint64:
If Not oWmiProp.IsArray Then
WMIGetProperty = Trim(CStr(sValue))
Else
WMIGetProperty = Join(sValue, ", ")
End If
Case wbemCimtypeBoolean:
If sValue = 1 Or UCase(sValue) = "TRUE" Then
WMIGetProperty = "True"
Else
WMIGetProperty = "False"
End If
Case wbemCimtypeDatetime:
Dim sTmpStrDate
'
' First attempt to convert the whole wmi date string
'
sTmpStrDate = Mid(sValue, 5, 2) & "/" & _
Mid(sValue, 7, 2) & "/" & _
Left(sValue, 4) & " " & _
Mid (sValue, 9, 2) & ":" & _
Mid(sValue, 11, 2) & ":" & _
Mid(sValue, 13, 2)
If IsDate(sTmpStrDate) Then
WMIGetProperty = CDate(sTmpStrDate)
Else
'
' Second, attempt just to convert the YYYYMMDD
'
sTmpStrDate = Mid(sValue, 5, 2) & "/" & _
Mid(sValue, 7, 2) & "/" & _
Left(sValue, 4)
If IsDate(sTmpStrDate) Then
WMIGetProperty = CDate(sTmpStrDate)
Else
'
' Nothing works - return passed in string
'
WMIGetProperty = sValue
End If
End If
Case Else:
WMIGetProperty = ""
End Select
End If
Else
If (ErrAction And ErrAction_ThrowError) = ErrAction_ThrowError Then _
ThrowScriptErrorNoAbort "An error occurred while accessing WMI property: '" & sPropName & "'.", Err
If (ErrAction And ErrAction_Abort) = ErrAction_Abort Then _
Quit()
WMIGetProperty = ""
End If
If (ErrAction And ErrAction_Trace) = ErrAction_Trace Then _
WScript.Echo " + " & sPropName & " :: '" & WMIGetProperty & "'"
End Function
Function WMIExecQuery(ByVal sNamespace, ByVal sQuery)
'
' WMIExecQuery :: Executes the WMI query and returns the result set.
'
'
Dim oWMI, oQuery, nInstanceCount
Dim e
Set e = New Error
On Error Resume Next
Set oWMI = GetObject(sNamespace)
e.Save
On Error GoTo 0
If IsEmpty(oWMI) Then
ThrowScriptErrorNoAbort "Unable to open WMI Namespace '" & sNamespace & "'. Check to see if the WMI service is enabled and running, and ensure this WMI namespace exists.", e
ThrowEmptyDiscoveryData
End If
On Error Resume Next
Set oQuery = oWMI.ExecQuery(sQuery)
e.Save
On Error GoTo 0
If IsEmpty(oQuery) Or e.Number <> 0 Then
ThrowScriptError "The Query '" & sQuery & "' returned an invalid result set. Please check to see if this is a valid WMI Query.", e
End If
'Determine if we queried a valid WMI class - Count will return 0 or empty
On Error Resume Next
nInstanceCount = oQuery.Count
e.Save
On Error GoTo 0
If e.Number <> 0 Then
ThrowScriptError "The Query '" & sQuery & "' did not return any valid instances. Please check to see if this is a valid WMI Query.", e
End If
Set WMIExecQuery = oQuery
End Function
Function GetFirstItemFromWMIQuery(ByRef oQuery)
ON ERROR RESUME NEXT
Err.Clear
Dim oResult: Set oResult = Nothing
Set oResult = oQuery.ItemIndex(0)
if Err.number <> 0 then
Err.Clear
Dim oObject
For Each oObject in oQuery
Set oResult = oObject
Exit For
Next
end if
Set GetFirstItemFromWMIQuery = oResult
End Function
'#Include File:SQLDBEngineDiscovery.vbs
'Copyright (c) Microsoft Corporation. All rights reserved.
' Discover instances of SQL Server DB Engines
' Targeted at Windows Server class - takes 4 or 5 arguments
' Works agentlessly and against Virtaul servers (Wolfpack cluster)
' Arg 0 : SourceID
' Arg 1 : MP Element ID
' Arg 2 : Computer ID
' Arg 3 : FQDN
' Arg 4 : NETBIOS Name (required for clustered SQL discovery)
' Arg 5 : Exlcuded instance list (prefixed with Exclude:)
' Arg 6 : Optional Boolean - true indicates this is a virtual Windows server (Wolfpack)
Dim SCRIPT_NAME : SCRIPT_NAME = "SQL Server " & SQL_VERSION & " DB Engine Discovery"
Dim TargetComputer
Dim TargetComputerID
Dim IsTargetVirtualServer
Dim SourceID
Dim ManagedEntityID
Dim TargetNetBIOSName
Dim ExcludeList
Dim g_oSQL
Dim g_oUtil
Dim g_List
Call Main()
'******************************************************************************
' Name - SQL - SQL Server Utility Class
'
Class SQL
Public HKEY_LOCAL_MACHINE
Public SQL_KEY_ROOT
Public SQL_KEY_ROOT_WOW64
Public SQL_KEY_ENGINE_INSTANCE_NAMES
Public SQL_KEY_ENGINE_INSTANCE_NAMES_WOW64
Public RS_KEY_ENGINE_INSTANCE_NAMES
Public RS_KEY_ENGINE_INSTANCE_NAMES_WOW64
Public SQL_TOOLS_PATH
Public SQL_TOOLS_PATH_WOW64
Public SQL_DEFAULT
Public SQL_KEY_NAMED
Public SQL_KEY_NAMED_WOW64
Public SQL_VAL_INSTINST
Public SERVICESTATE_GREEN
Public SERVICESTATE_YELLOW
Public SERVICESTATE_RED
Public DATABASE_EXCLUDE_FILENAME
Public DATABASE_EXCLUDE_DIRECTORY
Public JOB_EXCLUDE_FILENAME
Public JOB_EXCLUDE_DIRECTORY
Public STANDARD_SQLSERVICETYPE_SQLSERVER
Public STANDARD_SQLSERVICETYPE_SQLAGENT
Public STANDARD_SQLSERVICETYPE_MSSEARCH
Public STANDARD_SQLSERVICETYPE_MSDTS
Public STANDARD_SQLSERVICETYPE_OLAP
Public STANDARD_SQLSERVICETYPE_REPORT
Public STANDARD_SQLSERVICETYPE_SQLBROWSER
Public STANDARD_SQLSERVICETYPE_NOTIFICATION
Public SERVICEADVANCEDPROPERTY_TYPE_STRING
Public SERVICEADVANCEDPROPERTY_TYPE_FLAG
Public SERVICEADVANCEDPROPERTY_TYPE_NUMBER
Public SERVICEADVANCEDPROPERTY_NAME_VERSION
Public SERVICEADVANCEDPROPERTY_NAME_SPLEVEL
Public SERVICEADVANCEDPROPERTY_NAME_CLUSTERED
Public SERVICEADVANCEDPROPERTY_NAME_INSTALLPATH
Public SERVICEADVANCEDPROPERTY_NAME_DATAPATH
Public SERVICEADVANCEDPROPERTY_NAME_LANGUAGE
Public SERVICEADVANCEDPROPERTY_NAME_FILEVERSION
Public SERVICEADVANCEDPROPERTY_NAME_VSNAME
Public SERVICEADVANCEDPROPERTY_NAME_REGROOT
Public SERVICEADVANCEDPROPERTY_NAME_SKU
Public SERVICEADVANCEDPROPERTY_NAME_INSTANCEID
Public SERVICEADVANCEDPROPERTY_NAME_STARTUPPARAMETERS
Public SERVICEADVANCEDPROPERTY_NAME_SQLSTATES
Public SERVICEADVANCEDPROPERTY_NAME_ERRORREPORTING
Public SERVICEADVANCEDPROPERTY_NAME_DUMPDIR
Public SERVICEADVANCEDPROPERTY_NAME_SQMREPORTING
Public SERVICEADVANCEDPROPERTY_NAME_SKUNAME
Public SERVICEADVANCEDPROPERTY_NAME_ISWOW64
Public SERVICEADVANCEDPROPERTY_NAME_BROWSER
SQL_TOOLS_PATH = "SOFTWARE\Microsoft\Microsoft SQL Server\" & SQL_VERSION_NUMBER & "0\Tools\ClientSetup"
SQL_TOOLS_PATH_WOW64 = "SOFTWARE\Wow6432Node\Microsoft\Microsoft SQL Server\" & SQL_VERSION_NUMBER & "0\Tools\ClientSetup"
Set m_oSafeRegistry = New SafeRegistry
m_bConnectedToRegistry = m_oSafeRegistry.Connect(TargetComputer)
m_oSafeRegistry.SuppressionFlags = (m_oSafeRegistry.SUPPRESS_KEY_NOT_FOUND Or m_oSafeRegistry.SUPPRESS_VALUE_NOT_FOUND)
Public Property Get ConnectedToRegistry
ConnectedToRegistry = m_bConnectedToRegistry
End Property
'******************************************************************************
' Name: CreateConnectionFailureAlert
'
' Purpose: To generate an alert stating the reason for failing to connect to a SQL instance when it is running.
' Does nothing if the instance is not running.
'
' Parameters: sInstance, The SQL instance
' lErrNumber, The error number returned from the connection attempt
' sErrDescription, The error description returned from the connection attempt
'
' Returns: nothing
'
Public Sub CreateConnectionFailureAlert(sInstance, lErrNumber, sErrDescription)
If IsSQLServiceStarted(sInstance) = 1 Then
CreateAlert ALERT_WARNING, _
"SQL Server " & SQL_VERSION & " Service Availability", _
GetConnectionFailureMessage(sInstance, lErrNumber, sErrDescription), _
"", _
""
End If
End Sub
Sub WriteToEventLogAndExit(ByVal message)
Dim oAPITemp
Set oAPITemp = CreateObject("MOM.ScriptAPI")
oAPITemp.LogScriptEvent ("Management Group: " + ManagementGroupName + ". Script: " + WScript.ScriptName + ". Version: " + MANAGEMENT_PACK_VERSION), 4002, EVENT_TYPE_ERROR, message
WScript.Quit()
End Sub
'******************************************************************************
' Name: GetRunningInstances
'
' Purpose:
'
' Parameters:
'
' Returns:
'
Public Function GetRunningInstances(ByVal aInstances, ByRef aNonRunningInstances)
Dim sWQLNameList
Dim sInstance
If Not IsArray(aInstances) Then Exit Function
For Each sInstance In aInstances
If sWQLNameList <> "" Then sWQLNameList = sWQLNameList & " or "
sWQLNameList = sWQLNameList & "Name = '" & GetSQLServiceName(sInstance) & "'"
Next
If sWQLNameList <> "" Then
Dim sWQLQuery
sWQLQuery = "select Name from Win32_Service where (" & sWQLNameList & ")"
Dim sNamespace
sNamespace = "winmgmts://" & TargetComputer & "/root/cimv2"
Dim oRunning
Set oRunning = WMIExecQuery(sNamespace, sWQLQuery & " and State = 'Running'")
Dim oNotRunning
Set oNotRunning = WMIExecQuery(sNamespace, sWQLQuery & " and State <> 'Running'")
aNonRunningInstances = CreateSQLInstanceArray(oNotRunning)
End If
End Function
'******************************************************************************
' Name: CreateSQLInstanceArray
'
' Purpose:
'
' Parameters:
'
' Returns:
'
Private Function CreateSQLInstanceArray(ByVal oServiceObjectSet)
Dim aInstances
If oServiceObjectSet.Count > 0 Then
ReDim aInstances(oServiceObjectSet.Count - 1)
Dim i
i = 0
Dim oService
For Each oService in oServiceObjectSet
aInstances(i) = GetSQLInstanceNameFromServiceName(oService.Name)
i = i + 1
Next
End If
CreateSQLInstanceArray = aInstances
End Function
'******************************************************************************
' Name: GetInstanceKeyRoot
'
' Purpose: Gets the path to the root registry key for the instance's
' registry values
'
' Parameters: sInstance - The SQL instance name
'
' Returns: the root registry path
'
Public Function GetInstanceKeyRoot(ByVal sServerType, ByVal sInstance, ByVal bIs64Bit)
Dim sInternalInstanceName
Select Case sServerType
Case "SQL"
If (bIs64Bit) Then
sInternalInstanceName = ReadRegistryStringValue(SQL_KEY_ENGINE_INSTANCE_NAMES_WOW64, sInstance)
Else
sInternalInstanceName = ReadRegistryStringValue(SQL_KEY_ENGINE_INSTANCE_NAMES, sInstance)
End If
Case "RS"
If (bIs64Bit) Then
sInternalInstanceName = ReadRegistryStringValue(RS_KEY_ENGINE_INSTANCE_NAMES_WOW64, sInstance)
Else
sInternalInstanceName = ReadRegistryStringValue(RS_KEY_ENGINE_INSTANCE_NAMES, sInstance)
End If
End Select
If (bIs64Bit) Then
GetInstanceKeyRoot = SQL_KEY_ROOT_WOW64 & "\" & sInternalInstanceName
Else
GetInstanceKeyRoot = SQL_KEY_ROOT & "\" & sInternalInstanceName
End If
End Function
'******************************************************************************
' Name: GetInstanceKey
'
' Purpose: Gets the path to the registry key for the instance of a specified Server Type
'
' Parameters: sInstance - The SQL instance name
'
' Returns: the registry path
'
Public Function GetInstanceKey(ByVal sServerType, ByVal sInstance, ByVal sKey, ByVal bIs64Bit)
GetInstanceKey = GetInstanceKeyRoot(sServerType, sInstance, bIs64Bit) & "\" & sKey
End Function
'******************************************************************************
' Name: GetSQLInstanceKeyRoot
'
' Purpose: Gets the path to the root registry key for the instance's
' registry values
'
' Parameters: sInstance - The SQL instance name
'
' Returns: the root registry path
'
Public Function GetSQLInstanceKeyRoot(ByVal sInstance, ByVal bIs64Bit)
GetSQLInstanceKeyRoot = GetInstanceKeyRoot("SQL", sInstance, bIs64Bit)
End Function
'******************************************************************************
' Name: GetSQLInstanceKey
'
' Purpose: Gets the path to the registry key for the instance
'
' Parameters: sInstance - The SQL instance name
'
' Returns: the registry path
'
Public Function GetSQLInstanceKey(ByVal sInstance, ByVal sKey, ByVal bIs64Bit)
GetSQLInstanceKey = GetInstanceKey("SQL", sInstance, sKey, bIs64Bit)
End Function
'******************************************************************************
' Name: GetConnectionFailureMessage
'
' Purpose: To generate a message stating the reason for failing to connect to a SQL instance
'
' Parameters: sInstance, The SQL instance
' lErrNumber, The error number returned from the connection attempt
' sErrDescription, The error description returned from the connection attempt
'
' Returns: The failure message
'
Public Function GetConnectionFailureMessage(sInstance, lErrNumber, sErrDescription)
Dim sFailureReason
Dim sSQLServiceName
sSQLServiceName = GetSQLServiceName(sInstance)
Dim sResult
Select Case IsSQLServiceStarted(sInstance)
Case -2
sFailureReason = "is not installed"
Case -1, 0
sFailureReason = "is not running"
Case 1
Const DB_CONNECTION_FAILURE_MESSAGE = "The SQL Server management pack script ""SQL Server {Version} Service Availability"" is unable to successfully connect to the SQL Server instance ""{ServiceName}"". The error message returned is ""{Description}"""
sResult = Replace(DB_CONNECTION_FAILURE_MESSAGE, "{Version}", SQL_VERSION)
sResult = Replace(sResult, "{ServiceName}", sSQLServiceName)
GetConnectionFailureMessage = Replace(sResult, "{Description}", sErrDescription)
Exit Function
End Select
Const DB_CONNECTION_NO_SERVICE_MESSAGE = "The SQL Server service ({ServiceName}) {FailureReason}."
sResult = Replace(DB_CONNECTION_NO_SERVICE_MESSAGE, "{ServiceName}", sSQLServiceName)
GetConnectionFailureMessage = Replace(sResult, "{FailureReason}", sFailureReason)
End Function
'******************************************************************************
' Name: IsSupportedVersion
'
' Purpose: Checks if this instance is supported
'
' Parameters: sInstance, the name of the instance to check
'
' Returns: True if Microsoft SQL Server is of specific version
' False otherwise
'
Public Function IsSupportedVersion(sInstance)
If Left(GetSQLServerVersion(GetSQLServiceName(sInstance)), Len(SQL_VERSION_NUMBER)) = SQL_VERSION_NUMBER Then
IsSupportedVersion = True
Call g_oUtil.LogMessage(g_oUtil.DBG_TRACE, "IsSupportedVersion True for: " & sInstance)
Else
IsSupportedVersion = False
Call g_oUtil.LogMessage(g_oUtil.DBG_TRACE, "IsSupportedVersion False for: " & sInstance)
End If
End Function
'******************************************************************************
' Name: IsServiceSupported
'
' Purpose: Checks if this service is supported by this management pack
'
' Parameters: sService, the name of the service to check
'
' Returns: True if Microsoft SQL Server is of specific version
' False otherwise
'
Public Function IsServiceSupported(sService)
Dim oServices
Set oServices = WMIExecQuery ("winmgmts:\\" & TargetComputer & "\root\Microsoft\SqlServer\" & SQL_WMI_NAMESPACE, "select * from SqlService where ServiceName ='" & EscapeWQLString(sService) & "'")
IsServiceSupported = oServices.Count > 0
End Function
'******************************************************************************
' Name: GetSQLInstances
'
' Purpose: Gets the list of instances of SQL installed on
' the specified server. These are read through WMI
'
' Parameters: None
'
' Returns: A comma separated list of instances
'
Public Function GetSQLInstances(ByRef dSQLInstancesList)
Dim oVersionSpecificNamespace
Dim oServices, oService, sInstance, sInstances, sClusterName, bAddInstance, bIs64Bit
Dim currentNamespace, sqlWmi
' Check Sql Server namespace existence
' because Seed Discovery treats Sql Server Native Client as Sql Server instance
currentNamespace = "winmgmts:\\" & TargetComputer & "\root\Microsoft\SqlServer"
On Error Resume Next
Set sqlWmi = GetObject(currentNamespace)
On Error GoTo 0
If IsEmpty(sqlWmi) then
GetSQLInstances = Null
Exit Function
End If
Set oVersionSpecificNamespace = WMIExecQuery(currentNamespace, "select * from __NAMESPACE where Name ='" & SQL_WMI_NAMESPACE & "'")
If (oVersionSpecificNamespace.Count = 0) Then
GetSQLInstances = Null
Exit Function
End If
Set oServices = WMIExecQuery ("winmgmts:\\" & TargetComputer & "\root\Microsoft\SqlServer\" & SQL_WMI_NAMESPACE, "select * from SqlService where SQLServiceType ='1'")
Set dSQLInstancesList = CreateDictionaryFromObject(oServices, SERVICE_NAME)
GetAllSQLSeviceProperties(oServices)
For Each oService in oServices
sInstance = InstanceNameFromServiceName(oService.ServiceName)
If IsSupportedVersion(sInstance) Then
If IsSupportedSku(sInstance) Then
bIs64Bit = g_oSQL.Is64Bit(sInstance)
sClusterName = ReadRegistryStringValue(GetSQLInstanceKey(sInstance, "Cluster", bIs64Bit), "ClusterName")
If IsTargetVirtualServer Then
bAddInstance = (LCase(TargetNetBIOSName) = LCase(sClusterName))
Else
bAddInstance = IsNull(sClusterName)
End If
If bAddInstance Then
If sInstances <> "" Then
sInstances = sInstances & ","
End If
sInstances = sInstances & sInstance
End If
Else
g_List.Remove oService.ServiceName
End If
Else
g_List.Remove oService.ServiceName
End If
Next
Call g_oUtil.LogMessage(g_oUtil.DBG_TRACE, "GetSQLInstances returning the following instances: " & sInstances)
GetSQLInstances = sInstances
End Function
'******************************************************************************
' Name: GetRSInstances
'
' Purpose: Gets the list of instances of Report Server installed on
' the specified server. These are read through WMI.
'
' Parameters: None
'
' Returns: A comma separated list of instances
'
Public Function GetRSInstances()
Dim oServices, oService, sInstances
Set oServices = WMIExecQuery ("winmgmts:\\" & TargetComputer & "\root\Microsoft\SqlServer\" & SQL_WMI_NAMESPACE, "select * from SqlService where SQLServiceType ='6'")
For Each oService in oServices
If sInstances <> "" Then
sInstances = sInstances & ","
End If
sInstances = sInstances & InstanceNameFromServiceName(oService.ServiceName)
Next
Call g_oUtil.LogMessage(g_oUtil.DBG_TRACE, "GetRSInstances returning the following instances: " & sInstances)
GetRSInstances = sInstances
End Function
'******************************************************************************
' Name: Is64Bit
'
' Purpose: Checks if a Server is 64Bit
'
' Parameters: sInstance, the name of the instance to check
'
' Returns: True if 64Bit
' False if not 64bit
Public Function Is64Bit(sInstance)
Dim sKeyValue
Is64Bit = GetServiceAdvancedProperty(GetSQLServiceName(sInstance), SERVICEADVANCEDPROPERTY_NAME_ISWOW64)
End Function
'******************************************************************************
' Name: IsSupportedSku
'
' Purpose: Checks if the Sku is supported
'
' Parameters: sInstance, the name of the instance to check
'
' Returns: True if Microsoft MSDE
' False if Microsoft MSDE is not installed
Public Function IsSupportedSku(sInstance)
Dim sSKU
sSKU = GetServiceAdvancedProperty(GetSQLServiceName(sInstance), SERVICEADVANCEDPROPERTY_NAME_SKUNAME)
If Not IsNull(sSKU) Then
If sSKU = "Express Edition" Then
IsSupportedSku = True
Else
IsSupportedSku = True
Call g_oUtil.LogMessage(g_oUtil.DBG_TRACE, "IsSupportedSku True for: " & sInstance)
End If
Else
IsSupportedSku = False
End If
End Function
'******************************************************************************
' Name: IsClustered
'
' Purpose: Checks if an instance is clustered
'
' Parameters: sInstance, the name of the instance to check
'
' Returns: 1 if the instance is clustered
' 0 if the instance is not clustered
'
Public Function IsClustered(sInstance)
IsClustered = GetServiceAdvancedProperty(GetSQLServiceName(sInstance), SERVICEADVANCEDPROPERTY_NAME_CLUSTERED)
End Function
'******************************************************************************
' Name: IsSQLServiceStarted
'
' Purpose: Checks whether a given SQL service instance is running
'
' Parameters: sInstance, the name of the SQL instance to check
'
' Returns: 0 if the service is not started and not disabled
' 1 if the service is started
' -1 if the service is not started but the service is disabled
' -2 if there was a WMI Error getting the service status or the
' service does not exist
'
Public Function IsSQLServiceStarted(sInstance)
IsSQLServiceStarted = IsServiceStarted(GetSQLServiceName(sInstance))
End Function
'******************************************************************************
' Name: IsServiceStarted
'
' Purpose: Checks whether a given Windows service is running
'
' Parameters: sServiceName, the Windows service name (short)
'
' Returns: 0 if the service is not started and not disabled
' 1 if the service is started
' -1 if the service is not started but the service is disabled
' -2 if there was a WMI Error getting the service status or the
' service does not exist
'
Public Function IsServiceStarted(sServiceName)
Dim oService, sObjectString
sObjectString = "winmgmts:\\" & TargetComputer & "\root\cimv2"
On Error Resume Next
Err.Clear
'We want to do our own error handling here. No WMIGetObject().
Set oService = GetObject(sObjectString & ":Win32_Service.Name='" & EscapeWQLString(sServiceName) & "'")
If Err.Number <> 0 Then
IsServiceStarted = -2
Else
If oService.State = "Running" Then
IsServiceStarted = 1
ElseIf oService.StartMode = "Disabled" Then
IsServiceStarted = -1
Else
IsServiceStarted = 0
End If
End If
Set oService = Nothing
On Error GoTo 0
End Function
'******************************************************************************
' Name: GetSQLInstanceNameFromServiceName
'
' Purpose:
'
' Parameters:
'
' Returns:
'
Public Function GetSQLInstanceNameFromServiceName(ByVal sServiceName)
If sServiceName = SQL_DEFAULT Then
GetSQLInstanceNameFromServiceName = SQL_DEFAULT
Else
GetSQLInstanceNameFromServiceName = Mid(sServiceName, 7)
End If
End Function
'******************************************************************************
' Name: GetSQLServiceName
'
' Purpose:
'
' Parameters: sInstance, the name of the instance to return the service name for
'
' Returns: The service name
'
Public Function GetSQLServiceName(sInstance)
If sInstance = SQL_DEFAULT Then
GetSQLServiceName = SQL_DEFAULT
Else
GetSQLServiceName = "MSSQL$" & sInstance
End If
End Function
'******************************************************************************
' Name: GetSQLInstanceName
'
' Purpose: Returns the SQL Server instance name or default
'
' Parameters: sName - The physical name of the SQL Server
' sInstance - The SQL Server instance name
'
' Returns: The default or named instance connection name
'
Public Function GetSQLInstanceName(sName, sInstance)
If sInstance = SQL_DEFAULT Then
GetSQLInstanceName = sName
Else
GetSQLInstanceName = sName & "\" & sInstance
End If
End Function
Public Function EnumValues(ByVal sKeyPath, ByRef lResult)
EnumValues = m_oSafeRegistry.EnumValues(sKeyPath, lResult)
End Function
'******************************************************************************
' Name: ReadRegistryStringValue
'
' Purpose: Return a string value from the registry (HKLM)
'
' Parameters: sKeyPath, the path to the key
' sValueName, the name of the value to return
'
' Returns: A string matching the contents of the value or null
'
Public Function ReadRegistryStringValue(sKeyPath, sValueName)
Dim lResult
ReadRegistryStringValue = m_oSafeRegistry.ReadStringValue(sKeyPath, sValueName, lResult)
End Function
'******************************************************************************
' Name: ReadRegistryMultiStringValue
'
' Purpose: Return a multi string value from the registry (HKLM)
'
' Parameters: sKeyPath, the path to the key
' sValueName, the name of the value to return
'
' Returns: A string matching the contents of the value or null
'
Public Function ReadRegistryMultiStringValue(sKeyPath, sValueName)
Dim lResult
ReadRegistryMultiStringValue = m_oSafeRegistry.ReadMultiStringValue(sKeyPath, sValueName, lResult)
End Function
'******************************************************************************
' Name: ReadRegistryDWORDValue
'
' Purpose: Return a DWORD value from the registry (HKLM)
'
' Parameters: sKeyPath, the path to the key
' sValueName, the name of the value to return
' sHostName, the computer to connect to
'
' Returns: A string matching the contents of the value or null
'
Public Function ReadRegistryDWORDValue(sKeyPath, sValueName)
Dim lResult
ReadRegistryDWORDValue = m_oSafeRegistry.ReadDWORDValue(sKeyPath, sValueName, lResult)
End Function
'******************************************************************************
' Name: CreateDictionaryFromObject
'
' Purpose: Executing WMI query takes alot of time. So we use this function to
' store the result in a dictionary and use it instead of executing
' WMI query again and again
' Parameters: oOptions, theObject to be stored locally
'
' Returns: A dictionary
'
Public Function CreateDictionaryFromObject(ByVal oOptions, ByVal sKeyValue)
Dim aInstanceValue
Set aInstanceValue = CreateObject("Scripting.Dictionary")
If oOptions.Count > 0 Then
Dim oServiceValue
For Each oServiceValue in oOptions
Select Case sKeyValue
Case PROPERTY_NAME
aInstanceValue.Add oServiceValue.PropertyName, oServiceValue
Case SERVICE_NAME
aInstanceValue.Add oServiceValue.ServiceName, oServiceValue
End Select
Next
End If
Set CreateDictionaryFromObject = aInstanceValue
End Function
'******************************************************************************
' Name: GetAllSQLSeviceProperties
'
' Purpose: This function retrieves all the properties of all the SQL Instances
' Running on the machine and stores it in a global object g_List.
' The data is retrieved by a WMI query.
' Parameters: oSQLServices, theObject to be stored locally
'
Public Sub GetAllSQLSeviceProperties(ByVal oSQLServices)
Dim oSQLService, oOptions, oOption
Set oOptions = WMIExecQuery("winmgmts:\\" & TargetComputer & "\root\Microsoft\SqlServer\" & SQL_WMI_NAMESPACE, "select * from SqlServiceAdvancedProperty where SQLServiceType='1'" )
For Each oSQLService in oSQLServices
Dim sServiceName, dPropertiesList
Set dPropertiesList = CreateObject("Scripting.Dictionary")
sServiceName = oSQLService.ServiceName
For Each oOption in oOptions
If oOption.ServiceName = sServiceName Then
dPropertiesList.Add oOption.PropertyName, oOption
End If
Next
If Not IsEmpty(dPropertiesList)Then
g_List.Add sServiceName, dPropertiesList
End If
Next
End Sub
Public Function GetSQLServerVersion (sServiceName)
GetSQLServerVersion = "0.0.0.0"
Dim bIs64Bit : bIs64Bit = GetServiceAdvancedProperty(sServiceName, SERVICEADVANCEDPROPERTY_NAME_ISWOW64)
Dim instanceKeyRoot : instanceKeyRoot = GetInstanceKeyRoot("SQL", GetSQLInstanceNameFromServiceName(sServiceName), bIs64Bit)
Dim Version : Version = ReadRegistryStringValue(instanceKeyRoot & "\Setup", "PatchLevel")
If Version = "" Then
Version = ReadRegistryStringValue(instanceKeyRoot & "\MSSQLServer\CurrentVersion", "CurrentVersion")
End If
GetSQLServerVersion = Version
End Function
'******************************************************************************
' Name: GetFullTextSearchInstances
'
' Purpose: Gets the list of instances of FullTextSearch installed on
' the specified server. These are read through WMI
'
' Parameters: None
'
' Returns: The list of Full Text Search Instances if they are installed, an empty string if it is not
'
Public Function GetFullTextSearchInstances()
Dim sFTSInstances, sFTSInstance, sFTSInstanceName, sInstance
GetFullTextSearchInstances = ""
Set sFTSInstances = WMIExecQuery ("winmgmts:\\" & TargetComputer & "\root\Microsoft\SqlServer\" & SQL_WMI_NAMESPACE, "select * from SqlService where SQLServiceType ='9' or SQLServiceType ='3'")
Set GetFullTextSearchInstances = CreateDictionaryFromObject(sFTSInstances, SERVICE_NAME)
End Function
'******************************************************************************
' Name: GetFullTextSearchServiceName
'
' Purpose: Gets the name of the Full text search service name if is is insalled on
' the specified server. Otherwise it returns a ""
'
' Parameters: None
'
' Returns: The name of Full Text Search Service if they are installed, an empty string if it is not
'
Public Function GetFullTextSearchServiceName(ByVal sFTSInstanceName, ByVal dList)
GetFullTextSearchServiceName = "-"
If Not IsEmpty(dList) Then
If (dList.Exists(sFTSInstanceName)) Then
GetFullTextSearchServiceName = CStr(dList.Item(sFTSInstanceName).ServiceName)
End If
End If
End Function
'******************************************************************************
' Name: GetServiceAdvancedProperty
'
' Purpose: Return a DWORD value from the registry (HKLM)
'
' Parameters: sServiceName, the name of the service
' sPropertyName, the name of the property to return
'
' Returns: A string, integer, boolean matching the contents of the value or null
'
Function GetServiceAdvancedProperty(sServiceName, sPropertyName)
Dim oOptions, oOption
Dim dServiceValues
GetServiceAdvancedProperty = ""
If (Not IsEmpty(g_List)) And (g_List.Exists(sServiceName)) Then
Set dServiceValues = g_List.Item(sServiceName)
If (Not IsEmpty(dServiceValues)) And dServiceValues.Count > 0 And (dServiceValues.Exists(sPropertyName)) Then
Set oOption = dServiceValues.Item(sPropertyName)
Select Case oOption.PropertyValueType
Case SERVICEADVANCEDPROPERTY_TYPE_STRING
GetServiceAdvancedProperty = oOption.PropertyStrValue
Case SERVICEADVANCEDPROPERTY_TYPE_FLAG
If oOption.PropertyNumValue = 0 Then
GetServiceAdvancedProperty = False
Else
GetServiceAdvancedProperty = True
End If
Case SERVICEADVANCEDPROPERTY_TYPE_NUMBER
GetServiceAdvancedProperty = oOption.PropertyNumValue
End Select
End If
End If
End Function
Class SQLClass
Private m_sInstanceName
Private m_bIs64Bit
Public Property Let SQLServerInstanceName(ByVal sInstanceName)
m_sInstanceName = sInstanceName
End Property
Public Property Get SQLServerInstanceName()
SQLServerInstanceName = m_sInstanceName
End Property
Public Property Let SQLServerIs64Bit(ByVal bIs64Bit)
m_bIs64Bit = bIs64Bit
End Property
Public Property Get SQLServerIs64Bit()
SQLServerIs64Bit = m_bIs64Bit
End Property
Public Property Get Replication()
Replication = SQLAttributeConversion(SQL_REPLICATION_ATTRIBUTE_ID, CheckConfigurationValue("Replication", "IsInstalled", "REG_DWORD"))
End Property
Public Property Get SQLServerVersion()
Dim Version : Version = CheckConfigurationValue("Setup", "PatchLevel", "REG_SZ")
If Version = "" Then
Version = CheckConfigurationValue("MSSQLServer\CurrentVersion", "CurrentVersion", "REG_SZ")
End If
SQLServerVersion = Version
End Property
Public Property Get Edition()
Edition = CheckConfigurationValue("Setup", "Edition", "REG_SZ")
End Property
Public Property Get AuthenticationMode()
AuthenticationMode = SQLAttributeConversion(SQL_AUTHENTICATION_MODE_ATTRIBUTE_ID, CheckConfigurationValue("MSSQLServer", "LoginMode", "REG_DWORD"))
End Property
Public Property Get Language()
Language = g_oSQL.GetServiceAdvancedProperty(g_oSQL.GetSQLServiceName(m_sInstanceName), g_oSQL.SERVICEADVANCEDPROPERTY_NAME_LANGUAGE)
End Property
Public Property Get ServicePackVersion()
Dim ServicePack
ServicePack = g_oSQL.GetServiceAdvancedProperty(g_oSQL.GetSQLServiceName(m_sInstanceName), g_oSQL.SERVICEADVANCEDPROPERTY_NAME_SPLEVEL)
If IsNull(ServicePack) Then
ServicePack = ""
End If
ServicePackVersion = ServicePack
End Property
Public Property Get AuditLevel()
AuditLevel = SQLAttributeConversion(SQL_AUDIT_LEVEL_ATTRIBUTE_ID, CheckConfigurationValue("MSSQLServer", "AuditLevel", "REG_DWORD"))
End Property
Public Property Get InstallPath()
InstallPath = g_oSQL.GetServiceAdvancedProperty(g_oSQL.GetSQLServiceName(m_sInstanceName), g_oSQL.SERVICEADVANCEDPROPERTY_NAME_INSTALLPATH)
End Property
Public Property Get ToolsPath()
If (m_bIs64Bit) Then
ToolsPath = g_oSQL.ReadRegistryStringValue(g_oSQL.SQL_TOOLS_PATH_WOW64, "SQLPath")
Else
ToolsPath = g_oSQL.ReadRegistryStringValue(g_oSQL.SQL_TOOLS_PATH, "SQLPath")
End If
If (IsNull(ToolsPath)) Then
ToolsPath = ""
End If
End Property
Public Property Get EnableErrorReporting()
If g_oSQL.GetServiceAdvancedProperty(g_oSQL.GetSQLServiceName(m_sInstanceName), g_oSQL.SERVICEADVANCEDPROPERTY_NAME_ERRORREPORTING) Then
EnableErrorReporting = "True"
Else
EnableErrorReporting = "False"
End If
End Property
Public Property Get ReplicationWorkingDirectory()
Dim strVal
strVal = CheckConfigurationValue("Replication", "WorkingDirectory", "REG_SZ")
If "" = strVal Then
strVal = "N/A"
End If
ReplicationWorkingDirectory = strVal
End Property
Public Property Get ReplicationDistributionDatabase()
Dim strVal
strVal = CheckConfigurationValue("Replication", "DistributionDB", "REG_SZ")
If "" = strVal Then
strVal = "N/A"
End If
ReplicationDistributionDatabase = strVal
End Property
Public Property Get ConnectionName()
If m_sInstanceName = "MSSQLSERVER" Then
ConnectionName = ""
Else
ConnectionName = "\" & m_sInstanceName
End If
End Property
Public Property Get ServiceName()
If m_sInstanceName = "MSSQLSERVER" Then
ServiceName = "MSSQLSERVER"
Else
ServiceName = "MSSQL$" & m_sInstanceName
End If
End Property
Public Property Get ServiceClusterName()
ServiceClusterName = ""
If Cluster Then
ServiceClusterName = "SQL SERVER"
If m_sInstanceName <> "MSSQLSERVER" Then
ServiceClusterName = ServiceClusterName & " (" & m_sInstanceName & ")"
End If
End If
End Property
Public Property Get FullTextSearchServiceName()
If m_sInstanceName = "MSSQLSERVER" Then
FullTextSearchServiceName = SQL_FULLTEXTSEARCH_SERVICENAME
Else
FullTextSearchServiceName = SQL_FULLTEXTSEARCH_SERVICENAME & "$" & m_sInstanceName
End If
End Property
Public Property Get FullTextSearchServiceClusterName()
FullTextSearchServiceClusterName = ""
If Cluster Then
FullTextSearchServiceClusterName = SQL_FULLTEXTSEARCH_SERVICECLUSTERNAME
If m_sInstanceName <> "MSSQLSERVER" Then
FullTextSearchServiceClusterName = FullTextSearchServiceClusterName & " (" & m_sInstanceName & ")"
End If
End If
End Property
Public Property Get AgentName()
' SQL Server Express editions don't support 'SQL Agent Service'.
' We'd like to run SQL Agent service discovery only for the notExpress editions.
' SQL Agent service discovery works using query based on AgentName, therefore it should be empty for Express editions.
If (Edition <> "Express Edition") Then
If (m_sInstanceName = "MSSQLSERVER") Then
AgentName = "SQLSERVERAGENT"
Else
AgentName = "SQLAgent$" & m_sInstanceName
End If
Else
AgentName = ""
End If
End Property
Public Property Get AgentClusterName()
AgentClusterName = ""
If Cluster Then
AgentClusterName = "SQL SERVER AGENT"
If m_sInstanceName <> "MSSQLSERVER" Then
AgentClusterName = AgentClusterName & " (" & m_sInstanceName & ")"
End If
End If
End Property
Public Property Get Cluster()
If g_oSQL.IsClustered(m_sInstanceName) = "True" Then
Cluster = "True"
Else
Cluster = "False"
End If
End Property
Public Property Get ServiceAccount(sServiceName, dSQLServerInstances )
Dim oServiceAccount
Set oServiceAccount = dSQLServerInstances.Item(sServiceName)
ServiceAccount = oServiceAccount.StartName
End Property
Public Property Get InstanceID()
InstanceID = g_oSQL.GetServiceAdvancedProperty(g_oSQL.GetSQLServiceName(m_sInstanceName), g_oSQL.SERVICEADVANCEDPROPERTY_NAME_INSTANCEID)
End Property
Public Function GetStartupParameters()
Dim sKeyRoot, dValues, lResult, sValueName, sValue, dParameters
sKeyRoot = g_oSQL.GetSQLInstanceKeyRoot(m_sInstanceName, m_bIs64Bit) & "\MSSQLServer\Parameters"
dValues = g_oSQL.EnumValues(sKeyRoot, lResult)
Set dParameters = CreateObject("Scripting.Dictionary")
If Not IsNull(dValues) Then
For Each sValueName In dValues
sValue = CheckConfigurationValue("MSSQLServer\Parameters", sValueName, "REG_SZ")
If Left(sValue, 1) = "-" And Not dParameters.Exists(Left(sValue, 2)) Then
dParameters.Add Left(sValue, 2), Right(sValue, Len(sValue) -2)
End If
Next
End If
Set GetStartupParameters = dParameters
End Function
''******************************************************************************
' Name: CheckConfigurationValue
'
' Purpose: Read an instance specific registry key and returns the value
'
' Parameters:
'
' Returns: Value is specified registry key
'
Private Function CheckConfigurationValue(sAttributeKey, sValue, sKeyType)
Dim sKey, sResult
Call g_oUtil.LogMessage(g_oUtil.DBG_TRACE, "CheckConfigurationValue called with the following parameters: " & _
m_sInstanceName & ", " & _
sAttributeKey & ", " & _
sValue & ", ")
sKey = g_oSQL.GetSQLInstanceKeyRoot(m_sInstanceName, m_bIs64Bit) & "\" & sAttributeKey
If sKeyType = "REG_SZ" Then
sResult = g_oSQL.ReadRegistryStringValue (sKey, sValue)
ElseIf sKeyType = "REG_DWORD" Then
sResult = g_oSQL.ReadRegistryDWORDValue (sKey, sValue)
End If
If Not IsNull (sResult) Then
CheckConfigurationValue = sResult
Else
CheckConfigurationValue = ""
Call g_oUtil.LogMessage(g_oUtil.DBG_TRACE, "CheckConfigurationValue returning nothing")
End If
End Function
'******************************************************************************
' Name: SQLAttributeConversion
'
' Purpose: Conversion for SQL Server attributes
'
' Parameters:
' strName - Name of the attribute
' sValue - Value of the attribute
'
' Returns: Nothing
'
Private Function SQLAttributeConversion(strName, sValue)
SQLAttributeConversion = ""
Select Case strName
Case SQL_AUTHENTICATION_MODE_ATTRIBUTE_ID
If IsNumeric(sValue) Then
If sValue = 1 Then
SQLAttributeConversion = "Windows Authentication Mode"
Else
SQLAttributeConversion = "Mixed Mode (Windows Authentication and SQL Server Authentication)"
End If
End If
Case SQL_AUDIT_LEVEL_ATTRIBUTE_ID
If IsNumeric(sValue) Then
Select Case sValue
Case 0
SQLAttributeConversion = "None"
Case 1
SQLAttributeConversion = "Success"
Case 2
SQLAttributeConversion = "Failure"
Case 3
SQLAttributeConversion = "All"
End Select
End If
Case SQL_ENABLE_ERROR_REPORTING_ATTRIBUTE_ID
If IsNumeric(sValue) Then
If sValue <> 0 Then
SQLAttributeConversion = "True"
Else
SQLAttributeConversion = "False"
End If
End If
Case SQL_REPLICATION_ATTRIBUTE_ID
If IsNumeric(sValue) Then
If sValue = 1 Then
SQLAttributeConversion = "True"
Else
SQLAttributeConversion = "False"
End If
End If
End Select
End Function
End Class
'******************************************************************************
' Subs and Functions
'
Sub Main()
Dim oParams
Set oParams = WScript.Arguments
Set g_List = CreateObject("Scripting.Dictionary")
If oParams.Count < 6 Or oParams.Count > 7 Then
Quit()
End If
If oParams.Count = 7 Then
If LCase(oParams(6)) = "true" Then
IsTargetVirtualServer = True
Else
IsTargetVirtualServer = False
End If
Else
IsTargetVirtualServer = False
End If
Set oParams = Nothing
Set g_oSQL = New SQL
If Not g_oSQL.ConnectedToRegistry Then Quit()
Set g_oUtil = New Util
Call g_oUtil.SetDebugLevel(g_oUtil.DBG_NONE)
Call g_oUtil.LogMessage(g_oUtil.DBG_TRACE, SCRIPT_NAME & " Starting discovery for computer: " & TargetComputer)
Call DoServiceDiscovery()
Call g_oUtil.LogMessage(g_oUtil.DBG_TRACE, SCRIPT_NAME & " Finished discovery for computer: " & TargetComputer)
Dim i, aInsts
Dim dSQLServerInstances, dFullTextSearchServiceNames
'log trace
Call g_oUtil.LogMessage(g_oUtil.DBG_TRACE, "Starting SQL Discovery.")
If Len(ExcludeList) < 0 Then
WriteToEventLogAndExit("Instance exclusion list invalid in DBEngineDiscovery. Aborting discovery.")
End If
Dim oAPI, oSQLDiscoveryData
Set oAPI = CreateObject("MOM.ScriptAPI")
Set oSQLDiscoveryData = oAPI.CreateDiscoveryData(0, SourceId, ManagedEntityId)
Dim sInstances : sInstances = g_oSQL.GetSQLInstances(dSQLServerInstances)
If Not IsNull(sInstances) Then
aInsts = Split(sInstances, ",")
Set dFullTextSearchServiceNames = g_oSQL.GetFullTextSearchInstances()
For i = 0 To UBound(aInsts)
If Not(IsExcluded(aInsts(i))) Then DiscoverSQLInstance aInsts(i), oSQLDiscoveryData, dSQLServerInstances , dFullTextSearchServiceNames
Next
End If
Call oAPI.Return(oSQLDiscoveryData)
match = False
If Trim(ExcludeList) = "*" Then
match = True
Else
aExcludes = Split(ExcludeList, ",")
For i = 0 To UBound(aExcludes)
If LCase(sInstance) = LCase(Trim(aExcludes(i))) Then
match = True
End If
Next
End If
IsExcluded = match
Sub DiscoverSQLInstance(ByVal sInstanceName, ByRef oSQLDiscoveryData, ByRef dSQLServerInstances , ByRef dFullTextSearchServiceNames)
Dim oSQLClass, oDiscoveryData
Set oSQLClass = New SQLClass
oSQLClass.SQLServerInstanceName = sInstanceName
oSQLClass.SQLServerIs64Bit = g_oSQL.Is64Bit(sInstanceName)
'submit the discovery data packet
Call g_oUtil.LogMessage(g_oUtil.DBG_TRACE, "Submitting Discovery data packet.")
Call oSQLDiscoveryData.AddInstance(oSQLInstance)
If oSQLClass.SQLServerIs64Bit Then
Dim oRel: Set oRel = oSQLDiscoveryData.CreateRelationshipInstance(WOW64_INSTANCE_GROUP_CONTAINS_DBENGINE)
Dim oWow64Group: Set oWow64Group = oSQLDiscoveryData.CreateClassInstance(WOW64_INSTANCE_GROUP)
oRel.Source = oWow64Group
oRel.Target = oSQLInstance
Call oSQLDiscoveryData.AddInstance(oRel)
End If
End Sub
Sub ThrowEmptyDiscoveryData()
Dim oAPI, oSQLDiscoveryData
Set oAPI = CreateObject("MOM.ScriptAPI")
Set oSQLDiscoveryData = oAPI.CreateDiscoveryData(0, SourceId, ManagedEntityId)
Call oAPI.Return(oSQLDiscoveryData)
End Sub </Script></ScriptBody>
<TimeoutSeconds>$Config/TimeoutSeconds$</TimeoutSeconds>
</DataSource>
</MemberModules>
<Composition>
<Node ID="DS"/>
</Composition>
</Composite>
</ModuleImplementation>
<OutputType>System!System.Discovery.Data</OutputType>
</DataSourceModuleType>
Home
ENU 
Show References: