Subject: code
I’d have preferred to post this as a file but that’s not allowed so I hope linebreaks don’t make the following too difficult to use.
This runs as a WQS agent on a web form - that’s not included but it should be clear where you need to change things. There’s WQO agent on the form too - also not enclosed, all it does is pre-populate the Principal and replyto fields with an address from an external database.
The Bcc field is also populated from defaults built into the form.
The restriction on only certain browsers sending MIME messages in the code is simply because our wysiwyg editor doesn’t support some (like Opera) so they only get to enter plain text.
If received messages have odd characters in them try changing the character set. We used iso-8859-1 first but it couldn’t cope with smart quotes etc pasted from Word - Windows-1252 does appear to cope. Other char sets may be better in your situation.
We haven’t been using this long so there are probably lots of rough edges to discover. It does allow you to (apparently) send messages from whatever address goes into the Principal field (it doesn’t have to exist in the NAB for example).
'WQSBroadcast:
Option Declare
Option Public
%INCLUDE “lsconst.lss”
'CONSTANTS
’ temporary location for attachments to be sent with email messages
Public Const tempFilePath$ = "C:\TEMP"
'mailbox for sent emails
Public Const blackHole$ = “myemailarchive@company.co.uk”
'helpdesk mailbox used in reply to field on message
Public Const learnTech$ = “helpdesk@company.co.uk”
Dim session As NotesSession
Dim dbApp As NotesDatabase
Dim docWebForm As NotesDocument
'the email document
Dim msgDoc As NotesDocument
’ reference to servers/local NAB
Dim dbNames As NotesDatabase
’ the ($MailGroups) view in NAB
Dim viewNABMailGroups As NotesView
'same variable is used to reference multiple views
Dim vwApp As NotesView
Dim docMailGroup As NotesDocument
'body field on FORM
Dim formBody As NotesRichTextItem
'body field on Email message sent
Dim mailBody As NotesRichTextItem
Dim bccItem As NotesItem
Dim fileAttach As NotesEmbeddedObject
Dim mailGroupName As String
'array of unique email address in blindCopyTo field
Dim emailsInBccGroup() As String
Dim siteHome As Variant
’ “name@company.co.uk”
Dim SMTP821Address As String
'agent logging variables
Dim agent As NotesAgent
Dim agentLog As NotesLog
Sub READ_ME
%REM
Summary: A WebQuerySave agent that runs on the Broadcast form. Its purpose is to send emails to everyone
in the (automatically updated) "Newsletter" group using user supplied text and optional attached file.
The Newsletter group is currently about 400 RFC821-style addresses derived from an external database.
There are 2 types of email sent:
MIME - If the browser supports XINHA then the message is probably HTML and is sent as MIME so that it is correctly encoded.
PLAIN - If the browser (eg safari on mac) does not support XINHA then the message is sent as plain text.
Large emails ( >5 Mb here) may be sent off peak (overnight) depending due to server mail settings in the NAB.
Nothing is sent if the sendto, copy to, & blindcopy fields are empty.
For an explanation of SMTP headers (envelope and message headers) see
http://www.cns.utoronto.ca/usg/technotes/smtp-intro.html
http://tools.ietf.org/html/rfc2076#section-3.8
http://www.cs.tut.fi/~jkorpela/headers.html
%END REM
End Sub
Sub Initialize
Dim browser As String
’ get handle on the current NSF
Set session = New NotesSession
Set dbApp = session.CurrentDatabase
’ Setting up agent logging
Set agent = session.CurrentAgent
Set agentLog = New NotesLog( dbApp.FilePath & ": " & dbApp.Title & " " & agent.Name )
’ set this value to FALSE when everything is working reliably
agentLog.LogActions = True
agentLog.LogErrors = True
Call agentLog.OpenNotesLog( "", "AgentLog.NSF" )
On Error Goto ErrorCleanUp
’ Currently open form
Set docWebForm = session.DocumentContext
’ field populated in WQO
Call agentlog.LogAction( "message apparently by " & docWebForm.Principal(0) )
’ the web version of the dbPATH
siteHome = Evaluate("@WebDbName")
’ message should not be sent if there is no recient provided … no addresses to send to
If docWebForm.BlindCopyTo(0) = "" And docWebForm.CopyTo(0) = "" And docWebForm.SendTo(0) = ""Then
Print “[http://” & docWebForm.SERVER_NAME(0) & “/” & sitehome(0) & “/EmailSent?ReadForm]”
’ use javascript check on form to insist on at least one recipient
Goto Finish
’ get the contents of the body field in current document
Else
Set formBody = docWebForm.GetFirstItem( “Body” )
’ send via MBOX later
Set msgDoc = New NotesDocument( dbApp )
’ emailsInBccGroup()
Call createBccList
’ the message header fields, to, copy, blindcopy etcetera
Call setMessageHeaders()
’ a form default
’ BCC uses a big distribution list in the field default value
’ only some browsers support XINHA - Firefox/2 Firefox/3 MSIE
browser$ = docWebForm.HTTP_User_Agent(0)
If Instr(browser$,“Firefox/2”)>0 Or Instr(browser$,“Firefox/3”)>0 Or Instr(browser$,“MSIE”)>0 Then
Call SendMIME( )
Else
’ browsers not supporting XINHA editor, e.g. Safari, Opera get a plain textarea
Call SendPlain( )
End If
’ confirmation page
Print “[https://” & docWebForm.SERVER_NAME(0) & “/” & sitehome(0) & “/EmailSent?ReadForm]”
End If
Finish:
Call agentLog.Close
Exit Sub
ErrorCleanUp:
Call agentLog.LogError( Err, Error$ & " (initialize) at line " & Cstr( Erl() ))
Call agentLog.Close
End Sub
Sub setMessageHeaders()
’ Specifies the values for the message headers required by SMTP
’ blindcopy field is set by the form default values
’ principal field is set by the form WebQueryOpen agent as an SMTP RFC822-style address
’ principal value for the mail message must be set after the MIME values are set, in sendMIME
On Error Goto errHeaders
msgDoc.Form = "Memo"
’ from the form e.g. “Janet User” j.user@mysite.co.uk
msgDoc.From = docWebForm.Principal(0)
’ SMTP821 or 822
msgDoc.SendTo = docWebForm.GetItemValue( "SendTo" )
’ SMTP821 only
msgDoc.CopyTo = docWebForm.GetItemValue( "CopyTo" )
’ sender or learning technology, SMTP821 only
msgDoc.ReplyTo = docWebForm.GetItemValue( "ReplyTo" )
’ always a single value
msgDoc.Subject = docWebForm.Subject(0)
’ Domino can delay delivery of low priority messages until off-peak
If docWebForm.DeliveryPriority(0) <> "N" Then msgDoc.DeliveryPriority = docWebForm.DeliveryPriority(0)
’ Most mail readers will flag high importance messages
If docWebForm.Importance(0) <> "Normal" Then msgDoc.Importance = docWebForm.Importance(0)
’ Currently most mail readers do NOT display keywords and Categories can’t be sent with the message
If docWebForm.Keywords(0) <> "" Then msgDoc.Keywords = docWebForm.Keywords(0)
’ set in createBccList
msgDoc.BlindCopyTo = emailsInBccGroup()
Set bccItem = msgDoc.GetFirstItem( "BlindCopyTo" )
’ bcc all broadcasts to mail archive
Call bccItem.AppendToTextList( BlackHole$ )
’ Principal field on form should contain something like: “Janet User” j.user@mysite.co.uk
’ Convert to rfc 821 from 822
’ If Instr(docWebForm.Principal(0),“<”) > 0 Then
’ e.g. my.name@company.co.uk
’ SMTP821Address$ = Strleft(Strright(docWebForm.Principal(0),“<”),“>”)
’ Else
’ assume it was SMTP821 already
’ SMTP821Address$ = docWebForm.Principal(0)
’ End If
’ msgDoc.Principal must be set after any MIME stuff - with “@NotesDomain” appended, see sendMIME
Exit Sub
errHeaders:
Call agentLog.LogError( Err, Error$ & " (setMessageHeaders) at line " & Cstr( Erl() ))
End Sub
Sub createBccList( )
%REM
This routine creates a list of unique addresses for recipients made up of entries
in bcc. Entries are stored in a growing array
%END REM
Dim i As Integer
On Error Goto ErrCreateBccLists
i% = 0
’ will contain the emails in the BCC field of the current document
Redim emailsInBccGroup(0)
Forall a In docWebForm.BlindCopyTo
'search for the email address in the array defined above
’ a new address, SMTP821 only
If Isnull( Arraygetindex( emailsInBccGroup, a, 5 ) ) Then
’ array grows dynamically
Redim Preserve emailsInBccGroup$( i% )
’ a can be an email address in SMTP form, Notes email address or notes mail group
emailsInBccGroup( i% ) = a
i% = i% + 1
End If
End Forall
Finish:
Exit Sub
ErrCreateBccLists:
Call agentLog.LogError( Err, Error$ & " (createBccList) at line " & Cstr( Erl() ))
End Sub
Sub sendMime( )
’ OTHER Message HEADERS ARE SET IN Sub setMessageHeaders
'sends message in MIME format.
Dim mimeHeader As NotesMimeHeader
Dim body As NotesMimeEntity
Dim mimeChild As NotesMimeEntity
Dim stream As NotesStream
On Error Goto errSendMime
’ indicates whether items of type MIME_PART are converted to rich text upon NotesItem instantiation.
session.ConvertMIME = False
'creates parent entity
'item containing the MIME entity
Set body = msgDoc.CreateMIMEEntity()
'create header for content-type
Set mimeHeader = body.CreateHeader( {MIME-Version} )
Call mimeHeader.SetHeaderVal( "1.0" )
Set mimeHeader = body.CreateHeader( "Content-Type" )
Call mimeHeader.SetHeaderValAndParams( {multipart/alternative;boundary="=NextPart_="})
’ Send the plain text part first
Set mimeChild = body.createChildEntity()
Set stream = session.createStream()
Call stream.WriteText("If you can't read the message, please go to: http://www.company.co.uk/" )
Call mimeChild.setContentFromText( stream, {text/plain}, ENC_NONE )
Call stream.Close
’ next send the html, the sequence is apparently important (see codestore ref below)
’ and insert it into the list of child MIME entities.
Set mimeChild = body.CreateChildEntity()
Set stream = session.CreateStream()
Call stream.WriteText( |<html><head>|, EOL_CR )
Call stream.WriteText( |<style> body{margin:1em;font-family:verdana,arial,helvetica,sans-serif}</style>|, EOL_CR )
Call stream.WriteText( |</head><body>|, EOL_CR )
Call stream.WriteText( formBody.GetUnformattedText(), EOL_CR )
Call stream.WriteText( |</body></html>| )
’ charset=UTF-8, iso-8859-1, Windows-1252, ISO-8859-15 - see “MIME Charset Names” in Designer help
Call mimeChild.SetContentFromText( stream, {text/html; charset="Windows-1252"}, ENC_NONE )
Call stream.Close
'code to send an attachment with the email if one has been uploaded with the form
If docWebForm.HasEmbedded Then
Forall o In formBody.EmbeddedObjects
’ puts attachment in temp folder on local or server C drive
If( o.Type = EMBED_ATTACHMENT ) Then
Call o.ExtractFile( tempFilePath$ & o.source )
Set mimeChild = body.CreateChildEntity
Set mimeHeader = mimeChild.CreateHeader( “Content-Disposition” )
Call mimeHeader.SetHeaderVal( “attachment; filename=” & o.source)
Set mimeHeader = mimeChild.CreateHeader( “Content-ID” )
Call mimeHeader.SetHeaderVal( o.source )
’ reads the stream written to above
’ would be ideal if this was not binary but there is no easy way to determine the true type of attachment
If stream.Open( tempFilePath$ & o.source, “binary”) Then
If stream.Bytes > 0 Then
Call mimeChild.SetContentFromBytes( stream, “application/octet-stream”, ENC_IDENTITY_BINARY )
End If
Call stream.Close
Call stream.Truncate
End If
’ leave no file attachments on the server!
Kill tempFilePath$ & o.Source
End If
End Forall
End If
’ not necessary
’ Call msgDoc.CloseMIMEEntities( True, “body” )
’ To change the apparent sender requires the InetFrom field to be set too (without @NotesDomain)
’ “Janet User” j.user@mysite.co.uk
msgDoc.InetFrom = docWebForm.Principal(0)
’ set the principal field which overrides the From field on the mail and must include @NotesDomain
’ some email clients display both from and sender if there is a difference
msgDoc.Principal = docWebForm.Principal(0) & "@NotesDomain"
%REM
See http://codestore.info/store.nsf/unid/BLOG-20060321 or http://notes.net/ forums for discussion of @NotesDomain & .principal
%END REM
’ no form attached, msgDoc has a sendto field
Call msgDoc.send(False)
Call agentlog.LogAction( "MIME message sent" )
Finish:
Exit Sub
errSendMime:
Call agentLog.LogError( Err, Error$ & " sendMime at line " & Cstr( Erl()) )
Exit Sub
End Sub
Sub sendPlain( )
’ OTHER Message HEADERS ARE SET IN Sub setMessageHeaders
'Sends email when the sender is not using xinha for example Safari
On Error Goto errSendPlain
Set mailBody = New NotesRichTextItem( msgDoc, "body" )
'any attachments copied below
Call mailBody.AppendText( formBody.GetUnformattedText() )
'so attachments are on a new line
Call mailBody.AddNewline( 2 )
If docWebForm.HasEmbedded Then
Forall o In formBody.EmbeddedObjects
If( o.Type = EMBED_ATTACHMENT ) Then
Call o.ExtractFile( tempFilePath$ & o.Source )
Set fileAttach = mailBody.EmbedObject( EMBED_ATTACHMENT, “”, tempFilePath$ & o.Source )
'leave no file attachments on the server!!
Kill tempFilePath$ & o.Source
End If
End Forall
End If
’ set in setMessageHeaders
msgDoc.Principal = SMTP821Address$
msgDoc.InetFrom = docWebForm.Principal(0)
’ no form attached, doc has a sendto field
Call msgDoc.send(False)
Finish:
Call agentLog.Close
Exit Sub
errSendPlain:
Call agentLog.LogError( Err, Error$ & " SendMime at line " & Cstr( Erl()) )
Call agentLog.Close
Exit Sub
End Sub