<% '============================================================================== '软件名称：风讯网站信息管理系统 '当前版本：Foosun Content Manager System(FoosunCMS V3.2SP1) '最新更新：2006.50 '============================================================================== 'Copyright (C) 2002-2004 Foosun.Net All rights reserved. '商业注册联系：028-85098980-601,项目开发：028-85098980-606、609,客户支持：608 '产品咨询QQ：394226379,159410,125114015 '技术支持QQ：315485710,66252421 '项目开发QQ：415637671，655071 '程序开发：四川风讯科技发展有限公司(Foosun Inc.) 'Email:service@Foosun.cn 'MSN：skoolls@hotmail.com '论坛支持：风讯在线论坛(http:/bbs.foosun.net) '官方网站：www.Foosun.cn 演示站点：test.cooin.com '网站通系列(智能快速建站系列)：www.ewebs.cn '============================================================================== '免费版本请在程序首页保留版权信息，并做上本站LOGO友情连接 '风讯公司保留此程序的法律追究权利 '============================================================================== '加载 FS系统缓存 Dim ClassCache Set ClassCache = New Cls_FsCache ClassCache.Name="ConfigCache" If ClassCache.IsVaild = False Then ClassCache.ReLoadCache("") End If Set ClassCache=Nothing Dim MailCacheNameStr MailCacheNameStr=LCase(Replace(Replace(Server.MapPath("/"&SysRootDir) & "_ConfigCache","\",""),":","")) '=============================================================================== Function IsObjInstalled(strClassString) On Error Resume Next IsObjInstalled = False Err = 0 Dim xTestObj Set xTestObj = Server.CreateObject(strClassString) If 0 = Err Then IsObjInstalled = True Set xTestObj = Nothing Err = 0 End Function Function SendMail(SMTPServer,loginName,LoginPass,NameSendFrom,EmailSendFrom,StrSendTo,StrSubject,StrContent) 'On error resume next Dim ObjJmail,ArrSendTo,i If InStr(StrSendTo,",")>0 Then ArrSendTo = Split(StrSendTo,",") Else ArrSendTo = Array(StrSendTo) End If Set ObjJmail = Server.CreateObject("JMail.Message") ObjJmail.Silent = True ObjJmail.Logging = True ObjJmail.Charset = "gb2312" ObjJmail.MailServerUserName = LoginName ObjJmail.MailServerPassword = LoginPass ObjJmail.ContentType = "text/html" ObjJmail.From = EmailSendFrom ObjJmail.FromName = NameSendFrom ObjJmail.Subject = StrSubject For i=LBound(ArrSendTo) To UBound(ArrSendTo) ObjJmail.AddRecipient ArrSendTo(i) Next ObjJmail.Body = StrContent ObjJmail.Priority = 3 '邮件的优先级，可以范围从1到5。越大的优先级约高 ObjJmail.AddHeader "Originating-IP", Request.ServerVariables("REMOTE_ADDR") if not ObjJmail.Send(SMTPServer) then SendMail = false ' Response.Write("邮件发送失败，可能是服务器不支持JMAIL组件，请使用jmail4.3以上版本！
") Else SendMail = true ' Response.Write("邮件已经发送到你注册的邮箱中，请注意查收
") End If ObjJmail.Close Set ObjJmail=nothing End Function '---- function IsValidEmail(email) Dim regEx Set regEx = New RegExp regEx.Pattern = "(\w|-|_|0-9|\.| )+@{1}(\w|0-9|\.|-)+\.[A-Za-z]{2,3}" regEx.IgnoreCase = True IsValidEmail = regEx.Test(email) Set regEx=Nothing end function ObjInstalled=IsObjInstalled("JMail.SMTPMail") Newsid= trim(Replace(request("Newsid"),"'","''")) Action=trim(request("Action")) if Newsid="" then Response.write"" Response.end end if sql="Select * from FS_News where Newsid='"&Newsid&"'" set rs=server.createobject(G_FS_RS) rs.open sql,conn,1,1 if rs.bof and rs.eof then Response.write"" Response.end else if Action="MailToFriend" then call MailToFriend() else call main() end if end if rs.close set rs=nothing sub main() %> 发送电子邮件
发送电子邮件
<% If ObjInstalled=false Then Response.Write "" End If %>
将本文告诉好友
收信人姓名： *
收信人Email地址： *
你的姓名：
你的Email地址：
新闻信息： 新闻标题：<%= rs("Title") %>
新闻作者：<%= rs("Author") %>
发布时间：<%= rs("Adddate") %>
"> >
对不起，因为服务器不支持 JMail组件! 所以不能使用本功能。
<% = Application(MailCacheNameStr)(11) %>
<%end sub sub MailToFriend() MailToName=trim(request.form("MailToName")) MailToAddress=trim(request.form("MailToAddress")) if MailToName="" then Response.write "" Response.end end if if IsValidEmail(MailToAddress)=False then Response.write "" Response.end end if Dim t_server,t_Name,t_Pwd,t_From,t_Efrom,t_to,t_ret,Subject,mailbody Subject="您的朋友"&request.Form("Username")&"从" & Application(MailCacheNameStr)(1) & "给您发来的新闻资料" mailbody=mailbody &"" mailbody=mailbody &"" mailbody=mailbody &"
" mailbody=mailbody &"--  作者："&rs("Author")&"
" mailbody=mailbody &"--  发布时间："&rs("Adddate")&"

" mailbody=mailbody &"--  "&rs("title")&"
" mailbody=mailbody &""&rs("content")&"" mailbody=mailbody &"
" mailbody=mailbody &"
" & Application(MailCacheNameStr)(1) & ",电子邮件"&request.Form("Useremail")&"" t_server = Application(MailCacheNameStr)(8) t_Name = Application(MailCacheNameStr)(9) t_Pwd = Application(MailCacheNameStr)(10) t_From = request.Form("Username") t_Efrom = Application(MailCacheNameStr)(2) t_to = request.Form("MailToAddress") ' Response.write subject & mailbody :response.End ' response.write t_server & t_name & t_pwd & t_from & t_efrom & t_to & subject & mailbody t_ret = SendMail(t_server,t_Name,t_Pwd,t_From,t_Efrom,t_to,Subject,mailbody) if t_ret=False Or Err then '检测 Err.clear response.Write("") response.end else response.Write("") response.end end if end sub %>