<%
Dim fs, bgcol, lastChecked
Dim xmldoma, X, RSSChild, RSSItems, RSSItem, RSSLen
Dim RssUrl, manyminutes, logfile
' Index globals
RssUrl = "http://domain.tdl/rss.xml"
manyminutes = 120
logfile = "rss.txt"
' Creates objects
Set xmldoma = Server.CreateObject("MSXML2.DOMDocument.4.0")
Set fs = CreateObject("Scripting.FileSystemObject")
logfile = Server.MapPath(logfile)
If fs.FileExists(logfile) = true Then
Dim file
Set file = fs.GetFile(logfile)
If DateDiff("n", file.DateLastModified, Now()) > manyminutes Then
Dim temp
temp = WebGrab(RssUrl)
xmldoma.async = False
If temp <> "" Then
xmldoma.loadXML (temp)
Updatecache fs, logfile, temp
Else
xmldoma.loadXML (ReadFile(fs, logfile))
End If
Else
xmldoma.loadXML (ReadFile(fs, logfile))
End If
' When was the LJ page last checked
lastChecked = file.DateLastModified
' Closes file
Set file = Nothing
' Parses the RSS
Set RSSItems = xmldoma.getElementsByTagName("item")
RSSLen = RSSItems.length - 1
For X = 0 To RSSLen
Dim Link, Title, Body, GotDate
Set RSSItem = RSSItems.Item(X)
For Each RSSChild In RSSItem.childNodes
Select Case (RSSChild.nodeName)
Case "link"
Link = Replace(RSSChild.Text, vbCrLf, "")
Case "title"
Title = Replace(RSSChild.Text, vbCrLf, "")
Case "description"
Body = Replace(RSSChild.Text, vbCrLf, "")
Case "pubDate"
GotDate = Replace(RSSChild.Text, vbCrLf, "")
End Select
Next
If bgcol = "FFEEFF" Then
bgcol = "FFFFFF"
Else
bgcol = "FFEEFF"
End If
%>
<%
Next
Response.Write("" & _
"News feed last checked: " & lastChecked & "
")
Else
Response.Write("You need to create " & logfile & _
" before you can proceed")
End If
Set fs = Nothing
'-----
' Functions and more
'-----
'Gets updates from the web
Function WebGrab(url)
Dim httpa
Set httpa = Server.CreateObject("MSXML2.XMLHTTP.4.0")
httpa.Open "GET", url, False
httpa.send
If httpa.status = 200 Then
WebGrab = httpa.responseText
Else
WebGrab = ""
End If
End Function
' Reads from the logfile
Function ReadFile(filesys, logfile)
Dim readfil, filetext
Set readfil = filesys.OpenTextFile(logfile, 1)
filetext = readfil.ReadAll
readfil.Close
Set readfil = Nothing
ReadFile = filetext
End Function
' Updates the log file
Sub UpdateCache(filesys, logfile, ftext)
Dim updateFile
Set updateFile = filesys.OpenTextFile(logfile, 2)
updateFile.Write(ftext)
updateFile.Close
Set updateFile = Nothing
End Sub
%>