Серый форум — VBS: Помогите найти глюк

Re: VBS: Помогите найти глюк

null@example.com (komr) — Fri, 14 Aug 2015 07:30:57 +0000

Всем спасибо - всё заработало. Всё оказалось просто. Раздела Keyboard Layout в реестре не существует на целевом ПК... фишка в этом. Скрипт не может создать ключ в несуществующем разделе.
Сейчас уже не могу понять почему так всё, но я пробовал создавать раздел и скрипт всё равно не работал. UAC отключил уже потом, вероятно он и мешал срабатывать скрипту.

Re: VBS: Помогите найти глюк

null@example.com (komr) — Fri, 14 Aug 2015 07:20:43 +0000

Да, скрипт проверяет наличие прав, и убеждается, что они есть. Функция IsElevated возвращает Истину

Re: VBS: Помогите найти глюк

null@example.com (komr) — Fri, 14 Aug 2015 07:13:59 +0000

Мистика какая то... явно какой то встроенный механизм защиты Win7 работает. UAC я отключил... не помогло.

Re: VBS: Помогите найти глюк

null@example.com (komr) — Fri, 14 Aug 2015 07:11:17 +0000

Xameleon пишет:

1) Всё-таки оставляю за собой право предполагать, что Вы не запустили командную строку с правами администратора.
2) Переделал скрипт с учётом автоматической проверки прав. К сожалению, сейчас не имею возможности проверить на XP и других системах. Под рукой только Win 10 Pro. И думаю, что наверняка можно проще всё это реализовать.

1. У меня нет такого пункта, не нашёл. Видимо, т.к. я и так с админскими правами зарегистрировался в системе ,то и такого пункта в меню нет. Может есть вариант вызова через Пуск/выполнить?
2. Попробовал - выдаёт ошибку из обработчика (строка 42). Не удалось установить параметр...

Re: VBS: Помогите найти глюк

null@example.com (Xameleon) — Wed, 12 Aug 2015 19:31:19 +0000

Flasher,

Flasher пишет:

А так?

Set objRegistry = _
    GetObject("winmgmts:{impersonationLevel=impersonate}\\.\root\default:StdRegProv")

Попробовал. К сожалению не "прокатило", но с мыслью согласен. По идее должно было дать права от того кто запустил.

komr,

1) Всё-таки оставляю за собой право предполагать, что Вы не запустили командную строку с правами администратора.

Я имел в виду это:

2) Переделал скрипт с учётом автоматической проверки прав. К сожалению, сейчас не имею возможности проверить на XP и других системах. Под рукой только Win 10 Pro. И думаю, что наверняка можно проще всё это реализовать.


Option Explicit

Dim objRegistry, strPath, uBinary, strValue01, strValue02

Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003

If Not IsElevated() Then
    RestartElevated()
    WScript.Quit
End if

Set objRegistry = _
    GetObject("Winmgmts:root\default:StdRegProv")

strPath = "SYSTEM\CurrentControlSet\Control\Keyboard Layout"
uBinary = Array(&H00, &H00, &H00, &H00, &H00, &H00, &H00, &H00, _
                &H12, &H00, &H00, &H00, &H00, &H00, &H3B, &H00, _
                &H00, &H00, &H3C, &H00, &H00, &H00, &H3D, &H00, _
                &H00, &H00, &H3E, &H00, &H00, &H00, &H3F, &H00, _
                &H00, &H00, &H40, &H00, &H00, &H00, &H41, &H00, _
                &H00, &H00, &H42, &H00, &H00, &H00, &H43, &H00, _
                &H00, &H00, &H44, &H00, &H00, &H00, &H57, &H00, _
                &H00, &H00, &H58, &H00, &H00, &H00, &H5B, &HE0, _
                &H00, &H00, &H38, &H00, &H00, &H00, &H38, &HE0, _
                &H00, &H00, &H5C, &HE0, &H00, &H00, &H1D, &HE0, _
                &H00, &H00, &H00, &H00)

SetBinaryValue HKEY_LOCAL_MACHINE, strPath, "ScanCode Map", uBinary

strPath = ".DEFAULT\Keyboard Layout\Preload"
strValue01 = "00000409"
strValue02 = "00000419"

SetStringValue HKEY_USERS, strPath, "1", strValue01
SetStringValue HKEY_USERS, strPath, "2", strValue02

