Общее - [решено] Изъять программу из панели задач

Казбек · Конфигурация компьютера

The_Immortal,

How to Pin to Start Menu/Task Bar for Default User

Pin Items to the Start Menu or Windows 7 Taskbar via Script

The_Immortal · Отправлено: **11:28, 31-03-2015** | #3

Казбек,

Цитата Казбек:

How to Pin to Start Menu/Task Bar for Default User »

Тут вообще жесть - километровые решения

Цитата Казбек:

Pin Items to the Start Menu or Windows 7 Taskbar via Script »

Здесь вроде попроще, но непонятно каким образом зафигачить это для дефолтного пользователя....

Казбек · Конфигурация компьютера

The_Immortal,
Посмотрите внимательно. По первой ссылке там несколько решений.

The_Immortal · Отправлено: **11:47, 31-03-2015** | #5

Казбек,

Цитата Казбек:

По первой ссылке там несколько решений. »

Я посмотрел итоговое - оно основано на решении, приведенном в статье

Цитата Казбек:

Pin Items to the Start Menu or Windows 7 Taskbar via Script »

, но вопрос

Цитата The_Immortal:

каким образом зафигачить это для дефолтного пользователя »

остается открытым.

UPD:

Цитата The_Immortal:

Я посмотрел итоговое »

Кстати, Вы не могли бы его протестировать у себя?

pinunpin.vbs

Код:

Dim iArgCount

iArgCount = WScript.Arguments.Count
If (iArgCount <> 3) Then
	ShowUsage
End If

Dim sAction,sSMorTB,sFilePath
sAction = LCase(WScript.Arguments.Item(0))
sSMorTB = LCase(WScript.Arguments.Item(1))
sFilePath = LCase(WScript.Arguments.Item(2))

If (sAction <> "pin") And (sAction <> "unpin") Then
	WScript.Echo "Error: Invalid Action: '" & sAction & "'"
	ShowUsage
End If

If (sSMorTB <> "startmenu") And (sSMorTB <> "taskbar") Then
	WScript.Echo "Error: Invalid Location: '" & sSMorTB & "'"
	ShowUsage
End If

If (sAction = "pin") And (sSMorTB = "startmenu") Then PinToStartMenu sFilePath
If (sAction = "pin") And (sSMorTB = "taskbar") Then PinToTaskBar sFilePath
If (sAction = "unpin") And (sSMorTB = "startmenu") Then UnpinFromStartMenu sFilePath
If (sAction = "unpin") And (sSMorTB = "taskbar") Then UnpinFromTaskBar sFilePath


WScript.Quit		

Sub ShowUsage
	WScript.Echo "Usage:  " & WScript.ScriptName & " [PIN|UNPIN] [STARTMENU|TASKBAR] File"
	WScript.Echo vbTab & WScript.ScriptName & " PIN startmenu C:\apps\tools\wmopener.exe"
	WScript.Echo vbTab & WScript.ScriptName & " unpin TASKBAR ""C:\ProgramData\Microsoft\Windows\Start Menu\Programs\Mozilla Firefox.lnk"""
	WScript.Quit
End Sub

