public_cls.asp

网趣系统时尚版8（支付宝）

	Public function CheckNum(str)
		If isnull(str) or str=""  then
		Str=0
		End If
		if not isnumeric(str) then Error("错误的地址栏参数，请不要手动去更改地址栏参数！")
		CheckNum=int(str)
	End function
	
	Public Sub GetOnline()
		Dim PicMood
		If Session(CacheName & "Stats") = Stats Then
			AllOnlineNum=Session(CacheName & "AllonlineNum")
			UserOnlineNum=Session(CacheName & "UserOnlineNum")
		Else
			Session(CacheName & "Stats")=Stats
			Dim UserSessionID
			UserSessionID=Request.Cookies("SessionID")("SID")
			If IsNumeric(UserSessionID)=0 or UserSessionID="" Then
				UserSessionID=Ccur(MySessionID)
				Response.Cookies("SessionID").Expires=date+1
				Response.Cookies("SessionID")("SID")=Ccur(MySessionID)
			Else
				UserSessionID=Ccur(UserSessionID)
			End If
			If FoundUser Then
				SQL = "Select Count(ID) From[YX_Online]Where Name='" & MyName & "' or ID=" & UserSessionID &" "
			Else
				SQL = "Select Count(ID) From[YX_Online]Where ID=" & UserSessionID &""
			End if
			Temp=Execute(SQL)(0)
			IF FoundUser Then
				If MyHidden=2 Then PicMood=0
				IF Temp >1 Then Execute("Delete * From[YX_online] where name='"&MyName&"'")
			End If
			If Temp < 1 Then
				SQL="Insert into [YX_Online](ID,ClassID,Name,OldTime,LastTime,Locate,Ip,BoardID,BoardUrl) values("&UserSessionID&","&ClassID&",'"& Myname &"','"& NowBbsTime &"','"&NowBbsTime&"','"& Stats &"','"& MyIp &"',"& BoardID &",'"&GetUrl()&"')"
			Else
				SQL="Update [YX_Online] set Name='"& Myname &"',ClassID='"&ClassID&"',LastTime='"&NowBbsTime&"',Locate='"&Stats&"',BoardID="&BoardID&",BoardUrl='"&GetUrl()&"',Ip='"& MyIp &"' where ID="&UserSessionID&""
			End If
			Execute(Sql)
			'全部在线用户
			AllOnlineNum=Execute("Select Count(ID) From[YX_online]")(0)
			'统计在线会员
			If BoardID=0 Then
				UserOnlineNum=Execute("Select Count(ID) From[YX_online] where ClassID<>6")(0)
			Else
				UserOnlineNum=Execute("Select Count(ID) From[YX_online] where ClassID<>6 And BoardID="&BoardID&"")(0)
			End If
			Session(CacheName & "AllOnlineNum")=AllOnlineNum
			Session(CacheName & "UserOnlineNum")=UserOnlineNum
			If Int(AllOnlineNum)>Int(MaxOnlineNum) then
				Execute ("update [YX_Config] Set MaxOnlineNum="&AllOnlineNum&",MaxOnlineTime='"&NowBbsTime&"'")
				Cache.name="Config"
				Cache.clean()
			End If
			Execute( "Delete FROM [YX_Online] WHERE DATEDIFF('s', LastTime,'"&NowBbsTime&"') > "&BBSSetting(27)*60&"") '分钟
		End If
	End Sub
	
	Public Sub MakeCookiesEmpty()
		Session(CacheName & "MyInfo") = Empty
		Response.Cookies(CookiesName)("MyID")=""
		Response.Cookies(CookiesName)("MyName")=""
		Response.Cookies(CookiesName)("MyPwd")=""
		Response.Cookies(CookiesName)("MyHidden")=""
		Response.Cookies(CookiesName)("CookiesData")=""
		Cache.Name="UserOnline"
		Cache.Clean()
	End Sub
	
	Public Function PageStats()
		Temp=Template.ReadTemplate("你的位置")
		Temp=Replace(Temp,"{位置}",Position)
		PageStats=Temp
	End Function
	
	Public Sub Head(Str)
		Dim i
		Temp = Template.ReadTemplate("页面属性")
		IF Str<>"" Then
			Position=Position&"&nbsp;<FONT face=Webdings>8</FONT>&nbsp;"& Str
Stats=Str
		End if
		Temp = Replace(Temp,"{页面标题}",BBSName&" --- "&Stats)
		Temp= Temp & Template.ReadTemplate("菜单属性")& vbNewLine &"<SCRIPT Src=Inc/Menu.js></SCRIPT>"
		Temp = Temp & vbNewLine & Template.ReadTemplate("页面头部")
		Temp = Replace(Temp,"{菜单}",MenuInfo)
		Response.Write Temp&vbNewLine &PageStats()
		GetOnline()
		HeadLoad=True
	End Sub
	
	
	Public Sub Footer()
		Temp=Template.ReadTemplate("页面底部")
		Temp=Replace(Temp,"{版权}","Powered By:<a href=""http://www.cnhww.com/"" target=""_blank""><font color=red>cnhww.com </font></a><br> "&getTimeOver(BBSSetting(33))&" 数据查询："&SqlNum&"次 <br>"&CopyRight&"")
		Response.Write Temp
	End Sub
	'插件菜单
	Public Function PlusMenu()
		Cache.Name="PlusMenu"
		If Cache.Valid then
			PlusMenu=Cache.Value
		Else
			Set Rs=YxBBs.Execute("Select Name,Url,Flag From [YX_Plus]")
			SqlNum=SqlNum+1
			Do while not Rs.eof
				PlusMenu=PlusMenu & "<div class=menuitems><a href="&Rs(1)&">"&Rs(0)&"</a></div>"
				Rs.MoveNext
			Loop
			PlusMenu=" ┆ <a onmouseover=""showmenu(event,'"&PlusMenu&"')"">设 施</a>"
			Rs.Close
			Cache.add PlusMenu,dateadd("n",2000,NowBBSTime)
		End If
	End Function
	'风格菜单
	Public Function SkinList()
		Dim Temp,Arr_Rs,i
 		Cache.Name="SkinList"
		If Cache.valid Then
			Arr_Rs=Cache.Value
		Else
			Set Rs=Execute("Select SkinID,SkinName From[YX_SkinStyle]")
			If Rs.Eof Or Rs.Bof Then
			Exit Function
			Else
			Arr_Rs=Rs.GetRows
			Rs.Close
			Cache.add Arr_Rs,dateadd("n",2000,now)
			End If
		End if
			For i=0 To Ubound(Arr_Rs,2)
				If int(SkinID)=Int(Arr_Rs(0,i)) Then
					Temp=Temp&"<div class=menuitems><a href=Cookies.Asp?Action=Style&SkinID="&Arr_Rs(0,i)&"><font color=red>"&Arr_Rs(1,i)&"</font></a></div>"
				Else
					Temp=Temp&"<div class=menuitems><a href=Cookies.Asp?Action=Style&SkinID="&Arr_Rs(0,i)&">"&Arr_Rs(1,i)&"</a></div>"
				End if
			Next
		SkinList=Temp
	End Function
	'缓存版块
	Public Function CacheBoard()
		Cache.Name="BoardInfo"
		If Cache.valid then
			Board_Rs=Cache.Value
		Else
			Set Rs=Execute("Select Depth,BoardID,ParentID,Boardname,BoardSetting,BoardImg,Introduce,BoardAdmin,TopicNum,EssayNum,TodayNum,LastReply,PassUser,Child,ParentStr,RootID,BoardLock,BoardType,BoardGrade,rule From[YX_Board] order by RootID,Orders")
			If Rs.Eof Or Rs.Bof Then
				Exit Function
			Else
				Board_Rs=Rs.GetRows(-1)
				Rs.Close
				Cache.add Board_Rs,dateadd("n",1000,now)'1000分钟更新
			End If
		End If
	End Function
	'版块信息
	Public Function GetBoardInfo(Str,Ast)
		Dim I,BoardtypePic,BoardtypepicTemp,BoardAdmin,BoardAdmin1,LastStr
		Temp= Replace(Trim(Template.ReadTemplate("版块类型图片")), CHR(10),"")
		Temp= Replace(temp,CHR(13),"")
		If Temp="" Then Response.Write("模版数据损坏！<br><A HREF=Cookies.Asp?Action=Style&SkinID=0>请点这里更新你的Cookies</A><br>如果依然存在问题，请清空Cookies,并重新启动浏览器！"):Response.end
		BoardtypepicTemp=split(Temp,"|")
		If Board_Rs(16,Ast) Then
			Boardtypepic=BoardtypepicTemp(2)
		Else
			If board_Rs(11,Ast)<>"" Then
				If Datediff("h",Split(board_Rs(11,Ast),"|")(2),NowbbsTime)<=24 Then
					Boardtypepic=BoardtypepicTemp(1)
				Else
					Boardtypepic=BoardtypepicTemp(0)
				End If
			Else
				Boardtypepic=BoardTypePicTemp(0)
			End If
		End If
		If board_Rs(5,Ast)="" or IsNull(board_Rs(5,Ast)) Then
			Temp=""
		Else
			Temp="<img src="&board_Rs(5,Ast)&">"
		End if
		Str = Replace(Str,"{版块类型图片}",BoardTypePic)
		Str = Replace(Str,"{版块图片}",Temp)
		If board_Rs(13,Ast)>0 Then Temp=" ["&board_Rs(13,Ast)&"]" Else Temp=""
		Str = Replace(Str,"{版块ID}",board_Rs(1,Ast))
		Str = Replace(Str,"{版块名称}","<a href=List.Asp?BoardID="&board_Rs(1,Ast)&">"&board_Rs(3,Ast)&Temp&"</a>")
		Str = Replace(Str,"{版块介绍}",board_Rs(6,Ast))
		If Board_Rs(7,Ast) = "" Or IsNull(board_Rs(7,Ast)) Then
			BoardAdmin="暂无":BoardAdmin1="暂无"
		Else
			Temp=split(board_Rs(7,Ast),"@@")
			BoardAdmin=""
			For I=0 to ubound(Temp)
				BoardAdmin=BoardAdmin&"<a href='Profile.Asp?Name="&Temp(I)&"' title='点击查看版主："&Temp(I)&" 的信息'>"&Temp(I)&"</a> "
			Next
			BoardAdmin1=Replace(BoardAdmin,"&nbsp;","<br>")
		End If
		Str=Replace(Str,"{版主竖排}",BoardAdmin1)
		Str = Replace(Str,"{版主}",BoardAdmin)
		Str = Replace(Str,"{主题数}",board_Rs(8,Ast))
		Str = Replace(Str,"{总帖数}",board_Rs(9,Ast))
		Str = Replace(Str,"{今日帖数}",board_Rs(10,Ast))
		If isnull(board_Rs(11,Ast)) or board_Rs(11,Ast)="" Then
			Str=Replace(Str,"{最后回复}","")
		Elseif Cint(Board_Rs(17,Ast)) Then
			Str=Replace(Str,"{最后回复}","<div align=center><font color=#999999>认证版面</font></div>")
		Else
			LastStr=Template.ReadTemplate("版块最后回复")
			Temp=Split(board_Rs(11,Ast),"|")
			LastStr = Replace(LastStr,"{用户名称}",Temp(0))
			LastStr = Replace(LastStr,"{帖子信息}",Temp(1))
			LastStr = Replace(LastStr,"{回复时间}",Temp(2))
			LastStr = Replace(LastStr,"{表情}",Temp(3))
			LastStr = Replace(LastStr,"{主题ID}",Temp(4))
			LastStr = Replace(LastStr,"{版块ID}",Temp(5))
			LastStr = Replace(LastStr,"{数据表ID}",Temp(6))
			Str = Replace(Str,"{最后回复}",LastStr)
		End if
		GetBoardInfo=Str
	End Function
	'表格显示（标题，内容）
	Public Sub ShowTable(Str1,Str2)
		Dim Temp
		Temp=Template.ReadTemplate("内容表格")
		Temp=Replace(Temp,"{标题}",Str1)
		Temp=Replace(Temp,"{内容}",Str2)
		Response.Write(Temp)
	End Sub
	'检验版块
	Public Sub CheckBoard()
		If Not IsArray(Board_Rs) Then CacheBoard()
		If Not IsArray(Board_Rs) Then Error("您所访问的版面不存在！")
		Dim Temp,PassUser,i
                rssurl="?BoardID="&BoardID&""
		If BoardID=0 Then Error("错误的地址栏参数，请不要手动去更改地址栏参数！")
                For i=0 To Ubound(Board_Rs,2)
			If Int(Board_Rs(1,i))=Int(BoardID) Then
				BoardDepth=Board_Rs(0,i)
				BoardName=Board_Rs(3,i)
				Stats=Boardname
				BoardSetting=split(Board_Rs(4,i),",")
				BoardIntroduce=Board_Rs(6,i)
				BoardAdmin=Board_Rs(7,i)
				BoardEssayNum=Board_Rs(9,i)
				BoardTopicNum=Board_Rs(8,i)
				BoardTodayNum=Board_Rs(10,i)
				PassUser=Board_Rs(12,i)
				BoardChild=Board_Rs(13,i)
				BoardParentStr=Board_Rs(14,i)
				BoardRootID=Board_Rs(15,i)
				BoardLock=Board_Rs(16,i)
				BoardType=Board_Rs(17,i)
				BoardGrade=Board_Rs(18,i)
			End If
		Next
		IsBoardAdmin=False
		BoardRoots="|"
		If InStr("@@"&Lcase(BoardAdmin)&"@@","@@"&Lcase(MyName)&"@@")>0  And FoundUser And BoardAdmin<>"" Then IsBoardAdmin=True
		For i=0 To Ubound(Board_Rs,2)
			'记录区置顶信息
			If Board_Rs(15,i)=BoardRootID And Board_Rs(0,i)<>0 Then BoardRoots=BoardRoots&Board_Rs(1,i)&"|"
			If Int(BoardDepth)>0 Then