| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 970 人关注过本帖
标题:已结贴
只看楼主 加入收藏
a251357
Rank: 2
等 级:论坛游民
帖 子:42
专家分:14
注 册:2014-4-24
结帖率:90%
收藏
已结贴  问题点数:20 回复次数:10 
已结贴
已结贴

[此贴子已经被作者于2017-1-15 05:27编辑过]

2015-08-01 11:43
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:贵宾
威 望:364
帖 子:4947
专家分:30084
注 册:2008-10-15
收藏
得分:5 
用 Winsock 写吧,自己处理 smtp 协议,不难的。发邮件可以不编码的。

参考:http://blog.
3.2.  ESMTP 这一节。

你使用控件,因为都不支持 ESMTP 协议,而只支持 SMTP 协议,所以不成功。
也有可能你注意让控件去支持 ESMTP 协议。

[ 本帖最后由 风吹过b 于 2015-8-1 19:22 编辑 ]

授人于鱼,不如授人于渔
早已停用QQ了
2015-08-01 16:54
lianyicq
Rank: 12Rank: 12Rank: 12
等 级:贵宾
威 望:26
帖 子:737
专家分:3488
注 册:2013-1-26
收藏
得分:0 
回复 楼主 a251357
如果用WINSOCK控件,建议了解了解用telnet发邮件,T测试正常了再写代码.

大开眼界
2015-08-04 11:36
lianyicq
Rank: 12Rank: 12Rank: 12
等 级:贵宾
威 望:26
帖 子:737
专家分:3488
注 册:2013-1-26
收藏
得分:0 
各个邮箱的SMTP服务器情况不一样,我试了QQ、netease、tom三个邮箱,只有最不好用的tom邮箱测试通过了。netease邮箱auth login后,死活通不过验证。qq邮箱auth login也失败,提示please open smtp flag first.但没找到QQ邮箱设置SMTP开启的地方。telnet都过不了,vb6的winsock当然过不了。
试没试过CDO。
实在不行就引用outlook吧

大开眼界
2015-08-05 09:51
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:贵宾
威 望:364
帖 子:4947
专家分:30084
注 册:2008-10-15
收藏
得分:0 
网易的,现在要绑定手机,然后通过手机取 SMTP 随机密码才能通过验证。

QQ邮箱,在设置 ,帐户 很后面才这个开关。一共有四种。

授人于鱼,不如授人于渔
早已停用QQ了
2015-08-05 13:38
lianyicq
Rank: 12Rank: 12Rank: 12
等 级:贵宾
威 望:26
帖 子:737
专家分:3488
注 册:2013-1-26
收藏
得分:0 
回复 5楼 风吹过b
打到QQ邮箱开SMTP的地方了,需要独立密码。
开启后
helo握手
starttls(和TOM不一样)
auth login成功了。
后续命令和tom也不一样。要先rcpt 再data

大开眼界
2015-08-05 13:52
lianyicq
Rank: 12Rank: 12Rank: 12
等 级:贵宾
威 望:26
帖 子:737
专家分:3488
注 册:2013-1-26
收藏
得分:0 
TOM邮箱是这样的
telnet smtp. 25
helo ****
auth login
****
****
mail from:<****>
rcpt to:<****>
data
from:****
to:****
subject:Test

This is a test.

.

过程中好几行都输了多次,比如mail from:后报错,再输入就对了。最终试了两次都发到了QQ邮箱中的垃圾邮件箱。


[ 本帖最后由 lianyicq 于 2015-8-5 14:09 编辑 ]

大开眼界
2015-08-05 14:05
lianyicq
Rank: 12Rank: 12Rank: 12
等 级:贵宾
威 望:26
帖 子:737
专家分:3488
注 册:2013-1-26
收藏
得分:15 
在telnet测试通过的基础之上,调整了代码。用smtp.通过了,不过仍是进了垃圾邮箱。自己想办法改进吧。不同的邮箱有不同的指令或顺序,只能自己试了。
如果有我漏删的帐号或密码,请通知我并忽略,谢谢。
窗体代码
程序代码:
Option Explicit

