Имя пользователя:
Пароль:
 

Показать сообщение отдельно

Ветеран


Сообщения: 27449
Благодарности: 8088

Профиль | Отправить PM | Цитировать


Код: Выделить весь код
Option Explicit

Const HKEY_LOCAL_MACHINE = &H80000002

Dim strComputer
Dim strKey
Dim arrParameters

Dim objSWbemLocator
Dim objSWbemServicesEx
Dim objSWbemObjectEx

Dim arrSubKeys
Dim strSubKey

Dim objRegExp

Dim arrParameter
Dim lngValue
Dim arrValues
Dim boolFound
Dim strResult


strComputer   = "."
strKey        = "SOFTWARE\Microsoft\Windows\CurrentVersion\MMDevices\Audio\Render"
arrParameters = Array( _
	Array("{4b361010-def7-43a1-a5dc-071d955b62f7},14", "DWORD"), _
	Array("{4b361010-def7-43a1-a5dc-071d955b62f7},15", "BINARY"), _
	Array("{4b361010-def7-43a1-a5dc-071d955b62f7},16", "BINARY") _
)


Set objSWbemLocator    = WScript.CreateObject("WbemScripting.SWbemLocator")
Set objSWbemServicesEx = objSWbemLocator.ConnectServer(strComputer, "root\default")
Set objSWbemObjectEx   = objSWbemServicesEx.Get("StdRegProv")

If objSWbemObjectEx.EnumKey(HKEY_LOCAL_MACHINE, strKey, arrSubKeys) = 0 Then
	If Not IsNull(arrSubKeys) Then
		Set objRegExp = WScript.CreateObject("VBScript.RegExp")
		objRegExp.Pattern = "^\{[\da-fA-F]{8}(?:-[\da-fA-F]{4}){3}-[\da-fA-F]{12}}$"
		
		For Each strSubKey In arrSubKeys
			If objRegExp.Test(strSubKey) Then
				boolFound = True
				
				For Each arrParameter In arrParameters
					Select Case arrParameter(1)
						Case "DWORD"
							If objSWbemObjectEx.GetDWORDValue(HKEY_LOCAL_MACHINE, strKey & "\" & strSubKey & "\FxProperties", arrParameter(0), lngValue) <> 0 Then
								boolFound = False
							End If
						Case "BINARY"
							If objSWbemObjectEx.GetBinaryValue(HKEY_LOCAL_MACHINE, strKey & "\" & strSubKey & "\FxProperties", arrParameter(0), arrValues) <> 0 Then
								boolFound = False
							End If
						Case Else
							' Not implemented
					End Select
				Next
				
				If boolFound Then
					strResult = "HKLM\" & strKey & "\" & strSubKey
					WScript.Echo strResult
					
					Exit For
				End If
			End If
		Next
		
		Set objRegExp = Nothing
		
		If Not boolFound Then
			WScript.Echo "Can't find any right subkey in [HKLM\" & strKey & "]."
			WScript.Quit 3
		End If
	Else
		WScript.Echo "Nothing found in [HKLM\" & strKey & "]."
		WScript.Quit 2
	End If
Else
	WScript.Echo "Not found subkey [HKLM\" & strKey & "]."
	WScript.Quit 1
End If

Set objSWbemObjectEx   = Nothing
Set objSWbemServicesEx = Nothing
Set objSWbemLocator    = Nothing

WScript.Quit 0

Отправлено: 08:01, 17-02-2014 | #18