求个vb6 winsock发邮件附件,base64编码,已能编译成功通过的代码
主要是发附件那部分要能成功的,我网上找了几个试了实际都不行.附件编码后会在正文显示,而不是附件.我信箱: 2474580594@qq.com
谢谢! --------------------编程问答-------------------- 部分代码如下：
--------------------编程问答--------------------
Case MAIL_DATA
m_State = MAIL_DOT
Dim strAttachName As String
Dim filepath As String
Dim Fj
Dim i As Integer
Dim ii As Integer
Dim emailsendbj As Long
m_SendLen = 0
Fj = "From:" & user.Text & " <" & txtfrom & ">" & vbCrLf '发件人
Fj = Fj & "To:" & toname & " <" & getaddress & ">" & vbCrLf '收件人
Fj = Fj & "X-Mailer:Lusb:邮件发送软件V1.0" & vbCrLf '
Fj = Fj & "Subject:" & Chr(32) & subject + vbCrLf '邮件主题
Fj = Fj & "MIME-Version: 1.0" & vbCrLf 'MIME邮件版本
Fj = Fj & "Content-Type: multipart/mixed;" & vbCrLf
Fj = Fj & " boundary=" & """" & Fjmixed & """" & vbCrLf
emailsendbj = 0
If lstAttachments.ListCount <> 0 Then '如果有附件则进行编码发送
For i = 0 To lstAttachments.ListCount - 1
lstAttachments.ListIndex = i
filepath = lstAttachments.Text '文件名
For ii = Len(filepath) To 1 Step -1
If Mid(filepath, ii, 1) = "\" Then '取得文件名
strAttachName = Chr(34) & "=??B?" & Encode(Mid(filepath, ii + 1)) & "?=" & Chr(34) '处理文件名
m_strEncodedFiles = EncodeFromFile(filepath)
'=??B?yrnTw8u1w/cudHh0?=
'Fj = "--Unique-Boundary" & vbCrLf
'Fj = Fj & "Content-Type: multipart/mixed;" & vbCrLf & " boundary=" & Chr(34) & fg & Chr(34) & vbCrLf & vbCrLf
Fj = Fj & vbCrLf & "--" & Fjmixed & vbCrLf '分界线
Fj = Fj & "Content-Type: application/octet-stream;" & vbCrLf
Fj = Fj & " name=" & strAttachName & vbCrLf
Fj = Fj & "Content-Transfer-Encoding:base64" & vbCrLf
'Fj = Fj & "Content-Disposition: inline;" & vbCrLf
Fj = Fj & "Content-Disposition: attachment;" & vbCrLf
Fj = Fj & " filename=" & strAttachName & vbCrLf & vbCrLf
Fj = Fj & m_strEncodedFiles & "==" & vbCrLf
''''Winsock1.SendData Fj
Exit For
End If
Next ii
'Debug.Print m_strEncodedFiles
Next i
emailsendbj = emailsendbj + 1
End If
''''Fj = ""
If Len(txtMessage) <> 0 Then '如果有文本则编码发送
Fj = Fj & vbCrLf & "--" & Fjmixed & vbCrLf '
Fj = Fj & "Content-Type: multipart/alternative;" & vbCrLf
Fj = Fj & " boundary=" & """" & Fjalternative & """" & vbCrLf & vbCrLf
Fj = Fj & vbCrLf & "--" & Fjalternative & vbCrLf '文本开始
Fj = Fj & "Content-Type: text/plain;" & vbCrLf
Fj = Fj & " charset=" & """" & "gb2312" & """" & vbCrLf
Fj = Fj & "Content-Transfer-Encoding:base64" & vbCrLf & vbCrLf
Fj = Fj & Encode(txtMessage) & vbCrLf '文本正文
''''Winsock1.SendData Fj
''''Winsock1.SendData "--" & Fjalternative & "--" & vbCrLf '结束文本的发送
Fj = Fj & "--" & Fjalternative & "--" & vbCrLf '结束文本的发送
emailsendbj = emailsendbj + 1
End If
'''''Fj = ""
If Len(txtHtml) <> 0 Then '如果有网页则编码发送
Fj = Fj & vbCrLf & "--" & Fjmixed & vbCrLf '
Fj = Fj & "Content-Type: multipart/alternative;" & vbCrLf
Fj = Fj & " boundary=" & """" & Fjalternative & """" & vbCrLf & vbCrLf
Fj = Fj & vbCrLf & "--" & Fjalternative & vbCrLf '文本开始
Fj = Fj & "Content-Type: text/html;" & vbCrLf
Fj = Fj & " charset=" & """" & "gb2312" & """" & vbCrLf
Fj = Fj & "Content-Transfer-Encoding:base64" & vbCrLf & vbCrLf
Fj = Fj & EncodeFromFile(txtHtml) & vbCrLf '文本正文
'Fj = Fj & txtMessage '文本正文
'''''Winsock1.SendData Fj
'''''Winsock1.SendData "--" & Fjalternative & "--" & vbCrLf '结束文本的发送
Fj = Fj & "--" & Fjalternative & "--" & vbCrLf '结束文本的发送
emailsendbj = emailsendbj + 1
End If
'''''Winsock1.SendData "--" & Fjmixed & "--" & vbCrLf '结束附件的发送
Fj = Fj & "--" & Fjmixed & "--" & vbCrLf '结束附件的发送
'''''Winsock1.SendData "." & vbCrLf
Fj = Fj & "." & vbCrLf
m_SendLen = Len(Fj)
PBWock.Min = 0
PBWock.Max = m_SendLen
Winsock1.SendData Fj
谢谢大侠!有没有完整的呢?那个encode 能发份完整的我吗?我信箱: 2474580594@qq.com 谢谢!
补充：VB , 网络编程
