BizTalk BAM Portal Availability Monitor DataSource Provider for BizTalk Server MP

Microsoft.BizTalk.Library.Monitor.BAMPortal.DataSource (DataSourceModuleType)

This is the BizTalk BAM Portal Availability Monitor DataSource Provider for BizTalk Server MP.

Element properties:

TypeDataSourceModuleType
IsolationAny
AccessibilityPublic
RunAsMicrosoft.BizTalk.DiscoveryAccount
OutputTypeSystem.PropertyBagData

Member Modules:

ID Module Type TypeId RunAs 
DS DataSource System.CommandExecuterPropertyBagSource Default

Overrideable Parameters:

IDParameterTypeSelectorDisplay NameDescription
IntervalSecondsint$Config/IntervalSeconds$Interval SecondsThis is the Interval Seconds use to run this script.
LogSuccessEventstring$Config/LogSuccessEvent$Log Success EventThis is the Log Success Event configuration use to run this script.
TimeoutSecondsint$Config/TimeoutSeconds$Timeout SecondsThis is the Timeout Seconds use to run this script.

Source Code:

<DataSourceModuleType ID="Microsoft.BizTalk.Library.Monitor.BAMPortal.DataSource" Accessibility="Public" RunAs="Microsoft.BizTalk.DiscoveryAccount" Batching="false">
<Configuration>
<xsd:element name="IntervalSeconds" type="xsd:int"/>
<xsd:element name="TargetServer" type="xsd:string"/>
<xsd:element name="TargetWebSite" type="xsd:string"/>
<xsd:element name="LogSuccessEvent" type="xsd:boolean"/>
<xsd:element name="TimeoutSeconds" type="xsd:int"/>
</Configuration>
<OverrideableParameters>
<OverrideableParameter ID="IntervalSeconds" ParameterType="int" Selector="$Config/IntervalSeconds$"/>
<OverrideableParameter ID="LogSuccessEvent" ParameterType="string" Selector="$Config/LogSuccessEvent$"/>
<OverrideableParameter ID="TimeoutSeconds" ParameterType="int" Selector="$Config/TimeoutSeconds$"/>
</OverrideableParameters>
<ModuleImplementation>
<Composite>
<MemberModules>
<DataSource ID="DS" TypeID="System!System.CommandExecuterPropertyBagSource">
<IntervalSeconds>$Config/IntervalSeconds$</IntervalSeconds>
<ApplicationName>%windir%\system32\cscript.exe</ApplicationName>
<WorkingDirectory/>
<CommandLine>//nologo $file/BizTalkBAMPortalMonitor.vbs$ "$Config/TargetServer$" "$Config/TargetWebSite$" "$Config/LogSuccessEvent$"</CommandLine>
<TimeoutSeconds>$Config/TimeoutSeconds$</TimeoutSeconds>
<RequireOutput>true</RequireOutput>
<Files>
<File>
<Name>BizTalkBAMPortalMonitor.vbs</Name>
<Contents><Script>
' Copyright (c) Microsoft Corporation. All rights reserved

Option Explicit
SetLocale("en-us")

'Event Constants
Const EVENT_TYPE_SUCCESS = 0
Const EVENT_TYPE_ERROR = 1
Const EVENT_TYPE_WARNING = 2
Const EVENT_TYPE_INFORMATION = 4
'Other constants
Const SCRIPT_NAME = "BizTalk BAM Portal Monitor"
' Event ID Constants
Const EVENTID_SUCCESS = 99
Const EVENTID_SCRIPT_ERROR = 1000

Const APP_DISCOVERY_CONNECT_FAILURE = -1
Const APP_DISCOVERY_QUERY_FAILURE = -2
Const REGISTRY_CONNECT_FAILURE = -3
Const REGISTRY_READ_FAILURE = -4
Const HKEY_CLASSES_ROOT = &amp;H80000000
Const HKEY_CURRENT_USER = &amp;H80000001
Const HKEY_LOCAL_MACHINE = &amp;H80000002
Const HKEY_USERS = &amp;H80000003
Const HKEY_CURRENT_CONFIG = &amp;H80000005
Const StateDataType = 3

Dim oAPI, oBagState
Dim oParams, bLogSuccessEvent
Dim strMonitorStatus, strErrorDetail, strMessage
Dim dtStart

Dim TargetServer, TargetSite, strStatus, intStatus
Dim objIIS, objWMIService, colItems, objItem
Dim strWebsite, strStatusText

dtStart = Now
Set oAPI = CreateObject("Mom.ScriptAPI")

Set oParams = WScript.Arguments
if oParams.Count &lt; 3 then
strMessage = "The script '" &amp; SCRIPT_NAME &amp; "' didn't execute successfully because some parameters were missing: Param Count(" &amp; CStr(oParams.Count) &amp; ")"
CreateEvent EVENTID_SUCCESS, EVENT_TYPE_INFORMATION, strMessage
Wscript.Quit -1
End if
strMonitorStatus = "0"

TargetServer = oParams(0)
TargetSite = oParams(1)
bLogSuccessEvent = CBool(oParams(2))

Set oBagState = oAPI.CreateTypedPropertyBag(StateDataType)
GetMonitorStatus

Sub GetMonitorStatus()
Dim e
Dim sWBState, ObjWebSite
Dim boolStatus

Set e = New Error
e.Clear
On Error Resume Next
'Check status of Web Server
Set objIIS = GetObject("IIS://" &amp; TargetServer &amp; "/W3SVC/1")

e.Save
On Error Goto 0
If 0 &lt;&gt; e.number then
strMonitorStatus = "0"
strErrorDetail = SCRIPT_NAME &amp; ": - WebSite " &amp; TargetSite &amp; " Failure on Server " &amp; TargetServer &amp; " Error Detail:" &amp; e.Description
Else
intStatus = objIIS.Status

Select Case intStatus
Case 1 '"The Web server is starting."
strMonitorStatus = "0"
strErrorDetail = SCRIPT_NAME &amp; ": - WebSite " &amp; TargetSite &amp; " Failure on Server " &amp; TargetServer &amp; " Error Detail: The Web server is starting"
Case 2 '"The Web server is running."
strMonitorStatus = "1"
strErrorDetail = ""
Case 3 '"The Web server is stopping."
strMonitorStatus = "0"
strErrorDetail = SCRIPT_NAME &amp; ": - WebSite " &amp; TargetSite &amp; " Failure on Server " &amp; TargetServer &amp; " Error Detail: The Web server is stopping"
Case 4 '"The Web server is stopped."
strMonitorStatus = "0"
strErrorDetail = SCRIPT_NAME &amp; ": - WebSite " &amp; TargetSite &amp; " Failure on Server " &amp; TargetServer &amp; " Error Detail: The Web server is stopped"
Case 5 '"The Web server is pausing."
strMonitorStatus = "0"
strErrorDetail = SCRIPT_NAME &amp; ": - WebSite " &amp; TargetSite &amp; " Failure on Server " &amp; TargetServer &amp; " Error Detail: The Web server is pausing"
Case 6 '"The Web server is paused."
strMonitorStatus = "0"
strErrorDetail = SCRIPT_NAME &amp; ": - WebSite " &amp; TargetSite &amp; " Failure on Server " &amp; TargetServer &amp; " Error Detail: The Web server is paused"
Case 7 '"The Web server is continuing."
strMonitorStatus = "0"
strErrorDetail = SCRIPT_NAME &amp; ": - WebSite " &amp; TargetSite &amp; " Failure on Server " &amp; TargetServer &amp; " Error Detail: The Web server is continuing"
End Select



'Check status of a Virtual Directory
Set objWMIService = GetObject("winmgmts:{authenticationLevel=pktPrivacy}\\" _
&amp; TargetServer &amp; "\root\microsoftiisv2")

Set colItems = objWMIService.ExecQuery("Select * From IIsWebVirtualDir Where Name = " &amp; _
"'W3SVC/1/ROOT/" &amp; TargetSite &amp; "'")

For Each objItem in colItems
strStatus = objItem.AppGetStatus
If strStatus = 2 Then
strMonitorStatus = "1"
strErrorDetail = ""
ElseIf strStatus = 3 Then
strMonitorStatus = "0"
strErrorDetail = SCRIPT_NAME &amp; ": - WebSite " &amp; TargetSite &amp; " Failure on Server " &amp; TargetServer &amp; " Error Detail: The Web site is stopped"
Else
strMonitorStatus = "1"
strErrorDetail = ""
End If
Next

'Check status of Web Site
Set objIIS = GetObject("IIS://" &amp; TargetServer &amp; "/W3SVC/1/ROOT/" &amp; TargetSite)
strStatus = objIIS.AppGetStatus2

If strStatus = 2 Then
strMonitorStatus = "1"
strErrorDetail = ""
ElseIf strStatus = 3 Then
strMonitorStatus = "0"
strErrorDetail = SCRIPT_NAME &amp; ": - WebSite " &amp; TargetSite &amp; " Failure on Server " &amp; TargetServer &amp; " Error Detail: The Web site is stopped"
Else
strMonitorStatus = "1"
strErrorDetail = ""
End If
End if


boolStatus = PingSite("http://" &amp; TargetServer &amp; "/" &amp; TargetSite &amp; "/default.aspx")

If boolStatus = true Then
strMonitorStatus = "1"
strErrorDetail = ""
Else
strMonitorStatus = "0"
strErrorDetail = SCRIPT_NAME &amp; ": - WebSite " &amp; TargetSite &amp; " Failure on Server " &amp; TargetServer &amp; " Error Detail: " &amp; strStatusText
End If

If bLogSuccessEvent Then
strMessage = "The script '" &amp; SCRIPT_NAME &amp; "' completed successfully in " &amp; _
DateDiff("s", dtStart, Now) &amp; " seconds."
CreateEvent EVENTID_SUCCESS, EVENT_TYPE_INFORMATION, strMessage
End If

oBagState.AddValue "State", strMonitorStatus
oBagState.AddValue "ErrorDetail", strErrorDetail
oAPI.AddItem oBagState
Call oAPI.ReturnItems
End Sub


Sub CreateEvent(lEventID, lEventType, strMessage)
oAPI.LogScriptEvent SCRIPT_NAME,lEventID, lEventType, strMessage
End Sub

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 &lt;&gt; 0 Then ThrowScriptError "Unable to create automation object '" &amp; sProgramId &amp; "'", oError
End Function

Function PingSite( myWebsite )
Dim intStatus, objHTTP

Set objHTTP = CreateObject( "WinHttp.WinHttpRequest.5.1" )

objHTTP.Open "GET", myWebsite, False
objHTTP.SetRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MyApp 1.0; Windows NT 5.1)"
On Error Resume Next

objHTTP.Send
intStatus = objHTTP.Status

On Error Goto 0

If intStatus = 200 Or intStatus = 401 Or intStatus = 407 Then
PingSite = True
Else
If IsEmpty(intStatus) = true Then
strStatusText = "IIS Down or unavailable"
else
strStatusText = objHTTP.StatusText
End If
PingSite = False
End If

Set objHTTP = Nothing
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></Contents>
<Unicode>1</Unicode>
</File>
</Files>
</DataSource>
</MemberModules>
<Composition>
<Node ID="DS"/>
</Composition>
</Composite>
</ModuleImplementation>
<OutputType>System!System.PropertyBagData</OutputType>
</DataSourceModuleType>