'This script discovers BAM runtime component on a computer passed as parameter
'$Config/ComputerName$. If computer name is not passed then it discovers BAM on
'a runtime computer with lowest server ID in the management database. This also
'discovers BAM role and the containment of BAM runtime in it.
Dim oArgs
Set oArgs = WScript.Arguments
if oArgs.Count < 4 Then
Wscript.Quit -1
End If
Dim SourceID, ManagedEntityId, TargetComputer
Dim ComputerName, NetbiosComputerName
Dim BAMDbName, BAMDbServerName
SourceId = oArgs(0)
ManagedEntityId = oArgs(1)
ComputerName = oArgs(2)
NetbiosComputerName = oArgs(3)
TargetComputer = null
if oArgs.Count > 4 Then
TargetComputer = oArgs(4)
end if
Call GetBAMRuntime()
Sub GetBAMRuntime()
Dim objAPI, objDiscoveryData
Set objAPI = CreateObject("MOM.ScriptAPI")
Set objDiscoveryData = objAPI.CreateDiscoveryData(0, SourceId, ManagedEntityId)
if Not IsNull(BAMDbName) and Not IsNull(BAMDbServerName) then
Dim defaultConnStr
defaultConnStr = "Server=" & BAMDbServerName & ";Database=" & BAMDbName & ";Trusted_Connection=yes"
CreateObjectsAndRelations defaultConnStr, objAPI, objDiscoveryData
end if
Call objAPI.Return(objDiscoveryData)
End Sub
Function GetBAMDatabase(byRef BAMDbName, byRef BAMDbServerName)
Dim MgmtDbName, MgmtDbServerName
MgmtDbName = GetRegistryKeyValue("SOFTWARE\Microsoft\BizTalk Server\3.0\Administration", "MgmtDBName")
MgmtDbServerName = GetRegistryKeyValue("SOFTWARE\Microsoft\BizTalk Server\3.0\Administration", "MgmtDBServer")
if IsNull(TargetComputer) then
Dim ObjError
Set ObjError = New Error
Dim defaultConnStr
defaultConnStr = "Server=" & MgmtDbServerName & ";Database=" & MgmtDbName & ";Trusted_Connection=yes"
Dim cnADOConnection
Set cnADOConnection = MomCreateObject("ADODB.Connection")
cnADOConnection.Provider = "SQLNCLI11"
cnADOConnection.ConnectionTimeout = 15
ObjError.Clear
On Error Resume Next
cnADOConnection.Open defaultConnStr
ObjError.Save
On Error Goto 0
If 0 <> Err.number then
'Error event to goin here
GetBAMDatabase = MGMTDB_CONNECT_FAILURE
Exit Function
End If
Dim objResults
ObjError.Clear
On Error Resume Next
Set objResults = cnADOConnection.Execute("select top 1 * from adm_Server srv with (NoLock) order by srv.Id asc")
ObjError.Save
On Error Goto 0
If ObjError.Number <> 0 Then
' Error event to go in here
GetBAMDatabase = MGMTDB_QUERY_FAILURE
If (objResults <> null) Then objResults.Close
Exit Function
End If
TargetComputer = CStr(objResults(1))
objResults.Close
end if
Dim DiscoverBAMRuntime
DiscoverBAMRuntime = false
if StrComp(TargetComputer, NetbiosComputerName, 1) = 0 then
DiscoverBAMRuntime = true
end if
if (DiscoverBAMRuntime) then
Dim strGroupQuery
strGroupQuery = "select * from MSBTS_GroupSetting"
Dim GroupWbemObjSet, WbemGroupObject
Set GroupWbemObjSet = GetWMICollection(ComputerName, "MicrosoftBizTalkServer", strGroupQuery)
Dim strEval
For Each WbemGroupObject In GroupWbemObjSet
strEval = Eval(IsObject(WbemGroupObject.Properties_("BamDBName")))
If (strEval <> "False") Then
BAMDbName = WbemGroupObject.Properties_("BamDBName").value
End If
strEval = Eval(IsObject(WbemGroupObject.Properties_("BamDBServerName")))
If (strEval <> "False") Then
BAMDbServerName = WbemGroupObject.Properties_("BamDBServerName").value
End If
Next
end if
End Function
Function CreateObjectsAndRelations(defaultConnStr, byRef objAPI, byRef objDiscoveryData)
Dim ObjError
Set ObjError = New Error
Dim cnADOConnection
Set cnADOConnection = MomCreateObject("ADODB.Connection")
cnADOConnection.Provider = "SQLNCLI11"
cnADOConnection.ConnectionTimeout = 15
ObjError.Clear
On Error Resume Next
cnADOConnection.Open defaultConnStr
ObjError.Save
On Error Goto 0
If 0 <> Err.number then
CreateObjectsAndRelations = BAM_DISCOVERY_CONNECT_FAILURE
Exit Function
End If
Dim objResults
ObjError.Clear
On Error Resume Next
Set objResults = cnADOConnection.Execute("select * from bam_Metadata_Properties bmp with (NoLock) where bmp.Scope = 'ArchivingDatabase'")
ObjError.Save
On Error Goto 0
If ObjError.Number <> 0 Then
CreateObjectsAndRelations = BAM_DISCOVERY_QUERY_FAILURE
If (objResults <> null) Then objResults.Close
Exit Function
End If
Set oBAMRuntime = objDiscoveryData.CreateClassInstance("$MPElement[Name='Microsoft.BizTalk.Server.2016.BAMRuntime']$")
call oBAMRuntime.AddProperty("$MPElement[Name='Windows!Microsoft.Windows.Computer']/PrincipalName$", ComputerName)
call oBAMRuntime.AddProperty("$MPElement[Name='Microsoft.BizTalk.Server.2016.BAMRuntime']/BAMPrimaryImportDbName$", BAMDbName)
call oBAMRuntime.AddProperty("$MPElement[Name='Microsoft.BizTalk.Server.2016.BAMRuntime']/BAMPrimaryImportDbServerName$", BAMDbServerName)
Do While Not objResults.EOF
if CStr(objResults(0)) = "ArchivingDatabase" then
if CStr(objResults(1)) = "DatabaseName" then
call oBAMRuntime.AddProperty("$MPElement[Name='Microsoft.BizTalk.Server.2016.BAMRuntime']/BAMArchivingDbName$", CStr(objResults(2)))
else
call oBAMRuntime.AddProperty("$MPElement[Name='Microsoft.BizTalk.Server.2016.BAMRuntime']/BAMArchivingDbServerName$", CStr(objResults(2)))
end if
end if
objResults.MoveNext
Loop
call objDiscoveryData.AddInstance(oBAMRuntime)
Set oOutParam = oRegistry.ExecMethod_(sMethod, oInParam)
GetRegistryKeyValue = oOutParam.Properties_("sValue")
if IsNull(GetRegistryKeyValue) then
GetRegistryKeyValue = ""
end if
End Function
Function GetWMICollection(TargetComputer, strWMIBaseClass, strQuery)
Dim WbemSrv, WbemObjectSet
Set WbemSrv = Getobject("winmgmts:{impersonationLevel=impersonate}!\\" & TargetComputer & "\root\" & strWMIBaseClass)
Set WbemObjectSet = WbemSrv.ExecQuery(strQuery)
Set GetWMICollection = WbemObjectSet
End Function
Function CreateRelationShip(byRef objDiscoveryData, SourceObject, TargetObject, strRelationShipClassId)
Dim objRelation
Set objRelation = objDiscoveryData.CreateRelationshipInstance(strRelationShipClassId)
objRelation.Source = SourceObject
objRelation.Target = TargetObject
objDiscoveryData.AddInstance objRelation
End Function
Function MomCreateObject(ByVal sProgramId)
Dim ObjError
Set ObjError = New Error
On Error Resume Next
Set MomCreateObject = CreateObject(sProgramId)
ObjError.Save
On Error Goto 0
If ObjError.Number <> 0 Then WScript.Quit
End Function
Class Error
Private m_lNumber
Private m_sSource
Private m_sDescription
Private m_sHelpContext
Private m_sHelpFile
Public Sub Save()
m_lNumber = Err.number
m_sSource = Err.Source
m_sDescription = Err.Description
m_sHelpContext = Err.HelpContext
m_sHelpFile = Err.helpfile
End Sub
Public Sub Raise()
Err.Raise m_lNumber, m_sSource, m_sDescription, m_sHelpFile, m_sHelpContext
End Sub
Public Sub Clear()
m_lNumber = 0
m_sSource = ""
m_sDescription = ""
m_sHelpContext = ""
m_sHelpFile = ""
End Sub
Public Default Property Get Number()
Number = m_lNumber
End Property
Public Property Get Source()
Source = m_sSource
End Property
Public Property Get Description()
Description = m_sDescription
End Property
Public Property Get HelpContext()
HelpContext = m_sHelpContext
End Property
Public Property Get HelpFile()
HelpFile = m_sHelpFile
End Property
End Class </Script></ScriptBody>
<TimeoutSeconds>$Config/TimeoutSeconds$</TimeoutSeconds>
</DataSource>
</MemberModules>
<Composition>
<Node ID="DataSource"/>
</Composition>
</Composite>
</ModuleImplementation>
<OutputType>System!System.Discovery.Data</OutputType>
</DataSourceModuleType>
Home
Show References: