Исправить значение параметра в реестре
Всем доброго времени суток!
Прошу помочь в написании посредством кода на VBScript.
Необходимо внутри ветки реестра [HKEY_CURRENT_USER\Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles] найти параметр “Leave on Server” и после чего проверить его значение, если оно равно dword:00000000 то выход, если нет то исправить это значение на dword:00000000 затем выход.
Проблема в том, что название внутри папки может отличаться на разных компьютерах. (Например здесь Outlook\9375CFF0413111d3B88A00104B2A6676\00000006)
Возможно, у кого-то уже есть аналогичный опыт, прошу поделиться.
Буду признателен за помощь!
|
Цитата:
Цитата JooDoo
внутри ветки реестра [HKEY_CURRENT_USER\Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles] найти параметр “Leave on Server” »
|
Не нашли ни одного такого параметра — что делать? Нашли несколько таких параметров — что делать? |
Не нашли ни одного такого параметра — что делать. выход
Нашли несколько таких параметров — что делать. заменить везде на dword:00000000 затем выход
|
JooDoo, насколько я понимаю, нет никакой необходимости тыкаться по абсолютно всем подразделам HKCU\Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles.
У Вас действительно настроено у пользователей по нескольку профилей в Microsoft Outlook? Единственный умолчальный профиль имеет типичное имя Outlook. Настройки учётных записей, адресной книги, личных папок хранятся в именованных подразделах раздела 9375CFF0413111d3B88A00104B2A6676. То есть, в общем случае достаточно пройтись только по нумерованным подразделам из HKCU\Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles\Outlook\9375CFF0413111d3B88A00104B2A6676.
Код:
Option Explicit
Const HKEY_CURRENT_USER = &H80000001
Dim arrSubKeys
Dim strSubKey
Dim lngValue
With WScript.CreateObject("WbemScripting.SWbemLocator").ConnectServer(".", "root\default").Get("StdRegProv")
If .EnumKey(HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles\Outlook\9375CFF0413111d3B88A00104B2A6676", arrSubKeys) = 0 Then
For Each strSubKey In arrSubKeys
If .GetDWORDValue(HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles\Outlook\9375CFF0413111d3B88A00104B2A6676\" & strSubKey, "Leave on Server", lngValue) = 0 Then
If lngValue <> 0 Then
If .SetDWORDValue(HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles\Outlook\9375CFF0413111d3B88A00104B2A6676\" & strSubKey, "Leave on Server", 0) = 0 Then
WScript.Echo "Successfully set parameter [Leave on Server] of subkey [HKCU\Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles\Outlook\9375CFF0413111d3B88A00104B2A6676\" & strSubKey & "] to [0]."
Else
WScript.Echo "Failure set parameter [Leave on Server] of subkey [HKCU\Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles\Outlook\9375CFF0413111d3B88A00104B2A6676\" & strSubKey & "] to [0]."
End If
End If
End If
Next
Else
WScript.Echo "Can't enumerate subkeys on [HKCU\Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles\Outlook\9375CFF0413111d3B88A00104B2A6676]."
WScript.Quit 1
End If
End With
WScript.Quit 0
|
У нас иногда профиль могут назвать другим именем и тогда Outlook поменяется на новое имя.
|
JooDoo, выложите архив с файлом реестра с подобным именем профиля. То есть, всё содержимое реестра от раздела HKCU\Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem и ниже.
|
Огромное тебе спасибо Iska, меня полностью устраивает работа данного скрипта. Проверил все работает замечательно.
Только я не понял почему если он может искать внутри раздела 9375CFF0413111d3B88A00104B2A6676, а если указать HKCU\Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profile то нет?
Если это сложно организовать, то вопрос можно закрыть буду использовать данный скрипт.
Спасибо еще раз.
|
Цитата:
Цитата JooDoo
Только я не понял почему если он может искать внутри раздела 9375CFF0413111d3B88A00104B2A6676, а если указать HKCU\Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profile то нет? »
|
Что значит — нет?! Он ищет. И, разумеется, не находит, поскольку параметра Leave on Server в подразделах первого уровня в HKCU\Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profile быть не может.
Цитата:
Цитата JooDoo
Если это сложно организовать… »
|
Я жду от Вас архив с примером реального файла реестра с именем профиля. отличным от Outlook. Сделайте экспорт подраздела HKCU\Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem в файл реестра, упакуйте в архив и прикрепите к сообщению. Мне нужно увидеть логику, ибо тупо искать (и заменять) везде и повсюду не есть хорошо и правильно. |
Вложений: 1
Вот мой архив реестра
|
Хмм… Ну, тут тоже ровно один профиль. Вот код, который будет править указанный параметр в профиле по умолчанию:
Код:
Option Explicit
Const HKEY_CURRENT_USER = &H80000001
Dim arrSubKeys
Dim strSubKey
Dim strDefaultProfileName
Dim lngValue
With WScript.CreateObject("WbemScripting.SWbemLocator").ConnectServer(".", "root\default").Get("StdRegProv")
If .GetStringValue(HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles", "DefaultProfile", strDefaultProfileName) = 0 Then
If .EnumKey(HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles\" & strDefaultProfileName & "\9375CFF0413111d3B88A00104B2A6676", arrSubKeys) = 0 Then
For Each strSubKey In arrSubKeys
If .GetDWORDValue(HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles\" & strDefaultProfileName & "\9375CFF0413111d3B88A00104B2A6676\" & strSubKey, "Leave on Server", lngValue) = 0 Then
If lngValue <> 0 Then
If .SetDWORDValue(HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles\" & strDefaultProfileName & "\9375CFF0413111d3B88A00104B2A6676\" & strSubKey, "Leave on Server", 0) = 0 Then
WScript.Echo "Successfully set parameter [Leave on Server] of subkey [HKCU\Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles\" & strDefaultProfileName & "\9375CFF0413111d3B88A00104B2A6676\" & strSubKey & "] to [0]."
Else
WScript.Echo "Failure set parameter [Leave on Server] of subkey [HKCU\Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles\" & strDefaultProfileName & "\9375CFF0413111d3B88A00104B2A6676\" & strSubKey & "] to [0]."
End If
End If
End If
Next
Else
WScript.Echo "Can't enumerate subkeys on [HKCU\Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles\" & strDefaultProfileName & "\9375CFF0413111d3B88A00104B2A6676]."
WScript.Quit 2
End If
Else
WScript.Echo "Can't read parameter [DefaultProfile] from subkey [HKCU\Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles]."
WScript.Quit 1
End If
End With
WScript.Quit 0
Этого будет достаточно? |
Большое спасибо еще раз, теперь все супер то что я и хотел получить в результате.
Вопрос закрыт всем удачи!!!
|
Но на вопрос-то Вы не ответили — будет ли этого достаточно?
Ладно… Вот Вам на всякий случай ещё один код, который пытается перебирать все подразделы в …\Profiles, а не только указанный как умолчальный:
Код:
Option Explicit
Const HKEY_CURRENT_USER = &H80000001
Dim arrSubKeysProfiles
Dim strSubKeyProfile
Dim arrSubKeysEntries
Dim strSubKeyEntry
Dim lngValue
With WScript.CreateObject("WbemScripting.SWbemLocator").ConnectServer(".", "root\default").Get("StdRegProv")
If .EnumKey(HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles", arrSubKeysProfiles) = 0 Then
For Each strSubKeyProfile In arrSubKeysProfiles
If .EnumKey(HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles\" & strSubKeyProfile & "\9375CFF0413111d3B88A00104B2A6676", arrSubKeysEntries) = 0 Then
For Each strSubKeyEntry In arrSubKeysEntries
If .GetDWORDValue(HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles\" & strSubKeyProfile & "\9375CFF0413111d3B88A00104B2A6676\" & strSubKeyEntry, "Leave on Server", lngValue) = 0 Then
If lngValue <> 0 Then
If .SetDWORDValue(HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles\" & strSubKeyProfile & "\9375CFF0413111d3B88A00104B2A6676\" & strSubKeyEntry, "Leave on Server", 0) = 0 Then
WScript.Echo "Successfully set parameter [Leave on Server] of subkey [HKCU\Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles\" & strSubKeyProfile & "\9375CFF0413111d3B88A00104B2A6676\" & strSubKeyEntry & "] to [0]."
Else
WScript.Echo "Failure set parameter [Leave on Server] of subkey [HKCU\Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles\" & strSubKeyProfile & "\9375CFF0413111d3B88A00104B2A6676\" & strSubKeyEntry & "] to [0]."
End If
End If
End If
Next
Else
WScript.Echo "Can't enumerate subkeys on [HKCU\Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles\" & strSubKeyProfile & "\9375CFF0413111d3B88A00104B2A6676]."
WScript.Quit 2
End If
Next
Else
WScript.Echo "Can't enumerate subkeys on [HKCU\Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles]."
WScript.Quit 1
End If
End With
WScript.Quit 0
|
Первый скрипт наверно более актуальный для меня, так как исправляет по умолчанию в профиле. Второй актуален если будут использовать два и более профилей. У нас такого пока нет.
Буду его использовать как шаблон для написания других задач подобного типа.
|
Цитата:
Цитата JooDoo
так как исправляет по умолчанию в профиле. »
|
Наоборот — «в профиле по умолчанию» (или «в умолчальном профиле», хоть это и не вполне по-русски). Слова «по умолчанию» относится к «профиль», а не к «исправляет». |
Время: 12:43.
© OSzone.net 2001-
