Thursday, September 29, 2005

Reporting on Disconnected mailboxes and showing when they will be purged in Exchange 2003

One of cool things you can do in Exchange 2003 using the Exchange_Mailbox WMI class in you can show all the disconnected mailboxes by querying the DateDiscoveredAbsentInDS property which gets set after the “Cleanup Agent” has detected that there is no longer a Active Directory account associated with this mailbox. To make this information really useful in a report you need to combine it with what the Mailbox retention settings are on the mail-store where this mailbox is located. This will tell you when the mailbox is going to be deleted and how many days it has left in the cache. This information may be interesting if you have a mailbox that is quite large and you want to know when that space will be recovered into the mail-store. It can also come in handy if you need to monitor your helpdesk staff to make sure they aren’t deleting any mailboxes they shouldn’t. eg you could use it to email a warning when there is only 2-3 days left before a mailbox will be permanently deleted to really make sure you want to delete this mailbox.

To do this in a script you need to relate the mailbox stores msExchMailboxRetentionPeriod property with WMI’s DateDiscoveredAbsentInDS property and then use some of the VBS datetime functions to work out when the Mailbox will be permanently deleted. For this the ADO data shape provider again comes in handy in creating a disconnected recordset that will allow you to create a data shape that will relate mailboxes retrieved from the Exchange_Mailbox class with the store that they are in. The script outputs the results to the command window and also creates a CSV file on the c:\ drive called deletedmbrep.csv.

The msExchMailboxRetentionPeriod is an AD property that is held on each mailstore object in Active Directory and represents the number of seconds for the Mailbox retention setting. This gets converted to and from days when you view and configure it in Exchange System Manager.

How the script works
A general walkthrough of this script is it first grabs the timezone information from the registry which is necessary to convert the WMI time in DateDiscoveredAbsentInDS to the right time zone. The next part of the script takes the servername you want to run this script on as a command line parameter and then queries Active directory for this server and then queries all the Mail stores on this server. For each Mailstore it retrieves the msExchMailboxRetentionPeriod and then stores this as the Parent Datashape along with the displayname of the Mailstore. The next part of the script then queries the Exchange_Mailbox WMI class for any mailboxes that have the DateDiscoveredAbsentInDS set which would indicate they are disconnected mailboxes. This information then becomes the child recordset which is related to the parent record set based on the Mailstore name. The rest of the script is to display the data first converting the msExchMailboxRetentionPeriod into days and also the Mailboxsize in to Megabytes and the WMI datetime into a vb datetime.

To run the script you need to supply the name of the server you want to run it against as a command-line parameter

Eg cscript showdelmbs.vbs servername

The script itself looks like the following I’ve put a downloadable copy here

