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

Компьютерный форум OSzone.net (http://forum.oszone.net/index.php)
-   Программирование и базы данных (http://forum.oszone.net/forumdisplay.php?f=21)
-   -   Нужен .vbs скрипт для внесения изменений в реестр (http://forum.oszone.net/showthread.php?t=336327)

BKPB 21-08-2018 21:40 2827815
Нужен .vbs скрипт для внесения изменений в реестр
 
Помогите написать скрипт .vbs для внесения этих строк в реестр с получением прав на внесение в эту ветку реестра,

Windows Registry Editor Version 5.00

[HKEY_LOCAL_MACHINE\SOFTWARE\Classes\PotPlayerMini.XSPF\DefaultIcon]
@="C:\\Program Files (x86)\\PotPlayer\\PotIcons.dll,86"

[HKEY_LOCAL_MACHINE\SOFTWARE\Classes\PotPlayerMini.MPL\DefaultIcon]
@="C:\\Program Files (x86)\\PotPlayer\\PotIcons.dll,85"

[HKEY_LOCAL_MACHINE\SOFTWARE\Classes\PotPlayerMini.MPLS\DefaultIcon]
@="C:\\Program Files (x86)\\PotPlayer\\PotIcons.dll,81"

[HKEY_LOCAL_MACHINE\SOFTWARE\Classes\PotPlayerMini.M3U8\DefaultIcon]
@="C:\\Program Files (x86)\\PotPlayer\\PotIcons.dll,82"

[HKEY_LOCAL_MACHINE\SOFTWARE\Classes\PotPlayerMini.CUE\DefaultIcon]
@="C:\\Program Files (x86)\\PotPlayer\\PotIcons.dll,84"

а в конце скрипта вставить эти строки для обновления иконок после выполнения скрипта:

Dim objWshShell
Set objWshShell = WScript.CreateObject("WScript.Shell")

objWshShell.Run "ie4uinit -show"
' Для Windows 7
objWshShell.Run "ie4uinit -ClearIconCache"

И нужно, что бы скрипт запускался с обычными правами (то есть не нуждался в запуске от Администратора)

Iska 21-08-2018 21:51 2827817
Цитата:
Цитата BKPB
И нужно, что бы скрипт запускался с обычными правами (то есть не нуждался в запуске от Администратора) »
Да без проблем. Вот только при попытке что-либо создать/изменить в HKLM интерпретатор Windows Script Host получит «отлуп» от системы.

BKPB 21-08-2018 22:10 2827822
Вот сделал скрипт из рег в vbs с помощью конвертера REG Convert.]

Код:
Option Explicit
'~ On Error Resume Next
RequireAdmin
 
Dim objReg
Set objReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
 
RegWrite "HKLM\SOFTWARE\Classes\PotPlayerMini.XSPF\DefaultIcon", "", "REG_SZ", "C:\Program Files (x86)\PotPlayer\PotIcons.dll,86"
RegWrite "HKLM\SOFTWARE\Classes\PotPlayerMini.MPL\DefaultIcon", "", "REG_SZ", "C:\Program Files (x86)\PotPlayer\PotIcons.dll,85"
RegWrite "HKLM\SOFTWARE\Classes\PotPlayerMini.MPLS\DefaultIcon", "", "REG_SZ", "C:\Program Files (x86)\PotPlayer\PotIcons.dll,81"
RegWrite "HKLM\SOFTWARE\Classes\PotPlayerMini.M3U8\DefaultIcon", "", "REG_SZ", "C:\Program Files (x86)\PotPlayer\PotIcons.dll,82"
RegWrite "HKLM\SOFTWARE\Classes\PotPlayerMini.CUE\DefaultIcon", "", "REG_SZ", "C:\Program Files (x86)\PotPlayer\PotIcons.dll,84"
 
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
Помогите вставить в него эти строки для обновления иконок после выполнения скрипта:

Dim objWshShell
Set objWshShell = WScript.CreateObject("WScript.Shell")

objWshShell.Run "ie4uinit -show"
' Для Windows 7
objWshShell.Run "ie4uinit -ClearIconCache"

BKPB 22-08-2018 09:14 2827864
Один человек подсказал мне вставить эту строку в 13-ю строку этого скрипта:
CreateObject("WScript.Shell").Run "ie4uinit -show"
С Рабочего стола скрипт отрабатывает нормально и при запуске из папки Temp\PotPlayer, куда распаковывает инсталлятор тоже нормально.
Но вот при запуске инсталлятора выскакивает ошибка:
---------------------------
Windows Script Host
---------------------------
Сценарий: C:\Users\A47D~1\AppData\Local\Temp\PotPlayer\Associations.vbs
Строка: 13
Символ: 1
Ошибка: Не удается найти указанный файл.
Код: 80070002
Источник: (null)

---------------------------
ОК
---------------------------

Самое интересное, что хоть ошибка и выскакивает иконки обновляются.

Как исправить эту ошибку ?

BKPB 22-08-2018 10:32 2827880
Кажется что то начинает прояснятся, ошибка зависит от места запуска скрипта вызывающего ie4uinit.exe.
если выбираю директорию для запуска скрипта %SYSTEM32%:
Не удается найти "%SYSTEM32%\Associations.vbs". Проверьте, правильно ли указано имя и повторите попытку.
%WINDIR% - Не удается найти
%SYSTEMDRIVE% - Не удается найти
%ALLUSERSPROFILE% - Не удается найти
%PROGRAMDATA% - Не удается найти
%COMMONPROGRAMFILES% - Не удается найти

Если выбираю директорию %APPDATA% или %LOCALAPPDATA%\, то ошибок нет, но по окончанию почему то открывается окно C:\Users\Администратор


Время: 23:10.

Время: 23:10.
© OSzone.net 2001-