Author:水如烟
测试代码
Dim mail As New NewMail(session) mail.SendTo = session.UserNameObject.Abbreviated '就发送到自己邮箱 mail.Subject = "测试邮件发送" mail.Message = "这是一份测试邮件" mail.Attachment = "d:/word.txt;c:/bar.emf" Dim result As Boolean = mail.Send If result = True Then Console.WriteLine("发送时间:{0}", mail.PostedDate.ToString) Else Console.WriteLine("错误:{0}", mail.ErrMessage) End If '结果 '发送时间:2009-7-19 23:13:14
'在所有邮件中列出所有附件 Dim db As NotesDatabase = session.GetServerDbDirectory.OpenMailDatabase Dim view As NotesView = db.GetView("$All") Dim item As Mail Dim doc As NotesDocument For index As Integer = 0 To view.AllEntries.Count - 1 doc = view.GetNthDocument(index + 1) item = New Mail(doc) If String.IsNullOrEmpty(item.Attachment) Then Continue For Console.WriteLine("{0}", item.Attachment) Next
代码:
NewMail.vb
Namespace LzmTW.Lotus.Framework Public Class NewMail Inherits MailItem ''' ''' 在当前用户邮箱写信 ''' Sub New(ByVal session As NotesSession) MyBase.New(session.GetServerDbDirectory.OpenMailDatabase.CreateDocument) End Sub ''' ''' 在指定邮箱写信 ''' Sub New(ByVal dbMail As NotesDatabase) MyBase.New(dbMail.CreateDocument) End Sub Private err As String = String.Empty Public ReadOnly Property ErrMessage() As String Get Return err End Get End Property ''' ''' 发送邮件 ''' Public Function Send() As Boolean Dim result As Boolean Try Me.CurrentDocument.Send(False, "") result = True err = String.Empty Catch ex As Exception err = ex.Message End Try Return result End Function ''' ''' 保存邮件 ''' Public Function Save() As Boolean Dim result As Boolean Try Me.CurrentDocument.Save(False, False) result = True err = String.Empty Catch ex As Exception err = ex.Message End Try Return result End Function End Class End Namespace
Mail.vb
Namespace LzmTW.Lotus.Framework Public Class Mail Inherits MailItem Sub New(ByVal item As NotesDocument) MyBase.New(item) Me.IsReadOnly = True End Sub ''' ''' 发送人 ''' Public ReadOnly Property From() As String Get Return Me.CurrentDocument.GetFirstItem("From").Text End Get End Property ''' ''' 解压附件至本地 ''' Public Sub ExtractFile(ByVal index As Integer, ByVal path As String) If Not Me.BodyIsRichText Then Return If index < 0 Then Return Dim rich As NotesRichTextItem = Me.CurrentBody.ConvertToNotesRichTextItem Dim embObjects As List(Of NotesEmbeddedObject) = rich.EmbeddedObjects If index > embObjects.Count - 1 Then Return embObjects(index).ExtractFile(path) End Sub End Class End Namespace
MailItem.vb
Namespace LzmTW.Lotus.Framework Public MustInherit Class MailItem Implements IDisposable Protected CurrentDocument As NotesDocument Protected CurrentBody As NotesItem Protected IsReadOnly As Boolean = False Protected BodyIsRichText As Boolean = False Sub New(ByVal item As NotesDocument) Me.CurrentDocument = item If Not Me.CurrentDocument.GetFirstItem("Body").comIsValid Then Me.CurrentDocument.CreateRichTextItem("Body") End If Me.CurrentBody = Me.CurrentDocument.GetFirstItem("Body") Me.BodyIsRichText = (Me.CurrentBody.type = IT_TYPE.RICHTEXT) End Sub ''' ''' 收件人。多人以";"(分号)分隔。 ''' Public Property SendTo() As String Get Return Me.CurrentDocument.GetFirstItem("SendTo").Text End Get Set(ByVal value As String) If Me.IsReadOnly Then Return Me.CurrentDocument.ReplaceItemValue("SendTo", Me.GetObjectForNotesItemValue(value)) End Set End Property ''' ''' 抄送。多人以";"(分号)分隔。 ''' Public Property CopyTo() As String Get Return Me.CurrentDocument.GetFirstItem("CopyTo").Text End Get Set(ByVal value As String) If Me.IsReadOnly Then Return Me.CurrentDocument.ReplaceItemValue("CopyTo", Me.GetObjectForNotesItemValue(value)) End Set End Property ''' ''' 密送。多人以";"(分号)分隔。 ''' Public Property BlindCopyTo() As String Get Return Me.CurrentDocument.GetFirstItem("BlindCopyTo").Text End Get Set(ByVal value As String) If Me.IsReadOnly Then Return Me.CurrentDocument.ReplaceItemValue("BlindCopyTo", Me.GetObjectForNotesItemValue(value)) End Set End Property ''' ''' 主题 ''' Public Property Subject() As String Get Return Me.CurrentDocument.GetFirstItem("Subject").Text End Get Set(ByVal value As String) If Me.IsReadOnly Then Return Me.CurrentDocument.ReplaceItemValue("Subject", New Object() {value}) End Set End Property ''' ''' 消息 ''' Public Property Message() As String Get Return Me.CurrentBody.Text End Get Set(ByVal value As String) If Me.IsReadOnly Then Return Me.CurrentDocument.ReplaceItemValue("Body", New Object() {value}) End Set End Property ''' ''' 附件。多文件以";"(分号)分隔。 ''' Public Property Attachment() As String Get Return Me.GetAttachment End Get Set(ByVal value As String) If Me.IsReadOnly Then Return Me.SetAttachment(value) End Set End Property ''' ''' 发送时间 ''' Public ReadOnly Property PostedDate() As Date Get Return CDate(Me.CurrentDocument.GetFirstItem("PostedDate").Text) End Get End Property Private Function GetObjectForNotesItemValue(ByVal value As String) As Object() If String.IsNullOrEmpty(value) Then Return Nothing Return value.Split(";"c) End Function Private Function GetAttachment() As String If Not Me.BodyIsRichText Then Return Nothing Dim list As New List(Of String) Dim rich As NotesRichTextItem rich = Me.CurrentBody.ConvertToNotesRichTextItem If Not rich.EmbeddedObjects Is Nothing Then For Each item As NotesEmbeddedObject In rich.EmbeddedObjects list.Add(item.Source) Next End If Return String.Join(";"c, list.ToArray) End Function Private Sub SetAttachment(ByVal value As String) If Not Me.BodyIsRichText Then Return If String.IsNullOrEmpty(value) Then Return Dim rich As NotesRichTextItem rich = Me.CurrentBody.ConvertToNotesRichTextItem For Each file As String In value.Split(";"c) rich.EmbedObject(EMBED_TYPE.EMBED_ATTACHMENT, Nothing, file, file) Next End Sub Private disposedValue As Boolean = False Protected Overridable Sub Dispose(ByVal disposing As Boolean) If Not Me.disposedValue Then If disposing Then Me.CurrentBody.Dispose() Me.CurrentDocument.Dispose() End If End If Me.disposedValue = True End Sub Public Sub Dispose() Implements IDisposable.Dispose Dispose(True) GC.SuppressFinalize(Me) End Sub End Class End Namespace
