[VBS] Playing music in the background while another task is running


By: Hackoo
October 2, 2019

Sometimes some tasks can be taken a lot of time to end up.
This vbscript is created in order to play a random radio music in background while the script is running another task until to finish up and the music will stop too.

'**********************************Description in English***********************************
'This vbscript is created by Hackoo on 29/09/2019  
'Sometimes some tasks can be taken a lot of time to end up.  
'This code is created in order to play music in background while the script is running another  
'task until to finish up and the music will stop too.  
'So, the user can listen to the music playing while the script is running another task.  
'**********************************Description en Français**********************************  
'Parfois, certaines tâches peuvent prendre beaucoup de temps pour finir.  
'Ceci est créé afin de jouer de la musique en arrière-plan pendant que,  
'le script exécute une autre tâche jusqu’à la terminer et la musique s’arrêtera aussi.  
'Ainsi, l'utilisateur peut écouter la musique pendant que le script exécute une autre tâche.  
'*******************************************************************************************  
Option Explicit  
If AppPrevInstance() Then   
	MsgBox "The script is already Running" & vbCrlf &_  
	CommandLineLike(WScript.ScriptName),VbExclamation,"The script is already Running"      
	WScript.Quit    
Else  
	Call Run_as_Admin()  
	Dim Title,EndUP,WS,fso,Temp,WSF_File,URL_Music,CMD,Process_Music,StartTime,Duration  
	Title = "Playing music while another task is running by "& Chr(169) &" Hackoo 2019"  
	EndUP = False  
	Set WS = CreateObject("wscript.Shell")  
	Set fso = CreateObject("Scripting.FileSystemObject")  
	Temp = WS.ExpandEnvironmentStrings("%Temp%")  
	WSF_File = Temp & "\Music.wsf"  
	URL_Music = Random_Music  
	Call Create_WSF_Music_File()  
	CMD = "wscript.exe " & DblQuote(WSF_File) & " //job:PlayMusic "& DblQuote(URL_Music) &""  
	Set Process_Music = WS.Exec(cmd)  
	  
	WS.Popup "Playing this Radio music "& DblQuote(URL_Music) & vbCrlf &_  
	"in the background while the script is running another task until to finish it"_  
	,5,Title,vbInformation + vbSystemModal  
	  
	Do While Process_Music.Status = 0  
		If EndUP = False Then  
'**********************************************************************************************************************  
'Your Main Code goes Here  
StartTime = Timer  
Call RUN_CMD ( _  
			"echo.>%Tmp%\LogCMD.txt" &_  
			"& (Tracert.exe www.codereview.stackexchange.com" &_  
			"& Ping www.codereview.stackexchange.com" &_  
			"& Tracert.exe www.google.com" &_  
			"& Ping www.google.com" &_  
			"& NetStat -abnof)>>%Tmp%\LogCMD.txt" &_  
			"& Start /MAX %Tmp%\LogCMD.txt"_  
			)  
			  
			Duration = FormatNumber(Timer - StartTime, 0)  
			WS.Popup "The task had taken a run time until its completion about :" & vbCrlf &_  
			vbTab & convertTime(Duration) & vbCrlf & _  
			vbTab & WScript.ScriptName,10,Title,vbExclamation + vbSystemModal  
'**********************************************************************************************************************  
		Else  
			On Error Resume Next  'to ignore "invalid window handle" errors  
			Process_Music.Terminate  
			On Error Goto 0  
			EndUP = True  
		End If  
	Loop  
End If  
'----------------------------------------------------------------------------------------  
Sub Create_WSF_Music_File()  
	Dim oWSF  
	Set oWSF = fso.OpenTextFile(WSF_File,2,True)  
	oWSF.WriteLine ""  
	oWSF.WriteLine 	" language=""Vbscript"">"  
	oWSF.WriteLine 	"Dim URL_Music"  
	oWSF.WriteLine 	"URL_Music = WScript.Arguments(0)"  
	oWSF.WriteLine 	"Call Play(URL_Music)"  
	oWSF.WriteLine "Function Play(URL)"  
	oWSF.WriteLine 	"Dim Sound"  
	oWSF.WriteLine 	"Set Sound = CreateObject(""WMPlayer.OCX"")"                 
	oWSF.WriteLine 	"Sound.URL = URL"  
	oWSF.WriteLine 	"Sound.settings.volume = 100"                                 
	oWSF.WriteLine 	"Sound.Controls.play"                                       
	oWSF.WriteLine 	"Do while Sound.currentmedia.duration = 0"                  
	oWSF.WriteLine 		"wscript.sleep 100"                                         
	oWSF.WriteLine 	"Loop"    
	oWSF.WriteLine "End Function"  
	oWSF.WriteLine 	""  
	oWSF.WriteLine ""  
End Sub  
'----------------------------------------------------------------------------------------  
Function DblQuote(Str)  
	DblQuote = Chr(34) & Str & Chr(34)  
End Function  
'----------------------------------------------------------------------------------------  
Function RUN_CMD(StrCmd)  
	Dim ws,MyCmd,Result  
	Set ws = CreateObject("wscript.Shell")   
	MyCmd = "CMD /C " & StrCmd & " "  
	Result = ws.run(MyCmd,0,True)  
	EndUP = True  
End Function  
'----------------------------------------------------------------------------------------  
Function Random_Music()  
	Dim URL1,URL2,URL3,URL4,URL5,URL6,ListMusic,i,j,tmp  
	URL1 = "http://94.23.221.158:9197/stream"  
	URL2 = "http://www.chocradios.ch/djbuzzradio_windows.mp3.asx"  
	URL3 = "http://vr-live-mp3-128.scdn.arkena.com/virginradio.mp3"  
	URL4 = "http://185.52.127.168/fr/30201/mp3_128.mp3?origine=fluxradios"  
	URL5 = "http://icecast.skyrock.net/s/natio_mp3_128k"  
	URL6 = "http://185.52.127.173/fr/30601/mp3_128.mp3?origine=tunein"  
	ListMusic = array(URL1,URL2,URL3,URL4,URL5,URL6)  
	Randomize  
	For i = 0 To UBound(ListMusic)  
		j = Int((UBound(ListMusic) - i + 1) * Rnd + i)  
		tmp = ListMusic(i)  
		ListMusic(i) = ListMusic(j)  
		ListMusic(j) = tmp  
	Next    
	Random_Music=tmp  
End Function  
'----------------------------------------------------------------------------------------  
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  
'----------------------------------------------------------------------------------------  
Function convertTime(seconds)  
	Dim ConvSec,ConvHour,ConvMin  
   ConvSec = seconds Mod 60  
   If Len(ConvSec) = 1 Then  
         ConvSec = "0" & ConvSec  
   End If  
   ConvMin = (seconds Mod 3600) \ 60  
   If Len(ConvMin) = 1 Then  
         ConvMin = "0" & ConvMin  
   End If  
   ConvHour =  seconds \ 3600  
   If Len(ConvHour) = 1 Then  
         ConvHour = "0" & ConvHour  
   End If  
   convertTime = ConvHour & ":" & ConvMin & ":" & ConvSec  
End Function  
'----------------------------------------------------------------------------------------  
Sub Run_as_Admin()  
If Not WScript.Arguments.Named.Exists("elevate") Then  
   CreateObject("Shell.Application").ShellExecute DblQuote(WScript.FullName) _  
   , DblQuote(WScript.ScriptFullName) & " /elevate", "", "runas", 1  
    WScript.Quit  
End If  
End Sub  
'----------------------------------------------------------------------------------------


Need more help?
Describe your Problem
Example: Hard Drive Not Detected on My PC

Ask Question