读书人

WINSOCK发送邮件为啥内容稍微长点就收

发布时间: 2012-12-23 11:28:15 作者: rapoo

WINSOCK发送邮件为什么内容稍微长点就收不到呢?
我发送代码是这样写的, 短点的发送一点问题都没有, 但稍微长点内容发送过后,debug里头显示是发送成功的。。但却怎么也接收不到!

我测试了大概3800多字发送很正常都能收到, 超过了就几乎收不到了!!!!!

求高手指点。。

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)

Dim strServerResponse As String
Dim strResponseCode As String
Dim strDataToSend As String
'
'接收来自服务器的数据并存储在strServerResponse变量中
'
Winsock1.GetData strServerResponse
'
Debug.Print Replace(strServerResponse, vbCrLf, "")
'
'获取来自服务器的回应的代码
'
strResponseCode = Left(strServerResponse, 3)
'
'只有下面这个三个数字才表示服务执行你的命令成功,我们可以进行下一步的操作
'
If strResponseCode = "220" Or _
strResponseCode = "334" Or _
strResponseCode = "235" Or _
strResponseCode = "250" Or _
strResponseCode = "354" Or _
strResponseCode = "221" Then

Select Case m_State
Case MAIL_CONNECT
m_State = MAIL_HELO

strDataToSend = Trim$(txtSender)
strDataToSend = Split(strDataToSend, "@")(0)

Winsock1.SendData "HELO " & _
strDataToSend & vbCrLf


Debug.Print "HELO " & strDataToSend & vbCrLf

Case MAIL_HELO

m_State = MAIL_AUTHLOGIN

Winsock1.SendData "AUTH LOGIN" & vbCrLf
'
Debug.Print "AUTH LOGIN" & vbCrLf
'
Case MAIL_AUTHLOGIN

m_State = MAIL_USERNAME

Winsock1.SendData base64_2.Base64Encode(txtUserName) & vbCrLf
'
Debug.Print "USER NAME:" & base64_2.Base64Encode(txtUserName) & vbCrLf
'
Case MAIL_USERNAME

m_State = MAIL_PASSWORD

Winsock1.SendData base64_2.Base64Encode(txtPassWord) & vbCrLf
'
Debug.Print "PASSWORD:" & base64_2.Base64Encode(txtPassWord) & vbCrLf



Case MAIL_PASSWORD

m_State = MAIL_MAILFROM

Winsock1.SendData "MAIL FROM:" & Chr(32) & "<" & txtSender & ">" & vbCrLf
'
Debug.Print "MAIL FROM:" & Chr(32) & "<" & txtSender & ">" & vbCrLf
Case MAIL_MAILFROM

m_State = MAIL_RCPTTO

Winsock1.SendData "RCPT TO:" & Chr(32) & "<" & txtRecipient & ">" & vbCrLf
'
Debug.Print "RCPT TO:" & Chr(32) & "<" & txtRecipient & ">" & vbCrLf
'
Case MAIL_RCPTTO

m_State = MAIL_DATA

Winsock1.SendData "DATA" & vbCrLf
'
Debug.Print "DATA"


'
Case MAIL_DATA

m_State = MAIL_DOT

Winsock1.SendData ("From: " & txtSender & vbCrLf)
Winsock1.SendData ("To:" & txtRecipientName & vbCrLf)
Winsock1.SendData ("Subject: " & txtSubject & vbCrLf)
Winsock1.SendData ("Date: " & Format(Date, "Ddd") & "," & Format(Date, "dd Mmm YYYY") & " " & Format(Time, "hh:mm:ss") & "" & "-0600" & vbCrLf)
Winsock1.SendData ("X-Mailer: CCTV MAIL V1.0" & vbCrLf)
Winsock1.SendData ("MIME-Version: 1.0" & vbCrLf)

Randomize
'头
Const RandString As String = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890_"
Dim Globalstr As String, jd, uniquey
For jd = 1 To 20
uniquey = Int(Rnd * Len(RandString)) + 1


Globalstr = Globalstr + Mid(RandString, uniquey, 1)
Next jd
Globalstr = "001_" & Globalstr
Dim strime1, strime, strimeall, msg
strime1 = strime1 + "Content-Type: multipart/alternative;" + vbCrLf
strime1 = strime1 + Chr(9) + "boundary=""----=_NextPart_" + Globalstr + """" + vbCrLf + vbCrLf
strime1 = strime1 + "This mail is In MIME format. Your mail interface does Not appear To support this format." + vbCrLf + vbCrLf + vbCrLf

'正文
strime = "------=_NextPart_" + Globalstr + vbCrLf
''''''''''''''''''第一段文本格式的
msg = base64_2.Base64Encode(Trim(txtMessage))
strime = strime + "Content-type: text/plain; charset=gb2312 " + vbCrLf + vbCrLf
strime = strime + msg + vbCrLf + vbCrLf + vbCrLf
strime = strime + "------=_NextPart_" + Globalstr + vbCrLf


'''''''''''''''''''第二段HTML格式的
strime = strime + "Content-type: text/HTML; charset=gb2312 " + vbCrLf + vbCrLf
strime = strime + textToHtmlBody(Trim(txtMessage), txtSubject) + vbCrLf + vbCrLf
strime = strime + "------=_NextPart_" + Globalstr + "--" + vbCrLf + vbCrLf + vbCrLf

'------邮件体结束----------

Winsock1.SendData strime1 & vbCrLf
Winsock1.SendData strime & vbCrLf

Debug.Print strime1 & strime


Winsock1.SendData "." & vbCrLf
'
Debug.Print "."
'
Case MAIL_DOT

m_State = MAIL_QUIT



Winsock1.SendData "QUIT" & vbLf
'
Debug.Print "QUIT"
Case MAIL_QUIT

Winsock1.Close
'
End Select

Else
'
'如果服务器返回一个错误的代码就断开连接并提示用户
'
'Winsock1.Close

Debug.Print "——err 250: " & "SMTP Error: " & strServerResponse, _
vbInformation, "SMTP Error "
'
'MsgBox "SMTP Error: " & strServerResponse, _
vbInformation, "SMTP Error "
'
End If

End Sub
[最优解释]
网上查阅自动分包问题。互联网大约4K就会自动分包,你要手动处理分包与组包问题。

[其他解释]
这个资料里面有关于发送邮件的资料
[其他解释]
学习,领悟。。。。。。。。
[其他解释]
上面可能误导了, 因为测试发现,下面的这个内容也是怎么都接收不到

标题:
关键词
内容:
【书籍】【共性探测】【共振性】【永久免费】【认证】.lnk
【求代码】基础范畴.htm.lnk



但内容换成下面这样, 又肯定行了:
【书籍】xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx.lnk


【有效性】基础范畴.htm.lnk
[其他解释]
上面可能误导了, 因为测试发现,下面的这个内容也是怎么都接收不到

标题:
关键词
内容:
【书籍】【共性探测】【共振性】【永久免费】【认证】.lnk
【求代码】基础范畴.htm.lnk



但内容换成下面这样, 又肯定行了:
【书籍】xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx.lnk
【有效性】基础范畴.htm.lnk
[其他解释]
上面可能误导了, 因为测试发现,下面的这个内容也是怎么都接收不到

标题:
关键词
内容:
【书籍】【共性探测】【共振性】【永久免费】【认证】.lnk
【求代码】基础范畴.htm.lnk



但内容换成下面这样, 又肯定行了:
【书籍】xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx.lnk
【有效性】基础范畴.htm.lnk

读书人网 >VB

热点推荐