<%
Class Cls_94KK 
	Public FUN,Cache'Class
	Public Skins,SkinsPIC,NowBBSTime,MSIE
	Public Info,InfoUpdate
	
	Public BbsTable,SkinID,Ver,NowDate'parameter
	Public ShowHead
	Private MyOnline
	Public MyIp,MyName,MyPassword,MyID,MyHidden,FoundUser,MyAdmin,CookiesDate,IsBoardAdmin
	
	Public AllOnlineNum,UserOnlineNum,BoardOnlineNum,BoardUserOnlineNum
	Public Position,Stats,Board_Rs
	Public BoardString

	Public TB,BoardID,BoardName,BoardType,BoardIntroduce,BoardTopicNum,BoardEssayNum,BoardAdmin,BoardTodayNum,BoardDepth,BoardChild,BoardParentStr,BoardRootID,BoardRoots

	Private SqlNum,AddMenu
	Private Sub Class_Initialize()
		NowBBSTime=FormatDateTime(Now()+Timeset/24,0)'服务器时间
		Set Fun = New Cls_Fun
		Set Cache =  New Cls_Cache
		MyIp=GetIP()
		MyID=GetMemor("","MyID")
		MyName=GetMemor("","MyName")
		MyPassword=GetMemor("","MyPassword")
		MyHidden=GetMemor("","MyHidden")
		CookiesDate=GetMemor("","CookiesDate")
		SkinID=GetMemor("SkinID","SkinID")
		TB = CheckNum(Request.querystring("TB"))
		BoardID = CheckNum(Request.querystring("BoardID"))
		MyAdmin=0
		SqlNum=0
		ShowHead=True
		FoundUser=False
	End Sub
	
	Private Sub Class_Terminate()
		Set FUN = Nothing
		Set Cache=Nothing
		If IsObject(Conn) Then 
			Conn.Close
			Set Conn = Nothing
		End If
	End Sub
	'94kk安全盾
	Public property get SafeBuckler(LoginName,IP,IsUpdate)
		Dim All,IsMe,Temp,i,IPNum
		SafeBuckler=false
		If Cache.valid("LockLogin") Then
			All=Cache.Value("LockLogin")
			If Instr(All,"|"&IP)<>0 Then
				Temp=split(All,"<||>")
				For i=0 To Ubound(Temp)
					If Instr(Temp(i),"|"&IP)<>0 Then IpNum=IpNum+1
					If Instr(Temp(i),LoginName&"|"&IP)<>0 Then
						IsMe=Split(Temp(i),"|")
						If Int(IsMe(2))>4 Then
							SafeBuckler=True
						Else
							If IsUpdate=1 Then
								All=Replace(All,Temp(i),IsMe(0)&"|"&IsMe(1)&"|"&Int(IsMe(2)+1))
								If Int(IsMe(2))+1>4 Then NetLog"!尝试登陆错误超过五次<br>登陆用户名："&IsMe(0)
							End If
						End If
					End If
				Next
				If Instr(All,"|"&LoginName&"|"&IP)=0 Then All=All&"<||>"&LoginName&"|"&IP&"|"&"1"
			Else
				All=All&"<||>"&LoginName&"|"&IP&"|"&"1"
			End If
			If IpNum>7 Then Alert"你是不是疯了？\猪婷家园系统警示：禁止你登陆！","Index.asp"
			If IpNum=7 then NetLog"!尝试登陆以不同用户名错误超过七次"
		Else
			All=LoginName&"|"&IP&"|"&"1"
		End If
		If IsUpdate=1 Then Cache.Add "LockLogin",All,dateadd("n",1500,NowBBSTime)
	End property
   '读取IP
	Private Function GetIP()
		Dim Temp
		Temp = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
		If Temp = "" or isnull(Temp) or isEmpty(Temp) Then Temp = Request.ServerVariables("REMOTE_ADDR")
		If Instr(Temp,"'")>0 Then Temp="0.0.0.0"
		GetIP = Temp
	End Function

	Public Sub CheckIP()
		Dim CodeIP,rs,Arr_Rs,I
		If Cache.valid("IPData") then
			Arr_Rs=Cache.Value("IPData")
		Else
			Set Rs=Execute("select ID,StartIp,EndIP from [KK_LockIP] where Lock")
			If Rs.Eof Then
				ReDim Arr_Rs(2,0)
				Arr_Rs(1,0)="0"
				Arr_Rs(2,0)="0"
				Cache.add "IPData",Arr_Rs,dateadd("n",5000,now)
				Exit Sub
			Else
				Arr_Rs=Rs.GetRows(-1)
				Rs.Close
				Set Rs=Nothing
				Cache.add "IPData",Arr_Rs,dateadd("n",5000,now)
			End If
		End If
		CodeIP=Fun.IpEncode(MyIp)
		For i=0 To Ubound(Arr_Rs,2)
		If Arr_Rs(1,I)<=CodeIP And Arr_Rs(2,I)>=CodeIP Then 
			If Session(CacheName&"Lock")="" Then
				NetLog"被封IP的家伙又来了，哈哈，但不能进入论坛。"
				Session(CacheName&"Lock")="1"
			End If
			print"你所在网段已被封锁：可能该网段有人捣乱，请联系管理员！"
		End If
		Next
	End Sub
	'使之记忆
	Public Sub LetMemor(root,name,value)
		Session(CacheName & name)=value
		Response.Cookies(CacheName & root)(name)=value
	End Sub
	'获得记忆
	Public Function GetMemor(root,name)
		GetMemor=Session(CacheName & name)
		If GetMemor="" Then GetMemor=Request.Cookies(CacheName & root)(name)
	End Function
	'清空用户记忆
	Public Sub SetMemorEmpty()
		Dim Temp,I
		Temp=Split("MyID|MyName|MyPassword|MyHidden|CookiesData|MyAdmin|Sms","|")
		For I=0 to uBound(Temp)
			Session(CacheName & Temp(I)) = Empty
			Response.Cookies(CacheName)(Temp(I))= Empty
		Next
		Session(CacheName & "MyInfo")= Empty
		Session(CacheName & "MyGradeInfo")= Empty
		Session(CacheName & "Bank")=Empty
		Session(CacheName & "Login")=Empty
		FoundUser=False
	End Sub
	
	'检验数据表
	Private Function GetTB(Str)
		Dim AllTB,i
		AllTB=Split(BbsTable(0),",")
		For i=0 to uBound(AllTB)
			If Str=Int(AllTB(i)) Then 
				 GetTB=Str
				 Exit Function
			End IF
		Next
		GetTB=BbsTable(1)
	End Function	
	


	Public Sub Config()
		Dim Temp
		CheckIP()
		If Not IsNumeric(Session.SessionID) Then GoToErr(4)
		If Cache.valid("Info") And Cache.Valid("InfoUpdate") And Cache.Valid("parameter") Then
			Info=Split(Cache.Value("Info"),",")
			InfoUpdate=Split(Cache.Value("InfoUpdate"),",")
			Temp=Split(Cache.Value("parameter"),"<$$>")
		Else
			Dim Rs
			Set Rs = Execute("Select Info,AllEssayNum,TopicNum,TodayNum,YsterdayNum,MaxEssayNum,UserNum,NewUser,MaxOnlineNum,MaxOnlineTime,Hits,NowDate,BbsTable,SkinID,Ver From [KK_Config]")
			Info=Split(Rs(0),",")
			InfoUpdate=Rs(1)&","&Rs(2)&","&Rs(3)&","&Rs(4)&","&Rs(5)&","&Rs(6)&","&Rs(7)&","&Rs(8)&","&Rs(9)&","&Rs(10)&","&Rs(11)
			Temp=Rs(12)&"<$$>"&Rs(13)&"<$$>"&Rs(14)
			Cache.Add "Info",Rs(0),dateadd("n",2000,NowBBSTime)
			Rs.Close
			Set Rs=Nothing
			Cache.Add "InfoUpdate",InfoUpdate,dateadd("n",2000,NowBBSTime)
			Cache.Add "parameter",Temp,dateadd("n",2000,NowBBSTime)
			Temp=Split(Temp,"<$$>")
			InfoUpdate=Split(InfoUpdate,",")
		End If
			If InStr(Request.ServerVariables("HTTP_USER_AGENT"),"MSIE")>0 Then MSIE=True
	'=======前台关闭和打开风格
			If Instr(PageUrl,"admin_")=0 Then	
				If Info(3)="1" then '论坛关闭
					 Response.Write Info(4)
					 Response.End
				End If
				If Not IsNumeric(SkinID) or SkinID="0" or SkinID="" Then
					SkinID=Temp(1)
					LetMemor "SkinID","SkinID",SkinID
				End If
				OpenSkins()
				SkinsPIC=Split(ReadSkins("94KK@PIC"),"|")
			End If
		Ver=Temp(2)
		BbsTable=Split(Temp(0),"|")
		If Int(TB)<>Int(BbsTable(1)) Then TB=GetTB(TB)
		If Datediff("d",FormatDateTime(NowBbsTime,2),InfoUpdate(10))<>0 Then TodayUpdate
	End Sub
	
	'今日更新
	Private Sub TodayUpdate()
		Dim Temp,OnlineCache,Hits
		If Cache.valid("Hits") Then Hits=Cache.Value("Hits")
		Hits=Int(Hits)
		Execute("update [KK_config] set NowDate='"&FormatDateTime(NowBbsTime,2)&"',Todaynum=0,YsterdayNum=Todaynum,Hits=Hits+"&Hits)
		Execute("update [KK_Board] set Todaynum=0")
		If Cache.valid("OnlineCache") Then
			OnlineCache=Cache.Value("OnlineCache")
		End If
		Application.Contents.RemoveAll
		Cache.Add "OnlineCache",OnlineCache,dateadd("n",1500,NowBBSTime)
	End Sub
	
	Public Sub CheckUser()
       If Not IsNumeric(MyID) Or MyID="" Or MyName="" Or MyPassword="" Then
			FoundUser=False
	   Else
	      UserLoginTrue()
       End If
	End Sub
	
	'用户信息
	Public Sub UserLoginTrue()
		If Not IsArray(Session(CacheName & "MyInfo")) or Not IsArray(Session(CacheName & "MyGradeInfo")) Then
			Dim Rs
			If Not Fun.CheckName(MyName) or Not Fun.CheckPassword(MyPassword) Then
				SetMemorEmpty()
				NetLog"！非法伪造Cookie对论坛进行功击"
				Exit Sub
			End If
			Set Rs=Execute("Select ID,Name,Password,Sex,EssayNum,GoodNum,Mark,Coin,GameCoin,Home,QQ,IsQQpic,Pic,Picw,Pich,GradeID,Birthday,IsVip,RegTime,LastTime,SmsSize,RegIp,LoginNum,LastIp,Honor,Faction,BankSave,NewSmsNum From [KK_user] where Name='"&MyName&"' And Password='"&MyPassword&"'")
			If Rs.Eof Then
				SetMemorEmpty()
				Exit Sub
			Else
				Session(CacheName & "MyInfo")=Split(Rs.GetString(,1, "<$$>","",""),"<$$>")
				Session(CacheName & "MyGradeInfo")=Split(GetGradeInfo(Session(CacheName & "MyInfo")(15)),"|")
				If Session(CacheName & "login")="" Then
					Execute("Update [KK_user] set Lasttime='"&NowBbsTime&"',LoginNum=LoginNum+1 where Name='"&MyName&"'")
					Session(CacheName & "login")="1"
				End If
			End If
			Rs.Close
			Set Rs=Nothing
		End If
		'防黑客构造加强
		If Int(MyID)<>Int(Session(CacheName & "MyInfo")(0)) or LCase(MyName)<>LCase(Session(CacheName & "MyInfo")(1)) Or MyPassword<>Session(CacheName & "MyInfo")(2) Then
			NetLog"！非法伪造Cookie对论坛进行功击"
			SetMemorEmpty()
			Exit Sub
		End If
		FoundUser=True
		MemberInfo
	End Sub

	Private Sub MemberInfo()
		MyAdmin=Session(CacheName & "MyAdmin")
			If MyAdmin="" Then
				GetAdmin()
				Session(CacheName & "MyAdmin")=MyAdmin
			End If
			If  MyAdmin=9 Then AddMenu="&nbsp; <a href=""admin_index.asp"" target=""_blank"">后台管理</a>"
	End Sub
	
	'管理组
	Private Sub GetAdmin()
		Dim Rs,Ars,I
		MyAdmin=0
		If Session(CacheName & "MyInfo")(17)="1" Then MyAdmin=4
		Set Rs=Execute("select BoardID from [KK_admin] where name='"&MyName&"' order by BoardID")
		If Not Rs.eof then
			Ars=Rs.GetRows(-1)
			Rs.Close
			Set Rs=Nothing
			For I=0 to Ubound(Ars,2)
				If Ars(0,i)=0 Then MyAdmin=9:Exit Sub
				If Ars(0,i)=-1 Then MyAdmin=8:Exit Sub
				MyAdmin=7
			Next
		End If
	End Sub
	
	'在线通知用户(Flag参数：0正常1新留言2踢出)
	Public Sub UpdageOnline(UserName,Flag)
		Dim OnlineCache
		If Cache.valid("OnlineCache") Then
			OnlineCache=Cache.Value("OnlineCache")
		Else
			OnlineCache=""
		End If
		If Instr(OnlineCache,"|"&UserName&"|")=0 Then Exit Sub
		OnlineCache=Replace(OnlineCache,"|"&UserName&"|0|","|"&UserName&"|"&Flag&"|")
		If Flag=2 or Flag=0 or flag=3 Then OnlineCache=Replace(OnlineCache,"|"&UserName&"|1|","|"&UserName&"|"&Flag&"|"):OnlineCache=Replace(OnlineCache,"|"&UserName&"|3|","|"&UserName&"|"&Flag&"|")
		Cache.Add "OnlineCache",OnlineCache,dateadd("n",1000,NowBBSTime)
	End Sub
	
	'在线浮动
	Public Sub GetOnline()
	'Cache.clean("OnlineCache")
		If Info(21)="0" or Instr(PageUrl,"error.asp")<>0 or Instr(PageUrl,"online.asp")<>0 Then Exit Sub
		Dim OnlineCache,SID,EachOnline,Temp,SysMyOnline,I,DelOnline,TStats
		Dim Mood,II
		BoardUserOnlineNum=0
		BoardOnlineNum=0
		UserOnlineNum=0
		DelOnline=""
		SID=GetMemor("SID","SID")
		If SID="" Then
			LetMemor"SID","SID",Session.SessionID
			Response.Cookies(CacheName&"SID").Expires=date+1
			SID=GetMemor("SID","SID")
			If SID="" Then Exit Sub
		End If
		
		'读入位置
		TStats=Replace(Replace(Stats,",","&#44"),"|","｜")
		Mood=MyAdmin
		If MyHidden="0" Then Mood=1
		MyOnline=SID&"|"&MyName&"|0|"&NowBbsTime&"|"&NowBbsTime&"|"&MyIP&"|"&Mood&"|"&TStats&"|"&BoardID&","
		If Cache.valid("OnlineCache") Then
			OnlineCache=Cache.Value("OnlineCache")
			EachOnline=Split(OnlineCache,",")
			AllOnlineNum=uBound(EachOnline)
			For I=0 to AllOnlineNum-1
				Temp=Split(EachOnline(I),"|")
				If uBound(Temp)<>8 Then
					DelOnline=DelOnline&EachOnline(I)&","
				Else
					If Cdate(Temp(4))+Info(8)/1440<Cdate(NowBBSTime) Then
						DelOnline=DelOnline&EachOnline(I)&","
					Else
						If Trim(Temp(1))<>"" Then UserOnlineNum=UserOnlineNum+1
						'版块
						If Int(Temp(8))=BoardID Then
							BoardOnlineNum=BoardOnlineNum+1
							If Temp(1)<>"" Then BoardUserOnlineNum=BoardUserOnlineNum+1
						End If
					End If
					If Temp(0)=SID or (Temp(1)=MyName And FoundUser) Then
						II=II+1
						If II=1 Then
							SysMyOnline=EachOnline(I)&","
						Else
							DelOnline=DelOnline&EachOnline(I)&","
						End If
					End If
				End If
			Next
			'删除超时用户
			If DelOnline<>"" Then
				Temp=Split(DelOnline,",")
				AllOnlineNum=AllOnlineNum-uBound(Temp)
				For I=0 To uBound(Temp)-1
				OnlineCache=Replace(OnlineCache,Temp(I)&",","")
				Next
			End If
			If SysMyOnline="" Then
			'会员排前
				If FoundUser Then
					OnlineCache=MyOnline&OnlineCache
				Else
					OnlineCache=OnlineCache&MyOnline
				End If
			Else
				Temp=Split(SysMyOnline,"|")
				MyOnline=SID&"|"&MyName&"|"&Temp(2)&"|"&Temp(3)&"|"&NowBbsTime&"|"&MyIP&"|"&Mood&"|"&TStats&"|"&BoardID&","
				If FoundUser Then
					If Temp(7)<>TStats and BoardID<>0 Then
						BoardOnlineNum=BoardOnlineNum+1
						BoardUserOnlineNum=BoardUserOnlineNum+1
					End If
					If Temp(2)=2 Then GotrErr(72)'踢出
					If Temp(2)=3 Then
						UpdageOnline MyName,0
						Session(CacheName & "MyInfo") = Empty
						Session(CacheName & "MyAdmin")= Empty
						UserLoginTrue
					End If
					If Temp(1)=MyName Then
						OnlineCache=Replace(OnlineCache,SysMyOnline,MyOnline)
					Else
						OnlineCache=Replace(OnlineCache,SysMyOnline,"")
						OnlineCache=MyOnline&OnlineCache
					End If
				Else
					OnlineCache=Replace(OnlineCache,SysMyOnline,MyOnline)
				End If
			End If
		Else
			OnlineCache=MyOnline
			AllOnlineNum=1
		End If
		'更新在线缓存
		Cache.Add "OnlineCache",OnlineCache,dateadd("h",1000,NowBBSTime)
		'更新最大在线
		If Int(AllOnlineNum)>int(InfoUpdate(7)) then
		Dim S
			Execute ("update [KK_Config] Set MaxOnlineNum="&AllOnlineNum&",MaxOnlineTime='"&NowBbsTime&"'")
			S=Replace(join(InfoUpdate,","),InfoUpdate(7)&","&InfoUpdate(8),AllOnlineNum&","&NowBbsTime)
			Cache.Add "InfoUpdate",S,dateadd("n",2000,NowBBSTime)
			InfoUpdate=Split(S,",")
		End If
		
		If FoundUser Then
			If Instr(PageUrl,"sms.asp")>0 Then
				If Temp(2)=1 Then UpdageOnline MyName,0
			Else
				If Int(Session(CacheName & "MyInfo")(27))>0 or Instr(MyOnline,MyName&"|1|")<>0 Then
					If Info(45)="1" Then
						Response.Write"<script language='JavaScript'>if(confirm('您的论坛信箱有新留言，是否要查看？')){window.location.href='Sms.Asp';}else{event.returnValue=false;};window.location.href='Sms.Asp';</SCRIPT>"
					Else
						Temp=Session(CacheName & "MyInfo")(27)
						If Temp=0 then Temp=1
						AddMenu=AddMenu&" <a href='Sms.asp' target='_blank'><img border=0 src=Images/newsms.gif /><span style='color:#F00'>新留言（"&Temp&"条）</span></a><bgsound src='images/mail.wav' loop='1' />"
					End If
				End If
			End If
		End If
	End Sub
	
