高手注意：关于邮件发送程序的一个关键问题（分数全部给回答最经典一个）

[flowerknight]

我写了一个邮件发送程序，smtp服务器的连接没有问题，得到了服务器的回复，但当程序开始发送邮件时出现以下信息！
------发送完成------
服务器返回数据 -> 250 192.168.1.203

服务器返回数据 -> 553 You are not authorized to send mail as <MAIL FROM: [e-mail]>, authentication is required

服务器返回数据 -> 503 Error: need MAIL command

服务器返回数据 -> 503 Error: need RCPT command

我在程序中之填写了smtp、发送邮箱和目标邮箱；
我怀疑是不是我没有提交发送邮箱的密码，而造成没有权限
但很多人的邮件发送程序都没有提供密码这项；
如果需要的话，那密码该怎样提交给服务器呢？
希望能得到代码实例的详细回答
谢谢各位

[flowerknight]

我把接收回应的部分进行了如下修改，正如你所说服务器回复334
但我依然遇到了无法通过安全认证：
修改后的程序：
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)

Dim strServerResponse As String
Dim strResponseCode As String
Dim strDataToSend As String
'
'Retrive data from winsock buffer
'
Winsock1.GetData strServerResponse
'
Debug.Print strServerResponse
'
'Get server response code (first three symbols)
'
strResponseCode = Left(strServerResponse, 3)
'
'Only these three codes tell us that previous
'command accepted successfully and we can go on
'

If strResponseCode = "250" Or _
strResponseCode = "220" Or _
strResponseCode = "354" Or _
strResponseCode = "334" Then

Select Case m_State
Case MAIL_CONNECT
'Change current state of the session
m_State = MAIL_AUTH
'
'Remove blank spaces
strDataToSend = Trim$(txtSender)
'
'Retrieve mailbox name from e-mail address
strDataToSend = Left$(strDataToSend, _
InStr(1, strDataToSend, "@") - 1)
'Send HELO command to the server
Winsock1.SendData "HELO " & strDataToSend & vbCrLf
'
Debug.Print "HELO " & strDataToSend
Case MAIL_AUTH
m_State = MAIL_HELO
Winsock1.SendData "AUTH LOGIN" & vbCrLf '------------------------
Case MAIL_HELO
'
'Change current state of the session
m_State = MAIL_SCRET
'
'Send MAIL FROM command to the server
Winsock1.SendData "MAIL FROM:" & Trim$(txtSender) & vbCrLf
'
Debug.Print "MAIL FROM:" & Trim$(txtSender)
'
Case MAIL_SCRET
m_State = MAIL_FROM
Winsock1.SendData "123456" & vbCrLf

Case MAIL_FROM
'
'Change current state of the session
m_State = MAIL_RCPTTO
'
'Send RCPT TO command to the server
Winsock1.SendData "RCPT TO:" & Trim$(txtRecipient) & vbCrLf
'
Debug.Print "RCPT TO:" & Trim$(txtRecipient)

Case MAIL_RCPTTO
'
'Change current state of the session
m_State = MAIL_DATA
'
'Send DATA command to the server
Winsock1.SendData "DATA" & vbCrLf
'
Debug.Print "DATA"
'
Case MAIL_DATA
'
'Change current state of the session
m_State = MAIL_DOT
'
'So now we are sending a message body
'Each line of text must be completed with
'linefeed symbol (Chr$(10) or vbLf) not with vbCrLf
'
'Send Subject line
Winsock1.SendData "Subject:" & txtSubject & vbLf
'
Debug.Print "Subject:" & txtSubject
'
Dim varLines As Variant
Dim varLine As Variant
'
'Parse message to get lines (for VB6 only)
varLines = Split(txtMessage, vbCrLf)
'
'Send each line of the message
For Each varLine In varLines
Winsock1.SendData CStr(varLine) & vbLf
'
Debug.Print CStr(varLine)
Next
'
'Send a dot symbol to inform server
'that sending of message comleted
Winsock1.SendData "." & vbCrLf
'
Debug.Print "."
'
Case MAIL_DOT
'Change current state of the session
m_State = MAIL_QUIT
'
'Send QUIT command to the server
Winsock1.SendData "QUIT" & vbCrLf
'
Debug.Print "QUIT"
Case MAIL_QUIT
'
'Close connection
Winsock1.Close
'
End Select

