The gatekeeper of reality is
quantified imagination.
quantified imagination.
Project "Facebook Wall Feed 2"
<%@ Import Namespace="System" %>
<%@ Import Namespace="System.IO" %>
<%@ Import Namespace="System.Net" %>
<%@ Import Namespace="System.Text" %>
<script runat="server">
' Call this page as: somepage.aspx?name=Group1&feedNumber=6
' name = the server cache object name
' feedNumber = number of posts on wall to accept
' Feed Customizaiton
Dim discussionGroupPage As String = "http://www.facebook.com/PUBLIC-GROUP?sk=wall" ' URL of the public group wall
Dim rssDescriptionLen As Integer = 60 ' Number of characters to allow in the poster's post (description)
Dim numberOfPostsShow As Integer = 6 ' Number of posts on the wall to show
Dim rssIncludeImg As Integer = 1 ' 0 = do not include the thumbnail image of posters in description, 1 = include
Dim rssIncludeHeader As Integer = 0 ' 0 = do not include RSS provider data (below), 1 = include
Dim rssShowErrors As Integer = 0 ' 0 = do not show server-side errors with wall data retrieval, 1 = show
Dim feed_title As String = "Your Feed Title"
Dim feed_link As String = "http://www.facebook.com/PUBLIC-GROUP/"
Dim feed_description As String = "Public Group Wall Feed"
Dim feed_language As String = "en-us"
Dim feed_pubdate As String = "20 Apr 2007 9:40:00 GMT"
Dim feed_copyright As String = String.Empty
Dim feed_webmaster As String = "you@yoursite.com"
' Maintenance
Dim overrideCache As Integer = 0 ' 1 = override referring to cache when testing (useful when you have more than one instance of this code running referring to the same cache object and others are loading a different instance), 0 = do not override
Dim rssCacheClear As Integer = 0 ' 1 = clear server-cache, 0 = do not clear server-cache
Dim rawDump As Integer = 0 ' 1 = show fetched content without reorganization/formatting, 0 = do not show fetched content
' Do Not Use
Dim crawlAgent As String = String.Empty
Dim crawlError As String = String.Empty
' TRAP CONNECT ERRORS IN CRAWLPAGE
Private Function crawlPage(ByVal URL As String) As String
Dim buffSize As Integer = 2048
Dim crawlOutput As String = String.Empty
Dim crawlMethod As String = "GET"
Dim crawlURL As String = URL
Try
Dim myRequest As HttpWebRequest = CType(WebRequest.Create(crawlURL), HttpWebRequest)
myRequest.UserAgent = crawlAgent
myRequest.Method = crawlMethod
Dim myResponse As HttpWebResponse = CType(myRequest.GetResponse(), HttpWebResponse)
Dim streamResponse As Stream = myResponse.GetResponseStream()
Dim streamRead As New StreamReader(streamResponse)
Dim readBuff(buffSize) As [Char]
Dim lineStep As Integer = streamRead.Read(readBuff, 0, buffSize)
While lineStep > 0
Dim outputData As New [String](readBuff, 0, lineStep)
crawlOutput = crawlOutput & outputData
lineStep = streamRead.Read(readBuff, 0, buffSize)
End While
streamRead.Close()
streamResponse.Close()
myResponse.Close()
Catch ex As Exception
crawlError = Server.HtmlEncode(ex.Message)
End Try
Return (crawlOutput)
End Function
Private Sub Page_Load(ByVal sender As System.Object, ByVal e As System.EventArgs)
Dim feedContent As String = String.Empty
Dim rssFeed As String = String.Empty
' Querystring Data
Dim feedName As String = CStr(Request.QueryString("name"))
If Len(feedName) = 0 Then : feedName = "default" : End If
' Handle Manual Cache Clearing
If rssCacheClear = 0 Then
Dim maxFeedsTotalAccept As Integer = CInt(Request.QueryString("feedNumber"))
If maxFeedsTotalAccept <= 0 Then : maxFeedsTotalAccept = numberOfPostsShow : End If
' Retrieve Page Since Cache Does Not Exist
If HttpContext.Current.Cache(feedName) Is Nothing OR overrideCache = 1 OR rawDump = 1 Then
' Get User's Agent Data
crawlAgent = Request.UserAgent
' Load Wall Page
Dim discussionPageData As String = crawlPage(discussionGroupPage)
' Process Page
if Len(crawlError) = 0 Then
' Filter Content
discussionPageData = Replace(discussionPageData, vbCrLf, "")
' Break-up Content
Dim elemLinesRaw() As String = Split(discussionPageData, ">")
' Extract Useful Content
Dim elemLines(,) As String
Dim elemLinesCount As Integer = 0
Dim contentAStartFlag As Integer = 0
Dim contentBStartFlag As Integer = 0
Dim contentCStartFlag As Integer = 0
Dim contentCOrigin As Integer = 0
Dim contentCStartSubSet1 As Integer = 0
Dim contentCVariant1 As Integer = 0
Dim contentStartedParse As Integer = 0
Dim contentRecord As Integer = 0
Dim storyPhoto As String = String.Empty
Dim storyAuthor As String = String.Empty
Dim storyStatement As String = String.Empty
For S As Integer = 0 To UBound(elemLinesRaw)
if rawDump = 1 Then
Response.Write(elemLinesRaw(S) & vbcrlf)
Else
' Read Content
if contentStartedParse = 0 Then
' Determine content layout style
if elemLinesRaw(S).indexOf("class=""storyContent""") > 0 Then ' uiUnifiedStory uiStreamStory
contentAStartFlag = 1 : contentStartedParse = 1
Elseif elemLinesRaw(S).indexOf("uiUfiComment comment") > 0 Then
contentBStartFlag = 1 : contentStartedParse = 1
Elseif elemLinesRaw(S).indexOf("timelineUnitCustomBackground") > 0 Or elemLinesRaw(S).indexOf("pvm uiListItem") > 0 Or elemLinesRaw(S).indexOf("ptm uiListItem") > 0 Or elemLinesRaw(S).indexOf("pbm uiListItem") > 0 Then
contentCStartFlag = 1 : contentStartedParse = 1
End if
Else
' Parse A Content
if contentAStartFlag = 8 Then
if (elemLinesRaw(S).indexOf("</") > 0) Then
storyStatement = Split(elemLinesRaw(S), "</")(0)
Else
storyStatement = elemLinesRaw(S)
End if
contentRecord = 1
Elseif contentAStartFlag = 7 Then
if elemLinesRaw(S).indexOf("</") > -1 Then
contentAStartFlag = 8
End if
Elseif contentAStartFlag = 6 Then
if elemLinesRaw(S).indexOf("class=""") > 0 Then
contentAStartFlag = 7
Else
if elemLinesRaw(S).indexOf("</") > 0 Then
storyStatement = Split(elemLinesRaw(S), "</")(0)
contentRecord = 1
Elseif elemLinesRaw(S).indexOf("<br /") > 0 Then
storyStatement = Split(elemLinesRaw(S), "<br /")(0)
contentRecord = 1
End if
End if
Elseif contentAStartFlag = 5 Then
if elemLinesRaw(S).indexOf("<a href") > -1 And elemLinesRaw(S).indexOf("event, bagof(") > 0 Then
contentAStartFlag = 6
End if
' Catch that variant from contentAStartFlag = 3 earlier
if elemLinesRaw(S).indexOf("class=""messageBody"" data-ft=""") > 0 Then
contentAStartFlag = 6
End if
Elseif contentAStartFlag = 4 Then
storyAuthor = Split(elemLinesRaw(S), "</a")(0)
contentAStartFlag = 5
Elseif contentAStartFlag = 3 Then
' Catch variant of a closing tag that is not there under other circumstances
if elemLinesRaw(S).indexOf("</") > 0 Then
storyAuthor = Split(elemLinesRaw(S), "</")(0)
contentAStartFlag = 5
Else
contentAStartFlag = 4
End if
Elseif contentAStartFlag = 2 Then
if elemLinesRaw(S).indexOf("actorName") > 0 Then
contentAStartFlag = 3
End if
Elseif contentAStartFlag = 1 Then
if contentCOrigin = 1 Then
contentCOrigin = 0 : contentAStartFlag = 2
Elseif elemLinesRaw(S).indexOf("uiProfilePhoto") > 0 Then
storyPhoto = Split(Split(elemLinesRaw(S), "src=""")(1), """")(0)
contentAStartFlag = 2
End if
End if
' Parse B Content
if contentBStartFlag = 5 Then
storyStatement = Split(elemLinesRaw(S), "</span")(0)
contentRecord = 1
Elseif contentBStartFlag = 4 Then
if elemLinesRaw(S).indexOf("commentBody") > 0 Then
contentBStartFlag = 5
End if
Elseif contentBStartFlag = 3 Then
storyAuthor = Split(elemLinesRaw(S), "</")(0)
contentBStartFlag = 4
Elseif contentBStartFlag = 2 Then
if elemLinesRaw(S).indexOf("actorName") > 0 Then
contentBStartFlag = 3
End if
Elseif contentBStartFlag = 1 Then
if elemLinesRaw(S).indexOf("uiProfilePhoto") > 0 Then
storyPhoto = Split(Split(elemLinesRaw(S), "src=""")(1), """")(0)
contentBStartFlag = 2
End if
End if
' Parse C Content
if contentCStartFlag = 2 Then
' Start Variants
if contentCStartSubSet1 = 6 Then
if elemLinesRaw(S).indexOf("</") > 0 Then
storyStatement = Split(elemLinesRaw(S), "</")(0)
contentRecord = 1
End if
Elseif contentCStartSubSet1 = 5 Then
if elemLinesRaw(S).indexOf("""messageBody""") > 0 Then
contentCStartSubSet1 = 6
End if
Elseif contentCStartSubSet1 = 4 Then
storyAuthor = Split(elemLinesRaw(S), "</")(0)
contentCStartSubSet1 = 5
Elseif contentCStartSubSet1 = 3 Then
if contentCVariant1 = 1 Then
storyStatement = Split(elemLinesRaw(S), "</div")(0)
contentRecord = 1
End if
if elemLinesRaw(S).indexOf("class=""tipOnelineStory""") > 0 Then
contentCVariant1 = 1
Elseif elemLinesRaw(S).indexOf("class=""tlTxFe""") > 0 Then
contentCVariant1 = 1
Elseif elemLinesRaw(S).indexOf("class=""fsm fwn fcg""") > 0 Then
contentCStartFlag = 0 : contentStartedParse = 0
Elseif elemLinesRaw(S).indexOf("class=""storyContent""") > 0 Then
contentCStartFlag = 0 : contentCStartSubSet1 = 0
contentAStartFlag = 1 : contentCOrigin = 1
End if
Elseif contentCStartSubSet1 = 2 Then
storyAuthor = Split(elemLinesRaw(S), "</a")(0)
contentCStartSubSet1 = 3
Elseif contentCStartSubSet1 = 1 Then
contentCStartSubset1 = 2
End if
if elemLinesRaw(S).indexOf("<span class=""fwb""") > -1 And contentCStartSubset1 = 0 Then
contentCStartSubset1 = 1
End if
' Catch New Variant
if elemLinesRaw(S).indexOf("data-hovercard=") > 0 And contentCStartSubSet1 = 0 Then
contentCStartSubset1 = 4
End if
Elseif contentCStartFlag = 1 Then
if elemLinesRaw(S).indexOf("timelinePageMostRecentLabel") > 0 Then
' Skip top entry of link to recent posts by others
contentCStartFlag = 0 : contentStartedParse = 0
Elseif elemLinesRaw(S).indexOf("uiProfilePhoto") > 0 Then
storyPhoto = Split(Split(elemLinesRaw(S), "src=""")(1), """")(0)
contentCStartFlag = 2
End if
End if
' Record Content
if contentRecord = 1 Then
' Save Data
if Len(storyPhoto) > 0 AND Len(storyAuthor) > 0 AND Len(storyStatement) > 0 Then
' Filter breaking
storyStatement = Replace(Replace(storyStatement, vbCr, ""), vbLf, "")
' Continue
storyAuthor = Server.HtmlDecode(storyAuthor)
storyStatement = Server.HtmlDecode(storyStatement)
' Filter out HTML inserted by the poster
if storyStatement.indexOf("<") > -1 OR storyStatement.indexOf(">") > -1 Then
Dim tmp_Filtered As String = String.Empty
Dim tmp_Flip As Integer = 0
For T As Integer = 0 TO Len(storyStatement)
Dim tmp_contentChar As String = Mid(storyStatement, T + 1, 1)
if tmp_contentChar = "<" Then : tmp_Flip = 1 : End if
if tmp_Flip = 0 Then : tmp_Filtered = tmp_Filtered & tmp_contentChar : End if
if tmp_contentChar = ">" Then : tmp_Flip = 0 : End if
Next
storyStatement = tmp_Filtered
End if
' Limit size of statement
if Len(storyStatement) > rssDescriptionLen Then
storyStatement = Mid(storyStatement, 1, rssDescriptionLen) & "..."
End if
ReDim Preserve elemLines(3, elemLinesCount)
elemLines(0, elemLinesCount) = storyPhoto
elemLines(1, elemLinesCount) = storyAuthor
elemLines(2, elemLinesCount) = storyStatement
elemLines(3, elemLinesCount) = feed_pubdate
elemLinesCount = elemLinesCount + 1
End if
contentAStartFlag = 0 : contentBStartFlag = 0 : contentCStartFlag = 0 : contentCOrigin = 0
contentCStartSubSet1 = 0 : contentCVariant1 = 0 : contentStartedParse = 0 : contentRecord = 0
storyPhoto = String.Empty : storyAuthor = String.Empty : storyStatement = String.Empty
End if
End if
End if
Next
if rawDump = 0 Then
' Assemble Data into RSS
if elemLinesCount > 0 Then
' Content returned
Dim feedStep As Integer = 0
For R As Integer = 0 To elemLinesCount - 1
if R < maxFeedsTotalAccept Then
feedContent = feedContent & "<item>" & vbCrLf
feedContent = feedContent & "<title>" & feed_title & "</title>" & vbCrLf
feedContent = feedContent & "<link>" & feed_link & "</link>" & vbCrLf
if rssIncludeImg = 1 Then
feedContent = feedContent & "<description>" & Server.HtmlEncode("<img align=""left"" src=""" & elemLines(0, R) & """ border=""0"" /> ") & Server.HtmlEncode(Replace(elemLines(2, R), "'", "'")) & "</description>" & vbCrLf
Else
feedContent = feedContent & "<description>" & Server.HtmlEncode(Replace(elemLines(2, R), "'", "'")) & "</description>" & vbCrLf
End if
feedContent = feedContent & "<author>" & elemLines(1, R) & "</author>" & vbCrLf
feedContent = feedContent & "<date>" & elemLines(3, R) & "</date>" & vbCrLf
feedContent = feedContent & "</item>" & vbCrLf
End if
Next
Else
' No content found; target is reachable but the source code of the wall has possibly changed
feedContent = feedContent & "<item>" & vbCrLf
feedContent = feedContent & "<title>Page Found But Data Not Recognized</title>" & vbCrLf
feedContent = feedContent & "<link></link>" & vbCrLf
feedContent = feedContent & "<description>Page Found But Data Not Recognized</description>" & vbCrLf
feedContent = feedContent & "<author>Server</author>" & vbCrLf
feedContent = feedContent & "<date>" & feed_pubdate & "</date>" & vbCrLf
feedContent = feedContent & "</item>" & vbCrLf
End if
End if
Else
' No page found; target is unreachable; error
feedContent = feedContent & "<item>" & vbCrLf
feedContent = feedContent & "<title>Page Not Found/Error</title>" & vbCrLf
feedContent = feedContent & "<link></link>" & vbCrLf
if rssShowErrors = 0 Then
feedContent = feedContent & "<description>Either the page specified could not be found or an error has occurred.</description>" & vbCrLf
Else
feedContent = feedContent & "<description>" & Server.HtmlEncode(crawlError) & "</description>" & vbCrLf
End if
feedContent = feedContent & "<author>Server</author>" & vbCrLf
feedContent = feedContent & "<date>" & feed_pubdate & "</date>" & vbCrLf
feedContent = feedContent & "</item>" & vbCrLf
End if ' End Len(crawlError) = 0
if rawDump = 0 And overrideCache = 0 Then
' Add RSS Envelope, if specified
if rssIncludeHeader = 1 Then
rssFeed = rssFeed & "<rss version=""2.0"">" & vbCrLf
End if
rssFeed = rssFeed & "<channel>" & vbCrLf
If rssIncludeHeader = 1 Then
rssFeed = rssFeed & "<title>" & feed_title & "</title>" & vbCrLf
rssFeed = rssFeed & "<link>" & feed_link & "</link>" & vbCrLf
rssFeed = rssFeed & "<description>" & feed_description & "</description>" & vbCrLf
rssFeed = rssFeed & "<language>" & feed_language & "</language>" & vbCrLf
rssFeed = rssFeed & "<date>" & feed_pubdate & "</date>" & vbCrLf
rssFeed = rssFeed & "<copyright>" & feed_copyright & "</copyright>" & vbCrLf
rssFeed = rssFeed & "<webmaster>" & feed_webmaster & "</webmaster>" & vbCrLf
End If
rssFeed = rssFeed & feedContent
rssFeed = rssFeed & "</channel>" & vbCrLf
if rssIncludeHeader = 1 Then
rssFeed = rssFeed & "</rss>"
End if
' Add RSS to Server Cache
HttpContext.Current.Cache.Add(feedName, rssFeed, Nothing, DateTime.Now.AddDays(1), System.Web.Caching.Cache.NoSlidingExpiration, CacheItemPriority.Normal, Nothing)
End if
Else
' Get Feed From Server Cache
rssFeed = CType(HttpContext.Current.Cache(feedName), String)
End if ' End HttpContext.Current.Cache(feedName) Is Nothing
Else
' Clear Server Cache
HttpContext.Current.Cache.Remove(feedName)
' Compile RSS Data
feedContent = "<item>" & vbCrLf
feedContent = feedContent & "<title>Server Cache Cleared</title>" & vbCrLf
feedContent = feedContent & "<link></link>" & vbCrLf
feedContent = feedContent & "<description>Server Cache Cleared</description>" & vbCrLf
feedContent = feedContent & "<author>Server</author>" & vbCrLf
feedContent = feedContent & "<date>" & feed_pubdate & "</date>" & vbCrLf
feedContent = feedContent & "</item>" & vbCrLf
if rssIncludeHeader = 1 Then
rssFeed = rssFeed & "<rss version=""2.0"">" & vbCrLf
End if
rssFeed = rssFeed & "<channel>" & vbCrLf
If rssIncludeHeader = 1 Then
rssFeed = rssFeed & "<title>" & feed_title & "</title>" & vbCrLf
rssFeed = rssFeed & "<link>" & feed_link & "</link>" & vbCrLf
rssFeed = rssFeed & "<description>" & feed_description & "</description>" & vbCrLf
rssFeed = rssFeed & "<language>" & feed_language & "</language>" & vbCrLf
rssFeed = rssFeed & "<date>" & feed_pubdate & "</date>" & vbCrLf
rssFeed = rssFeed & "<copyright>" & feed_copyright & "</copyright>" & vbCrLf
rssFeed = rssFeed & "<webmaster>" & feed_webmaster & "</webmaster>" & vbCrLf
End If
rssFeed = rssFeed & feedContent
rssFeed = rssFeed & "</channel>" & vbCrLf
if rssIncludeHeader = 1 Then
rssFeed = rssFeed & "</rss>"
End if
End if ' End rssCacheClear = 0
' Generate Output
if rawDump = 0 And overrideCache = 0 Then
Response.Buffer = False
If rssIncludeHeader = 1 Then
Response.ContentType = "application/rss+xml"
Else
Response.ContentType = "text/xml"
End If
Response.Write("<" & "?" & "xml version=""1.0"" encoding=""utf-8""" & "?" & ">" & vbCrLf)
Response.Write(rssFeed)
End if
End Sub
</script>
|
