HTA, VBS: Ярлык на панель задач с запуском от имени администратора (Страница 1 из 2)

koros
Прочтите правила из шапки раздела и обрамите приведённые части поста в соответствующие BBCode.

По поводу использования mshta - это дает возможность запускать скрипт из других скриптов (не vbs) без создания дополнительных промежуточных файлов. Конкретно в этом случае я создаю ярлык на панели задач из 7-zip SFX и мне надо, чтобы он запускал программу с правами администратора.

В отношении скрипта. Есть рабочий скрипт для перекодировки текстового файла на основе CreateObject(""ADODB.Stream""):

mshta vbscript:execute("f=CreateObject(""Scripting.FileSystemObject"").GetFile(""C:\1.txt"").OpenAsTextStream(1).ReadAll():with CreateObject(""ADODB.Stream""):.Type=2:.Mode=3:.Open():.Charset=""windows-1251"":.WriteText(f):.Position=0:.Charset=""cp866"":S=.ReadText end with:a=CreateObject(""WScript.Shell"").RegWrite(""HKLM\NewKey\Param"",S,""REG_SZ""):close")

Попробовал сделать на его основе, т.е. заменить .LoadFromFile(f) на .WriteText(f) и .SaveToFile f на S=.ReadText с последующим созданием файла с помощью CreateObject(""Scripting.FileSystemObject"").CreateTextFile. Получился такой скрипт:

mshta vbscript:execute("f=""C:\Users\Администратор\AppData\Roaming\Microsoft\Internet Explorer\Quick Launch\User Pinned\TaskBar\Opera.lnk"":o=CreateObject(""Scripting.FileSystemObject"").GetFile(f).OpenAsTextStream(1).ReadAll():with CreateObject(""ADODB.Stream""):.Charset=""ascii"":.Type=2:.Mode=3:.Open():.Position=0:.WriteText(o):.Position=21:.WriteText Chr(96):.Position=0:S=.ReadText end with:a=CreateObject(""Scripting.FileSystemObject"").CreateTextFile(o,True).Write(S):close")

Ошибка не появляется, но и файл не изменяется. Если

a=CreateObject(""Scripting.FileSystemObject"").CreateTextFile(o,True).Write(S)

заменить на

a=CreateObject(""Scripting.FileSystemObject"").CreateTextFile(""c:\opera.lnk"",True).Write(S)

