VB 中用winsock控件发邮件的问题

[yingnvwuyan]

Dim strData As String
Dim Start As Single
Dim WaitTime As Single

Private Sub cmdSend_Click()
Dim sFrom As String
Dim sTo As String
Dim sSubject As String
Dim sDate As String
Dim sMaileType As String
Dim sMailHeader As String
Dim sMailBody As String
Dim blnOK As String

If Winsock1.State = sckClose Then
Winsock1.Protocol = sckTCPProtocol
Winsock1.RemoteHost = txtServer.Text
Winsock1.RemotePort = 25
blnOK = WaitforResponse("220")
If Not blnOK Then
StatusBar1.Panels(1).Text = "Status:Connection Fail"
StatusBar1.Refresh
Exit Sub
End If

StatusBar1.Panels(1).Text = "Status:Connecting.."
StatusBar1.Refresh
Winsock1.SendData "HELO" & txtServer.Text & vbCrLf
blnOK = WaitforResponse("250")
If Not blnOK Then
StatusBar1.Panels(1).Text = "Status:Connection Fail"
StatusBar1.Refresh
Exit Sub
End If
StatusBar1.Panels(1).Text=
"Status:Connected"
StatusBar1.Refresh
Winsock1.SendData "MAIL FORM:" & Trim
(txtFromAddress.Text) & vbCrLf
StatusBar1.Panels(1).Text = "Status:"
Sending Message"
StatusBar1.Refresh
blnOK = WaitforResponse("250")
If Not blnOK Then
StatusBar1.Panels(1).Text = "Status:"
Connection Fail"
StatusBar1.Refresh
Exit Sub
End If
Winsock1.SendData "RCPT TO:" & Trim
(txtToAddress.Text) & vbCrLF
blnOK = WaitforResponse("250")
If Not blnOK Then
StatusBar1.Panels(1).Text = "Status:"
Connection Fail"
StatusBar1.Refresh
Exit Sub
End If
Winsock1.SendData "DATA" & vbCrLf
blnOK = WaitforResponse("354")
If Not blnOK Then
StatusBar1.Panels(1).Text = "Status:"
Connection Fail"
StatusBar1.Refresh
Exit Sub
End If
'E-Mail Header
sFrom="From:"""& txtFromName.Text &
"""<" & Trim(txtFromAddress.Text) &">
" & vbCrLf
sTo = "To:"" & txtToName.Text & """ < ""
& Trim(txtTomAddress.Text) &"> " & vbCrLf
sSubject = "Subject: " & txtSubject.Text
& vbCrLf
sDate="Date: "& Format(Date "Ddd") &
"." & Format(Date. "dd Mmm YYYY") & "
" & Format(Time. "hh:mm:ss") & " +0800"
& vbCrLf
sMailType = "MIME-Version: 1.0" & vbCrLf
& "X-Mailer: lnternet Mail Service
(5.5.2448.0)" & vbCrLf
sMailHeader=sFrom & sTO & sSubject &
sDate & sMailType
Winsock1.SendData sMailHeader & vbCrLf
sMailBody = txtMessage.Text & vbCrLf
Winsock1.SendData sMailBody & vbCrLf
Winsock1.SendData vbCrLf & "." & vbCrLf
blnOK = WaitforResponse("250")

If Not blnk Then
StatusBar1.Panels(1).Text = "Status:"
Connection Fail"
StatusBar1.Refresh
Exit Sub
End If

Winsock1.SendData "OUIT" & vbCrLf
StatusBar1.Panels(1).Text = "Status:"
Disconnecting ""
StatusBar1.Refresh
blnOK=WaitforResponse("221)
If Not blnOK Then
StatusBar1.Panels(1).Text = "Status:"
Connection Fail"
StatusBar1.Refresh
Exit Sub
End If
Winsock1.Close
StatusBar1.Panels(1).Text = "Staus:"
Mail Sent"
StatusBar1.Refresh
End If
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal
As Long)
Winsock1.GetData strData
End Sub

Private Function WaitforResponse(ResponseCode As
Sting) As Boolean
Start = Timer
'SMTP Error: Time Out
Do White Len(strData)=0
WaitTime = Timer - Start
DoEvents
If WaitTime > 50 Then
MsgBox "SMTP Error : Tine Out". vbCritical
WaitforResponse = False
Exit Funtion
End If
Loop
'Winsock Error
Do While Left(strData, 3) <> ResponseCode
DoEvents
If WaitTime > 50 Then
MsgBox "SMTP Error:" & ResponseCode
& " " & strData ,vbCritical
WaitforResponse = False
Exit Function
End If
Loop

strData = ""
WaitforResponse = True
End Function

Private Sub cmdExit_Click()
If Winsock1.State <> scocked Then
Winsock1.Close
End If

End
End Sub


'为什么说WaitforResponse函数未定义，该怎么改呢

[threenewbee]

blnOK=WaitforResponse("221")

Private Function WaitforResponse(ResponseCode As
String) As Boolean

这个代码是手输入的还是扫描识别的，到处都是错误。
建议lz先掌握原理，这个代码没用的。

[yingnvwuyan]

引用 1 楼 caozhy 的回复:

blnOK=WaitforResponse("221")

Private Function WaitforResponse(ResponseCode As
                                  String) As Boolean

这个代码是手输入的还是扫描识别的，到处都是错误。
建议lz先掌握原理，这个代码没用的。

对着书本输入的