最近，smtp协议一些大型的邮件服务商增加了一个验证机制,导致以前的[邮件发送/群发]都不好用了。谁知道？

Question

如题。有些邮箱可以，有些不行了，例如: smtp.21cn.com

Answer 1

现在绝大多数邮件服务商为拒绝垃圾邮件，发信服务器采用了新的标准，即ESMTP。你可以从网上查找一下有关ESMTP的详细说明。

Answer 2

VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   5805
   ClientLeft      =   2355
   ClientTop       =   1680
   ClientWidth     =   5730
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   5805
   ScaleWidth      =   5730
   Begin VB.TextBox txtServerInf 
      Height          =   1395
      Left            =   0
      MultiLine       =   -1  'True
      ScrollBars      =   3  'Both
      TabIndex        =   19
      Top             =   4410
      Width           =   5715
   End
   Begin VB.CommandButton cmdSend 
      Caption         =   "发送(&S)"
      Height          =   495
      Left            =   4590
      TabIndex        =   17
      Top             =   3720
      Width           =   1065
   End
   Begin MSWinsockLib.Winsock dsSock 
      Left            =   3750
      Top             =   3120
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin VB.TextBox txtPwd 
      Height          =   375
      IMEMode         =   3  'DISABLE
      Left            =   2760
      PasswordChar    =   "O"
      TabIndex        =   16
      Top             =   3750
      Width           =   1425
   End
   Begin VB.TextBox txtUser 
      Height          =   375
      Left            =   600
      TabIndex        =   14
      Top             =   3750
      Width           =   1425
   End
   Begin VB.CheckBox chkSMTP 
      Caption         =   "SMTP服务器需要验证"
      Height          =   195
      Left            =   0
      TabIndex        =   12
      Top             =   3480
      Value           =   1  'Checked
      Width           =   2025
   End
   Begin VB.TextBox txtSMTPPort 
      Height          =   375
      Left            =   5220
      TabIndex        =   11
      Text            =   "25"
      Top             =   3060
      Width           =   495
   End
   Begin VB.TextBox txtSMTPServer 
      Height          =   375
      Left            =   1290
      TabIndex        =   9
      Top             =   3060
      Width           =   2115
   End
   Begin VB.TextBox txtContent 
      Height          =   1935
      Left            =   0
      MultiLine       =   -1  'True
      TabIndex        =   7
      Top             =   1110
      Width           =   5715
   End
   Begin VB.TextBox txtSubject 
      Height          =   375
      Left            =   1020
      TabIndex        =   5
      Top             =   450
      Width           =   4695
   End
   Begin VB.TextBox txtTo 
      Height          =   375
      Left            =   3960
      TabIndex        =   3
      Top             =   60
      Width           =   1755
   End
   Begin VB.TextBox txtFrom 
      Height          =   375
      Left            =   1020
      TabIndex        =   1
      Top             =   60
      Width           =   1755
   End
   Begin VB.Label Label9 
      AutoSize        =   -1  'True
      Caption         =   "服务器信息："
      Height          =   195
      Left            =   0
      TabIndex        =   18
      Top             =   4170
      Width           =   1080
   End
   Begin VB.Label Label8 
      AutoSize        =   -1  'True
      Caption         =   "密码："
      Height          =   195
      Left            =   2130
      TabIndex        =   15
      Top             =   3840
      Width           =   540
   End
   Begin VB.Label Label7 
      AutoSize        =   -1  'True
      Caption         =   "帐号："
      Height          =   195
      Left            =   0
      TabIndex        =   13
      Top             =   3780
      Width           =   540
   End
   Begin VB.Label Label6 
      AutoSize        =   -1  'True
      Caption         =   "端口号："
      Height          =   195
      Left            =   4380
      TabIndex        =   10
      Top             =   3150
      Width           =   720
   End
   Begin VB.Label Label5 
      AutoSize        =   -1  'True
      Caption         =   "SMTP服务器："
      Height          =   195
      Left            =   0
      TabIndex        =   8
      Top             =   3150
      Width           =   1170
   End
   Begin VB.Label Label4 
      AutoSize        =   -1  'True
      Caption         =   "邮件正文："
      Height          =   195
      Left            =   0
      TabIndex        =   6
      Top             =   870
      Width           =   900
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      Caption         =   "主题："
      Height          =   195
      Left            =   30
      TabIndex        =   4
      Top             =   540
      Width           =   540
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "收件人："
      Height          =   195
      Left            =   2970
      TabIndex        =   2
      Top             =   150
      Width           =   720
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "发件人："
      Height          =   195
      Left            =   30
      TabIndex        =   0
      Top             =   150
      Width           =   720
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Answer 3

