<%
Dim Ad_3(100),i3
Class Cls_Forum
	Rem Const
	Public BoardID,SqlQueryNum,Forum_Info,Forum_Setting,Forum_user,Forum_Copyright,Forum_ads,Forum_ChanSetting
	Public Forum_sn,Forum_Version,Stats,StyleName,ErrCodes,NowUseBBS,Cookiepath
	Public lanstr,mainhtml,mainsetting,sysmenu,mainpic
	Public MyUserInfo,UserToday,BoardJumpList,BoardList,CacheData,Maxonline
	Public UserGroupID,Lastlogin,GroupSetting,FoundUserPer
	Public Vipuser,Boardmaster,Superboardmaster,Master,FoundIsChallenge,FoundUser
	Public ScriptName,MemberName,MemberWord,MemberClass,UserHidden,UserID,UserTrueIP,UserPermission
	Public sendmsgnum,sendmsgid,sendmsguser,Page_Admin,Forum_AdLoop3
	Public BadWords,rBadWord,Forum_emot,Forum_PostFace,Forum_UserFace,SkinID
	Private adcode_1,adcode_2,adcode_4,ScriptTrueUrl,Forum_CSS,Main_Sid,ReloadCount,Nowstats,CssID
	Public Reloadtime,CacheName
	Private LocalCacheName,Cache_Data,IsTopTable,CookiesSid
	Public Board_Setting,boarduser,LastPost,Board_Ads,Board_user,BoardType,IsGroupSetting,BoardMasterList,Board_Data,Sid,Boardreadme,BoardRootID,BoardParentID
	Rem Sub 
	Private Sub Class_Initialize()
		Dim UserAgent,path
		UserAgent = Trim(Lcase(Request.Servervariables("HTTP_USER_AGENT")))
		If InStr(UserAgent,"teleport") > 0 or InStr(UserAgent,"webzip") > 0 or InStr(UserAgent,"flashget")>0 or InStr(UserAgent,"offline")>0 Then
			Response.Write "请不要采用teleport/Webzip/Flashget/Offline等工具来浏览论坛！"
			Response.End
		End If
		SqlQueryNum = 0
		Reloadtime=14400
		CacheName=Replace(Replace(Replace(Server.MapPath("index.asp"),"index.asp",""),":",""),"\","")
		ReloadCount=0
		IsTopTable = 0
		Forum_sn = CacheName:Vipuser = False:Boardmaster = False
		Superboardmaster = False:Master = False:FoundIsChallenge = False:FoundUser = False
		BoardID = Request("BoardID")
		'If BoardID="" Then BoardId=Request.Form("BoradID")
		If IsNumeric(BoardID) = 0 or BoardID = "" Then BoardID = 0
		BoardID = Clng(BoardID)
		MemberName = checkStr(Trim(Request.Cookies(Forum_sn)("username")))
		MemberWord = checkStr(Trim(Request.Cookies(Forum_sn)("password")))
		UserHidden = Request.Cookies(Forum_sn)("userhidden")
		UserID = Trim(Request.Cookies(Forum_sn)("UserID"))
		If IsNumeric(UserHidden) = 0 or Userhidden = "" Then UserHidden = 2
		If IsNumeric(UserID) = 0 Or UserID="" Then UserID=0
		UserID = Clng(UserID)
		UserTrueIP = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
		If UserTrueIP = "" Then UserTrueIP = Request.ServerVariables("REMOTE_ADDR")
		UserTrueIP = CheckStr(UserTrueIP)
		Dim Tmpstr,i
		Tmpstr = Request.ServerVariables("PATH_INFO")
		Tmpstr = Split(Tmpstr,"/")
		i = UBound(Tmpstr)
		ScriptName = Lcase(Tmpstr(i))
		MemberClass = checkStr(Request.Cookies(Forum_sn)("userclass"))
		Page_Admin=False
		If InStr(ScriptName,"showerr")>0 Or InStr(ScriptName,"login")>0 Or InStr(ScriptName,"reg")>0 Or InStr(ScriptName,"admin_")>0 Then Page_Admin=True
		sendmsgnum=0:sendmsgid=0:sendmsguser=""
	End Sub
	Private Sub class_terminate()
		If IsObject(Conn) Then 
			Conn.Close
			Set Conn = Nothing
		End If 
	End Sub
	Public Property Let Name(ByVal vNewValue)
		LocalCacheName=LCase(vNewValue)
	End Property
	Public Property Let Value(ByVal vNewValue)
		If LocalCacheName<>"" Then 
			ReDim Cache_Data(2)
			Cache_Data(0)=vNewValue
			Cache_Data(1)=Now()
			Application.Lock
			Application(CacheName & "_" & LocalCacheName) = Cache_Data
			Application.unLock
		Else
			Err.Raise vbObjectError + 1, "DvbbsCacheServer", " please change the CacheName."
		End If
	End Property
	Public Property Get Value()
		If LocalCacheName<>"" Then 
			Cache_Data=Application(CacheName & "_" & LocalCacheName)	
			If IsArray(Cache_Data) Then
				Value=Cache_Data(0)
			Else
				Err.Raise vbObjectError + 1, "DvbbsCacheServer", " The Cache_Data("&LocalCacheName&") Is Empty."
			End If
		Else
			Err.Raise vbObjectError + 1, "DvbbsCacheServer", " please change the CacheName."
		End If
	End Property
	Public Function ObjIsEmpty()
		ObjIsEmpty=True	
		Cache_Data=Application(CacheName & "_" & LocalCacheName)
		If Not IsArray(Cache_Data) Then Exit Function
		If Not IsDate(Cache_Data(1)) Then Exit Function
		If DateDiff("s",CDate(Cache_Data(1)),Now()) < (60*Reloadtime) Then ObjIsEmpty=False		
	End Function
	Public Sub DelCahe(MyCaheName)
		Application.Lock
		Application.Contents.Remove(CacheName&"_"&MyCaheName)
		Application.unLock
	End Sub
	'取得基本设置数据
	Public Sub GetForum_Setting()
		Name="setup"
		If ObjIsEmpty() Then ReloadSetup()
		CacheData=value
		'每日更新数据
		Name="Date"
		'DelCahe "Date"
		'第一次起用论坛或者重启IIS的时候加载缓存
		If ObjIsEmpty() Then
			value=Date()
			ReloadAllForumInfo
			ReloadAllBoardInfo
		End If
		Name="Date"
		If Cstr(value) <> Cstr(Date()) Then
			ReloadAllForumInfo
			ReloadAllBoardInfo
			Name="setup"
			ReloadSetup()
			CacheData=value
		End If
		Dim Setting
		Setting=CacheData(1,0)
		Setting = Split(Setting,"|||")
		Forum_Info = Setting(0)
		Forum_Info = Split (Forum_Info,",")
		Forum_Setting = Setting(1)
		Forum_Setting = Split (Forum_Setting,",")
		Forum_user = Setting(2)
		Forum_user = Split (Forum_user,",")
		Forum_Copyright = Setting(3)
		Forum_ChanSetting = CacheData(24,0)
		Forum_ChanSetting = Split(Forum_ChanSetting,",")
		Forum_Version = CacheData(18,0)
		BadWords = Split(CacheData(3,0),"|")
		rBadWord = Split(CacheData(4,0),"|")
		Main_Sid=CacheData(17,0)
		Maxonline = CacheData(5,0)
		NowUseBBS = CacheData(19,0)
		Cookiepath = CacheData(26,0)

		'关闭论坛相关部分
		If Forum_Setting(21)="1" And Not Page_Admin Then Response.redirect "showerr.asp?action=stop"		
		Dim OpenTime,tmpsetting,ischeck
		'判断BoardID的值，获取对应的设置
		If BoardID>0 Then
			If BoardID=444 Or BoardID=777 Or BoardID="" Then
  				Response.Write "错误的版面参数"
  				Response.End
			End If
			Name="BoardInfo_" & BoardID
  			If ObjIsEmpty() Then ReloadBoardInfo(BoardID)
			Board_Data = Value
			boarduser = Split(Board_Data(13,0) & "",",")
			Board_Ads = Split(Board_Data(17,0),"$")
			Board_user = Split(Board_Data(18,0),",")
			Forum_user = Board_User
			board_Setting = Split(Board_Data(16,0),",")
			LastPost = Split(Board_Data(14,0),"$")
			BoardType = Board_Data(1,0)
			IsGroupSetting = Board_Data(19,0)
			BoardMasterList = Board_Data(8,0)
			BoardRootID = Board_Data(5,0)
			BoardParentID=Board_Data(2,0)
			Sid = Board_Data(15,0)
			Boardreadme=Board_Data(7,0)
			OpenTime=Split(Board_Setting(22),"|")
			tmpsetting=Board_Setting(21)
			Forum_ads =Board_Ads
			ischeck=Clng(Board_Setting(18))
			If Board_Setting(50)<>"0" And Board_Setting(50)<>"" Then Response.Redirect Board_Setting(50)
			If IsNumeric(Board_Data(21,0)) And CLng(Board_Data(6,0)) >0 And CInt(Board_Data(4,0))< 2 Then LoadBoardList(BoardID) 
		Else
			Forum_ads =  CacheData(2,0)
			Forum_ads = Split(Forum_ads,"$")
			OpenTime=Split(Forum_Setting(70),"|")
			tmpsetting=Forum_Setting(69)
			ischeck=Forum_Setting(26)
			If Not IsNumeric(ischeck) Then ischeck=0
			ischeck=CLng(ischeck)		
		End If
		'IP锁定
		If Not Page_Admin Then IPlock()
		'定时开放判断
		If Not Page_Admin And Cint(tmpsetting)=1 and Ubound(OpenTime)=1 Then
			If IsNumeric(OpenTime(0)) and IsNumeric(OpenTime(1)) Then
				If CInt(OpenTime(0))< CInt(OpenTime(1)) Then
					If Hour(Now)<Cint(OpenTime(0)) or Hour(Now)>Cint(OpenTime(1)) Then Response.redirect "showerr.asp?action=stop&time"&OpenTime(0)&","&OpenTime(1)
				Else
					If Hour(Now)< Cint(OpenTime(0)) And Hour(Now) > Cint(OpenTime(1)) Then Response.redirect "showerr.asp?action=stop&time"&OpenTime(0)&","&OpenTime(1)
				End If
			End If
		End If
		'在线人数限制
		If ischeck > 0 And Not Page_Admin Then
			If MyBoardOnline.Forum_Online > ischeck And BoardID=0 Then
				If Not IsONline(Membername,1) Then Response.Redirect "showerr.asp?action=limitedonline&lnum="&ischeck
			End If
			If BoardID<> 0 Then
				If (Not IsONline(Membername,1)) And MyBoardOnline.Board_Online > ischeck Then Response.Redirect "showerr.asp?action=limitedonline&lnum="&ischeck
			End If
		End If
		If Forum_ChanSetting(0)="1" And Forum_ChanSetting(1)="1" Then Get_Chan_Ad
	End Sub 
	Public Function IsONline(UserName,action)
		IsONline=False
		If Trim(UserName)="" Then Exit Function
		If IsArray(Session(CacheName & "UserID")) And action=1 Then
			If Session(CacheName & "UserID")(0)="Dvbbs" Then
				IsONline=True:Exit Function 
			End If
		End If
		Dim Rs
		Set Rs =Execute("Select Count(*) From Dv_Online Where Username='"&UserName&"'")
		If Rs(0)<> 0 Then IsONline=True
		Set rs=Nothing  
	End Function  
	Public Sub ReloadSetup()
		Dim SQL,Rs,i
		SQL = "Select * from [Dv_setup] "
		Set Rs = Execute(SQL)
		value = Rs.GetRows(1)
		Set Rs = Nothing
	End Sub 
	Public Sub ReloadTemplateslist()		
		Dim Rs,SQL,tmpdata
		SQL = "select ID,StyleName from [Dv_Style]"
		Set Rs = Execute(SQL)
		tmpdata = Rs.GetString(,,"|||","@@@","")
		tmpdata = Left(tmpdata,Len(tmpdata)-3)	
		Set Rs = Nothing 
		value=tmpdata
	End Sub
	Public Sub LoadTemplates(Page_Fields)
		If IsDeBug = 0 Then On Error Resume Next'容错代码。
		Dim Style_Pic,Main_Style,TempStyle
		CookiesSid = Request.Cookies("skin")("SkinID_"&BoardID)
		If Not IsNumeric(CookiesSid) Or CookiesSid = "" Then
			If BoardID = 0 Then 
				SkinID = Main_Sid
			Else
				SkinID = sid
			End If
		Else
			SkinID=CookiesSid
		End If
		SkinID=CLng(SkinID)
		Name="StyleName"&SkinID
		If ObjIsEmpty() Then TemplatesToCache ("StyleName")
		StyleName=value
		Name="Forum_CSS"&SkinID
		If ObjIsEmpty() Then TemplatesToCache ("Forum_CSS")
		'风格换肤修改
		CssID=Request.Cookies("skin")("cssid_"&BoardID)
		If CssID="" Then CssID=0
		CssID=CLng(CssID)
		TempStyle=value		
		TempStyle=Split(TempStyle,"@@@")
		If CssID > UBound(Split(TempStyle(1),"|||"))-1 Then
			CssID=0
		End If
		Forum_CSS=Split(TempStyle(1),"|||")(CssID)
		
		Name="Main_Style"&SkinID
		If ObjIsEmpty() Then TemplatesToCache ("Main_Style")
		Main_Style=value
		If Not (Instr(ScriptName,"index")>0 Or Instr(ScriptName,"list")>0) Then
			Name="Style_Pic"&SkinID
			If ObjIsEmpty() Then TemplatesToCache ("Style_Pic")
			Style_Pic=value
			Style_Pic = Split(Style_Pic,"@@@")
			Forum_UserFace = Style_Pic(0)
			Forum_PostFace = Style_Pic(1)
			Forum_Emot = Style_Pic(2)
		End If
		If Page_Fields<>"" Then
			Name="page_"&Page_Fields&SkinID
			If ObjIsEmpty() Then TemplatesToCache ("page_"&Page_Fields)
			Template.value=value	
		End If
		Main_Style = Split(Main_Style,"@@@")
		mainhtml = Split(Main_Style(0),"|||")
		lanstr = Split(Main_Style(1),"|||")
		mainpic = Split(Main_Style(2),"|||")
		mainsetting = Split(mainhtml(0),"||")
		If IsDeBug = 0 Then
			If Err Then
				err.Clear
				If ReloadCount=0 Then 
					ReloadCount=1
					DelCahe "StyleName"&SkinID
					DelCahe "Forum_CSS"&SkinID
					DelCahe "Main_Style"&SkinID
					DelCahe "Style_Pic"&SkinID
					If Page_Fields<>"" Then DelCahe "page_"&Page_Fields&SkinID
					LoadTemplates Page_Fields
				End If
			End If
		End If	
	End Sub
	Public Sub TemplatesToCache(Page_Fields)
		Dim Rs,SQL
		SQL = "Select "&Page_Fields&" from [Dv_Style] where id = " & SkinID
		Set Rs = Execute(SQL)
		If Not Rs.EOF Then
			value=Rs(0)
		Else
			'处理错误
			If boardid<>0 Then
				If Cint(SkinID)=Cint(sid) Then Fixsid()
			Else
				If SkinID=CInt(CacheData(17,0)) Then
					Call FixSetupsid()		
				End if
			End If
			Response.redirect "cookies.asp?action=stylemod&SkinID=0&boardid="&Boardid					
		End If
		Set Rs = Nothing
	End Sub
	Private Sub Fixsid()
		Dim Rs,SQL
		SQL = "Select Count(*) from [Dv_Style] where id = " & sid
		Set Rs = Execute(SQL)
		If Rs(0)=0 Then
			'把该版的SID更新为系统缺省的值
			Execute("Update Dv_Board Set Sid="&CLng(CacheData(17,0))&" where BoardID="&BoardID&"")
			'更新该版面的缓存
			ReloadBoardCache BoardID,CacheData(17,0),15,0
		End If
		Set Rs = Nothing
	End Sub 
	Private Sub FixSetupsid()
		Dim Rs,SQL
		SQL = "Select Top 1 ID from [Dv_Style] Order by ID"
		Set Rs = Execute(SQL)
		If Rs.EOF Then
			Response.Write "论坛模板数据是空的，请添加。"
			Response.End 	
		Else
			ReloadSetupCache Rs(0),17
			Execute("Update Dv_Setup Set Forum_Sid="&Rs(0)&"")
		End If
		Set rs=Nothing 
	End Sub 
	Rem 判断发言是否来自外部
	Public Function ChkPost()
		Dim server_v1,server_v2
		Chkpost=False 
		server_v1=Cstr(Request.ServerVariables("HTTP_REFERER"))
		server_v2=Cstr(Request.ServerVariables("SERVER_NAME"))
		If Mid(server_v1,8,len(server_v2))=server_v2 Then Chkpost=True 
	End Function
	
	'每日更新信息，简单更新
	Public Function ReloadAllForumInfo()
		'数据库部分
		If value <> "1900-1-1" Then 
			value="1900-1-1"
			Dim Rs,LastPostInfo,TempStr,i
			Dim Forum_YesterdayNum,Forum_TodayNum,Forum_LastPost,Forum_MaxPostNum
			Set Rs=Execute("Select Top 1 Forum_YesterdayNum,Forum_TodayNum,Forum_LastPost,Forum_MaxPostNum From Dv_Setup")
			Forum_YesterdayNum=Rs(0)
			Forum_TodayNum=Rs(1)
			Forum_LastPost=Rs(2)
			Forum_MaxPostNum=Rs(3)
			Set Rs=Nothing
			LastPostInfo = Split(Forum_LastPost,"$")
			If Not IsDate(LastPostInfo(2)) Then LastPostInfo(2)=Now()	
			If DateDiff("d",CDate(LastPostInfo(2)),Now())<>0 Then'最后发贴时间不是今天，	
				TempStr=LastPostInfo(0)&"$"&LastPostInfo(1)&"$"&Now()&"$"&LastPostInfo(3)&"$"&LastPostInfo(4)&"$"&LastPostInfo(5)&"$"&LastPostInfo(6)&"$"&LastPostInfo(7)
				Execute("Update Dv_Setup Set Forum_YesterdayNum="&Forum_TodayNum&",Forum_LastPost='"&TempStr&"',Forum_TodayNum=0")
				ReloadSetupCache 0,9
				ReloadSetupCache Forum_TodayNum,11
				ReloadSetupCache TempStr,15	
			End If
			If Forum_TodayNum >Forum_MaxPostNum Then
				Execute("Update Dv_Setup Set Forum_MaxPostNum=Forum_TodayNum,Forum_MaxPostDate="&SqlNowString)
				ReloadSetupCache Forum_TodayNum,12'日最高发贴
				ReloadSetupCache Now(),13 '最高发贴日期
			End If
			LoadBoardsInfo()
		End If
		Name="Date"
		value=Date()
	End Function
	'使用一个查询更新所有版面的缓存
	Public Sub LoadBoardsInfo()
		Dim Rs,BoardData(23,0),i,GetData,SQL,LastPostInfo,TempStr,IsUpdate
		IsUpdate=0
		SQL="select boardid,BoardType,ParentID,ParentStr,Depth,RootID,Child,readme,BoardMaster,PostNum,TopicNum,indexIMG,todayNum,boarduser,LastPost,Sid,Board_Setting,Board_Ads,Board_user,IsGroupSetting,BoardTopStr,BoardID As TempStr,BoardID As TempStr1,BoardID As TempStr2 from Dv_board"
		If Not IsObject(Conn) Then ConnectionDatabase
		Set Rs=Server.CreateObject("ADODB.RecordSet")
		Rs.Open SQL,Conn,1,3
		Do While Not Rs.Eof
			LastPostInfo = Split(Rs(14),"$")
			If Not IsDate(LastPostInfo(2)) Then LastPostInfo(2)=Now()
			If DateDiff("d",LastPostInfo(2),Now())<>0 Then
				Rs("LastPost")=LastPostInfo(0)&"$"&LastPostInfo(1)&"$"&LastPostInfo(2)&"$"&LastPostInfo(3)&"$"&LastPostInfo(4)&"$"&LastPostInfo(5)&"$"&LastPostInfo(6)&"$"&LastPostInfo(7)
				Rs("TodayNum")=0
				Rs.UpDate
				IsUpdate=1
			End If
			Name="BoardInfo_" & Rs(0)
			For i=0 to Rs.Fields.Count-1
				BoardData(i,0)=Rs(i)
			Next
			value = BoardData
			GetData = Value
			IsUpdate=0
		Rs.MoveNext
		Loop
		Rs.Close
		Set Rs=Nothing
	End Sub 
	'更新总设置表部分缓存数组，入口：更新内容、数组位置
	Public Function ReloadSetupCache(MyValue,N)
		CacheData(N,0) = MyValue
		Name="setup"
		value=CacheData
	End Function

	'更新用户资料缓存(缓存用户名,是否需要添加)[0=不添加,只作清理,1=需要添加]
	Public Sub NeedUpdateList(username,act)
		Dim Tmpstr,TmpUsername
		Name="NeedToUpdate"
		If ObjIsEmpty() Then 
		Value=""
		End If
		Tmpstr=Value
		TmpUsername=","&username&","
		Tmpstr=Replace(Tmpstr,TmpUsername,",")
		Tmpstr=Replace(Tmpstr,",,",",")
		IF act=1 Then 
			If IsONline(username,0) Then
				If Tmpstr="" Then
					Tmpstr=TmpUsername
				Else
					Tmpstr=Tmpstr&TmpUsername
				End If
			End If
		End If
		Tmpstr=Replace(Tmpstr,",,",",")
		Value=Tmpstr
	End Sub

	'写入客人session
	Public Sub LetGuestSession()
		Dim StatUserID,UserSessionID
		StatUserID = checkStr(Trim(Request.Cookies(Forum_sn)("StatUserID")))
		If IsNumeric(StatUserID) = 0 or StatUserID = "" Then
			StatUserID = Replace(UserTrueIP,".","")
			UserSessionID = Replace(Startime,".","")
			If IsNumeric(StatUserID) = 0 or StatUserID = "" Then StatUserID = 0
			StatUserID = Ccur(StatUserID) + Ccur(UserSessionID)
		End If
		StatUserID = Ccur(StatUserID)
		Response.Cookies(Forum_sn).Expires=DateAdd("s",3600,Now())
		Response.Cookies(Forum_sn).path=cookiepath
		Response.Cookies(Forum_sn)("StatUserID") = StatUserID
		'客人=SessionID+活动时间+发贴时间+版面ID
		StatUserID = StatUserID & "_" & Now & "_" & Now & "_" & BoardID
		Session(CacheName & "UserID") = Split(StatUserID,"_")
	End Sub 
	'根据页面来判断是否需要执行TrueCheckUserLogin
	Public Function NeedChecklongin()
		NeedChecklongin=True
		If UserID>0 Then
			If InStr(ScriptName,"admin_")>0 Then Exit Function
			Dim pagelist
			pagelist=",usermanager.asp,mymodify.asp,modifypsw.asp,modifyadd.asp,usersms.asp,"
			pagelist=pagelist & "friendlist.asp,favlist.asp,myfile.asp,friendlist.asp,recycle.asp,"
			pagelist=pagelist & "fileshow.asp,bbseven.asp,dispuser.asp,"
			If InStr(pagelist,","&ScriptName&",")>0 Then Exit Function
		End If
		NeedChecklongin=False
	End Function 
	'验证用户登陆
	Public Sub CheckUserLogin()
		If Not IsArray(Session(CacheName & "UserID")) Then
			If UserID>0 Then 
				TrueCheckUserLogin
			ElseIf  NeedChecklongin  Then
				TrueCheckUserLogin
			ElseIf UserID=0 Then
				Call LetGuestSession()
			End If			
		ElseIf UserID >0  Then
			If NeedChecklongin Then
				TrueCheckUserLogin
			ElseIf UserID >0 And Not Session(CacheName & "UserID")(0)="Dvbbs" Then
				TrueCheckUserLogin
			Else
				Dim NeedToUpdate
				Name="NeedToUpdate"
				If Not ObjIsEmpty() Then 
					NeedToUpdate=","&Value&","
					If InStr(NeedToUpdate,","&MemberName&",")>0 Then
						Call NeedUpdateList(MemberName,0)
						Call TrueCheckUserLogin()
					End If
				End If
			End If
		End If
		If Session(CacheName & "UserID")(0) = "Dvbbs" Then
			GetCacheUserInfo
		Else
			MyUserInfo = Session(CacheName & "UserID")
			UserGroupID = 7
			Lastlogin = Now()
		End If	
		GetGroupSetting
	End Sub

	'系统分配随机密码
	Public Function Createpass()
		Dim Ran,i,LengthNum
		LengthNum=16
		Createpass=""
		For i=1 To LengthNum
			Randomize
			Ran = CInt(Rnd * 2)
			Randomize
			If Ran = 0 Then
				Ran = CInt(Rnd * 25) + 97
				Createpass =Createpass& UCase(Chr(Ran))
			ElseIf Ran = 1 Then
				Ran = CInt(Rnd * 9)
				Createpass = Createpass & Ran
			ElseIf Ran = 2 Then
				Ran = CInt(Rnd * 25) + 97
				Createpass =Createpass& Chr(Ran)
			End If
		Next
	End Function
	'更新用户验证密码
	Public Sub NewPassword()
		If UserID=0 Then Exit Sub
		Dim TruePassWord,usercookies
		usercookies=Request.Cookies(Dvbbs.Forum_sn)("usercookies")
		TruePassWord=Createpass
		If (Isnull(usercookies) or usercookies="") And Not Isnumeric(usercookies) Then usercookies=0
		Select Case Cint(usercookies)
			Case 0
				Response.Cookies(Forum_sn)("usercookies") = usercookies
			Case 1
   				Response.Cookies(Forum_sn).Expires=Date+1
				Response.Cookies(Forum_sn)("usercookies") = usercookies
			Case 2
				Response.Cookies(Forum_sn).Expires=Date+31
				Response.Cookies(Forum_sn)("usercookies") = usercookies
			Case 3
				Response.Cookies(Forum_sn).Expires=Date+365
				Response.Cookies(Forum_sn)("usercookies") = usercookies
		End Select
		Response.Cookies(Forum_sn).path=cookiepath
		Response.Cookies(Forum_sn)("username") = MemberName
		Response.Cookies(Forum_sn)("UserID") = UserID
		Response.Cookies(Forum_sn)("userclass") = checkStr(Request.Cookies(Forum_sn)("userclass"))
		Response.Cookies(Forum_sn)("userhidden") = UserHidden
		Response.Cookies(Forum_sn)("password") = TruePassWord
		Execute("UpDate [Dv_user] Set TruePassWord='"&TruePassWord&"' where UserID="&UserID)
		MemberWord = TruePassWord
		Dim iUserInfo
		iUserInfo = Session(CacheName & "UserID")
		iUserInfo(35) = TruePassWord
		Session(CacheName & "UserID") = iUserInfo
	End Sub
	
	Public Sub TrueCheckUserLogin()
	'Session(CacheName & "UserID")用户资料=0dvbbs+1刷新时间+2发贴时间+3所在版面ID+4用户ID+5用户名+6用户密码+7用户邮箱+8用户文章数+9用户主题数+10用户性别+11用户头像+12用户头像宽+13用户头像高+14用户注册时间+15用户最后登陆时间+16用户登陆次数+17用户状态+18用户等级+19用户组ID+20用户组名+21用户金钱+22用户积分+23用户魅力+24用户威望+25用户生日+26最后登陆IP+27用户被删除数+28用户精华数+29用户隐身状态+30用户短信情况+31用户阳光会员+32用户手机+33用户组图标+34用户头衔+35验证密码+36用户今日信息+37Dvbbs
		Dim Rs,SQL
		Sql="Select UserID,UserName,UserPassword,UserEmail,UserPost,UserTopic,UserSex,UserFace,UserWidth,UserHeight,JoinDate,LastLogin,UserLogins,Lockuser,Userclass,UserGroupID,UserGroup,userWealth,userEP,userCP,UserPower,UserBirthday,UserLastIP,UserDel,UserIsBest,UserHidden,UserMsg,IsChallenge,UserMobile,TitlePic,UserTitle,TruePassWord,UserToday"
		Sql=Sql+" From [Dv_User] Where UserID = " & UserID
		Set Rs = Execute(Sql)
		If Rs.Eof And Rs.Bof Then
			Rs.Close:Set Rs = Nothing
			UserID = 0
			EmptyCookies
			LetGuestSession()
		Else
			MyUserInfo=Rs.GetString(,1, "|||","","")
			Rs.Close:Set Rs = Nothing
			MyUserInfo = "Dvbbs|||"& Now & "|||" & DateAdd("s",-3600,Now()) &"|||"& BoardID &"|||"& MyUserInfo &"|||Dvbbs"
			MyUserInfo = Split(MyUserInfo,"|||")
			If Trim(MyUserInfo(35)) = Memberword And Trim(MyUserInfo(5)) =Membername Then
				Session(CacheName & "UserID") = MyUserInfo
				Memberword = MyUserInfo(35)
				GetCacheUserInfo()
			Else
				UserID = 0
				EmptyCookies
				LetGuestSession()
			End If
		End If
	End Sub
	'用户登录成功后，采用本函数读取用户数组并判断一些常用信息
	Public Sub GetCacheUserInfo()
		MyUserInfo = Session(CacheName & "UserID")
		UserID = Clng(MyUserInfo(4))
		MemberName = MyUserInfo(5)
		Lastlogin = MyUserInfo(15)
		If Not IsDate(LastLogin) Then LastLogin = Now()
		UserGroupID = Cint(MyUserInfo(19))
		If Trim(MyUserInfo(36))="" Then
			Execute("Update [Dv_User] Set UserToday='0|0|0' Where UserID = " & UserID)
			MyUserInfo(36) = "0|0|0"
			UserToday = Split(MyUserInfo(36),"|")
		Else
			UserToday = Split(MyUserInfo(36),"|")
			If Ubound(UserToday) <> 2 Then
				Execute("Update [Dv_User] Set UserToday='0|0|0' Where UserID = " & UserID)
				MyUserInfo(36) = "0|0|0"
				UserToday = Split(MyUserInfo(36),"|")
			End If
		End If
		Select Case UserGroupID
		Case 4
			Vipuser = True
		Case 3
			Boardmaster = True
		Case 2
			Superboardmaster = True
		Case 1
			Master = True
		End Select
		If MyUserInfo(31) = "1" Then FoundIsChallenge = True
		If DateDiff("d",LastLogin,Now())<>0 Then
			Execute("Update [Dv_User] Set UserToday='0|0|0',LastLogin = " & SqlNowString & " Where UserID = " & UserID)
			MyUserInfo(36) = "0|0|0"
			LastLogin = Now()
		End If
		If Userhidden = 2 and DateDiff("s",Lastlogin,Now())>Clng(Forum_Setting(8))*60 Then
			Execute("Update [Dv_User] Set UserLastIP = '" & UserTrueIP & "',LastLogin = " & SqlNowString & " Where UserID = " & UserID)
			Lastlogin = Now()
		End If
		sendmsgnum=0:sendmsgid=0:sendmsguser=""
		If MyUserInfo(30)<>"" Then
			Dim Usermsg
			Usermsg=Split(MyUserInfo(30),"||")
			If Ubound(Usermsg)=2 Then
				sendmsgnum=Usermsg(0)
				sendmsgid=Usermsg(1)
				sendmsguser=Usermsg(2)
			End If
		End If
		FoundUser=True
		MyUserInfo(15)=Lastlogin
		Session(CacheName & "UserID")=MyUserInfo
	End Sub
	Public Sub EmptyCookies()
		Response.Cookies(Forum_sn)("usercookies") = 0
		Response.Cookies(Forum_sn).path=cookiepath
		Response.Cookies(Forum_sn)("username") = ""
		Response.Cookies(Forum_sn)("UserID") = 0
		Response.Cookies(Forum_sn)("userclass") = ""
		Response.Cookies(Forum_sn)("userhidden") = 2
		Response.Cookies(Forum_sn)("password") = ""
	End Sub
	Private Sub GetGroupSetting()
		Name="GroupSetting_"& UserGroupID
		If ObjIsEmpty() Then 
			Dim Rs,SQL
			SQL = "Select GroupSetting From [Dv_UserGroups] where UserGroupID = " & UserGroupID & ""
			Set Rs = Execute(SQL)
			If Rs.Eof And Rs.Bof Then
				Set Rs=Nothing
				SQL = "Select GroupSetting From [Dv_UserGroups] where UserGroupID = 4"
				Set Rs = Execute(SQL)
				value=Rs(0)
			Else
				value=Rs(0)
			End If
		End If
		GroupSetting = Split(value,",")
		If Cint(GroupSetting(0))=0 And Not Page_Admin Then 
			AddErrCode "8":Showerr()
		End If
	End Sub 
	Public Sub ActiveOnline()	
		Dim ReflashPageLastTime,LastVisiBoardID
		ReflashPageLastTime = Session(CacheName & "UserID")(1)
		LastVisiBoardID = Clng(Session(CacheName & "UserID")(3))
		If Not IsDate(ReflashPageLastTime) Then ReflashPageLastTime = Now()
		'当在120秒内刷新同一个页面则不更新online数据
		If DateDiff("s",ReflashPageLastTime,Now()) < 120 And LastVisiBoardID = BoardID Then Exit Sub
		'更新数组
		ReflashPageLastTime = Session(CacheName & "UserID")
		ReflashPageLastTime(1) = Now()
		ReflashPageLastTime(3) = Dvbbs.BoardID
		Session(CacheName & "UserID") = ReflashPageLastTime
		UserActiveOnline
	End Sub
	Private Sub UserActiveOnline()
		Dim Actcome,SQl,Rs
		Dim MyGroupID,uip,BrowserType
		uip = UserTrueIP
		If FoundIsChallenge and Cint(Forum_ChanSetting(0))=1 Then
			MyGroupID = 9999
		Else
			MyGroupID = UserGroupID
		End If
			
		If UserID = 0 Then
			Dim StatUserID
			StatUserID = Session(CacheName & "UserID")(0)
			SQL = "Select ID,Boardid From [Dv_Online] Where ID = " & Ccur(StatUserID)
			Set Rs = Execute(SQL)
			If Rs.Eof And Rs.Bof Then
				If CInt(Forum_Setting(36)) = 0 Then
					Actcome = ""
				Else
					Actcome = address(uip)
				End If
				Set BrowserType=new Cls_Browser
				SQL = "Insert Into [Dv_Online](ID,Username,Userclass,Ip,Startime,Lastimebk,Boardid,Browser,Stats,Usergroupid,Actcome,Userhidden) Values (" & StatUserID & ",'客人','客人','" & UserTrueIP & "'," & SqlNowString & "," & SqlNowString & "," & Boardid & ",'" & BrowserType.platform&"|"&BrowserType.Browser&BrowserType.version & "','" & Replace(Left(Stats,250),"'","") & "',7,'" & Actcome & "'," & Userhidden & ")"
				'更新缓存总在线数据
				MyBoardOnline.Forum_Online=MyBoardOnline.Forum_Online+1
				Name="Forum_Online"
				value=MyBoardOnline.Forum_Online
				Set BrowserType=Nothing 
			Else
				SQL = "Update [Dv_Online] Set Lastimebk = " & SqlNowString & ",Boardid = " & Boardid & ",Stats = '" & Replace(Stats,"'","") & "' Where ID = " & Ccur(StatUserID)
			End If
			Rs.Close
			Set Rs = Nothing
			Execute(SQL)
		Else
			SQL = "Select ID,Boardid From [DV_Online] Where UserID = " & UserID
			Set Rs = Execute(SQL)
			If Rs.Eof And Rs.Bof Then
				If CInt(forum_setting(36)) = 0 Then
					Actcome = ""
				Else
					Actcome = address(uip)
				End If
				Set BrowserType=new Cls_Browser
				SQL = "Insert Into [Dv_Online](ID,Username,Userclass,Ip,Startime,Lastimebk,Boardid,Browser,Stats,Usergroupid,Actcome,Userhidden,UserID) Values (" & Session.SessionID & ",'" & Membername & "','" & Memberclass & "','" & UserTrueIP & "'," & SqlNowString & "," & SqlNowString & "," & Boardid & ",'" & BrowserType.platform&"|"&BrowserType.Browser&BrowserType.version & "','" & Replace(Left(Stats,250),"'","") & "'," & MyGroupID & ",'" & Actcome & "'," & Userhidden & "," & UserID & ")"
				Set BrowserType=Nothing
				'更新缓存总在线数据
				MyBoardOnline.Forum_Online=MyBoardOnline.Forum_Online+1
				Name="Forum_Online"
				Dvbbs.value=MyBoardOnline.Forum_Online
				'更新缓存总用户在线数据
				MyBoardOnline.Forum_UserOnline=MyBoardOnline.Forum_UserOnline+1
				Name="Forum_UserOnline"
				value=MyBoardOnline.Forum_UserOnline
			Else
				SQL = "Update [Dv_Online] Set Lastimebk = " & SqlNowString & ",Boardid = " & Boardid & ",Stats = '" & Replace(Stats,"'","") & "' Where UserID = " & UserID
			End If
			Rs.Close
			Set Rs = Nothing
			Execute(SQL)
		End If	
		'更新在线峰值
		If CLng(MyBoardOnline.Forum_Online) > CLng(Maxonline) Then
			Execute("update [Dv_setup] set Forum_Maxonline="&CLng(MyBoardOnline.Forum_Online)&",Forum_MaxonlineDate="& SqlNowString &"") 
			CacheData(5,0)=MyBoardOnline.Forum_Online
			CacheData(6,0)=Now()
			Name="setup"
			value=CacheData
		End If 
		Rem 删除超时用户
		MyBoardOnline.OnlineQuery
	End Sub
	Public Sub Nav()
		Head()
		ShowTopTable()
		IsTopTable = 1
	End Sub
	Public Sub head()
		'建立缓存
		Name="head_"&SkinID
		If ObjIsEmpty() Then
			value= Replace(Replace(mainhtml(1),"{$keyword}",Replace(Forum_info(8),"|",",")),"{$description}",Forum_info(10))&vbNewLine
		End If
		Response.Write Value
		Nowstats=stats
		Dim re
		Set re=new RegExp
		re.IgnoreCase =True
		re.Global=True
		re.Pattern="<(.*)(.*)>(.*)<\/\1>"
		If BoardID>0 Then Stats=BoardType&"-"&Stats
		Stats=re.replace(Stats, "$3")
		Set Re=Nothing
		Stats=Server.HTMLEncode(Stats)		
		Response.Write "<title>"
		Response.Write Forum_Info(0)
		Response.Write "-"	
		Response.Write stats						
		Response.Write "</title>"
		Response.Write vbNewLine
		Response.Write Forum_CSS
		Response.Write mainhtml(2)
		'论坛防刷新设置
		If Cint(Forum_Setting(19))=1 And Not Page_Admin Then
			Dim DoReflashPage
			DoReflashPage=false
			If Trim(Forum_Setting(64))<>"" And InStr(LCase(Forum_Setting(64)),ScriptName) >0 Then DoReflashPage=True
			If (Not IsEmpty(Session(CacheName & "UserID")(1))) and Cint(Forum_Setting(20))>0 and DoReflashPage Then
				If DateDiff("s",Session(CacheName & "UserID")(1),Now())<Cint(Forum_Setting(20)) Then
					Response.Write "<META http-equiv=Content-Type content=text/html; charset=gb2312><meta HTTP-EQUIV=REFRESH CONTENT="&Forum_Setting(20)&"><br>本页面起用了防刷新机制，请不要在"&Forum_Setting(20)&"秒内连续刷新本页面<BR>正在打开页面，请稍后……"
					Response.End
				Else
					DoReflashPage=Session(CacheName & "UserID")
					DoReflashPage(1)=Now()
					Session(CacheName & "UserID")=DoReflashPage
				End If
			ElseIf IsEmpty(Session(CacheName & "UserID")(1)) and Cint(Forum_Setting(20))>0 and DoReflashPage Then
				DoReflashPage=Session(CacheName & "UserID")
				DoReflashPage(1)=Now()
				Session(CacheName & "UserID")=DoReflashPage
			End If
		End If
	End Sub 
	Public Sub ShowTopTable()
		Dim TempStr,ForumMenu
		If Forum_ChanSetting(0)="1" And Forum_ChanSetting(1)="1"  Then 
			If Forum_ChanSetting(2)="1" Then
				TempStr = mainhtml(3)
				TempStr = Replace(TempStr,"{$top}",adcode_4)
			End If 
			If Forum_ChanSetting(3)="1" Then Forum_ads(0)=adcode_1
		End If
		Name="Templateslist"
		If ObjIsEmpty() Then ReloadTemplateslist()
		If UserID = 0 Then 
			sysmenu = mainhtml(7)
		Else
			sysmenu = Replace(mainhtml(6),"{$username}",Membername)
			If UserHidden=2 Then
				sysmenu = Replace(sysmenu,"{$hiddeninfo}",lanstr(3))
			Else
				sysmenu = Replace(sysmenu,"{$hiddeninfo}",lanstr(4))
			End If
			If Master Then
				sysmenu = Replace(sysmenu,"{$manageinfo}",mainhtml(10))
			Else
				sysmenu = Replace(sysmenu,"{$manageinfo}","")
			End If
			If Forum_ChanSetting(0)="1" Then
				Dim RayMenuInfo,RayMenu
				RayMenuInfo = Split(mainhtml(11),"||")
				If Forum_ChanSetting(2)=2 Then RayMenu = Replace(Replace(RayMenuInfo(3),"{$channame}",CacheData(23,0)),"{$forumurl}",Forum_Info(1))
				If FoundIsChallenge Then
					RayMenu = RayMenu & RayMenuInfo(1)
				Else
					RayMenu = RayMenu & RayMenuInfo(2)
				End If
				RayMenu = Replace(RayMenuInfo(0),"{$raymenu}",RayMenu)
				sysmenu = Replace(sysmenu,"{$raymenuinfo}",RayMenu)
			Else
				sysmenu = Replace(sysmenu,"{$raymenuinfo}","")
			End If
			sysmenu = Replace(sysmenu,"{$userid}",UserID)
		End If
		Dim tmpstr,i,outstr,ioutstr,SkinID1,Csslist,CssName,k,Tempstr1,Tempstr2
		mainhtml(9)=Replace(Replace(Replace(Replace(mainhtml(9),"\","\\"),"'","\'"),VbCrLf,"\n"),chr(13),"")
		tmpstr=Split(value,"@@@")
		mainhtml(9) = Split(mainhtml(9),"||")
		outstr =mainhtml(9)(2)
		ioutstr=mainhtml(9)(0)
		mainhtml(9)(5)=Replace(mainhtml(9)(5),"{$boardid}",BoardID)
		SkinID1=SkinID
		For i = 0 to UBound(tmpstr)
			tmpstr(i) = Split(tmpstr(i),"|||")
			SkinID=tmpstr(i)(0)
			Name="Forum_CSS"&SkinID
			If ObjIsEmpty() Then
				TemplatesToCache ("Forum_CSS")
			End If
			Csslist=Value
			Csslist=split(Csslist,"@@@")
			CssName=split(Csslist(0),"|||")
			Tempstr2=Replace(mainhtml(9)(4),"{$skinid}",SkinID)
			If SkinID1<>Cint(tmpstr(i)(0)) Then 
				Tempstr2=Replace(Tempstr2,"{$skinname}",tmpstr(i)(1))
			Else
				mainhtml(9)(1)=Replace(mainhtml(9)(1),"{$skinname}",tmpstr(i)(1))
				mainhtml(9)(1)=Replace(mainhtml(9)(1),"{$alertcolor}",mainsetting(1))
				Tempstr2=Replace(Tempstr2,"{$skinname}",mainhtml(9)(1))
			End If
			Tempstr1=""
			For k=0 to UBound(CssName)-1
				If k=CssID And SkinID1=Cint(tmpstr(i)(0)) Then 
					mainhtml(9)(6)=Replace(mainhtml(9)(6),"{$alertcolor}",mainsetting(1))
					Tempstr1=Tempstr1&Replace(Replace(Replace(mainhtml(9)(6),"{$skinid}",SkinID),"{$cssid}",k),"{$cssname}",CssName(k))
				Else
					Tempstr1=Tempstr1&Replace(Replace(Replace(mainhtml(9)(5),"{$skinid}",SkinID),"{$cssid}",k),"{$cssname}",CssName(k))
				End If	
			Next 
			Tempstr1=Replace(Tempstr2,"{$cssinfo}",Tempstr1)			
			ioutstr=ioutstr&Replace(mainhtml(9)(3),"{$csslist}",Tempstr1)
		Next	
		SkinID=SkinID1	
		outstr=Replace(outstr,"{$sylelist}",ioutstr)
		sysmenu = Replace(sysmenu,"{$syles}",outstr)
		TempStr = TempStr & mainhtml(4)
		TempStr = Replace(TempStr,"{$width}",mainsetting(0))
		TempStr = Replace(TempStr,"{$link}",Forum_Info(1))
		TempStr = Replace(TempStr,"{$logo}",Forum_Info(6))
		If Trim(Forum_info(7))<>"" Then
			TempStr = Replace(TempStr,"{$mailto}",Forum_Info(7))
		Else
			TempStr = Replace(TempStr,"{$mailto}","mailto:" & Forum_Info(5))
		End If
		TempStr = Replace(TempStr,"{$title}",Forum_Info(0) & "-" & Replace(stats,"'","\'"))
		TempStr = Replace(TempStr,"{$top_ads}",Forum_ads(0))
		TempStr = Replace(TempStr,"{$menu}",sysmenu)
		TempStr = Replace(TempStr,"{$boardid}",boardid)
		TempStr = Replace(TempStr,"{$alertcolor}",mainsetting(1))
		Name = "ForumPlusMenu"&SkinID
		If ObjIsEmpty() Then ReloadForumPlusMenu()
		ForumMenu = Value
		TempStr = Replace(TempStr,"{$plusmenu}",ForumMenu)
		Response.Write TempStr		
		TempStr = ""				
	End Sub 

	Public Sub Head_var(IsBoard,idepth,GetTitle,GetUrl)
		Dim NavStr,AllBoardList
		If Dvbbs.BoardID=0 Then
			If UserID>0 Then
				BoardReadme=lanstr(2) & " <b>" & Forum_Info(0) & "</b>"
			Else
				BoardReadme=lanstr(2) & " <b>" & Forum_Info(0) & "</b>"
			End If
		End if
	
		Name = "BoardJumpList"
		If ObjIsEmpty() Then LoadBoardJumpList
		BoardJumpList = Value
		BoardJumpList = Replace(BoardJumpList,"{BoardID="&BoardID&"}","selected")
		Name = "MyAllBoardList"
		If ObjIsEmpty() Then LoadAllBoardList
		'LoadAllBoardList
		AllBoardList = Value

		If BoardID>0 Then
			NavStr = " <a href="&Forum_Info(11)&" onMouseOver=""showmenu(event,'"&AllBoardList&"',0)"" style=""CURSOR:hand"">"&Forum_info(0)&"</a> → "
		Else
			NavStr = " <a href="&Forum_Info(11)&">"&Forum_info(0)&"</a> → "
		End If
		If IsBoard=1 Then
			BoardList = Board_Data(21,0)
			BoardType = Replace(Replace(BoardType,Chr(39),"&#39;"),Chr(34), "&#34;")
			If BoardParentID=0 Then
				NavStr = NavStr & " <a href=""list.asp?boardid="&BoardID&""" onMouseOver=""showmenu(event,'"&BoardList&"',0)"">"&BoardType&"</a>"
			Else
				If ScriptName="dispbbs.asp" Then 
					NavStr = NavStr & CheckBoardInfo & " → <a href=""list.asp?boardid="&BoardID&"&page="&Request("page")&""">"&BoardType&"</a>"
				Else
					NavStr = NavStr & CheckBoardInfo & " → <a href=""list.asp?boardid="&BoardID&""">"&BoardType&"</a>"
				End If
			End If
			NavStr = NavStr & " → " & Nowstats
			If request("CatLog")="NN" Then Response.Cookies("BoardList")(BoardID & "BoardID")= "NNotShow"
			If request.cookies("BoardList")(boardid & "BoardID")="NNotShow" Then NavStr = NavStr & "&nbsp;<a href=""?BoardID="&boardid&"&cBoardid="&boardid&"&Catlog=Y"" title=""展开论坛列表"">[展开]</a>"
		Elseif IsBoard=2 Then
			NavStr = NavStr & Nowstats
		Else
			NavStr = NavStr & "<a href="&GetUrl&">"&GetTitle&"</a> → " & Nowstats
		End If
		BoardReadme=Replace(Replace(Replace(BoardReadme&"","\n",""),"\r",""),"\","")
		NavStr = Replace(mainhtml(5),"{$nav}",NavStr)
		NavStr = Replace(NavStr,"{$width}",mainsetting(0))
		NavStr = Replace(NavStr,"{$boardreadme}",BoardReadme)
		If UserID>0 Then
			'sendmsgnum,sendmsgid,sendmsguser
			IsBoard = Split(mainhtml(12),"||")
			If Clng(SendMsgNum)>0 Then
				BoardReadme = IsBoard(0)
				If Forum_Setting(10)=1 Then
					BoardReadme = BoardReadme & IsBoard(1) & IsBoard(2)
				Else
					BoardReadme = BoardReadme & IsBoard(2)
				End If
				BoardReadme = Replace(BoardReadme,"{$smsid}",sendmsgid)
				BoardReadme = Replace(BoardReadme,"{$sender}",sendmsguser)
				BoardReadme = Replace(BoardReadme,"{$newmsgnum}",sendmsgnum)
				NavStr = Replace(NavStr,"{$umsg}",BoardReadme)
			Else
				NavStr = Replace(NavStr,"{$umsg}",IsBoard(3))
			End If
		Else
			NavStr = Replace(NavStr,"{$umsg}","")
		End If
		NavStr = Replace(NavStr,"{$alertcolor}",mainsetting(1))
		NavStr = Replace(NavStr,"{$showstr}","")
		Response.Write NavStr
	End Sub
	Private Function LoadBoardJumpList()
		Dim Forum_Boards,i,ii,Depth,Board_Datas
		Forum_Boards=Split(CacheData(27,0),",")
		For i=0 To Ubound(Forum_Boards)
			Name="BoardInfo_" & Forum_Boards(i)
			If ObjIsEmpty() Then ReloadBoardInfo(Forum_Boards(i))
			Board_Datas = Value
			BoardJumpList = BoardJumpList & "<option value=""list.asp?boardid="&Forum_Boards(i)&""" {BoardID="&Forum_Boards(i)&"}>"
			Depth=Board_Datas(4,0)
			Select Case Depth
			Case 0
				BoardJumpList = BoardJumpList & "╋"
			Case 1
				BoardJumpList = BoardJumpList & "&nbsp;&nbsp;├"
			End Select
			If Depth>1 Then
				For ii=2 To Depth
					BoardJumpList = BoardJumpList & "&nbsp;&nbsp;│"
				Next
				BoardJumpList = BoardJumpList & "&nbsp;&nbsp;├"
			End If
			BoardJumpList = BoardJumpList & Replace(Replace(Board_Datas(1,0),Chr(39),"&#39;"),Chr(34), "&#34;") &"</option>"
		Next
		Name="BoardJumpList"
		value=BoardJumpList
		Forum_Boards=Null
		Board_Datas=Null
	End Function
	Private Function LoadAllBoardList()	
		Dim Forum_Boards,MyAllBoardList,i,ii,Depth,Board_Datas
		Forum_Boards=Split(CacheData(27,0),",")
		For i=0 To Ubound(Forum_Boards)
			Name="BoardInfo_" & Forum_Boards(i)
			If ObjIsEmpty() Then ReloadBoardInfo(Forum_Boards(i))
			Board_Datas = Value
			Depth=Board_Datas(4,0)
			MyAllBoardList = MyAllBoardList & "<a href=list.asp?boardid="&Forum_Boards(i)&">"
			Select Case Depth
			Case 0
				MyAllBoardList = MyAllBoardList & "╋"
			Case 1
				MyAllBoardList = MyAllBoardList & "&nbsp;&nbsp;├"
			End Select
			If Depth>1 Then
				For ii=2 To Depth
					MyAllBoardList = MyAllBoardList & "&nbsp;&nbsp;│"
				Next
				MyAllBoardList = MyAllBoardList & "&nbsp;&nbsp;├"
			End If
			MyAllBoardList = MyAllBoardList & Server.htmlencode(Board_Datas(1,0)) & "</a><br>"
		Next
		Name="MyAllBoardList"
		value=Replace(Replace(MyAllBoardList,"'","\'"),Chr(34), "&#34;")
		Forum_Boards=Null
		Board_Datas=Null
	End Function
	Public Sub AddErrCode(ErrCode)
		If ErrCodes = "" Then
			ErrCodes = ErrCode
		Else
			ErrCodes = ErrCodes & "," & ErrCode
		End If
	End Sub 
	Public Sub Showerr()
		If ErrCodes<>"" Then Response.redirect "showerr.asp?BoardID="&boardid&"&ErrCodes="&ErrCodes&"&action="&server.URLEncode(Stats)
	End Sub 
	Public Sub Footer()
		Dim Tmp,CaCheInfo
		'CaCheInfo =  "<li>"
		'CaCheInfo = CaCheInfo & "共使用了" & Application.Contents.Count & "个缓存对象。"
		Tmp = mainhtml(8)
		If Forum_Setting(30) = "1" Then 
			Dim Endtime
			Endtime = Timer()	
			Tmp = Replace(Tmp,"{$runtime}","<br>执行时间：" & FormatNumber((Endtime-Startime)*1000,5) & "毫秒。查询数据库" & SqlQueryNum & "次。"& CaCheInfo)
		Else
			Tmp = Replace(Tmp,"{$runtime}","")
		End If
		Tmp = Replace(Tmp,"{$color}",mainsetting(1))
		Tmp = Replace(Tmp,"{$width}",mainsetting(0))
		Tmp = Replace(Tmp,"{$powered}","Powered By ：<a href = ""http://www.dvbbs.net/download.asp"" target = ""_blank"">Dvbbs Version " & Forum_Version & "</a>")
		Tmp = Replace(Tmp,"{$Footer_ads}",Forum_ads(1))
		If Forum_ChanSetting(0)="1" And Forum_ChanSetting(1)="1" And Forum_ChanSetting(4)="1" And IsTopTable=1 Then
			Tmp = Replace(Tmp,"{$ad}","<BR>" & adcode_2)
		Else
			Tmp = Replace(Tmp,"{$ad}","")
		End If 
		Tmp = Replace(Tmp,"{$copyright}",Forum_Copyright)
		Tmp = Replace(Tmp,"{$StyleName}",StyleName)
		If Forum_ChanSetting(0)="1" Then  
			Tmp = Replace(Tmp,"{$server}","<td align = right><a href = ""http://www.ray5198.com"" target = _blank title = ""本论坛所提供的互动服务由北京阳光加信科技有限公司提供""><img src = ""images/rayslogo.GIF"" border = 0></a></td>")
		Else
			Tmp = Replace(Tmp,"{$server}","")
		End If
		Response.Write Tmp
	End Sub
	Public Function Dvbbs_Suc(sucmsg)
		Dim TempStr
		TempStr = mainhtml(13)
		TempStr = Replace(TempStr,"{$sucmsg}",sucmsg)
		TempStr = Replace(TempStr,"{$returnurl}",Request.ServerVariables("HTTP_REFERER"))
		Response.Write TempStr
		TempStr = ""
	End Function
	Rem Function 
	Public Function Execute(Command)
		If Not IsObject(Conn) Then ConnectionDatabase
		'检查权限,防止注入攻击。
		If InStr(LCase(Command),"dv_admin")>0 And Left(ScriptName,6)<> "admin_" Then 
			Response.Write SaveSQLLOG(Command,"")'翻译成英文
			Command=Replace(LCase(Command),"dv_admin","dv<i>"&Chr(95)&"</i>admin") 
		End If				
		If IsDeBug = 0 Then 
			On Error Resume Next
			Set Execute = Conn.Execute(Command)
			If Err Then
				err.Clear
				Set Conn = Nothing
				'以下信息要翻译成英文
				Response.Write SaveSQLLOG(Command,"查询数据的时候发现错误，请检查您的查询代码是否正确。<br>基于安全的理由，只显示本信息，要查看详细的错误信息，请修改您的程序文件conn.asp。把""Const IsDeBug = 0""改为：""Const IsDeBug = 1""")
				Response.End
			End If
		Else
			'Response.Write command & "<br>"
			Set Execute = Conn.Execute(Command)
		End If	
		SqlQueryNum = SqlQueryNum+1
	End Function
	'记录查询错误事件
	Public Function SaveSQLLOG(sCommand,message)
		Dim lConnStr,lConn,ldb,SQL,RS
		ldb = "data/DvSQLLOG.mdb"
		lConnStr = "Provider = Microsoft.Jet.OLEDB.4.0;Data Source = " & Server.MapPath(ldb)
		Set lConn = Server.CreateObject("ADODB.Connection")
		lConn.Open lConnStr
		Set Rs = Server.CreateObject("adodb.recordset")
		Sql="select * from dv_sql_log"
		Rs.open sql,lconn,1,3
		Rs.addnew
		Rs("ScriptName")=ScriptName
		Rs("S_Info")=Left(sCommand,255)
		Rs("ip")=UserTrueIP
		Rs.update
		Rs.close
		lConn.Execute(SQL)
		lConn.Close
		Set lConn = Nothing 
		SaveSQLLOG = message
	End Function
	Public Function IPlock()
		IPlock=False 
		If IsArray(Session(CacheName & "UserID")) Then Exit Function 
		Dim locklist
		locklist=Trim(CacheData(25,0))
		If locklist="" Then Exit Function
		Dim i,StrUserIP,StrKillIP
		StrUserIP=UserTrueIP
		locklist=Split(locklist,"|")
		If StrUserIP="" Then Exit Function
		StrUserIP=Split(UserTrueIP,".")
		If Ubound(StrUserIP)<>3 Then Exit Function
		For i= 0 to UBound(locklist)
			If locklist(i)<>"" Then 
				StrKillIP = Split(locklist(i),".")
				If Ubound(StrKillIP)<>3 Then Exit For
				IPlock = True
				If (StrUserIP(0) <> StrKillIP(0)) And (StrKillIP(0) <> "*") Then IPlock=False
				If (StrUserIP(1) <> StrKillIP(1)) And (StrKillIP(1) <> "*") Then IPlock=False
				If (StrUserIP(2) <> StrKillIP(2)) And (StrKillIP(2) <> "*") Then IPlock=False
				If (StrUserIP(3) <> StrKillIP(3)) And (StrKillIP(3) <> "*") Then IPlock=False
				If IPlock Then Exit For 
			End If     
		Next
		If IPlock Then Response.Redirect "showerr.asp?action=iplock" 
	End Function
	'IP/来源
	Public Function address(sip)
		Dim aConnStr,aConn,adb
		Dim str1,str2,str3,str4
		Dim  num
		Dim country,city
		Dim irs,SQL
		If IsNumeric(Left(sip,2)) Then
			If sip="127.0.0.1" Then sip="192.168.0.1"
			str1=Left(sip,InStr(sip,".")-1)
			sip=mid(sip,instr(sip,".")+1)
			str2=Left(sip,instr(sip,".")-1)
			sip=Mid(sip,InStr(sip,".")+1)
			str3=Left(sip,instr(sip,".")-1)
			str4=Mid(sip,instr(sip,".")+1)
			If isNumeric(str1)=0 or isNumeric(str2)=0 or isNumeric(str3)=0 or isNumeric(str4)=0 Then
			Else		
				num=CLng(str1)*16777216+CLng(str2)*65536+CLng(str3)*256+CLng(str4)-1
				adb = "data/ipaddress.mdb"
				aConnStr = "Provider = Microsoft.Jet.OLEDB.4.0;Data Source = " & Server.MapPath(adb)
				Set AConn = Server.CreateObject("ADODB.Connection")
				aConn.Open aConnStr
	
				sql="select top 1 country,city from dv_address where ip1 <="&num&" and ip2 >="&num&""
				Set irs=aConn.execute(sql)
				If irs.EOF And irs.bof Then
					country="亚洲"
					city=""
				Else
					country=irs(0)
					city=irs(1)
				End If
				Set irs=Nothing
				Set aConn = Nothing 
				SqlQueryNum = SqlQueryNum+1
			End If
			address=country&city
		Else 
			address="未知"
		End If
	End Function
	
	'用于用户发布的各种信息过滤，带脏话过滤
	Public Function HTMLEncode(fString)
		If Not IsNull(fString) Then
			fString = replace(fString, ">", "&gt;")
			fString = replace(fString, "<", "&lt;")
			fString = Replace(fString, CHR(32), " ")		'&nbsp;
			fString = Replace(fString, CHR(9), " ")			'&nbsp;
			fString = Replace(fString, CHR(34), "&quot;")
			fString = Replace(fString, CHR(39), "&#39;")	'单引号过滤
			fString = Replace(fString, CHR(13), "")
			fString = Replace(fString, CHR(10) & CHR(10), "</P><P> ")
			fString = Replace(fString, CHR(10), "<BR> ")
			fString=ChkBadWords(fString)
			HTMLEncode = fString
		End If
	End Function
	'用于论坛本身的过滤，不带脏话过滤
	Public Function iHTMLEncode(fString)
		If Not IsNull(fString) Then
			fString = replace(fString, ">", "&gt;")
			fString = replace(fString, "<", "&lt;")
			fString = Replace(fString, CHR(32), " ")
			fString = Replace(fString, CHR(9), " ")
			fString = Replace(fString, CHR(34), "&quot;")
			fString = Replace(fString, CHR(39), "&#39;")
			fString = Replace(fString, CHR(13), "")
			fString = Replace(fString, CHR(10) & CHR(10), "</P><P> ")
			fString = Replace(fString, CHR(10), "<BR> ")
			iHTMLEncode = fString
		End If
	End Function
	Public Function strLength(str)
		If isNull(str) Or Str = "" Then
			StrLength = 0
			Exit Function
		End If
		Dim WINNT_CHINESE
		WINNT_CHINESE=(len("例子")=2)
		If WINNT_CHINESE Then
			Dim l,t,c
			Dim i
			l=len(str)
			t=l
			For i=1 To l
				c=asc(mid(str,i,1))
				If c<0 Then c=c+65536
				If c>255 Then t=t+1
			Next
			strLength=t
		Else 
			strLength=len(str)
		End If
	End Function
	Public Function ChkBadWords(Str)
		If IsNull(Str) Then Exit Function
		Dim i
		For i = 0 To Ubound(BadWords)
			If i > UBound(rBadWord) Then
				Str = Replace(Str,BadWords(i),"*")
			Else
				Str = Replace(Str,BadWords(i),rBadWord(i))
			End If
		Next
		ChkBadWords = Str
	End Function
	Public Function Checkstr(Str)
		If Isnull(Str) Then
			CheckStr = ""
			Exit Function 
		End If
		CheckStr = Replace(Str,"'","''")
	End Function

	Public Function Get_Chan_Ad()
		Dim TempData,i
		Dim rndnum
		Dim Temp_Ad,Forum_AdLoop1,Forum_AdLoop2
		Temp_Ad = Split(CacheData(22,0),"||")
		If Temp_Ad(0)<>"" Then
			Forum_AdLoop1=Split(Temp_Ad(0),",")
		Else
			Forum_AdLoop1=Split("",",")
		End If
		If Temp_Ad(1)<>"" Then
			Forum_AdLoop2=Split(Temp_Ad(1),",")
		Else
			Forum_AdLoop2=Split("",",")
		End If
		Forum_AdLoop3 = Temp_Ad(2)
		'顶部banner
		Randomize
		rndnum=Cint(Ubound(Forum_AdLoop1)*rnd+1)
		If UBound(Forum_AdLoop1)=-1 Then
			adcode_1=""
		Else 
			Name = "ForumAdCode1"
			If ObjIsEmpty() Then LoadForumAdCode1
			If IsArray(Value) And Forum_ChanSetting(3)="1" Then
				TempData=Value
				adcode_1=ReCssUrl(TempData(1,rndnum-1))
			Else
				adcode_1=""
			End If
		End If
		'尾部通栏
		Randomize
		rndnum=Cint(Ubound(Forum_AdLoop2)*rnd+1)
		If UBound(Forum_AdLoop2)=-1 Then
			adcode_2=""
		Else
			Name = "ForumAdCode2"
			If ObjIsEmpty() Then LoadForumAdCode2
			If IsArray(Value) And Forum_ChanSetting(4)="1" Then
				TempData=Value
				adcode_2=ReCssUrl(TempData(1,rndnum-1))
			Else
				adcode_2=""
			End If
		End If

		Name = "ForumAdCode3"
		If ObjIsEmpty() Then LoadForumAdCode3
		If IsArray(Value) And Forum_ChanSetting(2)="1" Then
			TempData=Value
			adcode_4=ReCssUrl(TempData(1,i))
		Else
			adcode_4=""
		End If

		i3 = 0
		If Forum_AdLoop3<>"" And Forum_ChanSetting(5)="1" And Instr(ScriptName,"dispbbs")>0 Then
			Name = "TopicAdCode"
			If ObjIsEmpty() Then LoadTopicAdCode
			If IsArray(Value) Then
				TempData = Value
				For i=0 To Ubound(TempData,2)
					If TempData(1,i)=239 Or TempData(1,i)=240 Or TempData(1,i)=1 Or TempData(1,i)=2 Then
						ad_3(i3)=" "
					Else
						ad_3(i3)=ReCssUrl(TempData(0,i))
					End If
					i3 = i3 + 1
				Next
			End If
		End If
		If i3=0 Then Ad_3(0)=" "
	End Function
	Private Function LoadTopicAdCode()
		Dim Rs
		Set Rs=Execute("Select a_adcode,a_id From Dv_AdCode Where a_id In ("&Forum_AdLoop3&")")
		If Not Rs.Eof Then
			Value = Rs.GetRows(-1)
		Else
			Value = ""
		End If
		Set Rs=Nothing
	End Function
	Private Function LoadForumAdCode1()
		Dim Rs
		Set Rs=Execute("Select a_address,a_adcode,a_id From Dv_AdCode Where a_address='0001'")
		If Not Rs.Eof Then
			Value = Rs.GetRows(-1)
		Else
			Value = ""
		End If
		Set Rs=Nothing
	End Function
	Private Function LoadForumAdCode2()
		Dim Rs
		Set Rs=Execute("Select a_address,a_adcode,a_id From Dv_AdCode Where a_address='0002'")
		If Not Rs.Eof Then
			Value = Rs.GetRows(-1)
		Else
			Value = ""
		End If
		Set Rs=Nothing
	End Function
	Private Function LoadForumAdCode3()
		Dim Rs
		Set Rs=Execute("Select a_address,a_adcode,a_id From Dv_AdCode Where a_address='0004'")
		If Not Rs.Eof Then
			Value = Rs.GetRows(-1)
		Else
			Value = ""
		End If
		Set Rs=Nothing
	End Function
	Public Function ReCssUrl(str)
		if str="" then exit function
		str=replace(str,"%css%","Get_Css.asp?SkinID="&SkinID)
		str=replace(str,"%url%",Forum_info(1))
		If CacheData(23,0)="" or isnull(CacheData(23,0)) Then
		str=replace(str,"%username%","dvbbs")
		str=replace(str,"%mouseId%","dvbbs")
		Else
		str=replace(str,"%username%",CacheData(23,0))
		str=replace(str,"%mouseId%",CacheData(23,0))
		End If
		ReCssUrl=str
	End Function
	Rem 读取部分
	Public Property Get RegSplitWords
		Dim Setting:Setting = Split(CacheData(1,0),"|||"):RegSplitWords = Setting(4)
	End Property
	Public Function ReloadBoardInfo(BoardID)
		'数组(21)用来记录版面的下拉菜单,22用来保存该版面的导航,23用来保存该版面的新闻和小字报
		Dim Rs,GetData
		Set Rs=Execute("select BoardID,BoardType,ParentID,ParentStr,Depth,RootID,Child,readme,BoardMaster,PostNum,TopicNum,indexIMG,todayNum,boarduser,LastPost,Sid,Board_Setting,Board_Ads,Board_user,IsGroupSetting,BoardTopStr,BoardID As TempStr,BoardID As TempStr1,BoardID As TempStr2 from Dv_board where BoardID="&BoardID)
  			If Not Rs.Eof Then
  				Name = "BoardInfo_" & BoardID
   				Value = Rs.GetRows(1)
				GetData = Value
				'If GetData(2,0)>0 Then LoadBoardParentStr BoardID,GetData(3,0)
				'LoadBoardNews_Paper(BoardID)
				'LoadBoardList(BoardID)
  			Else
  				'自动修正所有版面的boards数
  				ReloadAllBoardInfo()
  				Response.Redirect "index.asp"
  			End If
  		Rs.Close
  		Set Rs = Nothing
 	End Function
	'缓存版面公告和小字报信息
	Public Function LoadBoardNews_Paper(BoardID)
		Dim tRs,bgs,MyGetData,TempStr,NoAnn,NoColor
		If Not IsArray(lanstr) Then
			NoAnn = "当前没有公告"
		Else
			NoAnn = lanstr(9)
		End If
		If Not IsArray(mainsetting) Then
			NoColor = "blue"
		Else
			NoColor = mainsetting(10)
		End If
		Set tRs=Execute("Select Top 1 title,addtime,bgs From [Dv_bbsnews] Where boardid="&BoardID&" Order By ID Desc")
		If tRs.BOF And tRs.EOF Then
			TempStr = NoAnn & "|||"
		Else
			bgs=tRs(2)
			If bgs="" or IsNull(bgs) Then
				TempStr=tRs(0) & "|||" & tRs(1)
			Else
				TempStr="<img src=Skins/Default/filetype/mid.gif border=0><bgsound src="&bgs&" border=0>"&tRs(0)&"|||"&tRs(1)
			End if
		End If
		'小字报部分
		If IsSqlDataBase=1 Then
			Set tRs=Execute("Select Top 5 S_id as id,S_username as postuser,S_title as topic From Dv_Smallpaper Where Datediff(D,S_addtime,"&SqlNowString&")<=1 And S_boardid="&BoardID&" Order By S_addtime Desc")
		Else
			Set tRs=Execute("Select Top 5 S_id as id,S_username as postuser,S_title as topic From Dv_Smallpaper Where Datediff('D',S_addtime,"&SqlNowString&")<=1 And S_boardid="&BoardID&" Order By S_addtime Desc")
		End If
		If tRs.Eof And tRs.Bof Then
			TempStr=TempStr & "|||"
		Else
			Dim TempData,i
			TempData=tRs.GetRows(-1)
			For i=0 To Ubound(TempData,2)
				If i=0 Then
					TempStr = TempStr & "|||&nbsp;&nbsp;<font color="&NoColor&">"&HtmlEncode(TempData(1,i))&"</font>：<a href=javascript:openScript(""viewpaper.asp?id="&TempData(0,i)&"&boardid="&BoardID&""",500,400)>"&HtmlEncode(TempData(2,i))&"</a>&nbsp;&nbsp;"
				Else
					TempStr = TempStr & "&nbsp;&nbsp;<font color="&NoColor&">"&HtmlEncode(TempData(1,i))&"</font>：<a href=javascript:openScript(""viewpaper.asp?id="&TempData(0,i)&"&boardid="&BoardID&""",500,400)>"&HtmlEncode(TempData(2,i))&"</a>&nbsp;&nbsp;"
				End If
			Next
		End If
		MyGetData = Value
		MyGetData(23,0) = TempStr
		Value = MyGetData
		Set tRs=Nothing
	End Function
	'缓存导航相关信息
	Public Function LoadBoardParentStr(BoardID,MyParentStr)
		Dim tRs,GetData,MyGetData
		Set tRs=Execute("Select Boardid,Boardtype,Boardmaster,Parentid From Dv_Board Where Boardid In ("&MyParentStr&") Order By Orders")
		If Not tRs.Eof Then
			GetData = tRs.GetRows(-1)
			MyGetData = Value
			MyGetData(22,0) = GetData
			Value = MyGetData
		End If
		Set tRs = Nothing
	End Function

	'对应Dvbbs.Board_Data(21,0)，导航菜单缓存;
	Public Function LoadBoardList(BoardID)
		Dim Forum_Boards,i,ii,Depth,Board_Datas,MyBoardList,MyBoardRootID,MyBoard_Data
		If BoardID=0 Then Exit Function
		Name="BoardInfo_" & BoardID
		MyBoard_Data=value
		MyBoardRootID=Clng(MyBoard_Data(5,0))
		Forum_Boards=Split(CacheData(27,0),",")
		For i=0 To Ubound(Forum_Boards)
			Name="BoardInfo_" & Forum_Boards(i)
			If ObjIsEmpty() Then ReloadBoardInfo(Forum_Boards(i))
			Board_Datas = Value
			Depth=Board_Datas(4,0)
			If MyBoardRootID = Board_Datas(5,0) And (Not Board_Datas(2,0) = 0) Then MyBoardList = MyBoardList & "<a href=list.asp?boardid="&Forum_Boards(i)&">"
			Select Case Depth
			Case 0
				If MyBoardRootID = Board_Datas(5,0) And (Not Board_Datas(2,0) = 0) Then MyBoardList = MyBoardList & "╋"
			Case 1
				If MyBoardRootID = Board_Datas(5,0) And (Not Board_Datas(2,0) = 0) Then MyBoardList = MyBoardList & "&nbsp;&nbsp;├"
			End Select
			If Depth>1 Then
				For ii=2 To Depth
					If MyBoardRootID = Board_Datas(5,0) And (Not Board_Datas(2,0) = 0) Then MyBoardList = MyBoardList & "&nbsp;&nbsp;│"
				Next
				If MyBoardRootID = Board_Datas(5,0) And (Not Board_Datas(2,0) = 0) Then MyBoardList = MyBoardList & "&nbsp;&nbsp;├"
			End If
			If MyBoardRootID = Board_Datas(5,0) And (Not Board_Datas(2,0) = 0) Then MyBoardList = MyBoardList & Server.htmlencode(Board_Datas(1,0)) & "</a><br>"
		Next
		Name="BoardInfo_" & BoardID
		MyBoard_Data=value
		MyBoard_Data(21,0)=Replace(Replace(MyBoardList,"'","\'"),Chr(34), "&quot;")
		Board_Data(21,0)=MyBoard_Data(21,0)
		value=MyBoard_Data
		Forum_Boards=Null
		Board_Datas=Null
	End Function
	Public Function ReloadAllBoardInfo()
		Dim Rs,Boards,i
		i = 0
		Set Rs=Execute("Select BoardID From Dv_Board Order By RootID,depth,Orders")
		Do While Not Rs.Eof
			If i = 0 Then
				Boards = Rs(0)
			Else
				Boards = Boards & "," & Rs(0)
			End If
			i = i + 1
		Rs.MoveNext
		Loop
		Set Rs=Nothing
		Execute("Update dv_Setup Set Forum_Boards='"&Boards&"'")
		ReloadSetupCache Boards,27
	End Function
	'更新分版面部分缓存数组，入口：版面ID、更新内容、数组位置、更新方式，0直接赋值，1数值相加
	Public Sub ReloadBoardCache(BoardID,MyValue,N,act)
		If BoardID=444 Or BoardID=777 Or BoardID="" Then
  			Response.Write "错误的版面参数"
  			Response.End
		End If
		If BoardID=0 Then Exit Sub
		Dim Tmpdata
		Name="BoardInfo_" & BoardID
		If ObjIsEmpty() Then ReloadBoardInfo(BoardID)
		Tmpdata=Value
		If act=1 And IsNumeric(Tmpdata(N,0)) And IsNumeric(MyValue) Then
			Tmpdata(N,0)=CLng(Tmpdata(N,0))+MyValue
		Else
			Tmpdata(N,0) = MyValue
   		End If
   		Value=Tmpdata
	End Sub
	Public Function ReloadForumPlusMenu()
		Dim Rs,tRs,TempMenu,TempMenu1,MSetting
		Name="ForumPlusMenu"&SkinID
		Set Rs=Dvbbs.Execute("Select * From Dv_Plus Where Plus_Type='0' Order By ID")
		If Rs.Eof And Rs.Bof Then
			Value=""
			Exit Function
		End If
		Do While Not Rs.Eof
			MSetting=Split(Rs("Plus_Setting"),"|")
			Set tRs=Dvbbs.Execute("Select * From Dv_Plus Where Plus_Type='"&Rs("ID")&"' Order By ID")
			If tRs.Eof And tRs.Bof Then
				Select Case MSetting(0)
				Case 0
					TempMenu = TempMenu & " <img src="&mainpic(18)&" align=absmiddle> <a href="""&Rs("MainPage")&""" title="""&Rs("Plus_CopyRight")&""">"&Rs("Plus_Name")&"</a>"
				Case 1
					TempMenu = TempMenu & " <img src="&mainpic(18)&" align=absmiddle> <a href="""&Rs("MainPage")&""" title="""&Rs("Plus_CopyRight")&""" target=_blank>"&Rs("Plus_Name")&"</a>"
				Case 2
					TempMenu = TempMenu & " <img src="&mainpic(18)&" align=absmiddle> <a href=""JavaScript:openScript('"&Rs("MainPage")&"',"&MSetting(1)&","&MSetting(2)&")"" title="""&Rs("Plus_CopyRight")&""">"&Rs("Plus_Name")&"</a>"
				Case 3
					TempMenu = TempMenu & " <img src="&mainpic(18)&" align=absmiddle> <a href=""JavaScript:openScript('"&Rs("MainPage")&"',screen.width,screen.height)"" title="""&Rs("Plus_CopyRight")&""">"&Rs("Plus_Name")&"</a>"
				End Select
			Else
				Do While Not tRs.Eof
					MSetting=Split(tRs("Plus_Setting"),"|")
					Select Case MSetting(0)
					Case 0
						TempMenu1 = TempMenu1 & "<div class=menuitems><a href="&tRs("MainPage")&" title="&tRs("Plus_CopyRight")&">"&tRs("Plus_Name")&"</a></div>"
					Case 1
						TempMenu1 = TempMenu1 & "<div class=menuitems><a href="&tRs("MainPage")&" title="&tRs("Plus_CopyRight")&" target=_blank>"&tRs("Plus_Name")&"</a></div>"
					Case 2
						TempMenu1 = TempMenu1 & "<div class=menuitems><a href=JavaScript:openScript(\'"&tRs("MainPage")&"\',"&MSetting(1)&","&MSetting(2)&") title="&tRs("Plus_CopyRight")&">"&tRs("Plus_Name")&"</a></div>"
					Case 3
						TempMenu1 = TempMenu1 & "<div class=menuitems><a href=JavaScript:openScript(\'"&tRs("MainPage")&"\',screen.width,screen.height) title="&tRs("Plus_CopyRight")&">"&tRs("Plus_Name")&"</a></div>"
					End Select
				tRs.MoveNext
				Loop
				MSetting=Split(Rs("Plus_Setting"),"|")
				Select Case MSetting(0)
				Case 0
					TempMenu = TempMenu & " <img src="&mainpic(18)&" align=absmiddle> <a href="""&Rs("MainPage")&""" title="""&Rs("Plus_CopyRight")&""" onMouseOver=""showmenu(event,'"&TempMenu1&"')"">"&Rs("Plus_Name")&"</a>"
				Case 1
					TempMenu = TempMenu & " <img src="&mainpic(18)&" align=absmiddle> <a href="""&Rs("MainPage")&""" title="""&Rs("Plus_CopyRight")&""" target=_blank onMouseOver=""showmenu(event,'"&TempMenu1&"')"">"&Rs("Plus_Name")&"</a>"
				Case 2
					TempMenu = TempMenu & " <img src="&mainpic(18)&" align=absmiddle> <a href=""JavaScript:openScript('"&Rs("MainPage")&"',"&MSetting(1)&","&MSetting(2)&")"" title="""&Rs("Plus_CopyRight")&""" onMouseOver=""showmenu(event,'"&TempMenu1&"')"">"&Rs("Plus_Name")&"</a>"
				Case 3
					TempMenu = TempMenu & " <img src="&mainpic(18)&" align=absmiddle> <a href=""JavaScript:openScript('"&Rs("MainPage")&"',screen.width,screen.height)"" title="""&Rs("Plus_CopyRight")&""" onMouseOver=""showmenu(event,'"&TempMenu1&"')"">"&Rs("Plus_Name")&"</a>"
				End Select
				TempMenu1=""
			End If
		Rs.MoveNext
		Loop
		Value=TempMenu
		Set tRs=Nothing
		Set Rs=Nothing
	End Function
	'取得带端口的URL，推荐使用
	Property Get Get_ScriptNameUrl()
		If request.servervariables("SERVER_PORT")="80" Then
			Get_ScriptNameUrl="http://" & request.servervariables("server_name")&replace(lcase(request.servervariables("script_name")),ScriptName,"")
		Else
			Get_ScriptNameUrl="http://" & request.servervariables("server_name")&":"&request.servervariables("SERVER_PORT")&replace(lcase(request.servervariables("script_name")),ScriptName,"")
		End If
	End Property
	'删除服务器上论坛的所有缓存数据
	Public Sub DelallCache()
	Dim Cacheobj
	For Each Cacheobj in Application.Contents
		If CStr(Left(Cacheobj,Len(CacheName)+1))=CStr(CacheName&"_") Then
			Application.Lock
			Application.Contents.Remove(Cacheobj)
			Application.UnLock	
		End If
	Next 
	End Sub 
End Class
Class cls_Templates
	Public html,Strings,pic
	Public Property Let Value(ByVal vNewValue)
		Dim tmpstr:tmpstr = vNewValue:tmpstr = Split(tmpstr,"@@@")
		html = Split(tmpstr(0),"|||"):Strings = Split(tmpstr(1),"|||"):pic = Split(tmpstr(2),"|||")
	End Property
End Class
Class cls_UserOnlne
	Public Forum_Online,Forum_UserOnline,Forum_GuestOnline
	Private l_Online,l_GuestOnline
	Private Sub Class_Initialize()
		Dvbbs.Name="Forum_Online"
		Dvbbs.Reloadtime=60
		If Dvbbs.ObjIsEmpty() Then ReflashOnlineNum
		Dvbbs.Name="Forum_Online"
		Forum_Online = Dvbbs.Value
		Dvbbs.Name="Forum_UserOnline"
		If Dvbbs.ObjIsEmpty() Then ReflashOnlineNum
		Forum_UserOnline=Dvbbs.Value
		If Forum_Online < 0  Or Forum_UserOnline < 0 Or Forum_UserOnline > Forum_Online Then ReflashOnlineNum
		Forum_GuestOnline = Forum_Online - Forum_UserOnline
		l_Online=-1:l_GuestOnline=-1
		Dvbbs.Reloadtime=28800
	End Sub
	Public Sub OnlineQuery()
		Dim SQL,SQL1
		Dim TempNum,TempNum1
		Dvbbs.Name="delOnline_time"
		If Dvbbs.ObjIsEmpty() Then Dvbbs.Value=Now()
		If DateDiff("s",Dvbbs.Value,Now()) > Clng(Dvbbs.Forum_Setting(8))*10 Then
			Dvbbs.Value=Now()
			If Not IsObject(Conn) Then ConnectionDatabase
			If IsSqlDataBase = 1 Then
				SQL = "Delete From [DV_Online] Where UserID=0 And Datediff(Mi, Lastimebk, " & SqlNowString & ") > " & Clng(Dvbbs.Forum_Setting(8))
				SQL1 = "Delete From [DV_Online] Where UserID>0 And Datediff(Mi, Lastimebk, " & SqlNowString & ") > " & Clng(Dvbbs.Forum_Setting(8))
			Else
				SQL = "Delete From [Dv_Online] Where UserID=0 And Datediff('s', Lastimebk, " & SqlNowString & ") > " & Dvbbs.Forum_Setting(8) & "*60" 
				SQL1 = "Delete From [Dv_Online] Where UserID>0 And Datediff('s', Lastimebk, " & SqlNowString & ") > " & Dvbbs.Forum_Setting(8) & "*60"
			End If
			Conn.Execute SQL,TempNum
			Conn.Execute SQL1,TempNum1
			Dvbbs.SqlQueryNum = Dvbbs.SqlQueryNum + 2
			'如果删除客人数大于0，则应该更新总数
			If TempNum>0 Then
				'更新缓存总在线数据
				Forum_Online = Forum_Online - TempNum
				Forum_GuestOnline = Forum_GuestOnline - TempNum
			End If
			'如果删除用户数大于0，则应该更新总数和用户数
			If TempNum1>0 Or  TempNum>0 Then
				'更新缓存总在线数据
				Forum_Online = Forum_Online - TempNum1
				Forum_UserOnline = Forum_UserOnline - TempNum1
				
			End If
			Dvbbs.Name="Forum_Online"
			Dvbbs.Value=Forum_Online
			'更新缓存总用户在线数据
			Dvbbs.Name="Forum_UserOnline"
			Dvbbs.Value=Forum_UserOnline
			Forum_Online = Forum_Online - TempNum1
		End If
	End Sub
	'刷新在线数据缓存
	Public Sub ReflashOnlineNum
		Dim Rs
		Set Rs=Dvbbs.Execute("Select Count(*) From Dv_Online")
		Dvbbs.Value=Rs(0)
		Forum_Online = Dvbbs.Value
		Dvbbs.Name="Forum_UserOnline"
		Set Rs=Dvbbs.Execute("Select Count(*) From Dv_Online Where UserID>0")
		Dvbbs.Value=Rs(0)
		Forum_UserOnline = Dvbbs.Value
		Set Rs=Nothing
	End Sub
	'查询在某版面的在线总数
	Public Property Get Board_Online
		Board_Online=Board_UserOnline+Board_GuestOnline
	End Property
	Public Property Get Board_GuestOnline
		If l_GuestOnline=-1 Then
			Dim Rs
			Set Rs=Dvbbs.Execute("Select Count(*) From Dv_Online where BoardID="&Dvbbs.BoardID&" and UserID=0")
			l_GuestOnline=Rs(0):Set Rs= Nothing 
		End If
		Board_GuestOnline=l_GuestOnline
	End Property
	Public Property Get Board_UserOnline
		If l_Online=-1 Then
			Dim Rs
			Set Rs=Dvbbs.Execute("Select Count(*) From Dv_Online where BoardID="&Dvbbs.BoardID&" and UserID>0")
			l_Online=Rs(0):Set Rs= Nothing 
		End If
		Board_UserOnline=l_Online
	End Property
End Class
Class Cls_Browser
	Public Browser,version ,platform
	Private Sub Class_Initialize()
		Browser="unknown"
		version="unknown"
		platform="unknown"
		Dim Agent
		Agent=Request.ServerVariables("HTTP_USER_AGENT")
		Agent=Split(Agent,";")
		If InStr(Agent(1),"MSIE")>0 Then
			Browser="Microsoft Internet Explorer "
			version=Trim(Left(Replace(Agent(1),"MSIE",""),6))
		ElseIf InStr(Agent(4),"Netscape")>0 Then 
			Browser="Netscape "
			Dim tmpstr
			tmpstr=Split(Agent(4),"/")
			version=tmpstr(UBound(tmpstr))
		End If
		If InStr(Agent(2),"NT 5.2")>0 Then
			platform="Windows 2003"
		ElseIf InStr(Agent(2),"NT 5.1")>0 Then
			platform="Windows XP"
		ElseIf InStr(Agent(2),"NT 5.0")>0 Then
			platform="Windows 2000"
		ElseIf InStr(Agent(2),"9x")>0 Then
			platform="Windows ME"
		ElseIf InStr(Agent(2),"98")>0 Then
			platform="Windows 98"
		ElseIf InStr(Agent(2),"95")>0 Then
			platform="Windows 95"
		End If	
		'记录未知Agent
		If Browser="unknown" Or version="unknown" Or platform="unknown" Then
			Agent=Dvbbs.checkStr(Request.ServerVariables("HTTP_USER_AGENT"))
			Dim lConnStr,lConn,ldb
			ldb = "data/DvSQLLOG.mdb"
			lConnStr = "Provider = Microsoft.Jet.OLEDB.4.0;Data Source = " & Server.MapPath(ldb)
			Set lConn = Server.CreateObject("ADODB.Connection")
			lConn.Open lConnStr
			lConn.Execute("insert into [Agent](UserAgent)Values('" & Agent & "')")
			lConn.Close
			Set lConn = Nothing 
		End If
	End Sub 
End Class
%>