1 Тема от omegastripes (изменено: omegastripes, 2019-03-31 22:40:23)

  • omegastripes
  • Разработчик
  • Неактивен

Тема: VBS: Размещение скриптов в меню проводника "Отправить"

Всем привет! В моей практике бывали случаи, когда нужно было многократно запускать скрипт с какой-нибудь самописной утилиткой, перетаскивая на него разные файлы в проводнике. У меня таких набралось несколько. Для удобства, сначала я вручную кидал ярлыки в папку shell:sendto и запускал скрипты, щелкая правой кнопой на файле и выбирая нужный скрипт в контекстном меню проводника "Отправить". Позднее автоматизировал добавление и удаление скриптов в это меню. Вот шаблон, позволяющий это сделать:

Option Explicit

If WSCript.Arguments.Count = 0 Then
	AddItemToSendTo
	WSCript.Quit
End If

' Здесь располагается рабочая часть скрипта
MsgBox "Передан параметр " & WSCript.Arguments(0)

Sub AddItemToSendTo()
	
	Dim sLocMsgTitle, sLocShCutName, sLocAskAdd, sLocItemAdded, sLocAskRemove, sLocItemRemoved, oWshShell, oFSO, sAppDataPath, sScriptPath, sShCutPath
	
	If GetLocale = 1049 Then
		sLocMsgTitle = "Заголовок"
		sLocShCutName = "Название"
		sLocAskAdd = "Добавить подпункт '" & sLocShCutName & "' в пункт 'Отправить' контекстного меню Проводника?"
		sLocItemAdded = "Подпункт '" & sLocShCutName & "' добавлен"
		sLocAskRemove = "Удалить подпункт '" & sLocShCutName & "' из контекстного меню Проводника?"
		sLocItemRemoved = "Подпункт '" & sLocShCutName & "' удален"
	Else
		sLocMsgTitle = "Title"
		sLocShCutName = "Name"
		sLocAskAdd = "Add '" & sLocShCutName & "' subitem to Explorer context menu 'Send To' item?"
		sLocItemAdded = "'" & sLocShCutName & "' subitem added"
		sLocAskRemove = "Remove '" & sLocShCutName & "' subitem from Explorer context menu?"
		sLocItemRemoved = "'" & sLocShCutName & "' subitem removed"
	End If
	Set oWshShell = CreateObject("WScript.Shell")
	Set oFSO = CreateObject("Scripting.FileSystemObject")
	sAppDataPath = oWshShell.SpecialFolders.Item("AppData")
	sScriptPath = sAppDataPath & "\" & WScript.ScriptName
	sShCutPath = oWshShell.SpecialFolders.Item("SendTo") & "\" & sLocShCutName & ".lnk"
	If oFSO.FileExists(sScriptPath) And oFSO.FileExists(sShCutPath) Then
		If MsgBox(sLocAskRemove, vbOKCancel + vbCritical, sLocMsgTitle) = vbOK Then
			oFSO.DeleteFile sScriptPath, True
			oFSO.DeleteFile sShCutPath, True
			MsgBox sLocItemRemoved, vbInformation, sLocMsgTitle
		End If
	Else
		If MsgBox(sLocAskAdd, vbOKCancel + vbQuestion, sLocMsgTitle) = vbOK Then
			oFSO.CopyFile WScript.ScriptFullName, sScriptPath, True
			With oWshShell.CreateShortcut(sShCutPath)
				.Arguments = ""
				.Description = ""
				.HotKey = ""
				.IconLocation = "shell32.dll, 238"
				.TargetPath = sScriptPath
				.WindowStyle = 1
				.WorkingDirectory = sAppDataPath
				.Save
			End With
			MsgBox sLocItemAdded, vbInformation, sLocMsgTitle
		End If
	End If
	
End Sub

Получилось что-то вроде простенького "инсталлятора": при обычном запуске двойным щелчком скрипт спросит, нужно ли добавить соответствующий пункт в меню "Отправить", или удалить, если он там уже есть, а при запуске c параметрами управление передается рабочей части скрипта. При добавлении пункта в меню происходит копирование скрипта в папку AppData и создание ярлыка в папке SendTo. При удалении пункта - оба файла удаляются. В шаблоне необходимо кастомизировать заголовок для диалогов, название и иконку для пункта в меню, ну и собственно, вставить Ваш рабочий код вместо MsgBox'а.

Щт Уккщк Куыгьу Туче
’ҐЄгй п Є®¤®ў п бва Ёж : 1251