Tuesday, August 31, 2004

Creating a new folder in a mailbox if one doesn't exist

I've had this question from a few people that wanted to do this in a event sink, its acually really simple to do with a little bit of ADO/Exoledb code.

To create a folder in a mailbox using ADO you can use the adCreateCollection option in your record open statement. The following two lines would create a folder in a mailbox.

set rec = createobject("ADODB.Record")
rec.open "file://./backofficestorage/domain.com/MBX/mailbox/newfolder/", ,3,8192

The options included in the open statement are 3 which is adreadwrite and 8192 which is adCreateCollection (hex 0x2000)

If you try this code and the folder already exists you will get an error returned stating that the object already exists. So if you want to run the above code to create the folder only if the folder doesn't exist and not return an error if it does all you need to do is combine adCreateCollection with adOpenIfExists. eg

set rec = createobject("ADODB.Record")
rec.open "file://./backofficestorage/domain.com/MBX/mailbox/newfolder/", ,3,33562624

33562624 is the sum of adCreateCollection (hex 0x2000) and adOpenIfExists (hex 0x2000000)


Friday, August 27, 2004

vCalendar with CDO and Script

I’ve been playing with vCalendar and iCalendar with Exchange to solve a few problems and I found it was pretty interesting so I decided to write about a few things I’ve learned.

Background

Some good background information on vCalendar can be found here

vCalendar and Outlook (good general background on what it is)

IMC Product Development Information (This is the best site for vCalendar info and contains documentation of the current implementation)

IMC ietf-calendar page (Good read on iCalendar)

And last but not least this from the exchange SDK

Basically with Exchange each appointment in your calendar has a vCalendar formatted body part.

Putting it to use.

There are plenty of things you can do with vCalendar formated files the most obvious is to use them to import and export calendar appointments where other methods can’t be used. A simple CDO/ADO script that would go though and export all the appointments in a calendar for the past year (past and future) to separate vcs files goes something like this.


