Как создать ярлык для URL?

[Flasher]

Skif_off
Только не предупреждение.
Либо обрезать справа, оставив нативный метод, либо подключать скрытую консоль для полного имени. Что лучше?

[Вахмурка]

Адрес - это не заголовок. В поставленной задаче он не фигурировал

Советую перечитать первый пост темы. Там даже картинка приведена для особо внимательных. Слово "заголовок" в посте не обнаруживается. Зато русским языком написано "адресную строку".
Впрочем, если неймется, по классу ищем окно и берем его заголовок.

Браузеров разных может быть сколько угодно открыто или не открыто вообще

Для первого случая имеется функция:

s = browserURL("brser") URL in current browser window; brser gives browser name, if omitted uses exec.setbrowser value. Valid values include iexplore, netscape, firefox, maxthon, mozilla.

Во втором же случае задача вовсе теряет смысл

[Flasher]

Советую перечитать первый пост темы. Там даже картинка приведена для особо внимательных. Слово "заголовок" в посте не обнаруживается. Зато русским языком написано "адресную строку".

Советую помимо чтения ещё и по ссылкам не лениться ходить, где становится очевидно, что в имени файла отображён именно заголовок. И в посте написано про перетаскивание адресной, вот именно что, строки, а вовсе не подстановку адреса в имя.

Во втором же случае задача вовсе теряет смысл

Угу. Только мой скрипт с этим почему-то не согласен...

[Avada]

Вахмурка
Если следовать картинке для особо внимательных и проделать ровно то, что на ней изображено, то в результате получим именно ярлык на URL с именем заголовка. Это, кстати, было первое, что я сделал, прежде чем стал разбираться дальше, решая вопрос о правильном переименовании темы. А то, что у топик-стартера проблемы с терминологией и что он после первого поста не проявил к дальнейшему обсуждению ни малейшего интереса — это уже другая история.

[Skif_off]

Flasher
Имел в виду предупреждение + InputBox, чтобы пользователь сам укоротил/выбрал имя, но в плане автоматизации не очень удобно получается и потребуется новая проверка.

В голову пришло что-нибудь вроде:

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

WSH.CreateShortcut(Left(WSH.CurrentDirectory & Title, 245) & ".url")

не знаю, как лучше. Сейчас проверил, если имя >MAX_PATH, то WSH.CurrentDirectory вернёт только букву диска - тоже неприятность, получается?

по классу ищем окно и берем его заголовок

Окон многовато получится, нередко бывает запущено больше одного браузера.

[Вахмурка]

Окон многовато получится, нередко бывает запущено больше одного браузера.

Ну так в этом случае никакая автоматизация не поможет - компьютер не телепат, мысли и желания угадывать не умеет*. Выводим список окон, выбираем нужное
___
* пока, по крайней мере

[Flasher]

Skif_off
InputBox - те же яйца.
Как резать в коде - не вопрос, я спрашивал про сам подход.
Я, в принципе, знаю, как писать "длинные" бинарники, надо только сообразить, как после всех смещений убрать хвост из символов нулевого кода.

[Skif_off]

Flasher
Мне кажется, без предупреждения лезть за MAX_PATH не стоит, тогда проще резать слева (если молча).

[Flasher]

Skif_off
Почему? Начиная с Висты хотя бы?

[Skif_off]

Flasher
Куча софта не умеет с ними работать, первое, что пришло в голову: TeraCopy, Double Commander, %L/%UL в ТС.
VBScript/JScript работают? Судя по .CurrentDirectory возможны сюрпризы.

ИМХО, без неожиданностей удобнее, а так - решать тебе.

[Flasher]

Skif_off
Да, проблемы есть. Те же плагины urlview и urlgrank с длинными не работают. Тогда соглашусь, можно и спросить.
Я, пожалуй, в случае длинной папки ничего спрашивать не буду. Только если имя файла не вмещается. Вместо СurDir-y - %P.

[cut="Вариант с поддержкой длинного пути:"]

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

'============================== VBS ===============================
' Cоздать URL-ярлык в активном каталоге со ссылкой из буфера обмена
' Параметр: "%P"
'==================================================================
If WScript.Arguments.Count = 0 Then WScript.Quit
Dim WSH : Set WSH = CreateObject("WScript.Shell")
R = "HKCU\Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\3\1407"
On Error Resume Next
A = WSH.RegRead(R): If A > 0 Or Err.Number <> 0 Then WSH.RegWrite R, 0, "REG_DWORD"
URL = Trim(CreateObject("htmlfile").ParentWindow.ClipboardData.GetData("text"))
If A > 0 Then WSH.RegWrite R, A, "REG_DWORD"
On Error Goto 0 : Test = Left(URL, 4)
If Test = "" Or (Test <> "www." And Test <> "http") Then MsgBox "Буфер " &_
"обмена не содержит гиперссылки!", 4144, " Создание URL-ярлыка" : WScript.Quit
S = Split(": ? * "" ; \ / | < >") 
R = Array(-230,-225,-246,698,894,-24,-24,-24,706,707)
With WScript.CreateObject("InternetExplorer.Application", "IE_")
  .Visible = 0 : .Silent = 1 : .AddressBar = 0
  .MenuBar = 0 : .ToolBar = 0 : .StatusBar = 0 : .Navigate(URL)
  While IsEmpty(Title) Or Left(Title, 4) = "http" WScript.Sleep 20 :Wend
  .Stop : .ExecWB 45, 2 : FN = Title & ".url"
