<?xml version="1.0" encoding="windows-1251"?>
<document type="SelFTrendxTest">
  <xTest type="USER_SCRIPT" 
        alias="MSAD_Server_Test" 
        TitleRus="Тест оценки 'здоровья' сервера MS Active Directory" 
        TitleRootRus="Тесты оценки 'здоровья' серверов MS Windows WMI" 
        TitleEng="MS Active Directory Server Performance Test" 
        TitleRootEng="MS Windows Servers Performance Tests WMI" 
        TrafficLightsName="MS Active Directory Server Performance Test"
        Version="1.1">
    <Files>
      <File type="conf" name="VB.WP.MSADs.xTest.xml"/>
      <File type="help" name="XT.VB.what-Performance.html"/>
      <File type="dll" name="ST_SCTest.dll"/>
    </Files>
    <Keywords>
      <Keyword>Windows</Keyword>
      <Keyword>Active Directory</Keyword>
      <Keyword>WMI</Keyword>
      <Keyword>LDAP</Keyword>
    </Keywords>
    <!--
    $Id: VB.WP.ADsPerformance.XFiles.xml,v 1.1 2009/04/28 10:53:12 bag Exp $            
-->
    <xTestProps>
      <log_level_def>5</log_level_def>
      <truncate_log>0</truncate_log>
      <AverInervDuration>60</AverInervDuration>
      <discovery_func>OnDiscovery</discovery_func>
      <work_func>OnDataReceived</work_func>
    </xTestProps>

    <parameters TitleRus="Список контролируемых ресурсов:" TitleEng="Servers List:">
      <resources>
        <resource_id TitleRus="Имя Windows компьютера" TitleEng="Name"></resource_id>
      </resources>

      <common_attribs TitleRus="Список параметров (общие):" TitleEng="Parameters List (common):" SubTitleRus="Параметр" SubTitleEng="Parameter">
        <!-- Type: "String", "Bool", "Integer", "Double" -->

        <Attrib Type="String" TitleRus="Пороговые значения метрики 'DS поисковые подоперации в сек' (через ;)" TitleEng="Tresholds for 'DS Search sub-operations per sec' (; separated)" Alias="Thrld.DSSearchsuboperationsPersec">"80;40;20;10"</Attrib>
        <Attrib Type="String" TitleRus="Пороговые значения метрики 'LDAP поиск в сек' (через ;)" TitleEng="Tresholds for 'LDAP Searches per sec' (; separated)" Alias="Thrld.LDAPSearchesPersec">"80;40;20;10"</Attrib>
        <Attrib Type="String" TitleRus="Пороговые значения метрики 'LDAP сеансы клиентов' (через ;)" TitleEng="Tresholds for 'LDAP Client Sessions' (; separated)" Alias="Thrld.LDAPClientSessions">"40;30;20;10"</Attrib>
        <Attrib Type="String" TitleRus="Пороговые значения метрики 'Время успешной привязки LDAP в миллисек' (через ;)" TitleEng="Tresholds for 'LDAP Bind Time in msec' (; separated)" Alias="Thrld.LDAPBindTime">"400;300;200;100"</Attrib>
        <Attrib Type="String" TitleRus="Пороговые значения метрики 'Текущее количество потоков' (через ;)" TitleEng="Tresholds for 'DS Threads in Use' (; separated)" Alias="Thrld.DSThreadsinUse">"40;30;20;10"</Attrib>
        <Attrib Type="String" TitleRus="Пороговые значения метрики 'NTLM аутентификации в сек' (через ;)" TitleEng="Tresholds for 'NTLM Authentications per sec' (; separated)" Alias="Thrld.NTLMAuthentications">"40;30;20;10"</Attrib>
        <Attrib Type="String" TitleRus="Пороговые значения метрики 'Аутентификации Kerberos в сек' (через ;)" TitleEng="Tresholds for 'Kerberos Authentications per sec' (; separated)" Alias="Thrld.KerberosAuthentications">"40;30;20;10"</Attrib>
        <Attrib Type="String" TitleRus="Пороговые значения метрики 'Сжатый размер входящих данных репликации в байтах/сек' (через ;)" TitleEng="Tresholds for 'Replication Inbound Compressed Bytes per sec' (; separated)" Alias="Thrld.DRAInboundBytesCompressedBetweenSitesAfterCompressionPersec">"8000;4000;2000;1000"</Attrib>
        <Attrib Type="String" TitleRus="Пороговые значения метрики 'Сжатый размер исходящих данных репликации в байтах/сек' (через ;)" TitleEng="Tresholds for 'Replication Outbound Compressed Bytes per sec' (; separated)" Alias="Thrld.DRAOutboundBytesCompressedBetweenSitesAfterCompressionPersec">"8000;4000;2000;1000"</Attrib>
        <Attrib Type="String" TitleRus="Пороговые значения метрики 'Размер несжатых исходящих данных репликации в байтах/сек' (через ;)" TitleEng="Tresholds for 'Replication Outbound Not Compressed Bytes per sec' (; separated)" Alias="Thrld.DRAOutboundBytesNotCompressedWithinSitePersec">"16000;8000;4000;2000"</Attrib>
        <Attrib Type="String" TitleRus="Пороговые значения метрики 'Общее количество исходящих байт репликации в сек' (через ;)" TitleEng="Tresholds for 'Replication Outbound Bytes Total per sec' (; separated)" Alias="Thrld.DRAOutboundBytesTotalPersec">"24000;12000;6000;3000"</Attrib>
      </common_attribs>

      <resource_attribs TitleRus="Список параметров:" TitleEng="Parameters List:" SubTitleRus="Параметр" SubTitleEng="Parameter" >
        <Attrib Type="Enum" TitleRus="Тип аутентификации" TitleEng="Type of authentication" Alias="Auth">
          <Attrib_enum TitleRus="Использовать встроенную систему безопасности Windows NT" TitleEng="Use Windows NT Integrated security" Selected="Yes">"1"</Attrib_enum>
          <Attrib_enum TitleRus="Использовать заданные имя пользователя и пароль" TitleEng="Use a specific user name and password" Selected="No">"2"</Attrib_enum>
        </Attrib>
        <Attrib Type="String" TitleRus="Имя пользователя" TitleEng="Username" Alias="User">user</Attrib>
        <Attrib Type="SecureString" TitleRus="Пароль" TitleEng="Password" Alias="Pass">pass</Attrib>

      </resource_attribs>
    </parameters>

    <popupdisplay>
      <description ru="Тест оценки 'здоровья' сервера MS Active Directory" en="MS Active Directory Server Performance Test"></description>
      <!-- function: "EventCount", "Average", "Maximum", "Minimum" -->
    </popupdisplay>

    <Script language="VBScript">
      <!--