'位置导航	
	Public Function PageStats()
	If Info(27)="0" or instr(PageUrl,"index.asp")<>0 Then Exit Function
		Position=vbNewLine &"<script language=""JavaScript"" type=""text/javascript"">"&vbNewLine &"BoardListMenu()"&vbNewLine &"</script>"&vbNewLine &"<a onmouseover=""dropdownmenu(this, event, 'Board');"" href=index.asp>"&Info(0)&"</a>"&Position
		PageStats=Replace(ReadSkins("你的位置"),"{位置}",Position)
	End Function
	
	Public Sub Head(Str)
		Dim i,Temp
		Temp = ReadSkins("页面属性")
		IF Str<>"" Then
			Position=Position &"&nbsp;→&nbsp;"&Str
			Stats=Str
		End if
		Getonline()
		Temp = Replace(Temp,"{页面标题}",Stats&"--"&Info(0))
		If instr(PageUrl,"say.asp")>0 or instr(PageUrl,"show.asp")>0 or instr(PageUrl,"sms.asp")>0 or Instr(PageUrl,"placard.asp")>0 Then
		Temp=Temp&"<SCRIPT language=""JavaScript"" type=""text/javascript"" src=""Inc/Editor.js""></SCRIPT>"
		End if
		If ShowHead Then
			Temp = Temp & vbNewLine & ReadSkins("页面头部")
			IF FoundUser Then
				Temp = Replace(Temp,"{菜单}",vbNewLine &"<SCRIPT language=""JavaScript"" type=""text/javascript"" >"&vbNewLine &"UserMenu('"&MyName&"')"& vbNewLine &"</SCRIPT>"&AddMenu)
			Else
				Temp = Replace(Temp,"{菜单}",vbNewLine &"<SCRIPT language=""JavaScript"" type=""text/javascript"" >"&vbNewLine &"TouristMenu()"& vbNewLine &"</SCRIPT>"&AddMenu)
			End If
			Temp = Replace(Temp,"{广告}",Info(6))
			Temp = Temp&vbNewLine &PageStats()
		End If
		Response.Write Temp
	End Sub
	
	Public Sub Footer()
		Dim S,Hits
		'===为尊重作者的辛苦劳动，免费用户请不要去掉版本信息，谢谢！！！http://www.ju4t.com
		S="<span id=""ver"">Powered by <a href=""http://www.ju4t.com"" target=""_blank"" ><span style=""color: #FF6600;font-weight: bold;"">Drean.Cn</span></a> <span style=""color:#02419F;font-weight: bold;"">"&Ver&"</span></span>"
		S=S&"<br />"&Info(7)&"<br />"
		If Info(26)<>"0" Then
			If Cache.valid("Hits") Then Hits=Cache.Value("Hits")
			Hits=Int(Hits)
			Cache.Add "Hits",Hits+1,dateadd("n",2000,NowBBSTime)
			If Hits>2000 Then
				Execute("update KK_config Set Hits=Hits+2001")
				Hits=Replace(Join(InfoUpdate,","),InfoUpdate(9)&","&InfoUpdate(10),InfoUpdate(9)+ 2001&","&InfoUpdate(10))
				Cache.Add "InfoUpdate",Hits,dateadd("n",2000,NowBBSTime)
				Cache.clean("Hits")
			End If
		End If
		If Info(26)="1" Then S=S&" 论坛访问:"&InfoUpdate(9)+Hits&"次"
		If Info(24)="1" then S=S&" 数据查询："&SqlNum&"次"
		S=S&getTimeOver(Info(25))
		Response.Write Replace(ReadSkins("页面底部"),"{版权}",S)