Sub PinToStartMenu(Required_Path_To_Item)
	' See
	' http://blogs.technet.com/b/deploymentguys/archive/2009/04/08/pin-items-to-the-start-menu-or-windows-7-taskbar-via-script.aspx?PageIndex=3
	Const CSIDL_COMMON_PROGRAMS = &H17 
	Const CSIDL_PROGRAMS = &H2 
	
	Dim s_oFSO, s_oShell, s_oAllUsersProgramsFolder
	Dim s_oFolder, s_oFolderItem, s_colVerbs, s_oVerb
	Dim s_FullItemPath, s_sItemFolder, s_sItemName, s_sAllUsersProgramsPath

	Set s_oFSO = CreateObject("Scripting.FileSystemObject")
	Set s_oShell = CreateObject("Shell.Application")
	
	s_FullItemPath = Required_Path_To_Item
	
	If Not (s_oFSO.FileExists(s_FullItemPath)) Then
		WScript.Echo "Error Pinning File '" & s_FullItemPath & "' to Start Menu: File Does Not Exist!"
		Exit Sub
	End If
	
	s_sItemFolder = s_oFSO.GetParentFolderName(s_FullItemPath)
	s_sItemName = s_oFSO.GetFileName(s_FullItemPath)

	Set s_oFolder = s_oShell.Namespace(s_sItemFolder) 
	Set s_oFolderItem = s_oFolder.ParseName(s_sItemName) 
	Set s_colVerbs = s_oFolderItem.Verbs 

	For Each s_oVerb in s_colVerbs 
		If Replace(s_oVerb.name, "&", "") = "Pin to Start Menu" Then
			WScript.Echo "Pinning '" & s_FullItemPath & "' to Start Menu"
			's_oVerb.DoIt
		ElseIf Replace(s_oVerb.name, "&", "") = "Unpin from Start Menu" Then
			WScript.Echo "Error: Item '" & s_FullItemPath & "' is Already Pinned to Start Menu"
		End If
	Next
End Sub

Sub PinToTaskBar(Required_Path_To_Item)
	' See
	' http://blogs.technet.com/b/deploymentguys/archive/2009/04/08/pin-items-to-the-start-menu-or-windows-7-taskbar-via-script.aspx?PageIndex=3
	Const CSIDL_COMMON_PROGRAMS = &H17 
	Const CSIDL_PROGRAMS = &H2 
	
	Dim s_oFSO, s_oShell, s_oAllUsersProgramsFolder
	Dim s_oFolder, s_oFolderItem, s_colVerbs, s_oVerb
	Dim s_FullItemPath, s_sItemFolder, s_sItemName, s_sAllUsersProgramsPath

	Set s_oFSO = CreateObject("Scripting.FileSystemObject")
	Set s_oShell = CreateObject("Shell.Application")
	
	s_FullItemPath = Required_Path_To_Item
	
	If Not (s_oFSO.FileExists(s_FullItemPath)) Then
		WScript.Echo "Error Pinning File '" & s_FullItemPath & "' to TaskBar: File Does Not Exist!"
		Exit Sub
	End If
	
	s_sItemFolder = s_oFSO.GetParentFolderName(s_FullItemPath)
	s_sItemName = s_oFSO.GetFileName(s_FullItemPath)

	Set s_oFolder = s_oShell.Namespace(s_sItemFolder) 
	Set s_oFolderItem = s_oFolder.ParseName(s_sItemName) 
	Set s_colVerbs = s_oFolderItem.Verbs 

	For Each s_oVerb in s_colVerbs 
		If Replace(s_oVerb.name, "&", "") = "Pin to Taskbar" Then
			WScript.Echo "Pinning '" & s_FullItemPath & "' to Taskbar"
			's_oVerb.DoIt
		ElseIf Replace(s_oVerb.name, "&", "") = "Unpin from Taskbar" Then
			WScript.Echo "Error: Item '" & s_FullItemPath & "' is Already Pinned to Taskbar"
		End if
	Next
End Sub

