如何用VB的WINSOCK控件编写EMAIL

[textstar]

我想用VB的WINSOCK控件编写一个发送EMAIL的程序（只要发送）我想问用SENDDATA方法时是否有什么特定的格式如EMIAL的标题，时间，正文，发件人的地址等等如何来发送请举例说明，谢谢！

[sixfooter]

关注!

[zzssyyvc]

winsock和发邮件的协议不一样，你不如用mapi,vb中不是有这么一个控件吗？

[sinsky]

mapi好像要调用OutLook Express

[0xFFCD]

http://lovevb.2699.com上有例程可以下载，你去看看，不错的，完全原创，不像其他网站，你抄我，我抄你的。
　　 (\/)(\/)　/:""|　(\/)(\/)(\/)　
　>>>>>>==\/==\/===)`66|===\/==\/==\/====>　
　　　　　　　　　C`　　_)　　
　　　　　　　　　 \ ._|　　　
　　　　　　　　　　) / 　
　　　　　　　

[iceberg]

呵呵，你打算用vb的winsock控件实现SMTP协议吗？这个winsock控件只是封装了最基本的socket
功能，要实现SMTP，恐怕...
你还是去找个实现SMTP的ACTIVEX控件吧，如果你会visual c++，我这里有好几个SMTP协议封装类。

[hyui]

我把程序E-Mail给你吧！

[hyui]

也在这里给你:

先设置 Winsock1.Protocol=sckTCPProtocol RemotePort=25 LocalPort=1002(或其它)

程序如下:

Dim ReData As String '收到的数据
Dim Ans As Boolean '应答标志
Dim StopTime As Long '停止时间
Dim StartTime As Long '开始时间

Private Function SendMail(SeverName As String, LocalName As String, ToPep As String, Subject As String, FromPep As String, Mailer As String, Body As String) As Boolean
'* * * * * * * * * * * * * * * * *
'SeverName 远端SMTP服务器的IP或域名
'LocalName 本机域名
' ToPep 收件人的E-Mail地址
' Subject 邮件主题
' FromPep 发件人的E-Mail地址
' Mailer 发邮件的软件名
' Body 邮件正文
'* * * * * * * * * * * * * * * * *
SendMail = False
Ans = False
StopTime = 60 '停止时间=60秒
On Error GoTo Failed

Winsock1.RemoteHost = SeverName
Winsock1.Connect
Waiting
Winsock1.SendData "HELO" + LocalName + vbCrLf
Waiting
Winsock1.SendData "MAIL FROM:" + FromPep + vbCrLf
Waiting
Winsock1.SendData "RCPT TO:" + ToPep + vbCrLf '可以多次发送以发给多个人
Waiting
Winsock1.SendData "DATA" + vbCrLf
Waiting
Winsock1.SendData "Subject:" + Subject + vbCrLf
Winsock1.SendData "Reply-To:" + FromPep + vbCrLf
Winsock1.SendData "To:" + ToPep + vbCrLf
Winsock1.SendData Mailer + vbCrLf
Winsock1.SendData Body + vbCrLf
Winsock1.SendData vbCrLf + "." + vbCrLf '"."表示数据传送完毕
Waiting
Winsock1.SendData "QUIT" + vbCrLf '断开连接
Waiting
Winsock1.Close

SendMail = True
Exit Function

Failed:
Winsock1.Close
Ans = False

End Function

Private Sub Waiting()
StartTime = Timer
Do While Timer < StartTime + StopTime And Ans = False
DoEvents
Loop
Ans = False
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Winsock1.GetData ReData
Ans = True
End Sub

'参考自电脑报光盘

[zhdletter]

以下代码，有问题再说
Dim Response As String, Reply As Integer, 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 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 pre 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") & "" & " +0800"
first = "mail from:" + Chr(32) + FromEmailAddress + vbCrLf ' Get who's sending E-Mail address
Second = "rcpt to:" + Chr(32) + ToEmailAddress + vbCrLf ' Get who mail is going to
Third = "Date:" + Chr(32) + DateNow + vbCrLf ' Date when being sent
Fourth = "From:" + Chr(32) + FromName + vbCrLf ' Who's Sending
Fifth = "To:" + Chr(32) + ToNametxt + vbCrLf ' Who it going to
Sixth = "Subject:" + Chr(32) + EmailSubject + vbCrLf ' Subject of E-Mail
Seventh = EmailBodyOfMessage + vbCrLf ' E-mail message body
Ninth = "X-Mailer: EBT Reporter v 2.x" + vbCrLf ' What program sent the e-mail, customize this
Eighth = Fourth + Third + Ninth + Fifth + Sixth ' Combine for proper SMTP sending

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 worldcomputers.com" + vbCrLf)

WaitFor ("250")

StatusTxt.Caption = "Connected"
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 Command2_Click()

End

End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)

Winsock1.GetData Response ' Check for incoming response *IMPORTANT*

End Sub