/
Form1.vb
154 lines (128 loc) · 6.2 KB
/
Form1.vb
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
Imports System
Imports System.Collections.Generic
Imports System.ComponentModel
Imports System.Drawing
Imports System.Text
Imports System.Windows.Forms
Imports System.Net.Mail
Imports DevExpress.XtraRichEdit
Imports DevExpress.Utils
Imports DevExpress.Office.Services
Imports System.Net.Mime
Imports System.IO
Imports DevExpress.XtraRichEdit.Export
Imports DevExpress.Office.Utils
Namespace RichEditSendMail
Public Partial Class Form1
Inherits Form
Public Sub New()
InitializeComponent()
richEdit.LoadDocument("Hello.docx")
End Sub
Private Sub btnSend_Click(ByVal sender As Object, ByVal e As EventArgs)
If(Equals(edtTo.Text.Trim(), "")) OrElse (Equals(edtSubject.Text.Trim(), "")) OrElse (Equals(edtSmtp.Text.Trim(), "")) Then
MessageBox.Show("Fill in required fields")
Return
End If
Try
Dim mailMessage As MailMessage = New MailMessage("XtraRichEdit@devexpress.com", edtTo.Text)
mailMessage.Subject = edtSubject.Text
Dim exporter As RichEditMailMessageExporter = New RichEditMailMessageExporter(richEdit, mailMessage)
exporter.Export()
Dim mailSender As SmtpClient = New SmtpClient(edtSmtp.Text)
'specify your login/password to log on to the SMTP server, if required
'mailSender.Credentials = new NetworkCredential("login", "password");
mailSender.Send(mailMessage)
MessageBox.Show("Message sent", "RichEditSendMail", MessageBoxButtons.OK, MessageBoxIcon.Information)
Catch exc As Exception
MessageBox.Show(exc.Message)
End Try
End Sub
Public Class RichEditMailMessageExporter
Implements IUriProvider
Private ReadOnly control As RichEditControl
Private ReadOnly message As MailMessage
Private attachments As List(Of AttachementInfo)
Private imageId As Integer
Public Sub New(ByVal control As RichEditControl, ByVal message As MailMessage)
Guard.ArgumentNotNull(control, "control")
Guard.ArgumentNotNull(message, "message")
Me.control = control
Me.message = message
End Sub
Public Overridable Sub Export()
attachments = New List(Of AttachementInfo)()
Dim htmlView As AlternateView = CreateHtmlView()
message.AlternateViews.Add(htmlView)
message.IsBodyHtml = True
End Sub
Protected Friend Overridable Function CreateHtmlView() As AlternateView
AddHandler control.BeforeExport, AddressOf OnBeforeExport
Dim htmlBody As String = control.Document.GetHtmlText(control.Document.Range, Me)
Dim view As AlternateView = AlternateView.CreateAlternateViewFromString(htmlBody, Encoding.UTF8, MediaTypeNames.Text.Html)
RemoveHandler control.BeforeExport, AddressOf OnBeforeExport
Dim count As Integer = attachments.Count
For i As Integer = 0 To count - 1
Dim info As AttachementInfo = attachments(i)
Dim resource As LinkedResource = New LinkedResource(info.Stream, info.MimeType)
resource.ContentId = info.ContentId
view.LinkedResources.Add(resource)
Next
Return view
End Function
Private Sub OnBeforeExport(ByVal sender As Object, ByVal e As BeforeExportEventArgs)
Dim options As HtmlDocumentExporterOptions = TryCast(e.Options, HtmlDocumentExporterOptions)
If options IsNot Nothing Then
options.Encoding = Encoding.UTF8
End If
End Sub
'#Region "IUriProvider Members"
Public Function CreateCssUri(ByVal rootUri As String, ByVal styleText As String, ByVal relativeUri As String) As String Implements IUriProvider.CreateCssUri
Return String.Empty
End Function
Public Function CreateImageUri(ByVal rootUri As String, ByVal image As OfficeImage, ByVal relativeUri As String) As String Implements IUriProvider.CreateImageUri
Dim imageName As String = String.Format("image{0}", imageId)
imageId += 1
Dim imageFormat As OfficeImageFormat = GetActualImageFormat(image.RawFormat)
Dim stream As Stream = New MemoryStream(image.GetImageBytes(imageFormat))
Dim mediaContentType As String = OfficeImage.GetContentType(imageFormat)
Dim info As AttachementInfo = New AttachementInfo(stream, mediaContentType, imageName)
attachments.Add(info)
Return "cid:" & imageName
End Function
Private Function GetActualImageFormat(ByVal _officeImageFormat As OfficeImageFormat) As OfficeImageFormat
If _officeImageFormat = OfficeImageFormat.Exif OrElse _officeImageFormat = OfficeImageFormat.MemoryBmp Then
Return OfficeImageFormat.Png
Else
Return _officeImageFormat
End If
End Function
'#End Region
End Class
Public Class AttachementInfo
Private streamField As Stream
Private mimeTypeField As String
Private contentIdField As String
Public Sub New(ByVal stream As Stream, ByVal mimeType As String, ByVal contentId As String)
streamField = stream
mimeTypeField = mimeType
contentIdField = contentId
End Sub
Public ReadOnly Property Stream As Stream
Get
Return streamField
End Get
End Property
Public ReadOnly Property MimeType As String
Get
Return mimeTypeField
End Get
End Property
Public ReadOnly Property ContentId As String
Get
Return contentIdField
End Get
End Property
End Class
End Class
End Namespace