Sub UnpinFromStartMenu(Required_Path_To_Item)
	' See
	' http://blogs.technet.com/b/deploymentguys/archive/2009/04/08/pin-items-to-the-start-menu-or-windows-7-taskbar-via-script.aspx?PageIndex=3
	Const CSIDL_COMMON_PROGRAMS = &H17 
	Const CSIDL_PROGRAMS = &H2 
	
	Dim s_oFSO, s_oShell, s_oAllUsersProgramsFolder
	Dim s_oFolder, s_oFolderItem, s_colVerbs, s_oVerb
	Dim s_FullItemPath, s_sItemFolder, s_sItemName, s_sAllUsersProgramsPath

	Set s_oFSO = CreateObject("Scripting.FileSystemObject")
	Set s_oShell = CreateObject("Shell.Application")
	
	s_FullItemPath = Required_Path_To_Item
	
	If Not (s_oFSO.FileExists(s_FullItemPath)) Then
		WScript.Echo "Error Unpinning File '" & s_FullItemPath & "' From Start Menu: File Does Not Exist!"
		Exit Sub
	End If
	
	s_sItemFolder = s_oFSO.GetParentFolderName(s_FullItemPath)
	s_sItemName = s_oFSO.GetFileName(s_FullItemPath)

	Set s_oFolder = s_oShell.Namespace(s_sItemFolder) 
	Set s_oFolderItem = s_oFolder.ParseName(s_sItemName) 
	Set s_colVerbs = s_oFolderItem.Verbs 

	For Each s_oVerb in s_colVerbs 
		If Replace(s_oVerb.name, "&", "") = "Unpin from Start Menu" Then
			WScript.Echo "Unpinning '" & s_FullItemPath & "' From Start Menu"
			's_oVerb.DoIt
		ElseIf Replace(s_oVerb.name, "&", "") = "Pin to Start Menu" Then
			WScript.Echo "Error: Item '" & s_FullItemPath & "' is Not Pinned to Start Menu"
		End if
	Next
End Sub

Sub UnpinFromTaskBar(Required_Path_To_Item)
	' See
	' http://blogs.technet.com/b/deploymentguys/archive/2009/04/08/pin-items-to-the-start-menu-or-windows-7-taskbar-via-script.aspx?PageIndex=3
	Const CSIDL_COMMON_PROGRAMS = &H17 
	Const CSIDL_PROGRAMS = &H2 
	
	Dim s_oFSO, s_oShell, s_oAllUsersProgramsFolder
	Dim s_oFolder, s_oFolderItem, s_colVerbs, s_oVerb
	Dim s_FullItemPath, s_sItemFolder, s_sItemName, s_sAllUsersProgramsPath

	Set s_oFSO = CreateObject("Scripting.FileSystemObject")
	Set s_oShell = CreateObject("Shell.Application")
	
	s_FullItemPath = Required_Path_To_Item
	
	If Not (s_oFSO.FileExists(s_FullItemPath)) Then
		WScript.Echo "Error Unpinning File '" & s_FullItemPath & "' from Taskbar: File Does Not Exist!"
		Exit Sub
	End If
	
	s_sItemFolder = s_oFSO.GetParentFolderName(s_FullItemPath)
	s_sItemName = s_oFSO.GetFileName(s_FullItemPath)

	Set s_oFolder = s_oShell.Namespace(s_sItemFolder) 
	Set s_oFolderItem = s_oFolder.ParseName(s_sItemName) 
	Set s_colVerbs = s_oFolderItem.Verbs 

	For Each s_oVerb in s_colVerbs 
		If Replace(s_oVerb.name, "&", "") = "Unpin from Taskbar" Then
			WScript.Echo "Unpinning '" & s_FullItemPath & "' from Taskbar"
			's_oVerb.DoIt
		ElseIf Replace(s_oVerb.name, "&", "") = "Pin to Taskbar" Then
			WScript.Echo "Error: Item '" & s_FullItemPath & "' is Not Pinned to Taskbar"
		End if
	Next
End Sub

Использование:

Код:

pinunpin.vbs pin taskbar "C:\Program Files (x86)\Mozilla Firefox\firefox.exe"

У меня выдает ошибку "Невозможно создание объекта Scripting.FileSystemObject" - вероятно, у меня какие-то проблемы с WSH, т.к. автор пишет, что всё работает "brilliantly".

UPD2: запустил вышеуказанный скрипт на другой машине с Win 7 - ошибки не было, но и эффекта никакого не возымело.

Iska · Отправлено: **13:00, 31-03-2015** | #6

Цитата The_Immortal:

У меня выдает ошибку "Невозможно создание объекта Scripting.FileSystemObject" »

The_Immortal, где именно, на какой строке выдаёт? У Вас ОС — x64? Версия — английская?

The_Immortal · Отправлено: **13:25, 31-03-2015** | #7

Iska,

Цитата Iska:

на какой строке выдаёт? »

