Компьютерный форум OSzone.net  

Компьютерный форум OSzone.net (http://forum.oszone.net/index.php)
-   Скриптовые языки администрирования Windows (http://forum.oszone.net/forumdisplay.php?f=102)
-   -   [решено] Поиск и добавление значения параметра в реестре (http://forum.oszone.net/showthread.php?t=337122)

in-com 11-10-2018 12:52 2835413
Поиск и добавление значения параметра в реестре
 
Здравствуйте, ув. форумчане!
Прошу помощи в vbs скрипте. Искал на форуме и в рунете, но не нашел. Суть скрипта такова:
Необходимо найти уже заданное значение в реестре и дописать в него нужное, не изменяя всего предыдущего значения. Ели же параметр пуст, то добавить новое значение.
Пытался реализовать это своими силами, но что то не выходит.
Сам скрипт

Код:
Option Explicit
'~ On Error Resume Next
RequireAdmin

Const HKEY_CLASSES_ROOT = &H80000000

Dim objSWbemObjectEx, strValue, NewValue, objReg, strComputer

NewValue=newparam;

strComputer = "."
Set objReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")

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

("StdRegProv")

If objSWbemObjectEx.GetStringValue(HKEY_CLASSES_ROOT, "CLSID\{20D04FE0-3AEA-1069-A2D8-08002B30309D}\shell\CompMgmt",

"SubCommands", strValue) = 0 Then
        RegWrite "HKCR\CLSID\{20D04FE0-3AEA-1069-A2D8-08002B30309D}\shell\CompMgmt", "SubCommands", "REG_SZ", "strValue &

NewValue"
Else
        RegWrite "HKCR\CLSID\{20D04FE0-3AEA-1069-A2D8-08002B30309D}\shell\CompMgmt", "SubCommands", "REG_SZ", "NewValue"
End If

Set objSWbemObjectEx = Nothing

WScript.Quit 0

Function RegWrite(reg_keyname, reg_valuename,reg_type,ByVal reg_value)
        Dim aRegKey, Return
        aRegKey = RegSplitKey(reg_keyname)
        If IsArray(aRegKey) = 0 Then
                RegWrite = 0
                Exit Function
        End If

        Return = RegWriteKey(aRegKey)
        If Return = 0 Then
                RegWrite = 0
                Exit Function
        End If

        Select Case reg_type
                Case "REG_SZ"
                        Return = objReg.SetStringValue(aRegKey(0),aRegKey(1),reg_valuename,reg_value)
                Case "REG_EXPAND_SZ"
                        Return = objReg.SetExpandedStringValue(aRegKey(0),aRegKey(1),reg_valuename,reg_value)
                Case "REG_BINARY"
                        If IsArray(reg_value) = 0 Then reg_value = Array()
                        Return = objReg.SetBinaryValue(aRegKey(0),aRegKey(1),reg_valuename,reg_value)

                Case "REG_DWORD"
                        If IsNumeric(reg_value) = 0 Then reg_value = 0
                        Return = objReg.SetDWORDValue(aRegKey(0),aRegKey(1),reg_valuename,reg_value)

                Case "REG_MULTI_SZ"
                        If IsArray(reg_value) = 0 Then
                                If Len(reg_value) = 0 Then
                                        reg_value = Array()
                                Else
                                        reg_value = Array(reg_value)
                                End If
                        End If
                        Return = objReg.SetMultiStringValue(aRegKey(0),aRegKey(1),reg_valuename,reg_value)

                'Case "REG_QWORD"
                        'Return = oReg.SetQWORDValue(aRegKey(0),aRegKey(1),reg_valuename,reg_value)
                Case Else
                        RegWrite = 0
                        Exit Function
        End Select

        If (Return <> 0) Or (Err.Number <> 0) Then
                RegWrite = 0
                Exit Function
        End If
        RegWrite = 1
End Function

Function RegWriteKey(RegKeyName)
        Dim Return
        If IsArray(RegKeyName) = 0 Then
                RegKeyName = RegSplitKey(RegKeyName)
        End If

        If (IsArray(RegKeyName) = 0) Or (UBound(RegKeyName) <> 1) Then
                RegWriteKey = 0
                Exit Function
        End If

        Return = objReg.CreateKey(RegKeyName(0),RegKeyName(1))
        If (Return <> 0) Or (Err.Number <> 0) Then
                RegWriteKey = 0
                Exit Function
        End If
        RegWriteKey = 1
End Function

Function RegDelete(reg_keyname, reg_valuename)
        Dim Return,aRegKey
        aRegKey = RegSplitKey(reg_keyname)
        If IsArray(aRegKey) = 0 Then
                RegDelete = 0
                Exit Function
        End If

        Return = objReg.DeleteValue(aRegKey(0),aRegKey(1),reg_valuename)
        If (Return <> 0) And (Err.Number <> 0) Then
                RegDelete = 0
                Exit Function
        End If
        RegDelete = 1
End Function

Function RegDeleteKey(reg_keyname)
        Dim Return,aRegKey
        aRegKey = RegSplitKey(reg_keyname)
        If IsArray(aRegKey) = 0 Then
                RegDeleteKey = 0
                Exit Function
        End If

        'On Error Resume Next
        Return = RegDeleteSubKey(aRegKey(0),aRegKey(1))
        'On Error Goto 0
        If Return = 0 Then
                RegDeleteKey = 0
                Exit Function
        End If
        RegDeleteKey = 1
End Function

Function RegDeleteSubKey(strRegHive, strKeyPath)
        Dim Return,arrSubkeys,strSubkey
    objReg.EnumKey strRegHive, strKeyPath, arrSubkeys
    If IsArray(arrSubkeys) <> 0 Then
        For Each strSubkey In arrSubkeys
            RegDeleteSubKey strRegHive, strKeyPath & "\" & strSubkey
        Next
    End If

        Return = objReg.DeleteKey(strRegHive, strKeyPath)
        If (Return <> 0) Or (Err.Number <> 0) Then
                RegDeleteSubKey = 0
                Exit Function
        End If
        RegDeleteSubKey = 1
End Function

Function RegSplitKey(RegKeyName)
        Dim strHive, strInstr, strLeft
        strInstr=InStr(RegKeyName,"\")
        If strInstr = 0 Then Exit Function
        strLeft=left(RegKeyName,strInstr-1)

        Select Case strLeft
                Case "HKCR","HKEY_CLASSES_ROOT"        strHive = &H80000000
                Case "HKCU","HKEY_CURRENT_USER"        strHive = &H80000001
                Case "HKLM","HKEY_LOCAL_MACHINE"        strHive = &H80000002
                Case "HKU","HKEY_USERS"        strHive = &H80000003
                Case "HKCC","HKEY_CURRENT_CONFIG"        strHive = &H80000005
          Case Else Exit Function
        End Select

    RegSplitKey = Array(strHive,Mid(RegKeyName,strInstr+1))
End Function

Function RequireAdmin()
        Dim reg_valuename, WShell, Cmd, CmdLine, I

        GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")_
        .EnumValues &H80000003, "S-1-5-19\Environment",  reg_valuename
        If IsArray(reg_valuename) <> 0 Then
                RequireAdmin = 1
                Exit Function
        End If

        Set Cmd = WScript.Arguments
        For I = 0 to Cmd.Count - 1
                If Cmd(I) = "/admin" Then
                        Wscript.Echo "To script you must have administrator rights!"
                        'RequireAdmin = 0
                        'Exit Function
                        WScript.Quit
                End If
                CmdLine = CmdLine & Chr(32) & Chr(34) & Cmd(I) & Chr(34)
        Next
        CmdLine = CmdLine & Chr(32) & Chr(34) & "/admin" & Chr(34)

        Set WShell= WScript.CreateObject( "WScript.Shell")
        CreateObject("Shell.Application").ShellExecute WShell.ExpandEnvironmentStrings(_
        "%SystemRoot%\System32\WScript.exe"),Chr(34) & WScript.ScriptFullName & Chr(34) & CmdLine, "", "runas"
        WScript.Quit
End Function

Не пойму, что дописать далее, поэтому прошу вашей помощи!

Iska 11-10-2018 20:17 2835481
Цитата:
Цитата in-com
Не пойму, что дописать далее, »
Больше — ничего.

Цитата:
Цитата in-com
найти уже заданное значение в реестре »
Где именно найти? Какое значение?

Нужен не результат Ваших усилий в виде кода, а внятное словесное описание, с конкретикой — что и где.

in-com 11-10-2018 21:20 2835488
Цитата:
Цитата Iska
а внятное словесное описание, с конкретикой — что и где. »
Имеется заранее созданный подраздел в реестре (контекстное подменю "Дополнительно"по правой кнопке Компьютер) по пути "HKEY_CLASSES_ROOT\CLSID\{20D04FE0-3AEA-1069-A2D8-08002B30309D}\shell\CompMgmt" со строковым параметром SubCommands, значение которого необходимо изменить. То есть добавить еще одну строчку в параметре SubCommands не удаляя текущих значений. Например на основе файла реестра:
Было до работы скрипта
[HKEY_CLASSES_ROOT\CLSID\{20D04FE0-3AEA-1069-A2D8-08002B30309D}\shell\CompMgmt]
"MUIVerb"="Дополнительно"
"SubCommands"="controlpanel;services;regedit;msconfig;gpedit;taskschd;eventvwr"
"Icon"="imageres.dll,104"
"Position"="Top"

Стало после работы скрипта
[HKEY_CLASSES_ROOT\CLSID\{20D04FE0-3AEA-1069-A2D8-08002B30309D}\shell\CompMgmt]
"MUIVerb"="Дополнительно"
"SubCommands"="chkdsk;controlpanel;services;regedit;msconfig;gpedit;taskschd;eventvwr"
"Icon"="imageres.dll,104"
"Position"="Top"

Необходимость в VBS скрипте возникла после невозможности отображения данного контекстного меню, если удалить подраздел, на который ссылается первое значение в параметре SubCommands
Удаление подраздела controlpanel
[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\CommandStore\shell\controlpane l]
"MUIVerb"="Панель управления"
"Icon"="imageres.dll,22"
[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\CommandStore\shell\controlpane l\command]
@="control.exe"

Если бы система игнорировала несуществующие подразделы, на которые ссылаются строчки в SubCommands, то было бы идеально. Но этого не происходит, поэтому приходится искать такие решения.

Iska 11-10-2018 22:03 2835501
in-com, это не «добавить ещё одну строчку», а «вставить подстроку в начало строки, дополнив её точкой с запятой, если таковая подстрока отсутствует в строке». Но ладно, понятно.

А что делать, если таковой раздел, как:
Код:
HKEY_CLASSES_ROOT\CLSID\{20D04FE0-3AEA-1069-A2D8-08002B30309D}\shell\CompMgmt
вообще не существует (как у меня, например)?

in-com 12-10-2018 07:08 2835529
Вложений: 1
Цитата:
Цитата Iska
это не «добавить ещё одну строчку» »
Понял, буду исправляться :)

Цитата:
Цитата Iska
А что делать, если таковой раздел вообще не существует (как у меня, например)? »
Выкладываю вам во вложении готовый файл реестра и vbs скрипт (на ваше усмотрение) со всеми прописанными параметрами.

Iska 12-10-2018 21:59 2835649
in-com, спасибо за файл реестра, но всё-таки — что в этом случае нужно делать?

Впрочем, вот Вам примерная болванка на WSH на добавление подстроки «chkdsk», в случае её отсутствия, в начало значения строкового параметра «SubCommands» раздела «HKEY_CLASSES_ROOT\CLSID\{20D04FE0-3AEA-1069-A2D8-08002B30309D}\shell\CompMgmt»:
Скрытый текст
Код:
Option Explicit

Const HKEY_CLASSES_ROOT = &H80000000


Dim objSWbemObjectEx

Dim strValue


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

If objSWbemObjectEx.GetStringValue(HKEY_CLASSES_ROOT, "CLSID\{20D04FE0-3AEA-1069-A2D8-08002B30309D}\shell\CompMgmt", "SubCommands", strValue) = 0 Then
        If UBound(Filter(Split(strValue, ";"), "chkdsk", True, vbTextCompare)) = -1 Then
                strValue = "chkdsk;" & strValue
               
                If objSWbemObjectEx.SetStringValue(HKEY_CLASSES_ROOT, "CLSID\{20D04FE0-3AEA-1069-A2D8-08002B30309D}\shell\CompMgmt", "SubCommands", strValue) = 0 Then
                        WScript.Echo "Set string value successfully."
                Else
                        WScript.Echo "Can't set string value."
                End If
        Else
                WScript.Echo "String value already contains substring."
        End If
Else
        WScript.Echo "Can't find subkey or parameter."
End If

WScript.Quit 0

in-com 13-10-2018 08:36 2835670
Цитата:
Цитата Iska
Вам примерная болванка на WSH на добавление подстроки «chkdsk» »
Спасибо Вам большое! То, что нужно!
А можно сделать, чтобы отдельный скрипт искал и удалял уже существующую подстроку «chkdsk;» в любом месте строки, прописанной в строковом параметре «SubCommands»?
Пробовал так

Option Explicit

Const HKEY_CLASSES_ROOT = &H80000000

Dim objSWbemObjectEx

Dim strValue

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

If objSWbemObjectEx.GetStringValue(HKEY_CLASSES_ROOT, "CLSID\{20D04FE0-3AEA-1069-A2D8-08002B30309D}\shell\CompMgmt", "SubCommands", strValue) = 0 Then
If UBound(Filter(Split(strValue, ";"), "chkdsk", True, vbTextCompare)) = 0 Then
strValue = Replace(strValue,"chkdsk;", "")
WScript.Echo strValue
End If
Else
WScript.Echo "Can't find subkey or parameter."
End If

WScript.Quit 0

Что интересно, WSH отображает, что подстрока удалена, но сохранять значение не хочет.

Iska 13-10-2018 21:34 2835765
Цитата:
Цитата in-com
…но сохранять значение не хочет. »
Так Вы ж её в реестр и не пишете.

Цитата:
Цитата in-com
А можно сделать, чтобы отдельный скрипт искал и удалял уже существующую подстроку «chkdsk;» в любом месте строки, прописанной в строковом параметре «SubCommands»? »
Вот ещё одна примерная болванка кода:
Скрытый текст
Код:
Option Explicit

Const HKEY_CLASSES_ROOT = &H80000000


Dim objSWbemObjectEx

Dim strValue


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

If objSWbemObjectEx.GetStringValue(HKEY_CLASSES_ROOT, "CLSID\{20D04FE0-3AEA-1069-A2D8-08002B30309D}\shell\CompMgmt", "SubCommands", strValue) = 0 Then
        If UBound(Filter(Split(strValue, ";"), "chkdsk", True, vbTextCompare)) = 0 Then
                strValue = Replace(Replace(Replace(strValue, "chkdsk;", ""), ";chkdsk", ""),"chkdsk", "")
               
                If objSWbemObjectEx.SetStringValue(HKEY_CLASSES_ROOT, "CLSID\{20D04FE0-3AEA-1069-A2D8-08002B30309D}\shell\CompMgmt", "SubCommands", strValue) = 0 Then
                        WScript.Echo "Set string value successfully."
                Else
                        WScript.Echo "Can't set string value."
                End If
        Else
                WScript.Echo "String value not contains substring."
        End If
Else
        WScript.Echo "Can't find subkey or parameter."
End If

WScript.Quit 0

in-com 14-10-2018 00:18 2835774
Цитата:
Цитата Iska
Вот ещё одна примерная болванка кода »
Iska, премного благодарен! Ваши примерные болванки делают свое дело :Beer:


Время: 15:29.

Время: 15:29.
© OSzone.net 2001-