servername = wscript.arguments(0)
set shell = createobject("")
strValueName = "HKLM\SYSTEM\CurrentControlSet\Control\TimeZoneInformation\ActiveTimeBias"
minTimeOffset = shell.regread(strValueName)
toffset = datediff("h",DateAdd("n", minTimeOffset, now()),now())
set conn = createobject("ADODB.Connection")
set com = createobject("ADODB.Command")
set conn1 = createobject("ADODB.Connection")
strConnString = "Data Provider=NONE; Provider=MSDataShape"
conn1.Open strConnString
Set iAdRootDSE = GetObject("LDAP://RootDSE")
strNameingContext = iAdRootDSE.Get("configurationNamingContext")
strDefaultNamingContext = iAdRootDSE.Get("defaultNamingContext")
Set fso = CreateObject("Scripting.FileSystemObject")
set wfile = fso.opentextfile("c:\deletedmbrep.csv",2,true)
wfile.writeline("Mailbox,MailStore,Mailbox Size(MB),Date Delete Noticed,Date
when mailbox will be purged,Days left to Deletion")
set objParentRS = createobject("adodb.recordset")
set objChildRS = createobject("adodb.recordset")
" NEW adVarChar(255) AS SOADDisplayName, " & _
" NEW adVarChar(255) AS SOADDistName, " & _
" NEW adVarChar(255) AS SOADmsExchMailboxRetentionPeriod, " & _
" ((SHAPE APPEND " & _
" NEW adVarChar(255) AS WMILegacyDN, " & _
" NEW adVarChar(255) AS WMIMailboxDisplayName, " & _
" NEW adVarChar(255) AS WMISize, " & _
" NEW adVarChar(255) AS WMIDateDiscoveredAbsentInDS, " & _
" NEW adVarChar(255) AS WMIStorename) " & _
" RELATE SOADDisplayName TO WMIStorename) AS MOWMI"
objParentRS.LockType = 3
objParentRS.Open strSQL, conn1
Conn.Provider = "ADsDSOObject"
Conn.Open "ADs Provider"
svcQuery = "<LDAP://" & strNameingContext & ">;(&(objectCategory=msExchExchangeServer)(cn="
& Servername & "));cn,name,distinguishedName,legacyExchangeDN;subtree"
Com.ActiveConnection = Conn
Com.CommandText = svcQuery
Set Rs = Com.Execute
while not rs.eof
sgQuery = "<LDAP://" & strNameingContext & ">;(&(objectCategory=msExchPrivateMDB)(msExchOwningServer="
& rs.fields("distinguishedName") & "));cn,name,displayname,msExchMailboxRetentionPeriod,distinguishedName,
Com.CommandText = sgQuery
Set Rs1 = Com.Execute
while not rs1.eof
objParentRS("SOADDisplayName") = rs1.fields("displayname")
objParentRS("SOADDistName") = left(rs1.fields("distinguishedName"),255)
objParentRS("SOADmsExchMailboxRetentionPeriod") = rs1.fields("msExchMailboxRetentionPeriod")
wscript.echo "finished 1st AD query Mailbox Stores"
Set objchild = objParentRS("MOWMI").Value
strWinMgmts ="winmgmts:{impersonationLevel=impersonate}!//"& servername
Set objWMIExchange = GetObject(strWinMgmts)
Set listExchange_MailboxSizes = objWMIExchange.ExecQuery("Select * FROM
Exchange_Mailbox Where DateDiscoveredAbsentInDS IS NOT Null",,48)
For each objExchange_Mailboxs in listExchange_MailboxSizes
objchild("WMILegacyDN") = objExchange_Mailboxs.LegacyDN
objchild("WMIMailboxDisplayName") = objExchange_Mailboxs.MailboxDisplayName
objchild("WMISize") = objExchange_Mailboxs.Size
objchild("WMIDateDiscoveredAbsentInDS") =
objchild("WMIStorename") = objExchange_Mailboxs.storename
wscript.echo "finished Exchange WMI query"
Do While Not objParentRS.EOF
Set objChildRS = objParentRS("MOWMI").Value
MSdisplayname = objParentRS("SOADDisplayName")
wscript.echo "Mailbox Store : " & MSdisplayname
if objParentRS("SOADmsExchMailboxRetentionPeriod") <> 0 then
retrate = objParentRS("SOADmsExchMailboxRetentionPeriod")\24\60\60
retrate = 0
end if
wscript.echo "Current Retention Rate : " & retrate & " days"
Wscript.echo "Number of Deleted Mailboxes not yet purged : " &
if objChildRS.recordcount <> 0 then
wscript.echo "Disconnect Mailboxes"
end if
Do While Not objChildRS.EOF
mbsize = objChildRS("WMISize")
wscript.echo "Mailbox : " & objChildRS.fields("WMIMailboxDisplayName")
wscript.echo "Size of Mailbox : " & formatnumber(mbsize/1024,2) & " MB"
deldate =
4), Mid(objChildRS.fields("WMIDateDiscoveredAbsentInDS"), 5, 2),
Mid(objChildRS.fields("WMIDateDiscoveredAbsentInDS"), 7, 2)) & " " &
timeserial(Mid(objChildRS.fields("WMIDateDiscoveredAbsentInDS"), 9, 2),Mid(objChildRS.fields("WMIDateDiscoveredAbsentInDS"),
11, 2),Mid(objChildRS.fields("WMIDateDiscoveredAbsentInDS"),13, 2))))
wscript.echo "Date Deletetion was Detected : " & deldate
wscript.echo "Date when Mailbox will be purged : " & dateadd("d",retrate,deldate)
wscript.echo "Number of Days to Mailbox purge : " &
wfile.writeline(replace(objChildRS.fields("WMIMailboxDisplayName"),",","") & ","
& replace(MSdisplayname,",","") & "," & replace(formatnumber(mbsize/1024,2),",","")
& "," & deldate & "," & dateadd("d",retrate,deldate) & "," &
datediff("d",deldate,dateadd("d",retrate,deldate)) )
Wscript.echo "CSV file created"

