发送邮件代码求教高手！！！谢谢！！！！

Question

我在用以下代码发送邮件时，出现一个怪问题，还请各位予以帮助，谢谢！！！
TEXT4里面是写的“主题“
当主题为：你好（或经过编码后的字符），发送邮件就出现错误，为：
553 Mail data refused by AISP, rule [1155469].
当主题为其他字符，就能正常发送，还请教各位是何原因，谢谢！！！Private Enum SMTP_State
    MAIL_CONNECT
    MAIL_HELO
    MAIL_from
    MAIL_RCPTTO
    MAIL_DATA
    MAIL_DOT
    MAIL_QUIT
    MAIL_USER
    MAIL_PASS
    mail_login
End Enum
Dim strContent As String '正文
Private m_State As SMTP_StatePrivate Function Base64_Encode(strSource) As String 'base6加密算法
    Const BASE64_TABLE As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
    Dim strTempLine As String
    Dim j As Integer
    For j = 1 To (Len(strSource) - Len(strSource) Mod 3) Step 3
        strTempLine = strTempLine + Mid(BASE64_TABLE, (Asc(Mid(strSource, j, 1)) \ 4) + 1, 1)
        strTempLine = strTempLine + Mid(BASE64_TABLE, ((Asc(Mid(strSource, j, 1)) Mod 4) * 16 _
                      + Asc(Mid(strSource, j + 1, 1)) \ 16) + 1, 1)
        strTempLine = strTempLine + Mid(BASE64_TABLE, ((Asc(Mid(strSource, j + 1, 1)) Mod 16) * 4 _
                      + Asc(Mid(strSource, j + 2, 1)) \ 64) + 1, 1)
        strTempLine = strTempLine + Mid(BASE64_TABLE, (Asc(Mid(strSource, j + 2, 1)) Mod 64) + 1, 1)
    Next j
    If Not (Len(strSource) Mod 3) = 0 Then
         If (Len(strSource) Mod 3) = 2 Then
            strTempLine = strTempLine + Mid(BASE64_TABLE, (Asc(Mid(strSource, j, 1)) \ 4) + 1, 1)
            strTempLine = strTempLine + Mid(BASE64_TABLE, (Asc(Mid(strSource, j, 1)) Mod 4) * 16 _
                      + Asc(Mid(strSource, j + 1, 1)) \ 16 + 1, 1)
             strTempLine = strTempLine + Mid(BASE64_TABLE, (Asc(Mid(strSource, j + 1, 1)) Mod 16) * 4 + 1, 1)
            strTempLine = strTempLine & "="
        ElseIf (Len(strSource) Mod 3) = 1 Then
            strTempLine = strTempLine + Mid(BASE64_TABLE, Asc(Mid(strSource, j, 1)) \ 4 + 1, 1)
            strTempLine = strTempLine + Mid(BASE64_TABLE, (Asc(Mid(strSource, j, 1)) Mod 4) * 16 + 1, 1)
             strTempLine = strTempLine & "=="
        End If
     End If
    Base64_Encode = strTempLine
End Function
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub CmdSend_Click()
    Winsock1.Close
    Winsock1.LocalPort = 0
    strserver = TEXT3
    ColonPos = InStr(strserver, ":")
    If ColonPos = 0 Then
        Winsock1.Connect strserver, 25
    Else
        lngPort = CLng(Right$(strserver, Len(strserver) - ColonPos))
        strserver = Left$(strserver, ColonPos - 1)
        Winsock1.Connect strserver, lngPort
    End If    m_State = MAIL_CONNECT    '
    StatusTxt = "试图与服务器连接"
