<?xml version="1.0" encoding="windows-1251"?>
<document type="SelFTrendxTest">
  <xTest type="USER_SCRIPT" 
        alias="MSDHCP_Server_Test" 
        TitleRus="Тест оценки 'здоровья' сервера MS DHCP" 
        TitleRootRus="Тесты оценки 'здоровья' серверов MS Windows WMI" 
        TitleEng="DHCP Server Performance Test" 
        TitleRootEng="MS Windows Servers Performance Tests WMI" 
        TrafficLightsName="DHCP Server Performance Test"
        Version="1.1">
    <Files>
      <File type="conf" name="VB.WP.MSDHCP.xTest.xml"/>
      <File type="help" name="SLA-ONProbeHelp.html"/>
      <File type="dll" name="ST_SCTest.dll"/>
    </Files>
    <Keywords>
      <Keyword>Windows</Keyword>      
      <Keyword>WMI</Keyword>
      <Keyword>DHCP</Keyword>
    </Keywords>
    <!--
    $Id: VB.WP.MSDHCP.xTest.xml,v 1.2 2009/04/27 06:38:01 alex_l 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="Процессы для мониторинга (через ;)" TitleEng="Processes for monitoring (; separated)" Alias="ProcessName">"tcpsvcs"</Attrib>
        <Attrib Type="String" TitleRus="Пороговые значения метрики 'Получено пакетов в сек' (через ;)" TitleEng="Tresholds for 'Packets Received per sec' (; separated)" Alias="Thrld.PacketsReceivedPersec">"400;200;100;50"</Attrib>
        <Attrib Type="String" TitleRus="Пороговые значения метрики 'Получено DHCP-сервером пакетов запросов в сек' (через ;)" TitleEng="Tresholds for 'Requests per sec' (; separated)" Alias="Thrld.RequestsPersec">"40;30;20;10"</Attrib>
        <Attrib Type="String" TitleRus="Пороговые значения метрики 'Число пакетов, ожидающих обслуживания сервером' (через ;)" TitleEng="Tresholds for 'Active Queue Length' (; separated)" Alias="Thrld.ActiveQueueLength">"16;8;4;2"</Attrib>
        <Attrib Type="String" TitleRus="Пороговые значения метрики 'Отброшено дубликатов в сек' (через ;)" TitleEng="Tresholds for 'Duplicates Dropped per sec' (; separated)" Alias="Thrld.DuplicatesDroppedPersec">"160;80;40;20"</Attrib>
        <Attrib Type="String" TitleRus="Пороговые значения метрики 'Число пакетов, ожидающих проверки на наличие конфликтов' (через ;)" TitleEng="Tresholds for 'Conflict Check Queue Length' (; separated)" Alias="Thrld.ConflictCheckQueueLength">"16;8;4;2"</Attrib>
        <Attrib Type="String" TitleRus="Пороговые значения метрики 'Просроченных пакетов в сек' (через ;)" TitleEng="Tresholds for 'Packets Expired per sec' (; separated)" Alias="Thrld.PacketsExpiredPersec">"40;20;10;5"</Attrib>
        <Attrib Type="String" TitleRus="Пороговые значения метрики 'Среднее время на отправку ответа в миллисек' (через ;)" TitleEng="Tresholds for 'Avg Packet Sending Duration in msec' (; separated)" Alias="Thrld.MillisecondsperpacketAvg">"800;400;200;100"</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 DHCP" en="MS DHCP 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, objProcess
    Dim l_objDHCP, 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

