使用VB收发电子邮件 发送和接收电子邮件，对于某些执行特殊任务的应用程序而言，是一个十分有用的功能。例如，一个监视网络服务器资源使用情况的工具软件，如果它具有自动发送电子邮件的功能，那么当它发现服务器的资源使用已经接近事先设定的临界状态时，便可以向系统管理员发送一封告警的电子邮件，从而使系统管理员能够及时地采取措施，以避免重大事故的出现。在Visual Basic中，应用程序可以通过调用微软公司的MAPI（Messaging Application Programming Interface，消息应用程序编程接口），实现收发电子邮件的功能。笔者将在本文中结合简单实例，向大家介绍在VB程序中实现电子邮件收发功能的编程方法。 编制具有收发电子邮件功能的VB程序，必须使用Visual Basic 4.0以上的版本，因为只有4.0以上的Visual Basic才带有两个实现电子邮件收发功能的核心控件：MAPI会话控件和MAPI消息控件。MAPI会话控件用于建立和控制一个Microsoft Mail会话，MAPI消息控件用于创建和收发邮件消息。此外，程序必须运行在采用遵从MAPI的消息系统（如：Microsoft Exchange、Microsoft Mail、Outlook等）的环境中。 在开始编程之前，首先需要将MAPI控件加入VB工具箱。具体操作是：在VB菜单栏中选择Tools菜单项中的Custom Controls命令，调出"Custom Controls"对话框，在其中的"Available Controls"列表框中选中"Microsoft MAPI Controls"表项，然后按"OK"命令按钮退出该对话框。此后，工具箱中将新添两个图标，这就是MAPI会话控件和MAPI消息控件的图标。 下面，笔者将以两个简单的VB程序为例，分别介绍发送邮件和接收邮件的程序编制方法。 邮件发送程序 邮件发送程序的基本处理过程是：根据用户输入信息组成邮件，然后使用MAPI 消息控件的Send方法将邮件发出。编程步骤如下： 1、新建一个VB项目。 2、将缺省窗体Form1的Caption属性设置为"发送邮件"。 3、将MAPI控件加入VB工具框。 4、在Form1中加入一个MAPI会话控件MAPISession1和一个MAPI消息控件MAPIMessages1。 5、在Form1中加入三个文本框控件，将它们的Name属性分别设置为txtSendTo、txtSubject、txtMessage，并将txtMessage的Multiline属性设置为True。这三个文本框控件将分别用于填写邮件的收件人、主题和内容。 6、在Form1中加入三个标签控件，将它们的Caption属性分别设置为"收件人"、"主题"和"内容"，并将它们放在合适的位置用以标注相应的文本框控件。 7、在Form1中加入一个命令按钮控件，将其Caption属性和Name属性分别设置为"发送"和"cmdSend"。 8、将下列代码加入Form1的Form_Load事件： Private Sub Form_Load() MAPISession1.SignOn End Sub 9、将下列代码加入Form1的Form_Unload事件： Private Sub Form_Unload(Cancel As Integer) MAPISession1.SignOff End Sub 10、将下列代码加入cmdSend的Click事件： Private Sub cmdSend_Click() With MAPIMessages1 .MsgIndex = -1 .RecipDisplayName = txtSendTo.Text .MsgSubject = txtSubject.Text .MsgNoteText = txtMessage.Text .SessionID = MAPISession1.SessionID .Send End With MsgBox "邮件发送完毕！", , "发送邮件" End Sub 程序运行后如图3所示。在填写完邮件的收件人、主题和内容后，按"发送"命令按钮，如果没有出现运行时错误提示，那么就表明邮件已经成功地发往目的地了，否则，请检查填写的收件人地址是否准确无误以及系统中运行的消息系统工作是否正常。 邮件接收程序 邮件接收程序比邮件发送程序稍微复杂一些。首先需要使用MAPI消息控件的Fetch方法读取邮件，这个过程将把用户收件箱中所有未读邮件全部装入MAPI消息控件中。然后，检查MAPI消息控件的MsgCount属性以确定通过Fetch方法读取的邮件的总数。接着，可以通过设置MAPI消息控件的MsgIndex属性来指定具体需要处理哪一封邮件。需要说明的是，MsgIndex属性值的计数是从0开始的，也就是说，第一封邮件的索引号是0，第二封邮件的索引号是1，依次类推。编程步骤如下： 1、新建一个VB项目。 2、将缺省窗体Form1的Caption属性设置为"接收邮件"。 3、将MAPI控件加入VB工具框。 4、在Form1中加入一个MAPI会话控件MAPISession1和一个MAPI消息控件MAPIMessages1。 5、在Form1中加入三个标签控件和一个文本框控件，将三个标签控件的Name属性分别设置为lblMsgDateReceived、lblMsgOrigDisplayName、lblMsgSubject，将文本框控件的Name属性设置为txtMsgNoteText，并将标签控件的Caption属性和文本框控件的Text属性的内容清空。这四个控件将分别用于显示邮件的日期、发件人、主题和内容。 6、将txtMsgNoteText控件的Locked属性和Multiline属性设置为True，ScrollBars属性设置为2 - Vertical。 7、在Form1中再加入四个标签控件用于标注上述四个控件，将它们的Caption属性分别设置为"日期"、"发件人"、"主题"、"内容"。 8、在Form1中加入一个标签控件，将其Name属性设置为lblMsgCount，Caption属性设置为"第 0 封邮件，总计 0 封邮件"。该控件用于显示接收的邮件总数以及当前正在处理第几封邮件。 9、在Form1中加入三个命令按钮控件，将它们的Name属性分别设置为cmdPrevious、cmdNext、cmdClose，Caption属性分别设置为"上一封"、"下一封"、"关闭"。 10、编写一个窗体级子例程FetchNewMail： Public Sub FetchNewMail() MAPIMessages1.FetchUnreadOnly = True MAPIMessages1.Fetch End Sub 11、编写一个窗体级子例程DisplayMessage： Public Sub DisplayMessage() lblMsgCount.Caption = "第 " & _ LTrim(Str(MAPIMessages1.MsgIndex + 1)) & " 封邮件，总计 " & _ LTrim(Str(MAPIMessages1.MsgCount)) & " 封邮件" lblMsgDateReceived.Caption = MAPIMessages1.MsgDateReceived txtMsgNoteText.Text = MAPIMessages1.MsgNoteText lblMsgOrigDisplayName.Caption = MAPIMessages1.MsgOrigDisplayName lblMsgSubject.Caption = MAPIMessages1.MsgSubject End Sub 12、将下列代码加入Form1的Form_Load事件： Private Sub Form_Load() MAPISession1.SignOn MAPIMessages1.SessionID = MAPISession1.SessionID FetchNewMail DisplayMessage End Sub 13、将下列代码加入cmdPrevious的Click事件： Private Sub cmdPrevious_Click() If MAPIMessages1.MsgIndex > 0 Then MAPIMessages1.MsgIndex = MAPIMessages1.MsgIndex - 1 DisplayMessage Else Beep End If End Sub 14、将下列代码加入cmdNext的Click事件： Private Sub cmdNext_Click() If MAPIMessages1.MsgIndex < MAPIMessages1.MsgCount - 1 Then MAPIMessages1.MsgIndex = MAPIMessages1.MsgIndex + 1 DisplayMessage Else Beep End If End Sub 15、将下列代码加入cmdClose的Click事件： Private Sub cmdClose_Click() Unload Me End Sub 程序运行后如图4所示。在窗体加载过程中，窗体Load事件中的代码会读取新邮件，如果有新邮件，就显示第一个新邮件。如果有多个新邮件，则可以使用"上一封"和"下一封"命令按钮前后翻阅。 接收邮件 本例是读取用户收件箱中所有未读邮件，如果要读取收件箱中所有的邮件，那么只需在执行Fetch方法之前，将MAPI消息控件的FetchUnreadOnly属性设置为False。具体接收的邮件是否已经读过，可以通过MsgRead属性来判别。如果邮件的正文或附件曾经被浏览过，那么该邮件就会自动标记为已读，不过只浏览邮件的主题不会标记该邮件已读。 邮件附件 与处理邮件的方式一样，MAPI也为邮件的附件提供了一个计数器和一个索引。在处理收到的邮件时，可以通过检查AttachmentCount属性来确定该邮件携带了多少个附件，然后可以通过设置AttachmentIndex属性依次处理每一个附件。 AttachmentIndex的合法取值范围为0至AttachmentIndex-1。在设置了AttachmentIndex属性值后，可以读取附件的下列属性： AttachmentName：当附件是一个文件时，该属性用于指定文件的名称。当附件是 一个OLE对象时，该属性用于指定对象的类型。 AttachmentPath：该属性用于指定做为附件的文件的全路径名。 AttchmentPosition：该属性用于指定附件在邮件内容部分中的位置。当邮件收发程序显示邮件内容时，将使用该属性提供的信息把附件的标志放在合适的位置。 AttachmentType：该属性用于指定附件的类型，其合法取值为三个整数型数值，在VB中分别由下列常量表示： ·mapData－附件是一个数据文件 ·mapEOLE－附件是一个嵌入式OLE对象 ·mapSOLE－附件是一个静态OLE对象 发送邮件时，上述属性的使用方法与接收邮件时相同，只不过由读操作改为写操作了。值得一提的是AttachmentIndex属性，发送邮件时可以将其设置为任意值。而AttachmentCount属性则会自动设置为正确的值，无需人为设置。 小结 通过分析上述两个程序的代码，可以归纳出具有收发电子邮件功能的VB程序的基本流程如下： 1、使用MAPI会话控件建立一个邮件会话。 2、使用MAPI消息控件进行邮件的处理工作。 3、再次使用MAPI会话控件释放邮件会话。 由于上述两个VB程序只是简单的示例，因而略去了一些与本文主题关系不大的细节，如错误处理等。在编制实用程序时，为了保证程序的可靠性，应该考虑加入这些细节部分。
Dim strData As String Dim Start As Single Dim WaitTime As SinglePrivate Sub cmdSend_Click() Dim sFrom As String Dim sTo As String Dim sSubject As String Dim sDate As String Dim sMailType As String Dim sMailHeader As String Dim sMailBody As String Dim blnOK As Boolean
If Winsock1.State = sckClosed Then ' 使用 TCP Protocol Winsock1.Protocol = sckTCPProtocol
' 設定郵件伺服器 IP Address Winsock1.RemoteHost = txtServer.Text
' 設定 SMTP Port 為 25 Winsock1.RemotePort = 25
' 送件端嘗試連結至郵件伺服器端 Winsock1.Connect
' 等候郵件伺服器回傳 220 Ready for Mail 訊息 blnOK = WaitforResponse("220") ' Ready for Mail
If Not blnOK Then StatusBar1.Panels(1).Text = "Status: Connection Fail" StatusBar1.Refresh Exit Sub End If
' 等候郵件伺服器回傳 250 OK 訊息 blnOK = WaitforResponse("250") ' OK If Not blnOK Then StatusBar1.Panels(1).Text = "Status: Connection Fail" StatusBar1.Refresh Exit Sub End If ' 送件端發出 RCPT TO: 指令代表收件者 E-Mail Address Winsock1.SendData "RCPT TO: " & Trim(txtToAddress.Text) & vbCrLf
' 等候郵件伺服器回傳 250 OK 訊息 blnOK = WaitforResponse("250") ' OK
If Not blnOK Then StatusBar1.Panels(1).Text = "Status: Connection Fail" StatusBar1.Refresh Exit Sub End If
' 送件端發出 DATA 指令代表開始傳送 E-Mail Winsock1.SendData "DATA" & vbCrLf
' 等候郵件伺服器回傳 354 Start Mail Input 訊息 blnOK = WaitforResponse("354") ' Start Mail Input
If Not blnOK Then StatusBar1.Panels(1).Text = "Status: Connection Fail" StatusBar1.Refresh Exit Sub End If
' 等候郵件伺服器回傳 221 Close Connection 訊息 blnOK = WaitforResponse("221") ' Close Connection
If Not blnOK Then StatusBar1.Panels(1).Text = "Status: Connection Fail" StatusBar1.Refresh Exit Sub End If
' 關閉 Winsock Winsock1.Close
StatusBar1.Panels(1).Text = "Status: Mail Sent" StatusBar1.Refresh End If End SubPrivate Sub Winsock1_DataArrival(ByVal bytesTotal As Long) ' 郵件伺服器回傳訊息, 其中: ' 220 代表 Ready for Mail ' 221 代表 Close Connection ' 250 代表 OK ' 354 代表 Start Mail Input
Winsock1.GetData strData End SubPrivate Function WaitforResponse(ResponseCode As String) As Boolean Start = Timer
' SMTP Error: Time Out Do While Len(strData) = 0 WaitTime = Timer - Start DoEvents If WaitTime > 50 Then MsgBox "SMTP Error: Time Out.", vbCritical WaitforResponse = False Exit Function End If Loop
' Winsock Error Do While Left(strData, 3) <> ResponseCode DoEvents If WaitTime > 50 Then MsgBox "SMTP Error: " & ResponseCode & " " & strData, vbCritical WaitforResponse = False Exit Function End If Loop
strData = "" WaitforResponse = True End FunctionPrivate Sub cmdExit_Click() If Winsock1.State <> sckClosed Then Winsock1.Close End If End End Sub
使用VB收发电子邮件
发送和接收电子邮件，对于某些执行特殊任务的应用程序而言，是一个十分有用的功能。例如，一个监视网络服务器资源使用情况的工具软件，如果它具有自动发送电子邮件的功能，那么当它发现服务器的资源使用已经接近事先设定的临界状态时，便可以向系统管理员发送一封告警的电子邮件，从而使系统管理员能够及时地采取措施，以避免重大事故的出现。在Visual Basic中，应用程序可以通过调用微软公司的MAPI（Messaging Application Programming Interface，消息应用程序编程接口），实现收发电子邮件的功能。笔者将在本文中结合简单实例，向大家介绍在VB程序中实现电子邮件收发功能的编程方法。
编制具有收发电子邮件功能的VB程序，必须使用Visual Basic 4.0以上的版本，因为只有4.0以上的Visual Basic才带有两个实现电子邮件收发功能的核心控件：MAPI会话控件和MAPI消息控件。MAPI会话控件用于建立和控制一个Microsoft Mail会话，MAPI消息控件用于创建和收发邮件消息。此外，程序必须运行在采用遵从MAPI的消息系统（如：Microsoft Exchange、Microsoft Mail、Outlook等）的环境中。
在开始编程之前，首先需要将MAPI控件加入VB工具箱。具体操作是：在VB菜单栏中选择Tools菜单项中的Custom Controls命令，调出"Custom Controls"对话框，在其中的"Available Controls"列表框中选中"Microsoft MAPI Controls"表项，然后按"OK"命令按钮退出该对话框。此后，工具箱中将新添两个图标，这就是MAPI会话控件和MAPI消息控件的图标。 下面，笔者将以两个简单的VB程序为例，分别介绍发送邮件和接收邮件的程序编制方法。 邮件发送程序
邮件发送程序的基本处理过程是：根据用户输入信息组成邮件，然后使用MAPI
消息控件的Send方法将邮件发出。编程步骤如下：
1、新建一个VB项目。
2、将缺省窗体Form1的Caption属性设置为"发送邮件"。
3、将MAPI控件加入VB工具框。
4、在Form1中加入一个MAPI会话控件MAPISession1和一个MAPI消息控件MAPIMessages1。
5、在Form1中加入三个文本框控件，将它们的Name属性分别设置为txtSendTo、txtSubject、txtMessage，并将txtMessage的Multiline属性设置为True。这三个文本框控件将分别用于填写邮件的收件人、主题和内容。
6、在Form1中加入三个标签控件，将它们的Caption属性分别设置为"收件人"、"主题"和"内容"，并将它们放在合适的位置用以标注相应的文本框控件。
7、在Form1中加入一个命令按钮控件，将其Caption属性和Name属性分别设置为"发送"和"cmdSend"。
8、将下列代码加入Form1的Form_Load事件：
Private Sub Form_Load()
MAPISession1.SignOn
End Sub
9、将下列代码加入Form1的Form_Unload事件：
Private Sub Form_Unload(Cancel As Integer)
MAPISession1.SignOff
End Sub
10、将下列代码加入cmdSend的Click事件：
Private Sub cmdSend_Click()
With MAPIMessages1
.MsgIndex = -1
.RecipDisplayName = txtSendTo.Text
.MsgSubject = txtSubject.Text
.MsgNoteText = txtMessage.Text
.SessionID = MAPISession1.SessionID
.Send
End With
MsgBox "邮件发送完毕！", , "发送邮件"
End Sub
程序运行后如图3所示。在填写完邮件的收件人、主题和内容后，按"发送"命令按钮，如果没有出现运行时错误提示，那么就表明邮件已经成功地发往目的地了，否则，请检查填写的收件人地址是否准确无误以及系统中运行的消息系统工作是否正常。 邮件接收程序 邮件接收程序比邮件发送程序稍微复杂一些。首先需要使用MAPI消息控件的Fetch方法读取邮件，这个过程将把用户收件箱中所有未读邮件全部装入MAPI消息控件中。然后，检查MAPI消息控件的MsgCount属性以确定通过Fetch方法读取的邮件的总数。接着，可以通过设置MAPI消息控件的MsgIndex属性来指定具体需要处理哪一封邮件。需要说明的是，MsgIndex属性值的计数是从0开始的，也就是说，第一封邮件的索引号是0，第二封邮件的索引号是1，依次类推。编程步骤如下：
1、新建一个VB项目。
2、将缺省窗体Form1的Caption属性设置为"接收邮件"。
3、将MAPI控件加入VB工具框。
4、在Form1中加入一个MAPI会话控件MAPISession1和一个MAPI消息控件MAPIMessages1。
5、在Form1中加入三个标签控件和一个文本框控件，将三个标签控件的Name属性分别设置为lblMsgDateReceived、lblMsgOrigDisplayName、lblMsgSubject，将文本框控件的Name属性设置为txtMsgNoteText，并将标签控件的Caption属性和文本框控件的Text属性的内容清空。这四个控件将分别用于显示邮件的日期、发件人、主题和内容。
6、将txtMsgNoteText控件的Locked属性和Multiline属性设置为True，ScrollBars属性设置为2 - Vertical。
7、在Form1中再加入四个标签控件用于标注上述四个控件，将它们的Caption属性分别设置为"日期"、"发件人"、"主题"、"内容"。
8、在Form1中加入一个标签控件，将其Name属性设置为lblMsgCount，Caption属性设置为"第 0 封邮件，总计 0 封邮件"。该控件用于显示接收的邮件总数以及当前正在处理第几封邮件。
9、在Form1中加入三个命令按钮控件，将它们的Name属性分别设置为cmdPrevious、cmdNext、cmdClose，Caption属性分别设置为"上一封"、"下一封"、"关闭"。
10、编写一个窗体级子例程FetchNewMail：
Public Sub FetchNewMail()
MAPIMessages1.FetchUnreadOnly = True
MAPIMessages1.Fetch
End Sub
11、编写一个窗体级子例程DisplayMessage：
Public Sub DisplayMessage()
lblMsgCount.Caption = "第 " & _
LTrim(Str(MAPIMessages1.MsgIndex + 1)) & " 封邮件，总计 " & _
LTrim(Str(MAPIMessages1.MsgCount)) & " 封邮件"
lblMsgDateReceived.Caption = MAPIMessages1.MsgDateReceived
txtMsgNoteText.Text = MAPIMessages1.MsgNoteText
lblMsgOrigDisplayName.Caption = MAPIMessages1.MsgOrigDisplayName
lblMsgSubject.Caption = MAPIMessages1.MsgSubject
End Sub
12、将下列代码加入Form1的Form_Load事件：
Private Sub Form_Load()
MAPISession1.SignOn
MAPIMessages1.SessionID = MAPISession1.SessionID
FetchNewMail
DisplayMessage
End Sub
13、将下列代码加入cmdPrevious的Click事件：
Private Sub cmdPrevious_Click()
If MAPIMessages1.MsgIndex > 0 Then
MAPIMessages1.MsgIndex = MAPIMessages1.MsgIndex - 1
DisplayMessage
Else
Beep
End If
End Sub
14、将下列代码加入cmdNext的Click事件：
Private Sub cmdNext_Click()
If MAPIMessages1.MsgIndex < MAPIMessages1.MsgCount - 1 Then
MAPIMessages1.MsgIndex = MAPIMessages1.MsgIndex + 1
DisplayMessage
Else
Beep
End If
End Sub
15、将下列代码加入cmdClose的Click事件：
Private Sub cmdClose_Click()
Unload Me
End Sub
程序运行后如图4所示。在窗体加载过程中，窗体Load事件中的代码会读取新邮件，如果有新邮件，就显示第一个新邮件。如果有多个新邮件，则可以使用"上一封"和"下一封"命令按钮前后翻阅。 接收邮件 本例是读取用户收件箱中所有未读邮件，如果要读取收件箱中所有的邮件，那么只需在执行Fetch方法之前，将MAPI消息控件的FetchUnreadOnly属性设置为False。具体接收的邮件是否已经读过，可以通过MsgRead属性来判别。如果邮件的正文或附件曾经被浏览过，那么该邮件就会自动标记为已读，不过只浏览邮件的主题不会标记该邮件已读。 邮件附件
与处理邮件的方式一样，MAPI也为邮件的附件提供了一个计数器和一个索引。在处理收到的邮件时，可以通过检查AttachmentCount属性来确定该邮件携带了多少个附件，然后可以通过设置AttachmentIndex属性依次处理每一个附件。
AttachmentIndex的合法取值范围为0至AttachmentIndex-1。在设置了AttachmentIndex属性值后，可以读取附件的下列属性：
AttachmentName：当附件是一个文件时，该属性用于指定文件的名称。当附件是
一个OLE对象时，该属性用于指定对象的类型。
AttachmentPath：该属性用于指定做为附件的文件的全路径名。
AttchmentPosition：该属性用于指定附件在邮件内容部分中的位置。当邮件收发程序显示邮件内容时，将使用该属性提供的信息把附件的标志放在合适的位置。
AttachmentType：该属性用于指定附件的类型，其合法取值为三个整数型数值，在VB中分别由下列常量表示：
·mapData－附件是一个数据文件
·mapEOLE－附件是一个嵌入式OLE对象
·mapSOLE－附件是一个静态OLE对象
发送邮件时，上述属性的使用方法与接收邮件时相同，只不过由读操作改为写操作了。值得一提的是AttachmentIndex属性，发送邮件时可以将其设置为任意值。而AttachmentCount属性则会自动设置为正确的值，无需人为设置。 小结
通过分析上述两个程序的代码，可以归纳出具有收发电子邮件功能的VB程序的基本流程如下：
1、使用MAPI会话控件建立一个邮件会话。
2、使用MAPI消息控件进行邮件的处理工作。
3、再次使用MAPI会话控件释放邮件会话。
由于上述两个VB程序只是简单的示例，因而略去了一些与本文主题关系不大的细节，如错误处理等。在编制实用程序时，为了保证程序的可靠性，应该考虑加入这些细节部分。
Dim Start As Single
Dim WaitTime As SinglePrivate Sub cmdSend_Click()
Dim sFrom As String
Dim sTo As String
Dim sSubject As String
Dim sDate As String
Dim sMailType As String
Dim sMailHeader As String
Dim sMailBody As String
Dim blnOK As Boolean
If Winsock1.State = sckClosed Then
' 使用 TCP Protocol
Winsock1.Protocol = sckTCPProtocol
' 設定郵件伺服器 IP Address
Winsock1.RemoteHost = txtServer.Text
' 設定 SMTP Port 為 25
Winsock1.RemotePort = 25
' 送件端嘗試連結至郵件伺服器端
Winsock1.Connect
' 等候郵件伺服器回傳 220 Ready for Mail 訊息
blnOK = WaitforResponse("220") ' Ready for Mail
If Not blnOK Then
StatusBar1.Panels(1).Text = "Status: Connection Fail"
StatusBar1.Refresh
Exit Sub
End If
StatusBar1.Panels(1).Text = "Status: Connecting ...."
StatusBar1.Refresh
' 送件端發出 HELO 指令
Winsock1.SendData "HELO " & txtServer.Text & vbCrLf
' 等候郵件伺服器回傳 250 OK 訊息
blnOK = WaitforResponse("250") ' OK
If Not blnOK Then
StatusBar1.Panels(1).Text = "Status: Connection Fail"
StatusBar1.Refresh
Exit Sub
End If
StatusBar1.Panels(1).Text = "Status: Connected"
StatusBar1.Refresh
' 送件端發出 MAIL FROM: 指令代表送件者 E-Mail Address
Winsock1.SendData "MAIL FROM: " & Trim(txtFromAddress.Text) & vbCrLf StatusBar1.Panels(1).Text = "Status: Sending Message"
StatusBar1.Refresh
' 等候郵件伺服器回傳 250 OK 訊息
blnOK = WaitforResponse("250") ' OK If Not blnOK Then
StatusBar1.Panels(1).Text = "Status: Connection Fail"
StatusBar1.Refresh
Exit Sub
End If ' 送件端發出 RCPT TO: 指令代表收件者 E-Mail Address
Winsock1.SendData "RCPT TO: " & Trim(txtToAddress.Text) & vbCrLf
' 等候郵件伺服器回傳 250 OK 訊息
blnOK = WaitforResponse("250") ' OK
If Not blnOK Then
StatusBar1.Panels(1).Text = "Status: Connection Fail"
StatusBar1.Refresh
Exit Sub
End If
' 送件端發出 DATA 指令代表開始傳送 E-Mail
Winsock1.SendData "DATA" & vbCrLf
' 等候郵件伺服器回傳 354 Start Mail Input 訊息
blnOK = WaitforResponse("354") ' Start Mail Input
If Not blnOK Then
StatusBar1.Panels(1).Text = "Status: Connection Fail"
StatusBar1.Refresh
Exit Sub
End If
' E-Mail Header (標頭) 部分
sFrom = "From: """ & txtFromName.Text & """ <" & Trim(txtFromAddress.Text) & ">" & vbCrLf
sTo = "To: """ & txtToName.Text & """ <" & Trim(txtToAddress.Text) & ">" & vbCrLf
sSubject = "Subject: " & txtSubject.Text & vbCrLf
sDate = "Date: " & Format(Date, "Ddd") & ", " & Format(Date, "dd Mmm YYYY") & " " & Format(Time, "hh:mm:ss") & " +0800" & vbCrLf
sMailType = "MIME-Version: 1.0" & vbCrLf & "X-Mailer: Internet Mail Service (5.5.2448.0)" & vbCrLf
sMailHeader = sFrom & sTo & sSubject & sDate & sMailType
' 送件端傳送 E-Mail Header (標頭) 部分
Winsock1.SendData sMailHeader & vbCrLf
' E-Mail Body (內容) 部分
sMailBody = txtMessage.Text & vbCrLf
' 送件端傳送 E-Mail Body (內容) 部分
Winsock1.SendData sMailBody & vbCrLf
' E-Mail 以句點 (.) 作為結尾
Winsock1.SendData vbCrLf & "." & vbCrLf
' 等候郵件伺服器回傳 250 OK 訊息
blnOK = WaitforResponse("250") ' OK
If Not blnOK Then
StatusBar1.Panels(1).Text = "Status: Connection Fail"
StatusBar1.Refresh
Exit Sub
End If
' 送件端發出 QUIT 指令代表關閉 TCP 連結
Winsock1.SendData "QUIT" & vbCrLf
StatusBar1.Panels(1).Text = "Status: Disconnecting"
StatusBar1.Refresh
' 等候郵件伺服器回傳 221 Close Connection 訊息
blnOK = WaitforResponse("221") ' Close Connection
If Not blnOK Then
StatusBar1.Panels(1).Text = "Status: Connection Fail"
StatusBar1.Refresh
Exit Sub
End If
' 關閉 Winsock
Winsock1.Close
StatusBar1.Panels(1).Text = "Status: Mail Sent"
StatusBar1.Refresh
End If
End SubPrivate Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
' 郵件伺服器回傳訊息, 其中:
' 220 代表 Ready for Mail
' 221 代表 Close Connection
' 250 代表 OK
' 354 代表 Start Mail Input
Winsock1.GetData strData
End SubPrivate Function WaitforResponse(ResponseCode As String) As Boolean
Start = Timer
' SMTP Error: Time Out
Do While Len(strData) = 0
WaitTime = Timer - Start
DoEvents
If WaitTime > 50 Then
MsgBox "SMTP Error: Time Out.", vbCritical
WaitforResponse = False
Exit Function
End If
Loop
' Winsock Error
Do While Left(strData, 3) <> ResponseCode
DoEvents
If WaitTime > 50 Then
MsgBox "SMTP Error: " & ResponseCode & " " & strData, vbCritical
WaitforResponse = False
Exit Function
End If
Loop
strData = ""
WaitforResponse = True
End FunctionPrivate Sub cmdExit_Click()
If Winsock1.State <> sckClosed Then
Winsock1.Close
End If End
End Sub