Option Explicit
Dim Answerf As Boolean
Sub SendMail(strFrom As String, strTo As String, strSubject As String, strMsg As String)
   dsSock.Close
   dsSock.Connect txtSMTPServer, txtSMTPPort
   Waiting
   dsSock.SendData "EHLO" & strFrom & vbCrLf
   Waiting
   If chkSMTP.Value = Checked Then
      dsSock.SendData "AUTH LOGIN" & vbCrLf
      Waiting
      MsgBox Base64Encode(txtUser) & Base64Encode(txtPwd)
      dsSock.SendData Base64Encode(txtUser) & vbCrLf
      Waiting
      dsSock.SendData Base64Encode(txtPwd) & vbCrLf
      Waiting
   End If
   dsSock.SendData "MAIL FROM:<" & strFrom & ">" & vbCrLf
   Waiting
   dsSock.SendData "RCPT TO:<" & strTo & ">" & vbCrLf
   Waiting
   dsSock.SendData "DATA" & vbCrLf
   Waiting
   dsSock.SendData "DATA:" & Format$(Now, "dd mmm yy ttttt") & vbCrLf
   dsSock.SendData "FROM:" & strFrom & vbCrLf
   dsSock.SendData "TO:" & strTo & vbCrLf
   dsSock.SendData "SUBJECT:" & strSubject & vbCrLf & vbCrLf
   dsSock.SendData strMsg & vbCrLf & "." & vbCrLf
   Waiting
   dsSock.Close
   MsgBox "信件发送完毕！"
End SubPublic Sub Waiting()
   Dim PauseTime, Start
   PauseTime = 30
   Start = Timer
   Do While Timer < Start + PauseTime And Not Answerf
   DoEvents
   Loop
   Answerf = False
End Sub
Private Sub cmdSend_Click()
   txtServerInf.Text = ""
   Call SendMail(txtFrom.Text, txtTo.Text, txtSubject.Text, txtContent.Text)
End Sub
Private Sub dsSock_DataArrival(ByVal bytesTotal As Long)
   Dim Comedata As String
   dsSock.GetData Comedata
   txtServerInf.Text = txtServerInf.Text + Comedata
   Answerf = True
End SubPrivate Sub txtFrom_LostFocus()
   If chkSMTP.Value = Checked Then
      Dim i As Integer
      i = InStr(1, txtFrom, "@")
      If i <> 0 Then
         txtUser = Mid(txtFrom, 1, i - 1)
         txtSMTPServer = Mid(txtFrom, i + 1, Len(txtFrom) - i)
      End If
   End If
End Sub
Function MyASC(OneChar)
   If OneChar = "" Then MyASC = 0 Else MyASC = Asc(OneChar)
End Function
Private Function Base64Encode(inData)
   Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
   Dim cOut, sOut, i
   For i = 1 To Len(inData) Step 3
      Dim nGroup As Long
      Dim pOut, sGroup
      nGroup = &H10000 * Asc(Mid(inData, i, 1)) + &H100 * MyASC(Mid(inData, i + 1, 1)) + MyASC(Mid(inData, i + 2, 1))
      sGroup = Oct(nGroup)
      sGroup = String(8 - Len(sGroup), "0") & sGroup
      pOut = Mid(Base64, CLng("&o" & Mid(sGroup, 1, 2)) + 1, 1) + Mid(Base64, CLng("&o" & Mid(sGroup, 3, 2)) + 1, 1) + Mid(Base64, CLng("&o" & Mid(sGroup, 5, 2)) + 1, 1) + Mid(Base64, CLng("&o" & Mid(sGroup, 7, 2)) + 1, 1)
      sOut = sOut + pOut
      If (i + 2) Mod 57 = 0 Then sOut = sOut + vbCrLf
   Next
   Select Case Len(inData) Mod 3
      Case 1:
         sOut = Left(sOut, Len(sOut) - 2) + "=="
      Case 2:
         sOut = Left(sOut, Len(sOut) - 1) + "="
   End Select
   Base64Encode = sOut
End Function

Answer 4

上面这一段就是支持ESMTP的采用WinSock来发送Mail的VB代码。

Answer 5

好象与我原来做的没有什么区别，唯一一点，就是少了一句 .SendData "QUIT" & vbCrLf 

Answer 6

我建议发代码的那位同志能在发代码的同时，做简单的一句话说明。这一句话往往比三页程序更有用。
正是所谓的画龙点“ ” 现在我来补充这句话；
－－－－－－－－－－－－－－－－－
在连接上之后，发送helo ，发送AUTH LOGIN 加回车，然后发送base64编码的用户名加回车，base64编码的密码加回车
下面就和原来的一样了。
－－－－－－－－－－－－－－－－－

Answer 7

现在我来补充这句话；
－－－－－－－－－－－－－－－－－
在连接上之后，发送helo ，发送AUTH LOGIN 加回车，然后发送base64编码的用户名加回车，base64编码的密码加回车
下面就和原来的一样了。
－－－－－－－－－－－－－－－－－
========================
ESMTP当中是发送"EHLO"，而不是"HELO"

Answer 8

呵呵，其实这个偶倒觉得也蛮简单，只要OE(Outlook Express)能发送就OK了，自己写一个类似于邮件代理的东东，然后让OE发送到你的程序，然后你的程序再转发给邮件服务器，邮件服务器返回的信息，你再转发给OE，从而达到拦截和分析的目的。PS:偶之前就是这么干滴~~~不过上面那段代码，偶倒是从电脑报之类的杂志上面摘下来的，因为这个比较简单，只是后来写带附件的发送时才用拦截OE的方式来完成。

Answer 9

的确有些头大，我做的与你们说的是完全一致的：..."EHLO"，AUTH LOGIN 加回车，然后发送base64编码的用户名加回车，base64编码的密码加回车...
事实是，只有smtp.21cn.com 不能够发出（发送时也提示成功发送），其他的可以(例如: smtp.szonline.net、...)。
你们可以用自己做的代码试一下，看能不能在 21cn.com 真正实现发送。