'// \DHCP\Packets Received/sec            Win32_PerfFormattedData_DHCPServer_DHCPServer=@ PacketsReceivedPersec
'// \DHCP\Requests/sec                    RequestsPersec
'// \DHCP\Active Queue Length             ActiveQueueLength
'// \DHCP\Duplicates Dropped/sec          DuplicatesDroppedPersec
'// \DHCP\Conflict Check Queue Length     ConflictCheckQueueLength
'// \DHCP\Packets Expired/sec             PacketsExpiredPersec
'// \DHCP\Milliseconds Per Packet Avg     MillisecondsperpacketAvg
'//	\Process(tcpsvcs)\% Processor Time

        'stop
        Set objProcess = objRefresher.AddEnum (objWMIService, "Win32_PerfFormattedData_PerfProc_Process").ObjectSet
        l_objDHCP = Null
        Set l_objDHCP = objRefresher.Add (objWMIService, "Win32_PerfFormattedData_DHCPServer_DHCPServer=@").Object
		                         
        objRefresher.Refresh
        ResSet.Sleep 1000
        objRefresher.Refresh
      
        l_strMsg = "Vbs: " & CompName & " PacketsReceivedPersec:" & l_objDHCP.PacketsReceivedPersec
        ResSet.LogMsg (l_strMsg)

        l_strMsg = "Vbs: " & CompName & " RequestsPersec:" & l_objDHCP.RequestsPersec
        ResSet.LogMsg (l_strMsg)

        l_strMsg = "Vbs: " & CompName & " ActiveQueueLength:" & l_objDHCP.ActiveQueueLength
        ResSet.LogMsg (l_strMsg)

        l_strMsg = "Vbs: " & CompName & " DuplicatesDroppedPersec:" & l_objDHCP.DuplicatesDroppedPersec
        ResSet.LogMsg (l_strMsg)

        l_strMsg = "Vbs: " & CompName & " ConflictCheckQueueLength:" & l_objDHCP.ConflictCheckQueueLength
        ResSet.LogMsg (l_strMsg)

        l_strMsg = "Vbs: " & CompName & " PacketsExpiredPersec:" & l_objDHCP.PacketsExpiredPersec
        ResSet.LogMsg (l_strMsg)

        l_strMsg = "Vbs: " & CompName & " MillisecondsperpacketAvg:" & l_objDHCP.MillisecondsperpacketAvg
        ResSet.LogMsg (l_strMsg)

        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)

        ' \DHCP\Packets Received/sec
        SLAEventName = "[" & UCase(CompName) & "] DHCP\Packets Received/sec"
        SLAAliasName = "PacketsReceivedPersec_" &  UCase(CompName)
        Error = ResSet.EventAdd(SLAEventName, SLAAliasName, 0)
        l_arrThrld = GetThresholdForTL(ResSet.CommonProp.Attrib("Thrld.PacketsReceivedPersec").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.PacketsReceivedPersec в свойствах теста указаны не верно! Проверьте настройки и повторите запуск тестов."
		        Exit Sub
        End If
        
        ' \DHCP\Requests/sec
        SLAEventName = "[" & UCase(CompName) & "] DHCP\Requests/sec"
        SLAAliasName = "RequestsPersec_" &  UCase(CompName)
        Error = ResSet.EventAdd(SLAEventName, SLAAliasName, 0)
        l_arrThrld = GetThresholdForTL(ResSet.CommonProp.Attrib("Thrld.RequestsPersec").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.RequestsPersec в свойствах теста указаны не верно! Проверьте настройки и повторите запуск тестов."
		        Exit Sub
        End If

        ' \DHCP\Active Queue Length
        SLAEventName = "[" & UCase(CompName) & "] DHCP\Active Queue Length"
        SLAAliasName = "ActiveQueueLength_" &  UCase(CompName)
        Error = ResSet.EventAdd(SLAEventName, SLAAliasName, 0)
        l_arrThrld = GetThresholdForTL(ResSet.CommonProp.Attrib("Thrld.ActiveQueueLength").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.ActiveQueueLength в свойствах теста указаны не верно! Проверьте настройки и повторите запуск тестов."
		        Exit Sub
        End If

        ' \DHCP\Duplicates Dropped/sec
        SLAEventName = "[" & UCase(CompName) & "] DHCP\Duplicates Dropped/sec"
        SLAAliasName = "DuplicatesDroppedPersec_" &  UCase(CompName)
        Error = ResSet.EventAdd(SLAEventName, SLAAliasName, 0)
        l_arrThrld = GetThresholdForTL(ResSet.CommonProp.Attrib("Thrld.DuplicatesDroppedPersec").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.DuplicatesDroppedPersec в свойствах теста указаны не верно! Проверьте настройки и повторите запуск тестов."
		        Exit Sub
        End If

        ' \DHCP\Conflict Check Queue Length
        SLAEventName = "[" & UCase(CompName) & "] DHCP\Conflict Check Queue Length"
        SLAAliasName = "ConflictCheckQueueLength_" &  UCase(CompName)
        Error = ResSet.EventAdd(SLAEventName, SLAAliasName, 0)
        l_arrThrld = GetThresholdForTL(ResSet.CommonProp.Attrib("Thrld.ConflictCheckQueueLength").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.ConflictCheckQueueLength в свойствах теста указаны не верно! Проверьте настройки и повторите запуск тестов."
		        Exit Sub
        End If

        ' \DHCP\Packets Expired/sec
        SLAEventName = "[" & UCase(CompName) & "] DHCP\Packets Expired/sec"
        SLAAliasName = "PacketsExpiredPersec_" &  UCase(CompName)
        Error = ResSet.EventAdd(SLAEventName, SLAAliasName, 0)
        l_arrThrld = GetThresholdForTL(ResSet.CommonProp.Attrib("Thrld.PacketsExpiredPersec").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.PacketsExpiredPersec в свойствах теста указаны не верно! Проверьте настройки и повторите запуск тестов."
		        Exit Sub
        End If

        ' \DHCP\Milliseconds Per Packet Avg
        SLAEventName = "[" & UCase(CompName) & "] DHCP\Milliseconds Per Packet Avg"
        SLAAliasName = "MillisecondsperpacketAvg_" &  UCase(CompName)
        Error = ResSet.EventAdd(SLAEventName, SLAAliasName, 0)
        l_arrThrld = GetThresholdForTL(ResSet.CommonProp.Attrib("Thrld.MillisecondsperpacketAvg").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.MillisecondsperpacketAvg в свойствах теста указаны не верно! Проверьте настройки и повторите запуск тестов."
		        Exit Sub
        End If

        ' \Process(tcpsvcs)\% Processor Time
        SLAEventName = "[" & UCase(CompName)  & "] Process(tcpsvcs)\% Processor Time"
        SLAAliasName = "tcpsvcs_processor_time_" &  UCase(CompName)
        Error = ResSet.EventAdd(SLAEventName, SLAAliasName, 0)
        l_strTLName_ru = SLAEventName 
        l_strTLName_en = SLAEventName 
        TLError = ResSet.AddTrafficLight(SLAAliasName, l_strTLName_ru, l_strTLName_en, "Average", ">", 30, 25, 20, 15)
    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_objProcess, l_ProcessArr, l_objItem
    Dim l_bConnect, l_objDHCP, 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")
    l_ProcessArr = GetProcessForMon(ResSet.CommonProp.Attrib("ProcessName").Value)
	
    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 = "objProcess_" & CompName
                    Set l_objProcess = l_ObjConnectorsCollection.Item(l_strProcessAlias) 
                    
                    For Each l_objItem in l_objProcess
                        If IsProcessInList(l_ProcessArr, l_objItem.Name) Then
                            l_strLogMsg = "OnDataReceived: " & CompName  & " process: " &  l_objItem.Name & "(" & l_objItem.IDProcess & ")"
                            ResSet.LogMsg(l_strLogMsg) 
    
                            If Err.Number <> 0 Then
                                Exit For
                            End If
                                
		                    ' // Processor Time(%)
		                    l_strSLAAliasName = "tcpsvcs_processor_time_" &  UCase(CompName)
		                    ResSet.Events(l_strSLAAliasName).Value = CDbl(l_objItem.PercentProcessorTime)
                        End If
                    Next

                    l_strProcessAlias = "objdhcp_" & CompName
                    Set l_objDHCP = l_ObjConnectorsCollection.Item(l_strProcessAlias) 

                    l_strSLAAliasName = "PacketsReceivedPersec_" &  UCase(CompName)
                    ResSet.Events(l_strSLAAliasName).Value = l_objDHCP.PacketsReceivedPersec
                    
                    l_strSLAAliasName = "RequestsPersec_" &  UCase(CompName)
                    ResSet.Events(l_strSLAAliasName).Value = l_objDHCP.RequestsPersec
                    
                    l_strSLAAliasName = "ActiveQueueLength_" &  UCase(CompName)
                    ResSet.Events(l_strSLAAliasName).Value = l_objDHCP.ActiveQueueLength
                    
                    l_strSLAAliasName = "DuplicatesDroppedPersec_" &  UCase(CompName)
                    ResSet.Events(l_strSLAAliasName).Value = l_objDHCP.DuplicatesDroppedPersec
                    
                    l_strSLAAliasName = "ConflictCheckQueueLength_" &  UCase(CompName)
                    ResSet.Events(l_strSLAAliasName).Value = l_objDHCP.ConflictCheckQueueLength
                    
                    l_strSLAAliasName = "PacketsExpiredPersec_" &  UCase(CompName)
                    ResSet.Events(l_strSLAAliasName).Value = l_objDHCP.PacketsExpiredPersec
                    
                    l_strSLAAliasName = "MillisecondsperpacketAvg_" &  UCase(CompName)
                    ResSet.Events(l_strSLAAliasName).Value = l_objDHCP.MillisecondsperpacketAvg
                  
                    l_strSLAAliasName = "Availability_" &  UCase(CompName)              
                    ResSet.Events(l_strSLAAliasName).Value = 100.0               
                End If
                
                Set l_objProcess = Nothing
                Set l_objDHCP = 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

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Function GetProcessForMon(l_strProcName)       
    Dim l_arrTL
	
    l_arrTL = Split(l_strProcName, ";")
    GetProcessForMon = l_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_objProcess, l_objDHCP

    On Error Resume Next
    Err.Clear

    CompName=ResSet.Resource(l_iIndx).Name

    l_strProcAlias = "objProcess_" & CompName
    ref_ObjConnectorsCollection.Remove(l_strProcAlias)

    l_strProcAlias = "objdhcp_" & 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_objProcess = l_objRefresher.AddEnum(l_ObjWMIService, "Win32_PerfFormattedData_PerfProc_Process").ObjectSet
    Set l_objDHCP = l_objRefresher.Add (l_ObjWMIService, "Win32_PerfFormattedData_DHCPServer_DHCPServer=@").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 = "objProcess_" & CompName
    ref_ObjConnectorsCollection.Add l_strConnectorAlias, l_objProcess

    l_strConnectorAlias = "objdhcp_" & CompName
    ref_ObjConnectorsCollection.Add l_strConnectorAlias, l_objDHCP

    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_objProcess, ByRef ref_objDHCP)
    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_objProcess = ref_objRefresher.AddEnum(l_ObjWMIService, "Win32_PerfFormattedData_PerfProc_Process").ObjectSet
    Set ref_objDHCP = ref_objRefresher.Add (l_ObjWMIService, "Win32_PerfFormattedData_DHCPServer_DHCPServer=@").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_objProcess, l_objDHCP

    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_objProcess, l_objDHCP

        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 = "objProcess_" & CompName
            ref_ObjConnectorsCollection.Add l_strConnectorAlias, l_objProcess

            l_strConnectorAlias = "objdhcp_" & CompName
            ref_ObjConnectorsCollection.Add l_strConnectorAlias, l_objDHCP
        End If
    Next

    ResSet.LogMsg("Init: ***End***")
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Function IsProcessInList(ByRef l_ProcessArr, l_strProcessName)
    Dim l_iIndx, l_strItem

    IsProcessInList = False
    
    For l_iIndx = LBound(l_ProcessArr) To UBound(l_ProcessArr)
        l_strItem = UCase(Trim(l_ProcessArr(l_iIndx)))
        If l_strItem = UCase(l_strProcessName) Then
            IsProcessInList = True                
            Exit Function
        End If
    Next

End Function 

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

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>