Код:

Set s_oFSO = CreateObject("Scripting.FileSystemObject")

Цитата Iska:

У Вас ОС — x64? Версия — английская? »

x64, русская.

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

Цитата The_Immortal:

запустил вышеуказанный скрипт на другой машине с Win 7 - ошибки не было, но и эффекта никакого не возымело. »

Надо разбираться почему скрипт не приносит никакого эффекта.

Правда для начала хотелось бы удостовериться, что скрипт действительно не работает.
Пожалуйста, протестируйте кто-нибудь его.

Iska · Отправлено: **14:05, 31-03-2015** | #8

Цитата The_Immortal:

запустил вышеуказанный скрипт на другой машине с Win 7 - ошибки не было, но и эффекта никакого не возымело. »

Разумеется не возымело эффекта, поскольку:

Цитата The_Immortal:

русская. »

и глаголы в таких местах:

Код:

	For Each s_oVerb in s_colVerbs 
		If Replace(s_oVerb.name, "&", "") = "Pin to Start Menu" Then
			WScript.Echo "Pinning '" & s_FullItemPath & "' to Start Menu"
			's_oVerb.DoIt
		ElseIf Replace(s_oVerb.name, "&", "") = "Unpin from Start Menu" Then
			WScript.Echo "Error: Item '" & s_FullItemPath & "' is Already Pinned to Start Menu"
		End If
	Next

должны быть локализованы: «Закрепить программу в панели задач» и т.п. (текст приведён условный, по памяти), а исполнение глагола («s_oVerb.DoIt») — раскомментировано.

Цитата The_Immortal:

Set s_oFSO = CreateObject("Scripting.FileSystemObject") »

Проверьте ещё раз.

The_Immortal · Отправлено: **15:15, 31-03-2015** | #9

Iska,

Цитата Iska:

Разумеется не возымело эффекта»

Действительно, забыл про это, спасибо!

Скорректировал скрипт на русский вариант (лишние проверки и функции пока убрал). Получилось вот так:

pintaskbar.vbs

Код:

Dim sAction,sSMorTB,sFilePath
sAction = LCase(WScript.Arguments.Item(0))
sSMorTB = LCase(WScript.Arguments.Item(1))
sFilePath = LCase(WScript.Arguments.Item(2))

If (sAction = "pin") And (sSMorTB = "taskbar") Then PinToTaskBar sFilePath

WScript.Quit		

Sub PinToTaskBar(Required_Path_To_Item)
	' See
	' http://blogs.technet.com/b/deploymentguys/archive/2009/04/08/pin-items-to-the-start-menu-or-windows-7-taskbar-via-script.aspx?PageIndex=3
	Const CSIDL_COMMON_PROGRAMS = &H17 
	Const CSIDL_PROGRAMS = &H2 
	
	Dim s_oFSO, s_oShell, s_oAllUsersProgramsFolder
	Dim s_oFolder, s_oFolderItem, s_colVerbs, s_oVerb
	Dim s_FullItemPath, s_sItemFolder, s_sItemName, s_sAllUsersProgramsPath

	Set s_oFSO = CreateObject("Scripting.FileSystemObject")
	Set s_oShell = CreateObject("Shell.Application")
	
	s_FullItemPath = Required_Path_To_Item
	
	s_sItemFolder = s_oFSO.GetParentFolderName(s_FullItemPath)
	s_sItemName = s_oFSO.GetFileName(s_FullItemPath)

	Set s_oFolder = s_oShell.Namespace(s_sItemFolder) 
	Set s_oFolderItem = s_oFolder.ParseName(s_sItemName) 
	Set s_colVerbs = s_oFolderItem.Verbs 

	For Each s_oVerb in s_colVerbs 
		If Replace(s_oVerb.name, "&", "") = "Закрепить на панели задач" Then
			WScript.Echo "Pinning '" & s_FullItemPath & "' to Taskbar"
			s_oVerb.DoIt
		End if
	Next
End Sub

По-прежнему никакого эффекта, т.к. не выполняется условие

