曾在网上下载过一具用SMTP发邮件的程序,用一些网站申请的免费邮箱SMPT发送邮件可以成功,但对搜狐、新浪、雅虎之类的网站去无法完成发送任务。听说这和网站需要验证身份有关,但我不知道该在程序中的哪个地方加入验证,请高手指教。先谢谢啦。Dim Response As String, Reply As Integer
Dim DateNow As String, 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 SingleSub 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 per 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") & "" & " -0600"
        
        ' Get who's sending E-Mail address
        first = "mail from:" + Chr(32) + FromEmailAddress + vbCrLf
        ' Get who mail is going to
        Second = "rcpt to:" + Chr(32) + ToEmailAddress + vbCrLf
        ' Date when being sent
        Third = "Date:" + Chr(32) + DateNow + vbCrLf
        ' Who's Sending
        Fourth = "From:" + Chr(32) + FromName + vbCrLf
        ' Who it going to
        Fifth = "To:" + Chr(32) + ToNametxt + vbCrLf
        ' Subject of E-Mail
        Sixth = "Subject:" + Chr(32) + EmailSubject + vbCrLf
        ' E-mail message body
        Seventh = EmailBodyOfMessage + vbCrLf
        ' What program sent the e-mail, customize this
        Ninth = "X-Mailer: EBT Reporter v 2.x" + vbCrLf
        ' Combine for proper SMTP sending
        Eighth = Fourth + Third + Ninth + Fifth + Sixth
        
        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 SubSub 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 SubPrivate 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 SubPrivate Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
    Winsock1.GetData Response ' Check for incoming response *IMPORTANT*
End Sub