on error resume next

MyRoot = &H80000002
Path = "SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\AppKey"

Set obj = GetObject("winmgmts:{impersonationLevel=impersonate}!root/Default:StdRegProv")
obj.EnumKey MyRoot, Path, Names

temp = ""
for each i in names
   temp = temp & i & "<br />"
next
Set MyIE = CreateObject("InternetExplorer.Application")

With MyIE
   .Navigate "about:blank"
   .Toolbar = 0
   .MenuBar = 0
   .StatusBar = 0
   .Left = 0
   .Top = 0
   .Document.Title = "Настройка мультимедийных клавиш"
End With

Do while 1
   MyIE.Visible = 0

   MyIE.Document.Body.InnerHTML = "Введите цифру, соответствующую клавише, команду которой нужно изменить: <br /> <ol> <li> клавиша Back (1) </li> <li> клавиша Forward (2) </li> <li> клавиша Refresh (3) </li> <li> клавиша Stop (4) </li> <li> клавиша Search (5) </li> <li> клавиша Favorites (6) </li> <li> клавиша Home (7) </li> <li> клавиша E-mail (15) </li> <li> клавиша Media (16) </li> <li> клавиша My Computer (17) </li> <li> клавиша Calculator (18) </li> <li> Выход </li> </ol> <br />" 
   MyIE.Visible = 1

   select case InputBox("Введите необходимое действие:")
   case 1
      obj.SetExpandedStringValue MyRoot, Path & "\1", "ShellExecute", InputBox("Введите новую команду")
   case 2
      obj.SetExpandedStringValue MyRoot, Path & "\2", "ShellExecute", InputBox("Введите новую команду")
   case 3
      obj.SetExpandedStringValue MyRoot, Path & "\3", "ShellExecute", InputBox("Введите новую команду")
   case 4
      obj.SetExpandedStringValue MyRoot, Path & "\4", "ShellExecute", InputBox("Введите новую команду")
   case 5
      obj.SetExpandedStringValue MyRoot, Path & "\5", "ShellExecute", InputBox("Введите новую команду")
   case 6
      obj.SetExpandedStringValue MyRoot, Path & "\6", "ShellExecute", InputBox("Введите новую команду")
   case 7
      obj.SetExpandedStringValue MyRoot, Path & "\7", "ShellExecute", InputBox("Введите новую команду")
   case 8
      obj.SetExpandedStringValue MyRoot, Path & "\15", "ShellExecute", InputBox("Введите новую команду")
   case 9
      obj.SetExpandedStringValue MyRoot, Path & "\16", "ShellExecute", InputBox("Введите новую команду")
   case 10
      obj.SetExpandedStringValue MyRoot, Path & "\17", "ShellExecute", InputBox("Введите новую команду")
   case 11
      obj.SetExpandedStringValue MyRoot, Path & "\18", "ShellExecute", InputBox("Введите новую команду")
   case else: exit do
   End select
Loop

MyIE.Quit()
Set MyIE = Nothing
WScript.Quit()