Wednesday, September 08, 2004

Public folder RSS Feed Event sink v2

From the feedback I've received about the first public folder RSS feed sink I've come up with another version that incorporates many bug fixes and add's in some additional functionality.

The main functionality change and bug fix revolves around the publishing of the content of each public folder message. In the original sink I was using the Textdescription field which represented the text body of the email. The problem with this is that firstly the carriage returns weren't interpreted right in the XML file so if you had a long message it just appeared all stuck together with no formatting. To fix this there where two options the first was to continue using the textdescription field and then just replace any ASCII 13 characters (Line breaks in a email) with html line break characters eg


The second option and the one I've gone for is to use the urn:schemas:httpmail:htmldescription this allows for all the formatting to be retained in the XML file and this displays okay in various RSS feed readers I've tested.

The other functionality added was to change the link section so instead of linking back to the eml file that would take you to OWA if you clicked the link now it will redirect to a ASP file. This ASP file takes in two html querystrings passed in from the link in the RSS Feed and then does a webdav get on the feedfile and returns a webpage representation of that RSS feed entry. This is pretty cool because what it allows you to do is you can publish the feed file and asp file on a external web server and then allow people to access the contents of your Exchange public folders without even needing them to access your Exchange box via OWA.

To cater for the link functionality I've added a GUID node into each item entry based on the DAV:getetag field of each message. (Its possible I may regret using this field as im not 100% sure what its actually for but it was a nice unique number with no wacky characters that i could pass around, other things like Dav:href while unique i found caused problems in certain situations).

Other bug fixes include the RFC822 date fix, I've tried to get rid of all the hardcoded servernames and used two variables that are set at the top of the script instead for the webservername and feedfile name. Some small formatting changes where also made to make it more compatible across multiple RSS feed aggregates.

I recently got some webspace to post the scripts I put up on this blog so I've uploaded the complete code for the eventsink and the showmessage.asp page and they can be downloaded from