то c:\opera.lnk создается, но он совершенно не рабочий (/

Как я уже писал, скрипт мне нужен для использования в файле конфигурации 7-zip SFX. Сам ярлык на панели задач Windows старше 7 (насколько я знаю) не может быть создан с помощью документированных методик. Поэтому используется метод Verbs. В файле конфигурации 7-zip SFX записывается строка:

RunProgram="x86:hidcon:mshta vbscript:Execute(\"exe=\"\"%%T\\Opera.exe\"\":Set fs=CreateObject(\"\"Scripting.Filesystemobject\"\"):Set colVerbs=CreateObject(\"\"Shell.Application\"\").Namespace(fs.GetParentFolderName(exe)).ParseName(fs.GetFileName(exe)).Verbs:For Each objVerb in colVerbs:If Mid(objVerb.name,1,9)=\"\"Закрепить\"\" Then r=objVerb.DoIt End If:Next:close\")"

Ярлык создается, но программа не запускается, т.к. требется запуск от имени администратора Я и хочу поменять права у созданного ярлыка. При этом не хоxу создавать дополнительных файлов в архиве. Я не знаю других способов запустить скрипт vbs из  файла конфигурации кроме, как создать файл vbs и запустить его или через mshta.

Если просто создать в этой папке ярлык на программу, то он не будет работать. Работает только через "глагол".

Спасибо. Я просто неудачно выразился - имел в виду те методы, которые указали вы в предыдущем посту. Но не в этом дело, а в том, что через Verbs нельзя задать запуск от имени администратора. Насколько я понял это нельзя задать и через InvokeVerb\InvokeVerbEx...

Спасибо, учту.

Спасибо за советы, но может есть какие-нибудь мысли по моему первоначальному вопросу?

Именно не на панель быстрого запуска (она отключена по умолчанию), а на панель задач. Не понятно, почему у вас  - в меню Пуск.

С вашей помощью у меня получилось! Огромное спасибо!
Вот такой скрипт:

mshta vbscript:execute("f=CreateObject(""WScript.Shell"").Environment(""Process"")(""APPDATA"") & ""\Microsoft\Internet Explorer\Quick Launch\User Pinned\TaskBar\Opera.lnk"":with CreateObject(""SAPI.SpFileStream""):.Open f,1:.Seek 21:.Write &H20:.Close: end with:close")

Некоторое замечание. Если создавать ярлык на панели задач методом .Doit, то его имя такое же, как описание исходного файла (FileDescription). Если создавать ярлык через ПКМ, то имя ярлыка для некоторых файлов такое же, как FileDescription, а для некоторых - только первое слово до пробела из FileDescription. Какая тут зависимость я, честно говоря, не стал отслеживать... Это так - просто наблюдение...

Понятно - буду исправлять. Спасибо.

koros
Я уже писал, что до Висты панель быстрого запуска выполняла ту же функцию, что в поздних версиях выполняет кнопочный ряд панели задач, с той лишь разницей, что её можно отделять и крепить к любой стороне экрана.
Папки User Pinned\TaskBar\ там нет. Путь должен быть без этой цепочки. Ярлык на XP должен и так отрабатывать, там нет UAC.
Проблема же с выходом может быть та же, что у меня, т.е. к синтаксису скрипта это вообще может не иметь отношения.
А запись должна выглядеть как-то так:

mshta vbscript:Execute("Set WSS=CreateObject(""WScript.Shell""):If WSS.RegRead(""HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\CurrentVersion"")>""5.1"" Then:With CreateObject(""SAPI.SpFileStream"") .Open ""%SfxFolder26%\Microsoft\Internet Explorer\Quick Launch\User Pinned\TaskBar\""&CreateObject(""Shell.Application"").NameSpace(0).ParseName(WSS.Environment(""Process"")(""PROGRAMFILES"")&""\Opera\Opera.exe"").ExtendedProperty(""FileDescription"")&"".lnk"",1:.Seek 21:.Write &H20:.Close:End With:close")

И скрипт создания ярлыка в моём представлении должен выполняться таким образом:

Set WSS = CreateObject("WScript.Shell")
VPlus = WSS.RegRead("HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\CurrentVersion") > "5.1"
Set Opera = CreateObject("Shell.Application").NameSpace(&H26).ParseName("Opera\Opera.exe")
If VarType(Opera) = 9 Then WSH.Quit
If VPlus Then Chain = "User Pinned\TaskBar\"
Desc = Opera.ExtendedProperty("FileDescription")
Link = WSS.Environment("Process")("APPDATA") & "\Microsoft\Internet Explorer\Quick Launch\" & Chain & Desc & ".lnk"
If Not CreateObject("Scripting.FileSystemObject").FileExists(Link) Then
	If VPlus Then
 		Opera.InvokeVerb("taskbarpin")
	Else
		With WSS.CreateShortcut(Link)
			.TargetPath = Opera.Path
			.Description = Desc
			.Save
		End With
	End If
End If

koros
А то, что правила обязательны к выполнению, знаете? Особенно специально подчёркнутое. Исправляйте.

По поводу различия панели задач (TaskBar)  и панели быстрого запуска (Quick Launch).

Спасибо. Я просто не понял - думал, что ваша фраза о проблеме с выходом относится к моему последнему вопросу. Извините.

Это не совсем так. В вашем варианте скрипт начинает выполнятся, затем проверяется на какой системе он запущен и, при запуске на ХР, дальше команды не выполняются. Да при этом на ХР никакие действия с ярлыком не выполняются, Но при этом процесс mshta.exe остается висеть в запущенных процессах.
В остальном - полностью согласен. У меня также учитываются %ProgramFiles% и т.п. - просто я решил привести здесь более сокращенный код, чтобы просто показать проблему с mhta, которая меня интересует.

Ваш пример с mhta без завершающго End If на ХР не работает.

Я никакой спициалист в javascript, поэтому не знаю, как в нем организовать проверку на ХР. Но это и не важно, т.к. для моих целей javascript не подходит из-за того, что в нем допустимая длина строки в mshta меньше, чем в vbs и постоянно надо конвертировать слеши в путях.
Не знаю насчет настроек безопасности IE, но если упростить скрипт следующим образом

mshta vbscript:Execute("Set WSS=CreateObject(""WScript.Shell""):If WSS.RegRead(""HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\CurrentVersion"")>""5.1"" Then:msgbox(""Not XP""):End With:close")

, то скрипт отрабатывает так как надо - на ХР msbox не появляется и mshta кратковременно появляется в запущенных процессах и исчезает из них.
Если же вместо

msgbox(""Not XP"")

будет

With CreateObject(""SAPI.SpFileStream"") .Open ""%SfxFolder26%\Microsoft\Internet Explorer\Quick Launch\User Pinned\TaskBar\""&CreateObject(""Shell.Application"").NameSpace(0).ParseName(WSS.Environment(""Process"")(""PROGRAMFILES"")&""\Opera\Opera.exe"").ExtendedProperty(""FileDescription"")&"".lnk"",1:.Seek 21:.Write &H20:.Close:End With

, то с ярлыком, естественно, ничего не будет происходить (да его и нет), но mshta останется висеть в запущенных процессах. Если же виноваты настройки безопасности IE, то почему же они так реагируют на разные куски кода, которые всё равно не выполняются по условию?

Спасибо. Решение, которое я нашел для данной ситуации я уже привел, но просто хотелось бы разобраться c причинами такого поведения mshta.

Да, конечно. Я привел только часть, чтобы продемонстрировать затык с mshta.

Если добавить End If, то на ХР работает. На более поздних версиях - не так важно, поскольку требуется запускать скрипт на различных версиях и, поскольку ХР требует End If, я рассматривал скрипт с End If.

Я прошу прощения - описался здесь, когда набивал пост. Естественно, проверял длинный и короткий вариант с End If вместо End With. Главное то, что короткий вариант работает нормально, а длинный - оставляет висеть mshta в процессах.

Ну это не имеет смысла ради данной задачи. Тем более, что решение уже есть...

Спасибо.

Спасибо. Можно ли это записать в формате mshta?

Честно говоря - ничего в этом примере не понял... Что делает этот скрипт?

Flasher, благодарю за тестирование ). К сожалению первый код ваял только что и проверить смог только на Win 7 и Win 10. А что у вас за ОС ? XP ?

Можете показать, что выдаст такой вариант ?

items = resGetStrings("shell32.dll","337")

MsgBox Join(items,vbCrlf)

Предполагаю, что это как раз потому что в XP нет этих пунктов меню (10-ого и 11-ого элемента массива).

По поводу второго кода -
1) Это тоже тестовая заготовка. Хотел опробовать Ваш пример, но к сожалению не смог добиться его срабатывания. Поставил оперу, запустил скрипт - тишина. На панели иконка не появилась. Отладить пока не успел. Сегодня попробую подробнее изучить.
2) Предположил, что при сборке inline кода с вызовом через rundll получится избавиться от проблемы повисания. Сам не проверял, потому что опять же не успел отладить срабатывание Вашего примера у себя и понять в чём причина несрабатывания.

