VB Winsock发邮件时遇到问题 求解

Question

我这有一个vb程序来发送邮件 
可是在运行是老是报这个错误“实时错误“40006” 所需事物请求的错误协议连接或连接状态”
领导让改这个问题 可是我不会VB，所以请各位大侠帮帮忙 
  上代码了：
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
    DateNow = Format(Date, "Ddd") & ", " & Format(Date, "dd Mmm YYYY") & " " & Format(Time, "hh:mm:ss") & "" & " -0600"
    first = "mail from:" + Chr(32) + FromEmailAddress + vbCrLf
    Second = "rcpt to:" + Chr(32) + ToEmailAddress + vbCrLf
    Third = "Date:" + Chr(32) + DateNow + vbCrLf
    Fourth = "From:" + Chr(32) + FromName + vbCrLf
    Fifth = "To:" + Chr(32) + ToNametxt + vbCrLf
    Sixth = "Subject:" + Chr(32) + EmailSubject + vbCrLf
    Seventh = EmailBodyOfMessage + vbCrLf
    Ninth = "X-Mailer: EBT Reporter v 2.x" + vbCrLf
    Eighth = Fourth + Third + Ninth + Fifth + Sixth    Winsock1.Protocol = sckTCPProtocol
    Winsock1.RemoteHost = MailServerName
    Winsock1.RemotePort = 25
    Winsock1.Connect
    
    WaitFor ("220")--------------------------在这进入到错误
    
    StatusTxt.Caption = "连接中...."
    StatusTxt.Refresh
    Winsock1.SendData ("EHLO  新致公司！" + vbCrLf)
    
    WaitFor ("250")    Winsock1.SendData ("AUTH LOGIN" + vbCrLf)
    
    WaitFor ("334")    Winsock1.SendData (Encode64("xingbin.fan") + vbCrLf)
        
    WaitFor ("334")    Winsock1.SendData (Encode64("wangyun") + vbCrLf)
        WaitFor ("235")
   
    StatusTxt.Caption = "已连接"
    StatusTxt.Refresh
    Winsock1.SendData (first)    StatusTxt.Caption = "正在发送邮件信息................"
    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 = "所有邮件发送成功！"
    StatusTxt.Refresh    WaitFor ("221")    Winsock1.Close
Else
    MsgBox (str(Winsock1.State))
End If
End Sub

Answer 1

现在就这么点分了  有的话肯定多给你们点Sub WaitFor(ResponseCode As String)
    start = Timer
    While Len(Response) = 0
        Tmr = start - Timer
        DoEvents
        If Tmr > 50 Then
            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 = ""
End SubPrivate Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
    Winsock1.GetData Response --------------就是在这报出的错误
End Sub

Answer 2

整个思路都有问题，不出问题才是奇怪的事情。
VB的网络通讯是基于异步消息事件的，像这样一串的握手动作在一个过程处理完，想稳定是不可能的，因为VB是单线程的，这种过程在多线程中可能可以，但单线程的VB程序而言，未必可行。
所以，思路要改，主要的握手过程应该在事件里处理，而不是你的函数中等待结果再跳下一步，因为VB的主过程会占用很大的CPU使用率，根据机器的配置不同，这种操作的失误率也不同。就你这程序，有可能换个高配置的电脑搞不好就没问题了，但用个低性能的电脑，又不见得是一样的结果。关键在于等待过程可能对CPU占用率过大，导致响应消息失败.