Showing status of all SMTP Virtual Servers in your domain

The status of your SMTP virtual servers eg whether the server is Started, Stopped, Paused is held in the IIS Metabase on your Exchange server in the ServerState property. If you wanted to query this value from a script there is a ADSI provider for IIS which allows you to connect to the Metabase and retrieve this value much like you can with Active Directory.

Armed with this information you can now create a script that first queries Active Directory for all the Virtual Server objects within a domain. Then using the properties on these Virtual server object you can determine the servername of each server where the VS exists and then connect to the Metabase on that server and retrieve the Serverstate property. So you end up with a simple script that will give you a status of all the SMTP virtual servers in you AD domain. This script looks like the following I’ve put a downloadable copy here

set conn = createobject("ADODB.Connection")
set com = createobject("ADODB.Command")
Set iAdRootDSE = GetObject("LDAP://RootDSE")
strNameingContext = iAdRootDSE.Get("configurationNamingContext")
strDefNamingContext = iAdRootDSE.Get("defaultNamingContext")
Conn.Provider = "ADsDSOObject"
Conn.Open "ADs Provider"
Com.ActiveConnection = Conn
Com.ActiveConnection = Conn
Wscript.echo "SMTP Virtual Servers Status"
vsQuery = "<LDAP://" & strNameingContext & ">;(objectCategory=protocolCfgSMTPServer);name,distinguishedName;subtree"
Com.ActiveConnection = Conn
Com.CommandText = vsQuery
Set Rs = Com.Execute
While Not Rs.EOF
strstmsrv = "LDAP://" & rs.fields("distinguishedName")
set svsSmtpserver = getobject(strstmsrv)
wscript.echo "ServerName:" &

sub getSTMPstatus(servername,vsname)
Set SMTPVSS = GetObject("IIS://" & Servername & "/SMTPSVC")
for each SMTPVS in SMTPVSS
if SMTPVS.KeyType = "IIsSmtpServer" then
if SMTPVS.ServerComment = vsname then
wscript.echo "SMTP Server : " & SMTPVS.ServerComment
select case SMTPVS.ServerState
case 1 Wscript.echo "Current State: Starting"
case 2 Wscript.echo "Current State: Started"
case 3 Wscript.echo "Current State: Stopping"
case 4 Wscript.echo "Current State: Stopped"
case 5 Wscript.echo "Current State: Pausing"
case 6 Wscript.echo "Current State: Paused"
case 7 Wscript.echo "Current State: Continuing"
case else Wscript.echo "unknown"
end select
end if
end if

end sub

Wednesday, September 21, 2005

Importing Vcards from vcf files to Outlook Contacts and Vcard conversion Event sink

Over the past week I’ve been working on some code to convert vcards from the Palm Desktop software into Contacts that can be stored in either the Outlook Contacts folder or a Public Contacts folder. You can read more about the vcard format at . Vcards are great for exchanging information and you’ll find them in use on everything from Mobiles to I believe some Ipods now support vcards. I’ve come up with a couple of versions of this script the first script will take a directory that contains Vcards and create a new contact for each vcard file in the directory. The other thing I’ve created is a Event sink so you can send a mail that has an attached vcard the sink will detach the vcard and create a contact within that folder from the information that’s contained in the Vcard. As I was mainly working with the Palm Desktop software this software also allowed the inclusion of a photo within the Vcard so this script also handles converting this photo into a Jpg and attaching it to the contact so it can be displayed in Outlook 2003 Contact picture section.

How does it work

To get this to work I’ve had to use multiple API’s to do each of the bits I needed. The first API that is used is CDOEX which has the ability to create a Vcard stream from a existing Oultook Contact which we can use in reverse via the ADO streams interface to create a contact from a Vcard file (pretty easy actually). That’s really the basis of the code the one thing that CDOEX cant do is understand the Photo section in the vcard stream (if one exists) so this is where some custom code is required to firstly decode the base64 MIME part turn it into a jpg file and then attach it to the contact and manipulate the correct MAPI properties.

To decode the photo MIME part CDOEX is used again but this time the Bodypart interface is used and the ADO stream interface is again used to decode the base64 MIME part and turn it back into a downloadable file. Once the Contact Picture has been downloaded and attached to the contact the EntryId for the contact is then retrieved and used in a section of CDO code which then connects to the same contact and sets some Mapi properties on the attachment itself that tell outlook that there is a contact picture for this contact. I’ve explained why MAPI is necessary and the properties that are set in this post last week. Both these scripts are setup to use public contacts folders if you want to do this in a mailbox there are a few modification that need to be made to the script which I’ll point out later

Using it with the PalmDesktop

Another script I’ve included in the download is a script that will split apart the export from the PalmDesktop software. One good feature of this software is that you have the ability to export your conacts to a VCF file. But if you select multiple contacts and do an export then all you contacts get exported to one file. To split this one export file into a separate VCF’s for each contact I’ve included a simple script that will split this out (splitvcf.vbs).

Running the Import Script

The import script has a few hard-coded variables you may need to modify before running it first

public const pfPublicContactsFolder = file://./backofficestorage/ folders/pubcontacts/

This is the Exoledb file URI of the folder where you want to import the vcards to (note I’m using a public folder but someone’s contacts folder will work just as well)

public const vcardfolder = "c:\vcardimport"

This is the folder where the Vcards are located that you want to import make sure you only have Vcards in the folder the script doesn’t differentiate

public const mapiserver = "servername"

The in the Mailserver name this is required so the CDO section of the script can logon

public const mapimailbox = "mailbox"

This is a mailbox that exists on the same server as the public folder you’re adding the contacts to the user running the script must have permission to logon to this mailbox.

Once you have made these modifications to the script you should be ready to go

Changing the script to use a Mailbox instead of a public folder.

The main change if you are using a Mailbox instead of a public folder is after you have changed the Exoledb file URI is that you need to modify the CDO section of the code so it doesn’t use the public folder store when it goes to call getmessage eg change the following line

set objmessage = objSession.getmessage(eiEntryID,objpubstore.ID) to

set objmessage = objSession.getmessage(eiEntryID)

Using the Event Sink

The eventsink is the same as the Import script except that it’s designed to be used unattended. So it will fire and add contacts to the folder it’s registered on before registering the event sink however you need to make sure you set the following two variables.

public const mapiserver = "servername"
public const mapimailbox = "mailbox"

These need to be set to a mailbox that is on the same server as the public folder (or mailbox). You also need to make sure the account that the Exoledb.scripthost is running under has rights to logon to this mailbox. A few things to note about the event sink is that firstly it DELETES the message that was sent to it with the attached VCard. So if you want to run this in a mailbox you would need to change this also you need to change the section so it will create the contact in the desired contacts folder instead of the folder where the sink is registered. And also it only will fire on messages sent to that mail-enabled folder and not copied into the folder (this was mainly a safety mechanism to stop the dreaded never-ending sink loop)

I’ve put a download of the scripts here the event sink code looks like


public const mapiserver = "servername"
public const mapimailbox = "mailbox"

Sub ExStoreEvents_OnSave(pEventInfo, bstrURLItem, lFlags)
on error resume next

Const EVT_NEW_ITEM = 1

If (lFlags And EVT_IS_DELIVERED) Then

set objmessage = createobject("CDO.Message") bstrURLItem
if objmessage.fields("DAV:contentclass").value = "urn:content-classes:message"
Set objAttachments = objMessage.Attachments
If objAttachments.Count <> 0 Then
For Each objAttachment In objAttachments
fatt1 = len(objAttachment.filename)
fatt2 = fatt1 - 2
attname = UCASE(objAttachment.filename)
if lcase(mid(attname,fatt2,3)) = "vcf" then
Set Strm = objAttachment.GetDecodedContentStream
call ProcVcard(Strm.readtext,objmessage.fields("DAV:parentname").value)
delmsg = 1
end if
End If
End If
End if
set objmessage = nothing
if delmsg = 1 then
set rec = createobject("ADODB.Record") bstrURLItem,,3
set rec = nothing
end if