End With : Sub IE_TitleChange(T) Title = Trim(T) :End Sub
For i = 0 To 9 : FN = Replace(FN, S(i), ChrW(R(i))) :Next
Dir = WScript.Arguments(0) : FP = Dir & FN
If Len(FP) > 259 Then Pr = "\\?\" : If Len(Dir) < 260 Then _
M = MsgBox("Путь к ярлыку слишком длинный!" & vbCr & vbCr & "Да -" &_
" оставить. Нет - обрезать справа.", 4132, " Создание URL-ярлыка") :_
If M = 7 Then FP = Left(Left(FP, Len(FP) - 4), 255) & ".url"
With CreateObject("Scripting.FileSystemObject").CreateTextFile(Pr & FP, 1, 1)
  .Write "[InternetShortcut]" & vbCrLf & "URL=" & URL : .Close
End With : WSH.SendKeys "^r"

[/cut]

[Flasher]

Оказалось, что FSO без проблем работает с длинными путями при подстановке префикса \\?\ (чего не скажешь про Shell). Исправил. Плюс теперь скрипт нек. запретные символы заменяет на юникодные аналоги.

[Iori]

Flasher
Не пробегал ли случайно вариант скрипта выше, который бы брал название файла от файла на котором находится курсор.

[Zmy]

Iori, попробуйте так.

[cut="Script"]

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

' Cоздать URL-ярлык в активном каталоге со ссылкой из буфера обмена
' Автор Flasher
' Параметры: "%P" "%N"
'==================================================================
If WScript.Arguments.Count < 2  Then MsgBox "Параметры:" & vbCr & vbCr & """%P"" ""%N""" & vbCr, _
0,  "Не хватает параметров." : WScript.Quit
Dim WSH : Set WSH = CreateObject("WScript.Shell")
R = "HKCU\Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\3\1407"
On Error Resume Next
A = WSH.RegRead(R): If A > 0 Or Err.Number <> 0 Then WSH.RegWrite R, 0, "REG_DWORD"
URL = Trim(CreateObject("htmlfile").ParentWindow.ClipboardData.GetData("text"))
If A > 0 Then WSH.RegWrite R, A, "REG_DWORD"
On Error Goto 0 : Test = Left(URL, 4)
If Test = "" Or (Test <> "www." And Test <> "http") Then MsgBox "Буфер " &_
"обмена не содержит гиперссылки!", 4144, "To Clip not URL" : Set WSH = Nothing : WScript.Quit
S = Split(": ? * "" ; \ / | < >") : R = Array(-230,-225,-246,698,894,-24,-24,-24,706,707)
With WScript.CreateObject("InternetExplorer.Application", "IE_")
.Visible = 0 : .Silent = 1 : .AddressBar = 0
.MenuBar = 0 : .ToolBar = 0 : .StatusBar = 0 : .Navigate(URL)
While IsEmpty(Title) Or Left(Title, 4) = "http" WScript.Sleep 20 :Wend
.Stop : .ExecWB 45, 2 : FN = WScript.Arguments(1) & ".url"
End With : Sub IE_TitleChange(T) Title = Trim(T) :End Sub
For i = 0 To 9 : FN = Replace(FN, S(i), ChrW(R(i))) :Next
Dir = WScript.Arguments(0) : FP = Dir & FN : If Len(FP) > 259 Then Pr = "\\?\" : If Len(Dir) < 260 Then _
M = MsgBox("Путь к ярлыку слишком длинный!" & vbCr & vbCr & "Да -" &_
" оставить. Нет - обрезать справа.", 4132, " Создание URL-ярлыка") :_
If M = 7 Then FP = Left(Left(FP, Len(FP) - 4), 255) & ".url"
With CreateObject("Scripting.FileSystemObject").CreateTextFile(Pr & FP, 1, 1)
.Write "[InternetShortcut]" & vbCrLf & "URL=" & URL : .Close
End With : WSH.SendKeys "^r" : Set WSH = Nothing : WScript.Quit

[/cut]
.

[Iori]

Zmy
Спасибо То что надо.

Flasher, тебе отдельное спасибо за скрипт.