Public Class EEMail
Private JSONcontext List As String 'The JSON Paramenterd
Private m_HTMLBody As String 'The HTML Part of the message
Private m_gadgetURL As String 'The URL where the gadget.xml is at home (that needs to be authorized)
Private m_Subject As String ' The message subject
Private m_from As String 'The sender
Private m_session As NotesSession
Private m_dynamicHTML As Boolean 'Generate from Parameters
Private m_description As String ' The EE description
%REM
Sub new
Description: Create a new EEMail
%END REM
Public Sub New()
Set m_session = New NotesSession
m_from = m_session.Username
m_dynamicHTML = true
End Sub
%REM
Property Set isDynamic
Description: true = content generated from parameters
%END REM
Public Property Set isDynamic As Boolean
m_dynamicHTML = isDynamic
End Property
%REM
Property Set description
%END REM
Public Property Set description As String
m_description = description
End Property
%REM
Property Set Body
Description: THe HTML Message
%END REM
Public Property Set Body As String
m_HTMLBody = Body
End Property
%REM
Property Set gadgetURL
Description: where the gadget URL lives
%END REM
Public Property Set gadgetURL As String
m_gadgetURL = gadgetURL
End Property
%REM
Property Set subject
Description: Comments for Property Set
%END REM
Public Property Set subject As String
m_Subject = subject
End Property
%REM
Sub addParameter
Description: add a JSON Parameter to the context
%END REM
Public Sub addParameter(pName As String, pValue As Variant)
Dim workString
Dim first As Boolean
first = true
If IsArray(pValue)Then
workString = |{|
ForAll ele In pValue
If Not first Then
workString = workString + |, |
End If
first = false
workString = workString + |"|
workString = workString + CStr(ele)
workString = workString + |"|
End ForAll
workString = workString + |}|
JSONcontext(pName) = |"|+pName+|" : "| + workString +|"|
Else
JSONcontext(pName) = |"|+pName+|" : "|+CStr(pValue)+|"|
End if
End Sub
%REM
Sub sendMail
Description: Send the message
%END REM
Public Sub sendMail(SendTo As Variant)
Dim db As NotesDatabase
Dim mbox As NotesDatabase
Dim mail As NotesDocument
Dim mime As NotesMIMEEntity
set db = m_session.Currentdatabase
Set mbox = New NotesDatabase(db.Server,"mail.box") 'Breaks on multi-mailbox servers
If Not mbox.Isopen Then
Call mbox.Open("", "")
End If
m_session.Convertmime = False
Set mail = mbox.Createdocument()
'Header values
Set mime = mail.CreateMIMEEntity("Body")
Call me.addHeader(mime, "Content-Type", "multipart/alternative")
Call me.addHeader(mime, "MIME-Version", "1.0")
Call me.addHeader(mime, "Content-transfer-encoding", "7bit")
Call me.addHeader(mime, "Subject", m_subject)
Call me.addHeader(mime, "From", m_from)
ForAll rcp In SendTo
Call me.addHeader(mime, "To", CStr(rcp))
End ForAll
'Now text and embedded experience body
If Trim(me.m_HTMLBody) = "" Then
me.m_dynamicHTML = True 'Without content we generate dynamically
End If
If me.m_dynamicHTML Then
Call me.setDynamicHTMLBody(mime)
Else
Call me.setHTMLBody(mime)
End If
Call me.setEEBody(mime)
Call mail.Closemimeentities(true)
'Normal Notes fields
Call mail.ReplaceItemValue("Form","Memo")
Call mail.replaceItemValue("Recipients", SendTo)
Call mail.replaceItemValue( "From", m_from )
Call mail.Save(true, False) 'We deposit directly into the mail.box
m_session.Convertmime = True
End Sub
Public Property Set Sender As String
m_from = sender
End Property
%REM
Function setHTMLBody
Description: Get the human readable body of the eMail
%END REM
Private Sub setHTMLBody(mime As NotesMIMEEntity)
Dim out As NotesStream
Dim htmlbody As NotesMIMEEntity
Set out = m_session.Createstream()
out.WriteText(m_HTMLBody)
out.position = 0
Set htmlbody = mime.CreateChildEntity
Call htmlbody.SetContentFromText(out,"text/html; charset=UTF-8", ENC_IDENTITY_7BIT)
End Sub
%REM
Function setDynamicHTMLBody
Description: Create a human readable body of the eMail
%END REM
Private Sub setDynamicHTMLBody(mime As NotesMIMEEntity)
Dim out As NotesStream
Dim htmlbody As NotesMIMEEntity
Dim seperatorLcation As integer
Set out = m_session.Createstream()
Call out.WriteText(|<html>|,EOL_PLATFORM)
Call out.WriteText(|<head><title>|,EOL_PLATFORM)
Call out.WriteText(me.m_Subject,EOL_PLATFORM)
Call out.WriteText(|</title><style type="text/css">|,EOL_PLATFORM)
Call out.WriteText(|html, body, th {font-family : Verdana, Arial, sans-serif; font-size : small;}|,EOL_PLATFORM)
Call out.WriteText(|table {border : none; width : 60%}|,EOL_PLATFORM)
Call out.WriteText(|</style></head><body>|,EOL_PLATFORM)
Call out.WriteText(|<h3>|,EOL_PLATFORM)
Call out.WriteText(me.m_Subject,EOL_PLATFORM)
Call out.WriteText(|</h3><p>|,EOL_PLATFORM)
Call out.WriteText(me.m_description,EOL_PLATFORM)
Call out.WriteText(|</p><table width="60%" border="0" style="background-color : #FFFEFF"><tr><th>Parameter</th><th>Value</th></tr>|,EOL_PLATFORM)
ForAll ctp In JSONcontext
seperatorLcation = InStr(ctp,":")
Call out.WriteText(|<tr><td>|,EOL_NONE)
Call out.WriteText(Left$(ctp,seperatorLcation-1) ,EOL_NONE)
Call out.WriteText(|</td><td>|,EOL_NONE)
Call out.WriteText(Mid$(ctp,seperatorLcation+1),EOL_NONE)
Call out.WriteText(|</td></tr>|,EOL_PLATFORM)
End ForAll
Call out.WriteText(|</table></body></html>|,EOL_PLATFORM)
out.position = 0
Set htmlbody = mime.CreateChildEntity
Call htmlbody.SetContentFromText(out,"text/html; charset=UTF-8", Enc_identity_7bit)
Call out.Close()
End Sub
%REM
Function setHTMLBody
Description: Get the human readable body of the eMail
%END REM
Private Sub setEEBody(mime As NotesMIMEEntity)
Dim out As NotesStream
Dim eebody As NotesMIMEEntity
Dim first As Boolean
Set out = m_session.Createstream()
'Here the JSON gets written out
Call out.WriteText(|"{ gadget" : "|,EOL_NONE)
Call out.WriteText(m_gadgetURL,EOL_NONE)
Call out.WriteText(|",|,EOL_PLATFORM)
Call out.WriteText(|"context" : {|,EOL_PLATFORM)
'Looping through context parameter
first = true
ForAll ctp In JSONcontext
If Not first Then
Call out.WriteText(|, |,EOL_NONE)
End If
first = false
Call out.WriteText(ctp,EOL_PLATFORM)
End ForAll
Call out.WriteText(|} } |,EOL_PLATFORM)
out.position = 0
Set eebody = mime.CreateChildEntity
Call eebody.SetContentFromText(out,"application/embed+json; charset=UTF-8", Enc_identity_7bit)
Call out.Close()
End Sub
%REM
Sub addHeader
Description: Adds a header to a MIME Part
%END REM
Private Sub addHeader(mime As NotesMIMEEntity, hName As String, value As String)
Dim header As NotesMIMEHeader
Set header = mime.CreateHeader(hName)
Call header.SetHeaderVal(value)
End Sub
%REM
Sub addHeader
Description: Adds a header to a MIME Part
%END REM
Private Sub addHeaderParam(mime As NotesMIMEEntity, hName As String, value As String)
Dim header As NotesMIMEHeader
Set header = mime.CreateHeader(hName)
Call header.Setheadervalandparams(value)
End Sub
End Class