'============================== VBS ===============================
' Cоздать URL-ярлык в активном каталоге со ссылкой из буфера обмена
' Параметр: "%P" "%O"
'==================================================================
Set P = WSH.Arguments : If P.Count < 2 Then WSH.Quit
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WSS = CreateObject("WScript.Shell")
R = "HKCU\Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\3\1407"
On Error Resume Next
A = WSS.RegRead(R): If A > 0 Or Err.Number <> 0 Then WSS.RegWrite R, 0, "REG_DWORD"
URL = Trim(CreateObject("htmlfile").ParentWindow.ClipboardData.GetData("text"))
If A > 0 Then WSS.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-ярлыка" : WSH.Quit
If P(1) <> "" Then Name = P(1) Else Name = InPutBox(String(5, vbCr) &_
"Введите базовое имя URL-файла:", " Создание URL со ссылкой из Б/О")
While FSO.FileExists("\\?\" & P(0) & Name & ".url") _
Or FSO.FolderExists("\\?\" & P(0) & Name & ".url")
i = i + 1 : Name = P(1) & " (" & i & ")"
Wend : FP = P(0) & Name & ".url"
If Len(FP) > 259 Then Pr = "\\?\" : If Len(FP) < 260 Then _
M = MsgBox("Путь к ярлыку слишком длинный!" & vbCr & vbCr & "Да -" &_
" оставить. Нет - обрезать справа.", 4132, " Создание URL-ярлыка") :_
If M = 7 Then FP = Left(Left(FP, Len(FP) - 4), 255) & ".url"
With FSO.CreateTextFile(Pr & FP, 1, 1)
.Write "[InternetShortcut]" & VbCrLf & "URL=" & URL : .Close
End With : WSS.SendKeys "^r" |