Option Explicit

Sub OnDiscovery(ByRef ResSet)
    'stop
	
    On Error Resume Next
    Err.Clear
	
    Dim ErrorCode
    Dim objWMIService, CompName, SLAEventName, SLAAliasName, Auth, User, Pass
    Dim l_strTLName_en, l_strTLName_ru, Unid, i, ResCount, Error, TLError
    Dim l_strMsg
    Dim objRefresher
    Dim l_objADs, l_arrThrld
	
    'Ведение лога
    ResSet.LogMsg("*** Start Sub OnDiscovery ***")  
    ResSet.SendProgressMessage("Start Discovery...")
    
    'Пороги
    ResSet.LogMsg("Try to getting Metrics Thresholds")
    ErrorCode = CheckMetricsThrld(ResSet)
    if ErrorCode <> 0 Then
		  Exit Sub
    End If
    
    'количество ресурсов
    ResCount = ResSet.Count     
    Unid = ResSet.UnidBase
    ResSet.LogMsg("ResSet.Count: " & ResSet.Count & " ResSet.UnidBase: " & ResSet.UnidBase)
	
    For i=0 To ResCount - 1
        'имя компьютера
        CompName=ResSet.Resource(i).Name   
        ResSet.SendProgressMessage("Check: " & CompName & ". Just a second, please")	
        Auth = ResSet.Resource(i).Attrib("Auth").Value
        User = ResSet.Resource(i).Attrib("User").Value
        Pass = ResSet.Resource(i).Attrib("Pass").Value

        Set objRefresher = CreateObject("PLSWbemRefresherComponent.PLSWbemRefresher")

        If auth = "1" Then
            Set objWMIService = objRefresher.GetObject(CompName,"root\CIMV2",vbNull,vbNull,vbNull,vbNull,0,vbNull)
        Else
            Set objWMIService = objRefresher.GetObject(CompName,"root\CIMV2",User,Pass,vbNull,vbNull,0,vbNull)
        End If
        
        'Обработка исключений	
        If Err.Number<>0 Then      
            ResSet.ScriptError = -1
            ResSet.ScriptErrorInfo = Err.Description & "Ошибка при запуске теста. Нет возможности работать с устройством: '" & CompName
            ResSet.LogMsg ("*** Start Description Error ***")
            ResSet.LogMsg ("Computer name: " & CompName)
            ResSet.LogMsg ("Error number: " & Err.Number)
            ResSet.LogMsg ("Error Description: " & Err.Description)
            ResSet.LogMsg ("*** End Description Error ***")
            Exit Sub
        End If

