[решено] Как найти и изменить параметр реестра не зная где он находится

[krot183]

Значения параметров "{4b361010-def7-43a1-a5dc-071d955b62f7},14"
"{4b361010-def7-43a1-a5dc-071d955b62f7},15"
"{4b361010-def7-43a1-a5dc-071d955b62f7},16"

Если это просто поиск я могу убрать вывод сообщения из этого скрипта и объединить со вторым скриптом из шапки чтобы менялись значения в параметрах?

[Iska]

Разве Вы говорили что-либо про изменение параметров? Вы писали:
Нужно найти параметр реестра в ветке HKLM не зная полного пути к нему и создать переменную с полным путём к этому параметру. »
Полный путь к параметру будет в переменной «strResult». Или не будет.

Так Вам что на самом деле нужно сделать?

[krot183]

Iska, Изменить значения в параметрах.Спасибо.Я вроде понял как это сделать. Прийду с работы попробую и отпишусь.

[Iska]

Изменить значения в параметрах. »
1. В каких именно параметрах?
2. На что именно изменить?

[krot183]

Iska, Вот что и на что надо изменить


"{4b361010-def7-43a1-a5dc-071d955b62f7},14"=dword:00000001

"{4b361010-def7-43a1-a5dc-071d955b62f7},16"=hex:41,00,f8,73,01,00,00,00,00,00,\
00,00,f4,01,00,00,f4,01,00,00,f4,01,00,00,00,00,00,00,f4,01,00,00,f4,01,00,\
00,4a,01,00,00,4a,01,00,00

"{4b361010-def7-43a1-a5dc-071d955b62f7},15"=hex:41,00,f8,73,01,00,00,00,fc,ff,\
ff,ff,f8,ff,ff,ff,f6,ff,ff,ff,00,00,00,00,00,00,00,00,fa,ff,ff,ff,00,00,00,\
00,00,00,00,00


Не вышло у меня изменить параметры

[krot183]

Iska, Огромное спасибо! Всё получилось.Вот что у меня вышло

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

Dim AddValue1
Dim AddValue2
Dim AddValue3
Dim FindValue1
Dim FindValue2
Dim FindValue3


strComputer = "."
strKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\MMDevices\Audio\Render"
FindValue1 = "{4b361010-def7-43a1-a5dc-071d955b62f7},14"
FindValue2 = "{4b361010-def7-43a1-a5dc-071d955b62f7},15"
FindValue3 = "{4b361010-def7-43a1-a5dc-071d955b62f7},16"
AddValue1 = 1
AddValue2 = Array(&H41,&H00,&Hf8,&H73,&H01,&H00,&H00,&H00,&Hfc,&Hff,&Hff,&Hff,&Hf8,&Hff,&Hff,&Hff,&Hf6,&Hff,&Hff,&Hff,&H00,&H00,&H00,&H00,&H00,&H00,&H00,&H00,&Hfa,&Hff,&Hff,&Hff,&H00,&H00,&H00,&H00,&H00,&H00,&H00,&H00)
AddValue3 = Array(&H41,&H00,&Hf8,&H73,&H01,&H00,&H00,&H00,&H00,&H00,&H00,&H00,&Hf4,&H01,&H00,&H00,&Hf4,&H01,&H00,&H00,&Hf4,&H01,&H00,&H00,&H00,&H00,&H00,&H00,&Hf4,&H01,&H00,&H00,&Hf4,&H01,&H00,&H00,&H4a,&H01,&H00,&H00,&H4a,&H01,&H00,&H00)
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

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

objSWbemObjectEx.SetDWORDValue HKEY_LOCAL_MACHINE, strKey & "\" & strSubKey & "\FxProperties", FindValue1, AddValue1
objSWbemObjectEx.SetBinaryValue HKEY_LOCAL_MACHINE, strKey & "\" & strSubKey & "\FxProperties", FindValue2, AddValue2
objSWbemObjectEx.SetBinaryValue HKEY_LOCAL_MACHINE, strKey & "\" & strSubKey & "\FxProperties", FindValue3, AddValue3

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

WScript.Quit 0

[Iska]