Else
'
'If we are here server replied with
'unacceptable respose code therefore we need
'close connection and inform user about problem
'
Winsock1.Close
'
If Not m_State = MAIL_QUIT Then
MsgBox "SMTP Error: " & strServerResponse, _
vbInformation, "SMTP Error"
Else
MsgBox "Message sent successfuly.", vbInformation
End If
'
End If

End Sub
返回的debug结果是：
220 Welcome to coremail System(With Anti-Spam) 2.1

HELO liwei_king
250 192.168.1.248

334 VXNlcm5hbWU6

MAIL FROM:[e-mail]
334 UGFzc3dvcmQ6

535 Error: authentication failed

[flowerknight]

同志们，快呀！
再现等候

[flowerknight]

如何透过安全认证？

[iamluodong]

这是一个典型的服务端需要验证的问题,一般情况下你需要将你的拥护名称和口令发送到服务端.程序如下:


'发送服务端验证

Wsock.SendData "AUTH LOGIN" & vbCrLf
If Not WaitForResponse("334", 10) Then
TxtMsg.Text = "不支持!" & vbCrLf & TxtMsg.Text
Exit Sub
End If

'发送验证用户名称
Wsock.SendData VerUser & vbCrLf
If Not WaitForResponse("334", 10) Then
TxtMsg.Text = "用户名称验证无法通过!" & vbCrLf & TxtMsg.Text
Exit Sub
End If

'发送验证用户口令
Wsock.SendData VerPwd & vbCrLf
If Not WaitForResponse("235", 10) Then
TxtMsg.Text = "用户口令验证无法通过!" & vbCrLf & TxtMsg.Text
Exit Sub
End If

'该函数用于等待服务器响应码
Private Function WaitForResponse(strResponse As String, WaitTime As Integer) As Boolean
Dim WaitSt As Date
WaitSt = Now()
While InStr(1, Information, strResponse, vbTextCompare) < 1

DoEvents
If DateDiff("s", WaitSt, Now) > WaitTime Then
Information = ""
WaitForResponse = False
Exit Function
End If
Wend
Information = ""
WaitForResponse = True
End Function

[flowerknight]

我知道名称和口令发送到服务端，可是具体的写法怎么实现
比如：用户邮箱：[e-mail]
密码：1234567
如何写发送名称和口令这句代码！
谢了！

[flowerknight]

Private Sub cmdSend_Click()'发送按钮的事件内容
Winsock1.Connect Trim$(txtHost), 25
m_State = MAIL_CONNECT

End Sub
'接收服务器返回信息事件的内容
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)

Dim strServerResponse As String
Dim strResponseCode As String
Dim strDataToSend As String
'
'Retrive data from winsock buffer
'
Winsock1.GetData strServerResponse
'
Debug.Print strServerResponse
'
'Get server response code (first three symbols)
'
strResponseCode = Left(strServerResponse, 3)
'
'Only these three codes tell us that previous
'command accepted successfully and we can go on
'
If strResponseCode = "250" Or _
strResponseCode = "220" Or _
strResponseCode = "354" Then