'// \ADs\DS Search sub-operations/sec         Win32_PerfFormattedData_NTDS_NTDS=@ DSSearchsuboperationsPersec
'// \ADs\LDAP Searches/sec                    LDAPSearchesPersec
'// \ADs\LDAP Client Sessions                 LDAPClientSessions
'// \ADs\LDAP Bind Time in msec               LDAPBindTime
'// \ADs\DS Threads in Use                    DSThreadsinUse
'// \ADs\NTLM Authentications/sec             NTLMAuthentications
'// \ADs\Kerberos Authentications/sec         KerberosAuthentications
'// \ADs\DRA Inbound Bytes Compressed/sec     DRAInboundBytesCompressedBetweenSitesAfterCompressionPersec
'// \ADs\DRA Outbound Bytes Compressed/sec    DRAOutboundBytesCompressedBetweenSitesAfterCompressionPersec
'// \ADs\DRA Outbound Bytes Not Compressed/sec  DRAOutboundBytesNotCompressedWithinSitePersec
'// \ADs\DRA Outbound Bytes Total/sec         DRAOutboundBytesTotalPersec

        'stop
        l_objADs = Null
        Set l_objADs = objRefresher.Add (objWMIService, "Win32_PerfFormattedData_NTDS_NTDS=@").Object
		                         
        objRefresher.Refresh

        If Err.Number = 0 Then
            ResSet.Sleep 1000
            objRefresher.Refresh
          
            l_strMsg = "Vbs: " & CompName & " DSSearchsuboperationsPersec:" & l_objADs.DSSearchsuboperationsPersec
            ResSet.LogMsg (l_strMsg)
          
            l_strMsg = "Vbs: " & CompName & " LDAPSearchesPersec:" & l_objADs.LDAPSearchesPersec
            ResSet.LogMsg (l_strMsg)
                
            l_strMsg = "Vbs: " & CompName & " LDAPClientSessions:" & l_objADs.LDAPClientSessions
            ResSet.LogMsg (l_strMsg)

            l_strMsg = "Vbs: " & CompName & " DSThreadsinUse:" & l_objADs.DSThreadsinUse
            ResSet.LogMsg (l_strMsg)

            l_strMsg = "Vbs: " & CompName & " NTLMAuthentications:" & l_objADs.NTLMAuthentications
            ResSet.LogMsg (l_strMsg)

            l_strMsg = "Vbs: " & CompName & " KerberosAuthentications:" & l_objADs.KerberosAuthentications
            ResSet.LogMsg (l_strMsg)
            
            l_strMsg = "Vbs: " & CompName & " DRAInboundBytesCompressedBetweenSitesAfterCompressionPersec:" & l_objADs.DRAInboundBytesCompressedBetweenSitesAfterCompressionPersec
            ResSet.LogMsg (l_strMsg)
            
            l_strMsg = "Vbs: " & CompName & " DRAOutboundBytesCompressedBetweenSitesAfterCompressionPersec:" & l_objADs.DRAOutboundBytesCompressedBetweenSitesAfterCompressionPersec
            ResSet.LogMsg (l_strMsg)
            
            l_strMsg = "Vbs: " & CompName & " DRAOutboundBytesNotCompressedWithinSitePersec:" & l_objADs.DRAOutboundBytesNotCompressedWithinSitePersec
            ResSet.LogMsg (l_strMsg)

            l_strMsg = "Vbs: " & CompName & " DRAOutboundBytesTotalPersec:" & l_objADs.DRAOutboundBytesTotalPersec
            ResSet.LogMsg (l_strMsg)

        End If
      
        If Err.Number <> 0 Then
            ResSet.ScriptError = -1
            ResSet.ScriptErrorInfo = Err.Description & "2. Ошибка при запуске теста. Нет возможности работать с устройством: '" & CompName & "'. Подробности в файле: xfiles_log.txt"
            ResSet.LogMsg ("*** Start Description Error ***")
            ResSet.LogMsg ("Computer name: " & CompName)
            ResSet.LogMsg ("Error number: " & Err.Number)
            ResSet.LogMsg ("Error Description: " & Err.Description)
            ResSet.LogMsg ("*** End Description Error ***")
            Exit Sub
        End If

        ' Availability(%)
        SLAEventName = "[" & UCase(CompName) & "] Availability(%)"
        SLAAliasName = "Availability_" &  UCase(CompName)
        Error = ResSet.EventAdd(SLAEventName, SLAAliasName, Unid)
        l_strTLName_ru = SLAEventName
        l_strTLName_en = SLAEventName
        TLError = ResSet.AddTrafficLight(SLAAliasName, l_strTLName_ru, l_strTLName_en, "Average", "<", 50, 70, 80, 99)

        ' ADs\DS Search sub-operations/sec
        SLAEventName = "[" & UCase(CompName) & "] ADs\DS Search sub-operations/sec"
        SLAAliasName = "DSSearchsuboperationsPersec_" &  UCase(CompName)
        Error = ResSet.EventAdd(SLAEventName, SLAAliasName, 0)
        l_arrThrld = GetThresholdForTL(ResSet.CommonProp.Attrib("Thrld.DSSearchsuboperationsPersec").Value)
        If IsArray(l_arrThrld) Then
            l_strTLName_ru = SLAEventName
            l_strTLName_en = SLAEventName
            TLError = ResSet.AddTrafficLight(SLAAliasName, l_strTLName_ru, l_strTLName_en, "Average", ">", l_arrThrld(0), l_arrThrld(1), l_arrThrld(2), l_arrThrld(3))
        Else
		        ResSet.ScriptError = 3
		        ResSet.ScriptErrorInfo = "Пороговые значения для Thrld.DSSearchsuboperationsPersec в свойствах теста указаны не верно! Проверьте настройки и повторите запуск тестов."
		        Exit Sub
        End If

        ' ADs\LDAP Searches/sec
        SLAEventName = "[" & UCase(CompName) & "] ADs\LDAP Searches/sec"
        SLAAliasName = "LDAPSearchesPersec_" &  UCase(CompName)
        Error = ResSet.EventAdd(SLAEventName, SLAAliasName, 0)
        l_arrThrld = GetThresholdForTL(ResSet.CommonProp.Attrib("Thrld.LDAPSearchesPersec").Value)
        If IsArray(l_arrThrld) Then
            l_strTLName_ru = SLAEventName
            l_strTLName_en = SLAEventName
            TLError = ResSet.AddTrafficLight(SLAAliasName, l_strTLName_ru, l_strTLName_en, "Average", ">", l_arrThrld(0), l_arrThrld(1), l_arrThrld(2), l_arrThrld(3))
        Else
		        ResSet.ScriptError = 3
		        ResSet.ScriptErrorInfo = "Пороговые значения для Thrld.LDAPSearchesPersec в свойствах теста указаны не верно! Проверьте настройки и повторите запуск тестов."
		        Exit Sub
        End If

        ' \ADs\LDAP Client Sessions
        SLAEventName = "[" & UCase(CompName) & "] ADs\LDAP Client Sessions"
        SLAAliasName = "LDAPClientSessions_" &  UCase(CompName)
        Error = ResSet.EventAdd(SLAEventName, SLAAliasName, 0)
        l_arrThrld = GetThresholdForTL(ResSet.CommonProp.Attrib("Thrld.LDAPClientSessions").Value)
        If IsArray(l_arrThrld) Then
            l_strTLName_ru = SLAEventName
            l_strTLName_en = SLAEventName
            TLError = ResSet.AddTrafficLight(SLAAliasName, l_strTLName_ru, l_strTLName_en, "Average", ">", l_arrThrld(0), l_arrThrld(1), l_arrThrld(2), l_arrThrld(3))
        Else
		        ResSet.ScriptError = 3
		        ResSet.ScriptErrorInfo = "Пороговые значения для Thrld.LDAPClientSessions в свойствах теста указаны не верно! Проверьте настройки и повторите запуск тестов."
		        Exit Sub
        End If
        
        ' \ADs\LDAP Bind Time in msec
        SLAEventName = "[" & UCase(CompName) & "] ADs\LDAP Bind Time in msec"
        SLAAliasName = "LDAPBindTime_" &  UCase(CompName)
        Error = ResSet.EventAdd(SLAEventName, SLAAliasName, 0)
        l_arrThrld = GetThresholdForTL(ResSet.CommonProp.Attrib("Thrld.LDAPBindTime").Value)
        If IsArray(l_arrThrld) Then
            l_strTLName_ru = SLAEventName
            l_strTLName_en = SLAEventName
            TLError = ResSet.AddTrafficLight(SLAAliasName, l_strTLName_ru, l_strTLName_en, "Average", ">", l_arrThrld(0), l_arrThrld(1), l_arrThrld(2), l_arrThrld(3))
        Else
		        ResSet.ScriptError = 3
		        ResSet.ScriptErrorInfo = "Пороговые значения для Thrld.LDAPBindTime в свойствах теста указаны не верно! Проверьте настройки и повторите запуск тестов."
		        Exit Sub
        End If

        ' \ADs\DS Threads in Use
        SLAEventName = "[" & UCase(CompName) & "] ADs\DS Threads in Use"
        SLAAliasName = "DSThreadsinUse_" &  UCase(CompName)
        Error = ResSet.EventAdd(SLAEventName, SLAAliasName, 0)
        l_arrThrld = GetThresholdForTL(ResSet.CommonProp.Attrib("Thrld.DSThreadsinUse").Value)
        If IsArray(l_arrThrld) Then
            l_strTLName_ru = SLAEventName
            l_strTLName_en = SLAEventName
            TLError = ResSet.AddTrafficLight(SLAAliasName, l_strTLName_ru, l_strTLName_en, "Average", ">", l_arrThrld(0), l_arrThrld(1), l_arrThrld(2), l_arrThrld(3))
        Else
		        ResSet.ScriptError = 3
		        ResSet.ScriptErrorInfo = "Пороговые значения для Thrld.DSThreadsinUse в свойствах теста указаны не верно! Проверьте настройки и повторите запуск тестов."
		        Exit Sub
        End If

        ' \ADs\NTLM Authentications/sec
        SLAEventName = "[" & UCase(CompName) & "] ADs\NTLM Authentications/sec"
        SLAAliasName = "NTLMAuthentications_" &  UCase(CompName)
        Error = ResSet.EventAdd(SLAEventName, SLAAliasName, 0)
        l_arrThrld = GetThresholdForTL(ResSet.CommonProp.Attrib("Thrld.NTLMAuthentications").Value)
        If IsArray(l_arrThrld) Then
            l_strTLName_ru = SLAEventName
            l_strTLName_en = SLAEventName
            TLError = ResSet.AddTrafficLight(SLAAliasName, l_strTLName_ru, l_strTLName_en, "Average", ">", l_arrThrld(0), l_arrThrld(1), l_arrThrld(2), l_arrThrld(3))
        Else
		        ResSet.ScriptError = 3
		        ResSet.ScriptErrorInfo = "Пороговые значения для Thrld.NTLMAuthentications в свойствах теста указаны не верно! Проверьте настройки и повторите запуск тестов."
		        Exit Sub
        End If

        ' \ADs\Kerberos Authentications/sec
        SLAEventName = "[" & UCase(CompName) & "] ADs\Kerberos Authentications/sec"
        SLAAliasName = "KerberosAuthentications_" &  UCase(CompName)
        Error = ResSet.EventAdd(SLAEventName, SLAAliasName, 0)
        l_arrThrld = GetThresholdForTL(ResSet.CommonProp.Attrib("Thrld.KerberosAuthentications").Value)
        If IsArray(l_arrThrld) Then
            l_strTLName_ru = SLAEventName
            l_strTLName_en = SLAEventName
            TLError = ResSet.AddTrafficLight(SLAAliasName, l_strTLName_ru, l_strTLName_en, "Average", ">", l_arrThrld(0), l_arrThrld(1), l_arrThrld(2), l_arrThrld(3))
        Else
		        ResSet.ScriptError = 3
		        ResSet.ScriptErrorInfo = "Пороговые значения для Thrld.KerberosAuthentications в свойствах теста указаны не верно! Проверьте настройки и повторите запуск тестов."
		        Exit Sub
        End If
        
        ' \ADs\DRA Inbound Bytes Compressed/sec
        SLAEventName = "[" & UCase(CompName) & "] ADs\DRA Inbound Bytes Compressed/sec"
        SLAAliasName = "DRAInboundBytesCompressedBetweenSitesAfterCompressionPersec_" &  UCase(CompName)
        Error = ResSet.EventAdd(SLAEventName, SLAAliasName, 0)
        l_arrThrld = GetThresholdForTL(ResSet.CommonProp.Attrib("Thrld.DRAInboundBytesCompressedBetweenSitesAfterCompressionPersec").Value)
        If IsArray(l_arrThrld) Then
            l_strTLName_ru = SLAEventName
            l_strTLName_en = SLAEventName
            TLError = ResSet.AddTrafficLight(SLAAliasName, l_strTLName_ru, l_strTLName_en, "Average", ">", l_arrThrld(0), l_arrThrld(1), l_arrThrld(2), l_arrThrld(3))
        Else
		        ResSet.ScriptError = 3
		        ResSet.ScriptErrorInfo = "Пороговые значения для Thrld.DRAInboundBytesCompressedBetweenSitesAfterCompressionPersec в свойствах теста указаны не верно! Проверьте настройки и повторите запуск тестов."
		        Exit Sub
        End If
        
        ' \ADs\DRA Outbound Bytes Compressed/sec
        SLAEventName = "[" & UCase(CompName) & "] ADs\DRA Outbound Bytes Compressed/sec"
        SLAAliasName = "DRAOutboundBytesCompressedBetweenSitesAfterCompressionPersec_" &  UCase(CompName)
        Error = ResSet.EventAdd(SLAEventName, SLAAliasName, 0)
        l_arrThrld = GetThresholdForTL(ResSet.CommonProp.Attrib("Thrld.DRAOutboundBytesCompressedBetweenSitesAfterCompressionPersec").Value)
        If IsArray(l_arrThrld) Then
            l_strTLName_ru = SLAEventName
            l_strTLName_en = SLAEventName
            TLError = ResSet.AddTrafficLight(SLAAliasName, l_strTLName_ru, l_strTLName_en, "Average", ">", l_arrThrld(0), l_arrThrld(1), l_arrThrld(2), l_arrThrld(3))
        Else
		        ResSet.ScriptError = 3
		        ResSet.ScriptErrorInfo = "Пороговые значения для Thrld.DRAOutboundBytesCompressedBetweenSitesAfterCompressionPersec в свойствах теста указаны не верно! Проверьте настройки и повторите запуск тестов."
		        Exit Sub
        End If

        ' \ADs\Outbound Bytes Not Compressed/sec
        SLAEventName = "[" & UCase(CompName) & "] ADs\Outbound Bytes Not Compressed/sec"
        SLAAliasName = "DRAOutboundBytesNotCompressedWithinSitePersec_" &  UCase(CompName)
        Error = ResSet.EventAdd(SLAEventName, SLAAliasName, 0)
        l_arrThrld = GetThresholdForTL(ResSet.CommonProp.Attrib("Thrld.DRAOutboundBytesNotCompressedWithinSitePersec").Value)
        If IsArray(l_arrThrld) Then
            l_strTLName_ru = SLAEventName
            l_strTLName_en = SLAEventName
            TLError = ResSet.AddTrafficLight(SLAAliasName, l_strTLName_ru, l_strTLName_en, "Average", ">", l_arrThrld(0), l_arrThrld(1), l_arrThrld(2), l_arrThrld(3))
        Else
		        ResSet.ScriptError = 3
		        ResSet.ScriptErrorInfo = "Пороговые значения для Thrld.DRAOutboundBytesNotCompressedWithinSitePersec в свойствах теста указаны не верно! Проверьте настройки и повторите запуск тестов."
		        Exit Sub
        End If

        ' \ADs\DRA Outbound Bytes Total/sec
        SLAEventName = "[" & UCase(CompName) & "] ADs\DRA Outbound Bytes Total/sec"
        SLAAliasName = "DRAOutboundBytesTotalPersec_" &  UCase(CompName)
        Error = ResSet.EventAdd(SLAEventName, SLAAliasName, 0)
        l_arrThrld = GetThresholdForTL(ResSet.CommonProp.Attrib("Thrld.DRAOutboundBytesTotalPersec").Value)
        If IsArray(l_arrThrld) Then
            l_strTLName_ru = SLAEventName
            l_strTLName_en = SLAEventName
            TLError = ResSet.AddTrafficLight(SLAAliasName, l_strTLName_ru, l_strTLName_en, "Average", ">", l_arrThrld(0), l_arrThrld(1), l_arrThrld(2), l_arrThrld(3))
        Else
		        ResSet.ScriptError = 3
		        ResSet.ScriptErrorInfo = "Пороговые значения для Thrld.DRAOutboundBytesTotalPersec в свойствах теста указаны не верно! Проверьте настройки и повторите запуск тестов."
		        Exit Sub
        End If

    Next
	
    ResSet.LogMsg("*** End Sub OnDiscovery ***")
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Sub OnDataReceived(ByRef ResSet)

    On Error Resume Next
    Err.Clear

    Dim CompName, SLAEventName, SLAAliasName, l_iIndx, l_iResCount
    Dim l_ObjConnectorsCollection, l_objRefresher, l_strConnectorAlias, l_strProcessAlias
    Dim period, l_objItem
    Dim l_bConnect, l_objADs, l_strLogMsg, l_strSLAAliasName
    Dim l_bSucceededToPing, l_objWMI, l_objPingResults, l_oPingResult

    'stop
    ResSet.LogMsg ( Timer & ": " & "*** Start Sub OnDataReceived ***")
    l_iResCount = ResSet.Count
	
    Set l_ObjConnectorsCollection = CreateObject("Scripting.Dictionary")
	
    Init ResSet, l_ObjConnectorsCollection
    ResSet.Sleep(1000)
    period = 0
	
    'Пока не будет произведена остановка теста
    Do While Not ResSet.StopTest        
        If ResSet.IsNewSLaPeriod Then
            period = period + 1
            ResSet.LogMsg ( Timer & ": " & "Start While Loop")
            
            ResetEvents ResSet
                            			
            For l_iIndx = 0 To l_iResCount - 1
                Err.Clear
                CompName = ResSet.Resource(l_iIndx).Name

                l_strConnectorAlias = "objRefresher_" & CompName
                Set l_objRefresher = l_ObjConnectorsCollection.Item(l_strConnectorAlias) 

                'Пингуем компьютер для уменьшения возможного тайм-аута
                l_bSucceededToPing = False

                Set l_objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}//./root/cimv2")
                Set l_objPingResults = l_objWMI.ExecQuery("Select * FROM Win32_PingStatus WHERE Address = '" & CompName & "'")
                
                For Each l_oPingResult In l_objPingResults
                    If l_oPingResult.StatusCode = 0 Then
                        l_bSucceededToPing = True
                        Exit For
                    End If
                Next

                If l_bSucceededToPing <> True Then
                    ResSet.LogMsg("Failed to ping: " & CompName)  
                    Err.Raise vbObjectError 
                End If

                If Err.Number = 0 Then
                    l_objRefresher.Refresh
                End If

                If Err.Number <> 0 Then
                    '//Availability 
                    l_strSLAAliasName = "Availability_" &  UCase(CompName)
                    ResSet.Events(l_strSLAAliasName).Value = 0
                    l_strLogMsg = "OnDataReceived: " & CompName  & "Error: " &  Err.Description & "(" & Err.Number & ")"
                    ResSet.LogMsg(l_strLogMsg)
                Else
                    l_strProcessAlias = "objads_" & CompName
                    Set l_objADs = l_ObjConnectorsCollection.Item(l_strProcessAlias) 

                    l_strSLAAliasName = "DSSearchsuboperationsPersec_" &  UCase(CompName)
                    ResSet.Events(l_strSLAAliasName).Value = l_objADs.DSSearchsuboperationsPersec
                    
                    l_strSLAAliasName = "LDAPSearchesPersec_" &  UCase(CompName)
                    ResSet.Events(l_strSLAAliasName).Value = l_objADs.LDAPSearchesPersec
                    
                    l_strSLAAliasName = "LDAPClientSessions_" &  UCase(CompName)
                    ResSet.Events(l_strSLAAliasName).Value = l_objADs.LDAPClientSessions
                    
                    l_strSLAAliasName = "LDAPBindTime_" &  UCase(CompName)
                    ResSet.Events(l_strSLAAliasName).Value = l_objADs.LDAPBindTime

                    l_strSLAAliasName = "DSThreadsinUse_" &  UCase(CompName)
                    ResSet.Events(l_strSLAAliasName).Value = l_objADs.DSThreadsinUse

                    l_strSLAAliasName = "NTLMAuthentications_" &  UCase(CompName)
                    ResSet.Events(l_strSLAAliasName).Value = l_objADs.NTLMAuthentications
                    
                    l_strSLAAliasName = "KerberosAuthentications_" &  UCase(CompName)
                    ResSet.Events(l_strSLAAliasName).Value = l_objADs.KerberosAuthentications

                    l_strSLAAliasName = "DRAInboundBytesCompressedBetweenSitesAfterCompressionPersec_" &  UCase(CompName)
                    ResSet.Events(l_strSLAAliasName).Value = l_objADs.DRAInboundBytesCompressedBetweenSitesAfterCompressionPersec

                    l_strSLAAliasName = "DRAOutboundBytesCompressedBetweenSitesAfterCompressionPersec_" &  UCase(CompName)
                    ResSet.Events(l_strSLAAliasName).Value = l_objADs.DRAOutboundBytesCompressedBetweenSitesAfterCompressionPersec

                    l_strSLAAliasName = "DRAOutboundBytesNotCompressedWithinSitePersec_" &  UCase(CompName)
                    ResSet.Events(l_strSLAAliasName).Value = l_objADs.DRAOutboundBytesNotCompressedWithinSitePersec

                    l_strSLAAliasName = "DRAOutboundBytesTotalPersec_" &  UCase(CompName)
                    ResSet.Events(l_strSLAAliasName).Value = l_objADs.DRAOutboundBytesTotalPersec

                    l_strSLAAliasName = "Availability_" &  UCase(CompName)              
                    ResSet.Events(l_strSLAAliasName).Value = 100.0               
                End If
                
                Set l_objADs = Nothing
                Set l_objRefresher = Nothing
                
                ReinitInitComp ResSet, l_iIndx, l_ObjConnectorsCollection
            Next
	 
            ResSet.SendSLaEvents()
        End if
	    
        ResSet.Sleep(1000)
    Loop
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'Формирование массива из элемента строки,разделенного запятой
Function GetThresholdForTL(l_ThresholdString)       
    Dim arrTL, i
    arrTL = Split(l_ThresholdString, ";")
    If UBound(arrTL) <> 3 Then 
        GetThresholdForTL = "Данные не верны, проверьте правильность введенных пороговых значений в настройках теста - 1"
        Exit Function
    End If
	
    For i = LBound(arrTL) To UBound(arrTL)
        If Not IsNumeric (Trim(arrTL(i))) Then
            GetThresholdForTL = "Данные не верны, проверьте правильность введенных пороговых значений в настройках теста - 2"
            Exit Function
        End If
    Next
	
    GetThresholdForTL = arrTL
