我用VB做EMAIL收发程序，为什么我的SMTP验证老是过不了？？

[netcool1]

R:220 Welcome to coremail System(With Anti-Spam) 2.1
S:EHLO linhan
R:250-202.108.36.216
250-PIPELINING
250-SIZE 10240000
250-ETRN
250-AUTH LOGIN
250 8BITMIME
S:AUTH LOGIN
R:334 VXNlcm5hbWU6
S:(BASE64 USERNAME)
R:334 UGFzc3dvcmQ6
S:(BASE64 PASSWORD)
R:535 Error: authentication failed

上面的过程是否还缺了什么？？谢谢，我刚来，没分送，抱歉，不过真的谢谢大家

[dent]

查一查你使用的SMTP服务器，有可能因为你用的服务器需要身份验证（用你的EMAIL帐号和密码）。

[lovingkiss]

Select Case m_State
Case MAIL_CONNECT
'改变当前状态的值:发送EHLO[Helo是不需要验证的邮局]，表示申请连接
m_State = MAIL_AUTH
'发送Hello到服务器
Winsock.SendData "EHLO " & cobServer.Text & vbCrLf
'"发送连接服务器标识"
Case MAIL_AUTH
m_State = MAIL_USER
Winsock.SendData "AUTH LOGIN" & vbCrLf
'"标识成功，发送连接验证申请"
Case MAIL_USER
m_State = MAIL_PSW
Winsock.SendData EnCodeB.Encode(txtUser.Text) & vbCrLf
'"验证被接收，发送用户名称"
Case MAIL_PSW
'改变当前状态
m_State = MAIL_HELO
'Send DATA command to the server
Winsock.SendData EnCodeB.Encode(txtPass.Text) & vbCrLf
'"用户名称正确，发送密码"
Case MAIL_HELO
'改变当前状态:发送信件发送位置
m_State = MAIL_FROM
'从哪里发信，发送人信息
Winsock.SendData "MAIL FROM:" & txtSender.Text & vbCrLf
'"验证全部通过，发送邮件地址"
Case MAIL_FROM
'改变当前状态:发送到哪里去
m_State = MAIL_RCPTTO
'发送发送到那里的信息
If txtCopyTo.Text <> "" Then
Winsock.SendData "RCPT TO:(" & txtSendTo.Text & "," & txtCopyTo.Text & ")" & vbCrLf
Else
Winsock.SendData "RCPT TO:" & txtSendTo.Text & vbCrLf
End If
'"发送接收地址"
Case MAIL_RCPTTO
'改变当前状态
m_State = MAIL_DATA
Winsock.SendData "DATA" & vbCrLf

'"准备发送信息"
Case MAIL_DATA
'改变当前状态
m_State = MAIL_DOT


Winsock.SendData "Date: " & Format(Now, "ddd, d mmm yyyy h:m:s") & " +0800" & vbCrLf
Winsock.SendData "From: " & txtUser.Text & " <" & txtSender.Text & ">" & vbCrLf
Winsock.SendData "To: " & txtSendTo.Text & " <" & txtSendTo.Text & ">" & vbCrLf
Winsock.SendData "X-mailer: Xiao Xin Test Mail" & vbCrLf
Winsock.SendData "Mime-Version: 1.0" & vbCrLf
Winsock.SendData "Content-Type: multipart/mixed;" & vbCrLf
Winsock.SendData " boundary=""" & strBoundary & "" & vbCrLf
Winsock.SendData "Subject:" & txtTopic.Text & vbCrLf

Winsock.SendData "This is a multi-part message in MIME format." & vbCrLf & vbCrLf

Winsock.SendData rtxtContent.Text & vbCrLf & vbCrLf
Winsock.SendData rtxtAccessory.Text & vbCrLf & vbCrLf

Winsock.SendData vbCrLf & "--" & strBoundary & "--" & vbCrLf

Winsock.SendData "." & vbCrLf


'"信息发送完毕"
Case MAIL_DOT
'改变当前状态
m_State = MAIL_QUIT
Winsock.SendData "QUIT" & vbCrLf
cmdSendMail.Enabled = True
Winsock.Close
lstResponse.AddItem "Finished"
lstResponse.Selected(lstResponse.ListCount - 1) = True
Me.Caption = "Finished"
txtEnd.Text = Format(Now, "h:m:s")
'Winsock.SendData "QUIT" & vbCrLf
'"发送退出信号"
Case MAIL_QUIT
'关闭连接
Winsock.Close
'"关闭连接"
End Select

这是发送过程的那部分语句，我已经验证成功的；请勿联系

