Search code examples
vbscripthttp-headersvideo-streamingaudio-streaminghttp-live-streaming

How to check if a video or an audio stream is online or not in Vbscript?


I wonder what is the parameter or the value to look for to check if a video or audio stream is online or not in vbscript ?

So this what i have tried as code until now, but, it give me a wrong results, because i have checked all those streams with VLC and they works 5/5, but with this script the second and the third stream give me as offline ??

Option Explicit
Dim Title,URLArray,URL,ws,Msg,Data
Title = "Audio and Video Stream Checker"
URLArray = Array("https://5ac31d8a4c9af.streamlock.net/saheltv/_definst_/myStream/chunklist_w956788169.m3u8"_
,"http://aska.ru-hoster.com:8053/autodj"_
,"http://www.chocradios.ch/djbuzzradio_windows.mp3.asx")

Call ForceCScriptExecution()

For Each URL in URLArray
    wscript.echo "The stream " & URL & " is "& CheckOnline(URL) & vbCrlf & String(100,"-")
Next
'----------------------------------------------------
Function CheckOnline(URL)
    On Error Resume Next
    Const WHR_EnableRedirects = 6
    Dim h,AllResponseHeaders
    Set h = CreateObject("WinHttp.WinHttpRequest.5.1")
    h.Option(WHR_EnableRedirects) = False 'disable redirects
    h.Open "HEAD", URL , False
    h.Send()
    AllResponseHeaders = h.GetAllResponseHeaders()
    wscript.echo AllResponseHeaders 
    If Err.number = 0 Then
        If h.status = 200 OR h.status = 201 OR h.status = 202 OR h.status = 203 OR h.status = 204 Then
            CheckOnline = "ONLINE"
        Else
            CheckOnline = "OFFLINE"
        End IF
    Else
        CheckOnline = "OFFLINE" & vbCrlf & Err.Description
        On Error Goto 0
    End IF
End Function
'----------------------------------------------------
Sub ForceCScriptExecution()
    Dim Arg, Str, cmd
    cmd = "CMD /K Title " & Title &" & color 0A & "
    If Not LCase( Right( WScript.FullName, 12 ) ) = "\cscript.exe" Then
        For Each Arg In WScript.Arguments
            If InStr( Arg, " " ) Then Arg = """" & Arg & """"
            Str = Str & " " & Arg
        Next
        CreateObject( "WScript.Shell" ).Run _
           cmd & "cscript //nologo """ & _
            WScript.ScriptFullName & _
            """ " & Str
        WScript.Quit
    End If
End Sub
'--------------------------------------------------

I got as response like this :

Cache-Control: no-cache
Date: Sat, 28 Dec 2019 00:14:27 GMT
Content-Length: 232
Content-Type: application/vnd.apple.mpegurl
Accept-Ranges: bytes
Server: WowzaStreamingEngine/4.7.8
Access-Control-Expose-Headers: Date, Server, Content-Type, Content-Length
Access-Control-Allow-Origin: *
Access-Control-Allow-Credentials: true
Access-Control-Allow-Methods: OPTIONS, GET, POST, HEAD
Access-Control-Allow-Headers: Content-Type, User-Agent, If-Modified-Since, Cache-Control, Range


The stream https://5ac31d8a4c9af.streamlock.net/saheltv/_definst_/myStream/chunklist_w956788169.m3u8 is ONLINE
-------------------------------------------------------------------------------
Cache-Control: no-cache
Date: Sat, 28 Dec 2019 00:14:28 GMT
Pragma: no-cache
Content-Type: text/html; charset=utf-8
Expires: Mon, 26 Jul 1997 05:00:00 GMT
Server: Icecast 2.4.2


The stream http://aska.ru-hoster.com:8053/autodj is OFFLINE
-------------------------------------------------------------------------------
Connection: keep-alive
Date: Sat, 28 Dec 2019 00:14:28 GMT
Content-Type: text/html; charset=iso-8859-1
Location: https://www.chocradios.ch/djbuzzradio_windows.mp3.asx
Server: nginx
X-Powered-By: PleskLin


The stream http://www.chocradios.ch/djbuzzradio_windows.mp3.asx is OFFLINE
-------------------------------------------------------------------------------

Solution

  • Here is possible implementation with WMP:

    Option Explicit
    
    forceCScriptExecution "Audio and Video Stream Checker"
    testStreams
    
    Sub testStreams()
    
        Dim urls
        Dim sourceUrl
        Dim isOnline
        Dim mediaName
        Dim streamUrl
    
        urls = Array(_
            "https://5ac31d8a4c9af.streamlock.net/saheltv/_definst_/myStream/chunklist_w956788169.m3u8", _
            "http://aska.ru-hoster.com:8053/autodj", _
            "http://www.chocradios.ch/djbuzzradio_windows.mp3.asx" _
        )
        For Each sourceUrl In urls
            WScript.Echo ""
            WScript.Echo "sourceUrl " & sourceUrl
            WScript.Echo "Checking..."
            checkStreamOnline sourceUrl, 30, isOnline, mediaName, streamUrl
            WScript.Echo "isOnline " & isOnline
            WScript.Echo "mediaName " & mediaName
            WScript.Echo "streamUrl " & streamUrl
        Next
    
    End Sub
    
    Sub checkStreamOnline(sourceUrl, timeout, isOnline, mediaName, streamUrl)
    
        Dim wmp
        Dim isTimeout
        Dim t
    
        Set wmp = CreateObject("WMPlayer.OCX")
        wmp.settings.autostart = False
        wmp.url = sourceUrl
        wmp.settings.volume = 0
        wmp.controls.play
        t = DateAdd("s", timeout, Now)
        Do
            isOnline = wmp.playState = 3
            isTimeout = Now >= t
            WScript.Sleep 5
        Loop Until isOnline Or isTimeout
        mediaName = wmp.currentMedia.Name
        streamUrl = wmp.currentMedia.sourceUrl
        wmp.controls.stop
    
    End Sub
    
    Sub forceCScriptExecution(title)
    
        Dim arg, args, cmd
    
        cmd = "%comspec% /K Title " & title &" & color 0A & "
        If Not LCase(Right(WScript.FullName, 12)) = "\cscript.exe" Then
            For Each arg In WScript.Arguments
                If InStr(arg, " ") Then arg = """" & arg & """"
                args = args & " " & arg
            Next
            CreateObject("WScript.Shell").Run _
               cmd & "cscript //nologo """ & _
                WScript.ScriptFullName & _
                """ " & args
            WScript.Quit
        End If
    
    End Sub