End Function

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Sub ReinitInitComp(ByRef ResSet, l_iIndx, ByRef ref_ObjConnectorsCollection)
    Dim CompName, Auth, User, Pass, l_strLogMsg, l_strConnectorAlias
    Dim l_ObjWMIService, l_objRefresher, l_strProcAlias, l_objADs

    On Error Resume Next
    Err.Clear

    CompName=ResSet.Resource(l_iIndx).Name

    l_strProcAlias = "objads_" & CompName
    ref_ObjConnectorsCollection.Remove(l_strProcAlias)

    l_strConnectorAlias = "objRefresher_" & CompName   
    ref_ObjConnectorsCollection.Remove(l_strConnectorAlias)

    Err.Clear

    Auth = Cint(ResSet.Resource(l_iIndx).Attrib("Auth").Value)
    User = ResSet.Resource(l_iIndx).Attrib("User").Value
    Pass = ResSet.Resource(l_iIndx).Attrib("Pass").Value

    l_strLogMsg = "ReinitInitComp: Try To Create connector to Server: " & CompName
    ResSet.LogMsg(l_strLogMsg)

    Set l_objRefresher = CreateObject("PLSWbemRefresherComponent.PLSWbemRefresher")

    If auth = 1 then
        Set l_ObjWMIService = l_objRefresher.GetObject(CompName,"root\CIMV2",vbNull,vbNull,vbNull,vbNull,0,vbNull)
    Else
        Set l_ObjWMIService = l_objRefresher.GetObject(CompName,"root\CIMV2",User,Pass,vbNull,vbNull,0,vbNull)
    End If

    If Err.Number <> 0 Then 
        l_strLogMsg = "ReinitInitComp: " & CompName  & " Error: " &  Err.Description & "(" & Err.Number & ")"
        ResSet.LogMsg(l_strLogMsg)
        Exit Sub
    End If
    l_strLogMsg = "ReinitInitComp: Ok!Try to get perf counters from Server: " & CompName
    ResSet.LogMsg(l_strLogMsg)

    Set l_objADs = l_objRefresher.Add (l_ObjWMIService, "Win32_PerfFormattedData_NTDS_NTDS=@").Object

    If Err.Number <> 0 Then 
        l_strLogMsg = "ReinitInitComp: " & CompName  & " Error: " &  Err.Description & "(" & Err.Number & ")"
        ResSet.LogMsg(l_strLogMsg)
        Exit Sub
    End If
    
    l_objRefresher.AutoReconnect = False

    l_strConnectorAlias = "objRefresher_" & CompName
    ref_ObjConnectorsCollection.Add l_strConnectorAlias, l_objRefresher
    
    l_strConnectorAlias = "objads_" & CompName
    ref_ObjConnectorsCollection.Add l_strConnectorAlias, l_objADs

    l_objRefresher.Refresh
    
    l_strLogMsg = "ReinitInitComp: Ok! " & CompName
    ResSet.LogMsg(l_strLogMsg)