koros, это пример альтернативного выполнения js / vbs кода без использования mshta.exe.

Flasher,
1) А, вот в чём дело. В Win 7 есть только &Закрепить в меню "Пуск" и Изъять из &меню "Пуск".
Значит, как я и думал, в зависимости от ОС надо делать выборку из разных элементов массива.

У меня на win 10 выдаёт:

2) Длинного примера варианта из этого сообщения.

P.S Пофиксил размерность массива, а то лишний элемент читал. И пока не понял сколько всё-таки байт выделено под значение размера блока текста.

Function resGetStrings(dllName,id)
	'Тип необходимого нам ресурса
	Const RT_STRING	= 6
	Dim i, n, lLen
	'Создание массива для размещения элементов с запасом.
	Redim aItems(1)
	With CreateObject("MSXML2.XMLHTTP")
		'Открываем ресурсы библиотеки
		.Open "GET","res://" & dllName & "/" & RT_STRING & "/" & id, False:.send
		'Перебор содержимого responseBody
		For i = 1 to LenB(.responseBody)
			'Читаем первые 2 байта и получаем размер блока в байтах за ним
			lLen = AscB(MidB(.responseBody,i,2))
			'Проверяем, что длина не нулевая
			if lLen = 0 Then Exit For
			'Проверяем, что массива ещё хватает для размещения нового элемента
			if n > Ubound(aItems) Then Redim Preserve aItems(n)
			'Добавление считанного элемента в массив
			aItems(n) = MidB(.responseBody,i + 2,lLen * 2)
			'Смещение положения курсора чтения
			i = i + lLen * 2 + 1
			'Наращивание счётчика элементов массива
			n = n + 1
		Next
	End With
	'Обрезка массива до нужного размера
	if n < Ubound(aItems) Then Redim Preserve aItems(n-1)
	resGetStrings = aItems
