Monday, December 20, 2004

Showing how much whitepace is in your database via script

Continuing on from some of my last weeks entries,

When the Information Store maintenance process runs it logs to the windows eventlogs the results of its retention and de-fragmentation operations. More importantly it tells you how much space is held in deleted item retention (and how much it just released). How much space is held in deleted mailbox retention and how much it just released. And finally how much free-space there is in the database after the online de-fragmentation has just run.

So what this script does is query AD for all the mail and public folder stores in your domain. Then it querys each servers event log for 3 specific events that contain the details of the 3 maintenance operations and then parses the result out of that text and displays the result at the commandline. Event “1221” is logged after an online de-fragmentation is run on a mailbox or public folder store. Event “1027” is logged after the deleted item retention cleanup is done and the result of starting and ending size and numbers is logged. Event “9535” is logged after the deleted mailbox cleanup is run and logs the number and size of deleted mailboxes retained and purged.

To identify each mailstore within the eventlog exchange uses a format storagegroup\mailboxstore. This format isn’t stored in Active directory anywhere (easy) so I had to build it from the Active Directory DN path. This should all work fine as long as you don’t have any “,” in your mailstore name (this is going to break the split).

I’ve post a downloadable copy of the script here

The code looks like

set conn = createobject("ADODB.Connection")
set com = createobject("ADODB.Command")
Set iAdRootDSE = GetObject("LDAP://RootDSE")
strNameingContext = iAdRootDSE.Get("configurationNamingContext")
rangeStep = 999
lowRange = 0
highRange = lowRange + rangeStep
Conn.Provider = "ADsDSOObject"
Conn.Open "ADs Provider"
mbQuery = ";(objectCategory=msExchPrivateMDB);name,distinguishedName;subtree"
pfQuery = ";(objectCategory=msExchPublicMDB);name,distinguishedName;subtree"
Com.ActiveConnection = Conn
Com.CommandText = mbQuery
Set Rs = Com.Execute
Wscript.echo "Mailbox Stores"
Wscript.echo
While Not Rs.EOF
objmailstorename = "LDAP://" & Rs.Fields("distinguishedName")
set objmailstore = getObject(objmailstorename)
servername = mid(objmailstore.msExchOwningServer,4,instr(objmailstore.msExchOwningServer,",")-4)
dnarray = split(Rs.Fields("distinguishedName"),",",-1,1)
sgname = mid(dnarray(1),4) & "\" & mid(dnarray(0),4)
Dbfreespace = queryeventlog(servername,sgname,"1221")
Wscript.echo Rs.Fields("name") & " Freespace after Defrag : " & Dbfreespace
Dbreten = queryeventlog(servername,sgname,"1207")
mbreten = queryeventlog(servername,sgname,"9535")
wscript.echo
Rs.MoveNext

Wend
Wscript.echo "Public Folder Stores"
Wscript.echo
Com.CommandText = pfQuery
Set Rs1 = Com.Execute
While Not Rs1.EOF
objmailstorename = "LDAP://" & Rs1.Fields("distinguishedName")
set objmailstore = getObject(objmailstorename)
servername = mid(objmailstore.msExchOwningServer,4,instr(objmailstore.msExchOwningServer,",")-4)
dnarray1 = split(Rs1.Fields("distinguishedName"),",",-1,1)
sgname = mid(dnarray1(1),4) & "\" & mid(dnarray1(0),4)
Dbfreespace = queryeventlog(servername,sgname,"1221")
Wscript.echo Rs1.Fields("name") & " Freespace after Defrag : " & Dbfreespace
Dbreten = queryeventlog(servername,sgname,"1207")
wscript.echo
Rs1.MoveNext

Wend
Rs.Close
Rs1.close
Conn.Close
Set Rs = Nothing
Set Rs1 = Nothing
Set Com = Nothing
Set Conn = Nothing


function queryeventlog(servername,sgname,event2s)
SB = 0
dtmStartDate = CDate(Date) - 7
dtmStartDate = Year(dtmStartDate) & Right( "00" & Month(dtmStartDate), 2) & Right( "00" & Day(dtmStartDate), 2)
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & servername & "\root\cimv2")
Set colLoggedEvents = objWMIService.ExecQuery("Select * from Win32_NTLogEvent Where Logfile='Application' and Eventcode = '" & event2s & "' and TimeWritten >= '" & dtmStartDate & "' ",,48)
For Each objEvent in colLoggedEvents
SB = 1
Time_Written = objEvent.TimeWritten
Time_Written = left(Time_Written,(instr(Time_written,".")-1))
if instr(objEvent.Message,sgname) then
if event2s = "1221" then
queryeventlog = Mid(objEvent.Message,InStr(15,objEvent.Message,chr(34))+6,(InStr(1,objEvent.Message,"megabytes")-1)-(InStr(15,objEvent.Message,chr(34))+6))
else
if event2s = "1207" then
StartItems = Mid(objEvent.Message,InStr(82,objEvent.Message,chr(34))+13,(InStr(82,objEvent.Message,"items;")-(InStr(82,objEvent.Message,chr(34))+14)))
StartSize = Mid(objEvent.Message,(InStr(objEvent.Message,"items;")+7),InStr((InStr(objEvent.Message,"items;")+7),objEvent.Message," ")-(InStr(objEvent.Message,"items;")+7))
End_Items = Mid(objEvent.Message,(InStr(objEvent.Message,"End:")+5),InStr((InStr(objEvent.Message,"End:")+5),objEvent.Message," ")-(InStr(objEvent.Message,"End:")+5))
End_Size = Mid(objEvent.Message,(InStr((InStr(objEvent.Message,"End:")+5),objEvent.Message,"items;")+7),InStr((InStr((InStr(objEvent.Message,"End:")+5),objEvent.Message,"items;")+7),objEvent.Message," ")-(InStr((InStr(objEvent.Message,"End:")+5),objEvent.Message,"items;")+7))
Wscript.echo "Retained StartItems : " & StartItems & " StartSize : " & formatnumber(StartSize/1024,2)
Wscript.echo "Retained EndItems : " & End_Items & " EndSize : " & formatnumber(End_Size/1024,2)
else
Deleted_Number = Mid(objEvent.Message,InStr(88,objEvent.Message,".")+5,InStr(88,objEvent.Message,"deleted")-1-(InStr(88,objEvent.Message,".")+5))
Deleted_Size = Mid(objEvent.Message,(InStr(88,objEvent.Message,"deleted")+19),InStr(InStr(88,objEvent.Message,"deleted")+19,objEvent.Message," ")-(InStr(88,objEvent.Message,"deleted")+19))
Retained_Number = Mid(objEvent.Message,InStr(88,objEvent.Message,"removed.")+12,InStr(InStr(88,objEvent.Message,"removed.")+8,objEvent.Message,"deleted")-(InStr(88,objEvent.Message,"removed.")+12))
Retained_Size = Mid(objEvent.Message,InStr((InStr(88,objEvent.Message,"removed.")+8),objEvent.Message,"mailboxes")+11,InStr(InStr((InStr(88,objEvent.Message,"removed.")+8),objEvent.Message,"mailboxes")+11,objEvent.Message," ")-(InStr((InStr(88,objEvent.Message,"removed.")+8),objEvent.Message,"mailboxes")+11))
wscript.echo "Number of Deleted Mailboxs Removed : " & Deleted_Number & " Size : " & formatnumber(Deleted_Size/1024,2)
wscript.echo "Number of Deleted Mailboxs Retained : " & Retained_Number & " Size : " & formatnumber(Retained_Size/1024,2)
end if
end if
exit for
end if
next
if SB = 0 then queryeventlog = "No Backup recorded in the last 7 Days"
end function

Tuesday, December 14, 2004

Finding when a Exchange Store last backed up via script

There are a couple of ways you can determine when the last time a particular exchange store was backed up if you're using a program that backs up via the Exchange Backup API (Veritas,Brightstore etc).

With Exchange 2003 a new function was added into System Manager to allow you to see the "Time of Last Full Backup" on the database tab. This property is also available in CDOEXM (if you have the 2003 version of system manager loaded on the machine). The ".LastFullBackupTime" property was added to the IMailStoreDB and IPublicStoreDB interfaces. Using this is pretty easy all you have to do is to open the mailstore using the LDAP DN path and access the property eg

set mdbobj = createobject("CDOEXM.MailboxStoreDB")
mdbobj.datasource.open "LDAP://mbdDNpath"
Wscript.echo "Last Backed Up : " & mdbobj.LastFullBackupTime

I've put this together with a similar query from my previous post and this script selects all the exchange stores in a domain and reports when the last time they where backed up. I've posted the code here (this will on work on Exchange 2003)

Another method you can use to do this is to query the eventlog on each of your servers and look for each of the 221 completion events for each of the database files. When the backup runs on a Exchange server you get a bunch of really useful events that tell you when the backup started, how much was backed up and when it finished. In this script im focusing on the finished events which include the path to the database file. So if I combine it with the script from my previous post which was already getting the server name and file path of each of the database files. You end up with a script that will query Active directory for every mail and public folder store then query the event log via WMI to work out when the last time a backup occurred of each file and display the result on the commandline. Note I've limited the search range to the last 7 days so if a server hasn't backed up in the last 7 days you receive a no backup recorded message. This was done to keep the time it takes to run the script to a minumn as searching through a really large event log can be very time consuming. I've posted a copy of the script here The code look like