End SubPrivate Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
    Dim strServerResponse   As String
    Dim xjnr
     Dim llen As Long
    Dim mbyte() As Byte
    Dim strResponseCode     As String
    Dim strDataToSend       As String    '
    Const RandString As String = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890_"
    Dim Globalstr As String
    For jd = 1 To 24
        uniquey = Int(Rnd * Len(RandString)) + 1
        Globalstr = Globalstr + Mid(RandString, uniquey, 1)
    Next jd
    Winsock1.GetData strServerResponse
    strResponseCode = Left(strServerResponse, 3)
    If strResponseCode = "250" Or _
       strResponseCode = "220" Or _
       strResponseCode = "354" Or _
       strResponseCode = "334" Or _
       strResponseCode = "235" Then
        Select Case m_State
            Case MAIL_CONNECT
                m_State = MAIL_HELO
                strDataToSend = Trim$(TEXT1)
                 Winsock1.SendData "HELO " & strDataToSend & vbCrLf
                 StatusTxt = "登陆服务器"
            Case MAIL_HELO
                 m_State = MAIL_USER
                 Winsock1.SendData "AUTH LOGIN" & vbCrLf
                 StatusTxt = "正在校验用户名"
            Case MAIL_USER
                 m_State = MAIL_PASS
                 Winsock1.SendData (Base64_Encode(Trim(user.Text))) & vbCrLf
                 StatusTxt = "校验用户密码"
            Case MAIL_PASS
                 m_State = mail_login
                 Winsock1.SendData (Base64_Encode(PASSWORK)) & vbCrLf
                 StatusTxt = "发送人邮件地址"
            Case mail_login
                 m_State = MAIL_from
                 Winsock1.SendData "MAIL FROM:" & Trim$(TEXT1) & vbCrLf
                 StatusTxt = "接收人邮件地址"
            Case MAIL_from
                 m_State = MAIL_RCPTTO
                 Winsock1.SendData "RCPT TO:" & Trim$(TEXT2) & vbCrLf
                 StatusTxt = "邮件发送之中..."
            Case MAIL_RCPTTO
                 m_State = MAIL_DATA
                 Winsock1.SendData "DATA" & vbCrLf
                 StatusTxt = "获取邮件内容"
            Case MAIL_DATA
                m_State = MAIL_DOT
                Winsock1.SendData "From:" & user.Text & " <" & TEXT1 & ">" & vbCrLf
                Winsock1.SendData "To:" & toname & " <" & TEXT2 & ">" & vbCrLf
                Winsock1.SendData "Subject:" & TEXT4 & vbCrLf '主题
              strContent = TEXT7
              Winsock1.SendData strContent & vbCrLf
                Winsock1.SendData "." & vbCrLf
                StatusTxt = "邮件送完毕"
            Case MAIL_DOT
                m_State = MAIL_QUIT
                Winsock1.SendData "QUIT" & vbCrLf
                StatusTxt = "邮件成功发送!!!"
              Case MAIL_QUIT
                 Winsock1.Close
                 StatusTxt = "待命之中..."
         End Select
    Else
         Winsock1.Close
    End If
Debug.Print strServerResponse
End Sub

Answer 1

如果可以，把代码发我一份:[email protected] 我看看

Answer 2

改好了能把整个工程给我一份吗？　
[email protected]

Answer 3

还有个问题,为何执行不到MsgBox "GGGGGGGGGGGGGGG"这句,谢谢!!!!
   Case MAIL_DATA
                m_State = MAIL_DOT
                Winsock1.SendData "From:" & " <" & TEXT1 & ">" & vbCrLf
                Winsock1.SendData "To:" & " <" & TEXT2 & ">" & vbCrLf
                Winsock1.SendData "Subject:" & TEXT4 & vbCrLf '主题
              strContent = TEXT7
              Winsock1.SendData strContent & vbCrLf
                Winsock1.SendData "." & vbCrLf
                StatusTxt = "邮件送完毕"
            Case MAIL_DOT
                m_State = MAIL_QUIT
                Winsock1.SendData "QUIT" & vbCrLf
                StatusTxt = "邮件成功发送!!!"
              Case MAIL_QUIT
                 Winsock1.Close
                 MsgBox "GGGGGGGGGGGGGGG"
                 StatusTxt = "待命之中..."
         End Select
    Else
         Winsock1.Close
    End If
Debug.Print strServerResponse
End Sub

Answer 4

我建议你检查一下你的身份认证那几步
553错误是邮箱名不可用  多半都是因为身份认证没有通过造成的 ~~~
你在进行每一步操作的时候有没有检查上次操作的返回值？？？？连接上邮件服务器后有几个步骤要做：
1. C -> S 发送 EHLO %s\r\n ，local_host
2. C -> S 发送 AUTH LOGIN \r\n另外 用户名和密码的传输是要经过base64加密的 

Answer 5

Dim strSMTP As String
Dim strFrom As String
Dim strTo As String
Dim strSubject As String
Dim strPass As String
Dim strUser As String
Dim strBody As String
Dim strCuzz As String 
 Private Sub Command1_Click()