[netcool1]

谢谢。真是庆幸，我的做法跟你差不，也是用SELECT CASE 一步一步往下做，步骤也跟你一样，可能是BASE64编码过程有问题，谁可以给我BASE64编解码的程序参考一下。谢谢

[sonicdater]

用 Winsock 控件

dsSock.SendData "EHLO " & strFrom & vbCrLf
dsSock.SendData "AUTH LOGIN " & vbCrLf
dsSock.SendData Base64Encode(txtUser) & vbCrLf
dsSock.SendData Base64Encode(txtPwd) & vbCrLf
===================================================
Base64Encode 是一个 进行 base64 编码的函数， 需自己写。
txtUser 是 需验证的用户名，txtPwd 是 密码。
其它的 和一般的 smtp 命令一样。 你可参考 一下 那些 随处可见 的 例程。


base64 的编码 和解码 部分的 函数：：

http://www.csdn.net/Expert/topic/422/422011.xml
==================================================
C: EHLO
S: 250-smtp.example.com
S: 250 AUTH CRAM-MD5 DIGEST-MD5
C: AUTH login
S: 334 VXNlcm5hbWU6 //Username:
C: VGVzdA== //Test
S: 334 UGFzc3dvcmQ6 //Password:
C: MTIzNDU= //12345
S: 2.7.0 Authentication successful.
=========================================================

[lovingkiss]