Response.Write "<script type=""text/javascript"" src=""Inc/Std_StranJF.js""></script>"
	End Sub	
	
	'更新等级 参数（用户ID，帖数，标记）
	Public Sub UpdateGrade(User_ID,Num,Flag)
		Dim ARs,i,GradeID,Isbe,DefaultID
		Isbe=False
		ARs=SetGradeInfoCache()
		For i=0 To Ubound(ARs,2)
			If i=0 Then DefaultID=Ars(0,I)'防空
			GradeID=Ars(0,I)
			If (Flag=Ars(1,i) And Flag<>0) Or (Int(Num)=>Int(Ars(5,i)) And Flag=0) Then
				Isbe=True
				Exit For
			End If
		Next
		If Not Isbe Then GradeID=DefaultID
		Execute("update [KK_User] Set GradeID="&GradeID&",GradeFlag="&Flag&" where ID="&User_ID&"")
	End Sub
	
	Public Function SetGradeInfoCache()
		Dim Rs
		If Cache.valid("GradeInfo") then
			SetGradeInfoCache=Cache.Value("GradeInfo")
		Else
			Set Rs=Execute("Select ID,Flag,GradeName,PIC,Spic,EssayNum,Strings,Grouping From [KK_Grade] order by Grouping,EssayNum desc")
			SetGradeInfoCache=Rs.GetRows(-1)
			Rs.Close
			Set Rs=Nothing
			Cache.add "GradeInfo",SetGradeInfoCache,dateadd("n",5000,now)
		End If
	End Function
	
	Public Function GetGradeInfo(GradeID)
		Dim ARs,i
		ARs=SetGradeInfoCache()
		For i=0 To Ubound(ARs,2)
		If int(ARs(0,i))=Int(GradeID) Then
			GetGradeInfo=ARs(0,i)&"|"&ARs(1,i)&"|"&Ars(2,i)&"|"&Ars(3,i)&"|"&Ars(4,i)&"|"&Ars(5,i)&"|"&Ars(6,i)
			Exit Function
		End If
		Next
	End Function
	
	Public Function GetGradeName(GID,GFlag)
		Dim ARs,i
		ARs=SetGradeInfoCache()
		For i=0 To Ubound(ARs,2)
		If (int(ARs(0,i))=Int(GID) And GFlag=0) or (GFlag<>0 And GFlag=Int(ARs(1,i))) Then
			GetGradeName=ARs(2,i)
			Exit Function
		End If
		Next	
	End Function


	'公告
	Public Function Placard(Ast)
		Dim Temp,Rs,Arr_Rs,i
		If Cache.valid("Placard") then
			Arr_Rs=Cache.Value("Placard")
		Else
			Set Rs=Execute("Select Id,Caption,AddTime,BoardID From [KK_Placard] order by Id desc")
			If Rs.Eof Or Rs.Bof Then
				Temp=" "
				Placard=Temp
				Exit Function
			Else
				Arr_Rs=Rs.GetRows(-1)
				Rs.Close
				Cache.add "Placard",Arr_Rs,dateadd("n",5000,now)
			End if
		End if
		For i=0 To Ubound(Arr_Rs,2)
		If Arr_Rs(3,i)=Ast Then
			Temp=Temp&" ·<a href=""javascript:onclick=openwin('See.asp?Action=Placard&ID="&Arr_Rs(0,i)&"',600,400,'yes')"">"&Fun.HtmlCode(Arr_Rs(1,i))&"&nbsp;<span style='font-size:10px'>["&Arr_Rs(2,i)&"]</span></a> "
		End If
		Next
		If Temp="" Then Temp="没有公告"
		Placard=Temp
	End Function
	
'缓存版块 0深度+1ID+2父ID+3名称+4图片+5简介+6版主+7主题+8总帖+9今日帖+10最后复+11认证用+12子论坛+13子论组+14组类+15版数组
'获得全部版块
	Public Function GetBoardCache()
		If Cache.valid("BoardInfo") then
			Board_Rs=Cache.Value("BoardInfo")
		Else
			Dim Rs
			Set Rs=Execute("Select Depth,BoardID,ParentID,Boardname,BoardImg,Introduce,BoardAdmin,PassUser,Child,ParentStr,RootID,Strings From[KK_Board] order by RootID,Orders")
			If Rs.Eof Then
				Exit Function
			Else
				Board_Rs=Rs.GetRows(-1)
				Cache.add "BoardInfo",Board_Rs,dateadd("n",5000,now)
			End If
			Rs.Close
			Set Rs=Nothing
		End If
	End Function
	
'加载每个版块动态缓存
	Public Sub LoadingEachBoardCache()
		Dim Rs,Temp,B_RS,I
		Set Rs=Execute("Select BoardID,EssayNum,TopicNum,TodayNum,LastReply From[KK_Board] order by BoardID")
		If Rs.Eof Then
			Exit Sub
		Else
			B_Rs=Rs.GetRows(-1)
		End If
		Rs.Close
		Set Rs=Nothing
		For I=0 To Ubound(B_Rs,2)
			Temp=B_RS(1,I)&"|"&B_RS(2,I)&"|"&B_RS(3,I)&"|"&B_Rs(4,I)
			Cache.add "Board"&B_Rs(0,I),Temp,dateadd("n",120,now)
		Next
	End Sub
