API tools faq
paste
Advertisement
Guest User

Untitled

a guest
Oct 13th, 2018
160
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
VBScript 12.29 KB | None | 0 0
raw download clone embed print report
  1. 'by Flammrock
  2.  
  3. call downloadVideoYouTube()
  4.  
  5. Public function downloadVideoYouTube()
  6.     dim video_url,video_title,data,windowWait,ws,itag,info,video_filename,link
  7.     video_url = InputBox("Please enter Youtube link: ", "Download Video YouTube")
  8.     video_id = getID(video_url)
  9.     if video_id <> "0" Then
  10.         data = URLDecode(file_get_contents("http://www.youtube.com/get_video_info?video_id=" & video_id))
  11.         video_title = GetVideoTitle(file_get_contents(video_url))
  12.         link = getLinks(video_title,data)
  13.         if link <> "0" Then
  14.             itag = Mid(ExtractMatch(link,"[?&]itag(=([^&#]*)|&|#|$)"),2)
  15.             info = Split(getInfoVideo(itag),";")
  16.             video_filename = MkFileName(video_title) & "." & info(0)
  17.             windowWait = createWindow("Please wait, downloading of in progress..",200,100,"Download of "&video_title)
  18.             openWindow windowWait,False
  19.             call downloadFile(video_filename,link)
  20.             Set ws = CreateObject("wscript.shell")
  21.             ws.Run "Taskkill /im ""mshta.exe"" /f",0,True
  22.         else
  23.             Msgbox "Could not extract video Links"
  24.         end if
  25.     else
  26.         Msgbox "Could not extract video ID"
  27.     end if
  28. end function
  29.  
  30. Public function downloadFile(filename,url_link)
  31.     dim xHttp: Set xHttp = createobject("Microsoft.XMLHTTP")
  32.     dim bStrm: Set bStrm = createobject("Adodb.Stream")
  33.    
  34.     xHttp.Open "GET", url_link, False
  35.     xHttp.Send
  36.  
  37.     with bStrm
  38.         .type = 1 '//binary
  39.         .open
  40.         .write xHttp.responseBody
  41.         .savetofile filename, 2 '//overwrite
  42.     end with
  43.    
  44.     downloadFile = True
  45. end function
  46.  
  47. Public function getID(url)
  48.     id = ExtractMatch(url, "v=([A-Za-z0-9-_]+)")
  49.     if Len(id) = 0 Then
  50.         getID = "0"
  51.         Exit Function
  52.     end if
  53.     getID = id
  54. end function
  55.  
  56. Public function ExtractMatch(Text, Pattern)
  57.     Dim Regex, Matches
  58.  
  59.     Set Regex = New RegExp
  60.     Regex.Pattern = Pattern
  61.  
  62.     Set Matches = Regex.Execute(Text)
  63.     If Matches.Count = 0 Then
  64.         ExtractMatch = ""
  65.         Exit Function
  66.     End If
  67.  
  68.     ExtractMatch = Matches(0).SubMatches(0)
  69. End Function
  70.  
  71. Public function getLinks(title,queryString)
  72.     dim Matches,itag,url,info,listFormatAvailable,itagselect
  73.  
  74.     Set objRegEx = CreateObject("VBScript.RegExp")
  75.  
  76.     objRegEx.Global = True  
  77.     objRegEx.IgnoreCase = True
  78.     objRegEx.Pattern = "[?&]url(=([^&#]*)|&|#|$)"
  79.  
  80.     Set Matches = objRegEx.Execute(queryString)
  81.    
  82.     if Matches.Count = 0 Then
  83.         getLinks = "0"
  84.         Exit Function
  85.     end if
  86.    
  87.     listFormatAvailable = "<script>var index=0;</script><center><h1 style=""font:15px Verdana;"">Download of <b style=""color:red;"">" & title & "</b></h1><br /><br /><select onchange=""index=this.options[this.selectedIndex].getAttribute('data-i');"" style=""width:50%;padding: 10px;"">"
  88.     for i = 0 to Matches.Count-1
  89.         url = (Split(URLDecode(Mid(Matches.Item(i),6)),","))(0)
  90.         itag = Mid(ExtractMatch(url,"[?&]itag(=([^&#]*)|&|#|$)"),2)
  91.         info=Split(getInfoVideo(itag),";")
  92.         'listFormatAvailable = listFormatAvailable & info(0) & " (" & info(1) & ") " & info(2) & vbCrLf
  93.         listFormatAvailable = listFormatAvailable & "<option data-i=""" & i & """>" & info(0) & " (" & info(1) & ") " & info(2) & "</option><br />"
  94.     next
  95.     Set environmentVars = WScript.CreateObject("WScript.Shell").Environment("Process")
  96.     tempFolder = environmentVars("TEMP")
  97.     listFormatAvailable = listFormatAvailable & "</select><br /><button style=""border:0;width:50%;padding: 10px;background:#0d0;font:15px Verdana;color:#fff;margin:3px;"" onclick=""var fso = new ActiveXObject('Scripting.FileSystemObject');var file = fso.CreateTextFile('" & Replace(tempFolder,"\","\\") & "\\index.youtube.tmp', true);file.write(index);file.Close();setTimeout(function(){window.close();},200);"">Select!</button></center>"
  98.    
  99.     selectionWindow = createWindow("Selection.. - "&title,500,300,listFormatAvailable)
  100.     openWindow selectionWindow,True
  101.    
  102.     Set fso = CreateObject("Scripting.FileSystemObject")
  103.     If (fso.FileExists(tempFolder & "\\index.youtube.tmp")) Then
  104.         Set file = fso.OpenTextFile(tempFolder & "\\index.youtube.tmp", 1)
  105.         itagselect = file.ReadAll
  106.         file.Close
  107.         fso.DeleteFile tempFolder & "\\index.youtube.tmp"
  108.         getLinks = (Split(URLDecode(Mid(Matches.Item(itagselect),6)),","))(0)
  109.         Exit Function
  110.     Else
  111.         getLinks = "0"
  112.         Exit Function
  113.     End If
  114.  
  115.    
  116.     if Matches.Count > 0 Then
  117.        
  118.     end if
  119.    
  120.     getLinks = "0"
  121. end function
  122.  
  123. Public function createWindow(title,width,height,body)
  124.     createWindow = Join(Array("<!doctype html>","<html>","<head>","<meta charset=""UTF-8"">","<meta http-equiv=""X-UA-Compatible"" content=""IE=edge,chrome=1"">","<script>window.resizeTo(" & width & "," & height & ");window.moveTo(screen.width/2-" & width & "/2,screen.height/2-" & height & "/2);</script>","<title>" & title & "</title>","</head>","<body>",body,"</body>","</html>"),vbCrLf)
  125. end function
  126.  
  127. Public function openWindow(a,b)
  128.     Set objFSO = CreateObject("Scripting.FileSystemObject")
  129.     tempname = objFSO.GetTempName
  130.     Set environmentVars = WScript.CreateObject("WScript.Shell").Environment("Process")
  131.     tempFolder = environmentVars("TEMP")
  132.     Set objFileToWrite = objFSO.CreateTextFile(tempFolder & "\" & tempname & ".hta",True)
  133.     objFileToWrite.Write(a)
  134.     objFileToWrite.Close
  135.     Set objFileToWrite = Nothing
  136.     Set objShell = CreateObject("WScript.Shell")
  137.     objShell.Run tempFolder & "\" & tempname & ".hta",1,b
  138. end function
  139.  
  140. Public function getInfoVideo(itag)
  141.     dim data
  142.     data = "Unknown Type"
  143.     if itag = 5 Then
  144.         data = "flv;audio/video;240p;;"
  145.     ElseIf itag = 6 Then
  146.         data = "flv;audio/video;270p;;"
  147.     ElseIf itag = 17 Then
  148.         data = "3gp;audio/video;144p;;"
  149.     ElseIf itag = 18 Then
  150.         data = "mp4;audio/video;360p;;"
  151.     ElseIf itag = 22 Then
  152.         data = "mp4;audio/video;720p;;"
  153.     ElseIf itag = 34 Then
  154.         data = "flv;audio/video;360p;;"
  155.     ElseIf itag = 35 Then
  156.         data = "flv;audio/video;480p;;"
  157.     ElseIf itag = 36 Then
  158.         data = "3gp;audio/video;180p;;"
  159.     ElseIf itag = 37 Then
  160.         data = "mp4;audio/video;1080p;;"
  161.     ElseIf itag = 38 Then
  162.         data = "mp4;audio/video;3072p;;"
  163.     ElseIf itag = 43 Then
  164.         data = "webm;audio/video;360p;;"
  165.     ElseIf itag = 44 Then
  166.         data = "webm;audio/video;480p;;"
  167.     ElseIf itag = 45 Then
  168.         data = "webm;audio/video;720p;;"
  169.     ElseIf itag = 46 Then
  170.         data = "webm;audio/video;1080p;;"
  171.     ElseIf itag = 82 Then
  172.         data = "mp4;audio/video;360p;;3D"
  173.     ElseIf itag = 83 Then
  174.         data = "mp4;audio/video;480p;;3D"
  175.     ElseIf itag = 84 Then
  176.         data = "mp4;audio/video;720p;;3D"
  177.     ElseIf itag = 85 Then
  178.         data = "mp4;audio/video;1080p;;3D"
  179.     ElseIf itag = 92 Then
  180.         data = "hls;audio/video;240p;;3D"
  181.     ElseIf itag = 93 Then
  182.         data = "hls;audio/video;360p;;3D"
  183.     ElseIf itag = 94 Then
  184.         data = "hls;audio/video;480p;;3D"
  185.     ElseIf itag = 95 Then
  186.         data = "hls;audio/video;720p;;3D"
  187.     ElseIf itag = 96 Then
  188.         data = "hls;audio/video;1080p;;"
  189.     ElseIf itag = 100 Then
  190.         data = "webm;audio/video;360p;;3D"
  191.     ElseIf itag = 101 Then
  192.         data = "webm;audio/video;480p;;3D"
  193.     ElseIf itag = 102 Then
  194.         data = "webm;audio/video;720p;;3D"
  195.     ElseIf itag = 132 Then
  196.         data = "hls;audio/video;240p;;"
  197.     ElseIf itag = 133 Then
  198.         data = "mp4;video;240p;;"
  199.     ElseIf itag = 134 Then
  200.         data = "mp4;video;360p;;"
  201.     ElseIf itag = 135 Then
  202.         data = "mp4;video;480p;;"
  203.     ElseIf itag = 136 Then
  204.         data = "mp4;video;720p;;"
  205.     ElseIf itag = 137 Then
  206.         data = "mp4;video;1080p;;"
  207.     ElseIf itag = 138 Then
  208.         data = "mp4;video;2160p60;;"
  209.     ElseIf itag = 139 Then
  210.         data = "m4a;audio;48k;;"
  211.     ElseIf itag = 140 Then
  212.         data = "m4a;audio;128k;;"
  213.     ElseIf itag = 141 Then
  214.         data = "m4a;audio;256k;;"
  215.     ElseIf itag = 151 Then
  216.         data = "hls;audio/video;72p;;"
  217.     ElseIf itag = 160 Then
  218.         data = "mp4;video;144p;;"
  219.     ElseIf itag = 167 Then
  220.         data = "webm;video;360p;;"
  221.     ElseIf itag = 168 Then
  222.         data = "webm;video;480p;;"
  223.     ElseIf itag = 169 Then
  224.         data = "webm;video;1080p;;"
  225.     ElseIf itag = 171 Then
  226.         data = "webm;audio;128k;;"
  227.     ElseIf itag = 218 Then
  228.         data = "webm;video;480p;;"
  229.     ElseIf itag = 219 Then
  230.         data = "webm;video;144p;;"
  231.     ElseIf itag = 242 Then
  232.         data = "webm;video;240p;;"
  233.     ElseIf itag = 243 Then
  234.         data = "webm;video;360p;;"
  235.     ElseIf itag = 244 Then
  236.         data = "webm;video;480p;;"
  237.     ElseIf itag = 245 Then
  238.         data = "webm;video;480p;;"
  239.     ElseIf itag = 246 Then
  240.         data = "webm;video;480p;;"
  241.     ElseIf itag = 247 Then
  242.         data = "webm;video;720p;;"
  243.     ElseIf itag = 248 Then
  244.         data = "webm;video;1080p;;"
  245.     ElseIf itag = 249 Then
  246.         data = "webm;audio;50k;;"
  247.     ElseIf itag = 250 Then
  248.         data = "webm;audio;70k;;"  
  249.     ElseIf itag = 251 Then
  250.         data = "webm;audio;160k;;"
  251.     ElseIf itag = 264 Then
  252.         data = "mp4;video;1440p;;"
  253.     ElseIf itag = 266 Then
  254.         data = "mp4;video;2160p60;;"
  255.     ElseIf itag = 271 Then
  256.         data = "webm;video;1440p;;"
  257.     ElseIf itag = 272 Then
  258.         data = "webm;video;4320p;;"
  259.     ElseIf itag = 278 Then
  260.         data = "webm;video;144p;;"
  261.     ElseIf itag = 298 Then
  262.         data = "mp4;video;720p60;;"
  263.     ElseIf itag = 299 Then
  264.         data = "mp4;video;1080p60;;"
  265.     ElseIf itag = 302 Then
  266.         data = "webm;video;720p60;;"
  267.     ElseIf itag = 303 Then
  268.         data = "webm;video;1080p60;;"
  269.     ElseIf itag = 308 Then
  270.         data = "webm;video;1440p60;;"
  271.     ElseIf itag = 313 Then
  272.         data = "webm;video;2160p;;"
  273.     ElseIf itag = 315 Then
  274.         data = "webm;video;2160p60;;"
  275.     ElseIf itag = 330 Then
  276.         data = "webm;video;144p60;hdr;"
  277.     ElseIf itag = 331 Then
  278.         data = "webm;video;240p60;hdr;"
  279.     ElseIf itag = 332 Then
  280.         data = "webm;video;360p60;hdr;"
  281.     ElseIf itag = 333 Then
  282.         data = "webm;video;480p60;hdr;"
  283.     ElseIf itag = 334 Then
  284.         data = "webm;video;720p60;hdr;"
  285.     ElseIf itag = 335 Then
  286.         data = "webm;video;1080p60;hdr;"
  287.     ElseIf itag = 336 Then
  288.         data = "webm;video;1440p60;hdr;"
  289.     ElseIf itag = 337 Then
  290.         data = "webm;video;2160p60;hdr;"
  291.     end if
  292.     getInfoVideo = data
  293. end function
  294.  
  295. Public function file_get_contents(filename)
  296.     Dim objWinHttp: Set objWinHttp = createObject("MSXML2.ServerXMLHTTP")
  297.  
  298.     objWinHttp.Open "GET", filename, false
  299.     objWinHttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
  300.     objWinHttp.Send
  301.     'Response.Write objWinHttp.Status & " " & objWinHttp.StatusText
  302.  
  303.     file_get_contents = objWinHttp.ResponseText
  304.  
  305.     Set objWinHttp = Nothing
  306. end function
  307.  
  308. Public function URLDecode(str)
  309.     set list = CreateObject("System.Collections.ArrayList")
  310.     strLen = Len(str)
  311.     for i = 1 to strLen
  312.         sT = mid(str, i, 1)
  313.         if sT = "%" then
  314.             if i + 2 <= strLen then
  315.                 list.Add cbyte("&H" & mid(str, i + 1, 2))
  316.                 i = i + 2
  317.             end if
  318.         else
  319.             list.Add asc(sT)
  320.         end if
  321.     next
  322.     depth = 0
  323.     for each by in list.ToArray()
  324.         if by and &h80 then
  325.             if (by and &h40) = 0 then
  326.                 if depth = 0 then Err.Raise 5
  327.                 val = val * 2 ^ 6 + (by and &h3f)
  328.                 depth = depth - 1
  329.                 if depth = 0 then
  330.                     sR = sR & chrw(val)
  331.                     val = 0
  332.                 end if
  333.             elseif (by and &h20) = 0 then
  334.                 if depth > 0 then Err.Raise 5
  335.                 val = by and &h1f
  336.                 depth = 1
  337.             elseif (by and &h10) = 0 then
  338.                 if depth > 0 then Err.Raise 5
  339.                 val = by and &h0f
  340.                 depth = 2
  341.             else
  342.                 Err.Raise 5
  343.             end if
  344.         else
  345.             if depth > 0 then Err.Raise 5
  346.             sR = sR & chrw(by)
  347.         end if
  348.     next
  349.     if depth > 0 then Err.Raise 5
  350.     URLDecode = sR
  351. End Function
  352.  
  353. Public function HTMLDecode(encodedstring)
  354.     Dim tmp, i
  355.     tmp = encodedstring
  356.     tmp = Replace( tmp, "&quot;", chr(34) )
  357.     tmp = Replace( tmp, "&lt;"  , chr(60) )
  358.     tmp = Replace( tmp, "&gt;"  , chr(62) )
  359.     tmp = Replace( tmp, "&amp;" , chr(38) )
  360.     tmp = Replace( tmp, "&nbsp;", chr(32) )
  361.     For i = 1 to 255
  362.         tmp = Replace( tmp, "&#" & i & ";", chr( i ) )
  363.     Next
  364.     HTMLDecode = tmp
  365. End Function
  366.  
  367. Public function GetVideoTitle(Html)
  368.     ' get rid of all tabs
  369.    Html = Replace(Html, Chr(9), "")
  370.  
  371.     ' get rid of all newlines (vbscript regex engine doesn't like them)
  372.    Html = Replace(Html, vbCrLf, "")
  373.     Html = Replace(Html, vbLf, "")
  374.     Html = Replace(Html, vbCr, "")
  375.  
  376.     GetVideoTitle = HTMLDecode(Replace(ExtractMatch(Html, "<title>([^<]+)<")," - YouTube",""))
  377. End Function
  378.  
  379. Public function MkFileName(Titletm)
  380.     dim Title
  381.     Title = Replace(Titletm, "(", "")
  382.     Title = Replace(Title, ")", "")
  383.  
  384.     Dim Regex
  385.     Set Regex = New RegExp
  386.     With Regex
  387.         .Pattern = "[^A-Za-z0-9-_]"
  388.         .Global = True
  389.     End With
  390.  
  391.     Title = Regex.Replace(Title, "_")
  392.     MkFileName = Title
  393. End Function
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!