public_cls.asp

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

				If InStr(","&BoardParentStr&",",","&Board_Rs(1,i)&",")>0 Then
					'如果上级论坛为会员版面
					'If Board_Rs(4,i)=1 Then If Not Founduser then Error("该版面为只有注册会员可以进入")
					'上级版主继承管理
					If BBSSetting(1)="0" And FoundUser Then
						If InStr("|"&Board_Rs(7,i)&"|","|"&MyName&"|")>0 And FoundUser And BoardAdmin<>"" Then IsBoardAdmin=True
					End If
					Temp=Temp &" <FONT face=Webdings>8</FONT> <a href='List.Asp?BoardID="&Board_Rs(1,i)&"'>"&Board_Rs(3,i)&"</a>"
				End If
			End If
		Next
		If ClassID=3 And Not IsBoardAdmin Then ClassSetting=Split(Execute("Select ClassSetting from YX_UserClass where ClassID=5")(0),",")
		Position=Position & Temp &" <FONT face=Webdings>8</FONT> <a href='List.Asp?BoardID="&BoardID&"'>"&Stats&"</a>"
		If BoardName="" or IsNull(BoardName) Then Error("您所访问的版面不存在！")
		If  Instr(Lcase(Request("Url")),"list.asp")>0 Then
			If  isnull(Boardadmin) or Trim(BoardAdmin)="" then
				BoardAdmin="暂无"
			Else
				Temp=split(BoardAdmin,"@@")
				BoardAdmin=""
				For i=0 to ubound(Temp)
					Boardadmin=Boardadmin&"<a href='Profile.Asp?name="&Temp(i)&"'>"&Temp(i)&"</a>&nbsp;"
				Next
			End If
		End If
		If ClassID<=2 Then Exit Sub
		If Cint(MyGradeNum)<BoardGrade Then Error("您的等级还没有达到 <font color=#FF0000>"&BoardGrade&"</font> 级，不能进入这个版！当前您的等级是 <font color=#FF0000>"&CInt(MyGradeNum)&"</font> 级！")
		If BoardLock Then
			If  ClassID>2 or Not IsBoardAdmin then
				If (Instr(Lcase(Request("url")),"say.asp")>0 and Instr(Lcase(Request("url")),"show.asp")<1) or Instr(Lcase(Request("url")),"save.asp")>0 then Error("该版面已经锁定，你没有权限在本版发表帖子！") 
			End If
		End If
		If BoardType Then
			Dim IsPassUser
			ISpassUser=False
			If ClassID>2 Then
				If Not IsBoardAdmin Then
					If Not FoundUser or isnull(PassUser) or PassUser="" then
						Error("该版面为认证论坛，你还没有经过管理员的认证！")
					Else
						PassUser=Split(PassUser,"|")
						for i = 0 to ubound(PassUser)
							If MyName=trim(PassUser(i)) And MyName<>"" Then
								IsPassuser=True
								Exit for
							End If
						Next
						If Not IsPassUser Then Error("该版面为认证论坛，你还没有经过管理员的认证！")
					End If
				End If
			End if
		End If
		
		If Cint(MyEssayNum)<Cint(BoardSetting(5)) Then Error("您的贴数没有达到 "&Cint(BoardSetting(5))&" 不能进入本版面！")
		If Cint(MyMark)<Cint(BoardSetting(6)) Then Error("您的Yb没有达到 "&Cint(BoardSetting(6))&" 不能进入本版面！")
		If Cint(MyCoin)<Cint(BoardSetting(7)) Then Error("您的金币没有达到 "&Cint(BoardSetting(7))&" 不能进入本版面！")
		If Cint(MyLoginNum)<Cint(BoardSetting(8)) Then Error("您的登陆次数没有达到 "&Cint(BoardSetting(8))&" 不能进入本版面！")
		If Cint(MyGoodNum)<Cint(BoardSetting(9)) Then Error("您的精华贴数没有达到 "&Cint(BoardSetting(9))&" 不能进入本版面！")
		If DateDIff("n",MyRegTime,NowBBSTime)<Cint(BoardSetting(10)) Then Error("您的注册时间没有超过 "&Cint(BoardSetting(10))&" 不能进入本版面！")
	End Sub
	'版块下拉列表(当前ID，不显示的深度)
	Public Function BoardIDList(Ast,Depth)
		Dim Temp,I,II,po
		If Not IsArray(Board_Rs) Then YxBBs.CacheBoard()
		If IsArray(Board_Rs) Then
			For i=0 To Ubound(Board_Rs,2)
				Po=""
				If Board_Rs(0,i)=0 Then
					Temp=Temp&"<option value='"&Board_Rs(1,i)&"'"
					If Board_Rs(1,i)=Ast Then Temp=Temp&" selected"
					Temp=Temp&">≡"&Board_Rs(3,i)&"≡</option>"
				Else
					For II=2 to Board_Rs(0,i)
						po=Po&"∣"
					Next
					Temp=Temp&"<option value='"&Board_Rs(1,i)&"'"
					If Board_Rs(1,i)=Ast Then Temp=Temp&" selected"
					Temp=Temp&">"&po&"├ "&Board_Rs(3,i)&"</option>"
				End IF
			Next
			BoardIDList=Temp
		End If
	End Function
	'记录认证版块的标记
	Public Function NoShowTopic()
		Dim Temp,i
		If Not IsArrAy(Board_Rs) Then CacheBoard()
		If IsArray(Board_Rs) Then
			Temp=""
			For i=0 To Ubound(Board_Rs,2)
				If Board_Rs(17,I)=3 Then
					Temp=Temp&Board_Rs(1,I)&","
				End If
			Next
			If Temp<>"" Then Temp=left(temp,len(temp)-1)
			NoShowTopic=Temp
		End If
	End Function
	Public Function Execute(T_Sql)
		If Not IsObject(Conn) Then ConnectionDatabase
		Set Execute = Conn.Execute(T_Sql)
		SqlNum=SqlNum+1
	End Function
	Public Sub InToDataBase(DataBaseName,TableName,ColumnName,ColumnValue)
		On Error Resume Next
		
		YxBBs.Execute("insert into ["&TableName&"] ("&ColumnName&") values ("&Replace(Replace(ColumnValue,"True","1"),"False","0")&")")
		
		If Err Then
			Response.Write "在LOG数据库表"&TableName&"中添加记录失败！原因：<font color=red>" & Err.Description
			Err.Clear
		End If
	End Sub
	PubLic Sub InLog(LogInfo,ToName,LogType)
		If LogType = 1 Then
			InToDataBase db,"YX_Logs","UserName,UserIP,LogContent,LogTime","'"&YxBBs.MyName&"','"&YxBBs.MyIp&"','"&LogInfo&"','"&Now()&"'"
		Else
			InToDataBase db,"YX_Logs","ToName,UserName,UserIP,LogContent,LogTime","'"&ToName&"','"&YxBBs.MyName&"','"&YxBBs.MyIp&"','"&LogInfo&"','"&Now()&"'"
		End If
	End Sub
	'弹出JS错误消息
	Sub ErrMsg(Message)
		Response.Write("<script>alert('"&message&"');history.back();</script>")
		Set Cache = Nothing
		Set YxBBs = Nothing
		Response.End()
	End Sub
	'错误信息提示
	Public Sub Error(Message)
		If Not HeadLoad Then Call Head("错误信息")
		Call ShowTable("错误信息","<tr><td height=""100""><b>操作不成功的可能原因：</b><ul>"&Message&"</ul></td></tr>")
		YxBBs.Footer()
		Set Cache = Nothing
		Set YxBBs = Nothing
		Response.End()
	End Sub
	'操作成功表格
	Public Sub Success(Info,Message)
		If Not HeadLoad Then Call Head("操作成功")
		Call ShowTable("操作成功","<tr><td height=""100""><div style='margin:15;line-height: 150%'><b>"&Info&"您可以进行以下操作：</b><br><ul>"&Message&"</ul></div></td></tr>")
		YxBBs.Footer()
		Set Cache = Nothing
		Set YxBBs = Nothing
		Response.End()
	End Sub
	'获取Cookies记录(cookies名称，来源)
	Public Function GetCookiesInfo(CkStr,From)
		GetCookiesInfo=Session(CacheName & CkStr)
		If GetCookiesInfo="" Then GetCookiesInfo=Request.Cookies(CookiesName&CkStr)(CkStr)
		If GetCookiesInfo="" Then
			GetCookiesInfo=From
			Session(CacheName & CkStr)=From
			Response.Cookies(CookiesName&CkStr)(CkStr)=From
			Response.Cookies(CookiesName&CkStr).Expires=Date+1
		Else
			Session(CacheName & CkStr)=GetCookiesInfo
			Response.Cookies(CookiesName&CkStr)(CkStr)=GetCookiesInfo
		End If
	End Function
	'获取当前URL地址
	Public Function GetUrl()
		On Error Resume Next
		Dim Temp
		If LCase(Request.ServerVariables("HTTPS")) = "off" Then
			Temp = "http://"
		Else
			Temp = "https://"
		End If
		Temp = Temp & Request.ServerVariables("SERVER_NAME")
		If Request.ServerVariables("SERVER_PORT") <> 80 Then Temp = Temp & ":" & Request.ServerVariables("SERVER_PORT")
		Temp = Temp & Request.ServerVariables("URL")
		If Trim(Request.QueryString) <> "" Then Temp = Temp & "?" & Request.QueryString
		GetUrl = Temp
	End Function

	Public Function UpdateCookiesInfo(CkStr,Ast)
		If Ast=0 Then
			Session(CacheName & CkStr)=""
			Response.Cookies(CookiesName&CkStr)(CkStr)=""
		Else
			Dim Temp
			Temp=Session(CacheName & CkStr)
			If Temp="" Then Temp=Request.Cookies(CookiesName&CkStr)(CkStr)
			If Temp="" Then Exit Function
			Temp=Temp+Ast
			Session(CacheName & CkStr)=Temp
			Response.Cookies(CookiesName&CkStr)(CkStr)=Temp
			UpdateCookiesInfo=Temp
		End If
	End Function

	'1菜单列表2下拉列表
	Public Function BoardList(Ast)
	   If Ast<1 or Ast>2 Then Exit Function
		Dim Temp,BoardNenu,BoardSelect,i,II,Po
 		Cache.Name="BoardList"&Ast
		If Cache.valid Then
			Temp=Cache.Value
			BoardList=Temp
			Exit Function
		Else
			If Not IsArray(Board_Rs) Then CacheBoard()
			If Not IsArray(Board_Rs) Then Exit Function
			Cache.Name="BoardList"&Ast
			For i=0 To Ubound(Board_Rs,2)
			Po=""
			If Board_Rs(0,i)=0 Then'类
				BoardNenu=BoardNenu&"<div class=menuitems><A Href=List.Asp?BoardID="&Board_Rs(1,i)&">≡ "&Board_Rs(3,i)&" ≡</a></div>"
				BoardSelect=BoardSelect&"<option value='"&Board_Rs(1,i)&"'>■≡"&Board_Rs(3,i)&"≡</option>"
			Else
				For II=2 to Board_Rs(0,i)
				po=Po&"∣"
				Next
				BoardNenu=BoardNenu&"<div class=menuitems><A Href=List.Asp?BoardID="&Board_Rs(1,i)&">"&po&"├ "&Board_Rs(3,i)&"</a></div>"
				BoardSelect=BoardSelect&"<option value='"&Board_Rs(1,i)&"'>&nbsp;&nbsp;"&po&"├ "&Board_Rs(3,i)&"</option>"
			End IF
			Next
			BoardSelect="<select onchange=if(this.options[this.selectedIndex].value!=''){location='list.Asp?boardID='+this.options[this.selectedIndex].value;} style='font-size: 9pt'><option selected>跳转论坛至...</option>"&BoardSelect&"</select>"
			If Ast = 1 Then
			Cache.add BoardNenu,dateadd("n",5000,now)'5000分钟更新
			BoardList=BoardNenu
			Else
			Cache.add BoardSelect,dateadd("n",5000,now)
			BoardList=BoardSelect
			End If
		End If
	End Function

	Function Cvt(Tstr,Iflag)
		Select Case Iflag
			Case"1"
				Tstr="<font color=""red""><b>"&Tstr&"</b></font>"
			Case"2"
				Tstr="<font color=""blue""><b>"&Tstr&"</b></font>"
			Case"3"    
				Tstr="<font color=""green""><b>"&Tstr&"</b></font>"
			Case Else
				Tstr=Tstr
		End Select
	Cvt=Tstr
	End Function

	Function GetTimeOver(iflag)
		If iflag=0 Then Exit Function
		Dim tTimeOver
		If iflag = 1 Then
			tTimeOver = FormatNumber((Timer() - StartTime) * 1000, 3, true)
			getTimeOver = " 执行时间：" & tTimeOver & " Ms."
		Else
			tTimeOver = FormatNumber(Timer() - StartTime, 6, true)
			getTimeOver = " 执行时间：" & tTimeOver & " 秒"
		End If
	End Function
End Class


Dim YimXu,CookiesName
'读取Cookies 
CookiesName=LCase(Replace(Request.ServerVariables("SERVER_NAME") & Request.ServerVariables("URL"),Split(request.ServerVariables("SCRIPT_NAME"),"/")(ubound(Split(request.ServerVariables("SCRIPT_NAME"),"/"))),""))
YimXu=Request.Cookies(CookiesName)("CookiesDate")
If YimXu>0 Then Response.Cookies(CookiesName).Expires=date+YimXu
%>