可以参考一下: Public Sub SendMail(strFrom As String, strTo As String, strSubject As String, strBody As TextBox, wsk As Winsock, Optional strAttachName As String, Optional txtEncodedFile As Control)
Dim intCount As Integer
Wait 0.5
wsk.SendData "EHLO " & wsk.LocalIP & vbCrLf wsk.SendData "AUTH LOGIN" + vbCrLf Wait 0.5 If Not nocheck Then wsk.SendData B64E(strusername) + vbCrLf
wsk.SendData B64E(strpsd) + vbCrLf End If wsk.SendData "MAIL FROM:" & strFrom & vbCrLf
用VB设计有安全认证服务的Email
http://www.chinabyte.com/20020917/1630892.shtml
Public Sub SendMail(strFrom As String, strTo As String, strSubject As String, strBody As TextBox, wsk As Winsock, Optional strAttachName As String, Optional txtEncodedFile As Control)
Dim intCount As Integer
Wait 0.5
wsk.SendData "EHLO " & wsk.LocalIP & vbCrLf
wsk.SendData "AUTH LOGIN" + vbCrLf
Wait 0.5
If Not nocheck Then
wsk.SendData B64E(strusername) + vbCrLf
wsk.SendData B64E(strpsd) + vbCrLf
End If
wsk.SendData "MAIL FROM:" & strFrom & vbCrLf
Wait 0.5
wsk.SendData "RCPT TO:" & strTo & vbCrLf
wsk.SendData "DATA" & vbCrLf
Wait 0.5
wsk.SendData "MIME-Version: 1.0" & vbCrLf
wsk.SendData "From: " & ExtractArgument(1, strFrom, "@") & " <" & strFrom & ">" & vbCrLf
wsk.SendData "To: <" & strTo & ">" & vbCrLf
wsk.SendData "Subject: " & strSubject & vbCrLf
wsk.SendData "Content-Type: multipart/mixed;" & vbCrLf
wsk.SendData " boundary=Unique-Boundary" & vbCrLf & vbCrLf
wsk.SendData " [ Random garbage here ]" & vbCrLf & vbCrLf
wsk.SendData vbCrLf & "--Unique-Boundary" & vbCrLf
wsk.SendData "Content-type: text/plain; charset=US-ASCII" & vbCrLf & vbCrLf
wsk.SendData strBody.Text & vbCrLf & "." & vbCrLf
If LTrim(RTrim(strAttachName)) <> "" Then
For intCount = Len(strAttachName) To 1 Step -1
If Mid(strAttachName, intCount, 1) = "\" Then
strAttachName = Mid(strAttachName, intCount + 1)
GoTo lala
End If
Next intCount
lala:
wsk.SendData "--Unique-Boundary" & vbCrLf
wsk.SendData "Content-Type: multipart/parallel; boundary=Unique-Boundary-2" & vbCrLf & vbCrLf
wsk.SendData "--Unique-Boundary-2" & vbCrLf
wsk.SendData "Content-Type: application/octet-stream;" & vbCrLf
wsk.SendData " name=" & strAttachName & vbCrLf
wsk.SendData "Content-Transfer-Encoding: base64" & vbCrLf
wsk.SendData "Content-Disposition: inline;" & vbCrLf
wsk.SendData " filename=" & strAttachName & vbCrLf & vbCrLf
wsk.SendData txtEncodedFile.Text & "==" & vbCrLf
wsk.SendData "--Unique-Boundary-2----Unique-Boundary--"
End If
wsk.SendData vbCrLf & "." & vbCrLf
Wait 0.5
wsk.SendData "QUIT" & vbCrLf
Wait 0.5
wsk.Close
End Sub
以下是程序的返回信息,请各位大虾帮忙诊断一下,非常感谢:
220 ok RsProxyServer Ready
250 ok RsProxyServer
334 VXNlcm5hbWU6
334 UGFzc3dvcmQ6
235 authenticated
250 ok MailTo
250 ok RcptTo
354 ok Send it kkk
250 Message Queue (发送"."号后返回250)
220 goodbye (发送QUIT后,返回220)
我在一些书上看到发送QUIT后,应返回221,请问是怎么回事?
Private Sub cmdSend_Click()Wsock.Close
txtMsg.Text = ""
Wsock.RemoteHost = ServerIp
Wsock.RemotePort = ServerPort
strSendName = txtSName.Text
strReceiveName = txtRName.Text
strFromMail = txtFrom.Text
strToMail = txtTo.TextstrSubject = txtSubject.Text
strContent = txtContent.Text
Dim mData As StringmData = "邮件标题"
Wsock.CloseWsock.Connect
Wsock.SendData "HELO" & " " & Wsock.LocalHostName & vbCrLfWsock.SendData "AUTH LOGIN" + vbCrLfWsock.SendData Base64EncodeString("zhliu") + vbCrLfWsock.SendData Base64EncodeString("197881") + vbCrLf
Wsock.SendData "MAIL FROM:" & " " & strFromMail & vbCrLfWsock.SendData "RCPT TO:" & " " & strToMail & vbCrLfWsock.SendData "DATA" & vbCrLfWsock.SendData mData & vbCrLf
Wsock.SendData strContent & vbCrLf
Wsock.SendData "." & vbCrLfWsock.SendData "QUIT" & vbCrLf
If Not WaitForResponse("221", 20) Then '等待20秒
txtMsg.Text = txtMsg.Text & "失败" & vbCrLf
Exit Sub
End IfWsock.ClosetxtMsg.Text = txtMsg.Text & "发送成功"End SubPrivate Sub Wsock_DataArrival(ByVal bytesTotal As Long)
Wsock.GetData information
txtMsg.Text = txtMsg.Text & information & vbCrLf
End Sub结果会打出“失败”信息