End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Sub InitComp(ByRef ResSet, l_iIndx, ByRef ref_objRefresher, ByRef ref_objADs)
    Dim CompName, Auth, User, Pass, l_strLogMsg, l_strConnectorAlias
    Dim l_ObjWMIService, l_objRefresher

    On Error Resume Next
    Err.Clear

    CompName=ResSet.Resource(l_iIndx).Name
    Auth = Cint(ResSet.Resource(l_iIndx).Attrib("Auth").Value)
    User = ResSet.Resource(l_iIndx).Attrib("User").Value
    Pass = ResSet.Resource(l_iIndx).Attrib("Pass").Value

    l_strLogMsg = "InitComp: Try To Create connector to Server: " & CompName
    ResSet.LogMsg(l_strLogMsg)

    Set ref_objRefresher = CreateObject("PLSWbemRefresherComponent.PLSWbemRefresher")

    If auth = 1 then
        Set l_ObjWMIService = ref_objRefresher.GetObject(CompName,"root\CIMV2",vbNull,vbNull,vbNull,vbNull,0,vbNull)
    Else
        Set l_ObjWMIService = ref_objRefresher.GetObject(CompName,"root\CIMV2",User,Pass,vbNull,vbNull,0,vbNull)
    End If

    Set ref_objADs = ref_objRefresher.Add (l_ObjWMIService, "Win32_PerfFormattedData_NTDS_NTDS=@").Object

    If Err.Number <> 0 Then 
        l_strLogMsg = "InitComp Server: " & CompName  & "Error: " &  Err.Description & "(" & Err.Number & ")"
        ResSet.LogMsg(l_strLogMsg)
        Exit Sub
    End If
    
    ref_objRefresher.AutoReconnect = True
    ref_objRefresher.Refresh

