booksnew/tools/getsrss.vbs

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 "<!-- RSS Status : " & status & " -->" & vbcrlf
			wscript.echo "RSS Status : " & status  & vbcrlf

'			Exit Function

	end if





			' --------- PHP-Nuke & PostNuke compatabilaty --------------------------------
			rssXML_Data = replace(rssXML_Data, "<!DOCTYPE", "<!--DOCTYPE")
			rssXML_Data = replace(rssXML_Data, "rss-0.91.dtd"">", "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 "<!-- RSS Status : " & status & " -->" & 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 & "<BR>" & vbcrlf
'response.write "Month : " & mn & "<BR>" & vbcrlf
'response.write "Year : " & yr & "<BR>" & 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!<21>$%^&*()_+=[]{}#~<>?/\`'.,"
	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