Dim UserMail$, MailRecipiant$, MailBody$, SockData$, UserName$, PassWord$

Private Sub Command1_Click()
  UserName = "邮箱帐号,@前的字符串"
  PassWord = "邮箱密码"
  UserMail = "<完整发件邮箱地址>"
  MailRecipiant = "<完整收件邮箱地址>"
  MailBody = "测试发邮件"
  Winsock1.LocalPort = 0
  Winsock1.RemoteHost = "smtp服务器地址"
  Winsock1.RemotePort = 25 '端口号
  Winsock1.Connect
  Do While Winsock1.State <> sckConnected: DoEvents: Loop
End Sub




Private Sub Winsock1_Connect()
  Label1 = "Sending message..."
  Winsock1.SendData "EHLO " & UserName & vbCrLf
  If Not WaitFor("250") Then GoTo 100

  Winsock1.SendData "AUTH LOGIN " & vbCrLf
  If Not WaitFor("334") Then GoTo 100

  Winsock1.SendData Base64EncodeString(UserName) & vbCrLf
  If Not WaitFor("334") Then GoTo 100

 
  Winsock1.SendData Base64EncodeString(PassWord) & vbCrLf
  If Not WaitFor("235") Then GoTo 100

 
  Winsock1.SendData "MAIL FROM: " & UserMail & vbCrLf
  If Not WaitFor("250") Then GoTo 100

 
  Winsock1.SendData "RCPT TO: " & MailRecipiant & vbCrLf
  If Not WaitFor("250") Then GoTo 100

 
  Winsock1.SendData "DATA" & vbCrLf
  If Not WaitFor("354") Then GoTo 100

 
  Winsock1.SendData "From:完整发件邮箱地址" & vbCrLf & "To:完整收件邮箱地址" & vbCrLf & "Subject:喂" & vbCrLf & vbCrLf

 
  Winsock1.SendData MailBody & vbCrLf & "." & vbCrLf
  If Not WaitFor("250") Then GoTo 100

 
  Winsock1.SendData "QUIT" & vbCrLf
  If Not WaitFor("221") Then GoTo 100
  Label1 = "Message sent"
  GoTo 200
100
  Label1 = SockData
200
  Winsock1.Close
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
  Winsock1.GetData SockData
End Sub

Private Sub Winsock1_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
  Label1 = "Error: " & Description
  SockData = "Error"
  Winsock1.Close
End Sub

Private Function WaitFor(SockResponse As String) As Boolean
  Do While Left(SockData, 3) <> SockResponse And Left(SockData, 3) <> "220" And Left(SockData, 3) <> "250"
    DoEvents
    If Left(SockData, 3) > "400" Then Exit Function
  Loop
  WaitFor = 1
  SockData = ""
End Function



模块是引用的加解码代码
程序代码:
' A Base64 Encoder/Decoder.
'
' This module is used to encode and decode data in Base64 format as described in RFC 1521.
'
' Home page: www.source-code.biz.
' License: GNU/LGPL (www.).
' Copyright 2007: Christian d'Heureuse, Inventec Informatik AG, Switzerland.
' This module is provided "as is" without warranty of any kind.

Option Explicit

Private InitDone  As Boolean
Private Map1(0 To 63)  As Byte
Private Map2(0 To 127) As Byte

' Encodes a string into Base64 format.
' No blanks or line breaks are inserted.
' Parameters:
'   S         a String to be encoded.
' Returns:    a String with the Base64 encoded data.
Public Function Base64EncodeString(ByVal s As String) As String
   Base64EncodeString = Base64Encode(ConvertStringToBytes(s))
   End Function

' Encodes a byte array into Base64 format.
' No blanks or line breaks are inserted.
' Parameters:
'   InData    an array containing the data bytes to be encoded.
' Returns:    a string with the Base64 encoded data.
Public Function Base64Encode(InData() As Byte)
   Base64Encode = Base64Encode2(InData, UBound(InData) - LBound(InData) + 1)
   End Function

