VB中发送邮件的子程序.

领测软件测试网

　　 
　　VB中发送邮件的子程序.
白东,翻译整理,VBGood,http://www.vbgood.com

一个发送邮件的子程序,后面附带了,如果自动定时发送的例子.

这是调用方法:

SendEmail "mailserver.com", "support@domainname.com", "support@domainname.com", Email, Email, UserName, textarea

Global Response As String, Reply As Integer, DateNow As String
Global first As String, Second As String, Third As String
Global Fourth As String, Fifth As String, Sixth As String
Global Seventh As String, Eighth As String
Global Start As Single, Tmr As Single

Public Sub SendEmail(toMailServerName As String, FromName As String, FromEmailAddress As String, ToName
As String, ToEmailAddress As String, EmailSubject As String, EmailBodyOfMessage As String)
注释：使用的名称是默认名称
   Form1.Winsock1.LocalPort = 0 注释： 必须设定本地端口(local port)为 0 或者是最适合你的机器的端口
   
If Form1.Winsock1.State = sckClosed Then 注释： 检测socket是否关闭
   DateNow = Format(Date, "Ddd") & ", " & Format(Date, "dd Mmm YYYY") & " " & Format(Time, "hh:mm:ss")
& "" & " -0600"
   first = "mail from:" + Chr(32) + FromEmailAddress + vbCrLf 注释： 接受邮件地址
   Second = "rcpt to:" + Chr(32) + ToEmailAddress + vbCrLf 注释： 发送地址
   Third = "Date:" + Chr(32) + DateNow + vbCrLf 注释： 发送的数据
   Fourth = "From:" + Chr(32) + FromName + vbCrLf 注释： 发送者姓名
   Fifth = "To:" + Chr(32) + ToName + vbCrLf 注释： 接受者姓名
   Sixth = "Subject:" + Chr(32) + EmailSubject + vbCrLf 注释： E-Mail的主题
   Seventh = EmailBodyOfMessage + vbCrLf 注释： E-mail的内容
   Ninth = "X-Mailer: EBT Reporter v 2.x" + vbCrLf 注释： 配置这个使用那个smtp,自定义这个使用正确的smtp.
   Eighth = Fourth + Third + Ninth + Fifth + Sixth

   Form1.Winsock1.Protocol = sckTCPProtocol 注释： 设置发送协议
   Form1.Winsock1.RemoteHost = toMailServerName 注释： 设置服务器地址(POP3)
   Form1.Winsock1.RemotePort = 25 注释： 设置SMTP端口.
   Form1.Winsock1.Connect 注释： 开始连接
   
   WaitFor ("220")  注释：给出正在连接的提示
   
   注释：StatusTxt.Caption = "Connecting...."
   注释：StatusTxt.Refresh
   
   Form1.Winsock1.SendData ("HELO xxyyzz.com" + vbCrLf)

   WaitFor ("250")  注释：给出连接成功提示

   注释：StatusTxt.Caption = "Connected"
   注释：StatusTxt.Refresh

   Form1.Winsock1.SendData (first)  注释：给出正在发送邮件的提示

   注释：StatusTxt.Caption = "Sending Message"
   注释：StatusTxt.Refresh

   WaitFor ("250")

   Form1.Winsock1.SendData (Second)

   WaitFor ("250")

   Form1.Winsock1.SendData ("data" + vbCrLf)
   
   WaitFor ("354")

   Form1.Winsock1.SendData (Eighth + vbCrLf)
   Form1.Winsock1.SendData (Seventh + vbCrLf)
   Form1.Winsock1.SendData ("." + vbCrLf)

   WaitFor ("250")

   Form1.Winsock1.SendData ("quit" + vbCrLf)  注释：给出不能发送的提示
   
   注释：StatusTxt.Caption = "Disconnecting"
   注释：StatusTxt.Refresh

   WaitFor ("221")

   Form1.Winsock1.Close
Else
   Send "Winsock State" & Str(Form1.Winsock1.State)
   注释：MsgBox (Str(Winsock1.State))
End If
Exit Sub
End Sub

下面是一个自动发送的:
Public Sub WaitFor(ResponseCode As String)
   Start = Timer 注释： Time事件看是否在执行期间
   While Len(Response) = 0
       Tmr = Start - Timer
       DoEvents 注释： 让系统保持检测引入的响应**这个对于自动发送是比较重要的**
       If Tmr > 50 Then 注释： Time 进入第二次等待状态  并给出信息.
           注释：MsgBox "SMTP service error, timed out while waiting for response", 64, MsgTitle
           Exit Sub
       End If
   Wend
   While Left(Response, 3) <> ResponseCode
       DoEvents
       If Tmr > 50 Then
           注释：MsgBox "SMTP service error, impromper response code. Code should have been: " + ResponseCode
+ " Code recieved: " + Response, 64, MsgTitle
           Exit Sub
       End If
   Wend
Response = "" 注释： 发送空白response代码 Sent response code to blank **重要的!**
Exit Sub
End Sub 

文章来源于领测软件测试网 https://www.ltesting.net/