End Function

koros,

1) Это исполняемая строка. 7Z её так же выполнит как вариант с mshta.
2) Не понял вопроса. Синтаксис чего ? Синтаксис VBScript и JSсript одинаков для mshta, WScript, СScript и прочих интерпретаторов.

Опять не понял вопроса. O_o Этот код работает в mshta так же как и в других интерпретаторах. Поясните, пожалуйста что именно требуется.

Xameleon
1) 2) Запускаю

mshta vbscript:Execute("msgbox(""Not XP""):Close")

- получаю msgbox.
Запускаю

rundll32.exe vbscript:Execute("msgbox(""Not XP""):Close")

- получаю ошибку. Отсюда и вопрос какой синтаксис VBScript для запуска через rundll32?

3) В mshta код записывается в одну строку и имеет ограничение на длину. Так же я не знаю как правильно записывать в mshta обращение к Function. Поэтому и прошу вас, как опытного разработчика кодов, помочь мне преобразовать ваш код в одну строку для запуска через mshta.

Xameleon
Все равно не понял, как надо запускать код через rundll32.
Покажите, пожалуйста, на примере следующего кода (только именно на vbs, а не js):

mshta vbscript:Execute("Set WSS=CreateObject(""WScript.Shell""):If WSS.RegRead(""HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\CurrentVersion"")>""5.1"" Then:msgbox(""Not XP""):End With:close")

koros, ну как-то так, наверное:

rundll32 javascript:"\..\mshtml,RunHTMLApplication ";try{execScript("Set wss = CreateObject('WScript.Shell'):If wss.RegRead('HKLM\\SOFTWARE\\Microsoft\\Windows NT\\CurrentVersion\\CurrentVersion') > '5.1' Then MsgBox 'Not Xp',vbCritical,'vbscript sample'","vbscript")}catch(e){};close();

В Вашем примере End With вместо End If И по идее даже в End If нет необходимости, так как это inline код.

Flasher, хм. Наверное, я размерность массива неправильно определил. Я решил допилить скрипт. Закинул сюда отдельный сэмпл для экспериментов. http://forum.script-coding.com/viewtopic.php?id=12420

Xameleon
По rundll32: Строка 1. Символ 240. Незавершённая строковая константа. Код 0.
Сэмпл - хорошо, но файлик-то сперва проверьте'c.

Xameleon
Да я каждый обновлённый вариант проверял. То же самое.

Прошу участников следить за точками в конце предложений.
Уже второй день в разных сообщениях подмечаю.

Xameleon
Убрал второе сообщение. Не посмотрел на ник.

Xameleon
Не знаю. Скорее это всё те же особенности версий, о которых ранее велась речь.

