sub showRSSNewsFeeds(rssNewsFeed,id) set xmlObj = wscript.createobject("Msxml2.DOMDocument.3.0") set xmlhttp= wscript.createobject("Msxml2.XMLHTTP.3.0") xmlObj.validateOnParse = false xmlObj.async = false xmlObj.preserveWhiteSpace = false xmlhttp.open "GET", rssNewsFeed, False xmlhttp.send rssXML_Data = xmlhttp.responseXML.xml ' rssXML_Data = application(rssname & "xml") if len(xmlhttp.responsetext) = 0 then Status = rssError wscript.echo "" & vbcrlf wscript.echo "RSS Status : " & status & vbcrlf ' Exit Function end if ' --------- PHP-Nuke & PostNuke compatabilaty -------------------------------- rssXML_Data = replace(rssXML_Data, "", "rss-0.91.dtd""-->") ' ---------------------------------------------------------------------------- xmlObj.loadXML(rssXML_Data) If xmlObj.parseError.errorCode = 0 then ValidLocation = true else ValidLocation = false end if set xmlhttp = nothing if not ValidLocation then Status = rssBadRSS wscript.echo "" & vbcrlf 'response.flush Exit sub end if set schedule = xmlObj.selectSingleNode("schedule") ' wscript.echo schedule.text set service = schedule.selectSingleNode("service") set title = service.selectSingleNode("title") wscript.echo title.text set broadcasts = schedule.selectSingleNode("day/broadcasts") set children = broadcasts.selectNodes("broadcast") TotalItems = children.length wscript.echo totalitems wantedPID = id wscript.echo "Looking for " + wantedPID for each child in children itemNum = itemNum + 1 set pid = child.selectSingleNode("programme/pid") ' wscript.echo pid.text if pid.text = wantedPID then set title = child.selectSingleNode("programme/title") set synopsis = child.selectSingleNode("programme/short_synopsis") set displaytitle = child.selectSingleNode("programme/display_titles/title") set displaysubtitle = child.selectSingleNode("programme/display_titles/subtitle") wscript.echo title.text wscript.echo synopsis.text wscript.echo displaytitle.text wscript.echo displaysubtitle.text end if ' set ' if itemNum > ubound(Items, 2) then ' Redim Preserve Items(2, ubound(Items, 2) + 5) ' end if ' for each ItemChild in child.ChildNodes ' select case ItemChild.baseName ' case "title" Items(0, itemNum) = ItemChild.text ' case "link" Items(1, itemNum) = ItemChild.text ' case "description" Items(2, itemNum) = ItemChild.text ' end select ' next next end sub function SQLLongDate(olddate) dy = day(cdate(olddate)) mn = month(cdate(olddate)) yr = year(cdate(olddate)) mh = hour(cdate(olddate)) mm = minute(cdate(olddate)) ss = second(cdate(olddate)) if len(mh) <= 1 then mh = "0" & mh if len(mm) <= 1 then mm = "0" & mm if len(ss) <= 1 then ss = "0" & ss 'response.write "Day : " & dy & "
" & vbcrlf 'response.write "Month : " & mn & "
" & vbcrlf 'response.write "Year : " & yr & "
" & vbcrlf 'mv = mn & "/" & dy & "/" & yr mv= yr & "-" & mn & "-" & dy & " " mv = mv & mh & ":" & mm & ":" & ss SQLLongDate = mv end function function StripHTML(ByRef asHTML) Dim loRegExp ' Regular Expression Object ' Create built In Regular Expression object Set loRegExp = New RegExp loRegExp.Global = True ' Set the pattern To look For HTML tags loRegExp.Pattern = "<[^>]*>" ' Return the original String stripped of HTML StripHTML = loRegExp.Replace(asHTML, "") ' Release object from memory Set loRegExp = Nothing End function function numbersOnly(ival) notallwd = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ!£$%^&*()_+=[]{}#~<>?/\`'.," allwd = "01234567890" l = len(ival) ws = "" for t = 1 to l cc = mid(ival,t,1) if instr(allwd,cc) > 0 then ws = ws & cc next numbersonly = ws end function sub GatherRSS() feedurl = "http://www.bbc.co.uk/6music/programmes/schedules/today.xml" ' feedurl = "http://www.bbc.co.uk/radio3/programmes/schedules/today.xml" feedid = "b00j3hkg" ' marc ' feedid = "b00j3hxw" ' radio 6 - sixmusic plays it again ' feedid = "b00j15yw" ' radio 3 classical collection ' feedid = "b00j15z6" ' radio 3 performance on 3 call showRSSNewsFeeds(feedurl,feedid) end sub WScript.Echo "RSS Updater" call GatherRSS