Тема: 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