Что по скачанному файлу? Получилось вытащить что надо?

Статистика, завязанная на коде, я полагаю? Сам глагол-то на Win 7 имеется, выше обсуждали.

Xameleon
Понял. Нет, в том же списке 337:

Xameleon
Решил ковырнуть и первым делом закомментировал:

Сразу всё отобразилось. Да и в конце пару нулей. Нет смысла завершать цикл.

Добавил в скрипт упрощённый вариант получения глагола. Но с другой стороны, а не совпадают ли на Vista+ номера в коллекции? Может, есть смысл сразу (без поиска) запускать Opera.Verbs.Item(20).DoIt ?

Обратите внимание здесь присутствует глагол от Classic Shell:

Это я по-поводу того, что номера в коллекции могут изменяться - мало ли какая еще программа может их сдвигать.

Мда, как г..рится, дело было тёмной ночью, глаза слипались... Как следствие, вылет этой очевидности из головы.

Xameleon
ОК. В теме только файл на shell32.dll замените.

koros, Xameleon
Идея с упрощённым вариантом для нашего глагола ясна? Тесты на разных системах интересуют. Особенно иностранных.

Xameleon
Гуд. А по второму что?

Xameleon
Железа или оси? Т.е. под рукой чего-то кроме XP/7 нет? Или нет системы с другой локалью?

Xameleon
Так 10-ку никто не отменял. Там работает?

Xameleon
Путь в 3 строке %ProgramFiles%\Opera\Opera.exe где-то не соответствует реальности.
Если Opera 32-битная, т.е. лежит в папке Program Files (x86), и запуск производится из 64-битного Проводника/файлменеджера, то тут и возникает проблемка, тогда путь можно на прямой заменить для теста ("C:\Program Files (x86)\ вмеcто WSS.Environment("Process")("PROGRAMFILES") & "). Просто я писал чисто под инсталлятор.

Xameleon
Т.е., полагается, файлменедждер, откуда производится попытка запуска, 32-хбитный? Из Проводника-то должно работать.

Xameleon
Т.е. скрипт запускался из Проводника? И точный путь к Opera такой же?

Xameleon
Только речь идёт об opera.exe, а не launcher.exe.

MsgBox CreateObject("WScript.Shell").Environment("Process")("PROGRAMFILES") & "\Opera\Opera.exe"

Что возвращает такой скрипт?

Xameleon
Аа.. А почему его нет там? Я сам лично почти уже не пользуюсь Opera, но для проверки скачал сейчас последнюю на базе Blink и увидел рядом с launcher.exe и opera.exe. Изначально ведь обсуждался инсталлятор с opera.exe. Сам файл там никак появиться не может. После замены имени на launcher.exe тоже не срабатывает?

koros
Так тестируйте. Вам же в первую очередь надо. Тем более, что в вашем случае путь совпадает.

Xameleon
Понял. Я-то её по старинке распаковывал. После установки в песочницу уже увидел, что opera в папке 43.0.2442.806.
Что после замены имени в 3-й строке? Как верно замечено, в данном случае неважно, какой exe-шник станет подопытным.

P.S.: Я бы сам в коде поменял на launcher, просто есть вероятность, что речь о Presto 12.18.1872.

koros
На скрипт я ссылался? Ссылался. Интерес к тестам проявил? Проявил. Про то, что путь для вас годный, выше написал? Написал (1, 2). Что ещё требуется?

Нужно закреплять любые exe-шники. Опера приведена для примера.
Так путь до exe модуля заранее известен или его надо сначала найти ?
Путь известен заранее. Поэтому и предлагал использовать для тестов любой exe_шник в простой папке типа c:\temp. И надо закреплять только на панели задач, а не в Пуск или на Рабочем столе.
Спасибо.

Flasher,
1) Вот:

Вот что выдаёт на Win 10. )

Понимаю о чём вы, но боюсь ориентироваться таким образом будет проблематично, так как в ОС с другими языками он уже будет другим (раз там длина строки другая, то и блок размера данных будет содержать другие данные), а следовательно теряется смысл универсальности получения глагола. (

2)

