sendpage.asp

一个不错的论坛原代码

<!--#include file="Connections.asp" -->
<!--#include file="top.asp" -->
<!--#include file="ubb.asp" -->


<%  if isuser=false then
errornum=1
errormsg="<li>很抱歉，您没有权限进入</li><li>只有注册用户才可以进入！如果你是本论坛用户，请先<a href=login.asp>登陆</a></li>"
end if

l_id=chktopic(request.querystring("l_id"))
t_id=chktopic(request.querystring("t_id"))
dim h_selectemail,h_emailserver
sql="select h_selectemail,h_emailserver from home"
  set rsconn1=conn.execute(sql)
  if not rsconn1.eof then
h_emailserver=trim(rsconn1("h_emailserver"))'email邮件地址
h_selectemail=rsconn1("h_selectemail")'开通emial
end if
set rsconn1=nothing

if h_selectemail=0 then
errornum=1
errormsg=errormsg&"<li>很抱歉，系统未开启邮件功能</li>"
end if
if l_id="" then 
errornum=1
errormsg=errormsg&"<li>很抱歉，你没有选择论坛,请从论坛首页正确登陆</li>"
 end if
 if t_id="" then 
errornum=1
errormsg=errormsg&"<li>很抱歉，你没有选择主题帖,请从论坛首页正确登陆</li>"
 end if
 if errornum=1 then
call toptitle(l_title,cpbtitle)
call head(4,"论坛信息",Request.ServerVariables("HTTP_REFERER"),cpbtitle)
 call error(errormsg)
call bq()
response.end
end if

sql_topic= "select t_title from topic where t_id="&t_id&""
set rs_topic=conn.Execute (sql_topic) 
if  rs_topic.eof then
errornum=1
errormsg=errormsg&"<li>很抱歉，此帖已经不存在，可能已经被删除,如果有什么问题，请跟管理员联系</li>"
call toptitle(l_title,cpbtitle)
call error(errormsg)
call bq()
response.end
end if

sql_lanmu= "select l_title from lanmu where l_id="&l_id&""
set rs_lanmu=conn.Execute (sql_lanmu)
 ltitle=rs_lanmu("l_title")
 set rs_lanmu=nothing
 select case chktopic(request("action"))
 case "email"
 call email
 case "do1"
 call do1
  case "do2"
 call do2
 case else
 call show
 end select
 sub do1()
cpbtitle="推荐主题;"&rs_topic("t_title")
call toptitle(l_title,cpbtitle)
call head(3,"论坛信息",Request.ServerVariables("HTTP_REFERER"),cpbtitle)
tmpt = "http://" & request.servervariables("SERVER_NAME") & _            
               left(request.servervariables("SCRIPT_NAME"),len(request.servervariables("SCRIPT_NAME"))-len("sendpage.asp"))
myusername=chktopic(trim(request("myusername")))
yourusername=chktopic(trim(request("yourusername")))
youremail=chktopic(trim(request("youremail")))
yourcontent=chktopic(trim(request("yourcontent")))
t_title=chktopic(trim(request("t_title")))
if myusername="" then
errornum=1
errormsg=errormsg&"<li>您的姓名不能为空</li>"
end if
if yourusername="" then
errornum=1
errormsg=errormsg&"<li>您的朋友的姓名不能为空</li>"
end if
if youremail="" then
errornum=1
errormsg=errormsg&"<li>您朋友的email不能为空</li>"
end if
email1=Split(youremail, "@")
if ubound(email1) <>1 then
errornum=1
errormsg=errormsg&"<li>email格式不对</li>"
else
email1=Split(youremail, ".")
if ubound(email1) <1 then
errornum=1
errormsg=errormsg&"<li>email格式不对</li>"
end if
end if
if yourcontent="" then
errornum=1
errormsg=errormsg&"<li>邮件内容不能为空</li>"
end if
if errornum=1 then
call error(errormsg)
else

emailname=myusername
emailto=youremail
emailtopic="您的朋友给您推荐的主题"   
   emailbody=""&vbCrlf&"亲爱的"&yourusername&", 您好!"
   emailbody=emailbody & ""&vbCrlf&""&vbCrlf&"您的朋友"&myusername&"在"&l_title&"给您推荐了一篇主题:"&t_title&"，请前去看看"&vbCrlf&"地址："&tmpt&"topic.asp?l_id="&l_id&"&t_id="&t_id&""&vbCrlf&""
   emailbody=emailbody & "付上他（她）对您的话语："&yourcontent
   emailbody=emailbody &""&vbCrlf&"本论坛地址："&l_urlf
   emailbody=emailbody & ""&vbCrlf&""&vbCrlf&"dxxo论坛制作(http://down.dxxo.com)"&vbCrlf&"程序制作：down.dxxo.com(飞越)"&vbCrlf&""&vbCrlf&""


