Вот что получилось на данный момент, но оказывается, что бывает несколько вариантов у одного видео, поэтому играем пока только первый, но в итоге есть все в файле сохранённые ссылки :
- 'https://zen.yandex.ru/id/5e6e13e66be9d72182b9ebf5
- On Error Resume Next
- w = vbCrLf
- h = Chr(34)
- t = "Host"
- d = "vk.com"
- h1 = "User-Agent"
- h2 = "Mozilla/5.0 (Windows NT 6.3; WOW64; rv:36.0) Gecko/20100101 Firefox/36.0"
- url = "https://vk.com/video-44534933_163540964?list=a72fade9486453997a"
- url = Split(InputBox("Введите адрес видео","Enter URL",url),"?")(0)
- u = Split(url,"/")(3)
- With CreateObject("Msxml2.XMLHttp.6.0")
- .Open "GET", url&"?", False
- .SetRequestHeader t, d
- .SetRequestHeader h1, h2
- .Send
- .Open "GET", url&"?", False
- .SetRequestHeader t, d
- .SetRequestHeader h1, h2
- .Send
- g = .ResponseText
- End With
- g = Split(Join(Filter(Split(Replace(g,Chr(13),""),Chr(10)),"hls"),w),","&h)
- x = Array(h&"desc"&h&":", h&"jpg"&h&":", h&"hls_raw"&h&":", "playlist_id"&h&":", h&"url")
- For Each j In g
- For i = 0 To UBound(x)
- If InStr(1,h&j,x(i),1) <> 0 Then
- z = Replace(Replace(z&h&j&w,"\/","/"),"<br>"," ")
- End If
- Next
- Next
- CreateObject("Scripting.FileSystemObject").CreateTextFile(u&".txt",True).Write(z).Close
- CreateObject("WScript.Shell").Run "VLC.exe https:"&Split(Split(z,"\nhttps:")(1),"?")(0)
- MsgBox ": The End. :":Wscript.Quit
