Option Strict On
Imports System.Web.Mail
Imports System.Text
Imports System.ServiceProcess
Public Class frmMain
Inherits System.Windows.Forms.Form
' For use with the WndProc override routine
Dim WM_SYSCOMMAND As Integer = &H112
Dim SC_CLOSE As Integer = &HF060
Dim arlAttachments As ArrayList
'对Email地址的合法性做基本的检查。
Private Sub ValidateEmailAddress(ByVal txt As TextBox)
' 确认文本框是否为空
If txt.TextLength = 0 Then
Throw New Exception("请输入Email地址")
Else
' 确认是否有"." 和一个 "@" 在Email地址中
If txt.Text.IndexOf(".") = -1 Or txt.Text.IndexOf("@") = -1 Then
Throw New Exception("Email地址必须有效例如: " & _
"'someone@microsoft.com'")
End If
End If
End Sub
'这个方法重载了窗体的WndProc过程,当用户在试图关闭窗体的时候,可以获取关闭信息。
' 如果没有该方法,将无法终止ErrorProvider验证To和From文本框,因为To和From文本框的
'CausesValidation属性为True,如果用户输入了不合法的数据或者根本没有输入数据,而试图关闭窗体,
'这样引发了验证事件,窗体将不能关闭
Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)
If m.Msg = WM_SYSCOMMAND Then
If m.WParam.ToInt32 = SC_CLOSE Then
'取消CausesValidation为True的所有的控件,否则只有输入合法的数据才能关闭窗体。
txtTo.CausesValidation = False
txtFrom.CausesValidation = False
End If
End If
MyBase.WndProc(m)
End Sub
'通过btnBrowse按钮的Click事件,允许用户打开对话框,添加邮件附件,这里可以添加多个附件
'所有的附件被添加到MailAttachment对象的数组列表中。
Private Sub btnBrowse_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnBrowse.Click
With odlgAttachment
.InitialDirectory = "C:/"
.Filter = "All Files (*.*)|*.*|HTML Files (*.htm;*.html)|*.htm|Microsoft Mail Documents (*.msg)|*.msg|Word Documents (*.doc)|*.doc|Excel Files(*.xl*)|*.xl*|Excel Worksheets (*.xls)|*.xls|Excel Charts (*.xlc)|*.xlc|PowerPoint Presentations (*.ppt)|*.ppt|Text Files (*.txt)|*.txt"
.FilterIndex = 1
If .ShowDialog() = DialogResult.OK Then
If IsNothing(arlAttachments) Then
arlAttachments = New ArrayList
' 清除ListView控件中的 "(No Attachments)"文本
lstAttachments.Items.Clear()
End If
arlAttachments.Add(New MailAttachment(.FileName))
' 在列表框中显示附件的文件名即可
Dim strFileName() As String = .FileName.Split(New Char() {CChar("/")})
strFileName.Reverse(strFileName)
lstAttachments.Items.Add(strFileName(0))
End If
End With
End Sub
'最后处理 btnSend的Click事件,首先验证邮件地址,利用StringBuilder对象建立邮件信息,然后发送
Private Sub btnSend_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnSend.Click
' 验证接受任何发送人的邮件地址的有效性
Try
ValidateEmailAddress(txtFrom)
Catch ex As Exception
txtFrom.Select(0, txtFrom.Text.Length)
' 设置ErrorProvider控件显示错误信息
erpEmailAddresses.SetError(txtFrom, ex.Message)
Exit Sub
End Try
Try
ValidateEmailAddress(txtTo)
Catch exp As Exception
txtTo.Select(0, txtTo.Text.Length)
' 设置ErrorProvider控件显示错误信息
erpEmailAddresses.SetError(txtTo, exp.Message)
Exit Sub
End Try
' 这里使用StringBuilder类来联结字符串,不采用传统的String类。
'因为StringBuilder类在这方面就有非常好的优点和执行效果。
Dim sb As New StringBuilder
' 建立邮件信息
sb.Append("The following email was sent to you from the Send Mail How-To " & _
"sample application:")
sb.Append(vbCrLf)
sb.Append(vbCrLf)
sb.Append("SUBJECT: ")
sb.Append(Trim(txtSubject.Text))
sb.Append(vbCrLf)
sb.Append(vbCrLf)
sb.Append("MESSAGE: ")
sb.Append(Trim(txtBody.Text))
sb.Append(vbCrLf)
' 创建一个MailMessage对象,并初始化相关的属性。
Dim mailMsg As New MailMessage
With mailMsg
.From = txtFrom.Text.Trim
.To = txtTo.Text.Trim
.Cc = txtCC.Text.Trim
.Bcc = txtBCC.Text.Trim
.Subject = txtSubject.Text.Trim
.Body = sb.ToString
.Priority = CType(cboPriority.SelectedIndex, MailPriority)
If Not IsNothing(arlAttachments) Then
Dim mailAttachment As Object
For Each mailAttachment In arlAttachments
.Attachments.Add(mailAttachment)
Next
End If
End With
'设置SMTP服务器的名称,设置方法可以如下
'本地的IP地址,这里假设你的SMTP服务器可以通过本地的防火墙发送邮件
' 127.0.0.1
'信息交换服务器的名称或者IP地址
'SmtpMail.SmtpServer = "166.111.140.85"
' 扑获错误,向用户反馈发送过程中可能出现的错误信息
Try
SmtpMail.Send(mailMsg)
lstAttachments.Items.Clear()
lstAttachments.Items.Add("(No Attachments)")
MessageBox.Show("邮件发送成功!", _
"邮件发送状态", MessageBoxButtons.OK, _
MessageBoxIcon.Information)
Catch exp As Exception
MessageBox.Show("在发送邮件过程中出错 " & exp.Message, _
Me.Text, MessageBoxButtons.OK, MessageBoxIcon.Error)
End Try
End Sub
' 处理控件验证后的事件
Private Sub emailAddresses_Validated(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles txtFrom.Validated, txtTo.Validated
'清除显示的错误信息
erpEmailAddresses.SetError(CType(sender, TextBox), "")
End Sub
' 处理txtFrom.Validating, txtTo.Validating事件
Private Sub emailAddresses_Validating(ByVal sender As System.Object, ByVal e As System.ComponentModel.CancelEventArgs) Handles txtFrom.Validating, txtTo.Validating
Dim txt As TextBox = CType(sender, TextBox)
Try
ValidateEmailAddress(txt)
Catch exp As Exception
' 取消事件,高亮显示要修改的文本。
e.Cancel = True
txt.Select(0, txt.Text.Length)
' 显示错误的信息
erpEmailAddresses.SetError(txt, exp.Message)
End Try
End Sub
' 在窗体的Load事件中检查SMTP服务是否安装并且运行
Private Sub frmMain_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
' 确保SMTP服务安装
Dim services() As ServiceController = ServiceController.GetServices
Dim service As ServiceController
Dim blnHasSmtpService As Boolean = False
' 循环检查机器上所有的服务,以找到SMTP服务。
For Each service In services
If service.ServiceName.ToLower = "smtpsvc" Then
blnHasSmtpService = True
Exit For
End If
Next
If Not blnHasSmtpService Then
MessageBox.Show("你没有安装SMTP服务,请检查并安装", Me.Text, _
MessageBoxButtons.OK, MessageBoxIcon.Information)
End If
'确保SMTP服务运行,如果没有启动该服务。 Ensure the SMTP Service is running. If not, start it.
If Not service.Status = ServiceControllerStatus.Running Then
Dim frmStatusMessage As New frmStatus
frmStatusMessage.Show("SMTP服务当前没有运行. " & _
"启动服务...")
Try
service.Start()
frmStatusMessage.Close()
Catch
MessageBox.Show("启动服务的过程中发送错误 ", Me.Text, _
MessageBoxButtons.OK, MessageBoxIcon.Error)
End Try
End If
' 填充优先级别下拉列表框。
With cboPriority
.Items.AddRange(New String() {"Normal", "Low", "High"})
.SelectedIndex = 0
End With
End Sub
End Class