/
Form1.vb
157 lines (132 loc) · 5.14 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
155
156
157
Imports Microsoft.VisualBasic
Imports System
Imports System.Collections.Generic
Imports System.ComponentModel
Imports System.Data
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.XtraRichEdit.Export.Html
Imports System.Net
Imports DevExpress.Office.Utils
Namespace RichEditSendMail
Partial Public 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) Handles btnSend.Click
If (edtTo.Text.Trim() = "") OrElse (edtSubject.Text.Trim() = "") OrElse (edtSmtp.Text.Trim() = "") Then
MessageBox.Show("Fill in required fields")
Return
End If
Try
Dim mailMessage As New MailMessage("XtraRichEdit@devexpress.com", edtTo.Text)
mailMessage.Subject = edtSubject.Text
Dim exporter As New RichEditMailMessageExporter(richEdit, mailMessage)
exporter.Export()
Dim mailSender As 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()
Me.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 New LinkedResource(info.Stream, info.MimeType)
resource.ContentId = info.ContentId
view.LinkedResources.Add(resource)
Next i
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 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 stream_Renamed As Stream
Private mimeType_Renamed As String
Private contentId_Renamed As String
Public Sub New(ByVal stream As Stream, ByVal mimeType As String, ByVal contentId As String)
Me.stream_Renamed = stream
Me.mimeType_Renamed = mimeType
Me.contentId_Renamed = contentId
End Sub
Public ReadOnly Property Stream() As Stream
Get
Return stream_Renamed
End Get
End Property
Public ReadOnly Property MimeType() As String
Get
Return mimeType_Renamed
End Get
End Property
Public ReadOnly Property ContentId() As String
Get
Return contentId_Renamed
End Get
End Property
End Class
End Class
End Namespace