'获得单个版块动态缓存 0总帖数1主题数2今日帖3最后复。。
	Public Function GetEachBoardCache(B_ID)
		If Not Cache.valid("Board"&B_ID) Then LoadingEachBoardCache()
		GetEachBoardCache=Split(Cache.Value("Board"&B_ID),"|")
	End Function
'更新
	Public Sub UpdateEcachBoardCache(B_ID,Str)
	Dim Temp,i,TStr
	B_ID=Split(B_ID,",")
	Str=Str&"||||||||"'防止特殊版面为空出错
	For I=0 To ubound(B_ID)
		TStr=Split(Str,"|")
		Temp=GetEachBoardCache(B_ID(i))
		Cache.add "Board"&B_ID(i),Temp(0)+Int(TStr(0))&"|"&Temp(1)+Int(TStr(1))&"|"&Temp(2)+Int(TStr(2))&"|"&TStr(3)&"|"&TStr(4)&"|"&TStr(5)&"|"&TStr(6)&"|"&TStr(7)&"|"&TStr(8)&"|"&TStr(9),dateadd("n",120,now)
	Next
	End Sub
	
'版块信息;入口(样式,BoardID)
	Public Function GetBoardInfo(Str,Ast)
	Dim Temp,I,BoardtypeName,BoardtypePic,BoardAdmin,BoardAdmin1,LastStr,Boardupdate
	Dim Strings
	Strings=Split(Board_Rs(11,Ast),"|")
	If Str="1" Then
	Str=ReadSkins("显示简洁版块")
	Else
	Str=ReadSkins("显示版块")
	End If
	If Strings(7)="1" Then
		BoardTypeName="锁定论坛":Boardtypepic=SkinsPIC(6)
	ElseIf Strings(6)="1" or Strings(5)="1" Then
		BoardtypeName="特殊论坛":Boardtypepic=SkinsPIC(5)
	ElseIf Strings(8)="1" or Strings(3)="1" Then
		BoardTypeName="限制论坛":Boardtypepic=SkinsPIC(4)
	Else
		BoardtypeName="普通论坛":Boardtypepic=SkinsPIC(3)
	End If

	If Board_Rs(4,Ast)="" or IsNull(board_Rs(4,Ast)) Then
		temp=""
	Else
		Temp="<a href='List.asp?BoardID="&board_Rs(1,Ast)&"'><img border='0' src='"&board_Rs(4,Ast)&"' alt='"&board_Rs(3,Ast)&"' /></a>"
	End if
	Str = Replace(Str,"{版块类型图片}",BoardTypePic)
	Str = Replace(Str,"{版块图片}",Temp)
	If board_Rs(8,Ast)>0 Then Temp=" ["&board_Rs(8,Ast)&"]" Else Temp=""
		Str = Replace(Str,"{类型}",BoardtypeName)
		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(5,Ast))
		If Board_Rs(6,Ast) = "" Or IsNull(board_Rs(6,Ast)) Then 
			BoardAdmin="暂无":BoardAdmin1="暂无"
		Else
			Temp=split(board_Rs(6,Ast),"|")
			BoardAdmin=""
			for I=0 to ubound(Temp)
				BoardAdmin=BoardAdmin&"&nbsp;&nbsp;<a href='Userinfo.asp?Name="&Temp(I)&"' title='点击查看版主："&Temp(I)&" 的信息'>"&Temp(I)&"</a>"
			Next
		End If
		BoardAdmin1=Replace(BoardAdmin,"&nbsp;&nbsp;","<br>")'竖排
		Str=Replace(Str,"{版主竖排}",BoardAdmin1)
		Str = Replace(Str,"{版主}",BoardAdmin)
		Boardupdate=GetEachBoardCache(Board_Rs(1,Ast))
		Str = Replace(Str,"{总帖数}",Boardupdate(0))
		Str = Replace(Str,"{主题数}",Boardupdate(1))
		Str = Replace(Str,"{今日帖数}",Boardupdate(2))
		If Strings(6)="1" or Strings(5)="1" Then
			Temp="<div style='margin:20px 0'>特殊论坛，发帖信息保密！</div>"
		Else
			If Boardupdate(3)="" Then
				Temp=""
			Else
				Temp=ReadSkins("最后发帖信息")
				Temp= Replace(Temp,"{用户名称}",Boardupdate(3))
				Temp= Replace(Temp,"{回复时间}",Boardupdate(5))
				Temp= Replace(Temp,"{表情}","<img align='absmiddle' src='pic/face/"&Boardupdate(6)&".Gif' />")
				Temp= Replace(Temp,"{主题ID}",Boardupdate(7))
				Temp= Replace(Temp,"{版块ID}",Boardupdate(8))
				Temp= Replace(Temp,"{数据表ID}",Boardupdate(9))
				Temp= Replace(Temp,"{帖子信息}",Boardupdate(4))
			End If
		End If
		Str = Replace(Str,"{最后发帖信息}",Temp)
		GetBoardInfo=Str
	End Function
	
	'检验版块
	Public Sub CheckBoard()
      If Not IsArray(Board_Rs) Then GetBoardCache()
	  If Not IsArray(Board_Rs) Then GotoErr(10)
		Dim Temp,i,PassUser
		If BoardID=0 Then GotoErr(1)
		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
				'BoardIntroduce=Board_Rs(5,i)
				BoardAdmin=Board_Rs(6,i)
				PassUser=Board_Rs(7,i)
				BoardChild=Board_Rs(8,i)
				BoardParentStr=Board_Rs(9,i)
				BoardRootID=Board_Rs(10,i)
				BoardString=Split(Board_Rs(11,i),"|")
				Exit For
			End If
		Next
		If BoardName="" or isnull(BoardName) Then GotoErr(10)
		IsBoardAdmin=False
		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(10,i)=BoardRootID And Board_Rs(0,i)<>0 Then BoardRoots=BoardRoots&Board_Rs(1,i)&","
			If Int(BoardDepth)>0 Then
				If InStr(","&BoardParentStr&",",","&Board_Rs(1,i)&",")>0 Then
