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

[The_Immortal]

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



Банальная задача, на которую не нашел решения.

В режиме аудита настраиваются ярлыки на панели задач. При создании нового пользователя необходимо, чтобы эти ярлыки на панели задач были такими же, а не дефолтными.

CopyProfile в этом не помогает.



Подскажите, пожалуйста, как решить эту незамысловатую задачку?





Спасибо!

[Казбек]

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

[zxawfd@vk]

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



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,

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

[Казбек]

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



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

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

Я посмотрел итоговое - оно основано на решении, приведенном в статье
Цитата Казбек:



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

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

, но вопрос
Цитата The_Immortal:



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

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

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







UPD:
Цитата The_Immortal:



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

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

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



pinunpin.vbs

[spoiler]Код:

[/spoiler]

Код: Выделить всё

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[/i]" - вероятно, у меня какие-то проблемы с WSH, т.к. автор пишет, что всё работает "brilliantly".







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

[The_Immortal]

Цитата The_Immortal:



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

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

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

[Iska]

Iska,
Цитата Iska:



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

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

Код:

Код: Выделить всё

Set s_oFSO = CreateObject("Scripting.FileSystemObject")

Цитата Iska:



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

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

x64, русская.



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



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

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

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



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

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

[The_Immortal]

Цитата 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")

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

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

[Iska]

Iska,
Цитата Iska:



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

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

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



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


pintaskbar.vbs

[spoiler]Код:

[/spoiler]

Код: Выделить всё

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[/i], взятого

отсюда

. Он выдал следующее:


Цитата:



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]

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



На этот раз необходимо изъять программу из панели задач 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".



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