ShoutCast Online/Offline Status with ASP?

[nax_mushroom]

I found a ASP code here on the forum that show's the station title, now playing, history, and listeners and more.. it was really great...
But it only works if the Station is Online.
I tried to change it some, but i never got it to work.
I also want to have "RadioStation Status: [online/offline]" on my site.

i tried solving it using the "readyState" command.
but it didn't work

i tried:

<%
Set objXMLHTTP = Server.CreateObject("Microsoft.XMLHTTP")
Set objXML = Server.CreateObject("Microsoft.XMLDOM")
%>

<%=objXMLHTTP.readyState%> (=0, when the objXMLHTTP is closed?)

<% objXMLHTTP.Open "GET", sURL, False %>
<%=objXMLHTTP.readyState%> (=1 when the objXMLHTTP has open'd ?)

<% objXMLHTTP.Send %>

<%=objXMLHTTP.readyState%> (=4 when the objXMLHTTP has send?)

the "objXMLHTTP.Open" command always works..
i can write the wrong password to the station, and there is no error...
the error come's when i "objXMLHTTP.Send"

i have to have a function that checks if i can "objXMLHTTP.Send" or not...

dummy example:
<%if not objXMLHTTP.Send = available then%>
STATION IS OFFLiNE<%end if%>

Help !!

[angst]

try this:

<%
'this is the time out, it's set by default to 4 seconds
'but if your server has a slow connection it may have to be changed.
If xml.readyState <> 4 then
xml.waitForResponse 10
End If

If E******mber <> 0 then
strData = "<b>Error</b><br>check your configuration..."
Else

If (xml.readyState <> 4) Or (xml.Status <> 200) Then
xml.Abort

strData = "there was a problem connecting to shoutcast server...<br>error - script timed out"
Else
strData = xml.ResponseText
End If
End If
%>

[nax_mushroom]

to get the XML.readyState method to work I must XML.Send first...
and if the station is offline, the XML.Send method won't work!

I'ts a weird,stange,sick 'n evil cirle
Help!

[angst]

no thats not how it works,
past all your code in here and I'll show you an example.

[nax_mushroom]

I found the followin code here at the forum:
but it doesn't work if the station is offline...
i want a error message that says "station offline!"

<%

rem *** URL Decode Function ***
Function UrlDecode( strURL )
res = ""
i = InStr(strURL,"%")
ss = ""

While i>0
ss = "&H"+Mid(strURL,i+1,2)
res = res+Mid(strURL, 1, i-1)+Chr(0+ss)
strURL = Mid(strURL,i+3, Len(strURL)-i-2)

i = InStr(strURL,"%")
Wend
res = res+strURL

URLDecode = res
End Function

rem *** Constants ***
DebugMode = False ' set True to print XML decode error messages
TimeSuffix = " EST"
ServerID = "http://yourshoutcastip:yourshoutcastport" ' set for your server
ServerPassword = "yourshoutcastpassword" ' set for your server
MaxTracks = 99
v189Plus = True ' Set True if 1.8.9, if older, set false and hard code bitrate below
HardBitrate = 128 ' If not v1.8.9+ hard code bitrate here
sBorderColor = "#808080"
sInnerColor = "#303030"
ShowHeadings = True

sPlayLink = ServerID & "/listen.pls"
sURL = ServerID & "/admin.cgi?pass=" & ServerPassword & "&mode=viewxml&page=0&decachetime=" & Server.URLEncode(Now)

rem *** Get XML Data ***
Set objXMLHTTP = Server.CreateObject("Microsoft.XMLHTTP")
Set objXML = Server.CreateObject("Microsoft.XMLDOM")
rem Set objXMLHTTP = Server.CreateObject("Msxml2.ServerXMLHTTP.4.0") ' newer objects though they don't work for me
rem Set objXML = Server.CreateObject("Msxml2.DOMDocument.4.0") ' newer objects though they don't work for me
objXML.Async = False
objXML.ValidateOnParse = False ' v1.8.9 XML has a bug, set False to ignore
objXMLHTTP.Open "GET", sURL, False
objXMLHTTP.Send
TempXML = objXMLHTTP.ResponseText
LoadedXML = objXML.LoadXML(TempXML)

rem *** Debug ***
If Not LoadedXML AND DebugMode Then
Response.Write "<font face=""Tahoma, Arial, Helvetica"" size=""2""><small>" & "<br><b>XML Parse Error:</b> "
Response.Write objXML.parseError.reason
Response.Write "</font>"
End If

If LoadedXML Then
Set objDoc = objXML.DocumentElement
sCurTitle = UrlDecode(objDoc.SelectSingleNode("//SONGTITLE").Text)
sServer = UrlDecode(objDoc.SelectSingleNode("//SERVERTITLE").Text)
rem sURL = UrlDecode(objDoc.SelectSingleNode("//SERVERURL").Text)
sURL = sPlayLink
sGenre = UrlDecode(objDoc.SelectSingleNode("//SERVERGENRE").Text)
sCurrent = UrlDecode(objDoc.SelectSingleNode("//CURRENTLISTENERS").Text)
sPeak = UrlDecode(objDoc.SelectSingleNode("//PEAKLISTENERS").Text)
sMax = UrlDecode(objDoc.SelectSingleNode("//MAXLISTENERS").Text)
sICQ = UrlDecode(objDoc.SelectSingleNode("//ICQ").Text)
sAIM = UrlDecode(objDoc.SelectSingleNode("//AIM").Text)
If v189Plus Then
sBitrate = UrlDecode(objDoc.SelectSingleNode("//BITRATE").Text)
Else
sBitrate = HardBitrate
End If

If sCurrent < 10 Then sCurrent = "0" & sCurrent
If sPeak < 10 Then sPeak = "0" & sPeak
If sMax < 10 Then sMax = "0" & sMax

sHistory = ""
Set objSongs = objDoc.SelectNodes("//SONGHISTORY/SONG")
i = objSongs.Length
If i > MaxTracks Then
i = MaxTracks
End If
If i > 1 Then
For n=0 To i-1
Set objOneSong = objSongs.Item(n)
sTitle = UrlDecode(objOneSong.SelectSingleNode("TITLE").Text)
sTime = UrlDecode(objOneSong.SelectSingleNode("PLAYEDAT").Text)

sHour = Int(Left(sTime,2))
sRest = Right(sTime,Len(sTime)-2)
sRest = Left(sRest,Len(sRest)-3)
If sHour >= 12 Then
sAmPm = "pm"
Else
sAmPm = "am"
End If
If sHour = 0 Then sHour = 12
If sHour > 12 Then sHour = sHour - 12
If sHour < 10 Then sHour = "0" & sHour
rem sHistory = sHistory & "<tt>" & sTime & "</tt>" & " " & sTitle & "<br>" & vbCrLf
sHistory = sHistory & sHour & sRest & sAmPm & " <font color=""#FFFFFF"">" & sTitle & "</font>"
If n=0 Then
sHistory = sHistory & "<font color=""#FFFFFF"" size=""1""> [Now Playing]</font>"
End If
sHistory = sHistory & "<br>" & vbCrLf
Next
End If
Set objSongs = NOTHING

End If

Set objDoc = NOTHING
Set objXml = NOTHING
Set objXmlHTTP = NOTHING

rem *** Display Data or Error ***
Response.Write "<table border=""0"" cellpadding=""0"" cellspacing=""0"" align=""center"">" & vbCrLf

If ShowHeadings Then
Response.Write " <tr>" & vbCrLf
Response.Write " <td nowrap align=""center"" width=""10""></td>" & vbCrLf
Response.Write " <td nowrap align=""center"" valign=""bottom""><font face=""Arial, Helvetica"" size=""1"">Action</font></td>" & vbCrLf
Response.Write " <td nowrap align=""center"" valign=""bottom"" width=""10""></td>" & vbCrLf
Response.Write " <td align=""center"" valign=""bottom"" width=""100%""><font face=""Arial, Helvetica"" size=""1"">Genre [Description]</font></td>" & vbCrLf
Response.Write " <td nowrap align=""center"" valign=""bottom"" width=""10""></td>" & vbCrLf
Response.Write " <td nowrap align=""center"" valign=""bottom""><font face=""Arial, Helvetica"" size=""1"">Listeners<br>Now / Peak / Max</font></td>" & vbCrLf
Response.Write " <td nowrap align=""center"" valign=""bottom"" width=""10""></td>" & vbCrLf
Response.Write " <td nowrap align=""center"" valign=""bottom""><font face=""Arial, Helvetica"" size=""1"">Bitrate (Kb/s)</font></td>" & vbCrLf
Response.Write " <td nowrap align=""center"" valign=""bottom"" width=""10""></td>" & vbCrLf
Response.Write " </tr>" & vbCrLf
End If
Response.Write "<tr><td bgcolor=""" & sBorderColor & """ colspan=""9"" align=""center"" valign=""middle"" height=""4""><img src=""images/1x1.gif"" height=""1"" width=""1"" border=""0""></td></tr>" & vbCrLf

If LoadedXML AND sCurTitle <> "N/A" Then

Response.Write "<tr>" & vbCrLf
Response.Write "<td width=""10"" nowrap align=""center"" bgcolor=""" & sInnerColor & """>&nbsp;</td>" & vbCrLf
Response.Write "<td nowrap align=""center"" bgcolor=""" & sInnerColor & """><font face=""Arial, Helvetica"" size=""2""><a href=""" & sPlayLink & """><font color=""#FFFFFF""><b>"
Response.Write "<img src=""images/tunein.gif"" height=""15"" width=""49"" border=""0"">"
Response.Write "</b></font></a>&nbsp;</font></td>" & vbCrLf
Response.Write "<td width=""10"" nowrap align=""center"" bgcolor=""" & sInnerColor & """>&nbsp;</td>" & vbCrLf
Response.Write "<td width=""100%"" align=""left"" bgcolor=""" & sInnerColor & """><font face=""Arial, Helvetica"" size=""2"" color=""#FFFFFF""><font size=""1""><b>[" & sGenre & "]</font></b><br><a id=""listlinks"" target=""_top"" href=""" & sURL & """><font color=""#F0F0F0"">" & sServer & "</font></a><br>" & vbCrLf
Response.Write "<font size=""1""><a id=""chatstuff"" href=""aim:goim?screenname=" & Server.UrlEncode(sAIM) & """><font color=""#D0D0D0"">[ AIM ]</font></a>&nbsp;<a id=""chatstuff"" href=""http://wwp.icq.com/scripts/contact.dll?msgto=" & Server.UrlEncode(sICQ) & """><font color=""#D0D0D0"">[ ICQ ]</font></a><br></font></font></td>" & vbCrLf
Response.Write "<td nowrap align=""center"" width=""10"" bgcolor=""" & sInnerColor & """>&nbsp;</td>" & vbCrLf
Response.Write "<td nowrap align=""center"" bgcolor=""" & sInnerColor & """><font face=""Arial, Helvetica"" size=""2"" color=""#FFFFFF"">" & sCurrent & " / " & sPeak & " / " & sMax & "</font></td>" & vbCrLf
Response.Write "<td nowrap align=""center"" width=""10"" bgcolor=""" & sInnerColor & """>&nbsp;</td>" & vbCrLf
Response.Write "<td nowrap align=""center"" bgcolor=""" & sInnerColor & """><font face=""Arial, Helvetica"" size=""2"" color=""#FFFFFF"">" & sBitrate & "</font></td>" & vbCrLf
Response.Write "<td nowrap align=""center"" bgcolor=""" & sInnerColor & """ width=""10"">&nbsp;</td>" & vbCrLf
Response.Write "</tr>" & vbCrLf

If sHistory <> "" Then
Response.Write "<tr>" & vbCrLf
Response.Write "<td nowrap align=""center"" bgcolor=""" & sInnerColor & """ colspan=""3""><font size=""1"">&nbsp;</font></td>" & vbCrLf
Response.Write "<td align=""left"" bgcolor=""" & sInnerColor & """ colspan=""5""><font face=""Arial, Helvetica"" size=""1"" color=""#C0C0C0"">"
Response.Write "SHOUTcast Channel Playlist [updated "

nHour = Hour(Now)
nMinute = Minute(Now)
If nHour >= 12 Then
nAmPm = "pm" & TimeSuffix
Else
nAmPm = "am" & TimeSuffix
End If
If nHour = 0 Then nHour = 12
If nHour > 12 Then nHour = nHour - 12
If nHour < 10 Then nHour = "0" & nHour
If nMinute < 10 Then nMinute = "0" & nMinute

Response.Write nHour & ":" & nMinute & nAmPm

Response.Write "]:<br>" & vbCrLf
Response.Write "<font color=""#D0D0D0"">" & sHistory & "</font>"
Response.Write "</td>"
Response.Write "<td nowrap align=""center"" bgcolor=""" & sInnerColor & """ colspan=""1""><font size=""1"">&nbsp;</font></td>" & vbCrLf
Response.Write "</tr>" & vbCrLf
End If

Else
Response.Write "<td align=""center"" bgcolor=""" & sInnerColor & """ colspan=""9""><font face=""Arial, Helvetica"" size=""2"" color=""#FFFFFF"">" & "<b>Sorry - The SHOUTcase Server Is Currently Unavailable<br>Please Try Again Later</b>" & "</font></a><br>" & vbCrLf
End If

Response.Write "<tr><td bgcolor=""" & sBorderColor & """ colspan=""9"" align=""center"" valign=""middle"" height=""4""><img src=""images/1x1.gif"" height=""1"" width=""1"" border=""0""></td></tr>" & vbCrLf
Response.Write "</table>" & vbCrLf

%>

[angst]

just had to add "On Error Resume Next"
;)
-----your code----
<%
rem *** URL Decode Function ***
Function UrlDecode( strURL )
res = ""
i = InStr(strURL,"%")
ss = ""

While i>0
ss = "&H"+Mid(strURL,i+1,2)
res = res+Mid(strURL, 1, i-1)+Chr(0+ss)
strURL = Mid(strURL,i+3, Len(strURL)-i-2)

i = InStr(strURL,"%")
Wend
res = res+strURL

URLDecode = res
End Function

rem *** Constants ***
DebugMode = False ' set True to print XML decode error messages
TimeSuffix = " EST"
ServerID = "http://www.industrialradio.net:8000" ' set for your server
ServerPassword = "ChangeMe" ' set for your server
MaxTracks = 99
v189Plus = True ' Set True if 1.8.9, if older, set false and hard code bitrate below
HardBitrate = 128 ' If not v1.8.9+ hard code bitrate here
sBorderColor = "#808080"
sInnerColor = "#303030"
ShowHeadings = True
sPlayLink = ServerID & "/listen.pls"
sURL = ServerID & "/admin.cgi?pass=" & ServerPassword & "&mode=viewxml&page=0&decachetime=" & Server.URLEncode(Now)

rem *** Get XML Data ***
Set objXMLHTTP = Server.CreateObject("Microsoft.XMLHTTP")
Set objXML = Server.CreateObject("Microsoft.XMLDOM")
rem Set objXMLHTTP = Server.CreateObject("Msxml2.ServerXMLHTTP.4.0") ' newer objects though they don't work for me
rem Set objXML = Server.CreateObject("Msxml2.DOMDocument.4.0") ' newer objects though they don't work for me
objXML.Async = False
objXML.ValidateOnParse = False ' v1.8.9 XML has a bug, set False to ignore
objXMLHTTP.Open "GET", sURL, False
'--------------------------
On Error Resume Next
'-------------------------
objXMLHTTP.Send

TempXML = objXMLHTTP.ResponseText
LoadedXML = objXML.LoadXML(TempXML)

rem *** Debug ***
If Not LoadedXML AND DebugMode Then
Response.Write "<font face=""Tahoma, Arial, Helvetica"" size=""2""><small>" & "<br><b>XML Parse Error:</b> "
Response.Write objXML.parseError.reason
Response.Write "</font>"
End If

If LoadedXML Then
Set objDoc = objXML.DocumentElement
sCurTitle = UrlDecode(objDoc.SelectSingleNode("//SONGTITLE").Text)
sServer = UrlDecode(objDoc.SelectSingleNode("//SERVERTITLE").Text)
rem sURL = UrlDecode(objDoc.SelectSingleNode("//SERVERURL").Text)
sURL = sPlayLink
sGenre = UrlDecode(objDoc.SelectSingleNode("//SERVERGENRE").Text)
sCurrent = UrlDecode(objDoc.SelectSingleNode("//CURRENTLISTENERS").Text)
sPeak = UrlDecode(objDoc.SelectSingleNode("//PEAKLISTENERS").Text)
sMax = UrlDecode(objDoc.SelectSingleNode("//MAXLISTENERS").Text)
sICQ = UrlDecode(objDoc.SelectSingleNode("//ICQ").Text)
sAIM = UrlDecode(objDoc.SelectSingleNode("//AIM").Text)
If v189Plus Then
sBitrate = UrlDecode(objDoc.SelectSingleNode("//BITRATE").Text)
Else
sBitrate = HardBitrate
End If

If sCurrent < 10 Then sCurrent = "0" & sCurrent
If sPeak < 10 Then sPeak = "0" & sPeak
If sMax < 10 Then sMax = "0" & sMax

sHistory = ""
Set objSongs = objDoc.SelectNodes("//SONGHISTORY/SONG")
i = objSongs.Length
If i > MaxTracks Then
i = MaxTracks
End If
If i > 1 Then
For n=0 To i-1
Set objOneSong = objSongs.Item(n)
sTitle = UrlDecode(objOneSong.SelectSingleNode("TITLE").Text)
sTime = UrlDecode(objOneSong.SelectSingleNode("PLAYEDAT").Text)

sHour = Int(Left(sTime,2))
sRest = Right(sTime,Len(sTime)-2)
sRest = Left(sRest,Len(sRest)-3)
If sHour >= 12 Then
sAmPm = "pm"
Else
sAmPm = "am"
End If
If sHour = 0 Then sHour = 12
If sHour > 12 Then sHour = sHour - 12
If sHour < 10 Then sHour = "0" & sHour
rem sHistory = sHistory & "<tt>" & sTime & "</tt>" & " " & sTitle & "<br>" & vbCrLf
sHistory = sHistory & sHour & sRest & sAmPm & " <font color=""#FFFFFF"">" & sTitle & "</font>"
If n=0 Then
sHistory = sHistory & "<font color=""#FFFFFF"" size=""1""> [Now Playing]</font>"
End If
sHistory = sHistory & "<br>" & vbCrLf
Next
End If
Set objSongs = NOTHING

End If

Set objDoc = NOTHING
Set objXml = NOTHING
Set objXmlHTTP = NOTHING

rem *** Display Data or Error ***
Response.Write "<table border=""0"" cellpadding=""0"" cellspacing=""0"" align=""center"">" & vbCrLf

If ShowHeadings Then
Response.Write " <tr>" & vbCrLf
Response.Write " <td nowrap align=""center"" width=""10""></td>" & vbCrLf
Response.Write " <td nowrap align=""center"" valign=""bottom""><font face=""Arial, Helvetica"" size=""1"">Action</font></td>" & vbCrLf
Response.Write " <td nowrap align=""center"" valign=""bottom"" width=""10""></td>" & vbCrLf
Response.Write " <td align=""center"" valign=""bottom"" width=""100%""><font face=""Arial, Helvetica"" size=""1"">Genre [Description]</font></td>" & vbCrLf
Response.Write " <td nowrap align=""center"" valign=""bottom"" width=""10""></td>" & vbCrLf
Response.Write " <td nowrap align=""center"" valign=""bottom""><font face=""Arial, Helvetica"" size=""1"">Listeners<br>Now / Peak / Max</font></td>" & vbCrLf
Response.Write " <td nowrap align=""center"" valign=""bottom"" width=""10""></td>" & vbCrLf
Response.Write " <td nowrap align=""center"" valign=""bottom""><font face=""Arial, Helvetica"" size=""1"">Bitrate (Kb/s)</font></td>" & vbCrLf
Response.Write " <td nowrap align=""center"" valign=""bottom"" width=""10""></td>" & vbCrLf
Response.Write " </tr>" & vbCrLf
End If
Response.Write "<tr><td bgcolor=""" & sBorderColor & """ colspan=""9"" align=""center"" valign=""middle"" height=""4""><img src=""images/1x1.gif"" height=""1"" width=""1"" border=""0""></td></tr>" & vbCrLf

If LoadedXML AND sCurTitle <> "N/A" Then

Response.Write "<tr>" & vbCrLf
Response.Write "<td width=""10"" nowrap align=""center"" bgcolor=""" & sInnerColor & """> </td>" & vbCrLf
Response.Write "<td nowrap align=""center"" bgcolor=""" & sInnerColor & """><font face=""Arial, Helvetica"" size=""2""><a href=""" & sPlayLink & """><font color=""#FFFFFF""><b>"
Response.Write "<img src=""images/tunein.gif"" height=""15"" width=""49"" border=""0"">"
Response.Write "</b></font></a> </font></td>" & vbCrLf
Response.Write "<td width=""10"" nowrap align=""center"" bgcolor=""" & sInnerColor & """> </td>" & vbCrLf
Response.Write "<td width=""100%"" align=""left"" bgcolor=""" & sInnerColor & """><font face=""Arial, Helvetica"" size=""2"" color=""#FFFFFF""><font size=""1""><b>[" & sGenre & "]</font></b><br><a id=""listlinks"" target=""_top"" href=""" & sURL & """><font color=""#F0F0F0"">" & sServer & "</font></a><br>" & vbCrLf
Response.Write "<font size=""1""><a id=""chatstuff"" href=""aim:goim?screenname=" & Server.UrlEncode(sAIM) & """><font color=""#D0D0D0"">[ AIM ]</font></a> <a id=""chatstuff"" href=""http://wwp.icq.com/scripts/contact.dll?msgto=" & Server.UrlEncode(sICQ) & """><font color=""#D0D0D0"">[ ICQ ]</font></a><br></font></font></td>" & vbCrLf
Response.Write "<td nowrap align=""center"" width=""10"" bgcolor=""" & sInnerColor & """> </td>" & vbCrLf
Response.Write "<td nowrap align=""center"" bgcolor=""" & sInnerColor & """><font face=""Arial, Helvetica"" size=""2"" color=""#FFFFFF"">" & sCurrent & " / " & sPeak & " / " & sMax & "</font></td>" & vbCrLf
Response.Write "<td nowrap align=""center"" width=""10"" bgcolor=""" & sInnerColor & """> </td>" & vbCrLf
Response.Write "<td nowrap align=""center"" bgcolor=""" & sInnerColor & """><font face=""Arial, Helvetica"" size=""2"" color=""#FFFFFF"">" & sBitrate & "</font></td>" & vbCrLf
Response.Write "<td nowrap align=""center"" bgcolor=""" & sInnerColor & """ width=""10""> </td>" & vbCrLf
Response.Write "</tr>" & vbCrLf

If sHistory <> "" Then
Response.Write "<tr>" & vbCrLf
Response.Write "<td nowrap align=""center"" bgcolor=""" & sInnerColor & """ colspan=""3""><font size=""1""> </font></td>" & vbCrLf
Response.Write "<td align=""left"" bgcolor=""" & sInnerColor & """ colspan=""5""><font face=""Arial, Helvetica"" size=""1"" color=""#C0C0C0"">"
Response.Write "SHOUTcast Channel Playlist [updated "

nHour = Hour(Now)
nMinute = Minute(Now)
If nHour >= 12 Then
nAmPm = "pm" & TimeSuffix
Else
nAmPm = "am" & TimeSuffix
End If
If nHour = 0 Then nHour = 12
If nHour > 12 Then nHour = nHour - 12
If nHour < 10 Then nHour = "0" & nHour
If nMinute < 10 Then nMinute = "0" & nMinute

Response.Write nHour & ":" & nMinute & nAmPm

Response.Write "]:<br>" & vbCrLf
Response.Write "<font color=""#D0D0D0"">" & sHistory & "</font>"
Response.Write "</td>"
Response.Write "<td nowrap align=""center"" bgcolor=""" & sInnerColor & """ colspan=""1""><font size=""1""> </font></td>" & vbCrLf
Response.Write "</tr>" & vbCrLf
End If

Else
Response.Write "<td align=""center"" bgcolor=""" & sInnerColor & """ colspan=""9""><font face=""Arial, Helvetica"" size=""2"" color=""#FFFFFF"">" & "<b>Sorry - The SHOUTcase Server Is Currently Unavailable<br>Please Try Again Later</b>" & "</font></a><br>" & vbCrLf
End If

Response.Write "<tr><td bgcolor=""" & sBorderColor & """ colspan=""9"" align=""center"" valign=""middle"" height=""4""><img src=""images/1x1.gif"" height=""1"" width=""1"" border=""0""></td></tr>" & vbCrLf
Response.Write "</table>" & vbCrLf
%>

[nax_mushroom]

Ahh.. finally! Thanks!