Private Base64Tab(63) As Byte
Private DecodeTable(233) As Byte
Public Sub Class_Initialize()
'initialize the base64 table
Dim tDecodeTable As Variant
tDecodeTable = Array("255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "62", "255", "255", "255", "63", "52", "53", "54", "55", "56", "57", "58", "59", "60", "61", "255", "255", "255", "64", "255", "255", "255", "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", "16", "17", _
"18", "19", "20", "21", "22", "23", "24", "25", "255", "255", "255", "255", "255", "255", "26", "27", "28", "29", "30", "31", "32", "33", "34", "35", "36", "37", "38", "39", "40", "41", "42", "43", "44", "45", "46", "47", "48", "49", "50", "51", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255" _
, "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255")
For i = LBound(tDecodeTable) To UBound(tDecodeTable)
DecodeTable(i) = tDecodeTable(i)
Next
For i = 65 To 90
Base64Tab(i - 65) = i
Next
For i = 97 To 122
Base64Tab(i - 71) = i
Next
For i = 0 To 9
Base64Tab(i + 52) = 48 + i
Next
Base64Tab(62) = 43
Base64Tab(63) = 47
End Sub
Public Sub EncodeB64(ByRef FileIn() As Byte, ByRef Out() As Byte)
'declarations
Dim bin(2) As Byte
Dim iTemp As Long
Dim i As Long
Dim Lenght As Long
Dim Remaining As Byte
Dim BytesOut As Long
Lenght = UBound(FileIn) + 1 'lenght of the string
Remaining = ((Lenght) Mod 3)
If Remaining = 0 Then
BytesOut = ((Lenght / 3) * 4) ' how many bytes will the encoded string have
Else
BytesOut = (((Lenght + (3 - Remaining)) / 3) * 4) ' how many bytes will the encoded string have
End If
ReDim Out(BytesOut - 1)
For i = 0 To Lenght - Remaining - 1 Step 3
'3 bytes in
bin(0) = FileIn(i)
bin(1) = FileIn(i + 1)
bin(2) = FileIn(i + 2)
'4 bytes out
Out(iTemp) = Base64Tab((bin(0) \ 4) And &H3F)
Out(iTemp + 1) = Base64Tab((bin(0) And &H3) * 16 Or (bin(1) \ 16) And &HF)
Out(iTemp + 2) = Base64Tab((bin(1) And &HF) * 4 Or (bin(2) \ 64) And &H3)
Out(iTemp + 3) = Base64Tab(bin(2) And &H3F)
iTemp = iTemp + 4
DoEvents
Next
If Remaining = 1 Then ' if there is 1 byte remaining
'read 1 byte, the second in 0
bin(0) = FileIn(UBound(FileIn))
bin(1) = 0
Out(UBound(Out) - 3) = Base64Tab((bin(0) \ 4) And &H3F)
Out(UBound(Out) - 2) = Base64Tab((bin(0) And &H3) * 16 Or (bin(1) \ 16) And &HF)
Out(UBound(Out) - 1) = 61
Out(UBound(Out)) = 61
ElseIf Remaining = 2 Then 'if there are 2 bytes remaining
'read 2 bytes, the third is 0
bin(0) = FileIn(UBound(FileIn) - 1)
bin(1) = FileIn(UBound(FileIn))
bin(2) = 0
Out(UBound(Out) - 3) = Base64Tab((bin(0) \ 4) And &H3F)
Out(UBound(Out) - 2) = Base64Tab((bin(0) And &H3) * 16 Or (bin(1) \ 16) And &HF)
Out(UBound(Out) - 1) = Base64Tab((bin(1) And &HF) * 4 Or (bin(2) \ 64) And &H3)
Out(UBound(Out)) = 61
End If
End Sub
Public Sub Str2ByteArray(StringIn As String, ByteArray() As Byte)
ByteArray = StrConv(StringIn, vbFromUnicode)
End Sub
Public Sub Span(CharsPerLine As Long, InArray() As Byte, OutArray() As Byte)
Dim Lines As Long
Dim i2 As Long
Dim i As Long
Dim TempI As Long
Lines = ((UBound(InArray) + 1) + (UBound(InArray) + 1) Mod CharsPerLine) / CharsPerLine
ReDim OutArray(LBound(InArray) To UBound(InArray) + (Lines * 2))
TempI = 0
While Not TempI > UBound(InArray)
For i = TempI To TempI + CharsPerLine - 1
If i2 > UBound(OutArray) Or i > UBound(InArray) Then Exit Sub
OutArray(i2) = InArray(i)
i2 = i2 + 1
DoEvents
Next
If i2 > UBound(OutArray) Then Exit Sub
OutArray(i2) = 13
OutArray(i2 + 1) = 10
TempI = TempI + CharsPerLine
i2 = i2 + 2
Wend
End Sub
Public Sub DecodeB64(ByRef FileIn() As Byte, ByRef Out() As Byte)
'declarations
Dim inp(3) As Byte
Dim iTemp As Long
Dim i As Long
Dim Lenght As Long
Dim Remaining As Byte
Dim BytesOut As Long
Dim lTemp2 As Long
If FileIn(UBound(FileIn)) = 61 Then
Remaining = 1
If FileIn(UBound(FileIn) - 1) = 61 Then
Remaining = 2
End If
End If
Lenght = UBound(FileIn) + 1 'lenght of the string
BytesOut = ((Lenght / 4) * 3) - Remaining ' how many bytes will the decoded string have
ReDim Out(BytesOut - 1)
For i = 0 To Lenght Step 4
inp(0) = DecodeTable(FileIn(i))
inp(1) = DecodeTable(FileIn(i + 1))
inp(2) = DecodeTable(FileIn(i + 2))
inp(3) = DecodeTable(FileIn(i + 3))
If inp(3) = 64 Or inp(2) = 64 Then
If inp(3) = 64 And Not (inp(2) = 64) Then
inp(0) = DecodeTable(FileIn(i))
inp(1) = DecodeTable(FileIn(i + 1))
inp(2) = DecodeTable(FileIn(i + 2))
'2 bytes out
Out(iTemp) = (inp(0) * 4) Or ((inp(1) \ 16) And &H3)
Out(iTemp + 1) = ((inp(1) And &HF) * 16) Or ((inp(2) \ 4) And &HF)
Exit Sub
ElseIf inp(2) = 64 Then
inp(0) = DecodeTable(FileIn(i))
inp(1) = DecodeTable(FileIn(i + 1))
'1 byte out
Out(iTemp) = (inp(0) * 4) Or ((inp(1) \ 16) And &H3)
Exit Sub
End If
End If
'3 bytes out
Out(iTemp) = (inp(0) * 4) Or ((inp(1) \ 16) And &H3)
Out(iTemp + 1) = ((inp(1) And &HF) * 16) Or ((inp(2) \ 4) And &HF)
Out(iTemp + 2) = ((inp(2) And &H3) * 64) Or inp(3)
iTemp = iTemp + 3
DoEvents
Next
End Sub

Public Sub Unspan(ArrayIn() As Byte, ArrayOut() As Byte)
Dim sTemp As String
sTemp = StrConv(ArrayIn, vbUnicode)
sTemp = Replace(sTemp, vbCrLf, "")
ArrayOut = StrConv(sTemp, vbFromUnicode)
End Sub


'整个的一个类模块

[lovingkiss]

在这里不好看，你复制到一个类模块里面

[netcool1]

谢了

[suhuoqiang]

21cn应该怎样才发到呀,它好像用SMTP不行吧?

[gmlwx]

高手！

[NowCan]

收藏

[netcool1]

发邮件都是用SMTP的