<![CDATA[Серый форум — HTA/VBS: Настройка безопасности DCOM и WMI]]> 2014-01-30T16:24:18Z PunBB https://forum.script-coding.com/viewtopic.php?id=7523 <![CDATA[Re: HTA/VBS: Настройка безопасности DCOM и WMI]]> Сегодня попался на глаза этот код, решил реанимировать. Всем мир.

]]> https://forum.script-coding.com/profile.php?id=27085 2014-01-30T16:24:18Z https://forum.script-coding.com/viewtopic.php?pid=79551#p79551 <![CDATA[Re: HTA/VBS: Настройка безопасности DCOM и WMI]]> О чем и спик, что не в домене, а в рабочей группе. Да и речь не обо мне. Гипотетически время от времени надо подключаться к WMI удаленного компа не в домене, а админу в силу каких-нибудь инструкций и т.п. нельзя отключать родной брандмауэр. Понятно, что шансов мало, что такое может случиться, но тем не менее. Что интересно - все по фэн-шую (MSDNу) - и не работает.

]]> https://forum.script-coding.com/profile.php?id=27085 2012-09-03T16:58:55Z https://forum.script-coding.com/viewtopic.php?pid=63480#p63480 <![CDATA[Re: HTA/VBS: Настройка безопасности DCOM и WMI]]> Ну, у меня для локальной сети фаерволл отключён групповой политикой, так что даже не скажу насчёт его настройки.

]]> https://forum.script-coding.com/profile.php?id=1844 2012-09-03T16:53:18Z https://forum.script-coding.com/viewtopic.php?pid=63479#p63479 <![CDATA[HTA/VBS: Настройка безопасности DCOM и WMI]]> Столкнулся с задачей, решение которой, на мой взгляд, заслуживает внимания.
Задача: Подключиться к WMI удаленного компьютера под управлением Windows Vista или 7 c включенным UAC в рабочей группе.
Решение: Настроить разрешения на запуск и активацию DCOM, а также права на необходимые пространства имен WMI.
HTA по мотивам задачи:


<html>
<head>
	<title>Настройка</title>
	<!-- Настройка DCOM и WMI -->
	<meta http-equiv=content-type content="text-html; charset=windows-1251">
    <meta http-equiv=MSThemeCompatible content=yes>
    <hta:application              
		icon=comres.dll
        scroll=no
		version = "1.0"
    >
</head>
<style type="text/css">
	#usr{width:210px;}
	#ok,#cancel{width:103px;}
	#cancel{margin-left:4px}
	#ns{height:240px; overflow:auto;}
	#st{top: expression(ns.scrollTop)"
