sendmail.asp

淘客网上商店网站程序 淘客网上商店网站程序 淘客网上商店网站程序

<!--#include file="../Conn.asp"-->
<!--#include file="../inc/Cl_ClsSysTem.asp"-->
<!--#include file="../inc/Cl_ClsTemplate.asp"-->
<!--#include file="../inc/Cl_ClsEmail.asp"-->
<%
'if Cl.ChkIsOuter Then
	'Call Cl.OutErr(0,"<li>请不要从外部或者直接访问本页面！</li>")
	'Response.end
'end if
Cl.Get_WebSetting
dim rs,sql
dim Action,FoundErr,ErrMsg
dim SendTitle,SendBody
dim MailTitle,MailUrl,ComeUrl
dim InfoID,ChannelID
dim FriendName,FriendEmail,FromName
dim ObjInstalled
if Not Cl.ChkUserLogin then
	Call Cl.OutErr(0,Cl.Language.selectSingleNode("//NoLoginErr").text)
	Response.end
end if
Select Case Cint(Cl.Web_Setting(17))
Case 1
ObjInstalled=Cl.ChkObjInstalled("JMail.Message")
Case 2
ObjInstalled=Cl.ChkObjInstalled("CDONTS.NewMail")
Case 3
ObjInstalled=Cl.ChkObjInstalled("Persits.MailSender")
Case Else
ObjInstalled=False
End Select
'if ObjInstalled=False then
'	Call Cl.OutErr(0,"<li><font color=""red"">对不起，因为服务器不支持未安装邮件发送组件，或者已禁用发送邮件功能!</font></li>")
'end if
InfoID		= Cl.GetClng(request("InfoID"))
Action		= Trim(request("Action"))
MailTitle	= Trim(request("Title"))
SendTitle	= Replace(Cl.Language.selectSingleNode("//EmailFromFriendTitle").text,"{$webname}",Cl.Web_Info(0))
MailUrl		= Trim(request.Form("MailUrl"))
ComeUrl		= Request.ServerVariables("HTTP_REFERER")
if ComeUrl="" then ComeUrl = Cl.Web_Info(4)
if MailUrl="" then MailUrl = ComeUrl

if Action="SendMail" then
	SendToFriend
else
	SendMain
end if

Sub SendMain()
	Dim TempStr
	Call Template.Load(-2,10)
	TempStr = Template.Html
	TempStr = Replace(TempStr,"{$comeurl}",ComeUrl)
	TempStr = Replace(TempStr,"{$fromname}",Cl.MemberName)
	TempStr = Replace(TempStr,"{$fromemail}",Cl.Web_Info(8))
	TempStr = Replace(TempStr,"{$sendtitle}",SendTitle)
	TempStr = Replace(TempStr,"{$mailtitle}",MailTitle)
	TempStr = Replace(TempStr,"{$mailbodytemp}",Server.HtmlEnCode(GetMailBody))
	
	Response.Write TempStr
	TempStr = Empty
	CloseAllObj
end sub

sub SendToFriend()
	FriendName	= Trim(request.Form("FriendName"))
	FriendEmail	= Trim(request.Form("FriendEmail"))
	FromName	= Trim(request.Form("FromName"))
	if FriendName="" then
		ErrMsg=ErrMsg & "<br /><li>收信人姓名不能为空！</li>"
		founderr=true
	end if
	if Not Cl.ChkEmail(FriendEmail) then
		ErrMsg=ErrMsg & "<br /><li>收信人的Email地址有错误！</li>"
		founderr=true
	end if
	if FromName="" then
		ErrMsg=ErrMsg & "<br /><li>发信人姓名不能为空！</li>"
		founderr=true
	end if
	if Founderr Then Call Cl.OutErr(0,ErrMsg)
	SendBody=Replace(GetMailBody,"{$friendname}",FriendName)
	Dim ClEmail
	Set ClEmail = New Cls_SendMail
	ClEmail.SendObject = Cint(Cl.Web_Setting(17))	'设置选取组件
	ClEmail.ServerLoginName = Cl.Web_Setting(19)	'您的邮件服务器登录名
	ClEmail.ServerLoginPass = Cl.Web_Setting(20)	'登录密码
	ClEmail.SendSMTP = Cl.Web_Setting(18)			'SMTP地址
	ClEmail.SendFromEmail = Cl.User_Info(7)		'发送来源地址
	ClEmail.SendFromName = FromName		'发送人信息
	If ClEmail.ErrCode = 0 Then
		ClEmail.SendMail FriendEmail,SendTitle,SendBody	'执行发送邮件
	End If
	If ClEmail.ErrCode <> 0 Then
		Call Cl.OutErr(0,ClEmail.Description)
	else
		Cl.OutMsg 0,"恭喜您，已经成功将此邮件发送给你的好友！",MailUrl
	end if
end Sub

Function GetMailBody()
	Dim BodyStr
	BodyStr	= Template.GetTemplate(Cl.GetDefaultTemplateID(-2,9,Template.ProjectID))
	BodyStr	= Replace(BodyStr,"{$fromname}",Cl.MemberName)
	BodyStr	= Replace(BodyStr,"{$webname}",Cl.Web_Info(0))
	BodyStr	= Replace(BodyStr,"{$mailtitle}",MailTitle)
	BodyStr	= Replace(BodyStr,"{$mailurl}",MailUrl)
	BodyStr	= Replace(BodyStr,"{$username}",Cl.MemberName)
	BodyStr	= Replace(BodyStr,"{$webname}",Cl.Web_Info(0))
	BodyStr	= Replace(BodyStr,"{$copyright}",Cl.Web_info(9))
	BodyStr	= Replace(BodyStr,"{$version}","<a href='http://www.a"&"spoo.cn' target='_blank'>"&ClCMS_Version&"</a>")
	'BodyStr	= Replace(BodyStr,vbcrlf,"<br />")
	GetMailBody = BodyStr
End Function
%>
<%
'===================================================
' CreateLive CMS Version 4.0
'							Powered by Aspoo.CoM
'===================================================
' Mail: [e-mail], [e-mail]
' Q  Q: 3315263, 596197794
' Msn : [e-mail], [e-mail]
' Web : http://www.aspoo.com, http://www.aspoo.net
' Bbs : http://bbs.aspoo.com, http://bbs.aspoo.net
' Copyright (C) 2005-2007 Aspoo.CoM All Rights Reserved.
'===================================================
%>