'0深度，1ＩＤ，2父ＩＤ，3名称，4图片，5简介，6版主，7认证用户，8子论坛，9子论组，10组类，11组
				'如果上级论坛为会员版面
					If BoardString(3)="1" Then If  Not Founduser then GoToErr(10)
				'上级版主管理下级
					If Info(48)="1" And FoundUser Then
						If InStr("|"&Board_Rs(6,i)&"|","|"&MyName&"|")>0 And FoundUser And BoardAdmin<>"" Then IsBoardAdmin=True
					End If
					Temp=Temp &" → <a href='List.asp?BoardID="&Board_Rs(1,i)&"'>"&Board_Rs(3,i)&"</a>"
				End If
			End If
		Next
		'记录整个区版块ID
		If BoardRoots<>"" Then
			BoardRoots=Left(BoardRoots,len(BoardRoots)-1)
		End If
		Position=Position & Temp &" → <a href='List.asp?BoardID="&BoardID&"'>"&Stats&"</a>"
		If instr(PageUrl,"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&"&nbsp;&nbsp;<a href='Userinfo.asp?Name="&Temp(I)&"' title='点击查看版主："&Temp(I)&" 的信息'>"&Temp(I)&"</a>"
				next
			End If 
		End If
		If MyAdmin=9 Then Exit Sub
		'版组说明：0/1(0类)|0/1(1简洁)|(2简洁个数)|0/1(3会员)|0/1(4只读)|0/1(5VIP)|0/1(6认证)|0/1(7锁定)|0/1(8会员限制)|(9等级进入)|(10限帖数)|(11限积分)|(12限金币)|(13限游戏币)|0/1/2(13上传)|备用...
'       锁定
		If BoardString(7)="1" And Not IsBoardAdmin Then GoToErr(12)
		'VIP
		If BoardString(5)="1" Then
			If Not FoundUser Then GoToErr(10)
			If Session(CacheName & "MyInfo")(17)="0" Then GoToErr(13)
		End IF
		'认证
		If BoardString(6)="1" Then
			If PassUser="" or isnull(PassUser) Then GotoErr(14)
			If InStr("|"&PassUser&"|","|"&Lcase(MyName)&"|")=0 or MyName="" Then GotoErr(14)
		End If
		If BoardString(9)="1" Then
			If Not FoundUser Then GotoErr(10)
			'限帖数
			If Int(BoardString(10))>Int(Session(CacheName & "MyInfo")(4)) Then GotoErr(16)
			'限积分
			If Int(BoardString(11))>Int(Session(CacheName & "MyInfo")(6)) Then GotoErr(17)
			'限金钱
			If Int(BoardString(12))>Int(Session(CacheName & "MyInfo")(7)) Then GotoErr(18)
			'限游戏币
			If Int(BoardString(13))>Int(Session(CacheName & "MyInfo")(8)) Then GotoErr(19)
		End If
		'只读
		If BoardString(4)="1" And (Instr(PageUrl,"say.asp")>0 or Instr(PageUrl,"saysave.asp")>0) And Not IsBoardAdmin Then GotoErr(100)
		If BoardString(3)="1" Then
			If Instr(PageUrl,"list.asp")>0 Then Exit Sub
			If Not Founduser Then GoToErr(10)
		End If
	End Sub
	
	'版块下拉列表(当前ID，不显示的深度)
	Public Function BoardIDList(Ast,Depth)
		Dim Temp,I,II,po
		If Not IsArray(Board_Rs) Then GetBoardCache()
		If IsArray(Board_Rs) Then
			For i=0 To Ubound(Board_Rs,2)
				Po=""
				If Board_Rs(0,i)<>Depth Then
					If Board_Rs(0,i)<>0  Then
						For II=1 To Board_Rs(0,i)
						Po=Po&" ∣ "
						Next
					End If
					Temp=Temp&"<option value='"&Board_Rs(1,i)&"'"
					If Board_Rs(1,i)=Ast Then Temp=Temp&" selected"
					Temp=Temp&">&nbsp;"&Po&" ├ "&Board_Rs(3,i)&"</option>"
				End If
			Next
			BoardIDList=Temp
		End If
	End Function
	
	'过滤特殊帖
	Public Function CheckEspecial(str)
		Dim re,restr
		Set re=new RegExp
		re.IgnoreCase=true
		re.Global=True
		If Info(68)="0" Then
		re.Pattern="(\[code\])(.+?)(\[\/code\])"
		str=re.replace(str,"$2")		
		End If
		If Info(70)="0" Then
		re.Pattern="(\[reply\])(.+?)(\[\/reply\])"
		str=re.replace(str,"$2")
		End If
		If Info(71)="0" Then
		re.Pattern="(\[COIN=*([0-9]*)\])(.+?)(\[\/COIN\])"
		str=re.replace(str,"$3")
		End If
		If Info(72)="0" Then
		re.Pattern="(\[MARK=*([0-9]*)\])(.+?)(\[\/MARK\])"
		str=re.replace(str,"$3")
		End If
		If Info(73)="0" Then
		re.Pattern="(\[DATE=(.[^\[]*)\])(.+?)(\[\/DATE\])"
		str=re.replace(str,"$3")
		End If
		If Info(74)="0" Then
		re.Pattern="(\[SEX=*([0-1]*)\])(.+?)(\[\/SEX\])"
		str=re.replace(str,"$3")
		End If
		If Info(75)="0" Then
		re.Pattern="(\[login\])(.+?)(\[\/login\])"
		str=re.replace(str,"$2")
		End If
		If Info(76)="0" Then
		re.Pattern="(\[USERNAME=(.[^\[]*)\])(.+?)(\[\/USERNAME\])"
		str=re.replace(str,"$3")
		End If
		If Info(77)="0" Then
		re.Pattern="(\[BUYPOST=*([0-9]*)\])(.+?)(\[\/BUYPOST\])"
		str=re.replace(str,"$3")
		End If
		CheckEspecial=str
		Set re=Nothing
	End Function
	
	'记录认证和Vip版块的标记
	Public Function NoShowTopic()
		Dim Temp,i,Strings
		If Not IsArrAy(Board_Rs) Then GetBoardCache()
		If IsArray(Board_Rs) Then
			Temp=""
			For i=0 To Ubound(Board_Rs,2)
			Strings=Split(Board_Rs(11,i),"|")
			If Strings(6)="1" or Strings(5)="1" 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 GetBoardName(Ast)
		Dim i
		If Ast<1 then GetBoardName="<a href='Index.asp'>所有版块</a>":Exit Function
		If Not IsArray(Board_Rs) Then GetBoardCache()
		If IsArray(Board_Rs) Then
			For i=0 To Ubound(Board_Rs,2)
			IF Board_Rs(1,i)=Ast Then
				GetBoardName="<a href='List.asp?BoardID="&Board_Rs(1,i)&"'>"&Board_Rs(3,i)&"</a>"
				Exit For
			End IF
			Next
		End If
	End Function
			
	Public function CheckNum(str)
		If isnull(str) or str="" then Str=0
		If not isnumeric(str) then GotoErr(1)
		CheckNum=int(str)
	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 & " 毫秒 "
		Else
			tTimeOver = FormatNumber(Timer() - StartTime, 6, true)
			getTimeOver = " 执行时间：" & tTimeOver & " 秒 "
		End If
	End Function
	
	
	 Private Sub OpenSkins()
		'Cache.clean("Skin_"& SkinID)
		If Cache.valid("Skin_"& SkinID) then
			Skins=Cache.value("Skin_"& SkinID)
		Else 
		Dim Rs,Temp
	    Set Rs=Execute("Select Top 1 Pic,Content From [KK_Skins] Where SkinID="&SkinID&"")'"&SkinID)
		 If Not Rs.Eof Then
		 Temp="[94KK@PIC]"&Rs(0)&"[/94KK@PIC]"&Rs(1)
			 Cache.add "Skin_"&SkinID,Temp,dateadd("n",5000,now)
			 Skins=Temp
			 Rs.Close
			 Set Rs= Nothing
		 Else
			Print "没有模版或已被删除了！<br /><A HREF=Cookies.asp?Action=Style&SkinID=0>请点这里更新你的Cookies</A>"
		 End If
	  End If
   End Sub
	Public Function ReadSkins(TempLateName)
		If Instr(Skins,"["&TempLateName&"]")=0 or Instr(Skins,"[/"&TempLateName&"]")=0 Then
		   Print "风格模版不完整,程序终止! <br /><span style='color:#AAA'>模版出错标记:["&TempLateName&"]</span>"
		End If
		Dim TempStr,BeNum,EnNum,BStr,EStr
		BStr="["&TempLateName&"]"
		EStr="[/"&TempLateName&"]"
		BeNum=InStr(Skins,BStr)
		EnNum=InStr(BeNum+Len(BStr),Skins,EStr)
		On Error Resume Next
		TempStr=Mid(Skins,BeNum+Len(BStr),EnNum-BeNum-Len(BStr))
		If Err Then
		  Print "在处理"&TempName&"模版时出错"
		End If
		ReadSkins=TempStr
 	End Function
	
	Public Sub Netlog(str)
		Dim Temp,UserName
		UserName=MyName
		If UserName="" Then UserName="-"
		Temp=Left(Request.ServerVariables("script_name")&"<br>"&Replace(Request.ServerVariables("Query_String"),"'","''"),255)
		Execute("insert into KK_Log (UserName,UserIP,Remark,LogTime,Geturl) values ('"&UserName&"','"&MyIP&"','"&str&"','"&NowBbsTime&"','"&Temp&"')")
	End Sub
	
	Function Row(A,B,W,H)
		If H<>"" Then 
			H="min-height:"&H&";"
			If MSIE Then H=Replace(H,"min-","")
		End If
		Row="<div style=""text-align:left;border-bottom:1px solid "&SkinsPIC(0)&";""><div style=""line-height:18px;text-align:left;padding:2px;float:right;width:"&W&";"&H&"text-align :left;border-left:1px solid "&SkinsPIC(0)&""">"&B&"</div><div style=""text-align:left;padding:2px;line-height:18px;"">"&A&"</div><div style=""clear: both;""></div></div>"
	End Function
	
	Function Row1(str)
		Row1="<div style=""text-align:left;border-bottom:1px solid "&SkinsPIC(0)&";line-height:18px;"">"&Str&"</div>"
	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 function CheckMake()
		Dim Come,Here
		Come=Cstr(Request.ServerVariables("HTTP_REFERER"))
		Here=Cstr(Request.ServerVariables("SERVER_NAME"))
		If Come<>"" And Mid(Come,8,Len(Here)) <> Here Then GoToErr(2)
	End function
	
	Public Sub GoToErr(ErrNum)
		'If ErrNum=1 Then NetLog "非法改动参数，试图功击。"
		Response.Redirect "Error.asp?ErrNum=" & ErrNum
		Response.End
	End Sub
	
	Private Sub Print(Msg)
    	'输出提示信息
  		Response.Write "<br /><div style='color:#F00'>" & Msg & "</div>"
		Response.End
	End Sub
		'通用表格显示（标题，内容）
	Public Sub ShowTable(Str1,Str2)
		Dim Temp
		Temp=ReadSkins("通用内容表格")
		Temp=Replace(Temp,"{标题}",Str1)
		Temp=Replace(Temp,"{内容}",Str2)
		Response.Write(Temp)
	End Sub
	Public Function GetSafeCode()
		GetSafeCode="<input name=""safecode"" type=""text"" size=""6"" maxlength=""5"" /> <script type=""text/javascript"">document.write(""<img  align='absmiddle' src='Inc/SafeCode.asp?"",Math.random(),""' alt='请输入图片验证码'>"")</script>"
	End Function 
   	Public Sub Alert(msg,goUrl)
		msg = replace(msg,"'","\'")
	  	If goUrl="back" Then
	  		goUrl="history.go(-1);"
		Else
			goUrl="window.location.href='"&goUrl&"'"
		End IF
		Response.Write ("<script language=""JavaScript"" type=""text/javascript"">"&vbNewLine&"alert('" & msg & "');"&goUrl&vbNewLine&"</script>")
		Response.End
	End Sub
	
End Class
Class Cls_Cache
	Private Ca,CacheStr,expireTime,expireTimeName,path
	Private sub class_initialize()
	path=CacheName
	End Sub
	
	Private property let Name(Str) '缓存名称/属性
	CacheStr=str&path
	Ca=Application(CacheStr)
	expireTimeName=str&"expire"&path
	expireTime=Application(expireTimeName)
	End property

	Public property let expire(Str,tm) '设置缓存过期时间/属性
	Name=Str
	expireTime=tm
	Application.Lock()
	Application(expireTimeName)=expireTime
	Application.UnLock()
	End property
		
	Public property get valid(str)'检查
	Name=Str
	if isEmpty(Ca) or (not isdate(expireTime) or CDate(expireTime)<CDate(BBS94KK.NowBBSTime)) then
	valid=false
	else
	valid=true
	end if
	end property

	Public property get value(Str)
	Name=Str
	if isEmpty(Ca) or not isDate(expireTime) then
	value=null
	elseif CDate(expireTime)<now then
	value=null
	else
	value=Ca
	end if
	end property

	Public sub add(Str,varCache,varExpireTime) '对缓存赋值/方法
	Name=Str
	IF isEmpty(varCache) or not isDate(varExpireTime) then exit sub
	Ca=varCache
	expireTime=varExpireTime
	Application.lock
	Application(CacheStr)=Ca
	Application(expireTimeName)=expireTime
	Application.unlock
	End Sub

	Public sub clean(Str) '释放缓存/方法
	Name=Str
	Application.lock
	Application(CacheStr)=Empty
	Application(expireTimeName)=Empty
	Application.unlock
	Ca=Empty
	ExpireTime=Empty
	End Sub
End Class
%>