Select Case m_State
Case MAIL_CONNECT
'Change current state of the session
m_State = MAIL_HELO
'
'Remove blank spaces
strDataToSend = Trim$(txtSender)
'
'Retrieve mailbox name from e-mail address
strDataToSend = Left$(strDataToSend, _
InStr(1, strDataToSend, "@") - 1)
'Send HELO command to the server
Winsock1.SendData "HELO " & strDataToSend & vbCrLf
'
Debug.Print "HELO " & strDataToSend
'
Case MAIL_HELO
'
'Change current state of the session
m_State = MAIL_FROM
'
'Send MAIL FROM command to the server
Winsock1.SendData "MAIL FROM:" & Trim$(txtSender) & vbCrLf
'
Debug.Print "MAIL FROM:" & Trim$(txtSender)
'
Case MAIL_FROM
'
'Change current state of the session
m_State = MAIL_RCPTTO
'
'Send RCPT TO command to the server
Winsock1.SendData "RCPT TO:" & Trim$(txtRecipient) & vbCrLf
'
Debug.Print "RCPT TO:" & Trim$(txtRecipient)
'
Case MAIL_RCPTTO
'
'Change current state of the session
m_State = MAIL_DATA
'
'Send DATA command to the server
Winsock1.SendData "DATA" & vbCrLf
'
Debug.Print "DATA"
'
Case MAIL_DATA
'
'Change current state of the session
m_State = MAIL_DOT
'
'So now we are sending a message body
'Each line of text must be completed with
'linefeed symbol (Chr$(10) or vbLf) not with vbCrLf
'
'Send Subject line
Winsock1.SendData "Subject:" & txtSubject & vbLf
'
Debug.Print "Subject:" & txtSubject
'
Dim varLines As Variant
Dim varLine As Variant
'
'Parse message to get lines (for VB6 only)
varLines = Split(txtMessage, vbCrLf)
'
'Send each line of the message
For Each varLine In varLines
Winsock1.SendData CStr(varLine) & vbLf
'
Debug.Print CStr(varLine)
Next
'
'Send a dot symbol to inform server
'that sending of message comleted
Winsock1.SendData "." & vbCrLf
'
Debug.Print "."
'
Case MAIL_DOT
'Change current state of the session
m_State = MAIL_QUIT
'
'Send QUIT command to the server
Winsock1.SendData "QUIT" & vbCrLf
'
Debug.Print "QUIT"
Case MAIL_QUIT
'
'Close connection
Winsock1.Close
'
End Select

Else
'
'If we are here server replied with
'unacceptable respose code therefore we need
'close connection and inform user about problem
'
Winsock1.Close
'
If Not m_State = MAIL_QUIT Then
MsgBox "SMTP Error: " & strServerResponse, _
vbInformation, "SMTP Error"
Else
MsgBox "Message sent successfuly.", vbInformation
End If
'
End If

End Sub

我如何将密码提交到服务器呢？

[flowerknight]

同志们加油呀！
尽显高手本色的时候到了！

[iamluodong]

你在仔细看看我的代码,我看你的代码也是通过Winsock进行数据传递的所以我的代码适合你.
首先现在很多Smtp服务器需要用户验证以防止垃圾邮件如果你的代码在一年以前我想是没有问题的.现在要解决的就是发送用户名称和口令.
向服务器发送 "AUTH LOGIN" & vbCrLf 这条命令是必须的,如果服务端反馈334代码证明此服务器需要验证那么接下来我们就可以发送用户名称和口令了.依此是

1. wsock.senddata "AUTH LOGIN" & vbCrLf
2.Wsock.SendData [用户名称] & vbCrLf
3.紧接着如果服务端返回334.发送口令
wsock.senddata [口令] & vbcrlf

如果服务端返回334.那么验证通过仔细看看我的代码.

[xmczm]

我搞不懂Base64的编码程序
怎样用？？楼上的能否提示一点，谢谢

[iamluodong]

错了!!!用户名称不应该加"@163.com",你的邮箱是[e-mail]
你的用户名称应该是:liwei_king

[iamluodong]

错了!!!用户名称不应该加"@163.com",你的邮箱是[e-mail]
你的用户名称应该是:liwei_king

[flowerknight]

我又重写了一遍，注释换成中文，可是还是不行。不只阁下能否根据我的代码进行一下修改，并粘贴上来。
以下是我新写的：
Private Sub cmdSend_Click()

Winsock1.Connect Trim$(txtHost), 25

m_State = MAIL_AUTH

End Sub
'----------------------------------------------
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)

Dim strServerResponse As String
Dim strResponseCode As String
Dim strDataToSend As String
'
'获取服务器的返回信息
'
Winsock1.GetData strServerResponse
Debug.Print strServerResponse
'
'获取返回信息的前三个数字
'
strResponseCode = Left(strServerResponse, 3)
'
'根据返回的代码，进行相应的操作
'
If strResponseCode = "250" Or _
strResponseCode = "334" Or _
strResponseCode = "220" Or _
strResponseCode = "354" Then

Select Case m_State
Case MAIL_AUTH
m_State = MAIL_CONNECT
Winsock1.SendData "AUTH LOGIN" & vbCrLf

