<?xml version="1.0" encoding="windows-1251"?>
<document type="SelFTrendxTest" version="0.0" xmlns:m="xTest">
     <xTest type="USER_SCRIPT" alias="Duplicate App" 
     TitleRus="Тест обнаружения дублирующихся приложений" 
     TitleRootRus="Тесты соблюдения политик управления ресурсами MS Windows" 
     TitleEng="Duplicate Application Policy Violation Test" 
     TitleRootEng="MS Windows Policy Violation Tests" 
     TrafficLightsName="Duplicate Application Policy Violation Test"
     Version="2.0">
	<Files>
		<File type="conf" name="VB.WP.DuplicateApp.XTest.xml"/>
		<File type="help" name="VB.WP.DuplicateApp.XTest.chm::/VB.WP.DuplicateApp.XTest.html"/>
		<File type="dll" name="ST_SCTest.dll"/>
	</Files>
 <Keywords>
   <Keyword>Windows</Keyword>   
   <Keyword>WMI</Keyword>   
 </Keywords>

  <xTestProps>
        <log_level_def>0</log_level_def>
        <truncate_log>1</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>
        
        <resource_attribs TitleRus="Список параметров:" TitleEng="Parameters List:" SubTitleRus="Параметр" SubTitleEng="Parameter" >
            <!-- Type: "String", "Bool", "Integer", "Double" -->
            
            <Attrib Type="String" TitleRus="Имя компьютера администратора" TitleEng="Administrator's computer name" Alias="Admin_compName">"localhost"</Attrib>
            <Attrib Type="Bool" TitleRus="Посылать сообщение" TitleEng="Send popup message" Alias="Send_popup">"Yes"</Attrib>
        </resource_attribs>
    </parameters>

    <popupdisplay>
	    <description ru="Обнаружение дублирующих процессов" en="Duplicate Application Policy Violation"></description>
        <display_item ru="Нарушение политики" en="Policy Violation" alias="Policy_Violation" function="Maximum" sign="&gt;">0 0 0 0</display_item>
        <display_item ru="Ошибка при получении данных" en="Data Access Error" alias="Data_Access_Error" function="Maximum" sign="&gt;">10 10 0 0</display_item>
    </popupdisplay>


<Script language="VBScript">
<!--

' cDuplicateProcess - Список процессов, разделенных запятой, копии которых необходимо отслеживать.
Const cDuplicateProcess = "calc.exe,notepad.exe"
Dim IsWinXP
Dim objLocalWMIService

Sub OnDiscovery(ByRef ResSet)

	On Error Resume Next
	Err.Clear
	
	ResSet.LogMsg("*** Start Sub OnDiscovery ***")
    ResSet.SendProgressMessage("Start Script")
	ResCount=ResSet.Count
	Unid = ResSet.UnidBase

	For i=0 To ResCount - 1
		CompName=ResSet.Resource(i).Name
	    ResSet.SendProgressMessage("Check: " & CompName & ". Just a second, please")
		constr="WinMgmts:\\" & CompName & "\root\CIMV2"
		ResSet.LogMsg("Full WMI connect string:" & constr)
		Set objComputerProcess = GetObject(constr)
		Set colProcess = objComputerProcess.ExecQuery ("Select Caption, ExecutablePath from Win32_Process")
	
		If Err.Number<>0 Then
        	ResSet.ScriptError = -1
   			ResSet.ScriptErrorInfo = "Ошибка при запуске теста. Нет возможности работать с устройством: '" & 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
   		Else
   			Error = ResSet.EventAdd(UCase(CompName) & " Duplicate Application Events", CompName & "_events", Unid)
   			Unid = Unid + 1
   			Error = ResSet.EventAdd(UCase(CompName) & " Data Availability (%)", CompName & "_error", Unid)
   			Unid = Unid + 1
   		End If
	Next
	Error = ResSet.EventAdd("Policy Violation", "Policy_Violation", Unid)
	Unid = Unid + 1
	Error = ResSet.EventAdd("Data Access Error", "Data_Access_Error", Unid)
	ResSet.LogMsg("*** End Sub OnDiscovery ***")
End Sub



