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就会自动分包,你要手动处理分包与组包问题。
[解决办法]
这个资料里面有关于发送邮件的资料
[解决办法]
学习,领悟。。。。。。。。