set conn = createobject("ADODB.Connection")
set com = createobject("ADODB.Command")
Set iAdRootDSE = GetObject("LDAP://RootDSE")
strNameingContext = iAdRootDSE.Get("configurationNamingContext")
rangeStep = 999
lowRange = 0
highRange = lowRange + rangeStep
Conn.Provider = "ADsDSOObject"
Conn.Open "ADs Provider"
mbQuery = ";(objectCategory=msExchPrivateMDB);name,distinguishedName;subtree"
pfQuery = ";(objectCategory=msExchPublicMDB);name,distinguishedName;subtree"
Com.ActiveConnection = Conn
Com.CommandText = mbQuery
Set Rs = Com.Execute
Wscript.echo "Mailbox Stores"
Wscript.echo
While Not Rs.EOF
objmailstorename = "LDAP://" & Rs.Fields("distinguishedName")
set objmailstore = getObject(objmailstorename)
servername = mid(objmailstore.msExchOwningServer,4,instr(objmailstore.msExchOwningServer,",")-4)
slvlastbackuped = queryeventlog(servername,objmailstore.msExchSLVFile)
edblastbackuped = queryeventlog(servername,objmailstore.msExchEDBFile)
Wscript.echo Rs.Fields("name") & " Last Backed up EDB : " & edblastbackuped
Wscript.echo Rs.Fields("name") & " Last Backed up STM : " & slvlastbackuped
wscript.echo
Rs.MoveNext

Wend
Wscript.echo "Public Folder Stores"
Wscript.echo
Com.CommandText = pfQuery
Set Rs1 = Com.Execute
While Not Rs1.EOF
objmailstorename = "LDAP://" & Rs1.Fields("distinguishedName")
set objmailstore = getObject(objmailstorename)
servername = mid(objmailstore.msExchOwningServer,4,instr(objmailstore.msExchOwningServer,",")-4)
slvlastbackuped = queryeventlog(servername,objmailstore.msExchSLVFile)
edblastbackuped = queryeventlog(servername,objmailstore.msExchEDBFile)
Wscript.echo Rs1.Fields("name") & " Last Backed up EDB : " & edblastbackuped
Wscript.echo Rs1.Fields("name") & " Last Backed up STM : " & slvlastbackuped
wscript.echo
Rs1.MoveNext

Wend
Rs.Close
Rs1.close
Conn.Close
Set Rs = Nothing
Set Rs1 = Nothing
Set Com = Nothing
Set Conn = Nothing


function queryeventlog(servername,filename)
SB = 0
dtmStartDate = CDate(Date) - 7
dtmStartDate = Year(dtmStartDate) & Right( "00" & Month(dtmStartDate), 2) & Right( "00" & Day(dtmStartDate), 2)
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & servername & "\root\cimv2")
Set colLoggedEvents = objWMIService.ExecQuery("Select * from Win32_NTLogEvent Where Logfile='Application' and Eventcode = '221' and TimeWritten >= '" & dtmStartDate & "' ",,48)
For Each objEvent in colLoggedEvents
SB = 1
Time_Written = objEvent.TimeWritten
Time_Written = left(Time_Written,(instr(Time_written,".")-1))
if instr(objEvent.Message,filename) then
queryeventlog = dateserial(mid(Time_Written,1,4),mid(Time_Written,5,2),mid(Time_Written,7,2)) & " " & timeserial(mid(Time_Written,9,2),mid(Time_Written,11,2),mid(Time_Written,13,2))
exit for
end if
next
if SB = 0 then queryeventlog = "No Backup recorded in the last 7 Days"
end function

Listing the file sizes of all Exchange Stores on all Exchange Servers in a Domain V2

