asp使用Jmail发送含任意内嵌附件和附件的Email函数

下面的函数可以发送含任意内嵌附件和附件Email，可以自动分析邮件内容中的本地图片，并把它作为内嵌附件发送，只要服务器支持并可以发送任意的附件

 

Code
'===========================================================
'发送含任意内嵌附件和附件的Email函数
'    J_Server 发送服务器
'    J_From 发送者地址
'    J_FromName 发送者姓名
'    J_UserName 身份验证的用户名
'    J_Password 身份验证的密码
'    J_To 收件人地址
'    J_ToName 收件人称谓
'    J_Subject 发送服务器
'    J_HTMLBody 邮件内容
'    J_Attachment 邮件附件  文件之间用逗号隔开
'===========================================================
Function SendEmail(J_Server,J_From,J_FromName,J_UserName,J_Password,J_To,J_ToName,J_Subject,J_HTMLBody,J_Attachment)
    Set JMail = Server.CreateObject("JMail.Message")
    JMail.ISOEncodeHeaders = True 
    JMail.Silent = True 
    JMail.Charset = "gb2312"
    JMail.From = J_From '发送者地址
    JMail.FromName = J_FromName '发送者姓名                
    JMail.MailServerUserName = J_UserName '身份验证的用户名       
    JMail.MailServerPassword = J_Password '身份验证的密码   
    JMail.AddRecipient J_To, J_ToName '加入新的收件人
    JMail.Subject = J_Subject '邮件标题
    '**********增加普通附件********************
    Temp_Att=split(J_Attachment,",")
    For i=0 to ubound(Temp_Att)
        JMail.AddAttachment(Server.MapPath(Trim(Temp_Att(i))))
    Next
    '**********增加内嵌附件********************
    str=J_HTMLBody
    PicUrl=GetLocalPic_Url(str,2)
    If Trim(PicUrl)<>"" then
        Temp_Url=split(PicUrl,"|")
        For i=0 to Ubound(Temp_Url)
            tmp=JMail.AddAttachment(Server.MapPath(Temp_Url(i)))
            J_HTMLBody=replace(J_HTMLBody,Temp_Url(i),"cid:"&tmp&"")
        Next
    End If
    JMail.HTMLBody = J_HTMLBody '邮件内容
    flag = JMail.Send(J_Server) '发送服务器
    JMail.Close()
    SendEmail=flag
End Function

'===========================================================
'获取字符串中的本地图片地址
'Typ 1 所有图片；2本地图片；3本地图片
'===========================================================
Function GetLocalPic_Url(str,Typ)
    Dim Pic_Url,Temp_Url
    do while ContentInnerPicTF(str,"TF")
        Temp_Url=ContentInnerPicTF(str,"PicUrl")
        str=Replace(str,Temp_Url,"")
        
        Select Case Typ
            Case 1 '所有图片
                Pic_Url=Pic_Url&"|"&Temp_Url
            Case 2 '本地图片
                If instr(Temp_Url,"http://")=0 then Pic_Url=Pic_Url&"|"&Temp_Url
            Case 3 '本地图片
                If instr(Temp_Url,"http://")<>0 then Pic_Url=Pic_Url&"|"&Temp_Url
        End Select
        
        If left(trim(Pic_Url),1)="|" then Pic_Url=right(Pic_Url,len(Pic_Url)-1)
        
    loop
    GetLocalPic_Url=Pic_Url
End Function

'===========================================================
'判断传入的字符传中是否包含本地图片并取得此图片地址
'===========================================================
Function ContentInnerPicTF(StrCon,ReturnTF)
    Dim ConStr,Re,InnerPicAll,FistPicUrl,PicUrlStr
    ConStr = StrCon & ""
    Set Re = New RegExp
    Re.IgnoreCase = True
    Re.Global = True
    Re.Pattern = "(src\S+\.{1}(gif|jpg|png)(""|\'|>|\s)?)"
    InnerPicAll = ""
    Set InnerPicAll = Re.Execute(ConStr)
    Set Re = Nothing
    
    FistPicUrl = ""
    
    For Each PicUrlStr in InnerPicAll
        FistPicUrl = Replace(Replace(Replace(PicUrlStr,"src=",""),"'",""),"""","")
        If LCase(Left(FistPicUrl,Len(sRootDir))) = LCase(sRootDir) Then
            FistPicUrl = Mid(FistPicUrl,Len(sRootDir)+1)
        End If
        Exit For
    Next
    
    If ReturnTF = "TF" Then
        If FistPicUrl <> "" And (Not IsNull(FistPicUrl)) then
            ContentInnerPicTF = True
        Else
            ContentInnerPicTF = False 
        End If
    ElseIf ReturnTF = "PicUrl" Then
        If FistPicUrl <> "" And (Not IsNull(FistPicUrl)) then
            ContentInnerPicTF = FistPicUrl
        End If
    End If     

End Function

转载于:https://www.cnblogs.com/chthp/archive/2008/10/07/1305225.html