Text2.Text = Base64(txtBody.Text)End SubPrivate Function StrBase64(str1 As String) As String
 Dim bb() As Byte
 Dim b1 As Byte, b2 As Byte, b3 As Byte, b4 As Byte
 Dim str As String
 Dim n3 As Long
 bb = StrConv(str1, vbFromUnicode)
  
  If UBound(bb) < 0 Then Exit Function
 
 If (UBound(bb) + 1) Mod 3 = 1 Then
   n3 = UBound(bb) - 1
 ElseIf (UBound(bb) + 1) Mod 3 = 2 Then
   n3 = UBound(bb) - 2
 Else
   n3 = UBound(bb)
 End If
 
 
 If UBound(bb) < 2 Then GoTo LT
 
 For i = 0 To n3 Step 3
    
    b1 = (bb(i) And &HFC) / 4
    b1 = GetBase64Char(b1)
    b2 = (bb(i) And &H3) * 16 + (bb(i + 1) And &HF0) / 16
    b2 = GetBase64Char(b2)
    b3 = (bb(i + 1) And &HF) * 4 + (bb(i + 2) And &HC0) / 64
    b3 = GetBase64Char(b3)
    b4 = bb(i + 2) And &H3F
    b4 = GetBase64Char(b4)
  
  If i > 0 And i Mod 36 = 0 Then str2 = str2 + vbCrLf
  str2 = str2 + Chr(b1) + Chr(b2) + Chr(b3) + Chr(b4)
  Next
  
LT:
 If (UBound(bb) + 1) Mod 3 = 1 Then
    b1 = (bb(UBound(bb)) And &HFC) / 4
    b2 = (bb(UBound(bb)) And &H3) * 16
    b1 = GetBase64Char(b1)
    b2 = GetBase64Char(b2)
    str2 = str2 + Chr(b1) + Chr(b2)
 ElseIf (UBound(bb) + 1) Mod 3 = 2 Then
    b1 = (bb(UBound(bb) - 1) And &HFC) / 4
    b1 = GetBase64Char(b1)
    b2 = (bb(UBound(bb) - 1) And &H3) * 16 + (bb(UBound(bb)) And &HF0) / 16
    b2 = GetBase64Char(b2)
    b3 = (bb(UBound(bb)) And &HF) * 4
    b3 = GetBase64Char(b3)
    str2 = str2 + Chr(b1) + Chr(b2) + Chr(b3)
 End If
   
   str = StrConv(str, vbFromUnicode)
  
  If LenB(str) Mod 4 <> 0 Then
    str2 = str2 + StrConv(String(4 - LenB(str) Mod 4, "="), vbFromUnicode)
  End If
  StrBase64 = str
End Function
Private Function Base64(str1 As String) As String
 Dim bb() As Byte
 Dim b1 As Byte, b2 As Byte, b3 As Byte, b4 As Byte
 Dim s1 As Byte, s2 As Byte, s3 As Byte
 Dim str2 As String
 Dim lng As Long, n3 As Long
 
 'Unicode 转换成ASC
 bb = StrConv(str1, vbFromUnicode)
 
 lng = UBound(bb) + 1
  If lng < 1 Then Exit Function
 
 If lng Mod 3 = 1 Then
   n3 = lng - 1
 ElseIf lng Mod 3 = 2 Then
   n3 = lng - 2
 Else
   n3 = lng
 End If
   
 str2 = ""
 If lng > 2 Then
     For i = 1 To n3 Step 3
        s1 = bb(i - 1)
        s2 = bb(i)
        s3 = bb(i + 1)
        
        b1 = (s1 And &HFC) / 4
        b2 = (s1 And &H3) * 16 + (s2 And &HF0) / 16
        b3 = (s2 And &HF) * 4 + (s3 And &HC0) / 64
        b4 = s3 And &H3F
       
        b1 = GetBase64Char(b1)
        b2 = GetBase64Char(b2)
        b3 = GetBase64Char(b3)
        b4 = GetBase64Char(b4)
      
      If i Mod 37 = 0 Then str2 = str2 + vbCrLf
      str2 = str2 + Chr(b1) + Chr(b2) + Chr(b3) + Chr(b4)
    Next
     
    If lng - n3 = 1 Then
           str2 = str2 + Base64(Chr(bb(lng - 1)))
    ElseIf lng - n3 = 2 Then
          str2 = str2 + Base64(Chr(bb(lng - 2)) + Chr(bb(lng - 1)))
    Else
    
    End If
    
 ElseIf lng = 1 Then
        s1 = bb(0)
        
        b1 = (s1 And &HFC) / 4
        b2 = (s1 And &H3) * 16
       
        b1 = GetBase64Char(b1)
        b2 = GetBase64Char(b2)
        str2 = str2 + Chr(b1) + Chr(b2) + "=="
 ElseIf lng = 2 Then
        s1 = bb(0)
        s2 = bb(1)
         
        b1 = (s1 And &HFC) / 4
        b2 = (s1 And &H3) * 16 + (s2 And &HF0) / 16
        b3 = (s2 And &HF) * 4
        
        b1 = GetBase64Char(b1)
        b2 = GetBase64Char(b2)
        b3 = GetBase64Char(b3)
        str2 = str2 + Chr(b1) + Chr(b2) + Chr(b3) + "="
 End If
   
   
    Base64 = str2
