我写了一个邮件发送程序,但smtp服务器要求输入用户名、密码,请问如何在程序中自动向服务器发送验证信息呢。急!请各位高手指点,解决即给分。先谢谢啦

解决方案 »

  1.   

    看看这个:
    用VB设计有安全认证服务的Email 
    http://www.chinabyte.com/20020917/1630892.shtml
      

  2.   

    可以参考一下:
    Public Sub SendMail(strFrom As String, strTo As String, strSubject As String, strBody As TextBox, wsk As Winsock, Optional strAttachName As String, Optional txtEncodedFile As Control)
        
        Dim intCount As Integer
        
        Wait 0.5
        
        wsk.SendData "EHLO " & wsk.LocalIP & vbCrLf
        wsk.SendData "AUTH LOGIN" + vbCrLf
        Wait 0.5
        If Not nocheck Then
            wsk.SendData B64E(strusername) + vbCrLf
        
            wsk.SendData B64E(strpsd) + vbCrLf
        End If
        wsk.SendData "MAIL FROM:" & strFrom & vbCrLf
        
        Wait 0.5
        
        wsk.SendData "RCPT TO:" & strTo & vbCrLf
        wsk.SendData "DATA" & vbCrLf
        
        Wait 0.5
        
        wsk.SendData "MIME-Version: 1.0" & vbCrLf
        wsk.SendData "From: " & ExtractArgument(1, strFrom, "@") & " <" & strFrom & ">" & vbCrLf
        wsk.SendData "To: <" & strTo & ">" & vbCrLf
        wsk.SendData "Subject: " & strSubject & vbCrLf
        wsk.SendData "Content-Type: multipart/mixed;" & vbCrLf
        wsk.SendData "              boundary=Unique-Boundary" & vbCrLf & vbCrLf
        wsk.SendData " [ Random garbage here ]" & vbCrLf & vbCrLf
        wsk.SendData vbCrLf & "--Unique-Boundary" & vbCrLf
        wsk.SendData "Content-type: text/plain; charset=US-ASCII" & vbCrLf & vbCrLf
        wsk.SendData strBody.Text & vbCrLf & "." & vbCrLf
        
        If LTrim(RTrim(strAttachName)) <> "" Then
        
            For intCount = Len(strAttachName) To 1 Step -1
            
                If Mid(strAttachName, intCount, 1) = "\" Then
                    strAttachName = Mid(strAttachName, intCount + 1)
                    GoTo lala
                End If
                
            Next intCount
    lala:
            wsk.SendData "--Unique-Boundary" & vbCrLf
            wsk.SendData "Content-Type: multipart/parallel; boundary=Unique-Boundary-2" & vbCrLf & vbCrLf
            wsk.SendData "--Unique-Boundary-2" & vbCrLf
            wsk.SendData "Content-Type: application/octet-stream;" & vbCrLf
            wsk.SendData " name=" & strAttachName & vbCrLf
            wsk.SendData "Content-Transfer-Encoding: base64" & vbCrLf
            wsk.SendData "Content-Disposition: inline;" & vbCrLf
            wsk.SendData " filename=" & strAttachName & vbCrLf & vbCrLf
            wsk.SendData txtEncodedFile.Text & "==" & vbCrLf
            wsk.SendData "--Unique-Boundary-2----Unique-Boundary--"
            
        End If
        
        wsk.SendData vbCrLf & "." & vbCrLf
        
        Wait 0.5
        
        wsk.SendData "QUIT" & vbCrLf
        
        Wait 0.5
        
        wsk.Close
        
    End Sub
      

  3.   

    谢谢楼上两位大虾,问题得到解决,稍后我会给分的(现在给的话要揭帖,因为下面还有问题),可我在目标邮箱里仍然没有收到邮件,应该是没有发出去吧。
    以下是程序的返回信息,请各位大虾帮忙诊断一下,非常感谢:
    220 ok RsProxyServer Ready    
    250 ok RsProxyServer
    334 VXNlcm5hbWU6
    334 UGFzc3dvcmQ6
    235 authenticated
    250 ok MailTo
    250 ok RcptTo
    354 ok Send it kkk
    250 Message Queue   (发送"."号后返回250)
    220 goodbye   (发送QUIT后,返回220)
    我在一些书上看到发送QUIT后,应返回221,请问是怎么回事?
      

  4.   

    主要程序附下:
    Private Sub cmdSend_Click()Wsock.Close
    txtMsg.Text = ""
    Wsock.RemoteHost = ServerIp
    Wsock.RemotePort = ServerPort
    strSendName = txtSName.Text
    strReceiveName = txtRName.Text
    strFromMail = txtFrom.Text
    strToMail = txtTo.TextstrSubject = txtSubject.Text
    strContent = txtContent.Text
    Dim mData As StringmData = "邮件标题"
    Wsock.CloseWsock.Connect
       
    Wsock.SendData "HELO" & " " & Wsock.LocalHostName & vbCrLfWsock.SendData "AUTH LOGIN" + vbCrLfWsock.SendData Base64EncodeString("zhliu") + vbCrLfWsock.SendData Base64EncodeString("197881") + vbCrLf
    Wsock.SendData "MAIL FROM:" & " " & strFromMail & vbCrLfWsock.SendData "RCPT TO:" & " " & strToMail & vbCrLfWsock.SendData "DATA" & vbCrLfWsock.SendData mData & vbCrLf
    Wsock.SendData strContent & vbCrLf
    Wsock.SendData "." & vbCrLfWsock.SendData "QUIT" & vbCrLf
    If Not WaitForResponse("221", 20) Then  '等待20秒
        txtMsg.Text = txtMsg.Text & "失败" & vbCrLf
        Exit Sub
    End IfWsock.ClosetxtMsg.Text = txtMsg.Text & "发送成功"End SubPrivate Sub Wsock_DataArrival(ByVal bytesTotal As Long)
      
      Wsock.GetData information
      txtMsg.Text = txtMsg.Text & information & vbCrLf
      
    End Sub结果会打出“失败”信息