Set Rs = CreateObject("ADODB.Recordset")
set Rec = CreateObject("ADODB.Record")
Set Conn = CreateObject("ADODB.Connection")
set msgobj = CreateObject("CDO.message")
set stm1 = CreateObject("ADODB.stream")
calendarurl = "file://./backofficestorage/yourdoman.com/MBX/user/calendar/"
Conn.Provider = "ExOLEDB.DataSource"
Rec.Open calendarurl, ,3
SSql = "Select ""DAV:href"", ""DAV:displayname"" "
SSql = SSql & " FROM scope('shallow traversal of """ & calendarurl & """') "
SSql = SSql & "WHERE (""urn:schemas:calendar:dtstart"" >= CAST(""2004-01-01T00:00:00Z"" as 'dateTime')) "
SSql = SSql & "AND (""urn:schemas:calendar:dtstart"" < CAST(""2005-01-01T00:00:00Z"" as 'dateTime'))"
SSql = SSql & " AND ""DAV:contentclass"" = 'urn:content-classes:appointment' ORDER BY ""urn:schemas:calendar:dtstart"" ASC"
Rs.CursorLocation = 3 'adUseServer = 2, adUseClient = 3
Rs.CursorType = 3
rs.open SSql, rec.ActiveConnection, 3
if Rs.recordcount <> 0 then
Rs.movefirst
while not rs.eof
msgobj.datasource.open rs.fields("DAV:href")
savefile = "d:\vcsexp\" & replace(lcase(rs.fields("DAV:displayname")),".eml",".vcs")
set stm = msgobj.getstream
mstream = stm.readtext
vstream = mid(mstream,instr(mstream,"BEGIN:VCALENDAR"),(instr(mstream,"END:VCALENDAR")+13)-instr(mstream,"BEGIN:VCALENDAR"))
set stm1 = CreateObject("ADODB.stream")
stm1.open
stm1.type = 2
stm1.Charset = "x-ansi"
stm1.writetext vstream,0
stm1.savetofile savefile
set stm1 = nothing
rs.movenext
wend
end if


Because vCalendar is a defined format parsing this out of the message stream is pretty easy it’s just a case of starting at the BEGIN:VCALENDAR and stopping at the END:VCALENDAR. Once you have the files you should then be able to import them into another program that supports vCalendar (but don’t quote me on this).

Importing a vCalendar (VCS file) into a calendar using CDO

This was a little tricky but this is one method I found that worked, it involves first creating a CDO calendar message adding the vcs file as a body part and then saving the calendar message temporary to the inbox. Then all you need to do is open this new calendar message and process it like a normal appointment request by using the accept method of the icalendarmessage interface and then save it (then delete the original message). I created the following function to do this

function importtocal(fname)
set calmes = createobject("CDO.calendarmessage")
set calmes2 = createobject("CDO.calendarmessage")
set rec = createobject("ADODB.Record")
set stm = createobject("ADODB.Stream")
Randomize ' Initialize random-number generator.
rndval = Int((20000000000 * Rnd) + 1)
set calmes1 = calmes.message
stm.open
stm.type = 2
stm.Charset = "x-ansi"
stm.loadfromfile fname
Set iBp = calmes1.BodyPart.AddBodyPart
ibp.ContentClass = "urn:content-classes:calendarmessage"
ibp.ContentMediaType = "text/calendar"
Set Strm = iBp.GetDecodedContentStream
vstream = stm.readtext
Strm.WriteText vstream
Strm.Flush
tmpfname = "file://./backofficestorage/domain.com/MBX/user/Inbox/" & day(now) & month(now) & year(now) & hour(now) & minute(now) & rndval & ".eml"
calurl = "file://./backofficestorage/domain.com/MBX/user/Calendar/"
calmes.datasource.saveto tmpfname
calmes2.datasource.open tmpfname, ,3
For Index = 1 To calmes2.CalendarParts.Count
Set iCalPart = calmes2.CalendarParts(Index)
Set iAppt = iCalPart.GetUpdatedItem(calurl)
iAppt.accept
iAppt.datasource.savetocontainer calurl
Next
rec.open tmpfname, ,3
rec.deleterecord

end function

So to import all the files created by the export script you could front it with the following code.

on error resume next
set fso = createobject("scripting.filesystemobject")
set f = fso.getfolder("d:\vcsexp")
Set fc = f.Files
For Each file1 in fc
importtocal(file1.path)
next

Parsing the vCalendar format

Another thing that vCalendar information can come in handy for sometimes is to access information about an appointment (or meeting) that you may not be able to get using other properties. One such property is the email address of a meeting resource if you are trying to access it remotely with WebDAV. When you have a meeting that uses a resource the BCC property of the message is used to store the address information about the resource. With WebDAV your access to the recipient’s collection of a appointment is limited and you can only ever see the displayname of your resource. So one potential way to solve this is you can get the appointments stream using a WebDAV GET and then parse the attendees of the meeting and extract the resources email address.

Some things you need to keep in mind when parsing the vCalendar format is individual lines in a vCalendar file are delimited using a CRLF but long lines are split using the RFC 822 “folding” technique. This means if you have an email address that doesn’t quite fit on a line with the other text instead of taking the address to the next line it splits the address and put CR/LF immediately followed by an LWSP-character. (which is a fancy name for a Enter then a space). Have a look at this if your interested

What this means is that if you want to parse the information successfully you need to first unfold the data. I found that just doing a replace on any CRLF + Space combinations did the trick for me. The following sample goes though the attendees of a meeting using WebDAV and returns the email address of the resource account by parsing out the vCalendar information.


set Req = createobject("Microsoft.XMLHTTP")
Req.open "GET", "http://yourserver/exchange/mailbox/Calendar/test-5.EML", false
Req.setRequestHeader "Translate","f"
Req.send
attendeearry = split(req.responsetext,"ATTENDEE;",-1,1)
for i = 1 to ubound(attendeearry)
string1 = vbcrlf & " "
stparse = replace(attendeearry(i),string1,"")
attaddress = mid(stparse,(instr(stparse,"MAILTO:")+7),instr(stparse,chr(13)))
attaddress = mid(attaddress,1,instr(attaddress,vbcrlf))
if instr(stparse,"=RESOURCE") then
wscript.echo attaddress
end if
next


Wednesday, August 18, 2004

Calendar RSS feed Event sink

Somebody emailed me about using the public folder RSS event sink from one of my previous posts on a mailbox calendar. This sounded like a pretty cool idea and I could see some good applications so I decided to blog what I came up with in response to this.

A few things need to be changed from the original script the main one would be instead of the sink generating a feed of the last 7 days worth of posts in a public folder you would want it to generate a feed of the next 7 days worth of appointments in the calendar. Also some of the email fields needed to be dumped in favor of appointment start and end times. The third thing that needs to be done was to add some code to do a timezone adjustment because Exchange stores all appointment start and end times in UTC format. And last but not least a function was added to convert the adjusted query date values into ISO date format which is required for the Exoledb SQL query string. The Query string itself was completely rewritten to grab appointments that had a start date within the next 7 days. (Note you could have gone for end date as well if you wanted to catch appointments that where already in process or appointments that where multi-day events).

I fixed a few issues with the old code (most relating to reading this feed in RSS Bandit) I've fixed the pubdate xml field so It generates a reliable RFC822 date format field. I've also fixed the empty URI value of the feed link.

The code is written to create links based on a mailbox but you could also change the code so it could be used in a shared calendar in a public folder by changing the following line of code (note you need to at least change the servername)

objfield9.text = "http://servname/exchange" & right(Rs.fields("Dav:href"),(len(Rs.fields("Dav:href"))-instr(Rs.fields("Dav:href"),"/MBX/"))-3)

Change "/MBX/" to "/Public Folders/"

Anyway here's the script (ps watch the cut and paste its still pretty terrible)

Sub ExStoreEvents_OnSave(pEventInfo, bstrURLItem, lFlags)

on error resume next
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("title")
objfield3.text = "Calendar Folder Feed"
objfield1.appendChild objField3
Set objField4 = objDom.createElement("link")
objfield4.text = "http://servername/exchange" & right(ADODBRec.fields("Dav:parentname"),(len(ADODBRec.fields("Dav:parentname"))-instr(ADODBRec.fields("Dav:parentname"),"/MBX/"))-3)
objfield1.appendChild objField4
Set objField5 = objDom.createElement("description")
objfield5.text = "Calendar 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 shell = CreateObject("WScript.Shell")
strValueName = "HKLM\SYSTEM\CurrentControlSet\Control\TimeZoneInformation\ActiveTimeBias"
minTimeOffset = shell.regread(strValueName)
toffset = datediff("h",DateAdd("n", minTimeOffset, now()),now())
dtListFrom = DateAdd("n", minTimeOffset, now())
dtListTo = isodateit(DateAdd("d",7,dtListFrom))
dtListFrom = isodateit(dtListFrom)
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"", ""urn:schemas:httpmail:subject"", ""urn:schemas:calendar:dtstart"", ""urn:schemas:calendar:dtend"", "
SSql = SSql & " ""urn:schemas:calendar:organizer"", ""urn:schemas:calendar:location"", ""DAV:contentclass"", "
SSql = SSql & " ""urn:schemas:httpmail:textdescription"", ""urn:schemas:httpmail:fromemail"", ""DAV:ishidden"" "
SSql = SSql & " FROM scope('shallow traversal of """ & mailboxurl & """') "
SSql = SSql & "WHERE (""urn:schemas:calendar:dtstart"" >= CAST(""" & dtListFrom & """ as 'dateTime')) "
SSql = SSql & "AND (""urn:schemas:calendar:dtstart"" < ssql =" SSql" cursorlocation =" 3" aduseserver =" 2," aduseclient =" 3" cursortype =" 3"> 0 then
Rs.movefirst
while not rs.eof
if rs.fields("DAV:ishidden") = 0 then
Set objField2 = objDom.createElement("item")
objfield1.appendChild objField2
Set objField8 = objDom.createElement("title")
objfield8.text = rs.fields("urn:schemas:httpmail:subject")
objfield2.appendChild objField8
Set objField9 = objDom.createElement("link")
objfield9.text = "http://servername/exchange" & right(Rs.fields("Dav:href"),(len(Rs.fields("Dav:href"))-instr(Rs.fields("Dav:href"),"/MBX/"))-3)
objfield2.appendChild objField9
Set objField10 = objDom.createElement("description")
if isnull(Rs.fields("urn:schemas:httpmail:textdescription")) then
Etext = "Starts : " & dateadd("h",toffset,rs.fields("urn:schemas:calendar:dtstart")) & "<br>" Etext = Etext & "Ends : " & dateadd("h",toffset,rs.fields("urn:schemas:calendar:dtend")) & "<br>"

Etext = Etext & "Location : " & rs.fields("urn:schemas:calendar:location")
objfield10.text = Etext
else
Etext = "Starts : " & dateadd("h",toffset,rs.fields("urn:schemas:calendar:dtstart")) & "<br>"
Etext = Etext & "Ends : " & dateadd("h",toffset,rs.fields("urn:schemas:calendar:dtend")) & "<br>"
Etext = Etext & "Location : " & rs.fields("urn:schemas:calendar:location") & "<br><br>"
Etext = Etext & Rs.fields("urn:schemas:httpmail:textdescription")
objfield10.text = Etext
end if
objfield2.appendChild objField10
Set objField11 = objDom.createElement("author")
objfield11.text = rs.fields("urn:schemas:httpmail:fromemail")
objfield2.appendChild objField11
Set objField12 = objDom.createElement("pubDate")
dtstartd = rs.fields("urn:schemas:calendar:dtstart")
objfield12.text = WeekdayName(weekday(dtstartd),3) & ", " & day(dtstartd) & " " & Monthname(month(dtstartd),3) & " " & year(dtstartd) & " " & formatdatetime(rs.fields("urn:schemas:calendar:dtstart"),4) & ":00 GMT"
objfield2.appendChild objField12
set objfield2 = nothing
set objfield8 = nothing
set objfield9 = nothing
set objfield10 = nothing
set objfield11 = nothing
end if
rs.movenext
wend
end if
rs.close
Set objPI = objDom.createProcessingInstruction("xml", "version='1.0'")
objDom.insertBefore objPI, objDom.childNodes(0)
objdom.save("\\servername\inetpub\calpub.xml")

End Sub

function isodateit(datetocon)
strDateTime = year(datetocon) & "-"
if (Month(datetocon) < 10) then strDateTime = strDateTime & "0"
strDateTime = strDateTime &amp;amp;amp; Month(datetocon) & "-"
if (Day(datetocon) < 10) then strDateTime = strDateTime & "0"
strDateTime = strDateTime &amp;amp; Day(datetocon) & "T" & formatdatetime(datetocon,4) & ":00Z"
isodateit = strDateTime
end function

[Sorry about the edits blogger keep eating the function ]

Friday, August 13, 2004

Loading a Message in CDO from a text variable

This is something i learned today,

Loading a message from a file is well know and documented here using the ADO stream object loadfromfile method. But what if say instead of the message being stored in a serialized format in a eml file its stored exactly the same way in a SQL database.

The way I found that worked was to first create a new stream object and open it, write the text into the stream using stream.writetext (in this case it was a serialized version of a email exactly the same as a eml file yet stored in a database field). An then you flip the stream type to binary which converts the stream to binary for you and then you can use the normal open message from ado stream method. Here's what it look likes

set stm = createobject("ADODB.Stream")
set msgobj = createobject("CDO.Message")
stm.open
msgstring = rs.fields("messagebody")
stm.type = 2
stm.Charset = "x-ansi"
stm.writetext msgstring,0
stm.Position = 0
stm.type = 1
msgobj.datasource.openobject Stm, "_Stream"


Tuesday, August 10, 2004

Using X headers with Exchange

X-headers are user defined fields that can (and are) inserted into a mail header that can serve a number of roles and purposes. Some common ones that are used are x-mailer which descibes the name of the software used to send that email and x-scl which is used to store the IMF SCL value when a message is archived to the ucearchive directory by the IMF (note this is not used to pass the SCL between servers this is done though the xexch50 blob during message transfer).

If you want to make use of a x-header in a Exchange sink or CDO script its pretty easy. First off all you need to know is what the name of the x-header is. If your not sure i find the best way to find out is to look at a serial version of the email. For this you can save the message to a eml file using a script like this and then open the eml file in notepad.

set msgobj = createobject("CDO.Message")
msgobj.datasource.open mailurl
set stm = msgobj.getstream()
stm.savetofile "d:\myemail.eml"

Once you know what the X header field name is to retrieve or set a X header in a sink or script all you need to do is append the name of the x header to urn:schemas:mailheader: . For example one way of telling if a email is a delivery report of some sort is to see if X-DSNContext is set in the header of a message for example

set msgobj = createobject("CDO.Message")
msgobj.datasource.open mailurl

if msgobj.fields("urn:schemas:mailheader:X-DSNContext") <> "" then
Wscript.echo "Delivery Report"
else
Wscript.echo "Normal"
end if

If you want to create your own X-header in a SMTP event sink (say you wanted this to be processed by another sink somewhere else). It would look like this

Sub ISMTPOnArrival_OnArrival(ByVal Msg, EventStatus )

on error resume next
msg.fields("urn:schemas:mailheader:X-myfield") = "Email-Okay"
msg.fields.update
msg.datasource.save

End Sub

Wednesday, August 04, 2004

Detecting BCC's with a SMTP event sink

A couple of weeks ago I blogged this about BCC's and CDOEX, One of the questions that comes up when you start to deal in BCC's is can you detect a BCC programmatically for instance in a anti-spam event sink or if you are worried about confidentiality in an email that was sent. The answer is kind of. For instance you could implement a SMTP event sink on your forward facing Exchange /SMTP box that could detect if a email comings into your organization was being BCC to anyone in your domain. You do this by using the http://schemas.microsoft.com/cdo/smtpenvelope/recipientlist envelope field. This field will contain a list of all the recipients of a message that was submitted by the client (or sending mail server) before expansion of the address has been performed (or categorization in Exchange speak). On a inbound message this would only be the recipients that where in your domain that the SMTP server could deliver to. If you where to compare the recipientlist to the to and cc fields of the message and find any address's that are on the recipeintlist but not in the to and cc fields then you most probably have a BCC. Here's a sample on_arrival sink that would do this

Sub ISMTPOnArrival_OnArrival(ByVal Msg, EventStatus )
on error resume next
Dim RecpList
recplist = LCase(Msg.EnvelopeFields("http://schemas.microsoft.com/cdo/smtpenvelope/recipientlist"))
recparray = split(recplist,";",-1,1)
Set fso = CreateObject("Scripting.FileSystemObject")
set wfile = fso.opentextfile("d:\RECPT.txt",8,true)
for i = lbound(recparray) to ubound(recparray)
if instr(msg.to,replace(recparray(I),"smtp:","")) then
else
if instr(msg.cc,replace(recparray(I),"smtp:","")) then
else
wfile.writeline("BCC Detected " & recparray(I))
end if
end if
next
wfile.close
set wfile = nothing
End Sub


Now this would also work on outgoing mail by finding any BCC's that weren't from your own domain (which would have probably been delivered and removed from the recipientlist). The place that this falls down is it doesn't detect BCC's that wheren't sent to another domain. Say if the message had been sent to you and BCC'd to a yahoo or hotmail account the Recipeintlist won't contain entries for the yahoo or hotmail account. (this would be different if the mail was going outbound from your server where it would contain those entries.)