Sub OnDataReceived(ByRef ResSet)

	On Error Resume Next
	Err.Clear
	ResSet.LogMsg("*** Start Sub OnDataReceived ***")

	Dim arrWMIConnectString()
	Dim arrComp2Process()
	Dim arrDuplicateProcess

	ResCount=ResSet.Count
	arrDuplicateProcess=Split(LCase(cDuplicateProcess), ",")

	Set objLocalWMIService = GetObject("WinMgmts:\\.\root\CIMV2")
	IsWinXP = True
	If PingStatus("localhost") Then
		IsWinXP = True
	Else
		IsWinXP = False
	End If

	ReDim arrWMIConnectString (ResCount-1)

	For i=0 To ResCount - 1
		CompName=ResSet.Resource(i).Name
		constr="WinMgmts:\\" & CompName & "\root\CIMV2"
		ResSet.LogMsg("Full WMI connect string:" & constr)
		arrWMIConnectString(i) = constr
	Next

	For i=LBound(arrDuplicateProcess) To UBound(arrDuplicateProcess)
		If strWhere = "" Then
			strWhere = "Caption='" & arrDuplicateProcess(i) & "'"
		Else
			strWhere=strWhere + " or Caption='" & arrDuplicateProcess(i) & "'"
		End If
	Next

	strSelect="Select Caption, ExecutablePath from Win32_Process Where (" & strWhere & ")"


	Do While Not ResSet.StopTest

		StartTime = Timer
		Data_Access_Error = 0
		Policy_Violation = 0
		ReDim arrComp2Process(ResCount - 1, UBound(arrDuplicateProcess))
		
		For i=0 To ResCount - 1
			
			Err.Clear
			CompName=ResSet.Resource(i).Name
			
			If PingStatus(CompName) Then
				Set objComputerProcess = GetObject(arrWMIConnectString(i))
				Set colProcess = objComputerProcess.ExecQuery (strSelect)
				If Err.Number=0 Then
					ResSet.Events(CompName & "_events").Value = 0
					ResSet.Events(CompName & "_error").Value = 100
					For Each objProces In colProcess
						If( Err.Number <> 0 ) Then
							ResSet.Events(CompName & "_error").Value = 0
							Err.Clear
							Exit For
						End If
						
						CaptionProcess = LCase(objProces.Caption)
						For m = 0 To UBound(arrDuplicateProcess)
							If CaptionProcess = arrDuplicateProcess(m) Then
								arrComp2Process(i,m) = arrComp2Process(i,m) + 1
							End If
						Next
					Next
					NumberDuplicateApp = 0
					For m=0 To UBound(arrDuplicateProcess)
						If arrComp2Process(i,m) > 1 Then NumberDuplicateApp = NumberDuplicateApp + (arrComp2Process(i,m) - 1)
					Next
					ResSet.Events(CompName & "_events").Value = NumberDuplicateApp
					If NumberDuplicateApp > 0 Then
						If ResSet.Resource(i).Attrib("Send_popup").Value Then
							Admin_compName = ResSet.Resource(i).Attrib("Admin_compName").Value
							Call SendPopupMsg(CompName, NumberDuplicateApp, Admin_compName)
						End If
					End If 
				Else
					ResSet.Events(CompName & "_error").Value = 0
				End If
				If ResSet.Events(CompName & "_events").Value > 0 Then Policy_Violation = 1
				If ResSet.Events(CompName & "_error").Value = 0 Then Data_Access_Error = 1
			Else
				ResSet.Events(CompName & "_events").Value = 0
				ResSet.Events(CompName & "_error").Value = 100
			End If
		Next
		ResSet.Events("Policy_Violation").Value = Policy_Violation
		ResSet.Events("Data_Access_Error").Value = Data_Access_Error
		ResSet.SendSLaEvents()
		If ResSet.StopTest Then Exit Do
		AllTime = Timer - StartTime
		If AllTime < 0 Then SlaPausa = 1 Else SlaPausa = (ResSet.SLaPeriod - AllTime) * 1000
    	ResSet.Sleep SlaPausa
    Loop

End Sub

Sub SendPopupMsg(ByVal compName, ByVal NumberDupApp, ByVal admCompName)
	On Error Resume Next

	Dim oShell, WshNetwork
	Set oShell = CreateObject("WSCript.shell")
	vbDobleComma = Chr(34)
	If Ucase(admCompName) = Ucase("localhost") Then
		Set WshNetwork = CreateObject("WScript.Network")
		SendTo = WshNetwork.ComputerName
	Else
		SendTo = admCompName
	End If
	Message = "На компьютере: " & compName & " обнаружены копии контролируемых приложений. Число копий: " & NumberDupApp
	oShell.Run "net send " & SendTo & " " & vbDobleComma & Message & vbDobleComma, 0
End Sub

Function PingStatus ( strComputerName )
	' True если компьютер отвечает на ping
	On Error Resume Next
	
	If Not IsWinXP Then
		PingStatus = True
		Exit Function
	End If

	strSelect="Select StatusCode from Win32_PingStatus Where Address='" & strComputerName & "'"
	Set cPingResults = objLocalWMIService.ExecQuery(strSelect)
	
	For Each oPingResult In cPingResults
		If Err.Number <> 0 Then
			Err.Clear
			PingStatus = False
			Exit Function
		End If
		If oPingResult.StatusCode = 0 Then
			PingStatus = True
		Else
			PingStatus = False
		End If
	Next
End Function



-->
</Script>
    </xTest>
</document>
