📄 clsmain.asp
字号:
End Function
Public Sub LoadTemps()
Dim Openclock,Nexhour
If team.Forum_setting(106) = 1 Then
If Request.ServerVariables("HTTP_X_FORWARDED_FOR")>"" then CloseForum = 1
End if
'定时关闭
If Forum_setting(56)=1 Then
Openclock=Split(Forum_setting(0),"*")
Nexhour=Hour(Now())
If Openclock(nexhour)=0 Then CloseForum = 1
Else
CloseForum = Forum_setting(2)
End If
If CloseForum=1 and Not IsMaster Then
Response.Redirect "Club.asp?message=论坛维护中!"
End If
'IP锁定
If Request.Cookies(Forum_sn & "Kill")("kill") = "1" Then
If Not (SuperMaster Or IsMaster) Then Response.Redirect "Close.asp?action=ipclose"
ElseIf Not Request.Cookies(Forum_sn & "Kill")("kill") = "0" Then
Call LockIP()
If Request.Cookies(Forum_sn & "Kill")("kill") = "1" Then
If Not (SuperMaster Or IsMaster) Then Response.Redirect "Close.asp?action=ipclose"
End If
End If
'载入模板
SkinID = INT(team.Forum_setting(18))
If SkinKey > 0 Then
SkinID = SkinKey
End if
If HRf(2,2,"styleid") > 0 Then
Response.Cookies("Style")("skins") = HRf(2,2,"styleid")
End If
If CID(Request.Cookies("Style")("skins")) > 0 Then
SkinID = Request.Cookies("Style")("skins")
End If
LoadTemplates(SkinID)
End Sub
Public Sub Headers(s)
LoadTemps()
Dim TempStr
'搜索引擎优化部分,请勿擅自取消
TempStr = Replace(IndexHtml(0),"{$keywords}",Forum_setting(30))
TempStr = Replace(TempStr,"{$description}",Forum_setting(31))
TempStr = Replace(TempStr,"{$metainfo}",Club_Class(26))
If IsWebSearch Then
TempStr = Replace(TempStr,"{$TitleShow}",s & " | " & Forum_setting(66) &" | Power By Team Board")
TempStr = TempStr & "<a href=""http://www.team5.cn"" title=""论坛,bbs,免费论坛,技术,学习,博客,asp,asp.net,电脑,软件,灌水,防火墙,开发,插件"">TEAM官方论坛</a>"
Else
TempStr = Replace(TempStr,"{$TitleShow}",s & " | " & Forum_setting(66) )
End If
'搜索引擎优化结束
TempStr = TempStr & IndexHtml(1)
TempStr = Replace(TempStr,"{$clubname}",Club_Class(1))
If Not UserLoginED then
TempStr = Replace(TempStr,"{$isguest}","")
TempStr = Replace(TempStr,"{$isuser}","None")
Else
TempStr = Replace(TempStr,"{$isguest}","None")
TempStr = Replace(TempStr,"{$isuser}","")
End If
TempStr = Replace(TempStr,"{$Eremite}",iif(Request.Cookies("online")("Eremite")="1","<a href=""Login.asp?menu=eremite&upline=0"">上线</a>","<a href=""Login.asp?menu=eremite&upline=1"" class=""menuhref"">隐身</a>"))
TempStr = Replace(TempStr,"{$TK_UserName}",TK_UserName)
TempStr = Replace(TempStr,"{$skinsmenu}",iif(team.Forum_setting(28)=1,UserStyle(),""))'风格菜单
TempStr = Replace(TempStr,"{$teammenu}",iif(team.Forum_setting(92)=1,UserMenu(),""))'自添加菜单
Dim Menu_1
If IsMaster Or SuperMaster Then
Menu_1 = "<div class=menuitems><a href=admin.asp target=_top>后台管理</a></div>"
End If
If BoardMaster Or IsMaster Or SuperMaster Then
Menu_1 = Menu_1 & "<div class=menuitems><a href=BoradServer.asp target=_top>前台管理</a></div>"
End if
TempStr = Replace(TempStr,"{$mastermenu}",iif(IsMaster Or SuperMaster Or BoardMaster," - <a onmouseover="&Chr(34)&"showmenu(event,'"& Menu_1 &"')"&Chr(34)&" style=cursor:default>管理</a>",""))'菜单
TempStr = Replace(TempStr,"{$forumlock}",iif(CloseForum=1,"SERVER: <font color=RED>OFF</font>",""))
TempStr= Replace(TempStr,"{$message}",TeamNewMsg)
Dim Advtmp,i,topAdvs,ShowAdv,p
Advtmp = ForumAdvs()
TempStr = Replace(TempStr,"{$banner}",AdvShows(1))
If IsArray(Advtmp) Then
topAdvs = "":p = 0
topAdvs = "<div class=""a4""><br><table border=""0"" cellspacing=""1"" cellpadding=""3"" width=""98%"" align=""center"" class=""a2""><tr class=""tab4"">"
For i = 0 To Ubound(Advtmp,2)
If (Advtmp(2,i)="all" or Advtmp(2,i)="index") and CID(Advtmp(0,i)) = 1 and CID(Advtmp(1,i)) = 3 Then
If Advtmp(3,i) <>"" Then
If DateDiff("d",CDate(Advtmp(3,i)),Date())<0 Then Advtmp(5,i) = ""
End if
If Advtmp(4,i) <>"" Then
If DateDiff("d",CDate(Advtmp(4,i)),Date())>0 Then Advtmp(5,i) = ""
End if
If Advtmp(5,i)<>"" Then
p = p+1
topAdvs = topAdvs & "<td>"& Advtmp(5,i) &"</td>"
if p = 5 Then
topAdvs = topAdvs & "</tr><tr class=""tab4"">":p=0
End if
End if
End if
Next
topAdvs = topAdvs & "</table><br></div>"
End if
TempStr = Replace(TempStr,"{$bannerall}",topAdvs)
Echo TempStr
End Sub
'论坛尾部
Public sub Footer
Dim Temp,MSCode
If IsSqlDataBase = 1 Then
MSCode="SQL"
Else
MSCode="ACC"
End If
Temp = Replace(IndexHtml(9),"{$Foruminfo}","<a target=_blank href=http://www.team5.cn><b>"&team.Forum_setting(8)&"</b></a> - ")
Temp = Replace(Temp,"{$edition}","<a href=Licence.asp><b style='color:#FF9900'>"&MSCode&"</b></a>")
Temp = Replace(Temp,"{$runtime}",iif(team.Forum_setting(37)=1,"Processed in " & FormatNumber((Timer()-StarTime)*1000,2,-1) & " ms, " &SqlQueryNum& " queries",""))
Temp = Replace(Temp,"{$TimeZone}",Forum_setting(12))
Temp = Replace(Temp,"{$Nowdata}",Now())
Temp = Replace(Temp,"{$clubname}",Club_Class(3))
Temp = Replace(Temp,"{$cluburl}",Club_Class(4))
Temp = Replace(Temp,"{$regkey}","<A href=""http://www.miibeian.gov.cn/"">"& Forum_setting(59) &"</a>")
Temp = Replace(Temp,"{$adcode}",AdvShows(2))
Echo Temp
Htmlend
End Sub
'风格选择菜单
Private Function UserStyle()
Dim value,tmp,i,temp,rs
Cache.Reloadtime = Cid(Forum_setting(44))
Cache.Name = "TemplatesLoad"
If Cache.ObjIsEmpty() Then
Set Rs=Execute("Select StyleName,ID From ["&Isforum&"Style] order by ID Desc")
If RS.Eof Then
Exit Function
Else
Cache.Value = Rs.GetRows(-1)
End If
RS.Close:Set RS=Nothing
End If
value = Cache.Value
If Instr(ActUrl,"?")>0 Then
ActUrl = ActUrl & "&"
Else
ActUrl = ActUrl & "?"
End if
ActUrl = Replace(ActUrl,"?&","?")
For i=0 To Ubound(value,2)
Tmp = Tmp & "<div class=menuitems><a href="& ActUrl &"styleid="&value(1,i)&">"&value(0,i)&"</a></div>"
Next
temp = " - <a onmouseover="&Chr(34)&"showmenu(event,'"&tmp&"')"&Chr(34)&">风格</a> "
UserStyle = temp
End Function
Public Function ForumAdvs()
Dim SQL,RS,tmp
Cache.Reloadtime = Cid(Forum_setting(44))
Cache.Name = "ForumAdvsLoad"
If Cache.ObjIsEmpty() Then
Set Rs=Execute("Select Dois,Types,Boards,StarTime,StopTime,bodys From ["&Isforum&"AdvList] order by Sorts Desc")
If RS.Eof Then
Exit Function
Else
Cache.Value = Rs.GetRows(-1)
End If
RS.Close:Set RS=Nothing
End If
ForumAdvs = Cache.Value
End Function
Private Function LoadUserMenu()
Dim Rs
Cache.Reloadtime = Cid(Forum_setting(44))
Cache.Name = "MenuLoad"
If team.Forum_setting(92)= 0 Then Exit Function
If Cache.ObjIsEmpty() Then
Set Rs=Execute("Select ID,Name,Url,Followid From ["&Isforum&"Menu] Where newtype = 1 order by SortNum Desc")
If RS.Eof Then
Exit Function
Else
Cache.Value = Rs.GetRows(-1)
End If
RS.Close:Set RS=Nothing
End If
LoadUserMenu = Cache.Value
End Function
Private Function UserMenu()
Dim Selectby,Mymenu,MenuTemp,i
MenuTemp = LoadUserMenu
If IsArray(MenuTemp) Then
For i=0 To Ubound(MenuTemp,2)
If MenuTemp(3,i) = 0 Then
Mymenu = Mymenu & " - <a onmouseover="&Chr(34)&"showmenu(event,'"& MiniMenu(MenuTemp(0,i)) &"')"&Chr(34)&" style=""cursor:default""> "&MenuTemp(1,i)&"</a> "
End if
Next
End If
UserMenu = Mymenu
End Function
Public Function MiniMenu(a)
Dim Selectby,MenuTemp,i
Menutemp = LoadUserMenu
If IsArray(MenuTemp) Then
For i=0 To Ubound(MenuTemp,2)
If Menutemp(3,i) = a Then
Selectby=Selectby & "<div class=menuitems><a href="&MenuTemp(2,i)&">"&MenuTemp(1,i)&"</a></div>"
End if
Next
End If
MiniMenu = Selectby
End Function
REM 版主
Public Function GroupManages()
Dim Rs,Moderuser,tmp
Cache.Reloadtime = Cid(Forum_setting(44))
Cache.Name = "ManageUsers"
If Cache.ObjIsEmpty() Then
Set Rs=team.execute("Select ID,ManageUser,BoardID from ["&isforum&"Moderators] ")
If RS.Eof Then
Exit Function
Else
Cache.Value = Rs.GetRows(-1)
End If
Rs.Close:Set Rs=Nothing
End If
GroupManages = Cache.Value
End Function
REM 生日
Public Function TodBds()
Dim Rs,mans,tmp,i
If Application(CacheName&"_Nobady") = 1 Then
Exit Function
End if
Cache.Reloadtime = Cid(Forum_setting(44))
Cache.Name = "UserBirthdays"
If Cache.ObjIsEmpty() Then
Set Rs=team.Execute("Select UserName,Birthday From ["&IsForum&"User]")
If RS.Eof Then
LockCache "Nobady",1
Exit Function
Else
Cache.Value = Rs.GetRows(-1)
End If
Rs.Close:Set Rs=Nothing
End If
tmp = Cache.Value
Mans = ""
If Isarray(tmp) Then
for i = 0 to ubound(tmp,2)
If IsDate(tmp(1,i)) Then
If DateDiff("d",CDate(tmp(1,i)),Date()) = 0 Then
If Mans = "" Then
Mans = "<a href=""Profile.asp?username="& tmp(0,i) &""" target=""_blank""> "& tmp(0,i) &"</a> "
Else
Mans = Mans & " , <a href=""Profile.asp?username="& tmp(0,i) &""" target=""_blank""> "& tmp(0,i) &"</a> "
End if
End If
End if
Next
End if
TodBds = Mans
End Function
Public Function BoardList()
Dim Rs,Moderuser
Cache.Reloadtime = Cid(Forum_setting(44))
Cache.Name = "BoardLists"
If Cache.ObjIsEmpty() Then
Set Rs=team.Execute("Select ID,bbsname,Board_Model,Followid,Readme,today,toltopic,tolrestore,icon,Board_Last,Pass,Board_URL From ["&IsForum&"Bbsconfig] Where Hide=0 Order By SortNum")
If RS.Eof Then
Exit Function
Else
Cache.Value = Rs.GetRows(-1)
End If
Rs.Close:Set Rs=Nothing
End If
BoardList = Cache.Value
End Function
Public Function ForumList_tips(a)
Dim Rs,Moderuser,tmp,Bbstmp,i,LastPost
Dim CheckMaster,Moder1,Moder2,u
Dim Tmpid,j,Chcheid,R
Bbstmp = BoardList
If Isarray(Bbstmp) Then
tmp = "" : R=0
For i=0 to Ubound(Bbstmp,2)
If Bbstmp(3,i) = a Then
R = R+1
If Bbstmp(2,i) = 0 Then
tmp = tmp & IndexHtml (5)
Else
tmp = tmp & IndexHtml (6)
tmp = Replace(tmp,"{$tr}",iif(R = 1,"<tr class=""tab4"">",""))
If R >= Int(Forum_setting(32)) Then
tmp = Replace(tmp,"{$trend}","</tr>")
R = 0
Else
tmp = Replace(tmp,"{$trend}","")
End if
End If
'ID=0,bbsname=1,Board_Model=2,Followid=3,Readme=4,today=5,toltopic=6,tolrestore=7,icon=8,Board_Last=9,Pass=10,Board_URL=11
tmp = Replace(tmp,"{$boardurl}",IIF(Bbstmp(11,i)&""="","Forums.asp?fid="&Bbstmp(0,i)&"",Bbstmp(11,i)))
tmp = Replace(tmp,"{$today}",Iif(Bbstmp(5,i)>0,"Board0.gif","Board1.gif"))
tmp = Replace(tmp,"{$bbsname}",Bbstmp(1,i))
tmp = Replace(tmp,"{$id}",Bbstmp(0,i))
tmp = Replace(tmp,"{$passlogin}",iif(Trim(Bbstmp(10,i))&""="",""," [<FONT COLOR=""#FF0000"">密码验证</FONT>] "))
tmp = Replace(tmp,"{$intro}","{$intro}{$chcheid}")
tmp = Replace(tmp,"{$intro}",Bbstmp(4,i)&"")
tmp = Replace(tmp,"{$icon1}",Iif(Bbstmp(8,i)&""="","","<img src="""&Bbstmp(8,i)&""" border=""0"" align=""absmiddle"">"))
tmp = Replace(tmp,"{$toltopic}",Bbstmp(6,i))
tmp = Replace(tmp,"{$tolrestore}",Bbstmp(7,i))
tmp = Replace(tmp,"{$todays}",Bbstmp(5,i))
LastPost = Split(Bbstmp(9,i),"$@$")
tmp = Replace(tmp,"{$toppass}","主题："& LastPost(0) &"<BR>作者：<a href=""Profile.asp?username="& LastPost(1) &""" target=""_blank""> "& LastPost(1) &"</a><BR>时间："& LastPost(2) )
CheckMaster = GroupManages()
Moder1 = "" : Moder2 = ""
tmp = Replace(tmp,"{$style_1}",IIf(Forum_setting(26)=0,"","none"))
tmp = Replace(tmp,"{$style_2}",IIf(Forum_setting(26)=0,"none",""))
If Isarray(CheckMaster) Then
For u=0 to Ubound(CheckMaster,2)
If CheckMaster(2,u) = Cid(Bbstmp(0,i)) Then
Moder1 = Moder1 &"<option> "&CheckMaster(1,u)&" </option>"
If Moder2 = "" Then
Moder2 = Moder2 &" <a href=Profile.asp?username="&CheckMaster(1,u)&">"&CheckMaster(1,u)&"</a> "
Else
Moder2 = Moder2 &", <a href=Profile.asp?username="&CheckMaster(1,u)&">"&CheckMaster(1,u)&"</a> "
End If
End If
Next
tmp = Replace(tmp,"{$moder1}",Moder1)
tmp = Replace(tmp,"{$moder2}",iif(Moder2&""="","空缺",Moder2))
Else
tmp = Replace(tmp,"{$moder2}","")
tmp = Replace(tmp,"{$moder1}","")
End if
Tmpid = ""
Chcheid = BoardList
If isarray(Chcheid) and CID(Forum_setting(27))=1 Then
For j=0 to Ubound(Chcheid,2)
If Cid(Bbstmp(0,i)) = Cid(Chcheid(3,j)) Then
Tmpid = Tmpid & "<A href=Forums.asp?fid="&Chcheid(0,j)&"> <U>"&Chcheid(1,j)&"</U> </a>"
End if
Next
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -