1328.aspx

How to shut down COM+ applications with high call times with VB and VBScript

I posted earlier this year on How to get COM+ call times from VB and VBScript mentioning that it is possible to automatically shut down/recycle components with high call times using the COM+ Admin API. With VBScipt it is very  easy. The script below can be used from VB, VBScript or even an ASP page.

It uses the egilh.comtracker to get the COM+ call times in XML:

<applications>

      <application>

      <guid>{98CDBB6E-3CAF-46F2-ABE6-EABECD6AA4EB}</guid>

      <ID>10</ID>

      <processID>1792</processID>

      <statistics>

            <callsPerSecond>0</callsPerSecond>

            <totalCalls>0</totalCalls>

            <totalClasses>1</totalClasses>

            <totalInstances>1</totalInstances>

      </statistics>

      <classes>

            <class>

                  <progID>Test.Sleep.1</progID>

                  <bound>1</bound>

                  <inCall>0</inCall>

                  <pooled>-1</pooled>

                  <references>1</references>

                  <responseTime>120</responseTime>

                  <callsCompleted>0</callsCompleted>

                  <callsFailed>0</callsFailed>

            </class>

      </classes>

      </application>

</applications>

It loads the XML in a DOM using MSXML 3.0 and checks the responseTimes. It uses the COM+ Admin API to shut down the application if the call time is higher than the configured MAX_CALL_TIME and there are objects in call. The ShutDownApplication method works on Windows 2000 as well as Windows 2003. It has the same "brutal" effect as right clicking a COM+ application and selecting "shut down"; clients currently in call will get a COM+ error. With Windows 2003 it is possible to use recycling which routes new request to a new application instance but lets existing calls finish.

Option Explicit

 

Const MAX_CALL_TIME = 10000  'Max allowed call time in miliseconds

Const CHECK_INTERVAL = 5000  'How often we should check the call times

Const RECYCLE_REASON = 408  'The reason for the recyle. Any number is OK

 

 

'Never ending main loop that monitors the call time

Do While True

    checkCallTimes

    WScript.Sleep(CHECK_INTERVAL)

Loop

 

Private Sub checkCallTimes()

'**

'Purpose: Check the call times and shut down applications that have too high call times

    Dim oTracker 'As Object

    Dim sResult 'As String

    Dim oDOM 'As DOMDocument30

    Dim oNode 'As MSXML2.IXMLDOMNode

    Dim sProgID 'As String

    Dim lResponseTime 'As Long

    Dim lInCall 'As Long

    Dim oApp 'As MSXML2.IXMLDOMNode

    Dim bHighCallTimes 'As Boolean

 

     'Get the com+ call times

    oTracker = CreateObject("egilh.ComTracker")

    sResult = oTracker.getStatistics()

    oTracker = Nothing

 

    bHighCallTimes = False

 

    'Check call times

    oDOM = CreateObject("MSXML2.DomDocument.3.0")

    oDOM.loadXML(sResult)

    For Each oNode In oDOM.selectNodes("/applications/application/classes/class")

        lInCall = CLng(oNode.selectSingleNode("inCall").Text)

        lResponseTime = CLng(oNode.selectSingleNode("responseTime").Text)

 

        ' Check if we should recycle

        If lResponseTime > MAX_CALL_TIME And lInCall > 0 Then

            'Log that we are recycling

            sProgID = oNode.selectSingleNode("progID").Text

            WScript.Echo(Now() & " Shutting down '" & sProgID & _

                              "' because of high call time: " & lResponseTime)

 

            'We shut down the parent process: ../../processID

            oApp = oNode.parentNode.parentNode

            shutDownApplication(oApp.selectSingleNode("guid").Text)

            bHighCallTimes = True

        End If

    Next

 

    If Not bHighCallTimes Then WSCript.Echo(Now() & " Call Times OK")

End Sub

 

 

Private Sub shutDownApplication(ByVal appGuid)

'**

'Purpose: Shut down an application

'Description: Shuts down a com+ application identified by its guid.

Dim adminCatalog 'As COMAdmin.COMAdminCatalog

Dim appInstanceGUID 'As Object

 

    adminCatalog = CreateObject("COMAdmin.COMAdminCatalog")

 

    'ShutdownApplicationInstances

    adminCatalog.shutDownApplication(appGuid)

 

    adminCatalog = Nothing

End Sub