Case MAIL_CONNECT
m_State = MAIL_SCRET
strDataToSend = Trim$(txtSender)
'从邮箱中提取用户名
strDataToSend = Left$(strDataToSend, _
InStr(1, strDataToSend, "@") - 1)
'将用户名发送给服务器
Winsock1.SendData "HELO" & strDataToSend & vbCrLf
Debug.Print "HELO " & strDataToSend

Case MAIL_SCRET
'密码
m_State = MAIL_HELO
Winsock1.SendData 3285538 & vbCrLf

Case MAIL_HELO
m_State = MAIL_FROM
'
'发送 MAIL FROM 命令到服务器
Winsock1.SendData "MAIL FROM:" & Trim$(txtSender) & vbCrLf
Debug.Print "MAIL FROM:" & Trim$(txtSender)
'
Case MAIL_FROM
m_State = MAIL_RCPTTO
'
'发送 RCPT TO 目标命令到服务器
Winsock1.SendData "RCPT TO:" & Trim$(txtRecipient) & vbCrLf
Debug.Print "RCPT TO:" & Trim$(txtRecipient)
'
Case MAIL_RCPTTO
m_State = MAIL_DATA
'
'发送 DATA 数据命令到服务器
Winsock1.SendData "DATA" & vbCrLf
Debug.Print "DATA"
'
Case MAIL_DATA
m_State = MAIL_DOT
'
'发送内容主体
'Each line of text must be completed with
'linefeed symbol (Chr$(10) or vbLf) not with vbCrLf
'发送标题行
Winsock1.SendData "Subject:" & txtSubject & vbLf
Debug.Print "Subject:" & txtSubject
'
Dim varLines As Variant
Dim varLine As Variant
'
'获得行数
varLines = Split(txtMessage, vbCrLf)
'
'发送每一行的内容
For Each varLine In varLines
Winsock1.SendData CStr(varLine) & vbLf
Debug.Print CStr(varLine)
Next
'
'发送一个句点到服务器，表示发送完成
Winsock1.SendData "." & vbCrLf
Debug.Print "."
'
Case MAIL_DOT
m_State = MAIL_QUIT
'
'发送 QUIT 结束命令到服务器
Winsock1.SendData "QUIT" & vbCrLf
Debug.Print "QUIT"
Case MAIL_QUIT
'
'Close connection
Winsock1.Close
'
End Select

Else
'
'If we are here server replied with
'unacceptable respose code therefore we need
'close connection and inform user about problem
'
Winsock1.Close
'
If Not m_State = MAIL_QUIT Then
MsgBox "SMTP Error: " & strServerResponse, _
vbInformation, "SMTP Error"
Else
MsgBox "Message sent successfuly.", vbInformation
End If
'
End If

End Sub

[iamluodong]

你的用户名称和口令没有进行Base64编码,以下是Base64的编码程序
或者给我E_mail,我给你发过去.
Public Function Base64Encode(Infile As String, Outfile As String)
Dim FnumIn As Integer, FnumOut As Integer
Dim mInByte(3) As Byte, mOutByte(4) As Byte
Dim myByte As Byte
Dim i As Integer, LineLen As Integer, j As Integer
FnumIn = FreeFile()
Open Infile For Binary As #FnumIn
FnumOut = FreeFile()
Open Outfile For Binary As #FnumOut
While Not EOF(FnumIn)
i = 0
Do While i < 3
Get #FnumIn, , myByte
If Not EOF(FnumIn) Then
mInByte(i) = myByte
i = i + 1
Else
Exit Do
End If
Loop
Base64EncodeByte mInByte, mOutByte, i
For j = 0 To 3
Put #FnumOut, , mOutByte(j)
Next j
LineLen = LineLen + 1
If LineLen * 4 > 70 Then
Put #FnumOut, , vbCrLf
LineLen = 0
End If
Wend
Close (FnumOut)
Close (FnumIn)
End Function

Private Sub Base64EncodeByte(mInByte() As Byte, mOutByte() As Byte, Num As Integer)
Dim tByte As Byte
Dim i As Integer

If Num = 1 Then
mInByte(1) = 0
mInByte(2) = 0
ElseIf Num = 2 Then
mInByte(2) = 0
End If

