VBS/WSH/JS - [решено] Исправить значение параметра в реестре

Iska · Отправлено: **11:05, 21-05-2018** | #2

Цитата JooDoo:

внутри ветки реестра [HKEY_CURRENT_USER\Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles] найти параметр “Leave on Server” »

Не нашли ни одного такого параметра — что делать? Нашли несколько таких параметров — что делать?

JooDoo · Отправлено: **12:19, 21-05-2018** | #3

Не нашли ни одного такого параметра — что делать. выход
Нашли несколько таких параметров — что делать. заменить везде на dword:00000000 затем выход

Iska · Отправлено: **00:34, 22-05-2018** | #4

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

JooDoo · Отправлено: **16:42, 22-05-2018** | #5

У нас иногда профиль могут назвать другим именем и тогда Outlook поменяется на новое имя.

Iska · Отправлено: **16:56, 22-05-2018** | #6

JooDoo, выложите архив с файлом реестра с подобным именем профиля. То есть, всё содержимое реестра от раздела HKCU\Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem и ниже.

JooDoo · Отправлено: **04:45, 23-05-2018** | #7

Огромное тебе спасибо Iska, меня полностью устраивает работа данного скрипта. Проверил все работает замечательно.

Только я не понял почему если он может искать внутри раздела 9375CFF0413111d3B88A00104B2A6676, а если указать HKCU\Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profile то нет?

Если это сложно организовать, то вопрос можно закрыть буду использовать данный скрипт.

Спасибо еще раз.

Iska · Отправлено: **06:00, 23-05-2018** | #8

Цитата 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 в файл реестра, упакуйте в архив и прикрепите к сообщению. Мне нужно увидеть логику, ибо тупо искать (и заменять) везде и повсюду не есть хорошо и правильно.

JooDoo · Отправлено: **08:23, 23-05-2018** | #9

Вот мой архив реестра

Iska · Отправлено: **09:33, 23-05-2018** | #10

Хмм… Ну, тут тоже ровно один профиль. Вот код, который будет править указанный параметр в профиле по умолчанию:

Код:

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

Этого будет достаточно?