Private Sub SetBinaryValue(DefKey, SubKeyName, ValueName, Value)
    Dim intRet
    intRet = objRegistry.SetBinaryValue(DefKey, SubKeyName, ValueName, Value)
    If intRet <> 0 Then
        Err.Raise intRet, "Не удалось установить параметр """ & ValueName & """", "SetBinaryValue"
    End If
End Sub

'Функция проверки - есть ли у нас повышенные права или нет
Private Function IsElevated()
    IsElevated = CreateObject("WScript.Shell").Run("%comspec% /c whoami /all | findstr /I /C:""S-1-16-12288""",0,True) = 0
End Function

'Процедура перезапуска своего же процесса с повышенными правами
Private Sub RestartElevated()
    Dim i, strTmp
    'Собираем строку параметров запуска на случай если скрипт был запущен с параметрами
    For i=0 To WScript.Arguments.Count-1
        If InStr(WScript.Arguments(i), " ") > 0 Then
            strTmp = strTmp & " """ & WScript.Arguments(i) & """"
        Else
            strTmp = strTmp & " " & WScript.Arguments(i)
        End If
    Next
    'Запускаем свой же скрипт с повышенными правами
    RunElevated WScript.FullName, """" & WScript.ScriptFullName & """" & strTmp, ""
End Sub

'Запуск приложения с повышенными правами
Private Sub RunElevated(strApplication, strArguments, strWorkingDir)
    CreateObject("Shell.Application").ShellExecute strApplication, strArguments, strWorkingDir, "runas"
End Sub

Re: VBS: Помогите найти глюк

null@example.com (Flasher) — Wed, 12 Aug 2015 16:01:39 +0000

А так?

Set objRegistry = _
    GetObject("winmgmts:{impersonationLevel=impersonate}\\.\root\default:StdRegProv")

Re: VBS: Помогите найти глюк

null@example.com (komr) — Wed, 12 Aug 2015 14:18:17 +0000

Получается, осталось понять, как запустить скрипт с нужными правами.

Re: VBS: Помогите найти глюк

null@example.com (komr) — Wed, 12 Aug 2015 13:47:31 +0000

Xameleon пишет:

Код 5 соответствует запрету доступа, как я понимаю.
Первое что приходит в голову - Запуская скрипт, Вы интерпретатор WScript / CScript запускаете с правами администратора ? В XP это не требовалось, в Win 7 и выше это часто бывает необходимо. Для проверки достаточно запустить командную строку с правами админа, а уже из неё запустить скрипт. Если же дело не в этом, то остаётся только выяснять по каким причинам у вас нет права записи в эту ветку.

Кстати ДА, доступ... я попробовал сегодня скрипт на машине с ХР - работает без проблем. А на семёрке - нет. Странно то, что права на ветку у меня есть. Я могу и создать этот раздел и параметр и задать ему значения и удалить всё. А вот скрипт этого не может. Попробую сейчас через командную строку... хотя скрипт должен запускаться через групповую политику - а там, в разделе ПК ,права админа должны быть по умолчанию.

Ничего не вышло - и права, вроде бы, есть, но не работает.

Re: VBS: Помогите найти глюк

null@example.com (Xameleon) — Wed, 12 Aug 2015 09:23:40 +0000

Понял Вас. Посмотрел подробности про SetBinaryValue

Вот что пишут:

Return value
In C++, the method returns a uint32 value that is 0 (zero) if successful. If the function fails, the return value is a nonzero error code that is defined in WinError.h. In C++, use the FormatMessage function with the FORMAT_MESSAGE_FROM_SYSTEM flag to get a generic description of the error. You can also look up return values under the WMI Error Constants.
In scripting or Visual Basic, the method returns an integer value that is 0 (zero) if successful. If the function fails, the return value is a nonzero error code that you can look up in WbemErrorEnum.

К сожалению в списке ошибок, не нашёл чего-то подобного коду 5.

На просторах инета нашёл предложение посмотреть последнюю ошибку, произошедшую в WMI. -
ссылка

Set oLastError = CreateObject("WbemScripting.SWbemLastError")
WScript.Echo oLastError.getObjectText_(1)

Порылся ещё. Нашёл список кодов ошибок для API функций, используемых внутри объектов WMI. ссылка

Const ERROR_SUCCESS = 0&
Const ERROR_BADDB = 1009&
Const ERROR_BADKEY = 1010&
Const ERROR_CANTOPEN = 1011&
Const ERROR_CANTREAD = 1012&
Const ERROR_CANTWRITE = 1013&
Const ERROR_OUTOFMEMORY = 14&
Const ERROR_INVALID_PARAMETER = 87&
Const ERROR_ACCESS_DENIED = 5&
Const ERROR_NO_MORE_ITEMS = 259&
Const ERROR_MORE_DATA = 234&

Код 5 соответствует запрету доступа, как я понимаю.

Первое что приходит в голову - Запуская скрипт, Вы интерпретатор WScript / CScript запускаете с правами администратора ? В XP это не требовалось, в Win 7 и выше это часто бывает необходимо. Для проверки достаточно запустить командную строку с правами админа, а уже из неё запустить скрипт. Если же дело не в этом, то остаётся только выяснять по каким причинам у вас нет права записи в эту ветку.

Re: VBS: Помогите найти глюк

null@example.com (komr) — Tue, 11 Aug 2015 07:07:40 +0000

Вот пример кода, с проверкой результатов выполнения добавления ключа в реестр.

intRes = objRegistry.SetBinaryValue(HKEY_LOCAL_MACHINE, strPath, "ScanCode Map", uBinary)
If intRes <> 0 Then
    WScript.Echo intRes & ": не удалось установить параметр ScanCode Map"
    WScript.Quit
End If

Он выдаёт цифру 5. Кто знает что это значит?

Re: VBS: Помогите найти глюк

null@example.com (komr) — Tue, 11 Aug 2015 07:04:59 +0000

Xameleon пишет:

1) В данном случае, глюк это:
On Error Resume Next
Так как этот оператор подавляет вывод ошибок. Так что либо удаляйте, либо комментируйте эту строку и смотрите что сообщит скрипт.
2)
komr пишет:
Если сделать проверку, то метод выдаёт цифру 5. Т.е. какую то ошибку.
О какой проверке идёт речь ?
Ошибки, как правило, сопровождаются пояснениями - причина, описание. В вашем случае они есть ?

Оператор подавления ошибок, естественно комментировал. Никаких изменений.
Метод SetBinaryValuе возвращает 0, если прошло без ошибок. В моём случае возвращает 5. Что это означает - понять не могу.

Re: VBS: Помогите найти глюк

null@example.com (Xameleon) — Mon, 10 Aug 2015 14:11:38 +0000

1) В данном случае, глюк это:

On Error Resume Next

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

komr пишет:

Если сделать проверку, то метод выдаёт цифру 5. Т.е. какую то ошибку.

О какой проверке идёт речь ?

Ошибки, как правило, сопровождаются пояснениями - причина, описание. В вашем случае они есть ?

Re: VBS: Помогите найти глюк

null@example.com (komr) — Mon, 10 Aug 2015 12:58:10 +0000

Я запускаю скрипт на ПК с админскими правами и ничего... и ошибок, гад, не выдаёт. Если сделать проверку, то метод выдаёт цифру 5. Т.е. какую то ошибку.

VBS: Помогите найти глюк

null@example.com (komr) — Mon, 10 Aug 2015 12:56:42 +0000

Есть такой код переназначения кучи клавиш

Option Explicit

On Error Resume Next

Dim objRegistry, strPath, uBinary, strValue01, strValue02

Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003

Set objRegistry = _
    GetObject("Winmgmts:root\default:StdRegProv")

strPath = "SYSTEM\CurrentControlSet\Control\Keyboard Layout"
uBinary = Array(&H00, &H00, &H00, &H00, &H00, &H00, &H00, &H00, _
                &H12, &H00, &H00, &H00, &H00, &H00, &H3B, &H00, _
                &H00, &H00, &H3C, &H00, &H00, &H00, &H3D, &H00, _
                &H00, &H00, &H3E, &H00, &H00, &H00, &H3F, &H00, _
                &H00, &H00, &H40, &H00, &H00, &H00, &H41, &H00, _
                &H00, &H00, &H42, &H00, &H00, &H00, &H43, &H00, _
                &H00, &H00, &H44, &H00, &H00, &H00, &H57, &H00, _
                &H00, &H00, &H58, &H00, &H00, &H00, &H5B, &HE0, _
                &H00, &H00, &H38, &H00, &H00, &H00, &H38, &HE0, _
                &H00, &H00, &H5C, &HE0, &H00, &H00, &H1D, &HE0, _
                &H00, &H00, &H00, &H00)

objRegistry.SetBinaryValue HKEY_LOCAL_MACHINE, strPath, "ScanCode Map", uBinary

strPath = ".DEFAULT\Keyboard Layout\Preload"
strValue01 = "00000409"
strValue02 = "00000419"

objRegistry.SetStringValue HKEY_USERS, strPath, "1", strValue01
objRegistry.SetStringValue HKEY_USERS, strPath, "2", strValue02

Он работал, но сейчас не работает. Ну ни в какую... Не создаётся и не заполняется значениями бинарный ключ.
Куда копать?