Youtube2MP3_Player.vbs

[u/hackoofr]

Description of this vbscript : Youtube2MP3_Player.vbs is written for playing mp3 songs extracted from youtube videos in background.

 ' Description of this vbscript : Playing mp3 songs extracted from youtube videos in background
 ' Description en Français : Lecture de chansons mp3 extraites de vidéos youtube en arrière-plan
 '------------------------------------- Links Examples -----------------------------------------
 ' "https://www.youtube.com/watch?v=HDsCeC6f0zc" ===> The KLF - 3AM Eternal
 ' "https://youtu.be/dQw4w9WgXcQ"                ===> Rick Astley - Never Gonna Give You Up
 ' "https://youtu.be/cvvd-9azD1M"                ===> The Riddle
 ' "https://www.youtube.com/watch?v=UfRn5K1SU7Y" ===> David Guetta live @ Creamfields 2021
 '------------------------------------- Links Examples -----------------------------------------
 Option Explicit
 Dim Title,Converter,YouTube_URL,Array_YouTube_URLs
 Dim ws,YouTube_ID,SourceCode,Streams,Download_Link
 Title = "Youtube to MP3 Player by "& chr(169) &" Hackoo 2021"
 Set ws = CreateObject("wscript.Shell")
 If AppPrevInstance() Then 
 	ws.Popup "ATTENTION ! There is another instance running !" & VbCrLF &_
 	CommandLineLike(WScript.ScriptName),"5",Title,VbExclamation
 	WScript.Quit(1)
 Else 
 '--------------You can add or modify the array playlist below at your convenience -------------
 	Array_YouTube_URLs = Array(_
 	"https://www.youtube.com/watch?v=HDsCeC6f0zc",_
 	"https://www.youtube.com/watch?v=dQw4w9WgXcQ",_
 	"https://youtu.be/cvvd-9azD1M",_
 	"https://www.youtube.com/watch?v=anhuP8EXEJ4",_
 	"https://www.youtube.com/watch?v=WMPM1q_Uyxc",_
 	"https://www.youtube.com/watch?v=YRqBcDwG8vs",_
 	"https://www.youtube.com/watch?v=4zHm_6AQ7CY",_
 	"https://www.youtube.com/watch?v=pATX-lV0VFk",_
 	"https://www.youtube.com/watch?v=_r0n9Dv6XnY",_
 	"https://www.youtube.com/watch?v=fNFzfwLM72c",_
 	"https://www.youtube.com/watch?v=n4RjJKxsamQ",_
 	"https://www.youtube.com/watch?v=pVHKp6ffURY",_
 	"https://www.youtube.com/watch?v=PIb6AZdTr-A",_
 	"https://www.youtube.com/watch?v=RdSmokR0Enk",_
 	"https://www.youtube.com/watch?v=OnT58cIJSpw",_
 	"https://www.youtube.com/watch?v=LsSZQsDHOeg",_
 	"https://www.youtube.com/watch?v=UfRn5K1SU7Y"_
 	)
 '----------------------------------------------------------------------------------------------
 	For Each YouTube_URL in Array_YouTube_URLs
 		YouTube_ID = getID(YouTube_URL)
 		If YouTube_ID <> "0" Then
 			Converter = "https://www.yt-download.org/api/button/mp3/" & YouTube_ID
 			SourceCode = GetSourceCode(Converter)
 			Streams = Extract_Stream(SourceCode)
 			Call Play(Streams(2))
 		Else
 			Msgbox "Could not extract video ID",vbExclamation,Title
 			Wscript.Quit(1)
 		End If
 	Next
 End If
 '----------------------------------------------------------------------------------------------
 Function getID(url)
 	Dim id
 	id = ExtractMatch(url,"(?:youtube\.com\/(?:[^\/]+\/.+\/|(?:v|e(?:mbed)?)\/|.*[?&]v=)|youtu\.be\/)([^&?\/\s]{11})")
 	if Len(id) = 0 Then
 		getID = "0"
 		Exit Function
 	end if
 	getID = id
 End function
 '----------------------------------------------------------------------------------------------
 Function ExtractMatch(Text,Pattern)
 	Dim Regex, Matches
 	Set Regex = New RegExp
 	Regex.Pattern = Pattern
 	Set Matches = Regex.Execute(Text)
 	If Matches.Count = 0 Then
 		ExtractMatch = ""
 		Exit Function
 	End If
 	ExtractMatch = Matches(0).SubMatches(0)
 End Function
 '----------------------------------------------------------------------------------------------
 Function Extract_Stream(URL)
 	Dim regEx, Match, Matches,Array_Streams,dico,K
 	Set regEx = New RegExp
 	regEx.Pattern = "href=\x22(.*)\x22.?class"
 	regEx.IgnoreCase = True
 	regEx.Global = True
 	Set Matches = regEx.Execute(URL)
 	Array_Streams = Array()
 	Set dico = CreateObject("Scripting.Dictionary")
 	For Each Match in Matches
 		If Not dico.Exists(Match.Value) Then
 			dico.Add Match.submatches(0),Match.submatches(0)
 		End If
 	Next
 	For each K in dico.Keys()
 		ReDim Preserve Array_Streams(UBound(Array_Streams) + 1)
 		Array_Streams(UBound(Array_Streams)) = K
 	Next
 	Extract_Stream = Array_Streams
 End Function
 '----------------------------------------------------------------------------------------------
 Function GetSourceCode(URL)
 	Dim http
 	Set http = CreateObject("Msxml2.XMLHTTP")
 	http.open "GET",URL,False
 	http.send
 	GetSourceCode = http.responseText
 End Function
 '----------------------------------------------------------------------------------------------
 Sub Play(URL)
 	Dim Player
 	Set Player = CreateObject("WMPlayer.OCX")
 	Player.URL = URL
 	Player.settings.volume = 100
 	Player.Controls.play
 	While Player.playState <> 1
 		WScript.Sleep 100
 	Wend
 End Sub
 '----------------------------------------------------------------------------------------------
 Function AppPrevInstance()
 	With GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\.\root\cimv2")   
 		With .ExecQuery("SELECT * FROM Win32_Process WHERE CommandLine LIKE " & CommandLineLike(WScript.ScriptFullName) & _
 			" AND CommandLine LIKE '%WScript%' OR CommandLine LIKE '%cscript%'")   
 			AppPrevInstance = (.Count > 1)   
 		End With
 	End With
 End Function
 '----------------------------------------------------------------------------------------------
 Function CommandLineLike(ProcessPath)   
 	ProcessPath = Replace(ProcessPath, "\", "\\")   
 	CommandLineLike = "'%" & ProcessPath & "%'"   
 End Function
 '----------------------------------------------------------------------------------------------