%>
   
<!-- #include file="email.asp" -->
	<%if SendMail="OK" then
		sendmsg=sendmsg&"<li>您的信息已经发往您的朋友的邮箱</li>"
	else
		sendmsg=sendmsg&"<li>很抱歉，由于系统错误，邮件发送失败</li>"
	end if
	


 succmsg="<li>发送结果</li>"&sendmsg&"<Li><a href=list.asp?l_id="&l_id&">返回前论坛</a></li><li><a href=topic.asp?l_id="&l_id&"&t_id="&t_id&">返回前主题</a><li>3秒钟后将自动返回前主题</li><script language=javascript>setTimeout(""location.replace('topic.asp?l_id="&l_id&"&t_id="&t_id&"')"",3000)</script>"
call succ(succmsg)
end if
end sub


 sub do2()
cpbtitle="打包邮递主题;"&rs_topic("t_title")
call toptitle(l_title,cpbtitle)
call head(3,"论坛信息",Request.ServerVariables("HTTP_REFERER"),cpbtitle)
tmpt = "http://" & request.servervariables("SERVER_NAME") & _            
               left(request.servervariables("SCRIPT_NAME"),len(request.servervariables("SCRIPT_NAME"))-len("sendpage.asp"))


youremail=chktopic(trim(request("youremail")))
if youremail="" then
errornum=1
errormsg=errormsg&"<li>邮递EMAIL不能为空</li>"
end if
email1=Split(youremail, "@")
if ubound(email1) <>1 then
errornum=1
errormsg=errormsg&"<li>email格式不对</li>"
else
email1=Split(youremail, ".")
if ubound(email1) <1 then
errornum=1
errormsg=errormsg&"<li>email格式不对</li>"
end if
end if

if errornum=1 then
call error(errormsg)
else
emailname=cpbusername
emailto=youremail
emailtopic="打包邮递主题;"&rs_topic("t_title")  
  emailbody=emailbody &"<style type=""text/css"">"
  emailbody=emailbody &".tdc {  font-family: ""宋体""; font-size: 9pt; color: "&tdc&"}"
  emailbody=emailbody &"</style>"
   emailbody=emailbody &"<title>"&l_title&"-"&rs_topic("t_title")&"</title>"
   emailbody=emailbody &""&vbCrlf&" <span class=tdc>您好!"
   emailbody=emailbody & ""&vbCrlf&""&vbCrlf&"这是"&cpbusername&"在"&l_title&"打包的主题:"&t_title&"，您可以去此"&vbCrlf&"地址："&tmpt&"topic.asp?l_id="&l_id&"&t_id="&t_id&"浏览"&vbCrlf&"内容如下：</span>"   
    isbanzhu=false
	sql="select l_password,l_access,l_banzhu from lanmu where l_id="&l_id&""
	set rs=conn.execute(sql)
	if not rs.eof then
	l_banzhu=rs("l_banzhu")
	if issupermaster=false and ismaster=false then
	if not isnull(l_banzhu) and l_banzhu<>"" and isuser and isbordermaster then
    if instr(l_banzhu,cpbusername)>0 then
 isbanzhu=true'获得斑竹的身份
  end if
  end if
	'此段检查是否为加密区
	if isbanzhu=false then
	if rs("l_password")<>""  and session("fy_lpassword")<>rs("l_password") then response.redirect"login.asp?action=password&l_id="&l_id&""
if rs("l_access")=2 and  isbordermaster=false then
errornum=1
errormsg="<Li>很抱歉，您没有权限进入,只有版主和总版主才可以进入！</li>"
elseif rs("l_access")=1 and isuser=false then
errornum=1
errormsg="<Li>很抱歉，您没有权限进入,只有注册用户才可以进入！</Li>"

elseif rs("l_access")=4 and isvipuser=false and isbordermaster=false then
errornum=1
errormsg="<Li>很抱歉，您没有权限进入,只有认证用户才可以进入！</Li>"
end if

end if

end if

else
errornum=1
errormsg="<Li>很抱歉，无此论坛！</Li>"
end if
set rs=nothing
  if t_id="" then 
errornum=1
errormsg=errormsg&"<li>很抱歉，您没有选择主题帖,请从论坛首页正确登陆</li>"
 end if
  if errornum<> 1 then
sqllanmu="select l_access,l_title,l_id,l_lockuser from lanmu where l_id="&l_id&""
set rslanmu=conn.execute(sqllanmu) 
sql_topic= "select t_buysend,t_lock,t_title,t_content,t_time,t_lastedit,t_username,t_autourl,t_lockubb from topic where t_id="&trim(t_id)&""
set rs_topic=conn.Execute (sql_topic)