asp使用Jmail发送含任意内嵌附件和附件的Email函数
下面的函数可以发送含任意内嵌附件和附件Email,可以自动分析邮件内容中的本地图片,并把它作为内嵌附件发送,只要服务器支持并可以发送任意的附件
![](https://www.cnblogs.com/Images/OutliningIndicators/ContractedBlock.gif)
![](https://www.cnblogs.com/Images/OutliningIndicators/ExpandedBlockStart.gif)
'===========================================================
'发送含任意内嵌附件和附件的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