'Создание ActiveX-объекта на рабочем столе
set wsh1 = WScript.CreateObject("WScript.Shell")
GUID = "{3CDE458F-AFDF-46f1-BA75-351E6AC64DA9}"
Action = InputBox("Введите цифру, указывающую на необходимое вам действие:" & vbCrLf &  vbCrLf &  "1. Создать объект на рабочем столе" & vbCrLf  & "2. Создать команды контекстного меню" & vbCrLf  & "3. Скрыть объект с рабочего стола" & vbCrLf, "Меню", "1")

Select case Action
case 1
	if RRD(0, "HKCR\CLSID\" & GUID & "\") = EMPTY then
		wsh1.RegWrite "HKCR\CLSID\" & GUID & "\ShellFolder\Attributes", 0, "REG_DWORD"
		wsh1.RegWrite "HKCR\CLSID\" & GUID & "\ShellFolder\CallForAttributes", 0, "REG_DWORD"
		Temp = InputBox("Введите название значка:", "Занимаемся творчеством", "Мой значок")
		if temp <> "" then wsh1.RegWrite "HKCR\CLSID\" & GUID & "\", temp, "REG_SZ"
		Temp = InputBox("Введите подсказку для значка:", "Занимаемся творчеством", "Тсссс!!! - это мой значок! Вы знали?")
		if temp <> "" then wsh1.RegWrite "HKCR\CLSID\" & GUID & "\InfoTip", temp, "REG_SZ"
		Temp = InputBox("Укажите путь к иконке для значка:", "Занимаемся творчеством", "shell32.dll,34")
		if temp <> "" then wsh1.RegWrite "HKCR\CLSID\" & GUID & "\DefaultIcon\", temp, "REG_EXPAND_SZ"
		call AddCommand	
	End If
	'добавляем наш объект на рабочий стол
	wsh1.RegWrite "HKLM\Software\Microsoft\Windows\CurrentVersion\Explorer\Desktop\namespace\" & GUID & "\", GUID, "REG_SZ"
case 2
	call AddCommand
case 3
	RRD 1, "HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\Desktop\namespace\" & GUID & "\"
End select

sub AddCommand()
i = 1
Do while i > 0
	Temp = InputBox("Введите название элемента командной строки:", "Занимаемся творчеством", RRD(0, "HKCR\CLSID\" & GUID & "\shell\" & i & "\"))
	if temp <> "" then wsh1.RegWrite "HKCR\CLSID\" & GUID & "\shell\" & i & "\", temp, "REG_SZ"
	Temp = InputBox("Введите команду:", "Занимаемся творчеством", RRD(0, "HKCR\CLSID\" & GUID & "\shell\" & i & "\command\"))
	if temp <> "" then 
		wsh1.RegWrite "HKCR\CLSID\" & GUID & "\shell\" & i & "\command\", temp, "REG_EXPAND_SZ"
	Else
		i = i - 1
  End if
  i = i + 1
  Temp = MsgBox("Добавить еще одну команду?", vbYesNo, "Занимаемся творчеством")
  if temp = vbNo then i = 0
Loop
End sub

'если i=0, то выполняется чтение параметра реестра, если i=1, то выполняется удаление параметра реестра
Function RRD(i, Path)
	set wshTemp = WScript.CreateObject("WScript.Shell")
	On Error Resume Next
	select case i
	case "0"
		RRD = wshTemp.RegRead(Path)

		'проверяем, произошла ли ошибка при чтении параметра реестра
		if err.Number <> 0 then
			err.Clear
		End if
	case "1"
		wshTemp.RegDelete Path

		'проверяем, произошла ли ошибка при удалении параметра реестра
		if err.Number <> 0 then
			err.Clear
		End if
	End select

	'удаляем объект из памяти, чтобы не засорять ее
	Set wshTemp = Nothing
End Function