' Encodes a byte array into Base64 format.
' No blanks or line breaks are inserted.
' Parameters:
'   InData    an array containing the data bytes to be encoded.
'   InLen     number of bytes to process in InData.
' Returns:    a string with the Base64 encoded data.
Public Function Base64Encode2(InData() As Byte, ByVal InLen As Long) As String
   If Not InitDone Then Init
   If InLen = 0 Then Base64Encode2 = "": Exit Function
   Dim ODataLen As Long: ODataLen = (InLen * 4 + 2) \ 3     ' output length without padding
   Dim OLen As Long: OLen = ((InLen + 2) \ 3) * 4           ' output length including padding
   Dim Out() As Byte
   ReDim Out(0 To OLen - 1) As Byte
   Dim ip0 As Long: ip0 = LBound(InData)
   Dim ip As Long
   Dim op As Long
   Do While ip < InLen
      Dim i0 As Byte: i0 = InData(ip0 + ip): ip = ip + 1
      Dim i1 As Byte: If ip < InLen Then i1 = InData(ip0 + ip): ip = ip + 1 Else i1 = 0
      Dim i2 As Byte: If ip < InLen Then i2 = InData(ip0 + ip): ip = ip + 1 Else i2 = 0
      Dim o0 As Byte: o0 = i0 \ 4
      Dim o1 As Byte: o1 = ((i0 And 3) * &H10) Or (i1 \ &H10)
      Dim o2 As Byte: o2 = ((i1 And &HF) * 4) Or (i2 \ &H40)
      Dim o3 As Byte: o3 = i2 And &H3F
      Out(op) = Map1(o0): op = op + 1
      Out(op) = Map1(o1): op = op + 1
      Out(op) = IIf(op < ODataLen, Map1(o2), Asc("=")): op = op + 1
      Out(op) = IIf(op < ODataLen, Map1(o3), Asc("=")): op = op + 1
      Loop
   Base64Encode2 = ConvertBytesToString(Out)
   End Function

' Decodes a string from Base64 format.
' Parameters:
'    s        a Base64 String to be decoded.
' Returns     a String containing the decoded data.
Public Function Base64DecodeString(ByVal s As String) As String
   If s = "" Then Base64DecodeString = "": Exit Function
   Base64DecodeString = ConvertBytesToString(Base64Decode(s))
   End Function

' Decodes a byte array from Base64 format.
' Parameters
'   s         a Base64 String to be decoded.
' Returns:    an array containing the decoded data bytes.
Public Function Base64Decode(ByVal s As String) As Byte()
   If Not InitDone Then Init
   Dim IBuf() As Byte: IBuf = ConvertStringToBytes(s)
   Dim ILen As Long: ILen = UBound(IBuf) + 1
   If ILen Mod 4 <> 0 Then Err.Raise vbObjectError, , "Length of Base64 encoded input string is not a multiple of 4."
   Do While ILen > 0
      If IBuf(ILen - 1) <> Asc("=") Then Exit Do
      ILen = ILen - 1
      Loop
   Dim OLen As Long: OLen = (ILen * 3) \ 4
   Dim Out() As Byte
   ReDim Out(0 To OLen - 1) As Byte
   Dim ip As Long
   Dim op As Long
   Do While ip < ILen
      Dim i0 As Byte: i0 = IBuf(ip): ip = ip + 1
      Dim i1 As Byte: i1 = IBuf(ip): ip = ip + 1
      Dim i2 As Byte: If ip < ILen Then i2 = IBuf(ip): ip = ip + 1 Else i2 = Asc("A")
      Dim i3 As Byte: If ip < ILen Then i3 = IBuf(ip): ip = ip + 1 Else i3 = Asc("A")
      If i0 > 127 Or i1 > 127 Or i2 > 127 Or i3 > 127 Then _
         Err.Raise vbObjectError, , "Illegal character in Base64 encoded data."
      Dim b0 As Byte: b0 = Map2(i0)
      Dim b1 As Byte: b1 = Map2(i1)
      Dim b2 As Byte: b2 = Map2(i2)
      Dim b3 As Byte: b3 = Map2(i3)
      If b0 > 63 Or b1 > 63 Or b2 > 63 Or b3 > 63 Then _
         Err.Raise vbObjectError, , "Illegal character in Base64 encoded data."
      Dim o0 As Byte: o0 = (b0 * 4) Or (b1 \ &H10)
      Dim o1 As Byte: o1 = ((b1 And &HF) * &H10) Or (b2 \ 4)
      Dim o2 As Byte: o2 = ((b2 And 3) * &H40) Or b3
      Out(op) = o0: op = op + 1
      If op < OLen Then Out(op) = o1: op = op + 1
      If op < OLen Then Out(op) = o2: op = op + 1
      Loop
   Base64Decode = Out
   End Function

