RSS XML News Feed for your HTA

Forums

My Profile

Inbox

Address Book

My Subscription

My Forums

RSS XML News Feed for your HTA

Logged in as: Guest

arrSession:exec spGetSession 2,16,53806

	Active Users: There are 0 members and 0 guests.
	Users viewing this topic: none

Printable Version

All Forums >> [Scripting] >> Post a VBScript >> RSS XML News Feed for your HTA
Do you like VisualBasicScript.com? Link to us and help spread the word about our forum. Thanks!

Page: [1]

Message

<< Older Topic Newer Topic >>

RSS XML News Feed for your HTA - 11/25/2007 10:48:28 PM

Meg

Posts: 123
Score: 2
Joined: 7/13/2006
From: Australia
Status: offline

This was written by ByteScout for ASP and I have converted it to HTA. The code below is configured it for the Australian ABC News feed which updates at least every 15 minutes and to display the top item (should be the latest) in the HTA, you can configure it to scan for keywords and display more than one item. The script re-scans the remote RSS XML file every 30 seconds.

Uses:- Add a news feed to one of your HTA's or point it to your own RSS feed for in house propaganda. Make that dreary old HTA tool you use everyday something you want to look at.

Something different in a HTA

<html>
<head>
<title>HTA RSS Scrape</title>
<HTA:APPLICATION 
    ID="objScrape"
    APPLICATIONNAME="HTAScrape"
    SINGLEINSTANCE="yes"
    SCROLL="no"
    
>

<SCRIPT Language="VBScript">
'By MJP 2007
'-----------------------------------------------------------
Sub Window_Onload
  window.resizeto 860,300
  scrape
  iTimerID = window.setInterval("scrape", 30000) 'Refresh the page every 30 seconds
end sub
'-----------------------------------------------------------
Sub Scrape
RSSHTML.innerhtml=""
'Main code Thanks to ByteScout -converted to HTA comptible
'http://www.bytescout.com/how_to_display_rss_using_asp.html'

'Configuration
'RSS Feed URL to display 
URLToRSS = "http://www.abc.net.au/news/indexes/justin/rss.xml"
'max number of displayed items
MaxNumberOfItems = 1
'Optional Keyword Search of RSS feed
Keyword1 = "" ' Keyword1 = "tech" - set non-empty keyword value to filter by this keyword
Keyword2 = "" ' Keyword1 = "win" - set non-empty keyword value to filter by this 2nd keyword too
'Error message that will be displayed if no items etc
ErrorMessage = "<br><b>Can Not Read:</b> " &URLToRSS
'Main Code Start
Set xmlHttp = CreateObject("MSXML2.ServerXMLHTTP.3.0")  
xmlHttp.Open "Get", URLToRSS, false
on error resume next
xmlHttp.Send()
RSSXML = xmlHttp.ResponseText
Set xmlDOM = CreateObject("MSXML2.DomDocument.3.0")  
xmlDOM.async = False
xmlDOM.validateOnParse = False
xmlDom.resolveExternals = False
If not xmlDOM.LoadXml(RSSXML) Then
ErrorMessage = ErrorMessage & "<BR><BR>" &"<b>XML Error:</b> "& xmlDOM.parseError.reason 
End If 
Set xmlHttp = Nothing ' clear HTTP object
Set RSSItems = xmlDOM.getElementsByTagName("item") ' collect all "items" from downloaded RSS
RSSItemsCount = RSSItems.Length-1
' if not <item>..</item> entries, then try to get <entry>..</entry>
if RSSItemsCount = -1 Then 
Set RSSItems = xmlDOM.getElementsByTagName("entry") ' collect all "entry" (atom format) from downloaded RSS
RSSItemsCount = RSSItems.Length-1
End If 
Set xmlDOM = Nothing ' clear XML
j = -1
For i = 0 To RSSItemsCount
Set RSSItem = RSSItems.Item(i)
for each child in RSSItem.childNodes
Select case lcase(child.nodeName)
case "title"
RSStitle = child.text
case "link"
If RSSLink = "" Then
If child.Attributes.length>0 Then
RSSLink = child.GetAttribute("href")
if (RSSLink <> "") Then
if child.GetAttribute("rel") <> "alternate" Then
RSSLink = ""
End If
End If
End If ' if has attributes 
If RSSLink = "" Then
RSSlink = child.text
End If
End If
case "description"
RSSdescription = child.text
case "content" ' atom format
RSSdescription = child.text
case "published"' atom format
RSSDate = child.text
case "pubdate"
RSSDate = child.text
case "comments"
RSSCommentsLink = child.text
case "category"
Set CategoryItems = RSSItem.getElementsByTagName("category")
RSSCategory = ""
for each categoryitem in CategoryItems
if RSSCategory <> "" Then 
RSSCategory = RSSCategory & ", "
End If
RSSCategory = RSSCategory & categoryitem.text
Next
End Select
next
' Check filter
If (InStr(RSSTitle,Keyword1)>0) or (InStr(RSSTitle,Keyword2)>0) or (InStr(RSSDescription,Keyword1)>0) or (InStr(RSSDescription,Keyword2)>0) then
j = J+1
if J<MaxNumberOfItems then 
RSSHTML.innerhtml=RSSHTML.innerhtml&"<table width=800 border=0 bgcolor=white><tr><td rowspan=2><a href=http://www.abc.net.au/news/indexes/justin/rss.xml><img border=0 src=http://abc.net.au/news/img/newslogo88.gif></a></td><td width=700><strong>"&RSSDate&"</strong></td></tr><tr><td><a href="&RSSLink&">"&RSSTitle&"</a></td></tr><tr><td colspan=2>"&RSSDescription&"</td></tr></table>"
End if
End If

'Display Error
if err.number<>0 then
DataArea.InnerHTML = ErrorMessage
ErrorMessage =""
end if
end sub

'-----------------------------------------------------------

</SCRIPT>
</head>
<body>

Post #: 1

RE: RSS XML News Feed for your HTA - 11/30/2007 10:52:59 PM

djredmar

Posts: 42
Score: 0
Joined: 12/11/2006
From: Europe, The Netherlands
Status: offline

Nice script,

But it's not compatible with other xml files..

I will try to rescript it and check if its possible to enumerate all tags..

(in reply to Meg)

Post #: 2

RE: RSS XML News Feed for your HTA - 12/1/2007 10:38:40 PM

Meg

Posts: 123
Score: 2
Joined: 7/13/2006
From: Australia
Status: offline

Thanks, Let me know how you go, I am no longer developing this script because it is blocked when I run it from work. Though for interest, have you got a link to the RSS feed you are trying to display?

(in reply to djredmar)

Post #: 3

RE: RSS XML News Feed for your HTA - 12/26/2007 7:57:11 PM

djredmar

Posts: 42
Score: 0
Joined: 12/11/2006
From: Europe, The Netherlands
Status: offline

Well,

changing MSXML2.ServerXMLHTTP.3.0 to MSXML2.ServerXMLHTTP solved my issue.

Nice going :) thanks for the script.

_____________________________

blah?

(in reply to Meg)