SMTP发送邮件

 

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