这个例子网上有很多版本,但是通常能发的,异常管理不是做的很好,这里的代码是我稍加整理的。包含了认证过程,我想现在SMTP一般都是要认证的吧。不要认证的只需把相应的行去掉即可。
代码如下:
Dim Response As String, Reply As Integer
Dim DateNow As String, first As String, Second As String, Third As String
Dim Fourth As String, Fifth As String, Sixth As String
Dim Seventh As String, Eighth As String
Dim Start As Single, Tmr As Single
Sub SendEmail(MailServerName As String, FromName As String, FromEmailAddress As String, ToName As String, ToEmailAddress As String, EmailSubject As String, EmailBodyOfMessage As String)
Winsock1.LocalPort = 0 ' Must set local port to 0 (Zero) or
'you can only send 1 e-mail per program
'start
If Winsock1.State = sckClosed Then 'Check to see if socet is closed
DateNow = Format(Date, "Ddd") & ", " _
& Format(Date, "dd Mmm YYYY") & " " _
& Format(Time, "hh:mm:ss") & "" & " -0600"
' Get who's sending E-Mail address
first = "mail from:" + Chr(32) + FromEmailAddress + vbCrLf
' Get who mail is going to
Second = "rcpt to:" + Chr(32) + ToEmailAddress + vbCrLf
' Date when being sent
Third = "Date:" + Chr(32) + DateNow + vbCrLf
' Who's Sending
Fourth = "From:" + Chr(32) + FromName + vbCrLf
' Who it going to
Fifth = "To:" + Chr(32) + ToNametxt + vbCrLf
' Subject of E-Mail
Sixth = "Subject:" + Chr(32) + EmailSubject + vbCrLf
' E-mail message body
Seventh = EmailBodyOfMessage + vbCrLf
' What program sent the e-mail, customize this
Ninth = "X-Mailer: EBT Reporter v 2.x" + vbCrLf
' Combine for proper SMTP sending
Eighth = Fourth + Third + Ninth + Fifth + Sixth
Winsock1.Protocol = sckTCPProtocol ' Set protocol for sending
Winsock1.RemoteHost = MailServerName ' Set the server address
Winsock1.RemotePort = 25 ' Set the SMTP Port
Winsock1.Connect ' Start connection
WaitFor ("220")
StatusTxt.Caption = "Connecting...."
StatusTxt.Refresh
Winsock1.SendData ("HELO xxx.gov.cn" + vbCrLf)
WaitFor ("250")
StatusTxt.Caption = "Connected"
StatusTxt.Refresh
Winsock1.SendData ("AUTH LOGIN" + vbCrLf)
WaitFor ("334")
StatusTxt.Caption = "Sending AUTH LOGIN"
StatusTxt.Refresh
Winsock1.SendData (Base64_Encode("danny@xxx.gov.cn") + vbCrLf)
WaitFor ("334")
StatusTxt.Caption = "Sending Username"
StatusTxt.Refresh
Winsock1.SendData (Base64_Encode("danny") + vbCrLf)
WaitFor ("235")
StatusTxt.Caption = "Sending Password"
StatusTxt.Refresh
Winsock1.SendData (first)
StatusTxt.Caption = "Sending Message"
StatusTxt.Refresh
WaitFor ("250")
Winsock1.SendData (Second)
WaitFor ("250")
Winsock1.SendData ("data" + vbCrLf)
WaitFor ("354")
Winsock1.SendData (Eighth + vbCrLf)
Winsock1.SendData (Seventh + vbCrLf)
Winsock1.SendData ("." + vbCrLf)
WaitFor ("250")
Winsock1.SendData ("quit" + vbCrLf)
StatusTxt.Caption = "Disconnecting"
StatusTxt.Refresh
WaitFor ("221")
Winsock1.Close
Else
MsgBox (Str(Winsock1.State))
End If
End Sub
Sub WaitFor(ResponseCode As String)
Start = Timer ' Time event so won't get stuck in loop
While Len(Response) = 0
Tmr = Start - Timer
DoEvents ' Let System keep checking for incoming response **IMPORTANT**
If Tmr > 50 Then ' Time in seconds to wait
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 = "" ' Sent response code to blank **IMPORTANT**
End Sub
Private Sub Command1_Click()
SendEmail txtEmailServer.Text, txtFromName.Text, txtFromEmailAddress.Text, txtToEmailAddress.Text, txtToEmailAddress.Text, txtEmailSubject.Text, txtEmailBodyOfMessage.Text 'MsgBox ("Mail Sent")
StatusTxt.Caption = "Mail Sent"
StatusTxt.Refresh
Beep
Close
End Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Winsock1.GetData Response ' Check for incoming response *IMPORTANT*
End Sub
Private Function Base64_Encode(strSource) As String 'base6加密算法
Const BASE64_TABLE As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
Dim strTempLine As String
Dim j As Integer
For j = 1 To (Len(strSource) - Len(strSource) Mod 3) Step 3
strTempLine = strTempLine + Mid(BASE64_TABLE, (Asc(Mid(strSource, j, 1)) \ 4) + 1, 1)
strTempLine = strTempLine + Mid(BASE64_TABLE, ((Asc(Mid(strSource, j, 1)) Mod 4) * 16 _
+ Asc(Mid(strSource, j + 1, 1)) \ 16) + 1, 1)
strTempLine = strTempLine + Mid(BASE64_TABLE, ((Asc(Mid(strSource, j + 1, 1)) Mod 16) * 4 _
+ Asc(Mid(strSource, j + 2, 1)) \ 64) + 1, 1)
strTempLine = strTempLine + Mid(BASE64_TABLE, (Asc(Mid(strSource, j + 2, 1)) Mod 64) + 1, 1)
Next j
If Not (Len(strSource) Mod 3) = 0 Then
If (Len(strSource) Mod 3) = 2 Then
strTempLine = strTempLine + Mid(BASE64_TABLE, (Asc(Mid(strSource, j, 1)) \ 4) + 1, 1)
strTempLine = strTempLine + Mid(BASE64_TABLE, (Asc(Mid(strSource, j, 1)) Mod 4) * 16 _
+ Asc(Mid(strSource, j + 1, 1)) \ 16 + 1, 1)
strTempLine = strTempLine + Mid(BASE64_TABLE, (Asc(Mid(strSource, j + 1, 1)) Mod 16) * 4 + 1, 1)
strTempLine = strTempLine & "="
ElseIf (Len(strSource) Mod 3) = 1 Then
strTempLine = strTempLine + Mid(BASE64_TABLE, Asc(Mid(strSource, j, 1)) \ 4 + 1, 1)
strTempLine = strTempLine + Mid(BASE64_TABLE, (Asc(Mid(strSource, j, 1)) Mod 4) * 16 + 1, 1)
strTempLine = strTempLine & "=="
End If
End If
Base64_Encode = strTempLine
End Function
分享到:
相关推荐
VB6.0 实现了简单 Socket 服务端,利用了 winsock 控件
利用VB6.0中WINSOCK控件实现一个服务器端对多个客户端的SOCKET通讯。
在VB6.0中调用SQL Server的存储过程是VB开发者经常遇到的问题,本文将详细介绍如何在VB6.0中调用SQL Server的存储过程,并对存储过程的优点和使用方法进行了详细的解释。 首先,存储过程是一种封装方法,用于重复...
Delphi6.0与VB6.0中的Socket技术对比分析及集成
VB6.0中DataGrid的应用
VB 6.0 中文企业版 VB 6.0 中文企业版 VB 6.0 中文企业版
VB6.0中使用鼠标滑轮的解决方法及文件和说明
VB6.0 收发邮件,附代码 VB6.0 收发邮件,附代码
vb6.0vb6.0vb6.0vb6.0vb6.0
vb6.0序列号 vb6.0序列号 vb6.0序列号 vb6.0序列号 vb6.0序列号 vb6.0序列号 vb6.0序列号
一个VB6.0的toolbar的使用示范,toolbar是很好用的控件
《 VB6.0中通过MSChart控件调用数据库 》
vb6.0学习vb6.0学习
VB6.0 在图片框中显示PNG图片
用Visual Basic 6.0编写的OCR识别程序,对数字的识别率高
撰写新邮件,使用MAPI对话框撰写及发送电子邮件,使用设计的窗体NewMsg撰写及发送电子邮件,在删除当前邮件后,下一封邮件的位置设置为当前位置,这时需要判断该邮件是否已经在子窗体MsgView中显示,如是,将其设为...
VB6.0完整版VB6.0完整版
网上下载收集的VB6.0反编译软件。对VB6.0开发的软件功能进行分析。
vb6.0使用案例-一般好vb6.0使用案例-一般好vb6.0使用案例-一般好vb6.0使用案例-一般好vb6.0使用案例-一般好vb6.0使用案例-一般好
vb6.0winsock控件2种方式发送大文件,包含服务端、客户端