Dim response As String
Dim datenow As String
Dim 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 String
Private Sub Command1_Click()
Call sendemail(txtEmailServer.Text, txtFromName.Text, txtFromEmail.Text, txtToName.Text, txtToEmail.Text, txtEmailSubject.Text, txtEmailBodyOfMessage.Text)
statusTxt.Refresh
Beep
Close
End Sub
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
If Winsock1.State <> sckClosed Then Winsock1.Close
datenow = Format(Now, "yyyy.mm.dd hh:mm:ss")
first = "MAIL From:" + Chr(32) + "<" + fromemailaddress + ">" + vbCrLf
second = "RCPT TO:" + Chr(32) + "<" + toemailaddress + ">" + vbCrLf
third = "date:" + Chr(32) + datenow + vbCrLf
fourth = "form:" + Chr(32) + fromname + vbCrLf
fifth = "to:" + Chr(32) + toname + vbCrLf
sixth = "subject:" + Chr(32) + emailsubject + vbCrLf
seventh = emailbodyofmessage + vbCrLf
eighth = fourth + vbCrLf + third + vbCrLf + fifth + vbCrLf + sixth
Winsock1.Protocol = sckTCPProtocol
Winsock1.RemoteHost = mailservername
Winsock1.RemotePort = 25
Winsock1.Connect
waitfor ("220")
statusTxt.Caption = "connecting……"
statusTxt.Refresh

Winsock1.SendData "HELO edefc5cc7df74ee" & vbCrLf
waitfor ("250")
Debug.Print response

Winsock1.SendData "AUTH LOGIN" & vbCrLf
waitfor ("334")

Winsock1.SendData "emFvdXQ=" & vbCrLf
waitfor ("334")

Winsock1.SendData "MjM0NTY3" & vbCrLf
waitfor ("235")
statusTxt.Caption = "connected"
statusTxt.Refresh

Winsock1.SendData first
Debug.Print first
waitfor ("250")
statusTxt.Caption = "sending message"
statusTxt.Refresh

Winsock1.SendData second
Debug.Print second
waitfor ("250")

Winsock1.SendData "DATA" & vbCrLf
waitfor ("354")
Debug.Print response

Winsock1.SendData eighth

Winsock1.SendData seventh

Winsock1.SendData vbCrLf & "." & vbCrLf
waitfor ("250")
Debug.Print response

Winsock1.SendData "QUIT" & vbCrLf
waitfor ("221")
Debug.Print response

Winsock1.Close
statusTxt.Caption = "disconnecting"
statusTxt.Refresh
MsgBox "发送成功！"
End Sub
Sub waitfor(responsecode As String)
start = Timer
While Len(response) = 0
tmr = Timer - start
DoEvents
If tmr > 100 Then
MsgBox "smtp serviceerror,timed out while waiting for response", 64, msgtitle
Exit Sub
End If
Wend
While Left(response, 3) <> responsecode
DoEvents
If tmr > 100 Then
MsgBox "smtp service error,impromper response code." _
& "code should have been :" + responsecode + "code received:" + response, 64, msgtitle
Exit Sub
End If
Wend
response = ""
End Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Winsock1.GetData response
Debug.Print response
End Sub

Private Sub Winsock1_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)

MsgBox "Winsock Error number " & Number & vbCrLf & _
Description, vbExclamation, "Winsock Error"

End Sub