Private Sub Init()
   Dim c As Integer, i As Integer
   ' set Map1
   i = 0
   For c = Asc("A") To Asc("Z"): Map1(i) = c: i = i + 1: Next
   For c = Asc("a") To Asc("z"): Map1(i) = c: i = i + 1: Next
   For c = Asc("0") To Asc("9"): Map1(i) = c: i = i + 1: Next
   Map1(i) = Asc("+"): i = i + 1
   Map1(i) = Asc("/"): i = i + 1
   ' set Map2
   For i = 0 To 127: Map2(i) = 255: Next
   For i = 0 To 63: Map2(Map1(i)) = i: Next
   InitDone = True
   End Sub

Private Function ConvertStringToBytes(ByVal s As String) As Byte()
   Dim b1() As Byte: b1 = s
   Dim l As Long: l = (UBound(b1) + 1) \ 2
   If l = 0 Then ConvertStringToBytes = b1: Exit Function
   Dim b2() As Byte
   ReDim b2(0 To l - 1) As Byte
   Dim p As Long
   For p = 0 To l - 1
      Dim c As Long: c = b1(2 * p) + 256 * CLng(b1(2 * p + 1))
      If c >= 256 Then c = Asc("?")
      b2(p) = c
      Next
   ConvertStringToBytes = b2
   End Function

Private Function ConvertBytesToString(b() As Byte) As String
   Dim l As Long: l = UBound(b) - LBound(b) + 1
   Dim b2() As Byte
   ReDim b2(0 To (2 * l) - 1) As Byte
   Dim p0 As Long: p0 = LBound(b)
   Dim p As Long
   For p = 0 To l - 1: b2(2 * p) = b(p0 + p): Next
   Dim s As String: s = b2
   ConvertBytesToString = s
   End Function






 

大开眼界
2015-08-05 14:40
a251357
Rank: 2
等 级:论坛游民
帖 子:42
专家分:14
注 册:2014-4-24
收藏
得分:0 
回复 7楼 lianyicq
谢谢了亲~版主辛苦了!
2015-08-05 21:52
a251357
Rank: 2
等 级:论坛游民
帖 子:42
专家分:14
注 册:2014-4-24
收藏
得分:0 
回复 7楼 lianyicq
'采用 控件 jmail.dll

Dim jmail As New jmail.SMTPMail
jmail.MailDomain = "smtp. 'SMTP服务器
jmail.ServerAddress = "smtp. 'SMTP服务器
jmail.ServerPort = 25
jmail.Subject = "测试----" '主题
jmail.Body = "内容-----"
'jmail.Message.HTMLBody = "Hello!" 'HTML 网页源码 加载源码 内容
jmail.Sender = "12345@ '你的E-mail
jmail.SenderName = "12345" '你的名字
jmail.AddAttachment ("D:\ 测试.txt") '附件
jmail.AddRecipient " '收件人
jmail.Message.MailServerPassWord = "09876" '密码
jmail.Message.MailServerUserName = "12345" '用户名
jmail.Message.From = "12345@ '你的E-mail
jmail.Message.FromName = "测试测试" '你的名字
jmail.Message.Send ("smtp.) 'SMTP服务器

问题已解决~但也还是谢谢版主提供另外的资料~我源码也附上了,以后有人也有此问题的时候也好解决!

帖子已结!
2015-08-05 22:00
快速回复:已结贴
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.057098 second(s), 7 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved