SMTP Server Transport Events - Simple Scripting

• Download source files - 9 Kb

Introduction

This article describes SMTP Transport Events in the Microsoft SMTP server. The article shows how to write simple scripts and how to install these scripts. The article also shows how to write incoming emails to a database and how to mark incoming emails with a red follow up flag.

Background

Recently I was asked to work out a way to get Exchange 2000 to mark some incoming emails with a red follow up flag. I started looking through MSDN and I came across SMTP Server Events. I discovered that there are 2 types of events:

• Protocol Events
• Transport Events

This article is going to discuss transport events.

Transport events occur when an email has been received by the SMTP server. The event that I want to discuss is the OnSubmission event, there are 2 other events: OnPreCategorize and OnPostCategorize. The OnTransportSubmission event is the same event as the CDO for Windows 2000 OnArrival event. The OnTransportSubmission event is called with the following prototype:

Sub ISMTPOnArrival_OnArrival(ByVal Msg, EventStatus)

A CDO MailMsg object is passed into the sub routine, with this we have full access to the email that the server is processing. So the full code to add a red follow up flag would be:

On Error Resume Next

Const cdoRunNextSink = 0

Sub ISMTPOnArrival_OnArrival(ByVal Msg, EventStatus)
 
    On Error Resume Next 
        Set Flds = Msg.Fields
        With Flds
            .Item("urn:schemas:httpmail:messageflag") = True
            .Item("urn:schemas:mailheader:x-message-flag") = True
            .Update
        End With
    ' save changes to the mail

    Msg.Datasource.Save
    ' continue with the next event sink

    EventStatus = cdoRunNextSink

End Sub		

On another project we wanted to automatically add bounced email to our database, the code to do this would look something like this:

On Error Resume Next

Const cdoRunNextSink = 0

Const adCmdStoredProc = &H0004
Const adVarChar = 200
Const adWChar = 130
Const adParamInput = &H0001


Sub ISMTPOnArrival_OnArrival(ByVal Msg, EventStatus)

  On Error Resume Next 

    Dim objConnection, objCommand, strConnection, intLen
    Dim strBody, strToEmail, strFromEmail, strSubject

    strToEmail = Msg.To
    strFromEmail = Msg.From
    strSubject = Msg.Subject
    strBody = Msg.TextBody


    If strBody <> "" Then
      intLen = Len(strBody) + 1
    Else
      intLen = 1
    End If

    strConnection = _
      "Provider=SQLOLEDB;SERVER=localhost;Initial Catalog=databasename;User ID=;Password=;"

    Set objConnection = CreateObject("ADODB.Connection")
    Set objCommand = CreateObject("ADODB.Command")

    Call objConnection.Open(strConnection)

    objCommand.ActiveConnection = objConnection
    objCommand.CommandType = adCmdStoredProc
    objCommand.CommandText = "spAddBouncedEmail"

	
    objCommand.Parameters.Append objCommand.CreateParameter("ToEmail", adVarChar, _
        adParamInput, 255, strToEmail)
    objCommand.Parameters.Append objCommand.CreateParameter("FromEmail", adVarChar, _
        adParamInput, 255, strFromEmail)
    objCommand.Parameters.Append objCommand.CreateParameter("Subject", adVarChar, _
        adParamInput, 255, strSubject)
    objCommand.Parameters.Append objCommand.CreateParameter("Body", adWChar, _
        adParamInput, intLen, strBody & " ")
	
    objCommand.Execute

    ' continue with the next event sink

    EventStatus = cdoRunNextSink

End Sub
		

Using the code

Microsoft were very kind to provide us with a VB script that helps us to install our scripts, it's called smtpreg.vbs
To install a script:

cscript smtpreg.vbs /add 1 onarrival BouncedEmail CDO.SS_SMTPOnArrivalSink 
    "rcpt to=*@somewhere.com;rcpt to=*@somewhere.net"

This adds an event called BouncedEmail onarrival with an entry point of ISMTPOnArrival_OnArrival which will be applied to all recipients that match '*@somewhere.com' and '*@somewhere.net'.

Now we need to tell the server which script to run:

cscript smtpreg.vbs /setprop 1 onarrival BouncedEmail Sink ScriptName "path_to_scriptfile"

This just sets the property on the BouncedEmail event, telling it where to locate the script.

Un-installation is a simple process:

cscript smtpreg.vbs /remove 1 onarrival BouncedEmail

Points of Interest

I came across an interesting problem whilst implementing the red follow-up flag. The client wanted incoming emails to be marked with the follow up as well as internal emails going to a certain address. At first this wasn't working for internal addresses, this is because Outlook uses MAPI to communicate with exchange rather than SMTP. Microsoft issued this KB Article explaining the problem. The work around is pretty messy, it involves adding a new virtual SMTP server and bouncing emails off it, this makes the event fire because it goes from outlook to exchange as MAPI then from exchange to the virtual SMTP server back to exchange again.

I hope this simple article can provoke some thought. I might mention that you can write your own COM add-ins that perform the same functions, of course these would give better performance. I wouldn't like to run these VB scripts on a server that has a very high demand, you might notice some performance problems. The projects I've used these techniques on have suffered no such problems however.

Some interesting links that relate to SMTP Transport Events:

• How to write mailing rules
• CDO Reference

History

• 20/12/2002 - Article Created