To use the showmessage.asp page this needs to be located in the same directory as the feed file (if not you'll need to modify the code). I hope for the next version to do a complied version with a installer so you won't need to know anything about event sinks to use it. Here's the code for the new sink and showmessage.asp.

Sub ExStoreEvents_OnSave(pEventInfo, bstrURLItem, lFlags)

on error resume next
WebServer = "Intranet"
feedfile = "feedpub2.xml"
set DispEvtInfo = pEventInfo
set ADODBRec = DispEvtInfo.EventRecord
set objdom = CreateObject("MICROSOFT.XMLDOM")
Set objField = objDom.createElement("rss")
Set objattID = objDom.createAttribute("version")
objattID.Text = "2.0"
objField.setAttributeNode objattID
objDom.appendChild objField
Set objField1 = objDom.createElement("channel")
objfield.appendChild objField1
Set objField3 = objDom.createElement("link")
objfield3.text = "http://" & WebServer & "/showmessage.asp?xmlfile=" & feedfile & "&message=All"
objfield1.appendChild objField3
Set objField4 = objDom.createElement("title")
objfield4.text = "Public Folder Feed"
objfield1.appendChild objField4
Set objField5 = objDom.createElement("description")
objfield5.text = "Public Folder Feed For Path"
objfield1.appendChild objField5
Set objField6 = objDom.createElement("language")
objfield6.text = "en-us"
objfield1.appendChild objField6
Set objField7 = objDom.createElement("lastBuildDate")
objfield7.text = WeekdayName(weekday(now),3) & ", " & day(now()) & " " & Monthname(month(now()),3) & " " & year(now()) & " " & formatdatetime(now(),4) & ":00 GMT"
objfield1.appendChild objField7
Set Rs = CreateObject("ADODB.Recordset")
Set fso = CreateObject("Scripting.FileSystemObject")
Set msgobj = CreateObject("CDO.Message")
tyear = year(now()-7)
tmonth = month(now()-7)
if tmonth < 10 then tmonth = 0 & tmonth
stday = day(now()-7)
if stday < 10 then stday = 0 & stday
sttime = formatdatetime(now1,4)
qdatest = tyear & "-" & tmonth & "-" & stday & "T"
qdatest1 = qdatest & sttime & ":" & "00Z"
set Rec = CreateObject("ADODB.Record")
set Rec1 = CreateObject("ADODB.Record")
Set Conn = CreateObject("ADODB.Connection")
mailboxurl = ADODBRec.fields("Dav:parentname")
Conn.Provider = "ExOLEDB.DataSource"
Rec.Open mailboxurl, ,3
SSql = "SELECT ""DAV:href"", ""DAV:getetag"", ""DAV:contentclass"", ""urn:schemas:httpmail:htmldescription"", ""urn:schemas:httpmail:datereceived"", "
SSql = SSql & """urn:schemas:httpmail:fromemail"", ""urn:schemas:httpmail:subject"", ""DAV:ishidden"" "
Ssql = SSql & " FROM scope('shallow traversal of """ & mailboxurl & """') "
SSql = SSql & " WHERE (""urn:schemas:httpmail:datereceived"" > CAST(""" & qdatest1 & """ as 'dateTime')) AND ""DAV:isfolder"" = false"
Rs.CursorLocation = 3 'adUseServer = 2, adUseClient = 3
Rs.CursorType = 3 SSql, rec.ActiveConnection, 3
if Rs.recordcount <> 0 then
while not rs.eof
if rs.fields("DAV:ishidden") = 0 then
Set objField2 = objDom.createElement("item")
objfield1.appendChild objField2
Set objField8 = objDom.createElement("guid")
Set objattID8 = objDom.createAttribute("isPermaLink")
objattID8.Text = "false"
objField8.setAttributeNode objattID8
objfield8.text = replace(Rs.fields("DAV:getetag"),chr(34),"")
objfield2.appendChild objField8
Set objField9 = objDom.createElement("title")
objfield9.text = rs.fields("urn:schemas:httpmail:subject")
objfield2.appendChild objField9
Set objField10 = objDom.createElement("link")
objfield10.text = "http://" & WebServer & "/showmessage.asp?xmlfile=" & feedfile & "&message=" & replace(Rs.fields("DAV:getetag"),chr(34),"")
objfield2.appendChild objField10
Set objField11 = objDom.createElement("description")
objfield11.text = Rs.fields("urn:schemas:httpmail:htmldescription")
if objfield11.text = "" then objfield11.text = "Blank"
objfield2.appendChild objField11
Set objField12 = objDom.createElement("author")
objfield12.text = rs.fields("urn:schemas:httpmail:fromemail")
objfield2.appendChild objField12
Set objField13 = objDom.createElement("pubDate")
objfield13.text = WeekdayName(weekday(rs.fields("urn:schemas:httpmail:datereceived")),3) & ", " & day(rs.fields("urn:schemas:httpmail:datereceived")) & " " & Monthname(month(rs.fields("urn:schemas:httpmail:datereceived")),3) & " " & year(rs.fields("urn:schemas:httpmail:datereceived")) & " " & formatdatetime(rs.fields("urn:schemas:httpmail:datereceived"),4) & ":00 GMT"
objfield2.appendChild objField13
set objfield2 = nothing
set objfield8 = nothing
set objfield9 = nothing
set objfield10 = nothing
set objfield11 = nothing
set objfield12 = nothing
set objfield13 = nothing
end if
end if
Set objPI = objDom.createProcessingInstruction("xml", "version='1.0'")
objDom.insertBefore objPI, objDom.childNodes(0)"\\" & Webserver & "\wwwroot\" & feedfile)

End Sub

showmessage.asp file

on error resume next
set xmlfile1 = request.querystring("xmlfile")
xmlfile = "http://" & Request.ServerVariables("SERVER_NAME") &
xmlfile = left(xmlfile,(instr(xmlfile,"showmessage.asp")-1)) & xmlfile1
uid = request.querystring("message")
set xmlobj = server.createobject("microsoft.xmlhttp")
xmlobj.Open "Get", xmlfile, False, "", ""
xmlobj.setRequestHeader "Accept-Language:", "en-us"
xmlobj.setRequestHeader "Content-type:", "text/xml"
set oResponseDoc = xmlobj.responseXML
set oNodeList = oResponseDoc.getElementsByTagName("*")
For i = 0 To (oNodeList.length -2)
set oNode = oNodeList.nextNode
if oNode.Text = uid then
guid = oNode.Text
set oNode = oNodeList.nextNode
Title = oNode.Text
set oNode = oNodeList.nextNode
Link = oNode.Text
set oNode = oNodeList.nextNode
Description = oNode.Text
set oNode = oNodeList.nextNode
Author = oNode.Text
set oNode = oNodeList.nextNode
pubdate = oNode.Text
end if
pubdate = replace(pubdate,"GMT","")
pubdate = cdate(Mid(pubdate,(instr(pubdate,",")+1),len(pubdate)))
set shell = server.createobject("")
strValueName = "HKLM\SYSTEM\CurrentControlSet\Control\TimeZoneInformation\ActiveTimeBias"
minTimeOffset = shell.regread(strValueName)
toffset = datediff("h",DateAdd("n", minTimeOffset, now()),now())
pubdate = dateadd("h",toffset,pubdate)

%><table border="1" cellspacing="1" width="100%" id="table1">
<td>Received: <%=pubdate%></td>
<td>From: <%=author%></td>
<td>Subject: <%=Title%></td>
<td>Message: <%=Description%></td>


Duncan said...

How do I install the script?

Glen said...

To get VBS event sinks going on a Exchange 2003/2000
server you first need to register the script host sink
have a look at . The procedure is the same under 2003. This installs a COM+ object which essentially hosts the VBS script you are going to use. There's is a lot of good documentation in the Exchange SDK (which you can download from ) around using Event sinks. I've also written several articles about using the VBS Event sink on Exchange have a look at.

Anonymous said...

I'm not an Exchange admin, but there is a public folder which I'm interested in viewing as RSS. Is there a way to convert this VB script to some kind of stand-alone application which polls exchange for changes to the public folder, then spits out an RSS feed? Thanks in advance.

Glen said...

Yes just use any of the Exchange API's from Mapi to Webdav. You can use some of the query code from this post but most of the rest of it would require a rewrite. The basic concept are all still the same thought the Exchange SDK has information on who to create querys etc