求个vb6 winsock发邮件附件,base64编码,已能编译成功通过的代码

Question

主要是发附件那部分要能成功的,我网上找了几个试了实际都不行.附件编码后会在正文显示,而不是附件.我信箱: [email protected]谢谢!

Answer 1

部分代码如下：
            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

Answer 2

谢谢大侠!有没有完整的呢?那个encode    能发份完整的我吗?我信箱: [email protected] 谢谢!