End Sub

sub ProcVcard(vcardstream,pfPublicContactsFolder)
pfPublicContactsFolder = pfPublicContactsFolder & "/"
cphoto = 0
set contobj1 = createobject("CDO.Person")
set stm1 = contobj1.getvcardstream()
stm1.type = 2
stm1.Charset = "x-ansi"
stm1.writetext = vcardstream
vcararry = split(vcardstream,vbcrlf)
for i = lbound(vcararry) to ubound(vcararry)
if instr(vcararry(i),"PHOTO;")then
cphoto = 1
if cphoto = 1 then
if instr(vcararry(i)," ") then
photovcard = photovcard & vcararry(i) & vbcrlf
cphoto =2
end if
end if
end if
Randomize ' Initialize random-number generator.
rndval = Int((20000000000 * Rnd) + 1)
contname = pfPublicContactsFolder & day(now) & month(now) & year(now) & hour(now)
& minute(now) & rndval & ".eml"
contobj1.fields("urn:schemas:mailheader:subject").value = contobj1.fileas
if contobj1.fields("urn:schemas:mailheader:subject").value = "" then
contobj1.datasource.saveto contname
set contobj1 = nothing
if cphoto = 2 then
set objmessage = createobject("CDO.Message") contname,,3
Set objbpart = objmessage.BodyPart.AddBodyPart
Set Flds = objbpart.Fields
Flds("urn:schemas:mailheader:content-type") = "image/jpeg"
Flds("urn:schemas:mailheader:content-disposition") = "attachment;filename=ContactPicture.jpg"
Flds("urn:schemas:mailheader:content-transfer-encoding") = "base64"
set Stm = createobject("ADODB.Stream")
Set Stm = objbpart.GetEncodedContentStream
stm.type = 2
Stm.writetext photovcard
Set fso = CreateObject("Scripting.FileSystemObject")
if (fso.FileExists("c:\temp\ContactPicture.jpg")) Then
End If
objbpart.savetofile "c:\temp\ContactPicture.jpg"
objmessage.addattachment "c:\temp\ContactPicture.jpg"
= true
objmessage.fields("") =
eiEntryID = Octenttohex(objmessage.fields("").value)
set objSession = CreateObject("MAPI.Session")
Const Cdoprop1 = &H7FFF000B
const Cdoprop2 = &H370B0003
const Cdoprop3 = &HE210003
strProfile = mapiserver & vbLf & mapimailbox
objSession.Logon "",,, False,, True, strProfile
Set objInbox = objSession.Inbox
Set objInfoStore = objSession.GetInfoStore(objSession.Inbox.StoreID)
Set objpubstore = objSession.InfoStores("Public Folders")
set objmessage = objSession.getmessage(eiEntryID,objpubstore.ID)
set objAttachments = objmessage.Attachments
For Each objAttachment In objAttachments
objAttachment.fields.add Cdoprop1,"True"
objAttachment.fields(Cdoprop2).value = -1

end if
end if

end sub

Function Octenttohex(OctenArry)
ReDim aOut(UBound(OctenArry))
For i = 1 to UBound(OctenArry) + 1
if len(hex(ascb(midb(OctenArry,i,1)))) = 1 then
aOut(i-1) = "0" & hex(ascb(midb(OctenArry,i,1)))
aOut(i-1) = hex(ascb(midb(OctenArry,i,1)))
end if
Octenttohex = join(aOUt,"")
End Function


Friday, September 16, 2005

Add a Picture to Contact in Outlook 2003 via Script

I'm currently writing some code for an event sink that will convert a Vcard attached to a message into a contact in a public folder. Mostly the Vcards that I want to import are from the Palm desktop software which allows you to add images into the contact similar to the new functionality added to Outlook 2003. So as part of my code I had to come up with something that would decode the picture from the vcard file and then add it to the contact in a way Outlook 2003 would understand it. Although I haven't quite finish the vcard code i thought this was worth a separate post.