Вообще-то вот так:
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", 1), _
Array("{4b361010-def7-43a1-a5dc-071d955b62f7},15", "BINARY", Array(&H41,&H00,&Hf8,&H73,&H01,&H00,&H00,&H00,&Hfc,&Hff,&Hff,&Hff,&Hf8,&Hff,&Hff,&Hff,&Hf6,&Hff,&Hff,&Hff,&H00,&H00,&H00,&H00,&H00,&H00,&H00,&H00,&Hfa,&Hff,&Hff,&Hff,&H00,&H00,&H00,&H00,&H00,&H00,&H00,&H00)), _
Array("{4b361010-def7-43a1-a5dc-071d955b62f7},16", "BINARY", Array(&H41,&H00,&Hf8,&H73,&H01,&H00,&H00,&H00,&H00,&H00,&H00,&H00,&Hf4,&H01,&H00,&H00,&Hf4,&H01,&H00,&H00,&Hf4,&H01,&H00,&H00,&H00,&H00,&H00,&H00,&Hf4,&H01,&H00,&H00,&Hf4,&H01,&H00,&H00,&H4a,&H01,&H00,&H00,&H4a,&H01,&H00,&H00)) _
)


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
For Each arrParameter In arrParameters
Select Case arrParameter(1)
Case "DWORD"
If objSWbemObjectEx.SetDWORDValue(HKEY_LOCAL_MACHINE, strKey & "\" & strSubKey & "\FxProperties", arrParameter(0), arrParameter(2)) <> 0 Then
WScript.Echo "Can't set DWord Value into parameter [HKLM\" & strKey & "\" & strSubKey & "\FxProperties" & "\" & arrParameter(0) & "]."
End If
Case "BINARY"
If objSWbemObjectEx.SetBinaryValue(HKEY_LOCAL_MACHINE, strKey & "\" & strSubKey & "\FxProperties", arrParameter(0), arrParameter(2)) <> 0 Then
WScript.Echo "Can't set Binary Value into parameter [HKLM\" & strKey & "\" & strSubKey & "\FxProperties" & "\" & arrParameter(0) & "]."
End If
Case Else
' Not implemented
End Select
Next

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

[krot183]

Iska, Спасибо работает.

[evgeny_t]

Товарищи знатоки, помогите пожалуйста изменить код этого скрипта, чтобы замена происходила автоматом, без подтверждений и уведомлений, в случае нахождения искомого значения в указанной ветке.




Option Explicit

Dim SectionName
Dim tmpRegFile
Dim FindValue
Dim AddValue
Dim objWSS
Dim objFSO
Dim RegFile
Dim CurrSection
Dim GetLine
Dim KeyName
Dim strPrompt
Dim ReturnValue

SectionName = "HKEY_CURRENT_USER\Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles\Outlook"
tmpRegFile = "d:\tmp.reg"
FindValue = "YYY.XXX.ru"
AddValue = "ZZZ.XXX.ru"

Set objWSS = CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")

objWSS.Run "regedit /e " & tmpRegFile & " """ & SectionName & """", 2, True

Set RegFile = objFSO.OpenTextFile(tmpRegFile, 1, True, -1)

Do While RegFile.AtEndOfStream <> True
GetLine = RegFile.ReadLine
If Left(GetLine, 6) = "[HKEY_" Then
CurrSection = Mid(GetLine, 2, Len(GetLine) - 2)
Else
If InStr(GetLine, FindValue) Then
strPrompt = "Вы желаете заменить значение ключа " & GetLine & vbNewLine & _
"в разделе " & CurrSection & vbNewLine & _
"на значение """ & AddValue & """?"
ReturnValue = MsgBox(strPrompt, 35, "Замена в реестре")
If ReturnValue = 6 Then
KeyName = Replace(Split(GetLine, "=")(0), """", "")
If KeyName = "@" Then KeyName = ""
objWSS.RegWrite CurrSection & "\" & KeyName, AddValue, "REG_SZ"
ElseIf ReturnValue = 2 Then
Exit Do
End If
objWSS.RegWrite CurrSection & "\" & KeyName, AddValue, "REG_SZ"
End If
End If
Loop

RegFile.Close

'Следующая строка закомментирована для возможности отката изменений
'objFSO.DeleteFile tmpRegFile

Set objWSS = Nothing
Set objFSO = Nothing
'MsgBox "Скрипт завершил работу"

WScript.Quit