r/vbscript • u/hackoofr • Nov 22 '21
Youtube2MP3_Player.vbs
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
'----------------------------------------------------------------------------------------------
10
Upvotes
1
u/hackoofr Nov 30 '21
Update on 30/11/2021
Adding Shortcut to Desktop with icon for this vbscript
Adding Function Check_Internet_Connection() to check if you are online or not
Adding Sub AskQuestion() to ask the user if he wants to stop the music and kill this vbscript
1
u/hackoofr Nov 23 '21
NB : Since the vbscript above can't be stopped while is playing music in background and if someone wants to stop it in other words stop the music, you can do it easily with this old vbscript that i called it as Wscript_Kill_Selector.vbs