<% SiteSettings=Conn.Execute("[BBSXP_SiteSettings]") CookieUserName=HTMLEncode(unescape(Request.Cookies("UserName"))) if ""&SiteSettings("nowdate")&""<>""&date()&"" then Conn.execute("update [BBSXP_SiteSettings] set Nowdate='"&date()&"'") Conn.execute("update [BBSXP_Statistics_Site] set TodayPost=0") Conn.execute("update [BBSXP_Forums] set ForumToday=0") end if dim toptrue,ForumsList,ForumTreeList,TotalPage,PageCount,RankName,RankIconUrl ii=0 startime=timer() Set rs = Server.CreateObject("ADODB.Recordset") Server.ScriptTimeout=SiteSettings("Timeout")'设置脚本超时时间 单位:秒 function HTMLEncode(fString) fString=Replace(fString,";",";") fString=Replace(fString,"<","<") fString=Replace(fString,">",">") fString=Replace(fString,"\","\") fString=Replace(fString,"--","--") fString=Replace(fString,CHR(9)," ") fString=Replace(fString,CHR(10),"
") fString=Replace(fString,CHR(13),"") fString=Replace(fString,CHR(22),"") fString=Replace(fString,CHR(32)," ") fString=Replace(fString,CHR(34),""")'双引号 fString=Replace(fString,CHR(39),"'")'单引号 fString=ReplaceText(fString,"&#([0-9]*);","&#$1;") '解决韩文字符问题 if IsSqlDataBase=0 then '过滤片假名(日文字符)[\u30A0-\u30FF] by yuzi首创 fString=escape(fString) fString=ReplaceText(fString,"%u30([A-F][0-F])","0$1;") fString=unescape(fString) end if HTMLEncode=fString end function ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' function ContentEncode(fString) fString=Replace(fString,vbCrlf, "") fString=Replace(fString,"\","\") fString=Replace(fString,"'","'") fString=Replace(fString,""" then fString=ReplaceText(fString,"<(\/|)("&SiteSettings("BannedHtmlLabel")&")", "<$1$2") if SiteSettings("BannedHtmlEvent")<>"" then fString=ReplaceText(fString,"<(.[^>]*)("&SiteSettings("BannedHtmlEvent")&")", "<$1$2") if SiteSettings("BannedText")<>"" then filtrate=split(SiteSettings("BannedText"),"|") for i = 0 to ubound(filtrate) fString=ReplaceText(fString,""&filtrate(i)&"",string(len(filtrate(i)),"*")) next end if contentEncode=fString end function ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Function YbbEncode(str) str=ReplaceText(str,"\[(\/|)(b|i|u|strike|center|marquee)\]","<$1$2>") str=ReplaceText(str,"\[COLOR=([^[]*)\]","") str=ReplaceText(str,"\[FONT=([^[]*)\]","") str=ReplaceText(str,"\[SIZE=([0-9]*)\]","") str=ReplaceText(str,"\[\/(SIZE|FONT|COLOR)\]","") str=ReplaceText(str,"\[URL\]([^[]*)","$1") str=ReplaceText(str,"\[URL=([^[]*)\]","") str=ReplaceText(str,"\[\/URL\]","") str=ReplaceText(str,"\[EMAIL\](\S+\@[^[]*)(\[\/EMAIL\])","$1") str=ReplaceText(str,"\[IMG\]([^"&CHR(34)&"[]*)(\[\/IMG\])","") str=ReplaceText(str,"\[quote\]","
") str=ReplaceText(str,"\[quote user="&CHR(34)&"([^[]*)"&CHR(34)&"\]","
$1:
") str=ReplaceText(str,"\[\/quote\]","
") YbbEncode=str End Function ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Function IsObjInstalled(strClassString) On Error Resume Next IsObjInstalled = False Set xTestObj = Server.CreateObject(strClassString) If 0 = Err Then IsObjInstalled = True Set xTestObj = Nothing On Error GoTo 0 End Function ''''''''''''''''''''''''''''''''''''''''''' Function DelFile(DelFilePath) On Error Resume Next DelFile= False set MyFileObject=Server.CreateOBject("Scripting.FileSystemObject") MyFileObject.DeleteFile""&Server.MapPath(""&DelFilePath&"")&"" Set MyFileObject= Nothing If 0 = Err or 53 = Err Then DelFile= True else error2(""&DelFilePath&"\n文件无法删除!") end if On Error GoTo 0 End Function ''''''''''''''''''''''''''''''''''''''''''' Function CheckPOST if Request.ServerVariables("request_method") <> "POST" then response.write "
" Response.End end if End Function ''''''''''''''''''''''''''''''''''''''''''' Function ResponseCookies(Key,Value,Expires) DomainPath=Left(Request.ServerVariables("script_name"),inStrRev(Request.ServerVariables("script_name"),"/")) Response.Cookies(Key)=""&Value&"" if Expires<>0 then Response.Cookies(Key).Expires=date+Expires Response.Cookies(Key).Path = DomainPath End Function ''''''''''''''''''''''''''''''''''''''''''' Function CleanCookies() DomainPath=Left(Request.ServerVariables("script_name"),inStrRev(Request.ServerVariables("script_name"),"/")) For Each objCookie In Request.Cookies Response.Cookies(objCookie)= "" Response.Cookies(objCookie).Path = DomainPath Next End Function ''''''''''''''''''''''''''''''''''''''''''' Function CheckSize(ByteSize) if ByteSize=>1024000000 then ByteSize=formatnumber(ByteSize/1024000000)&" GB" elseif ByteSize=>1024000 then ByteSize=formatnumber(ByteSize/1024000)&" MB" elseif ByteSize=>1024 then ByteSize=formatnumber(ByteSize/1024)&" KB" else ByteSize=ByteSize&" 字节" end if CheckSize=ByteSize End Function ''''''''''''''''''''''''''''''''''''''''''' Function ShowRole(RoleID) if RoleID=1 then RoleID="管理员" elseif RoleID=2 then RoleID="超级版主" elseif RoleID=3 then RoleID="注册会员" else RoleID=Conn.Execute("Select Name From [BBSXP_Roles] where ID="&RoleID&"")(0) end if ShowRole=RoleID End Function ''''''''''''''''''''''''''''''''''''''''''' sub ShowRank(experience) sql="Select top 1 * From [BBSXP_Ranks] where PostingCountMin<="&experience&" order by PostingCountMin Desc" Set UserRank=Conn.Execute(sql) if UserRank.eof then RankName="未知等级" RankIconUrl="images/level/0.gif" else RankName=UserRank("RankName") RankIconUrl=UserRank("RankIconUrl") end if Set UserRank = Nothing end sub ''''''''''''''''''''''''''''''''''''''''''' function Zodiac(birthday) if IsDate(birthday) then birthyear=year(birthday) ZodiacList=array("猴","鸡","狗","猪","鼠","牛","虎","兔","龙","蛇","马","羊") Zodiac=ZodiacList(birthyear mod 12) end if end function ''''''''''''''''''''''''''''''''''''''''''' function constellation(birthday) if IsDate(birthday) then ConstellationMon=month(birthday) ConstellationDay=day(birthday) if Len(ConstellationMon)<2 then ConstellationMon="0"&ConstellationMon if Len(ConstellationDay)<2 then ConstellationDay="0"&ConstellationDay MyConstellation=ConstellationMon&ConstellationDay if MyConstellation < 0120 then constellation="" elseif MyConstellation < 0219 then constellation="" elseif MyConstellation < 0321 then constellation="" elseif MyConstellation < 0420 then constellation="" elseif MyConstellation < 0521 then constellation="" elseif MyConstellation < 0622 then constellation="" elseif MyConstellation < 0723 then constellation="" elseif MyConstellation < 0823 then constellation="" elseif MyConstellation < 0923 then constellation="" elseif MyConstellation < 1024 then constellation="" elseif MyConstellation < 1122 then constellation="" elseif MyConstellation < 1222 then constellation="" elseif MyConstellation > 1221 then constellation="" end if end if end function function closeall conn.close set rs=nothing set rs1=nothing set conn=nothing set SiteSettings = Nothing response.End() end function '帐号验证 UserName=HTMLEncode(Request("UserName")) Userpass=md5(Trim(Request("Userpass"))) if UserName=empty then response.Write("[err]用户名没有输入[/err]") closeall end if sql="select * from [BBSXP_Users] where UserName='"&UserName&"'" Set Rs=Conn.Execute(SQL) if Rs.eof then response.Write("[err]此用户名还未注册[/err]") closeall end if if Rs("UserAccountStatus")=0 then response.Write("[err]您的帐号尚未激活[/err]") closeall end if if Len(Rs("Userpass"))<16 then if Request("Userpass")<>Rs("Userpass") then response.Write("[err]您输入的密码错误[/err]") closeall end if Conn.execute("update [BBSXP_Users] set Userpass='"&Userpass&"' where UserName='"&UserName&"'") elseif Len(Rs("Userpass"))=16 then mdfive=16 if md5(Request("UserPass"))<>Rs("UserPass") then response.Write("[err]您输入的密码错误[/err]") closeall end if Conn.execute("update [BBSXP_Users] set Userpass='"&Userpass&"' where UserName='"&UserName&"'") else if UserPass<>Rs("UserPass") then response.Write("[err]您输入的密码错误[/err]") closeall end if end if UserID=Rs("ID") if Request("IsSave")=1 then Expires=9999 else Expires=0 end if if Request("Eremite")="1" then Eremite="1" else Eremite="0" end if ResponseCookies"UserID",Rs("ID"),Expires ResponseCookies"UserPass",UserPass,Expires ResponseCookies"Eremite",Eremite,Expires ForumID=int(Request("ForumID")) VoteExpiry=int(Request("VoteExpiry")) sql="select * from [BBSXP_Forums] where id="&ForumID&"" Set Rs=Conn.Execute(sql) if Rs.Eof then response.Write("[err]没有该版块[/err]") closeall end if ForumName=Rs("ForumName") ForumLogo=Rs("ForumLogo") Moderated=Rs("Moderated") FollowID=Rs("FollowID") TolSpecialTopic=Rs("TolSpecialTopic") IsModerated=Rs("IsModerated") Rs.close if SiteSettings("sortshowforum")=0 then If Not Conn.Execute("Select ID From [BBSXP_Forums] where FollowID="&ForumID&"" ).eof Then response.Write("[err]类别不能发帖[/err]") closeall end if end if color=HTMLEncode(Request("color")) icon=Request.Form("icon") Subject=HTMLEncode(Request("Subject")) Category=HTMLEncode(Request("Category")) Content=ContentEncode(Request("Content")) if Request("DisableYBBCode")<>1 then Content=YbbEncode(Content) if Len(Subject)<2 then Message=Message&"
  • 文章主题不能小于 2 字符" if Len(content)<2 then Message=Message&"
  • 文章内容不能小于 2 字符" if SiteSettings("BannedText")<>empty then filtrate=split(SiteSettings("BannedText"),"|") for i = 0 to ubound(filtrate) Subject=ReplaceText(Subject,""&filtrate(i)&"",string(len(filtrate(i)),"*")) next end if ''''''''''''''''''''''''''''''' if Message<>"" then response.Write("[err]"&Message&"[/err]") closeall end if sql="select * from [BBSXP_Users] where ID="&UserID&"" Rs.Open sql,Conn,1,3 if SiteSettings("DuplicatePostIntervalInMinutes") > 0 then StopPostTime=int(DateDiff("s",Rs("UserLandTime"),Now())) if StopPostTime < int(SiteSettings("DuplicatePostIntervalInMinutes")) then Message=Message&"
  • 论坛限制一个人两次发帖间隔必须大于 "&SiteSettings("DuplicatePostIntervalInMinutes")&" 秒!
  • 您必须再等待 "&SiteSettings("DuplicatePostIntervalInMinutes")-StopPostTime&" 秒!" end if 'if SiteSettings("RegUserTimePost") > 0 then ' StopPostTime=int(DateDiff("s",Rs("UserRegTime"),Now())) ' if StopPostTime < int(SiteSettings("RegUserTimePost")) then Message=Message&"
  • 新注册用户必须等待 "&SiteSettings("RegUserTimePost")&" 秒后才能发帖!
  • 您必须再等待 "&SiteSettings("RegUserTimePost")-StopPostTime&" 秒!" 'end if if Message<>"" then response.Write("[err]"&Message&"[/err]") closeall end if Rs("PostTopic")=Rs("PostTopic")+1 Rs("UserMoney")=Rs("UserMoney")+SiteSettings("IntegralAddThread") Rs("experience")=Rs("experience")+SiteSettings("IntegralAddThread") Rs("UserLandTime")=now() Rs("UserLastIP")=Request.ServerVariables("REMOTE_ADDR") Rs.update Rs.close Rs.Open "select * from [BBSXP_Threads]",Conn,1,3 Rs.addNew Rs("UserName")=UserName Rs("PostTime")=now() Rs("lastname")=UserName Rs("lasttime")=now() Rs("Topic")=Subject Rs("ForumID")=ForumID Rs("SpecialTopic")=Category if Request("icon")<>"" then Rs("icon")=icon if Request("Vote")<>"" then Rs("isVote")=1 if Request("IsLocked")=1 then Rs("IsLocked")=1 if IsModerated=1 then Rs("IsDel")=1 Rs.update ID=Rs("ID") PostsTableName=Rs("PostsTableName") Rs.close 'if Request.Form("Vote")<>"" then 'Conn.Execute("insert into [BBSXP_Vote] (ThreadID,Type,Items,Result,Expiry) values ('"&ID&"','"&int(Request.Form("multiplicity"))&"','"&HTMLEncode(allpollTopic)&"','"&Votenum&"','"&now()+VoteExpiry&"')") 'end if 'if Request.Form("UpFileID")<>"" then 'UpFileID=split(Request.form("UpFileID"),",") 'for i = 0 to ubound(UpFileID)-1 'Conn.execute("update [BBSXP_UpFiles] set Category='"&Category&"',Description='"&Subject&"' where id="&int(UpFileID(i))&" and UserName='"&CookieUserName&"'") 'next 'end if Conn.Execute("insert into [BBSXP_Posts"&PostsTableName&"] (ThreadID,IsTopic,UserName,Subject,content,Postip) values ('"&ID&"','1','"&UserName&"','"&Subject&"','"&content&"','"&Request.ServerVariables("REMOTE_ADDR")&"')") Conn.execute("update [BBSXP_Forums] set lastTopic='"&Left(HTMLEncode(Request("Subject")),15)&"',lastname='"&UserName&"',lasttime="&SqlNowString&",ForumToday=ForumToday+1,ForumThreads=ForumThreads+1,ForumPosts=ForumPosts+1 where id="&ForumID&" or ID="&FollowID&"") Conn.execute("update [BBSXP_SiteSettings] set DaysPosts=DaysPosts+1,DaysTopics=DaysTopics+1,TotalPosts=TotalPosts+1,TotalTopics=TotalTopics+1") if Request.Form("IsAddBlog")=1 then Conn.Execute("insert into [BBSXP_Blogs] (Subject,Content,UserName,Category,BlogDate) values ('"&Subject&"','"&content&"','"&UserName&"','"&Category&"','"&year(now)&"-"&month(now)&"')") Session("VerifyCode")="" 'Application("LastPost")=Request.Form 'if IsModerated=1 then 'EnableCensorship="由于论坛设有审查制度,您发表的帖子需要等待激活才能显示。" 'else 'EnableCensorship="返回主题" 'end if 'Message="
  • 新主题发表成功
  • "&EnableCensorship&"
  • 返回论坛
  • 返回论坛首页" 'succeed(""&Message&"") response.Write("1") closeall %>