End Function
Private Function GetBase64Char(b4 As Byte) As Byte
    
    If b4 <= 25 Then
         b4 = b4 + 65
    ElseIf b4 <= 51 Then
         b4 = b4 + 71
    ElseIf b4 <= 61 Then
         b4 = b4 - 4
    ElseIf b4 = 62 Then
         b4 = 43
    Else
         b4 = 47
    End If
GetBase64Char = b4End FunctionPrivate Sub Command2_Click()
strCuzz = strCuzz + vbNewLine + vbNewLine
strCuzz = strCuzz + "----------------------------------------" + vbNewLine
strCuzz = strCuzz + "This is a letter sent by CuzzMail" + vbNewLine + vbNewLine
strCuzz = strCuzz + "For more details,please visit site:" + vbNewLine
strCuzz = strCuzz + "    http://cuzz.533.net/" + vbNewLine + vbNewLine
strCuzz = strCuzz + "Or you can contact the author by email:" + vbNewLine
strCuzz = strCuzz + "    [email protected]" + vbNewLine + vbNewLine
strCuzz = strCuzz + "Thank you for your testing" + vbNewLine
strCuzz = strCuzz + "----------------------------------------" + vbNewLine
 strSMTP = txtSMTP.Text
strFrom = txtFrom.Text
strTo = txtTo.Text
strSubject = txtSubject.Text
strPass = txtPass.Text
strUser = txtUser.Text
Sck1.Connect txtSMTP.Text, 25
End SubPrivate Sub Sck1_DataArrival(ByVal bytesTotal As Long)
Dim str1 As String, str3 As String 
Static strState As String
Sck1.GetData str1
str3 = Left(str1, 3)
Text2.Text = str1 + Text2.TextSelect Case strState
   Case ""     '连接成功
       If str3 = "220" Then
            Sck1.SendData "HELO " + "www.test.com" + vbCrLf
            strState = "HELO"
       End If
   Case "HELO"
       
       If str3 = "250" Then
            Sck1.SendData "AUTH LOGIN" + vbCrLf
            strState = "AUTH"
       End If   Case "AUTH"
       If str3 = "235" Then
            Sck1.SendData "MAIL FROM:" + strFrom + vbCrLf
            strState = "MAIL"
       ElseIf str3 = "334" Then
            If Left(str1, 16) = "334 VXNlcm5hbWU6" Then
                  Sck1.SendData Base64(strUser) + vbCrLf
            ElseIf Left(str1, 16) = "334 UGFzc3dvcmQ6" Then
                  Sck1.SendData Base64(strPass) + vbCrLf
            Else
            End If
       End If
   
   Case "MAIL"
       If str3 = "250" Then
            Sck1.SendData "RCPT TO:" + strTo + vbCrLf
            strState = "RCPT"
       End If
   Case "RCPT"
        If str3 = "250" Then
            Sck1.SendData "DATA" + vbCrLf
            strState = "DATA"
       End If   Case "DATA"
       If str3 = "354" Then
            strBody = "From:" + "CuzzMail<[email protected]>" + vbCrLf
            strBody = strBody + "To:" + txtTo.Text + vbCrLf
            strBody = strBody + "Subject:" + txtSubject.Text + vbCrLf
            strBody = strBody + "X-mailer:CuzzMail<http://cuzz.533.net>" + vbCrLf
            strBody = strBody + vbCrLf
            strBody = strBody + txtBody.Text + vbCrLf
            
            strCuzz = strBody + strCuzz + vbCrLf + "." + vbCrLf
 
            Sck1.SendData strCuzz
            strState = "DATASEND"
       End If
   Case "DATASEND"
   
            Sck1.SendData "QUIT" + vbCrLf
            strState = "QUIT"
   Case "QUIT"
   
      Sck1.Close
      MsgBox "Sent successfully!", vbInformation, "Cuzz Mail"
      strState = ""
End Select  
End Sub