'============================== VBS ===============================
' Cоздать URL-ярлык в активном каталоге со ссылкой из буфера обмена
' Условие: поле "Путь запуска:" должно быть пустым
'==================================================================
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
R = Array("''","-"," -",",","_","_","_")
S = Array("""","|", ":",";","\","/","?")
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 : For i = 0 To 6 : FN = Replace(FN, S(i), R(i)) : Next
With WSH.CreateShortcut(FN) .TargetPath = URL : .Save :End With
WSH.SendKeys "^r": Sub IE_TitleChange(T) Title = Trim(T) :End Sub |