Код:

If Replace(s_oVerb.name, "&", "") = "Закрепить на панели задач"

Фразу "Закрепить на панели задач" я взял из результата выполнения скрипта ListVerbs.vbs, взятого отсюда. Он выдал следующее:

Цитата:

Verbs for item: C:\Program Files (x86)\Mozilla Firefox\firefox.exe
==================================================================
&Открыть
Запуск от имени &администратора
Исправл&ение неполадок совместимости

Закрепить на &панели задач
&Закрепить в меню "Пуск"
Восста&новить прежнюю версию

&Вырезать
&Копировать
Создать &ярлык
&Удалить
Переи&меновать
Сво&йства

Вызывал также внутри цикла

Код:

WScript.Echo s_oVerb.name

- показывало "Закрепить на &панели задач".

Откуда там амперсанд в середине фразы мне не очень понятно, но я пробовал и с ним через просто сравнение:

Код:

If s_oVerb.name = "Закрепить на &панели задач" Then

и без него (т.е. с заменой, как в изначальном примере).

UPD: нашел в Инете такой вариант сравнения:

Код:

...
VerbName = Replace(objVerb.Name, "&", "")
If VerbName = "Закрепить программу в панели задач" Or VerbName = "Закрепить на панели задач" Or VerbName = "Pin to Taskbar" Then
objVerb.DoIt
...

Также не работает

UPD2: всё в порядке. Что-то не так с ОС, поэтому и не работало. Попробовал на чистой ОС - всё работает.

The_Immortal · Отправлено: **18:30, 06-05-2015** | #10

Всех приветствую!

На этот раз необходимо изъять программу из панели задач Win 8, а именно ярлык на "Магазин".

Пример рабочего скрипта изъятия Windows Media Player из панели задач у Win 7:

Код:

Const CSIDL_COMMON_PROGRAMS = &H17 

Dim objShell, objFSO
Dim objAllUsersProgramsFolder
Dim strAllUsersProgramsPath
Dim objFolder
Dim objFolderItem
Dim colVerbs
Dim objVerb

Set objShell = CreateObject("Shell.Application")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objAllUsersProgramsFolder = objShell.NameSpace(CSIDL_COMMON_PROGRAMS)
strAllUsersProgramsPath = objAllUsersProgramsFolder.Self.Path

'Windows Media Player unpin
If objFSO.FileExists(strAllUsersProgramsPath & "\Windows Media Player.lnk") Then
    Set objFolder = objShell.Namespace(strAllUsersProgramsPath)
    Set objFolderItem = objFolder.ParseName("Windows Media Player.lnk")
    Set colVerbs = objFolderItem.Verbs
    For Each objVerb in colVerbs
    VerbName = Replace(objVerb.Name, "&", "")
    If VerbName = "Изъять программу из панели задач" Or VerbName = "Изъять из панели задач" Or VerbName = "Unpin from Taskbar" Or VerbName = "Открепить от панели задач" Then
        objVerb.DoIt
    End If
    Next
End If

WScript.Quit

Пытался сделать аналогичным образом с "Магазином":

Код:

...
'Магазин unpin
If objFSO.FileExists(strAllUsersProgramsPath & "\Магазин.lnk") Then
    Set objFolder = objShell.Namespace(strAllUsersProgramsPath)
    Set objFolderItem = objFolder.ParseName("Магазин.lnk")
    Set colVerbs = objFolderItem.Verbs
    For Each objVerb in colVerbs
    VerbName = Replace(objVerb.Name, "&", "")
    If VerbName = "Изъять программу из панели задач" Or VerbName = "Изъять из панели задач" Or VerbName = "Unpin from Taskbar" Or VerbName = "Открепить от панели задач" Then
        objVerb.DoIt
    End If
    Next
End If

WScript.Quit

Но почему-то не срабатывает.

Может проблема связано как-то с кириллицей?

Спасибо!

UPD: оказывается ссылка называлась "Windows Store.lnk", а представлялась как "Магазин.lnk".

Всем спасибо!