Basically to add a picture to a contact in Outlook you need to first have the file in jpg format and the name of the file your going to attachment must be ContactPicture.jpg. Once you have attached that file you then need to modify/Add 2 properties on that attachment itself. The only API that you can use to successfully do this (well that I've found) is MAPI. So this means you need to use CDO 1.2 if your scripting. The two props you need to set are

H7FFF000B Set it to true which makes outlook 2003 hide the attachment(still visible in 2002 though)
H370B0003 PR_RENDERING_POSITION needs to be set to -1

The other thing that needs to be done is you need to add a property to the contact itself that tells Outlook that there is Picture for the contact. This property is the named property {00062004-0000-0000-C000-000000000046}0x8015 .

I've put a barebones script together that will do this using a hardcode EntryID that needs to be pulled from the contact using OulookSpy or pfDavAdmin. I've posted a downloadable copy of the code here the script itself looks like.

mapiserver = "servername"
mapimailbox = "mailbox"
contactEntryID = "000000002F7E...etc"
filename = "c:\temp\ContactPicture.jpg"
set objSession = CreateObject("MAPI.Session")
Const Cdoprop1 = &H7FFF000B
const Cdoprop2 = &H370B0003
strProfile = mapiserver & vbLf & mapimailbox
objSession.Logon "",,, False,, True, strProfile
Set objInbox = objSession.Inbox
Set objInfoStore = objSession.GetInfoStore(objSession.Inbox.StoreID)
set objmessage = objSession.getmessage(contactEntryID)
set objAttachments = objmessage.Attachments
Set objAttachment = objmessage.Attachments.Add
objAttachment.Position = -1
objAttachment.Type = 1
objAttachment.Source = filename
objAttachment.ReadFromFile filename
For Each objAttachment In objAttachments
if = "ContactPicture.jpg" then
objAttachment.fields.add Cdoprop1,"True"
objAttachment.fields(Cdoprop2).value = -1
end if
objmessage.fields.add "0x8015",11,"true","0420060000000000C000000000000046"

Thursday, September 15, 2005

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

I posted a script that did this using ADO/Exoledb some time ago here someone asked this week about doing the same thing using WebDAV. In WebDAV to create a folder you use the MKCOL verb eg but if you try and issue this against a URL that already exist then it will throw a 405 error. While dealing with such an error is not that difficult an alternative to doing this is to first do a search against the parent folder to see if that folder exists and then take the appropriate action. A script to do this looks like the following I've posted a downloadable copy here. The script itself looks for a folder called Spamfolder within the inbox if it doesn't find it then it creates it using MKCOL.

server = "Servername"
mailbox = "Mailbox"
NewFLd = "Spamfolder"
strURL = "http://" & server & "/exchange/" & mailbox & "/inbox/"
strQuery = ""
strQuery = strQuery & "SELECT """""
strQuery = strQuery & " FROM scope('shallow traversal of """
strQuery = strQuery & strURL & """') Where ""DAV:ishidden"" = False AND ""DAV:isfolder"" = True AND "
strQuery = strQuery & """"" = '" & NewFLd & "'
set req = createobject("microsoft.xmlhttp") "SEARCH", strURL, false
req.setrequestheader "Content-Type", "text/xml"
req.setRequestHeader "Translate","f"
req.send strQuery
If req.status >= 500 Then
ElseIf req.status = 207 Then
set oResponseDoc = req.responseXML
set oNodeList = oResponseDoc.getElementsByTagName("d:x3001001E")
wscript.echo oNodeList.length
if oNodeList.length <> 0 then
wscript.echo "Folder Already Exists"
call Createfolder(NewFld,strURL)
end if
End If

Sub Createfolder(fldname,parentfolder)

nfolderURL = parentfolder & "/" & fldname & "/" "MKCOL", nfolderURL, false
req.setrequestheader "Content-Type", "text/xml"
req.setRequestHeader "Translate","f"
if req.status = 201 then
Wscript.echo "Folder created sucessfully"
wscript.echo req.status
wscript.echo req.statustext
end if

end sub

Wednesday, September 07, 2005

OT: Back online

Just a quick post to say im back online after a good holiday im still trying to catch up on everything. This is one of the more amusing signs that I came across while on holidays.