End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Sub Init(ByRef ResSet, ByRef ref_ObjConnectorsCollection)
    Dim l_iIndx, l_iResCount, CompName, Auth, User, Pass, l_strLogMsg, l_strConnectorAlias
    Dim l_ObjWMIService, l_objRefresher, l_objADs

    ResSet.LogMsg("Init: ***Start***")
    l_iResCount = ResSet.Count
    
    For l_iIndx=0 To l_iResCount - 1
        CompName=ResSet.Resource(l_iIndx).Name
        InitComp ResSet, l_iIndx, l_objRefresher, l_objADs

        If Err.Number <> 0 Then 
            l_strLogMsg = "Init Server: " & CompName  & "Error: " &  Err.Description & "(" & Err.Number & ")"
            ResSet.LogMsg(l_strLogMsg)
        Else
            l_strLogMsg = "Init: Ok! " & CompName
            ResSet.LogMsg(l_strLogMsg)
              
            l_strConnectorAlias = "objRefresher_" & CompName
            l_objRefresher.AutoReconnect = False
            ref_ObjConnectorsCollection.Add l_strConnectorAlias, l_objRefresher
            
            l_strConnectorAlias = "objads_" & CompName
            ref_ObjConnectorsCollection.Add l_strConnectorAlias, l_objADs
        End If
    Next

    ResSet.LogMsg("Init: ***End***")
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Sub ResetEvents(ByRef ResSet) 
    Dim l_iIndx
    
    For l_iIndx = 0 To ResSet.EventsCount - 1
        ResSet.Events(l_iIndx).Value = ResSet.BadValue
    Next
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Function CheckMetricsThrld(ByRef ResSet)
    Dim i, l_Pos

    CheckMetricsThrld = 0
    
    For i = 0 To  ResSet.CommonProp.Count - 1
        Dim l_AttribAlias, l_arrThreshold

        l_AttribAlias = ResSet.CommonProp.Attrib(i).Alias

        l_Pos = InStr(l_AttribAlias, "Thrld.")
        
        If l_Pos = 1 Then
            l_arrThreshold = GetThresholdForTL(ResSet.CommonProp.Attrib(i).Value)
            
            If Not IsArray(l_arrThreshold) Then
                ErrorCode = -1
		            ResSet.ScriptError = 3
		            ResSet.ScriptErrorInfo = l_arrThreshold
                CheckMetricsThrld = 1
                Exit Function
            End If
        End If
    Next
End Function

'''''''''''''''''''''''''''''''''''''''''''''

Function GetThresholdForTL(l_ThresholdString)
    Dim arrTL, i
    arrTL = Split(l_ThresholdString, ";")
    If UBound(arrTL) <> 3 Then 
        GetThresholdForTL = "Данные не верны, проверьте правильность введенных пороговых значений в настройках теста - 1"
        Exit Function
    End If
	
    For i = LBound(arrTL) To UBound(arrTL)
        If Not IsNumeric (Trim(arrTL(i))) Then
            GetThresholdForTL = "Данные не верны, проверьте правильность введенных пороговых значений в настройках теста - 2"
            Exit Function
        End If
    Next
	
    GetThresholdForTL = arrTL
End Function

-->
    </Script>
  </xTest>
</document>