Понял. Взял на заметку.

3)

Возможно. ) Хотя мне кажется, что скорее хочет, но не совсем понимает, что именно. Сейчас задача немного прояснилась, ушли от необходимости поиска модуля оперы. Уже проще )

koros, ну вот теперь есть некоторая ясность. ) Будем думать дальше.

Flasher, сработало ! )

Получил: &Закрепить на панели задач

Боюсь, что не прокатит, так как тогда, наерное, придётся делать цикл перебора возможных разделителей по которым вычленять эту строку. ) Но чем чёрт не шутит, может и есть какой-то ещё способ.

Не, не, я не о том. Он говорит

Я к тому, что koros, следя за нашими исследованиями, уже понял, что пока у нас нет готового решения, которое можно было бы проверять на разных ОС, так как тот вариант, что имеется пока не срабатывает. Наверное верит нам на слово. )

koros, я правильно изложил Ваш взгляд на ситуацию ? Хотелось бы с Вашей стороны тоже увидеть предложения вариантов кода. А то, действительно, решение Вашей задачи сводится к нашему с Flasher-ом диалогу. )

Flasher,

1)

RegExp. Хм.... Мысль. ) Не пришло в голову. Согласен. Но это ж сколько dll-ок надо изучить, чтоб все варианты учесть ?

2)

Не совсем понял, что Вы имеете в виду. Ну да ладно. Чего я за koros-а отвечаю. Он сам пояснит, если что. )

koros
Пока остановимся на этом коде. Если есть возможность выложить shell32.dll.mui из соответствующих текущим локалям папок, то было бы очень кстати.

koros
Пока не надо. Пока отдельный запуск. Кроме китайского есть ещё что-то? Из европейских желательно.

koros
Лучше таки ответить на вопрос и по возможности приложить файлы.
С китайской всё и так было ясно.

И хочу заметить, что текст с ошибкой элементарно забирается по Ctrl+C из окна.
Не советую тратить ресурсы на полноэкранные скриншоты.

koros
Да все, какие есть. Но лучше, как уже писал, их приложить к посту.
Я не уверен, но есть вероятность, что при смене языка системы (rundll32.exe shell32.dll,Control_RunDLL intl.cpl,,3) в папках локализации соответствующий языку mui там окажется. Проверьте на виртуалке.

koros
Устанавливать ОС не надо. Посмотрел файлы. Похоже, дело дрянь. Во французском, например, вообще нет разделителя в нужном месте, в итальянском тоже не всё очевидно. Т.е. остаётся побайтовое чтение. Думаю, для данного случая стоит написать алгоритм чтения блока с конца. Будем думать. Но что-то меня терзают сомнения насчёт того, как оно заведётся в однострочнике, и нужно ли вообще всё это. Этот установщик сам по себе мультиязычный?

koros, Flasher
Такой вариант функции чтения строки не подходит ? Сделать его inline конечно можно, но боюсь можем в итоге уткнуться в ограничение длины строки запуска. Поэтому я бы всё-таки использовал внешний модуль кода.

MsgBox LoadResString("shell32.dll",5386)

Function LoadResString(fileName,ByVal id)
	Dim l, gid, i, n
	id = Fix(id)
	gid =  id \ 16 + 1
	With CreateObject("MSXML2.XMLHTTP")
		.Open "?","res://shell32.dll/6/" & gid:.Send
		For i = 1 to LenB(.responseBody)
			l = AscB(MidB(.responseBody,i,1))
			if (gid-1) * 16 + n = id Then LoadResString = MidB(.responseBody,i + 2,l * 2): Exit Function
			i = i + l * 2 + 1
			n = n + 1
		Next		
	End With
End Function

Господа, по поводу вынесения кода, хотел узнать Ваше мнение о таком варианте.

Flasher, ага. Но, если я правильно понял, то мы все пришли к выводу, что инлайновый код собирать для этих целей не очень удобно. Вот я и решил спросить нашего топикстартера - вдруг он поменял своё мнение. )