</style>
<script language="VBScript">	
	Sub window_onload()
		window.resizeTo 250, 430
		window.moveTo 20, 20
		For Each objNameSpace In GetObject("winmgmts:\\.\root").InstancesOf("__NAMESPACE")			
			s = s & "<div><input id=""" & objNameSpace.Name & """ type=""checkbox""/>" & objNameSpace.Name & "</div>"
		Next		
		document.getElementById("ns").InnerHTML = s
		document.getElementById("usr").focus()
	End Sub
	
	Sub cancel_onclick()
		window.close
	End Sub
	
	Sub ok_onclick()
		s = document.getElementById("usr").Value
		If s = "" Then
			MsgBox "Имя пользователя не может быть пустым",vbInformation
			Exit Sub
		End If		
		DACLModify s
	End Sub		
	
	Function DACLModify(sUserName)
		On Error Resume Next		
		Dim bPartOfDomain, sDomainName 'имя домена (если не в домене - имя локального компьютера)
		Dim objWinCS, obj
		Dim objWMI		
				
		Set objWMI = GetObject("winmgmts:\\.\root\cimv2")
		
		If IsPreVista(objWMI) Then
			MsgBox "Текущая версия операционной системы не поддерживается",vbExclamation
			Exit Function
		End If
		
		Set objWinCS = objWMI.ExecQuery("SELECT * FROM Win32_ComputerSystem")
		For Each obj In objWinCS
			bPartOfDomain = obj.PartOfDomain
			If bPartOfDomain Then
				sDomainName = obj.Domain
			Else
				sDomainName = obj.Name
			End If
		Next
		Set objWinCS = Nothing

		Dim objCollection
		'поиск учетной записи
		If bPartOfDomain Then
			Set objCollection = objWMI.ExecQuery("SELECT SID FROM Win32_Account WHERE Domain='" & sDomainName & "' AND Name='" & sUserName & "'")
		Else
			Set objCollection = objWMI.ExecQuery("SELECT SID FROM Win32_Account WHERE Name='" & sUserName & "'")
		End If

		If objCollection.Count = 0 Then			
			MsgBox "Учетная запись " & sUserName & " не найдена",vbInformation
			Exit Function
		End If		
		
		Dim strSID
		'получаем SID
		For Each obj In objCollection
			strSID = UCase(obj.SID)
		Next
		Set objCollection = Nothing
		
		'безопасность DCOM
		If document.getElementById("dcom").checked Then
			If DCOM_DACL_Modify(sUserName, sDomainName, strSID) <> 0 Then Exit Function
		End If
		
		'безопасность пространств имен wmi
		For Each n In document.getElementById("ns").childNodes			
			If n.childNodes(0).checked Then
				If WMI_DACL_Modify(sUserName, sDomainName, strSID, n.innerText) <> 0 Then Exit Function
			End If
		Next		
		
		If Err.Number = 0 Then
			MsgBox "Настройка безопасности DCOM и WMI завершена",vbInformation
		Else
			MsgBox "Не удалось настроить безопасность DCOM и WMI",vbCritical
		End If
		
	End Function
	
	Function DCOM_DACL_Modify(sUserName, sDomainName, strSID)
		On Error Resume Next
		Const HKLM = &H80000002
		Const KeyPath = "SOFTWARE\Microsoft\Ole"
		Const KeyValue = "MachineLaunchRestriction"
		Const KeyEnableValue = "EnableDCOM" 'влючено ли использование DCOM
		Dim objReg
		
		DCOM_DACL_Modify = 1 'по умолчанию - ошибка
		
		Set objReg = GetObject("winmgmts:\\.\root\default:StdRegProv")		

		'читаем ключ - разрешен ли DCOM
		Dim sEnableValue		
		If objReg.GetStringValue(HKLM, KeyPath, KeyEnableValue, sEnableValue) <> 0 Then
			MsgBox "Не удалось прочитать ключ " & "HKLM\" & KeyPath & "\" & KeyEnableValue,vbCritical
			Exit Function
		End If
		
		If UCase(sEnableValue) <> "Y" Then			
			If objReg.SetStringValue(HKLM, KeyPath, KeyEnableValue, "Y") <> 0 Then
				MsgBox "Не удалось записать ключ " & "HKLM\" & KeyPath & "\" & KeyEnableValue,vbCritical
				Exit Function
			End If
		End If
		
		'---Права
		'читаем ключ
		Dim arrSD		
		If objReg.GetBinaryValue(HKLM, KeyPath, KeyValue, arrSD) <> 0 Then
			MsgBox "Не удалось прочитать ключ " & KeyPath & "\" & KeyValue,vbCritical
			Exit Function
		End If
		If Not IsArray(arrSD) Then
			MsgBox "Ключ " & "HKLM\" & KeyPath & "\" & KeyValue & " не является массивом",vbCritical
			Exit Function
		End If

		'конвертируем в Win32_SecurityDescriptor - только Vista и 7
		Dim objWMI, SDHelper
		Set objWMI = GetObject("winmgmts:\\.\root\cimv2")
		Set SDHelper = objWMI.Get("Win32_SecurityDescriptorHelper")
		Dim objSD		
		If SDHelper.BinarySDToWin32SD(arrSD, objSD) <> 0 Then 'BinarySDToSDDL
			MsgBox "Не удалось конвертировать массив в дескриптор безопасности DCOM",vbCritical
			Exit Function
		End If

		Dim arrACE, objACE
		Dim bFound 'флаг - SID найден
		arrACE = objSD.DACL
		'настройка существующих записей
		For Each objACE In arrACE 'ищем наш SID
			If StrComp(objACE.Trustee.SIDString, strSID, vbTextCompare) = 0 Then 'SID найден
				bFound = True				
				'разрешение на полный доступ
				objACE.AceType = 0
				objACE.AccessMask = &H1F
				Exit For
			End If			
		Next

		'если SID не найден
		If Not bFound Then			
			Dim objSID, objTrustee, objNewACE
			'формируем новый экземпляра класса Win32_Ace
			Set objSID = objWMI.Get("Win32_SID.SID='" & strSID & "'")
			Set objTrustee = objWMI.Get("Win32_Trustee").SpawnInstance_()
			objTrustee.Domain = sDomainName 'домен или имя локального компа
			objTrustee.Name = sUserName
			objTrustee.SID = objSID.BinaryRepresentation
			objTrustee.SidLength = objSID.SidLength
			objTrustee.SIDString = strSID
			Set objSID = Nothing
			Set objNewACE = objWMI.Get("Win32_Ace").SpawnInstance_()
			objNewACE.AceType = 0  'разрешить
			objNewACE.AceFlags = 0
			objNewACE.AccessMask = &H1F 'полный доступ
			objNewACE.Trustee = objTrustee			
			Set objTrustee = Nothing
			
			'расширяем DACL
			ReDim Preserve arrACE(UBound(arrACE) + 1)
			Set arrACE(UBound(arrACE)) = objNewACE			
			Set objNewACE = Nothing			
			objSD.DACL = arrACE
			Erase arrACE
		End If
		
		Set objWMI = Nothing
		
		'сохраняем изменения - конвертируем обратно - только Vista и 7
		Dim arrSD2		
		If SDHelper.Win32SDToBinarySD(objSD, arrSD2) <> 0 Then
			MsgBox "Не удалось конвертировать дескриптор безопасности DCOM в массив",vbCritical
			Exit Function
		End If
		Set SDHelper = Nothing
		
		If Not IsArray(arrSD2) Then
			MsgBox "Конвертирванный дескриптор безопасности DCOM не является массивом",vbCritical
			Exit Function
		End If				
		
		If objReg.SetBinaryValue(HKLM, KeyPath, KeyValue, arrSD2) <> 0 Then
			MsgBox "Не удалось записать ключ " & "HKLM\" & KeyPath & "\" & KeyValue,vbCritical
			Exit Function
		End If
		Set objReg = Nothing		
		
		DCOM_DACL_Modify = Err.Number
		
	End Function
	
	Function WMI_DACL_Modify(sUserName, sDomainName, strSID, strNameSpace)
		On Error Resume Next
		Dim objSecurity, objNameSpace
		
		WMI_DACL_Modify = 1 'по умолчанию - ошибка
		
		Set objNameSpace = GetObject("winmgmts:\\.\root\" & strNameSpace)
		Set objSecurity = objNameSpace.Get("__SystemSecurity=@")
		
		Dim objSD
		'получаем дескриптор безопасности пространства имен - только Vista и 7
		If objSecurity.GetSecurityDescriptor(objSD) <> 0 Then 'если не удалось получить дескриптор безопасности
			MsgBox "Не удалось получить дескриптор безопасности пространства имен "	& strNameSpace,vbCritical
			Exit Function
		End If

		Dim arrACE, objACE
		arrACE = objSD.DACL
		Dim bFound 'флаг - SID найден
		'настройка существующих записей
		For Each objACE In arrACE 'ищем наш SID
			If StrComp(objACE.Trustee.SIDString, strSID, vbTextCompare) = 0 Then 'SID найден
				bFound = True
				'разрешение на полный доступ
				objACE.AceType = 0
				objACE.AccessMask = &H6003F
				Exit For
			End If
		Next

		'если SID не найден
		If Not bFound Then			
			Dim objSID, objTrustee, objNewACE, objWMI
			Set objWMI = GetObject("winmgmts:\\.\root\cimv2")
			'формируем новый экземпляра класса Win32_Ace
			Set objSID = objWMI.Get("Win32_SID.SID='" & strSID & "'")
			Set objTrustee = objWMI.Get("Win32_Trustee").SpawnInstance_()
			objTrustee.Domain = sDomainName 'домен или имя локального компа
			objTrustee.Name = sUserName
			objTrustee.SID = objSID.BinaryRepresentation
			objTrustee.SidLength = objSID.SidLength
			objTrustee.SIDString = strSID
			Set objSID = Nothing
			Set objNewACE = objWMI.Get("Win32_Ace").SpawnInstance_()
			Set objWMI = Nothing
			objNewACE.AceType = 0  'разрешить
			objNewACE.AceFlags = 0
			objNewACE.AccessMask = &H6003F 'полный доступ
			objNewACE.Trustee = objTrustee			
			Set objTrustee = Nothing
			
			'расширяем DACL
			ReDim Preserve arrACE(UBound(arrACE) + 1)
			Set arrACE(UBound(arrACE)) = objNewACE			
			Set objNewACE = Nothing			
			objSD.DACL = arrACE
			Erase arrACE
		End If

		'сохраняем изменения настроек безопасности пространства имен - только Vista и 7
		If objSecurity.SetSecurityDescriptor(objSD) <> 0 Then
			MsgBox "Не удалось сохранить изменения в настройке безопасности пространства имен " & strNameSpace,vbCritical
			Exit Function
		End If
		
		Set objSecurity = Nothing
		Set objNameSpace = Nothing
		
		WMI_DACL_Modify = Err.Number
		
	End Function
		
	Function IsPreVista(objWMI)
		On Error Resume Next
		Dim obj
		For Each obj In objWMI.ExecQuery("Select * From Win32_OperatingSystem")
			If CInt(Left(obj.Version, 1)) = 5 Then 'XP или ранее
				IsPreVista = True
			End If
		Next
	End Function
</script>
<body>	
	Имя пользователя: <br/><input id="usr" type="text"/><br/>
	<input id="dcom" type="checkbox"/>DCOM<br/>	
	<div id="st">Пространства имен WMI:</div>
	<div id="ns"></div><br/>
	<input id="ok" type="button" value="OK"/><input id="cancel" type="button" value="Отмена"/>	
</body> 
</html>

Запуск, разумеется, от имени администратора:


With CreateObject("Scripting.FileSystemObject")
	f = .BuildPath(.GetParentFolderName(WScript.ScriptFullName),"DCOM'n'WMI_Access_Rights_Adjustment.hta")
	If .FileExists(f) Then
		CreateObject("Shell.Application").ShellExecute "mshta.exe", Chr(34) & f & Chr(34),, "runas",1
	Else
		MsgBox "Файл " & f & " не найден",vbExclamation
	End If
End With

Наверное на форуме кому-нибудь будет полезно.

p.s.: Настройка Брандмауэра Windows согласно MSDN ни для XP, ни для Vista/7 по моим наблюдениям не помогает - ни netsh, ни скриптом, ни руками - только отключение. Хотелось бы знать, только у меня лыжи не едут?

]]> https://forum.script-coding.com/profile.php?id=27085 2012-09-03T16:49:22Z https://forum.script-coding.com/viewtopic.php?pid=63478#p63478