[updated fixed new bug when there's more then one mailbox store on a server]

I've had a bit of feedback about the first version of the script that i posted here so I decided to give it a quick revise and add some additional functionality. The additional functionality added to this script is that instead of just returning the size of each store file it also now returns the freespaces left of the disk where the file is located and the percentage of the diskspace that is free. Also there are some fixes for it to allow the script to work when there are more then 1000 mailboxes. I've posted a copy of the new code up here

set conn = createobject("ADODB.Connection")
set com = createobject("ADODB.Command")
Set iAdRootDSE = GetObject("LDAP://RootDSE")
strNameingContext = iAdRootDSE.Get("configurationNamingContext")
rangeStep = 999
lowRange = 0
highRange = lowRange + rangeStep
Conn.Provider = "ADsDSOObject"
Conn.Open "ADs Provider"
mbQuery = ";(objectCategory=msExchPrivateMDB);name,distinguishedName;subtree"
pfQuery = ";(objectCategory=msExchPublicMDB);name,distinguishedName;subtree"
Com.ActiveConnection = Conn
Com.CommandText = mbQuery
Set Rs = Com.Execute
Wscript.echo "Mailbox Stores"
Wscript.echo
While Not Rs.EOF
objmailstorename = "LDAP://" & Rs.Fields("distinguishedName")
mbnum = 0
quit = false
rangeStep = 999
lowRange = 0
highRange = lowRange + rangeStep
set objmailstore = getObject(objmailstorename)
Do until quit = true
on error resume next
strCommandText = "homeMDBBL;range=" & lowRange & "-" & highRange
objmailstore.GetInfoEx Array(strCommandText), 0
if err.number <> 0 then quit = true
varReports = objmailstore.GetEx("homeMDBBL")
if quit <> true then mbnum = mbnum + ubound(varReports)+1
lowRange = highRange + 1
highRange = lowRange + rangeStep
loop
err.clear
Set fso = CreateObject("Scripting.FileSystemObject")
edbfilespec = "\\" & mid(objmailstore.msExchOwningServer,4,instr(objmailstore.msExchOwningServer,",")-4) & "\" & left(objmailstore.msExchEDBFile,1) & "$" & mid(objmailstore.msExchEDBFile,3,len(objmailstore.msExchEDBFile)-2)
stmfilespec = "\\" & mid(objmailstore.msExchOwningServer,4,instr(objmailstore.msExchOwningServer,",")-4) & "\" & left(objmailstore.msExchSLVFile,1) & "$" & mid(objmailstore.msExchSLVFile,3,len(objmailstore.msExchSLVFile)-2)
Set efile = fso.GetFile(edbfilespec)
set sfile = fso.GetFile(stmfilespec)
edbsize = formatnumber(efile.size/1073741824,2,0,0,0)
stmsize = formatnumber(sfile.size/1073741824,2,0,0,0)
set edrive = fso.GetDrive("\\" & mid(objmailstore.msExchOwningServer,4,instr(objmailstore.msExchOwningServer,",")-4) & "\" & left(objmailstore.msExchEDBFile,1) & "$")
set sdrive = fso.GetDrive("\\" & mid(objmailstore.msExchOwningServer,4,instr(objmailstore.msExchOwningServer,",")-4) & "\" & left(objmailstore.msExchSLVFile,1) & "$")
edbtotalspace = round(edrive.totalsize/1073741824)
edbfreespace = round(edrive.FreeSpace/1073741824)
edbpercentleft = FormatNumber((edbfreespace/edbtotalspace)*100, 0)
stmtotalspace = round(sdrive.totalsize/1073741824)
stmfreespace = round(sdrive.FreeSpace/1073741824)
stmpercentleft = FormatNumber((stmfreespace/stmtotalspace)*100, 0)
Wscript.echo Rs.Fields("name") & "# Mailboxes: " & mbnum & " EDBSize(GB): " & edbsize & " STMSize(GB): " & stmsize
wscript.echo "Freespace on EDB Drive (" & left(objmailstore.msExchEDBFile,1) & ":) :" & edbfreespace & " GB Percent Left :" & edbpercentleft & " %"
wscript.echo "Freespace on STM Drive (" & left(objmailstore.msExchSLVFile,1) & ":) :" & stmfreespace & " GB Percent Left :" & stmpercentleft & " %"
wscript.echo
Rs.MoveNext

Wend
Wscript.echo "Public Folder Stores"
Wscript.echo
Com.CommandText = pfQuery
Set Rs1 = Com.Execute
While Not Rs1.EOF
objmailstorename = "LDAP://" & Rs1.Fields("distinguishedName")
set objmailstore = getObject(objmailstorename)
Set fso = CreateObject("Scripting.FileSystemObject")
edbfilespec = "\\" & mid(objmailstore.msExchOwningServer,4,instr(objmailstore.msExchOwningServer,",")-4) & "\" & left(objmailstore.msExchEDBFile,1) & "$" & mid(objmailstore.msExchEDBFile,3,len(objmailstore.msExchEDBFile)-2)
stmfilespec = "\\" & mid(objmailstore.msExchOwningServer,4,instr(objmailstore.msExchOwningServer,",")-4) & "\" & left(objmailstore.msExchSLVFile,1) & "$" & mid(objmailstore.msExchSLVFile,3,len(objmailstore.msExchSLVFile)-2)
Set efile = fso.GetFile(edbfilespec)
set sfile = fso.GetFile(stmfilespec)
edbsize = formatnumber(efile.size/1073741824,2,0,0,0)
stmsize = formatnumber(sfile.size/1073741824,2,0,0,0)
set edrive = fso.GetDrive("\\" & mid(objmailstore.msExchOwningServer,4,instr(objmailstore.msExchOwningServer,",")-4) & "\" & left(objmailstore.msExchEDBFile,1) & "$")
set sdrive = fso.GetDrive("\\" & mid(objmailstore.msExchOwningServer,4,instr(objmailstore.msExchOwningServer,",")-4) & "\" & left(objmailstore.msExchSLVFile,1) & "$")
edbtotalspace = round(edrive.totalsize/1073741824)
edbfreespace = round(edrive.FreeSpace/1073741824)
edbpercentleft = FormatNumber((edbfreespace/edbtotalspace)*100, 0)
stmtotalspace = round(sdrive.totalsize/1073741824)
stmfreespace = round(sdrive.FreeSpace/1073741824)
stmpercentleft = FormatNumber((stmfreespace/stmtotalspace)*100, 0)
Wscript.echo Rs1.Fields("name") & " EDBSize(GB): " & edbsize & " STMSize(GB): " & stmsize
wscript.echo "Freespace on EDB Drive (" & left(objmailstore.msExchEDBFile,1) & ":) :" & edbfreespace & " GB Percent Left :" & edbpercentleft & " %"
wscript.echo "Freespace on STM Drive (" & left(objmailstore.msExchSLVFile,1) & ":) :" & stmfreespace & " GB Percent Left :" & stmpercentleft & " %"
wscript.echo
Rs1.MoveNext

Wend
Rs.Close
Rs1.close
Conn.Close
Set Rs = Nothing
Set Rs1 = Nothing
Set Com = Nothing
Set Conn = Nothing

Monday, December 06, 2004

Setting Outlook 2003 Junk Email Options Programmatically

[If you are trying to do this using Exchange 2007 please see http://gsexdev.blogspot.com/2007/07/turning-on-filter-junk-email-in.html ]


The Outlook 2003 Junk email filter has a number of different options that can be configured through (tools-options) that determine how the filter will treat email it detects as spam in your inbox. The configuration settings are stored on a hidden extendedrule message in a user’s inbox. The options settings are held in two MAPI properties on this hidden message the first one being

http://schemas.microsoft.com/mapi/proptag/0x61010003 which stores a long value that sets that level of junk email protection you want the long values for each of the setting are

No Automatic filtering = -1
Low = 6
High = 3
Safe Lists only = -2147483648

The “Permanently delete suspected junk e-mail instead of moving it to the Junk E-mail folder” is stored in the http://schemas.microsoft.com/mapi/proptag/0x61020003 as

Disabled = 0
Enabled = 1

On a new mailbox or a mailbox where Outlook 2003 is not being used (and this setting hasn’t been turned on with OWA2003) this hidden message won’t exist in the user inbox (also the junk e-mail folder won't have been created). One way to create this rule (and folder) is to turn on “filter junk email” in OWA2003. You can do this programmatically using a Webdav post and some OWA commands. Eg

xmlstr = ""
xmlstr = xmlstr & "Cmd=options" & vbLf
xmlstr = xmlstr & "junkemailstate=1" & vbLf
xmlstr = xmlstr & "cmd=savejunkemailrule" & vbLf
Set ObjxmlHttp = CreateObject("Microsoft.XMLHTTP")
ObjxmlHttp.Open "POST", "http://server/exchange/mailbox/", False,
"domain\user", "password"
ObjxmlHttp.setRequestHeader "Accept-Language:","en-us"
ObjxmlHttp.setRequestHeader "Content-type:","application/x-www-UTF8-encoded"
ObjxmlHttp.setRequestHeader "Content-Length:", Len(xmlstr)
ObjxmlHttp.Send xmlstr
Wscript.echo ObjxmlHttp.responseText

Once you know for sure that the rule message is going to be there you can go about using a script to modify the Outlook Junk-email settings. The script I use to do this is based on Exoledb (you could also use Webdav if you wanted to do it remotely). What the script does is searches the users inbox for any IPM.ExtendedRule.Message messages that has the http://schemas.microsoft.com/mapi/proptag/0x65EB001E property (which I’m not really sure does) set to JunkEmailRule. Once this message is identified it’s opened up using ADO/Exoledb and the two properties I mentioned above are modified. In the sample script it sets the junk email option to high. I’ve posted a copy of the two scripts in this article here

The code for the above script looks like this

mailbox = "yourmailbox"
Set Rs = CreateObject("ADODB.Recordset")
Set msgobj = CreateObject("CDO.Message")
set Rec = CreateObject("ADODB.Record")
set Rec1 = CreateObject("ADODB.Record")
Set Conn = CreateObject("ADODB.Connection")
mailboxurl = "file://./backofficestorage/yourdomain.com/MBX/" & mailbox & "/"
Conn.Provider = "ExOLEDB.DataSource"
Rec.Open mailboxurl, ,3
mailboxurl = "file://./backofficestorage/ yourdomain.com /MBX/" & mailbox & "/inbox/"
SSql = "SELECT ""DAV:href"", ""DAV:uid"", ""DAV:contentclass"" FROM scope('shallow traversal of """ & mailboxurl & """') "
SSql = SSql & " WHERE ""http://schemas.microsoft.com/mapi/proptag/0x65EB001E"" = 'JunkEmailRule' and ""http://schemas.microsoft.com/exchange/outlookmessageclass"" = 'IPM.ExtendedRule.Message' "
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
wscript.echo Rs.Fields("DAV:href").Value
rec1.open Rs.Fields("DAV:href").Value,,3
wscript.echo rec1.fields("http://schemas.microsoft.com/mapi/proptag/0x61010003").Value
wscript.echo rec1.fields("http://schemas.microsoft.com/mapi/proptag/0x61020003").Value
rec1.fields("http://schemas.microsoft.com/mapi/proptag/0x61010003").Value = 3
rec1.fields("http://schemas.microsoft.com/mapi/proptag/0x61020003").Value = 0
rec1.fields.update
rec1.close
rs.movenext
wend
end if
rs.close

Monday, November 22, 2004

Setting the Appointment Label Text Programmatically

Last week I blogged this Appointment label Colour Changing Event Sink and I mentioned that the appointment label text is located in the http://schemas.microsoft.com/mapi/proptag/0x36DC0102 property in an undocumented binary form. Well I had a crack at working out what that format is this week and I've come up with the following sample.

Before I start though I must give the following warning, the following piece of code and method is completely unsupported and completely untested. Playing around with binary properties is very unwise unless you really have a good enough grasp to be able to undo any damage you may do trying to set them. The third and last bit is that this will only work if your using the ASCII character set. If you're using other types of character sets (eg a lot of Asian character sets) this wont work.

Because this property is stored in a binary format to work with this in VBS we need something that can read binary and convert it to a hex string which makes it usable. For this I've used Arrayconvert out of this KB article. This library works well and it free and easy to use, the only thing it doesn't do is convert directly a string to hex but you can do this indirectly by first converting the sting to binary and then to hex.

So when no customizations have been made to the labels this property is set to a hex value of 44 Zero's (I know this is not a proper explanation of binary). Or as I'm going to deal with it in the script its 11 groups of "0000". As we have 10 labels then 10 of these groups represent a spacer for each label and the lasts group represents the padding to begin. These groups of 0's are constants in this property they only change in location in relation to the text that's being inserted into the labels.

So the major task that this script does is builds the hex string to be inserted into the property. The first thing it does is sets up a 10 element array to hold all the spacer values for each label. (We already know that this property is going to start with "0000"). The next thing it does is setups up a 10 element array to hold the values for all the customized label texts.

The next part of code then loops through the spacer array and checks to see if any text is going to be inserted from the corresponding label array. If text has been set in that label array element it then first converts the text to a hex string (by way of converting it to binary then back to hex). Then because each character is given 4 digits for storage and USASCII only uses the first 2 digits the hex string is split apart and each hex character representation is padded with "00".

So what we end up with is a hex string representing all the values and spacers that need to be set. Some Exoledb/ADO code is then used to set the x36DC0102 property using the arrayconvert library to convert this hex string into the octent Variant Array of bytes needed for this property.

Thats it as I said you should view this code as experimental and highly suspect. I've posted a downloadable copy of the code here. In my example I'm only setting the two values for blue and green to Internal and External. Eg.

dim objspcarray(9)
dim objlabelarray(9)
set rec = createobject("ADODB.Record")
Set cnvt = CreateObject("ADs.ArrayConvert")
objspcarray(0) = "0000"
objspcarray(1) = "0000"
objspcarray(2) = "0000"
objspcarray(3) = "0000"
objspcarray(4) = "0000"
objspcarray(5) = "0000"
objspcarray(6) = "0000"
objspcarray(7) = "0000"
objspcarray(8) = "0000"
objspcarray(9) = "0000"
objlabelarray(0) = ""
objlabelarray(1) = "External"
objlabelarray(2) = "Internal"
objlabelarray(3) = ""
objlabelarray(4) = ""
objlabelarray(5) = ""
objlabelarray(6) = ""
objlabelarray(7) = ""
objlabelarray(8) = ""
objlabelarray(9) = ""
dstring = "0000"
for i = lbound(objspcarray) to ubound(objspcarray)
if objlabelarray(i) <> "" then
objtooct = cnvt.CvStr2vOctetStr(objlabelarray(i))
objtohex = cnvt.CvOctetStr2vHexStr(objtooct)
for h = 1 to len(objtohex)/2
dstring = dstring & mid(objtohex,((h*2)-1),2) & "00"
next
end if
dstring = dstring & objspcarray(i)
next
wscript.echo dstring
rec.open "file://./backofficestorage/domain/mbx/mailbox/calendar",,3
rec.fields("http://schemas.microsoft.com/mapi/proptag/x36DC0102").Value = cnvt.CvHexStr2vOctetStr(dstring)
rec.fields.update
rec.close

Monday, November 15, 2004

Appointment label Colour Changing Event Sink

[2/2/2005 updated this post and script to use named property instead the custom Mapi prop]

One of the cool features that was implemented in Outlook 2002 was the ability to change the colour of appointment labels to help distinguish between different types of appointments. (see http://www.slipstick.com/calendar/colorcal.htm for a good description of this feature). But because of the laziness factor I find that I rarely use this feature because I usually forget to set it. One of the things that I really wanted this to do also was be able to show me at a glace which meetings in my calendar where internal meeting (only contained internal attendees) and which meeting contained external attendees (this can be usefull in the morning). Putting this into an event sink turned out to be a really easy solution. All I needed was some code that would go though the attendees collection of a appointment object when the appointment was created and check each of the address's of the attendees to see if they where local address's or external. I leaned on the side of low tech and just decided to go for a match against one local domain. The property that controls the appointment colour is http://schemas.microsoft.com/mapi/id/{00062002-0000-0000-C000-000000000046}/0x8214 and there are 10 integers (data type needs to be long) you can pass to it representing the different colours available in Outlook. I decided to go for blue for external meeting and green for internal meeting. The other check the code performs is to check the number of attendees in the appointment this is because I only wanted it to work on meeting or appointments where someone else other then me was attending. NOTE: I’ve restricted this sink so it only takes action on newly created appointments this is because a sink that updates properties on an existing message can be pretty dangerous. If you look at the logic when the sink fires it updates properties on the message and saves that message which then causes the sink to fire again and again and before you know it your transaction logs are full and the store is dismounted (Doh!)

The appointment label text provides a bit more of a challenge its located in the http://schemas.microsoft.com/mapi/proptag/0x36DC0102 property in an undocumented binary form, although on first look it doesn’t appear that daunting it looks like its just in byte format padded with a few zeros but this is a challenge for another day.
The code for the sink looks like this, Ive posted a copy up here


<SCRIPT LANGUAGE="VBScript">

Sub ExStoreEvents_OnSave(pEventInfo, bstrURLItem, lFlags)

Const EVT_NEW_ITEM = 1
Const EVT_IS_DELIVERED = 8

If (lFlags And EVT_IS_DELIVERED) Or (lFlags And EVT_NEW_ITEM) Then

chgappt = 0
LocalSearchdomain = "@yourdomain.com"
set apptobj = createobject("CDO.Appointment")
apptobj.datasource.open bstrURLItem,,3
cval = apptobj.fields("http://schemas.microsoft.com/mapi/id/{00062002-0000-0000-C000-000000000046}/0x8214")
if apptobj.Attendees.count > 1 then
for each attend in apptobj.Attendees
if instr(lcase(attend.address),LocalSearchdomain) = 0 then
chgappt = 1
end if
next
if chgappt = 1 then
if cavl <> 2 then
apptobj.fields("http://schemas.microsoft.com/mapi/id/{00062002-0000-0000-C000-000000000046}/0x8214") = clng(2)
apptobj.fields.update
apptobj.datasource.save
end if
else
if cavl <> 3 then
apptobj.fields("http://schemas.microsoft.com/mapi/id/{00062002-0000-0000-C000-000000000046}/0x8214") = clng(3)
apptobj.fields.update
apptobj.datasource.save
end if
end if
end if
apptobj = nothing

end if

End Sub

</SCRIPT>

Monday, November 08, 2004

Deleting old email with a Exoledb Script

This question pops up now and again from people who want to be able to scheduled a script that will delete mail in a folder that was received more then say 30 days ago. Typically this could be used on a postmaster mailbox (hopefully people are reading these mails before they get deleted) or on a mailbox that is doing auto replies when you want to keep the original emails for a period of time. Going about this is quite simple in Exoeldb all you really need to do is query on the desired folder for all the mail where the urn:schemas:httpmail:datereceived is older then 30 days. Once you have all these mails in a record set you can loop though the recordset and delete the email. The thing to remember when you are deleting mail this way is that the deleted mail goes into the dumpster of whatever folder you are deleting them from

mailboxurl = "file://./backofficestorage/yourdomain/MBX/mailbox/inbox"
set Rec = CreateObject("ADODB.Record")
set Rs = CreateObject("ADODB.Recordset")
Set Conn = CreateObject("ADODB.Connection")
Conn.Provider = "ExOLEDB.DataSource"
Rec.Open mailboxurl, ,3
SSql = "SELECT ""DAV:href"", ""DAV:contentclass"" FROM scope('shallow traversal of """ & mailboxurl & """') "
SSql = SSql & " WHERE (""urn:schemas:httpmail:datereceived"" < CAST(""" & isodateit(now()-31) & """ as 'dateTime')) AND ""DAV:isfolder"" = false"
SSql = SSql & " AND ""DAV:contentclass"" = 'urn:content-classes:message'"
Rs.CursorLocation = 2 'adUseServer = 2, adUseClient = 3
rs.open SSql, rec.ActiveConnection, 3
while not rs.eof
rs.delete 1
rs.movenext
wend
rs.close


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

If you want to go a step further with the script and crawl each folder in a mailbox to delete old content then you can combine this with one of the scripts from http://support.microsoft.com/default.aspx?scid=kb;en-us;320071 which gives you a method of enumerating every folder in a mailbox. Then you just call out an archive sub for each folder. This script gets a bit lengthy I’ve put an example of this as well as the other script from the article up here. As these scripts delete things great care should be always taken when using and testing scripts of this nature. Make sure you have adequately configured Deleted item retention rates and working backups, if you’re not sure what either of these things are don’t use the scripts (and seek help).

Monday, November 01, 2004

Finding what Resources are being used from a Meeting Request

I've blogged about resources in meetings before but this question came up last week about how do you tell which resources have been booked from a calendar request message(meeting invitation). When someone creates a meeting the resources that are booked (or attempting to be booked) with the meeting get stored in the BCC field of the appointment object. In the calendar request messages (invitations) that go out to the users (and resource mailboxes if your using some sort of auto accept system) the resources aren't included in the calendar request message (not even in the recipients collection even when the resource mailbox is receiving the calendar request). If you use Outlook to do the booking it does copy the resources display name into the location property but with OWA the location field is left blank unless the user specifically enters something . So from a calendar request message you received from a meeting organized by OWA how could you tell which resources where being booked with that meeting.

Here are a couple of methods that may help

The Mapi property 0x8167001E lists all the displaynames of attendees of a meeting and this seems to include all the resources as well. So what you can do is grab this property do a split on it to get the entries into an array. Loop though the array and check if each address is in the To or CC field of the appointment and if its not then its a resource. eg

Set iCalMsg = CreateObject("CDO.Message")
iCalMsg.datasource.open "itemurl"
recplist =
iCalMsg.fields("http://schemas.microsoft.com/mapi/proptag/0x8167001E")
recparray = split(recplist,";",-1,1)
for i = lbound(recparray) to ubound(recparray)
if instr(iCalMsg.fields("http://schemas.microsoft.com/mapi/proptag/0x0E04001E"),recparray(I)) then
else
if instr(iCalMsg.fields("http://schemas.microsoft.com/mapi/proptag/0x0E03001E"),recparray(I)) then
else
wscript.echo recparray(I)
end if
end if
next

Another method you can use is if you loop though the attendees collection of the appointment associated with the calendar request you can find the organizer of the appointment. Once you know the organizer of the appointment you can then use this along with the urn:schemas:calendar:uid field which uniquely identifies each appointment to call the GetAssociatedItem method of the calendar item. This will (if you have the rights to) connect to the organizers mailbox and then retrieve the master appointment object which will contain resources in the attendees collection . This all uses CDOEX and CDOEXM and the file URL scheme so for this to work the resource mailbox and organizers mailbox has have be on the same server.

Set iCalMsg = CreateObject("CDO.CalendarMessage")
iCalMsg.datasource.open "itemurl"
For Each iCalPart In iCalMsg.CalendarParts
Set iAppt = iCalPart.GetUpdatedItem
cuid1 = iAppt.fields("urn:schemas:calendar:uid")
for each attend in iAppt.Attendees
if attend.IsOrganizer <> 0 then
Set Person = CreateObject("CDO.Person")
strURL = attend.address
Person.DataSource.Open strURL
Set Mailbox = Person.GetInterface("IMailbox")
set iAppt1 = iCalPart.GetAssociatedItem(Mailbox.calendar)
for each attend1 in iAppt1.Attendees
 wscript.echo attend1.address
 wscript.echo attend1.role
 wscript.echo attend1.status
 wscript.echo attend1.type
next
end if
next
Next

If you wanted to use the second method but the mailboxes are on separate servers then something similar can be done using three webDAV queries and some ADSI. The following example first grabs the calendar message using a WebDAV GET and parses the organizer of the meeting out of the vCalendar body part and also the calendar UID. An ADSI query is then performed using the SMTP address of the organizer to retrieve the msExchHomeServerName property which tells you which server the mailbox is on. A second WebDAV search is then done of the organizers calendar based on the Calender UID of the appointment. This should then locate the original appointment which is then retrieved using a WebDAV GET. The resource mailbox (or mailbox's) SMTP address's are then parsed out of the vCalendar body part.
I've posted a copy of all the scripts from this post here

set Req = createobject("Microsoft.XMLHTTP")
Req.open "GET","http://server/exchange/mailbox/inbox/calandermessage.EML",false
Req.setRequestHeader "Translate","f"
Req.send
attendeearry = split(req.responsetext,"ORGANIZER;",-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)-1))
next
uidarry = mid(req.responsetext,instr(req.responsetext,"UID:")+3,len(req.responsetext))
string1 = vbcrlf & " "
stparse = replace(uidarry,string1,"")
uidprop = mid(stparse,2,instr(stparse,vbcrlf))
uidprop = replace(uidprop,vbcrlf,"")
CUserID = replace(attaddress," ","")
Set objDNS = CreateObject("ADSystemInfo")
DomainName = LCase(objDNS.DomainDNSName)
Set oRoot = GetObject("LDAP://" & DomainName & "/rootDSE")
strDefaultNamingContext = oRoot.get("defaultNamingContext")
GALQueryFilter = "(&(&(&(& (mailnickname=*) (|
(&(objectCategory=person)(objectClass=user)(!(homeMDB=*))(!(msExchHomeServerName=*)))(&(objectCategory=person)(objectClass=user)(|(homeMDB=*)(msExchHomeServerName=*)))
)))(objectCategory=user)(mail=" & CUserID & ")))"
strQuery = "<LDAP://" & DomainName & "/" & strDefaultNamingContext & ">;" &
GALQueryFilter &
";distinguishedName,msExchHomeServerName,msExchHideFromAddressLists;subtree"
Set oConn = CreateObject("ADODB.Connection") 'Create an ADO Connection
oConn.Provider = "ADsDSOOBJECT" ' ADSI OLE-DB provider
oConn.Open "ADs Provider"

Set oComm = CreateObject("ADODB.Command") ' Create an ADO Command
oComm.ActiveConnection = oConn
oComm.Properties("Page Size") = 1000
oComm.CommandText = strQuery

Set rs = oComm.Execute

server =
right(rs.fields("msExchHomeServerName"),len(rs.fields("msExchHomeServerName"))-(instr(rs.fields("msExchHomeServerName"),"cn=Servers/cn=")+13))
mailbox = attaddress
strURL = "http://" & server & "/exchange/" & mailbox & "/calendar/"
strQuery = "<?xml version=""1.0""?><D:searchrequest xmlns:D = ""DAV:"" >"
strQuery = strQuery & "<D:sql>SELECT ""DAV:href"" FROM scope('shallow traversal
of """
strQuery = strQuery & strURL & """') Where ""urn:schemas:calendar:uid"" = '" &
uidprop & "'</D:sql></D:searchrequest>"
set req = createobject("microsoft.xmlhttp")
req.open "SEARCH", strURL, false
req.setrequestheader "Content-Type", "text/xml"
req.setRequestHeader "Translate","f"
req.send strQuery
If req.status >= 500 Then
wscript.echo "Status: " & req.status
wscript.echo "Status text: An error occurred on the server."
ElseIf req.status = 207 Then
set oResponseDoc = req.responseXML
set oNodeList = oResponseDoc.getElementsByTagName("a:href")
For i = 0 To (oNodeList.length -2)
set oNode = oNodeList.nextNode
proccalmess(oNode.Text)
Next
Else
wscript.echo "Status: " & req.status
wscript.echo "Status text: " & req.statustext
wscript.echo "Response text: " & req.responsetext
End If

sub proccalmess(objhref)

Req.open "GET", objhref, 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

end sub

Thursday, October 21, 2004

Last 5 received/Sent Emails IPAQ pocket IE page/script

I been playing around with some WebDAV code with Pocket IE (on a IPAQ)to display a screen that shows me the last 5 emails I received and the last 5 I sent. Because my IPAQ sits on my desk most of the day doing nothing I found this pretty handy as it alloys me to see at a glance which bit of email I need to take action on and what I've replied to recently. Geting the code to work inside of pocket IE was a little bit of a challendge had to switch to using Jscript and I found out that a few things that worked fine in the desktop version of IE don't work the way you really want them to (or at all) in the pocket version of IE but I did manage to come up with the following piece of working code. Basically what it does is performs two separate WebDAV queries the first one of the Inbox and then the Sent Items folder. I used the Range header to limit the result set of the queries to 5 rows. The Range header is pretty cool it kind of a sudo SQL TOP statement. I've added some simple HTML that displays unread email in a different colour and bold and the last part of the code sets up a ongoing timer which does a query of the mailbox every 25 seconds to see if any new mail has arrived or the read status of a mail has change. It does this by making another query of the inbox and then compares the received time of the last mail it received to the one it retrieved in the first query of that email along with the read status as well. If any of these are different then it initiates a page reload. The page itself is just a HTM page you copy to your IPAQ (after you mod the code to put in your mailbox and server you need to connect to). I've put a copy of the code up here

Tuesday, October 12, 2004

Listing the file sizes of all Exchange Stores on all Exchange Servers in a Domain

One of the things that I've found missing from the Exchange Management GUI's has been the ability to get the physical size of the database files (especially when you have multiple servers to manage). None of the Exchange API's accessible with script offer this type of information either.

I've found two methods you can use to grab this information via a script, the first is when the information store performs a backup via the Exchange Backup API one of the events it logs is event code 220 which states the size of each file before it is backed up. The other method is to connect to the file using the FSO object in VBS and grab the size of the file directly.

I've expanded this second method into a script that first queries for all the msExchPrivateMDB and msExchPulicMDB objects in Active Directory using ADSI. Then using the msExchEDBFile, msExchSLVFile and msExchOwningServer AD properties constructs the URL to be able to connect to each file remotely and report on the size of the EDB and STM files for that mail or public folder store. I've also used the homeMDBBL property which contains a list of all the mailenabled accounts within a mailstore to get the number of mailboxes for each mailstore. The script itself is designed to be run from the command line using cscript and will produce a console output for every Exchange server store for the domain its runs in.

The script itself looks like this I've posted a download-able copy up here

set conn = createobject("ADODB.Connection")
set com = createobject("ADODB.Command")
Set iAdRootDSE = GetObject("LDAP://RootDSE")
strNameingContext = iAdRootDSE.Get("configurationNamingContext")
Conn.Provider = "ADsDSOObject"
Conn.Open "ADs Provider"
mbQuery = ";(objectCategory=msExchPrivateMDB);name,distinguishedName;subtree"
pfQuery = ";(objectCategory=msExchPublicMDB);name,distinguishedName;subtree"
Com.ActiveConnection = Conn
Com.CommandText = mbQuery
Set Rs = Com.Execute
Wscript.echo "Mailbox Stores"
Wscript.echo
While Not Rs.EOF
objmailstorename = "LDAP://" & Rs.Fields("distinguishedName")
set objmailstore = getObject(objmailstorename)
objmailstore.GetInfoEx Array("homeMDBBL"), 0
varReports = objmailstore.GetEx("homeMDBBL")
Set fso = CreateObject("Scripting.FileSystemObject")
edbfilespec = "\\" & mid(objmailstore.msExchOwningServer,4,instr(objmailstore.msExchOwningServer,",")-4) & "\" & left(objmailstore.msExchEDBFile,1) & "$" & mid(objmailstore.msExchEDBFile,3,len(objmailstore.msExchEDBFile)-2)
stmfilespec = "\\" & mid(objmailstore.msExchOwningServer,4,instr(objmailstore.msExchOwningServer,",")-4) & "\" & left(objmailstore.msExchSLVFile,1) & "$" & mid(objmailstore.msExchSLVFile,3,len(objmailstore.msExchSLVFile)-2)
Set efile = fso.GetFile(edbfilespec)
set sfile = fso.GetFile(stmfilespec)
edbsize = formatnumber(efile.size/1073741824,2,0,0,0)
stmsize = formatnumber(sfile.size/1073741824,2,0,0,0)
Wscript.echo Rs.Fields("name") & "# Mailboxes: " & ubound(varReports)+1 & " EDBSize(GB): " & edbsize & " STMSize(GB): " & stmsize
Rs.MoveNext

Wend
Wscript.echo
Wscript.echo "Public Folder Stores"
Wscript.echo
Com.CommandText = pfQuery
Set Rs1 = Com.Execute
While Not Rs1.EOF
objmailstorename = "LDAP://" & Rs1.Fields("distinguishedName")
set objmailstore = getObject(objmailstorename)
Set fso = CreateObject("Scripting.FileSystemObject")
edbfilespec = "\\" & mid(objmailstore.msExchOwningServer,4,instr(objmailstore.msExchOwningServer,",")-4) & "\" & left(objmailstore.msExchEDBFile,1) & "$" & mid(objmailstore.msExchEDBFile,3,len(objmailstore.msExchEDBFile)-2)
stmfilespec = "\\" & mid(objmailstore.msExchOwningServer,4,instr(objmailstore.msExchOwningServer,",")-4) & "\" & left(objmailstore.msExchSLVFile,1) & "$" & mid(objmailstore.msExchSLVFile,3,len(objmailstore.msExchSLVFile)-2)
Set efile = fso.GetFile(edbfilespec)
set sfile = fso.GetFile(stmfilespec)
edbsize = formatnumber(efile.size/1073741824,2,0,0,0)
stmsize = formatnumber(sfile.size/1073741824,2,0,0,0)
Wscript.echo Rs1.Fields("name") & " EDBSize(GB): " & edbsize & " STMSize(GB): " & stmsize
Rs1.MoveNext

Wend
Rs.Close
Rs1.Close
Conn.Close
Set Rs = Nothing
set Rs1 = Nothing
Set Com = Nothing
Set Conn = Nothing

Friday, October 08, 2004

Getting Meeting Attendee status and roles through WebDAV

When you send out meeting or appointment invites to people and they are accepted or denied by users the status of there acceptance (and their role in the Meeting) is stored in the recipients collection of the appointment object. In CDOEX you have a few interfaces that allow you to interrogate and retrieve this information via the IAppointment and IAttendee interfaces. EG

set apptobj = createobject("CDO.Appointment")
apptobj.datasource.open "file://./backofficestorage/domain.com.au/MBX/mailbox/calendar/appointment.EML"
for each attend in apptobj.Attendees
wscript.echo attend.address
wscript.echo attend.role
wscript.echo attend.status
next

In WebDAV access to the recipients collection of a message is very limited and usually all you can retrieve is the email address and or displayname of each attendee. A while ago I blogged this about a method of accessing a meeting resource's email address by using the vCalendar body part of an appointment. The attendee status and attendee role are also stored in this vCalendar body part so you can extend this method to also parse out the attendee Role and attendee Status from this body part. Here's what it looks like in script. If you want to download a copy I've put it up here

set Req = createobject("Microsoft.XMLHTTP")
Req.open "GET", "http://server/exchange/mailbox/Calendar/appoinment.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))
attrole = mid(stparse,(instr(stparse,"ROLE=")+5),instr((instr(stparse,"ROLE=")+5),stparse,";")-(instr(stparse,"ROLE=")+5))
attstatus = mid(stparse,(instr(stparse,"PARTSTAT=")+9),instr((instr(stparse,"PARTSTAT=")+9),stparse,";")-(instr(stparse,"PARTSTAT=")+9))
wscript.echo attaddress
wscript.echo attrole
wscript.echo attstatus
next

Thursday, September 30, 2004

Scripting Contact folder Distribution List though OWA

Contact folder distribution lists presents some what of a challenge when it comes to scripting and programmatic access. The members in these lists are held in a couple of binary MAPI properties and there are no direct interfaces to modify these lists using CDOEX. Modifing the properties directly using Exoledb or WebDAV is possible in some cases just not very easy or flexible. Fortunately OWA does provide a method to create and modify these contact distribution lists which can easily be used in a automation script.

Creating a DL,

This is the one thing that you can do easily using CDOEX,ADO or WEBDAV but one extra thing you can do with OWA is create a DL and add a member to it at the same time. The one restriction I found for this is you can only add one member at a time per request. The following script creates a new DL in a public folder using the save cmd. You need to put the name of your new DL in http://schemas.microsoft.com/mapi/dlname=NewDlName

Set ObjxmlHttp = CreateObject("MSXML2.ServerXMLHTTP")
xmlstr = ""
xmlstr = xmlstr & "Cmd=save" & vbLf
xmlstr = xmlstr & "msgclass=IPM.DistList" & vbLf
xmlstr = xmlstr & "http://schemas.microsoft.com/mapi/dlname=NewDlName"
ObjxmlHttp.Open "POST", "http://server/public/test2/", false, "domain\user", "pass"
ObjxmlHttp.setRequestHeader "Accept-Language", "en-us"
ObjxmlHttp.setRequestHeader "Content-type", "application/x-www-UTF8-encoded"
ObjxmlHttp.setRequestHeader "Content-Length", Len(xmlstr)
ObjxmlHttp.Send xmlstr

I used MSXML2.ServerXMLHTTP because of the responses OWA gives back it gets a little bit messy and it best just to ignore the responses.

Adding members to a DLL

To add a member to a existing DL you first need to know what the URL of DL is (be careful its usually more then just the displayname you can use something like exchange explorer to look at the dav:href of the object if your not sure). Then what you do is post to the DL name submitting some commands in the body of the post

Set ObjxmlHttp = CreateObject("MSXML2.ServerXMLHTTP")
xmlstr = ""
xmlstr = xmlstr & "Cmd=addmember" & vbLf
xmlstr = xmlstr & "msgclass=IPM.DistList" & vbLf
xmlstr = xmlstr & "member=user@domain.com" & vbLf
ObjxmlHttp.Open "POST", "http://server/public/test2/Dlname.eml", false, "domain\user", "pass"
ObjxmlHttp.setRequestHeader "Accept-Language", "en-us"
ObjxmlHttp.setRequestHeader "Content-type", "application/x-www-UTF8-encoded"
ObjxmlHttp.setRequestHeader "Content-Length", Len(xmlstr)
ObjxmlHttp.Send xmlstr


Viewing the contents of a Distribution list

Viewing the members of a DL can be useful for a number of different purposes and its pretty easy all you need to do is issue the Cmd=viewmembers. What you get back is some XML with the email and memberid of each member in the DL. The MemberID comes in handy if you need to delete a member from the DL . Here's a script that demos this

Set ObjxmlHttp = CreateObject("Microsoft.XMLHTTP")
ObjxmlHttp.Open "GET","http://server/public/test2/dlname.EML?Cmd=viewmembers", False, "domain\user", "pass"
ObjxmlHttp.Send
set oResponseDoc = ObjxmlHttp.responseXML
set oNodeList = oResponseDoc.getElementsByTagName("memberid")
set oNodeList1 = oResponseDoc.getElementsByTagName("email")
For i = 0 To (oNodeList.length -1)
set oNode = oNodeList.nextNode
set oNode1 = oNodeList1.nextNode
wscript.echo oNode.text & " " & oNode1.text
next


Deleteing a member from a DL

To delete a member from a DL you first need to know what the memberid of the member you want to delete is. So you need to combine a Cmd=viewmembers query with a delete function. The code below does a loop though all the members of the DL until it matches a email address its supplied and then calls the delete function.

usertodel = "user@domain.com"
Set ObjxmlHttp = CreateObject("Microsoft.XMLHTTP")
ObjxmlHttp.Open "GET","http://server/public/test2/dlname.EML?Cmd=viewmembers", False, "domain\user", "pass"
ObjxmlHttp.Send
set oResponseDoc = ObjxmlHttp.responseXML
set oNodeList = oResponseDoc.getElementsByTagName("memberid")
set oNodeList1 = oResponseDoc.getElementsByTagName("email")
For i = 0 To (oNodeList.length -1)
set oNode = oNodeList.nextNode
set oNode1 = oNodeList1.nextNode
if oNode1.text = usertodel then
delmember(oNode.text)
wscript.echo "Member Deleted " & oNode1.text
end if
next

function delmember(utodel)
Set ObjxmlHttp = CreateObject("MSXML2.ServerXMLHTTP")
xmlstr = ""
xmlstr = xmlstr & "Cmd=deletemember" & vbLf
xmlstr = xmlstr & "msgclass=IPM.DistList" & vbLf
xmlstr = xmlstr & "memberid=" & utodel
ObjxmlHttp.Open "POST", "http://server/public/test2/dlname.EML", false, "domain\user", "pass"
ObjxmlHttp.setRequestHeader "Accept-Language", "en-us"
ObjxmlHttp.setRequestHeader "Content-type", "application/x-www-UTF8-encoded"
ObjxmlHttp.setRequestHeader "Content-Length", Len(xmlstr)
ObjxmlHttp.Send xmlstr
end function


Some things you need to be careful off, I found you always need to specify the authentication as pass though didn't seem to work. I've put copies off all the scripts from this post here. http://msgdev.mvps.org/exdevblog/contactdl.zip

Thursday, September 23, 2004

Copying Contacts from One Mailbox to Another via Script

I had this request from one of my customers recently who wanted me to copy all the contacts from one mailbox into another. The easiest way to do this would have been to use outlook to export the contacts folder to a pst and then just import them back into the other mailbox using Outlook. Because i manage this client remotely and there's no Outlook on the Exchange server itself (and i really didn't feel like talking the users though this) I came up with the following Exoledb/CDOEX script to do the copy. The challenge when copying anything between mailbox's or public folders is you cant do a direct copy (eg ADO copyrecord only works within a mailbox or public store) so you have to use another solution.

What this script does is first does a query to get all the URL's of contacts in the mailbox's contact folder. Then it opens up each contact using the CDO.Person interface and then access's the vcard stream on each contact object . The script then copies this vcard stream into a new CDO.Person object and then saves it to the store which will then gernerate all the nessasary MAPI contact properties based on the information that is in the vCard Stream. The vCard stream has most of the information needed to create the contact as it was in the source mailbox but there are a few specific MAPI properties that are missing to be able to replicate this exactly. The first of these is the fileas property which ensures that when you recreate the contact they will be listed in the same order as they where in the source mailbox. The other import one that needs to be copied is the postal address, the business address gets copied in the vCard stream but the postal address doesn't and Outlook actually uses the postal address to display the address in the normal contact view . Some other things that don't copy over properly when you use the vCard stream is the email displayname and if you have a X400 address instead of a SMTP address this also get mangled so I've included code that copies each of those address properties manually. I've only included the properties for the first email contact field (if you want the 2nd and 3rd you'll have to get them yourself).

I've posted a copy of the script up here http://msgdev.mvps.org/exdevblog/copcont2.zip

here's what the code looks like

on error resume next
Set Rs = CreateObject("ADODB.Recordset")
set Rec = CreateObject("ADODB.Record")
set contobj = createobject("CDO.Person")
Set Conn = CreateObject("ADODB.Connection")
contactfolderurl = "file://./backofficestorage/domain.com/MBX/sourcemb/contacts/"
Conn.Provider = "ExOLEDB.DataSource"
Rec.Open contactfolderurl, ,3
SSql = "Select ""DAV:href"", ""http://schemas.microsoft.com/exchange/permanenturl"" "
SSql = SSql & " FROM scope('shallow traversal of """ & contactfolderurl & """') "
SSql = SSql & "WHERE ""DAV:contentclass"" = 'urn:content-classes:person' and ""DAV:ishidden"" = false"
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
set contobj1 = createobject("CDO.Person")
wscript.echo rs.fields("DAV:href")
ourl = rs.fields("http://schemas.microsoft.com/exchange/permanenturl")
contobj.datasource.open ourl,,3
set stm = contobj.getvcardstream()
set stm1 = contobj1.getvcardstream()
stm1.writetext = stm.readtext
stm1.flush
contobj1.fields("urn:schemas:contacts:fileas") = contobj.fields("urn:schemas:contacts:fileas")
contobj1.fields("http://schemas.microsoft.com/mapi//id/{00062004-0000-0000-C000-000000000046}/0x8080") = contobj.fields("http://schemas.microsoft.com/mapi//id/{00062004-0000-0000-C000-000000000046}/0x8080")
contobj1.fields("http://schemas.microsoft.com/mapi//id/{00062004-0000-0000-C000-000000000046}/0x818A") = contobj.fields("http://schemas.microsoft.com/mapi//id/{00062004-0000-0000-C000-000000000046}/0x818A")
contobj1.fields("http://schemas.microsoft.com/mapi//id/{00062004-0000-0000-C000-000000000046}/0x818B") = contobj.fields("http://schemas.microsoft.com/mapi//id/{00062004-0000-0000-C000-000000000046}/0x818B")
contobj1.fields("http://schemas.microsoft.com/mapi//id/{00062004-0000-0000-C000-000000000046}/0x818C") = contobj.fields("http://schemas.microsoft.com/mapi//id/{00062004-0000-0000-C000-000000000046}/0x818C")
contobj1.fields("http://schemas.microsoft.com/mapi//id/{00062004-0000-0000-C000-000000000046}/0x818D") = contobj.fields("http://schemas.microsoft.com/mapi//id/{00062004-0000-0000-C000-000000000046}/0x818D")
contobj1.fields("http://schemas.microsoft.com/mapi/proptag/0x3A15001E") = contobj.fields("http://schemas.microsoft.com/mapi/proptag/0x3A15001E")
contobj1.fields("http://schemas.microsoft.com/mapi/proptag/0x3A2A001E") = contobj.fields("http://schemas.microsoft.com/mapi/proptag/0x3A2A001E")
contobj1.fields("http://schemas.microsoft.com/mapi/proptag/0x3A2B001E") = contobj.fields("http://schemas.microsoft.com/mapi/proptag/0x3A2B001E")
contobj1.fields.update
contobj1.datasource.savetocontainer "file://./backofficestorage/domain.com/MBX/targetmb/contacts/"
wscript.echo err.description
err.clear
set stm = nothing
set stm1 = nothing
set contobj1 = nothing
rs.movenext
wend
end if

Friday, September 10, 2004

Simple HTML calendar feed from Users Free/Busy data

A while ago I posted this about creating a simple html calendar like the ones you see in OWA. I was looking though some OWA captures today and noticed the following command is called when you manipulate the calender object in OWA.

?Cmd=monthfreebusy&start=2004-07-25T00:00:00+10:00&end=2004-09-05T00:00:00+10:00

(the +10:00 at the end I believe refers to the time zone offset which you need to adjust to your own timezone or put some code in that does it)

What this does is return a single string of numbers with each day in-between the &start and &end variables represented by a 0 if there are no appointments that day, a 1 if there is and a 2 is no freebusy data has been published.

I took this function and combined it with some WebDAV in a ASP page and was able to feed the simple html calendar and make it bold all the dates in the calendar that there where appointments on, I also created a few functions so you could change months back and forth.

The limitations of this method is that it only works for the months where free-busy information has been published and it doesn't work for public folder calendars because no free busy information is maintained for these. It should however come in handy for things like resource mailboxes where having a simple calendar comes in handy.

I've posted up a copy of the ASP page and button images here http://msgdev.mvps.org/exdevblog/showcalendar.zip (don't forget to change the timezone unless you live on the East coast of Aus)

The code itself look like


<table border="0" id="table1" cellpadding="2" width="147">
<tr><b>
<%
sdate = request.querystring("sdate")
if sdate = "" then
wdate = now()
mmonth = monthname(month(now())) & " " & Year(now())
else
wdate = dateserial(mid(sdate,1,4),mid(sdate,6,2),mid(sdate,9,2))
mmonth = monthname(month(wdate)) & " " & Year(wdate)
end if
pmonth = condate(dateadd("m",-1,wdate))
stime = condate(wdate)
etime = condate(dateadd("m",1,wdate))
response.write "<td style=""padding: 0"" width=""147"" align=""center"" colspan=""7""><b><font
face=""Arial Narrow"" size=2 color=""#000080"">"
response.write "<a href=""showcalendar.asp?sdate=" & etime & """><img
border=""0"" src=""pg-next.gif"" width=""16"" height=""16""
align=""right""></a>"
response.write "<a href=""showcalendar.asp?sdate=" & pmonth & """><img
border=""0"" src=""pg-prev.gif"" width=""16"" height=""16""
align=""left""></a><B>" & mmonth & "</b></td>"
%>
</font></b> </tr>
<tr>
<td style="border-bottom-style: solid; padding: 0" width="16" align="center">
M</td>
<td style="border-bottom-style: solid; padding: 0" width="16" align="center">
T</td>
<td style="border-bottom-style: solid; padding: 0" width="16" align="center">
W</td>
<td style="border-bottom-style: solid; padding: 0" width="16" align="center">
T</td>
<td style="border-bottom-style: solid; padding: 0" width="16" align="center">
F</td>
<td style="border-bottom-style: solid; padding: 0" width="16" align="center">
S</td>
<td style="border-bottom-style: solid; padding: 0" width="16" align="center">
S</td>
</tr>
<%

urlstr = "http://servername/exchange/mailbox/calendar/?Cmd=monthfreebusy&start="
& stime & "T00:00:00+10:00&end=" & etime & "T00:00:00+10:00"
Set Objxml = Server.CreateObject("Microsoft.XMLhttp")
Objxml.Open "Get", urlstr, False, "", ""
Objxml.setRequestHeader "Accept-Language:", "en-us"
Objxml.setRequestHeader "Content-type:", "application/x-www-UTF8-encoded"
Objxml.setRequestHeader "Content-Length:", Len(szXml)
Objxml.Send szXml
set oResponseDoc = Objxml.responseXML
set oNodeList = oResponseDoc.getElementsByTagName("fbdata")
For i = 0 To (oNodeList.length -1)
set oNode = oNodeList.nextNode
caldata = oNode.text
next
cdatefday = cdate(dateserial(year(wdate),month(wdate),"1"))
sday = weekday(cdatefday,2)
cmonth = month(wdate)
for x = 1 to 6
response.write "<tr>"
for i = 1 to 7
if cmonth = month(cdatefday) then
if sday =< i then
sday = 0
if mid(caldata,day(cdatefday),1) = 1 then
response.write "<td style=""padding: 0"" width=""16"" align=""center""><b>" &
day(cdatefday) & "</b></td>"
else
response.write "<td style=""padding: 0"" width=""16"" align=""center"">" &
day(cdatefday) & "</td>"
end if
cdatefday = dateadd("d",1,cdatefday)
else
response.write "<td style=""padding: 0"" width=""16"" align=""center""> </td>"

end if
else
response.write "<td style=""padding: 0"" width=""16"" align=""center""> </td>"

end if
next
response.write "</tr>"
next


function condate(date2con)
dtcon = date2con
if month(dtcon) < 10 then
if day(dtcon) < 10 then
qdat = year(dtcon) & "-" & "0" & month(dtcon) & "-" & "01"
else
qdat = year(dtcon) & "-" & "0" & month(dtcon) & "-" & "01"
end if
else
if day(dtcon) < 10 then
qdat = year(dtcon) & "-" & month(dtcon) & "-" & "01"
else
qdat = year(dtcon) & "-" & month(dtcon) & "-" & "01"
end if
end if
condate = qdat
end function
%>

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

replace(Rs.fields("urn:schemas:httpmail:textdescription"),chr(13),"<br/>")

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 http://msgdev.mvps.org/exdevblog/pubfeedv2.zip

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
rs.open SSql, rec.ActiveConnection, 3
if Rs.recordcount <> 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("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
rs.movenext
wend
end if
rs.close
Set objPI = objDom.createProcessingInstruction("xml", "version='1.0'")
objDom.insertBefore objPI, objDom.childNodes(0)
objdom.save("\\" & Webserver & "\wwwroot\" & feedfile)

End Sub

showmessage.asp file


<%
on error resume next
set xmlfile1 = request.querystring("xmlfile")
xmlfile = "http://" & Request.ServerVariables("SERVER_NAME") &
Request.ServerVariables("URL")
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"
xmlobj.Send
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
Next
pubdate = replace(pubdate,"GMT","")
pubdate = cdate(Mid(pubdate,(instr(pubdate,",")+1),len(pubdate)))
set shell = server.createobject("wscript.shell")
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">
<tr>
<td>Received: <%=pubdate%></td>
</tr>
<tr>
<td>From: <%=author%></td>
</tr>
<tr>
<td>Subject: <%=Title%></td>
</tr>
<tr>
<td>Message: <%=Description%></td>
</tr>
</table>

Thursday, September 02, 2004

Processing Meeting requests remotely with WebDAV and OWA

This was something interesting I learned this week. If you want to process meeting requests remotely the same way you can locally with CDOEX then using a combination of WebDAV and some OWA commands can make this happen.

Process the request

Basically when someone invites you to a meeting you will get sent a calendar message that contains all the invitation information. You can differentiate this from a normal message by looking at the DAV:Contentclass and seeing if its set to urn:content-classes:calendarmessage. Now if you want to scan a inbox for any of these messages you could do a WebDAV search against that mailbox for any messages that have this particular content class and also who’s outlookmessage class was set to IPM.Schedule.Meeting.Request which delineates this as a meeting request. Eg

server = "servername"
mailbox = "mailbox"
strURL = "http://" & server & "/exchange/" & mailbox & "/inbox/"
strQuery = ""
strQuery = strQuery & "SELECT ""DAV:href"", ""http://schemas.microsoft.com/exchange/outlookmessageclass"""
strQuery = strQuery & " FROM scope('shallow traversal of """
strQuery = strQuery & strURL & """') Where ""DAV:ishidden"" = False AND ""DAV:isfolder"" = False AND "
strQuery = strQuery & """DAV:contentclass"" = 'urn:content-classes:calendarmessage'
"
set req = createobject("microsoft.xmlhttp")
req.open "SEARCH", strURL, false
req.setrequestheader "Content-Type", "text/xml"
req.setRequestHeader "Translate","f"
req.send strQuery
If req.status >= 500 Then
wscript.echo "Status: " & req.status & " Status text: An error occurred on the server."
ElseIf req.status = 207 Then
wscript.echo "Status: " & req.status & " Status text: An error occurred on the server."
set oResponseDoc = req.responseXML
set oNodeList = oResponseDoc.getElementsByTagName("a:href")
set oclasslist = oResponseDoc.getElementsByTagName("d:outlookmessageclass")
For i = 0 To (oclasslist.length -2)
set oNode1 = oclasslist.nextNode
set oNode = oNodeList.nextNode
if oNode1.Text = "IPM.Schedule.Meeting.Request" then acceptcalmess(oNode.Text)
Next
Else
wscript.echo "Status: " & req.status & " Status text: An error occurred on the server."
End If

sub acceptcalmess(objhref)
wscript.echo objhref
end sub

Now to process the calendar messages this is where you can use the OWA accept and decline commands. Once you issue one of these commands OWA will create a new calendar response message saying that you have accepted or declined this meeting and save this into your drafts folder (the original calendar request message is also deleted). To send this message all you then need to do is move it to the DavMailSubmissionURI. To put this all together with the search example it would look like this

server = "servername"
mailbox = "mailbox"
strURL = "http://" & server & "/exchange/" & mailbox & "/inbox/"
strQuery = ""
strQuery = strQuery & "SELECT ""DAV:href"", ""http://schemas.microsoft.com/exchange/outlookmessageclass"""
strQuery = strQuery & " FROM scope('shallow traversal of """
strQuery = strQuery & strURL & """') Where ""DAV:ishidden"" = False AND ""DAV:isfolder"" = False AND "
strQuery = strQuery & """DAV:contentclass"" = 'urn:content-classes:calendarmessage'
"
set req = createobject("microsoft.xmlhttp")
req.open "SEARCH", strURL, false
req.setrequestheader "Content-Type", "text/xml"
req.setRequestHeader "Translate","f"
req.send strQuery
If req.status >= 500 Then
wscript.echo "Status: " & req.status
wscript.echo "Status text: An error occurred on the server."
ElseIf req.status = 207 Then
wscript.echo "Status: " & req.status
wscript.echo "Status text: " & req.statustext
set oResponseDoc = req.responseXML
set oNodeList = oResponseDoc.getElementsByTagName("a:href")
set oclasslist = oResponseDoc.getElementsByTagName("d:outlookmessageclass")
For i = 0 To (oclasslist.length -2)
set oNode1 = oclasslist.nextNode
set oNode = oNodeList.nextNode
if oNode1.Text = "IPM.Schedule.Meeting.Request" then acceptcalmess(oNode.Text)
Next
Else
wscript.echo "Status: " & req.status
wscript.echo "Status text: " & req.statustext
wscript.echo "Response text: " & req.responsetext
End If

sub acceptcalmess(objhref)

Req.open "GET", objhref & "?cmd=Accept", false
Req.send
wscript.echo req.status
sDestinationURL = "http://" & server & "/exchange/" & mailbox & "/##DavMailSubmissionURI##/"
sSource = replace(lcase(objhref),"/inbox/","/drafts/")
req.open "MOVE", sSource, False
req.setRequestHeader "Destination", sDestinationURL
req.setRequestHeader "Content-Type", "message/rfc822;"
req.setRequestHeader "Translate", "f"
req.setRequestHeader "Content-Length:", Len(xmlstr)
req.send(xmlstr)
wscript.echo req.status
end sub

The last thing you might want to do in regards to processing calendar messages is to process that actual responses that come back from people so that the attendee status in the appointment is updated with accepted, rejected and any new attendees that are invited. To do this all you need to do is open the responses with the open cmd from OWA and OWA will process the request and update the meeting appropriately. To identify the response calendar messages from a request calendar messages you can use the Oulookmessageclass and see if its of type IPM.Schedule.Meeting.Resp.Pos, IPM.Schedule.Meeting.Resp.Neg, IPM.Schedule.Meeting.Resp.Tent .

server = "servername"
mailbox = "username"
strURL = "http://" & server & "/exchange/" & mailbox & "/inbox/"
strQuery = ""
strQuery = strQuery & "SELECT ""DAV:href"", ""http://schemas.microsoft.com/exchange/outlookmessageclass"""
strQuery = strQuery & " FROM scope('shallow traversal of """
strQuery = strQuery & strURL & """') Where ""DAV:ishidden"" = False AND ""DAV:isfolder"" = False AND "
strQuery = strQuery & """DAV:contentclass"" = 'urn:content-classes:calendarmessage'
"
set req = createobject("microsoft.xmlhttp")
req.open "SEARCH", strURL, false
req.setrequestheader "Content-Type", "text/xml"
req.setRequestHeader "Translate","f"
req.send strQuery
If req.status >= 500 Then
wscript.echo "Status: " & req.status
wscript.echo "Status text: An error occurred on the server."
ElseIf req.status = 207 Then
wscript.echo "Status: " & req.status
wscript.echo "Status text: " & req.statustext
set oResponseDoc = req.responseXML
set oNodeList = oResponseDoc.getElementsByTagName("a:href")
set oclasslist = oResponseDoc.getElementsByTagName("d:outlookmessageclass")
For i = 0 To (oclasslist.length -2)
set oNode1 = oclasslist.nextNode
set oNode = oNodeList.nextNode
select case oNode1.Text
case "IPM.Schedule.Meeting.Resp.Neg" acceptcalmess(oNode.Text)
case "IPM.Schedule.Meeting.Resp.Tent" acceptcalmess(oNode.Text)
case "IPM.Schedule.Meeting.Resp.Pos" acceptcalmess(oNode.Text)
end select
Next
Else
wscript.echo "Status: " & req.status
wscript.echo "Status text: " & req.statustext
wscript.echo "Response text: " & req.responsetext
End If

sub acceptcalmess(objhref)

Req.open "GET", objhref & "?cmd=Open", false
Req.send
wscript.echo req.status
end sub



Note processing the meeting responses this way does not delete the response you have to do this manually.

What about task requests?
Task requests seem to be a little different OWA for example doesn’t give you the option to process task requests. So this method is really not applicable.

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