<%
'=========================================================
' File: Dv_ClsMain.asp
' Version:7.0 sp3
' Date: 2004-6-30
' Script Written by dvbbs.net
'=========================================================
' Copyright (C) 2003,2004 AspSky.Net. All rights reserved.
' Web: http://www.aspsky.net,http://www.dvbbs.net
' Email: eway@aspsky.net
'=========================================================
'是否商业版，非官方SQL版本请在此设置为0以及在Conn中设置论坛为SQL数据库，否则显示不正常
Const IsBuss=1
Const Dvbbs_Server_Url = "http://server.dvbbs.net/"
Class Cls_Forum
	Rem Const
	Public BoardID,SqlQueryNum,Forum_Info,Forum_Setting,Forum_user,Forum_Copyright,Forum_ads,Forum_ChanSetting,Forum_UploadSetting
	Public Forum_sn,Forum_Version,Stats,StyleName,ErrCodes,NowUseBBS,Cookiepath,ScriptFolder
	Public lanstr,mainhtml,mainsetting,sysmenu,mainpic
	Public MyUserInfo,UserToday,BoardJumpList,BoardList,CacheData,Maxonline
	Public UserGroupID,Lastlogin,GroupSetting,FoundUserPer,UserInfoCount,UserGroupParent,UserGroupParentID
	Public VipGroupUser,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,Forum_PicUrl
	Private adcode_1,adcode_2,adcode_4,ScriptTrueUrl,Forum_CSS,Main_Sid,Nowstats,CssID
	Public Reloadtime,CacheName,savelog
	Private LocalCacheName,Cache_Data,IsTopTable,CookiesSid,BoardInfoData,ShowErrType
	Public Board_Setting,boarduser,LastPost,Board_Ads,Board_user,BoardType,IsGroupSetting,BoardMasterList,Board_Data,Sid,Boardreadme,BoardRootID,BoardParentID
	Private Is_Isapi_Rewrite,iArchiverUrl
	Public ModHtmlLinked,ArchiverUrl,ArchiverType
	Public Browser,version ,platform,IsSearch
	Public BoardXML,BoardNode,NodeUpdate
	Public IsUserPermissionOnly,IsUserPermissionAll
	Rem Sub 
	Private Sub Class_Initialize()
		If Not Response.IsClientConnected Then Response.End
		IsUserPermissionOnly = 0
		IsUserPermissionAll = 0
		ShowErrType = 0 '错误信息显示模式
		savelog=0'设置为1的时候会记录攻击或错误错信息。
		SqlQueryNum = 0
		Reloadtime=28800
		CacheName = Lcase(Replace(Replace(Replace(Server.MapPath("index.asp"),"index.asp",""),":",""),"\",""))
		IsTopTable = 0
		Forum_sn = Replace(CacheName,"_","")
		VipGroupUser = False
		Vipuser = False:Boardmaster = False
		Superboardmaster = False:Master = False:FoundIsChallenge = False:FoundUser = False
		BoardID = Request("BoardID")
		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 = Trim(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
		Tmpstr = Request.ServerVariables("PATH_INFO")
		Tmpstr = Split(Tmpstr,"/")
		ScriptName = Lcase(Tmpstr(UBound(Tmpstr)))
		ScriptFolder = Lcase(Tmpstr(UBound(Tmpstr)-1)) & "/"
		MemberClass = checkStr(Request.Cookies(Forum_sn)("userclass"))
		Page_Admin=False
		If InStr(ScriptName,"showerr")>0 Or InStr(ScriptName,"login")>0 Or InStr(ScriptName,"admin_")>0 Then Page_Admin=True
		sendmsgnum=0:sendmsgid=0:sendmsguser=""
		'模拟HTML部分开始
		Is_Isapi_Rewrite = 0
		If Is_Isapi_Rewrite = 0 Then ModHtmlLinked = "?"
		ArchiverType = 0
		If InStr(ScriptName,"indexhtml.asp") > 0 Then
			iArchiverUrl = Lcase(Request.ServerVariables("QUERY_STRING"))
			If iArchiverUrl <> "" Then
				ArchiverUrl = iArchiverUrl
				iArchiverUrl = Split(iArchiverUrl,"_")
				If iArchiverUrl(0) = "list" And Ubound(iArchiverUrl) = 5 Then
					If IsNumeric(iArchiverUrl(1)) Then
						ArchiverType = 1
						BoardID = Clng(iArchiverUrl(1))
					End If
				End If
			End If
		End If
		'模拟HTML部分结束
		'Response.Write Server.MapPath("index.asp")
		'response.end
		NodeUpdate=False
	End Sub
	
	Private Sub class_terminate()
		If NodeUpdate Then
			Application.lock
			Set Application(CacheName&"_Boradlist")=BoardXML.cloneNode(True)
			Application.unlock
		End If
		Set BoardXML = Nothing
		If IsObject(Conn) Then Conn.Close : Set Conn = Nothing
		If IsObject(Plus_Conn) Then Plus_Conn.Close : Set Plus_Conn = Nothing
	End Sub
	Public Property Let Name(ByVal vNewValue)
		LocalCacheName = LCase(vNewValue)
		Cache_Data=Application(CacheName & "_" & LocalCacheName)
	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 	
			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	
		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 Checkcache()
		Name="Date"
		Dim iScriptName
		iScriptName = Request.ServerVariables("Script_Name")
		If InStr(Lcase(iScriptName),"admin/") > 0 Then
			iScriptName = "admin/index.asp"
		Else
			iScriptName = ""
		End If
		If ObjIsEmpty() Then
			If iScriptName <> "" Then
				Session("LoadCache")=iScriptName
				Response.Redirect "../LoadCache.asp"
			Else
				If Request.ServerVariables("QUERY_STRING")<>"" Then
					Session("LoadCache")=ScriptName&"?"&Request.ServerVariables("QUERY_STRING")
				Else
					Session("LoadCache")=ScriptName
				End If
				Response.Redirect "LoadCache.asp"
			End If
		Else
			If Cstr(value) <> Cstr(Date()) Then
				If iScriptName <> "" Then
					Session("LoadCache")=iScriptName
					Response.Redirect "../LoadCache.asp"
				Else
					If Request.ServerVariables("QUERY_STRING")<>"" Then
						Session("LoadCache")=ScriptName&"?"&Request.ServerVariables("QUERY_STRING")
					Else
						Session("LoadCache")=ScriptName
					End If
					Response.Redirect "LoadCache.asp"
				End If
			End If
		End If
	End Sub
	'取得基本设置数据
	Public Sub GetForum_Setting()
		Name="setup"
		CacheData=value
		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_UploadSetting = Split(Forum_Setting(7),"|")
		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 ScriptFolder = Lcase(CacheData(33,0)) Then Page_Admin = True
		'IP锁定
		If Request.Cookies(Forum_sn & "Kill")("kill") = "1" Then
			If Not Page_Admin Then Response.Redirect "showerr.asp?action=iplock"
		ElseIf Not ( Request.Cookies(Forum_sn & "Kill")("kill") = "0" And Not IsEmpty(Session(CacheName & "UserID")) ) Then
			Call ChecKIPlock
			If Request.Cookies(Forum_sn & "Kill")("kill") = "1" Then
				If Not Page_Admin Then Response.Redirect "showerr.asp?action=iplock"
			End If
		End If	
		'关闭论坛相关部分
		'判断BoardID的值，获取对应的设置
		If Forum_Setting(21)="1" And Not Page_Admin Then Response.redirect "showerr.asp?action=stop"		
		Dim OpenTime,ischeck
		Set BoardXML=Application(CacheName&"_Boradlist").cloneNode(True)
		'If (Dvbbs.Forum_ChanSetting(13)="1" And Dvbbs.Forum_ChanSetting(0)="1") Or Dvbbs.Forum_ChanSetting(3)="0" Then MyForumPay = True
		
		If BoardID>0 Then
			Dim Nodelist,node
			Set Nodelist=BoardXML.documentElement.getElementsByTagName("board")
			For Each Node in nodelist
				If Cstr(BoardId)=Node.attributes.getNamedItem("boardid").text Then
					Set BoardNode=Node
					Exit For
				End If		
			Next
			Set Nodelist=Nothing
			If  Not IsObject(BoardNode) Then
				Response.Write "错误的版面参数"
  				Response.End
  			ElseIf BoardNode is Nothing Then
  				Response.Write "错误的版面参数"
  				Response.End
			End If
			boarduser = Split(BoardNode.attributes.getNamedItem("boarduser").text,",")
			Forum_ads = Split(BoardNode.attributes.getNamedItem("board_ads").text,"$")
			Forum_user = Split(BoardNode.attributes.getNamedItem("board_user").text,",")
			'Forum_user = Board_User
			board_Setting = Split(BoardNode.attributes.getNamedItem("board_setting").text,",")
			LastPost = Split(BoardNode.attributes.getNamedItem("lastpost").text,"$")
			BoardType = BoardNode.attributes.getNamedItem("boardtype").text
			IsGroupSetting = BoardNode.attributes.getNamedItem("isgroupsetting").text
			BoardMasterList = BoardNode.attributes.getNamedItem("boardmaster").text
			BoardRootID = BoardNode.attributes.getNamedItem("rootid").text
			If BoardNode.parentNode.attributes.getNamedItem("boardid") is Nothing Then
				BoardParentID="0"
			Else
				BoardParentID=BoardNode.parentNode.attributes.getNamedItem("boardid").text
			End If
			Sid = BoardNode.attributes.getNamedItem("sid").text
			Boardreadme=BoardNode.attributes.getNamedItem("readme").text
			If Len(Board_Setting(22))< 24 Then Board_Setting(22)="1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1"
			OpenTime=Split(Board_Setting(22),"|")
			setting=Board_Setting(21)
			ischeck=Clng(Board_Setting(18))
			If Board_Setting(50)<>"0" And Board_Setting(50)<>"" Then Response.Redirect Board_Setting(50)
		Else
			Forum_ads =  CacheData(2,0)
			Forum_ads = Split(Forum_ads,"$")
			If Len(Forum_Setting(70))< 24 Then Forum_Setting(70)="1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1"
			OpenTime=Split(Forum_Setting(70),"|")
			setting=Forum_Setting(69)
			ischeck=Forum_Setting(26)
			If Not IsNumeric(ischeck) Then ischeck=0
			ischeck=CLng(ischeck)		
		End If
		'定时开放判断
		If Not Page_Admin And Cint(setting)=1 Then
			If OpenTime(Hour(Now))="1" Then Response.redirect "showerr.asp?action=stop&boardid="&Dvbbs.BoardID&""
		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
		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
	End Sub
	Public Function IsReadonly()
		IsReadonly=False
		Dim TimeSetting
		If Forum_Setting(69)="2" Then
			TimeSetting=split(Forum_Setting(70),"|")
			If TimeSetting(Hour(Now))="1" Then
				IsReadonly=True
				Exit Function
			End If
		End If
		If BoardID>0 Then 
			If Board_Setting(21)="2" Then
				TimeSetting=split(Board_Setting(22),"|")
				If TimeSetting(Hour(Now))="1" Then IsReadonly=True
			End If
		End If 
	End Function
	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 LoadTemplates(Page_Fields)
		Dim Style_Pic,Main_Style,TempStyle
		SkinID=CLng(SkinID)
		'风格换肤修改
		TempStyle = CacheData(35,0)
		TempStyle = Split(TempStyle,"@@@")
		If SkinID > UBound(Split(TempStyle(1),"|||"))-1 Then SkinID = 0
		Forum_CSS = Split(TempStyle(1),"|||")(SkinID)		'风格内容
		Forum_PicUrl = Split(TempStyle(2),"|||")(SkinID)	'图片路径
		CssID = SkinID
		SkinID = Split(TempStyle(3),"|||")(SkinID)		'采用模板ID
		Name = "Main_Style"&SkinID
		Main_Style = Replace(value,"{$PicUrl}",Forum_PicUrl)		'风格图片路径替换
		Name="StyleName"&SkinID
		StyleName=value
		If Not (Instr(ScriptName,"index")>0 Or Page_Admin) Then
			Name = "Style_Pic"&SkinID
			Style_Pic = Replace(value,"{$PicUrl}",Forum_PicUrl)		'风格图片路径替换
			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
			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),"||")
		Forum_CSS = Replace(Forum_CSS,"{$width}",mainsetting(0))
		Forum_CSS = Replace(Forum_CSS,"{$PicUrl}",Forum_PicUrl)
	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 Sub ReloadSetupCache(MyValue,N)
		CacheData(N,0) = MyValue
		Name="setup"
		value=CacheData
	End Sub
	'更新用户资料缓存(缓存用户名,是否需要添加)[0=不添加,只作清理,1=需要添加]
	Public Sub NeedUpdateList(username,act)
		Dim Tmpstr,TmpUsername
		Name="NeedToUpdate"
		If ObjIsEmpty() Then Value=""
		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=",post.asp,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,savepost.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
			Else
				Call LetGuestSession()
			End If	
		Else
			If UserID >0  Then
				Dim NeedToUpdate,toupdate
				toupdate=False
				Name="NeedToUpdate"
				If Not ObjIsEmpty() Then 
					NeedToUpdate=","&Value&","
					If InStr(NeedToUpdate,","&MemberName&",")>0 Then
						Call NeedUpdateList(MemberName,0)
						toupdate=True
					End If
				End If
				
				If NeedChecklongin Or (UserID >0 And Not Ubound(Session(CacheName & "UserID"))=45) Or toupdate Then TrueCheckUserLogin
			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	
		Response.Write "<iframe width=""0"" height=""0"" src=""newpass.asp"" name=""Dvnewpass""></iframe>"
	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用户积分UserEp+23用户魅力UserCp+24用户威望+25用户生日+26最后登陆IP+27用户被删除数+28用户精华数+29用户隐身状态+30用户短信情况+31用户阳光会员+32用户手机+33用户组图标+34用户头衔+35验证密码+36用户今日信息+37用户金币+38用户点券+	39跟踪用户ID+40VIP登记时间+41VIP截止时间+42是否存在全局自定义权限IsUserPermissionAll+43是否有多属性用户组IsUserPermissionOnly+44临时数据+45Dvbbs
		Dim Rs,SQL,FoundMyGroupID
		FoundMyGroupID = 0
		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,UserMoney,UserTicket,FollowMsgID,Vip_StarTime,Vip_EndTime"
		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, "|||","","")
			If IsArray(Session(CacheName & "UserID")) Then
				If Session(CacheName & "UserID")(0)="Dvbbs" Then	'修正防刷新的问题,轻飘飘
					If Cint(Session(CacheName & "UserID")(19)) <> Cint(Split(MyUserInfo,"|||")(15)) Then FoundMyGroupID = Cint(Session(CacheName & "UserID")(19))
					If FoundMyGroupID > 0 Then
					MyUserInfo = "Dvbbs|||"& Session(CacheName & "UserID")(1) & "|||"& Session(CacheName & "UserID")(2) &"|||"& BoardID &"|||"& MyUserInfo &"|||"&FoundUserPermission_All()&"|||"&Split(MyUserInfo,"|||")(15)&"|||"& Session(CacheName & "UserID")(Ubound(Session(CacheName & "UserID"))-1) &"|||Dvbbs"
					Else
					MyUserInfo = "Dvbbs|||"& Session(CacheName & "UserID")(1) & "|||"& Session(CacheName & "UserID")(2) &"|||"& BoardID &"|||"& MyUserInfo &"|||"&FoundUserPermission_All()&"|||0|||"& Session(CacheName & "UserID")(Ubound(Session(CacheName & "UserID"))-1) &"|||Dvbbs"
					End If
				Else
					MyUserInfo = "Dvbbs|||"& Now & "|||" & DateAdd("s",-3600,Now()) &"|||"& BoardID &"|||"& MyUserInfo &"|||"&FoundUserPermission_All()&"|||0||||||Dvbbs"
				End If
			Else
				MyUserInfo = "Dvbbs|||"& Now & "|||" & DateAdd("s",-3600,Now()) &"|||"& BoardID &"|||"& MyUserInfo &"|||"&FoundUserPermission_All()&"|||0||||||Dvbbs"
			End If
			Rs.Close:Set Rs = Nothing
			MyUserInfo = Split(MyUserInfo,"|||")
			If FoundMyGroupID > 0 Then MyUserInfo(19) = FoundMyGroupID
			If Trim(MyUserInfo(35)) = Memberword And MyUserInfo(5) =Membername Then
				Session(CacheName & "UserID") = MyUserInfo
				Memberword = MyUserInfo(35)
				GetCacheUserInfo()
			Else
				If IsArray(Session(CacheName & "UserID"))  Then
					If Session(CacheName & "UserID")(0)="Dvbbs" Then
						If Trim(Session(CacheName & "UserID")(4))=Trim(MyUserInfo(4)) And Session(CacheName & "UserID")(5)=MyUserInfo(5) And Trim(Session(CacheName & "UserID")(6))=Trim(MyUserInfo(6)) Then
							If Request.ServerVariables("QUERY_STRING")<>"" Then
								Session("LoadCache")=ScriptName&"?"&Request.ServerVariables("QUERY_STRING")
							Else
								Session("LoadCache")=ScriptName
							End If
							If Session("flag")<>"" Then
								Response.Redirect "../newpass.asp"
							Else
								Response.Redirect "newpass.asp"
							End If
						End If 
					Else
						UserID = 0
						EmptyCookies
						LetGuestSession()
					End If
				Else
					UserID = 0
					EmptyCookies
					LetGuestSession()
				End If 
			End If
		End If
	End Sub
	'用户登录成功后，采用本函数读取用户数组并判断一些常用信息
	Public Sub GetCacheUserInfo()
		MyUserInfo = Session(CacheName & "UserID")
		UserInfoCount = Ubound(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|0|0' Where UserID = " & UserID)
			MyUserInfo(36) = "0|0|0|0|0"
			UserToday = Split(MyUserInfo(36),"|")
		Else
			UserToday = Split(MyUserInfo(36),"|")
			If Ubound(UserToday) <> 4 Then
				Execute("Update [Dv_User] Set UserToday='0|0|0|0|0' Where UserID = " & UserID)
				MyUserInfo(36) = "0|0|0|0|0"
				UserToday = Split(MyUserInfo(36),"|")
			End If
		End If
		'判断是否VIP组成员
		If Not IsNull(MyUserInfo(41)) or MyUserInfo(41)<>"" Then
			If IsDate(MyUserInfo(41)) Then
				If DateDiff("d",Now(),MyUserInfo(41))>0 Then
					VipGroupUser = True
				Else
					Dim tRs
					'将已过期的VIP用户移回注册组并清空有效时间
					If UserGroupID>8 Then
						Set tRs=Execute("Select Top 1 * From Dv_UserGroups Where ParentGID=3 And MinArticle<="&MyUserInfo(8)&" Order By MinArticle Desc")
							If not tRs.Eof Then
								Execute("Update Dv_User Set UserClass='"&tRs("UserTitle")&"',TitlePic='"&tRs("GroupPic")&"',UserGroupID="&tRs("UserGroupID")&",Vip_StarTime=null,Vip_EndTime=null Where UserID="&UserID)
							End If
						Set tRs=Nothing
					Else
						Execute("Update Dv_User Set Vip_StarTime=null,Vip_EndTime=null Where UserID="&UserID)
					End If
					MyUserInfo(40) = ""
					MyUserInfo(41) = ""
					Session(CacheName & "UserID") = MyUserInfo
				End If
			End If
		End If
		Select Case UserGroupID
		Case 8
			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|0|0',LastLogin = " & SqlNowString & " Where UserID = " & UserID)
			MyUserInfo(36) = "0|0|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
		If IsNull(MyUserInfo(39)) Then
			MyUserInfo(39)=""
		Else
			MyUserInfo(39) = Replace(Trim(MyUserInfo(39))&"",Chr(13),"")
		End If
		'跟踪用户处理
		If MyUserInfo(39)<>"" Then
			Dim ToolsFollowUserID,i,Rs,Tools_inceptid,Tools_newincept,Tools_msginfo
			ToolsFollowUserID = Split(MyUserInfo(39),",")
			For i=0 To Ubound(ToolsFollowUserID)
				If Len(ToolsFollowUserID(i))>0 and Len(ToolsFollowUserID(i))<50 and ToolsFollowUserID(i)<>"" Then
					ToolsFollowUserID(i) = CheckStr(ToolsFollowUserID(i))
						Execute("Insert into Dv_Message (incept,sender,title,content,sendtime,flag,issend) values ('"& ToolsFollowUserID(i)&"','系统消息','您跟踪的用户"&Dvbbs.MemberName&"已登录','您使用了论坛道具“狗仔队”，您所跟踪的用户 "&Dvbbs.Membername&" 于 "&Now()&" 登录了论坛，请您及时和该用户取得联系，感谢您采用我们的服务。',"&SqlNowString&",0,1)")
						Set Rs=Execute("Select top 1 id,sender From Dv_Message Where incept ='"& ToolsFollowUserID(i) &"'")
						Tools_inceptid=Rs(0) &"||"& Rs(1)
						Set Rs=Execute("Select Count(id) From Dv_Message Where Flag=0 and issend=1 and delR=0 And incept='"& ToolsFollowUserID(i) &"'")
						Tools_newincept = Rs(0)
						Set Rs=Nothing
						If IsNull(Tools_newincept) Then Tools_newincept=0
						Tools_msginfo=Tools_newincept & "||" & Tools_inceptid
						Execute("update [dv_user] set UserMsg='"&CheckStr(Tools_msginfo)&"' where username='"&ToolsFollowUserID(i)&"'")
				End If
			Next
			MyUserInfo(39) = ""
			Execute("UpDate Dv_User Set FollowMsgID='' Where UserID="&UserID)
		End If
		FoundUser=True
		MyUserInfo(15)=Lastlogin
		'用户头像处理
		Dim iUserMagicFace
		iUserMagicFace = Split(MyUserInfo(11),"|")
		If Ubound(iUserMagicFace) = 1 Then MyUserInfo(11) = iUserMagicFace(1)
		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()
		Dim tGroupSetting
		Name = "GroupSetting_" & UserGroupID
		tGroupSetting = Split(value,"§§§")
		GroupSetting = Split(tGroupSetting(0),",")
		UserGroupParent = Cint(tGroupSetting(1))
		UserGroupParentID = Split(tGroupSetting(2),"|")
		IsUserPermissionAll = MyUserInfo(Ubound(MyUserInfo)-3)
		If Cint(GroupSetting(0))=0 And Not Page_Admin Then AddErrCode "8":Showerr()
		If BoardID > 0 And Not ScriptName="showerr.asp" Then BoardInfoData=CheckBoardInfo()
		If UserID > 0 And BoardID=0 Then
			If IsUserPermissionAll="1" Then LoadUserPermission_All()
		End If
	End Sub
	'输出缓存用户组GroupSetting(58)设置 （用户名在帖子内容中显示标记） 组ID,姓名代码|||
	Public Function GroupSetting_UserName()
		Name="GroupSetting_UserName"
		GroupSetting_UserName = value
	End Function
	'用户是否存在论坛全局自定义权限
	Public Function FoundUserPermission_All()
		Dim PerRs
		FoundUserPermission_All = 0
		Set PerRs=Execute("Select Uc_Setting From Dv_UserAccess Where Uc_Boardid=0 And uc_UserID="&UserID)
		If Not (PerRs.Eof And PerRs.Bof) Then FoundUserPermission_All = 1
		PerRs.Close:Set PerRs=Nothing
	End Function
	Public Sub LoadUserPermission_All()
		Dim Rs
		Set Rs=Dvbbs.execute("Select Uc_Setting From Dv_UserAccess Where Uc_Boardid=0 And uc_UserID="&UserID)
		If Not(Rs.Eof And Rs.Bof) Then
			UserPermission=Split(Rs(0),",")
			GroupSetting = Split(Rs(0),",")
			FoundUserPer=True
		End If
		Set Rs=Nothing
	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  And Not InStr(ScriptName,"showerr")>0 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 uip,StatsStr
			uip = UserTrueIP
        	StatsStr = Stats
        	StatsStr = Replace(StatsStr, "'", "")
        	StatsStr = Replace(StatsStr, Chr(0), "")
        	StatsStr = Replace(StatsStr, "--", "——")
        	StatsStr = Left(StatsStr, 250)
		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
				GetBrowser()
				'不记录搜索引擎的客人 2004-8-30 Dv.Yz
				If IsSearch  Or (Browser="unknown" And Version="unknown" And Platform="unknown") Then
					Exit Sub  
				End If
				SQL = "Insert Into [Dv_Online](ID,Username,Userclass,Ip,Startime,Lastimebk,Boardid,Browser,Stats,Usergroupid,Actcome,Userhidden) Values (" & StatUserID & ",'客人','客人','" & UserTrueIP & "'," & SqlNowString & "," & SqlNowString & "," & Boardid & ",'" & platform&"|"&Browser&version & "','" & StatsStr & "',7,'" & Actcome & "'," & Userhidden & ")"
				'更新缓存总在线数据
				MyBoardOnline.Forum_Online=MyBoardOnline.Forum_Online+1
				Name="Forum_Online"
				value=MyBoardOnline.Forum_Online 
			Else
				SQL = "Update [Dv_Online] Set Lastimebk = " & SqlNowString & ",Boardid = " & Boardid & ",Stats = '" & StatsStr & "' Where ID = " & Ccur(StatUserID)
			End If
			Rs.Close
			Set Rs = Nothing
			Execute(SQL)
		Else
			SQL = "Select ID,Boardid,Lastimebk 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
				GetBrowser
				
		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 & ",'" & platform&"|"&Browser&version & "','" & StatsStr & "'," & UserGroupID & ",'" & Actcome & "'," & Userhidden & "," & UserID & ")"
				'更新缓存总在线数据
				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 = '" & StatsStr & "' Where UserID = " & UserID
Dim OnlineTime
			OnlineTime=DateDiff("s",Rs(2),Now())
			If OnlineTime>0 Then
				Execute("UPDATE [Dv_User] SET OnlineTime="&OnlineTime&" WHERE UserID="&UserID&" And OnlineTime Is Null")
				Execute("UPDATE [Dv_User] SET OnlineTime=OnlineTime+"&OnlineTime&" WHERE UserID="&UserID)
			End If
			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()
		Nowstats=stats
		If BoardID > 0 And ScriptName<>"printpage.asp" Then Stats=BoardType&"-"&Stats
		Stats=Replace(Stats,Chr(34),"&quot;")
		Stats=Replace(Stats,Chr(13),"")
		Dim re,TitleStats
		Set re=new RegExp
			re.IgnoreCase =True
			re.Global=True
			re.Pattern="<(.[^>]*)>"
			TitleStats=re.Replace(Stats, "")
			re.Pattern=""""
			TitleStats=re.Replace(TitleStats, "&quot;")
		Set Re=Nothing
		Response.Write Replace(Replace(Replace(mainhtml(1),"{$keyword}",Replace(Forum_info(8),"|",",")),"{$description}",Forum_info(10))&vbNewLine,"{$title}",Forum_Info(0)&"-"&TitleStats)
		Response.Write Forum_CSS
		Response.Write Chr(10)
		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,Tempstr1
		Dim RayMenuInfo,RayMenu
		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 Or GroupSetting(70)="1" Then
				sysmenu = Replace(sysmenu,"{$manageinfo}",mainhtml(10))
			Else
				sysmenu = Replace(sysmenu,"{$manageinfo}","")
			End If
			If Forum_ChanSetting(0)="1" Then
				RayMenuInfo = Split(mainhtml(11),"||")
				RayMenu = Replace(Replace(RayMenuInfo(4),"{$channame}",CacheData(23,0)),"{$forumurl}",Forum_Info(1))
				If FoundIsChallenge Then
					RayMenu = RayMenu & RayMenuInfo(2)
				Else
					RayMenu = RayMenu & RayMenuInfo(3)
				End If
				RayMenu = Replace(RayMenuInfo(1),"{$raymenu}",RayMenu)
				sysmenu = Replace(sysmenu,"{$raymenuinfo}",RayMenuInfo(0))
			Else
				sysmenu = Replace(sysmenu,"{$raymenuinfo}","")
			End If
			sysmenu = Replace(sysmenu,"{$userid}",UserID)
			Response.Write RayMenu
		End If
		If Forum_Setting(90)=0 Then 
			sysmenu = Replace(sysmenu,"{$Plus_Tools}","")
		Else
			sysmenu = Replace(sysmenu,"{$Plus_Tools}",mainhtml(16))
		End If
		If GroupSetting(57) = "1" Then
			Name = "StyleList_All"
			Tempstr1=Value
			If Dvbbs.BoardID = 0 Then
				TempStr1 = Replace(TempStr1,"{$dskinid}",CacheData(17,0))
			Else
				TempStr1 = Replace(TempStr1,"{$dskinid}",Sid)
			End If
		Else
			mainhtml(9)=Replace(Replace(Replace(Replace(mainhtml(9),"\","\\"),"'","\'"),VbCrLf,"\n"),chr(13),"")
			mainhtml(9) = Split(mainhtml(9),"||")
			Tempstr1=Replace(Replace(mainhtml(9)(0),"{$dskinid}",CacheData(17,0)),"{$csslist}","")
		End If
		sysmenu = Replace(sysmenu,"{$syles}",Tempstr1)
		TempStr = TempStr & Chr(10) & mainhtml(4)
		TempStr = Replace(TempStr,"{$width}",mainsetting(0))
		TempStr = Replace(TempStr,"{$link}",Forum_Info(1))
		If Boardid>0 Then 
			If Board_Setting(51)="" Or Board_Setting(51) = "0"  Then
				TempStr = Replace(TempStr,"{$logo}",Forum_Info(6))
			Else
				TempStr = Replace(TempStr,"{$logo}",Board_Setting(51))
			End If
		Else
			TempStr = Replace(TempStr,"{$logo}",Forum_Info(6))
		End If
		If Trim(Forum_info(7))<>"0" And 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}",Chr(10) & sysmenu)
		TempStr = Replace(TempStr,"{$boardid}",boardid)
		TempStr = Replace(TempStr,"{$alertcolor}",mainsetting(1))
		Name = "ForumPlusMenu"
		ForumMenu = Value
		If ForumMenu <> "" Then
			TempStr = Replace(TempStr,"{$plusmenu}"," <img src="&mainpic(18)&" align=absmiddle> " & ForumMenu)
		Else
			TempStr = Replace(TempStr,"{$plusmenu}","")
		End If
		Response.Write TempStr
		TempStr = ""
	End Sub 
	Public Sub Head_var(IsBoard,idepth,GetTitle,GetUrl)
		Dim NavStr,AllBoardList
		If Dvbbs.BoardID=0 Then BoardReadme=lanstr(2) & " <b>" & Forum_Info(0) & "</b>"
		If BoardID>0 Then
			NavStr = " <a href="&Forum_Info(11)&" onMouseOver=""showmenu(event,BoardJumpList(0),'',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
			BoardType = Replace(Replace(BoardType,Chr(39),"&#39;"),Chr(34), "&#34;")
			If BoardParentID=0 Then
				NavStr = NavStr & " <a href=""index.asp?boardid="&BoardID&""" onMouseOver=""showmenu(event,BoardJumpList("&Dvbbs.Boardid&"),'',0);"">"&BoardType&"</a>"
			Else
				If ScriptName="dispbbs.asp" Then 
					NavStr = NavStr & BoardInfoData & " → <a href=""index.asp?boardid="&BoardID&"&page="&Request("page")&""">"&BoardType&"</a>"
				Else
					NavStr = NavStr & BoardInfoData & " → <a href=""index.asp?boardid="&BoardID&""">"&BoardType&"</a>"
				End If
			End If
			NavStr = NavStr & " → " & Nowstats
		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)
			Else
				BoardReadme = IsBoard(3)
			End If
			Dim i,UserGroupList,iGroupName
			IsUserPermissionOnly = MyUserInfo(Ubound(MyUserInfo)-2)
			If UserGroupParent = 4 Then
				BoardReadme = BoardReadme & IsBoard(4)
				For i = 0 To Ubound(UserGroupParentID)
					Name = "GroupSetting_" & UserGroupParentID(i)
					iGroupName = Split(value,"§§§")(3)
					If i = 0 Then
						UserGroupList = "<a href=cookies.asp?action=ReGroup&GroupID="&UserGroupParentID(i)&">"&iGroupName&"</a><BR>"
					Else
						UserGroupList = UserGroupList & "<a href=cookies.asp?action=ReGroup&GroupID="&UserGroupParentID(i)&">"&iGroupName&"</a>"
					End If
				Next
				BoardReadme = Replace(BoardReadme,"{$UserGroupList}",UserGroupList)
			ElseIf Cint(IsUserPermissionOnly) > 0 Then
				BoardReadme = BoardReadme & IsBoard(4)
				Name = "GroupSetting_" & IsUserPermissionOnly
				iGroupName = Split(value,"§§§")(3)
				UserGroupList = "<a href=cookies.asp?action=ReGroup&GroupID="&IsUserPermissionOnly&">"&iGroupName&"</a><BR>"
				BoardReadme = Replace(BoardReadme,"{$UserGroupList}",UserGroupList)
			End If
			NavStr = Replace(NavStr,"{$umsg}",BoardReadme)
		Else
			NavStr = Replace(NavStr,"{$umsg}","")
		End If
		NavStr = Replace(NavStr,"{$alertcolor}",mainsetting(1))
		NavStr = Replace(NavStr,"{$showstr}","")
		Response.Write vbNewLine & NavStr
	End Sub
	Public Sub AddErrCode(ErrCode)
		If ErrCodes = "" Then
			ErrCodes = ErrCode
		Else
			ErrCodes = ErrCodes & "," & ErrCode
		End If
	End Sub
	Public Property Let ErrType(ByVal Value)
		ShowErrType = Value
	End Property
	Public Sub Showerr()
		If ErrCodes<>"" Then
			If ShowErrType = 1 Then
				Response.redirect "showerr.asp?BoardID="&Boardid&"&ErrCodes="&ErrCodes&"&action="&server.URLEncode(Stats)&"&ShowErrType=1"
			Else
				Response.redirect "showerr.asp?BoardID="&Boardid&"&ErrCodes="&ErrCodes&"&action="&server.URLEncode(Stats)
			End If
		End If
	End Sub 
	Public Sub Footer()
		Dim Tmp,CaCheInfo
		'CaCheInfo =  "<li>"
		'CaCheInfo = CaCheInfo & "共使用了" & Application.Contents.Count & "个缓存对象。"
		'CaCheInfo=result
		Tmp = mainhtml(18)
		Tmp = Replace(Tmp,"{$boardid}",boardid)
		If (Dvbbs.Forum_ChanSetting(13)="1" And Dvbbs.Forum_ChanSetting(0)="1") Or Dvbbs.Forum_ChanSetting(3)="0" Then
			Tmp = Replace(Tmp,"{$UserTicket}","<BR>" & lanstr(11))
		Else
			Tmp = Replace(Tmp,"{$UserTicket}","")
		End If
		Response.Write Tmp
		Tmp = mainhtml(8)
		If Forum_Setting(30) = "1" Then 
   Dim Endtime
   Endtime = Timer()
   Tmp = Replace(Tmp,"{$runtime}","<br />页面执行时间 0"&FormatNumber((Endtime-Startime),5)&" 秒, "&SqlQueryNum&" 次数据查询<br />"& CaCheInfo)
  End If 
  Tmp = Replace(Tmp,"{$powered}", "Powered By <a href = ""http://www.dvbbs.net/"" target = ""_blank"">Dvbbs</a>  <a href = ""http://www.dvbbs.net/download.asp"" target = ""_blank"">Version " & Forum_Version & "</a>") 
  Tmp = Replace(Tmp,"{$Footer_ads}",Forum_ads(1))
  Tmp = Replace(Tmp,"{$copyright}",Forum_Copyright)
  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
	Public Function Execute(Command)
		If Not IsObject(Conn) Then ConnectionDatabase		
		If IsDeBug = 0 Then 
			On Error Resume Next
			Set Execute = Conn.Execute(Command)
			If Err Then
				err.Clear
				Set Conn = Nothing
				If savelog=1 Then
					Response.Write SaveSQLLOG(Command,"查询数据的时候发现错误，请检查您的查询代码是否正确。<br>基于安全的理由，只显示本信息，要查看详细的错误信息，请修改您的程序文件conn.asp。把""Const IsDeBug = 0""改为：""Const IsDeBug = 1""")
				Else
					Response.Write "查询数据的时候发现错误，请检查您的查询代码是否正确。"
				End If
				Response.End
			End If
		Else
			'Response.Write command & "<br>"
			Set Execute = Conn.Execute(Command)
		End If	
		SqlQueryNum = SqlQueryNum+1
	End Function
	'-----------------------------------------------------------------------------------------------------
	'独立道具查询
	Public Function Plus_Execute(Command)
		If Cint(Forum_Setting(92))=1 Then
			If Not IsObject(Plus_Conn) Then Plus_ConnectionDatabase
		Else
			If Not IsObject(Conn) Then ConnectionDatabase
		End IF
		'检查权限,防止注入攻击。
		If InStr(LCase(Command),"dv_admin")>0 And Left(ScriptName,6)<> "admin_" Then 
			If savelog=1 Then
				Response.Write SaveSQLLOG(Command,"")
			End If
			Command=Replace(LCase(Command),"dv_admin","dv<i>"&Chr(95)&"</i>admin") 
		End If				
		If IsDeBug = 0 Then 
			On Error Resume Next
			If Cint(Forum_Setting(92))=1 Then
				Set Plus_Execute = Plus_Conn.Execute(Command)
			Else
				Set Plus_Execute = Conn.Execute(Command)
			End If
			If Err Then
				err.Clear
				If Cint(Forum_Setting(92))=1 Then
					Set Plus_Conn = Nothing
				Else
					Set Conn = Nothing
				End If
				If savelog=1 Then
					Response.Write SaveSQLLOG(Command,"查询数据的时候发现错误，请检查您的查询代码是否正确。<br>基于安全的理由，只显示本信息，要查看详细的错误信息，请修改您的程序文件conn.asp。把""Const IsDeBug = 0""改为：""Const IsDeBug = 1""")
				Else
					Response.Write "查询数据的时候发现错误，请检查您的查询代码是否正确。"
				End If
				Response.End
			End If
		Else
			'Response.Write command & "<br>"
			If Cint(Forum_Setting(92))=1 Then
				Set Plus_Execute = Plus_Conn.Execute(Command)
			Else
				Set Plus_Execute = Conn.Execute(Command)
			End If
		End If	
		SqlQueryNum = SqlQueryNum+1
	End Function
	'-----------------------------------------------------------------------------------------------------

	'记录查询错误事件
	Public Function SaveSQLLOG(sCommand,message)
		Dim lConnStr,lConn,ldb
		ldb = MyDbPath & "data/DvSQLLOG.mdb"
		'Response.Write ldb
		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 dv_sql_log (ScriptName,S_Info,ip) Values ('"&ScriptName&"','"&Replace(Left(sCommand,255),"'","''")&"','"&UserTrueIP&"')")
		lConn.Close
		Set lConn = Nothing 
		SaveSQLLOG = message
	End Function
	Public Sub ChecKIPlock()
		Dim IPlock
		IPlock = False
		Dim locklist
		locklist=Trim(CacheData(25,0))
		If locklist="" Then Exit Sub
		Dim i,StrUserIP,StrKillIP
		StrUserIP=UserTrueIP
		locklist=Split(locklist,"|")
		If StrUserIP="" Then Exit Sub
		StrUserIP=Split(UserTrueIP,".")
		If Ubound(StrUserIP)<>3 Then Exit Sub
		For i= 0 to UBound(locklist)
			locklist(i)=Trim(locklist(i))
			If locklist(i)<>"" Then 
				StrKillIP = Split(locklist(i),".")
				If Ubound(StrKillIP)<>3 Then Exit For
				IPlock = True
				If (StrUserIP(0) <> StrKillIP(0)) And Instr(StrKillIP(0),"*")=0 Then IPlock=False
				If (StrUserIP(1) <> StrKillIP(1)) And Instr(StrKillIP(1),"*")=0 Then IPlock=False
				If (StrUserIP(2) <> StrKillIP(2)) And Instr(StrKillIP(2),"*")=0 Then IPlock=False
				If (StrUserIP(3) <> StrKillIP(3)) And Instr(StrKillIP(3),"*")=0 Then IPlock=False
				If IPlock Then Exit For
			End If
		Next
		Response.Cookies(Forum_sn & "Kill").Expires = DateAdd("s", 360, Now())
		Response.Cookies(Forum_sn & "Kill").Path = Cookiepath
		If IPlock Then
			Response.Cookies(Forum_sn & "Kill")("kill") = "1"
		Else
			Response.Cookies(Forum_sn & "Kill")("kill") = "0"
		End If
	End Sub
	'IP/来源
	Public Function address(sip)
		Dim aConnStr,aConn,adb
		Dim str1,str2,str3,str4
		Dim  num
		Dim country,city
		Dim irs,SQL
		address="未知"
		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
				country="亚洲"
				city=""
				sql="select top 1 country,city from dv_address where ip1 <="&num&" and ip2 >="&num&""
				Set irs=aConn.execute(sql)
				If Not(irs.EOF And irs.bof) Then
					country=irs(0)
					city=irs(1)
				End If
				Set irs=Nothing
				Set aConn = Nothing 
				SqlQueryNum = SqlQueryNum+1
			End If
			address=country&city
		End If
	End Function
	'显示验证码
	Public Function GetCode()
			GetCode= Dvbbs.mainhtml(15)&"<img src=""DV_getcode.asp"">"
	End Function
	'检查验证码是否正确
	Public Function CodeIsTrue()
		Dim CodeStr
		CodeStr=Trim(Request("CodeStr"))
		If CStr(Session("GetCode"))=CStr(CodeStr) And CodeStr<>""  Then
			CodeIsTrue=True
			Session("GetCode")=empty
		Else
			CodeIsTrue=False
			Session("GetCode")=empty
		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 CheckNumeric(Byval CHECK_ID)
		If CHECK_ID<>"" and IsNumeric(CHECK_ID) Then _
			CHECK_ID = cCur(CHECK_ID) _
		Else _
			CHECK_ID = 0
		CheckNumeric = CHECK_ID
	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 InStr(Str,BadWords(i))>0 Then
				If i > UBound(rBadWord) Then
					Str = Replace(Str,BadWords(i),"*")
				Else
					Str = Replace(Str,BadWords(i),rBadWord(i))
				End If
			End If
		Next
		ChkBadWords = Str
	End Function
	Public Function Checkstr(Str)
		If Isnull(Str) Then
			CheckStr = ""
			Exit Function 
		End If
		Str = Replace(Str,Chr(0),"")
		CheckStr = Replace(Str,"'","''")
	End Function

	Public Sub ReloadBoardInfo(lboardid)
		NodeUpdate=True
		'Response.Write "ReloadBoardInfo="&lboardid &"<br>"
		Dim Rs,Node,i,BoardPath,BoardMasterList,BoardMaster,CNode
		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,cid,Rules From Dv_Board where boardid in ("& lboardid &") Order By RootID,orders")
		Dim Board_setting,lastpost
		Do while Not Rs.EOF
			Board_setting=Split(Rs("Board_setting")&"",",")
			BoardPath = "board"
			For i=1 To Rs("Depth")
				BoardPath = "board/"&BoardPath 
			Next
			Set Node=BoardXML.documentElement.selectSingleNode(BoardPath&"[@boardid='"&Rs(0)&"']")
			For i = 0 To Rs.Fields.Count-1
				Node.attributes.getNamedItem(LCase(Rs(i).name)).text = Rs(i)&""
			Next
			lastpost=Split(Rs("lastpost")&"","$")
			For i=0 to UBound(LastPost)
				Node.attributes.getNamedItem("lastpost"&i).text=LastPost(i)
			Next
			For Each cnode In Node.selectNodes("boardmasterlist")
				node.removeChild(Cnode)
			Next
			BoardMasterList=Split(Rs("BoardMaster")&"","|")
			i=0
			For Each BoardMaster in BoardMasterlist
				Set CNode=Node.appendChild(BoardXML.createNode(1,"boardmasterlist",""))
				CNode.attributes.setNamedItem(BoardXML.createNode(2,"master","")).text=BoardMaster
				CNode.attributes.setNamedItem(BoardXML.createNode(2,"urlencode","")).text=Server.urlencode(BoardMaster)
				CNode.attributes.setNamedItem(BoardXML.createNode(2,"order","")).text=i
				i=i+1
			Next
			Rs.MoveNext
		Loop
		Rs.Close 
		Set Rs = Nothing
	End Sub
	'更新分版面部分缓存数组，入口：版面ID列表,豆号分隔、更新内容、节点名称
	Public Sub ReloadBoardCache(lBoardID,MyValue,TagName)
   		NodeUpdate=True
		'Response.Write "ReloadBoardCache="& lBoardID &" MyValue="&MyValue&" TagName="&TagName&"<br>"
   		lBoardID=Split(lBoardID,",")
   		Dim Nodelist,Node,i,lastpost,j,cnode,BoardMasterList,BoardMaster
		Set Nodelist=BoardXML.documentElement.getElementsByTagName("board")
		For i=0 to UBound(lBoardID)
			For Each Node in nodelist
				If Cstr(lBoardID(i))=Node.attributes.getNamedItem("boardid").text Then
					Node.attributes.getNamedItem(TagName).text=MyValue
					If TagName="lastpost" Then
						lastpost=Split(MyValue,"$")
						For j=0 to UBound(LastPost)
							Node.attributes.getNamedItem("lastpost"&j).text=LastPost(i)
						Next
					End If
					If TagName="boardmaster" Then
						For Each cnode In Node.selectNodes("boardmasterlist")
							node.removeChild(Cnode)
						Next
						BoardMasterList=Split(MyValue,"|")
						j=0
						For Each BoardMaster in BoardMasterlist
							Set CNode=Node.appendChild(BoardXML.createNode(1,"boardmasterlist",""))
							CNode.attributes.setNamedItem(BoardXML.createNode(2,"master","")).text=BoardMaster
							CNode.attributes.setNamedItem(BoardXML.createNode(2,"urlencode","")).text=Server.urlencode(BoardMaster)
							CNode.attributes.setNamedItem(BoardXML.createNode(2,"order","")).text=j
							j=j+1
						Next
					End If
					Exit For
				End If
			Next
		Next 
	End Sub

	'取得带端口的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 GetBrowser()
		Dim Agent,Tmpstr,i
		IsSearch = False
		If Not IsEmpty(Session(Dvbbs.CacheName & "Cls_Browser")) Then
			Tmpstr = Split(Session(Dvbbs.CacheName & "Cls_Browser"),"|||")
			Browser = Dvbbs.checkStr(Tmpstr(0))
			version = Dvbbs.checkStr(Tmpstr(1))
			platform = Dvbbs.checkStr(Tmpstr(2))
			If Tmpstr(3)="1" Then 
				IsSearch = True
			End If
			Exit Sub
		End If
		Browser="unknown"
		version="unknown"
		platform="unknown"
		Agent=Request.ServerVariables("HTTP_USER_AGENT")
		'Agent="Opera/7.23 (X11; Linux i686; U)  [en]"	
		If Left(Agent,7) ="Mozilla" Then '有此标识为浏览器
			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 "
				tmpstr=Split(Agent(4),"/")
				version=tmpstr(UBound(tmpstr))
			ElseIf InStr(Agent(4),"rv:")>0 Then
				Browser="Mozilla "
				tmpstr=Split(Agent(4),":")
				version=tmpstr(UBound(tmpstr))
				If InStr(version,")") > 0 Then 
					tmpstr=Split(version,")")
					version=tmpstr(0)
				End If
			End If
			If UBound(Agent)>2 Then
				platform = UserPlatForm(Agent(2),Agent(3),UBound(Agent))
			Else
				platform = UserPlatForm(Agent(2),"",UBound(Agent))
			End If
		ElseIf Left(Agent,5) ="Opera" Then 
			Agent=Split(Agent,"/")
			Browser="Mozilla "
			tmpstr=Split(Agent(1)," ")
			version=tmpstr(0)
			If UBound(Agent)>2 Then
				platform = UserPlatForm(Agent(1),Agent(3),UBound(Agent))
			Else
				platform = UserPlatForm(Agent(1),"",UBound(Agent))
			End If
		Else
			'识别搜索引擎
			Dim botlist
			Botlist="Google,Isaac,SurveyBot,Baiduspider,ia_archiver,P.Arthur,FAST-WebCrawler,Java,Microsoft-ATL-Native,TurnitinBot,WebGather,Sleipnir"
			Botlist=split(Botlist,",")
			For i=0 to UBound(Botlist)
				If InStr(Agent,Botlist(i))>0  Then 
					platform=Botlist(i)&"搜索器"
					IsSearch=True
					Exit For
				End If
			Next 
		End If
		If version<>"unknown" Then 
			Dim Tmpstr1
			Tmpstr1=Trim(Replace(version,".",""))
			If Not IsNumeric(Tmpstr1) Then
				version="unknown"
			End If
		End If
		If IsSearch Then
			Browser=""
			version=""
			Session(Dvbbs.CacheName & "Cls_Browser") = Browser &"|||"& version &"|||"& platform&"|||1"
		Else
			Session(Dvbbs.CacheName & "Cls_Browser") = Browser &"|||"& version &"|||"& platform&"|||0"
		End If
	End Sub
	Private Function UserPlatForm(UserAgent1,UserAgent2,UserAgentNum)
		If InStr(UserAgent1,"NT 5.2")>0 Then
			UserPlatForm="Windows 2003"
		ElseIf InStr(UserAgent1,"Windows CE")>0 Then
			UserPlatForm="Windows CE"
		ElseIf InStr(UserAgent1,"NT 5.1")>0 Then
			UserPlatForm="Windows XP"
		ElseIf InStr(UserAgent1,"NT 4.0")>0 Then
			UserPlatForm="Windows NT"
		ElseIf InStr(UserAgent1,"NT 5.0")>0 Then
			UserPlatForm="Windows 2000"
		ElseIf InStr(UserAgent1,"NT")>0 Then
			UserPlatForm="Windows NT"
		ElseIf InStr(UserAgent1,"9x")>0 Then
			UserPlatForm="Windows ME"
		ElseIf InStr(UserAgent1,"98")>0 Then
			UserPlatForm="Windows 98"
		ElseIf InStr(UserAgent1,"95")>0 Then
			UserPlatForm="Windows 95"
		ElseIf InStr(UserAgent1,"Win32")>0 Then
			UserPlatForm="Win32"
		ElseIf InStr(UserAgent1,"Linux")>0 Then
			UserPlatForm="Linux"
		ElseIf InStr(UserAgent1,"SunOS")>0 Then
			UserPlatForm="SunOS"
		ElseIf InStr(UserAgent1,"Mac")>0 Then
			UserPlatForm="Mac"
		ElseIf UserAgentNum>2 Then
			If InStr(UserAgent2,"NT 5.1")>0 Then UserPlatForm="Windows XP"
			If InStr(UserAgent2,"Linux")>0 Then UserPlatForm="Linux"
		End If
	End Function

	'---------------------------------------------------
	'记录道具操作日志信息(发生数量，记录事件类型，备注内容，用户最后剩余金币和点券（金币|点券）)
	'Log_ID,ToolsID,CountNum,Log_Money,Log_Ticket,AddUserName,AddUserID,Log_IP,Log_Time,Log_Type,BoardID,Conect,HMoney
	'Log_Type类型(0=其它,1=使用,2=转让,3=充值,4=购买,5=奖励,6=vip交易)
	'HMoney最后剩余金币和点券（金币|点券）
	'boardid 记录版面参数，后台为-1
	'---------------------------------------------------
	Public Sub ToolsLog(Log_ToolsID,CountNum,Log_Money,Log_Ticket,Log_Type,Conect,HMoney)
		Dim Sql
		Conect = CheckStr(Conect)
		HMoney = CheckStr(HMoney)
		Sql = "Insert into [Dv_MoneyLog] (ToolsID,CountNum,Log_Money,Log_Ticket,AddUserName,AddUserID,Log_IP,Log_Type,BoardID,Conect,HMoney) values (" &_
			CheckNumeric(Log_ToolsID) &","&_
			CheckNumeric(CountNum) &","&_
			CheckNumeric(Log_Money) &","&_
			CheckNumeric(Log_Ticket) &",'"&_
			MemberName &"',"&_
			UserID &",'"&_
			UserTrueIP &"',"&_
			Log_Type &","&_
			BoardID &",'"&_
			Conect &"','"&_
			HMoney &"'"&_
			")"
		'Response.Write Sql
		Dvbbs.Execute(Sql)
	End Sub
End Class
Class cls_Templates
	Public html,Strings,pic
	Public Property Let Value(ByVal vNewValue)
		Dim TemplateStr,tmpstr:TemplateStr = vNewValue
		TemplateStr = Replace(TemplateStr,"{$PicUrl}",Dvbbs.Forum_PicUrl)
		tmpstr = Split(TemplateStr,"@@@")
		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
		Dvbbs.Name="Forum_Online"
		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")
		If Not IsNull(Rs(0)) Then
			Dvbbs.Value=Rs(0)
		Else
			Dvbbs.Value=0
		End If
		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
		If IsNull(l_GuestOnline) Then l_GuestOnline=0
		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
%>