tByte = mInByte(0) And &HFC
mOutByte(0) = tByte / 4
tByte = ((mInByte(0) And &H3) * 16) + (mInByte(1) And &HF0) / 16
mOutByte(1) = tByte
tByte = ((mInByte(1) And &HF) * 4) + ((mInByte(2) And &HC0) / 64)
mOutByte(2) = tByte
tByte = (mInByte(2) And &H3F)
mOutByte(3) = tByte

For i = 0 To 3
If mOutByte(i) >= 0 And mOutByte(i) <= 25 Then
mOutByte(i) = mOutByte(i) + Asc("A")
ElseIf mOutByte(i) >= 26 And mOutByte(i) <= 51 Then
mOutByte(i) = mOutByte(i) - 26 + Asc("a")
ElseIf mOutByte(i) >= 52 And mOutByte(i) <= 61 Then
mOutByte(i) = mOutByte(i) - 52 + Asc("0")
ElseIf mOutByte(i) = 62 Then
mOutByte(i) = Asc("+")
Else
mOutByte(i) = Asc("/")

End If
Next i

If Num = 1 Then
mOutByte(2) = Asc("=")
mOutByte(3) = Asc("=")
ElseIf Num = 2 Then
mOutByte(3) = Asc("=")
End If
End Sub


Public Function Base64Decode(Infile As String, Outfile As String)
Dim FnumIn As Integer, FnumOut As Integer
Dim mInByte(4) As Byte, mOutByte(3) As Byte
Dim myByte As Byte
Dim i As Integer, LineLen As Integer, j As Integer
Dim ByteNum As Integer
FnumIn = FreeFile()
Open Infile For Binary As #FnumIn
FnumOut = FreeFile()
Open Outfile For Binary As #FnumOut

While Not EOF(FnumIn)
i = 0
Do While i < 4
Get #FnumIn, , myByte
If Not EOF(FnumIn) Then
If myByte <> &HA And myByte <> &HD Then
'把回车符和换行符去掉
mInByte(i) = myByte
i = i + 1
End If
Else
Exit Do
End If
Loop
Base64DecodeByte mInByte, mOutByte, ByteNum

For j = 0 To 2 - ByteNum
Put #FnumOut, , mOutByte(j)
Next j
'LineLen = LineLen + 1
Wend
Close (FnumOut)
Close (FnumIn)
End Function

Private Sub Base64DecodeByte(mInByte() As Byte, mOutByte() As Byte, ByteNum As Integer)
Dim tByte As Byte
Dim i As Integer
ByteNum = 0
For i = 0 To 3
If mInByte(i) >= Asc("A") And mInByte(i) <= Asc("Z") Then
mInByte(i) = mInByte(i) - Asc("A")
ElseIf mInByte(i) >= Asc("a") And mInByte(i) <= Asc("z") Then
mInByte(i) = mInByte(i) - Asc("a") + 26
ElseIf mInByte(i) >= Asc("0") And mInByte(i) <= Asc("9") Then
mInByte(i) = mInByte(i) - Asc("0") + 52
ElseIf mInByte(i) = Asc("+") Then
mInByte(i) = 62
ElseIf mInByte(i) = Asc("/") Then
mInByte(i) = 63
Else '"="
ByteNum = ByteNum + 1
mInByte(i) = 0
End If
Next i
'取前六位
tByte = (mInByte(0) And &H3F) * 4 + (mInByte(1) And &H30) / 16
'0的六位和1的前两位
mOutByte(0) = tByte
tByte = (mInByte(1) And &HF) * 16 + (mInByte(2) And &H3C) / 4
'1的后四位和2的前四位
mOutByte(1) = tByte
tByte = (mInByte(2) And &H3) * 64 + (mInByte(3) And &H3F)
mOutByte(2) = tByte
'2的后两位和3的六位
End Sub

[iamluodong]

我上面给的就是Base64的编码程序,它的存在是为了存储二进制类型的数据比如你的邮件中带有附件那么就需要用Base64编码使之成为可以用Ascii码表示的数据类型,用户名称和口令必须经过Base64编码,相应的服务端使用Base64对你的用户名称和口令进行解码,如果一致那么验证通过.
你如果连Base64都不清楚,我不知你的邮件程序是如何完成的.我已经不可能给你将的更细致了.Bye.