<!-- #include file=MD5.asp -->
<%
If inStr(Lcase(Request.Servervariables("SCRIPT_NAME")),"board_popfun.asp") > 0 Then Response.End
Dim DEF_PubMessageEnable
DEF_PubMessageEnable = 0
dim DEF_PageExeTime1,GBL_DBNum,con,GBL_ConFlag,GBL_CheckPassDoneFlag,GBL_FileDir
DEF_PageExeTime1 = Timer
GBL_DBNum = 0
GBL_ConFlag = 0
GBL_CheckPassDoneFlag = 0

Dim GBL_board_ID
If Request.QueryString("dontRequestFormFlag") = "" Then
	GBL_board_ID = Request.QueryString("BoardID")
	If GBL_board_ID = "" Then GBL_board_ID = Request.Form("BoardID")
Else
	GBL_board_ID = Request.QueryString("BoardID")
End If
GBL_board_ID = Left(GBL_board_ID,14)
If isNumeric(GBL_board_ID)=0 Then GBL_board_ID=0
GBL_board_ID = Fix(cCur(GBL_board_ID))

Dim GBL_Board_BoardName,GBL_Board_BoardAssort
Dim GBL_Board_TopicNum,GBL_Board_AnnounceNum,GBL_Board_AssortName,GBL_Board_BoardLimit,GBL_Board_GoodNum
Dim GBL_Board_ForumPass,GBL_Board_HiddenFlag,GBL_Board_MasterList,GBL_Board_AllMaxRootID,GBL_Board_AllMinRootID
Dim GBL_Board_BoardStyle,GBL_Board_StartTime,GBL_Board_EndTime,GBL_Board_AssortMaster,GBL_Board_OtherLimit
GBL_Board_BoardStyle = DEF_DefaultStyle
GBL_Board_StartTime = "000000"
GBL_Board_EndTime = "000000"

Dim GBL_UserID

Dim GBL_SiteHeadString,GBL_SiteBottomString,GBL_DefineImage,GBL_TableHeadString,GBL_TableBottomString,GBL_ShowBottomSure,GBL_TempletID,GBL_TempletFlag

Dim GBL_CookieTime,GBL_IPAddress
GBL_CookieTime = Request.Cookies(DEF_MasterCookies & "Time")

Dim GBL_UDT
GBL_UDT = Session(DEF_MasterCookies & "UDT")
GetIPAddress

If isNumeric(application(DEF_MasterCookies & "SitePageCount")) = False Then
	Application.Lock
	Application(DEF_MasterCookies & "SitePageCount") = 0
	Application.UnLock
End If
Application.Lock
Application(DEF_MasterCookies & "SitePageCount") = Application(DEF_MasterCookies & "SitePageCount") + 1
Application.UnLock

Sub ReloadBoardInfo(ID)

	If GBL_ConFlag = 0 Then Exit Sub
	Dim Rs,GetData
	Set Rs = Server.CreateObject("ADODB.RecordSet")
	Rs.Open "Select top 1 T1.BoardName,T1.BoardAssort,T1.BoardIntro,T1.LastWriter,T1.LastWriteTime,T1.TopicNum,T1.AnnounceNum,T1.ForumPass,T1.HiddenFlag,T1.BoardLimit,T1.MasterList,T1.AllMaxRootID,T1.AllMinRootID,T1.GoodNum,T2.AssortName,T1.BoardStyle,T1.StartTime,T1.EndTime,T1.TodayAnnounce,T1.LastAnnounceID,T1.LastTopicName,T1.BoardImgUrl,T1.BoardImgWidth,T1.BoardImgHeight,T1.BoardHead,T1.BoardBottom,T1.ParentBoard,T1.LowerBoard,T1.ParentBoardStr,T1.TopicNum_All,T1.AnnounceNum_All,T1.TodayAnnounce_All,T1.GoodNum_All,0,0,T2.AssortMaster,T1.OtherLimit from LeadBBS_Boards as T1 inner join LeadBBS_Assort as T2 on t1.BoardAssort=T2.AssortID where T1.BoardID=" & ID,con,1,1
	GBL_DBNum = GBL_DBNum + 1
	If Rs.Eof Then
		Rs.Close
		Set Rs = Nothing
		GBL_board_ID = 0
		GBL_Board_BoardLimit = 0
		Exit Sub
	Else
		GetData = Rs.GetRows(1)
		Application.Lock			
		Application(DEF_MasterCookies & "BoardInfo" & ID) = GetData
		Application.UnLock
		Rs.Close
		Set Rs = Nothing
	End If

End Sub

Sub Borad_GetBoardIDValue(ID)

	Dim Temp
	Temp = Application(DEF_MasterCookies & "BoardInfo" & ID)
	If isArray(Temp) = False Then
		ReloadBoardInfo(ID)
		Temp = Application(DEF_MasterCookies & "BoardInfo" & ID)
		If isArray(Temp) = False Then GBL_board_ID = 0
	End If
	If GBL_board_ID = 0 Then Exit Sub

	GBL_Board_BoardName = Temp(0,0)
	GBL_Board_BoardAssort = cCur(Temp(1,0))
	'GBL_Board_BoardIntro = Temp(2,0)
	'GBL_Board_LastWriter = Temp(3,0)
	'GBL_Board_LastWriteTime = Temp(4,0)
	GBL_Board_TopicNum = cCur(Temp(5,0))
	GBL_Board_AnnounceNum = cCur(Temp(6,0))
	GBL_Board_AssortName =Temp(14,0)
	GBL_Board_ForumPass = Temp(7,0)
	GBL_Board_HiddenFlag = Temp(8,0)
	GBL_Board_BoardLimit = cCur(Temp(9,0))
	GBL_Board_MasterList = Temp(10,0)
	GBL_Board_AllMaxRootID = cCur(Temp(11,0))
	GBL_Board_AllMinRootID = cCur(Temp(12,0))
	GBL_Board_GoodNum = cCur(Temp(13,0))
	If Temp(15,0) <> 0 Then GBL_Board_BoardStyle = Temp(15,0)
	GBL_Board_StartTime = Right("000000" & Temp(16,0),6)
	GBL_Board_EndTime = Right("000000" & Temp(17,0),6)
	'GBL_Board_TodayAnnounce = Temp(18,0)
	'LastAnnounceID = 19,0
	',T1.LastTopicName= 20,0
	'21,22,23
	GBL_SiteHeadString = Temp(24,0)
	GBL_SiteBottomString = Temp(25,0)
	'26,27,T1.ParentBoard,T1.LowerBoard
	'28,T1.ParentBoardStr,29.TopicNum_All,30.AnnounceNum_All,31.TodayAnnounce_All,32.GoodNum_All
	GBL_Board_AssortMaster = Temp(35,0)
	GBL_Board_OtherLimit = cCur(Temp(36,0))

	If GBL_CHK_PWdFlag = 0 and (GBL_Board_BoardLimit <> 0 or GBL_Board_ForumPass <> "" or GBL_Board_OtherLimit > 0) Then
		If GBL_Board_ForumPass <> "" or GBL_Board_OtherLimit > 0 or GetBinarybit(GBL_Board_BoardLimit,2) = 1 or GetBinarybit(GBL_Board_BoardLimit,7) = 1 Then
			GBL_CHK_PWdFlag = 1
		ElseIf GBL_CHK_GuestFlag = 1 and GetBinarybit(GBL_Board_BoardLimit,1) = 1 Then
			GBL_CHK_PWdFlag = 1
		End If
	End If

End Sub

Sub BBS_SiteHead(headString,BoardID,Str)

	SiteHead(headString)
	DisplayBBSNavigate BoardID,Str

End Sub

Sub UpdateOnlineUserAtInfo(BoardID,AtInfo)

	If BoardID <> 0 and isArray(Application(DEF_MasterCookies & "BoardInfo" & BoardID)) = False Then
		Exit Sub
	End If
	Dim AtBoardIDCookie
	AtBoardIDCookie = Left(Request.Cookies(DEF_MasterCookies & "AtBD"),14)
	If isNumeric(AtBoardIDCookie) = False or AtBoardIDCookie = "" Then
		Response.Cookies(DEF_MasterCookies & "AtBD") = BoardID
	Else
		AtBoardIDCookie = cCur(AtBoardIDCookie)
		If isTrueDate(GBL_CookieTime) = 1 Then
			If DateDiff("s",GBL_CookieTime,DEF_Now) < 120 and AtBoardIDCookie = BoardID Then Exit Sub
			If AtBoardIDCookie <> BoardID Then Response.Cookies(DEF_MasterCookies & "AtBD") = BoardID
		Else
			Response.Cookies(DEF_MasterCookies & "Time") = DEF_Now
		End If
	End If

	Dim Rs,SQL
	SQL = "Select top 1 AtBoardID from LeadBBS_OnlineUser where sessionID=" & cCur(session.sessionID)
	Set Rs = Con.ExeCute(SQL)
	GBL_DBNum = GBL_DBNum + 1
	If Not Rs.Eof Then
		SQL = cCur(Rs(0))
		If SQL <> BoardID Then
			Rs.Close
			Set Rs = Nothing
			Application.Lock
			If BoardID <> 0 Then Application(DEF_MasterCookies & "BDOL" & BoardID) = Application(DEF_MasterCookies & "BDOL" & BoardID) + 1
			If SQL <> 0 Then Application(DEF_MasterCookies & "BDOL" & SQL) = Application(DEF_MasterCookies & "BDOL" & SQL) - 1
			Application.UnLock
			Con.ExeCute("Update LeadBBS_OnlineUser Set AtBoardID=" & BoardID & ",AtInfo='" & Replace(Left(KillHTMLLabel(AtInfo),255),"'","''") & "',AtUrl='" & Replace(Left(Request.Servervariables("SCRIPT_NAME") & "?" & Request.QueryString,255),"'","''") & "' where sessionID=" & cCur(session.sessionID))
			GBL_DBNum = GBL_DBNum + 1
		Else
			Rs.Close
			Set Rs = Nothing
			Con.ExeCute("Update LeadBBS_OnlineUser Set AtInfo='" & Replace(Left(KillHTMLLabel(AtInfo),255),"'","''") & "',AtUrl='" & Replace(Left(Request.Servervariables("SCRIPT_NAME") & "?" & Request.QueryString,255),"'","''") & "' where sessionID=" & cCur(session.sessionID))
			GBL_DBNum = GBL_DBNum + 1
		End If
	Else
		Rs.Close
		Set Rs = Nothing
	End If

End Sub

Sub UpdateOnlineUserInfo(Str)

	Dim Rs,SQL,GetData,N,delN
	SQL = "Select AtBoardID " & Str
	Set Rs = Con.ExeCute(SQL)
	If Rs.Eof Then
		Rs.Close
		Set Rs = Nothing
		Exit Sub
	End If
	GetData = Rs.GetRows(-1)
	Rs.Close
	Set Rs = Nothing
	GBL_DBNum = GBL_DBNum + 1
	
	SQL = 0
	Rs = Ubound(GetData,2)
	For N = 0 to Rs
		SQL = cCur(GetData(0,N))
		If SQL > 0 Then 
			Application.Lock
			Application(DEF_MasterCookies & "BDOL" & SQL) = Application(DEF_MasterCookies & "BDOL" & SQL) - delN
			Application.UnLock
		End If
	Next
	Application.Lock
	Application(DEF_MasterCookies & "ActiveUsers") = Application(DEF_MasterCookies & "ActiveUsers") - (Rs + 1)
	Application.UnLock
	
	Con.ExeCute("Delete " & Str)
	GBL_DBNum = GBL_DBNum + 1

End Sub

Sub DisplayBBSNavigate(BoardID,Str)

	%><table width="<%=DEF_BBS_ScreenWidth%>" border="0" cellspacing="0" cellpadding="0" align="center">
	<tr>
		<td colspan=2>
			<img src=<%=DEF_BBS_HomeUrl%>images/null.gif height=5 width=2></td>
	</tr>
	<tr>
		<td><font class=NavColor>
			<a href="<%
			If DEF_SiteHomeUrl = "" Then DEF_SiteHomeUrl = DEF_BBS_HomeUrl & "Boards.asp"
			If GBL_Board_BoardAssort = "" and Str = "" Then
				Response.Write DEF_SiteHomeUrl & """><font class=NavColor>" & "首页</font></a> &gt;&gt; " & DEF_BBS_Name
			Else
				Response.Write DEF_SiteHomeUrl & """><font class=NavColor>" & "首页</font></a> &gt;&gt; <a href=""" & DEF_BBS_HomeUrl & "Boards.asp""><font class=NavColor>" & DEF_BBS_Name & "</font></a>"
				If GBL_Board_BoardName="" Then 
					If GBL_Board_AssortName<>"" Then Response.Write " &gt;&gt; " & GBL_Board_AssortName
				Else
					If GBL_Board_AssortName<>"" Then Response.Write " &gt;&gt; <a href=""" & DEF_BBS_HomeUrl & "Boards.asp?Assort=" & GBL_Board_BoardAssort & """><font class=NavColor>" & GBL_Board_AssortName & "</font></a>"
					If BoardID > 0 Then
						Dim Temp,TempStr,N
						Temp = cCur(Application(DEF_MasterCookies & "BoardInfo" & GBL_board_ID)(26,0))
						Do While Temp > 0
							If isArray(Application(DEF_MasterCookies & "BoardInfo" & Temp)) = False Then
								ReloadBoardInfo(Temp)
								If isArray(Application(DEF_MasterCookies & "BoardInfo" & Temp)) = False Then Exit Do
							End If
							TempStr = " &gt;&gt; <a href=" & DEF_BBS_HomeUrl & "Board/Board.asp?BoardID=" & Temp & "><font class=NavColor>" & Application(DEF_MasterCookies & "BoardInfo" & Temp)(0,0) & "</font></a>" & TempStr
							Temp = cCur(Application(DEF_MasterCookies & "BoardInfo" & Temp)(26,0))
							N = N + 1
							If N > 10 Then Exit Do
						Loop
						Response.Write TempStr
						Response.Write " &gt;&gt; <a href=""" & DEF_BBS_HomeUrl & "Board/Board.asp?BoardID=" & GBL_Board_ID & """><font class=NavColor>" & GBL_Board_BoardName & "</font></a>"
					End If
				End If
			End If
			Response.write Str%></font>
		</td>
		<td align=right>
			<%DisplayInfoBoxNavigate%></td>
	</tr>
	<tr>
		<td colspan=2>
			<img src=<%=DEF_BBS_HomeUrl%>images/null.gif height=5 width=2></td>
	</tr>
	</table>
	<%

End Sub

Sub DisplayInfoBoxNavigate

	If DEF_PubMessageEnable = 1 Then
		If isArray(application(DEF_MasterCookies & "PubMsg")) = True Then
			Dim Temp,N
			Temp = application(DEF_MasterCookies & "PubMsg")
			If Ubound(Temp,2) = 0 or GBL_Board_ID > 0 Then
				Response.Write "<img src=" & DEF_BBS_HomeUrl & "images/" & GBL_DefineImage & "pms.gif width=18 height=14 align=absmiddle border=0><a href=" & DEF_BBS_HomeUrl & "User/LookMessage.asp><span class=NavColor>" & Temp(0,0) & "</span></a>"
			Else
				Response.Write "<MARQUEE width=300 scrollamount=3 onMouseOver=this.stop(); onMouseOut=this.start();>"
				Response.Write "<a href=" & DEF_BBS_HomeUrl & "User/LookMessage.asp#0><span class=NavColor name=pubm id=pubm>" & Temp(0,n) & "</a>(" & Left(RestoreTime(Temp(1,n)),10) & ")"
				For N = 1 to Ubound(Temp,2)
					Response.Write " &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; <a href=" & DEF_BBS_HomeUrl & "User/LookMessage.asp#" & N & "><span class=NavColor name=pubm id=pubm>" & Temp(0,n) & "</a>(" & Left(RestoreTime(Temp(1,n)),10) & ")"
				Next
			End If
		Else
			If application(DEF_MasterCookies & "PubMsg") <> VbCrLf & VbCrLf Then ReloadPubMessageInfo
		End If
	End if
	If GBL_CHK_MessageFlag = 0 or GBL_CHK_MessageFlag = False Then
		If GBL_Board_ID < 1 Then Response.Write "</td><td align=right><a href=" & DEF_BBS_HomeUrl & "User/MyInfobox.asp><img src=" & DEF_BBS_HomeUrl & "images/" & GBL_DefineImage & "inbox.GIF border=0 align=absmiddle width=18 height=14><span class=NavColor>收件箱</span></a>"
	Else
		%>
					</td><td align=right><bgsound src=<%=DEF_BBS_HomeUrl%>images/notify.wav border=0 loop="1">
					<a href=<%=DEF_BBS_HomeUrl%>User/MyInfobox.asp><img src=<%=DEF_BBS_HomeUrl & "images/" & GBL_DefineImage%>inbox.GIF border=0 align=absmiddle width=18 height=14><span class=NavColor>您有<span name=winkfont1 id=winkfont1 class=RedFont>新的</span>消息</span></a>
					<script language="JavaScript">
					<!--
					function dwft1()
					{
						if(winkfont1.className=="RedFont"){winkfont1.className = "";setTimeout("dwft1()",500);}
						else{winkfont1.className = "RedFont";setTimeout("dwft1()",500);}
					}
					dwft1();
					// -->
					</script>
		<%
	End if

End Sub

Sub CloseDatabase

	If GBL_ConFlag = 0 Then Exit Sub
	If DEF_EnableDatabaseCache = 1 Then
		Set con = Nothing
	Else
		Con.close
		Set con = Nothing
	End If
	GBL_ConFlag = 0

End Sub

Sub OpenDatabase

	If DEF_EnableDatabaseCache = 1 Then
		If isObject(Application(DEF_MasterCookies & "con")) = False Then
			set con = Server.CreateObject("ADODB.Connection")
			'Con.ConnectionString = "driver={Microsoft Access Driver (*.mdb)};dbq=" & Server.MapPath(DEF_BBS_HomeUrl & DEF_AccessDatabase)
			Con.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & Server.MapPath(DEF_BBS_HomeUrl & DEF_AccessDatabase)
			con.open
			if Err Then
				err.Clear
				Set Con = Nothing
				GBL_CHK_TempStr = GBL_CHK_TempStr & "数据库连接错误!"
				Response.Write GBL_CHK_TempStr
				Response.End
			End If
			Application.Lock
			Set Application(DEF_MasterCookies & "con") = Con
			Application.UnLock
		Else
			Set con = Application(DEF_MasterCookies & "con")
		End If
	Else
		set con = Server.CreateObject("ADODB.Connection")
		'Con.ConnectionString = "driver={Microsoft Access Driver (*.mdb)};dbq=" & Server.MapPath(DEF_BBS_HomeUrl & DEF_AccessDatabase)
		Con.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & Server.MapPath(DEF_BBS_HomeUrl & DEF_AccessDatabase)
		con.open
		if Err Then
			Err.Clear
			Set Con = Nothing
			GBL_CHK_TempStr = GBL_CHK_TempStr & "数据库连接错误!"
			Response.Write GBL_CHK_TempStr
			Response.End
		End If
	End If
	GBL_ConFlag = 1
	If Application(DEF_MasterCookies & "SitePageCount") > 999 Then
		Application.Lock
		application(DEF_MasterCookies & "SitePageCount") = 0
		Application.UnLock
		Con.ExeCute("Update LeadBBS_SiteInfo Set PageCount=PageCount+1000")
		UpdateStatisticDataInfo 1000,4,1
		GBL_DBNum = GBL_DBNum + 1
	End If
	If IsArray(application(DEF_MasterCookies & "BListAll")) = False Then ReloadBoardListData

End Sub

Sub initDatabase

	OpenDatabase
	CheckUserOnline

End Sub

Sub ReloadBoardListData

	Dim Rs,GetData
	Set Rs = Con.ExeCute("Select BoardID,BoardAssort from LeadBBS_Boards where ParentBoard=0 and HiddenFlag = 0 order by BoardAssort,OrderID ASC")
	GBL_DBNum = GBL_DBNum + 1
	If Not Rs.Eof Then
		GetData = Rs.GetRows(-1)
		Application.Lock
		application(DEF_MasterCookies & "BList") = GetData
		Application.UnLock
	End If
	Rs.Close
	Set Rs = Nothing
	Set Rs = Con.ExeCute("Select BoardID,BoardAssort from LeadBBS_Boards")
	GBL_DBNum = GBL_DBNum + 1
	If Not Rs.Eof Then
		GetData = Rs.GetRows(-1)
		Application.Lock
		application(DEF_MasterCookies & "BListAll") = GetData
		Application.UnLock
	End If
	Rs.Close
	Set Rs = Nothing

End Sub

Sub GetIPAddress

	GBL_IPAddress = Left(Replace(Request.ServerVariables("HTTP_X_FORWARDED_FOR"),"'",""),15)
	If GBL_IPAddress = "" Then GBL_IPAddress = Left(Replace(Request.ServerVariables("REMOTE_ADDR"),"'",""),15)

End Sub

Sub RepairOnlineUser

	Dim GetData	
	GetData = application(DEF_MasterCookies & "BListAll")
	If isArray(GetData) = False Then
		ReloadBoardListData
		GetData = application(DEF_MasterCookies & "BListAll")
	End If
	If isArray(GetData) = False Then Exit Sub

	Dim N,m,i,Rs
	m = Ubound(GetData,2)
	SetActiveUserCount
	For N = 0 to m
		Set Rs = Con.ExeCute("Select count(*) from LeadBBS_OnlineUser Where AtBoardID=" & GetData(0,n))
		GBL_DBNum = GBL_DBNum + 1
		If Rs.Eof Then
			i = 0
		Else
			i = Rs(0)
			If isNull(i) Then i = 0
			i = cCur(i)
		End If
		Rs.Close
		Set Rs = Nothing
		Application.Lock
		Application(DEF_MasterCookies & "BDOL" & GetData(0,n)) = i
		Application.UnLock
	Next

End Sub

sub CheckUserOnline

	Dim Rs,Count,SQL,TmpSessionID,DayFlag

	Dim I
	If isNumeric(Replace(GBL_IPAddress,".","")) = 0 or (Replace(GBL_IPAddress,".","",1,3,0) = Replace(GBL_IPAddress,".","",1,2,0)) Then
		'Response.Write "论坛禁止非法IP地址者访问"
		'CloseDatabase
		'Response.End
		GBL_IPAddress = "1.1.1.1"
	End If
	Dim NIP,NewIP,tmp
	If DEF_EnableForbidIP = 1 Then
		NIP = GBL_IPAddress
		I = inStr(NIP,".")
		NewIP = Left(NIP,I-1)
		
		NIP = Mid(NIP,I+1)
		I = inStr(NIP,".")
		tmp = Left(NIP,I-1)
		NewIP = NewIP & Right("00" & tmp,3)
		
		NIP = Mid(NIP,I+1)
		I = inStr(NIP,".")
		tmp = Left(NIP,I-1)
		NewIP = NewIP & Right("00" & tmp,3)
		NIP = Mid(NIP,I+1)
		NewIP = NewIP & Right("00" & NIP,3)
		SQL = "Select top 1 id from LeadBBS_ForbidIP Where IPStart<=" & NewIP & " and IPEnd>=" & NewIP
		Set Rs = Con.ExeCute(SQL)
		GBL_DBNum = GBL_DBNum + 1
		If Not Rs.Eof Then
			Rs.Close
			Set Rs = Nothing
			CloseDatabase
			Response.Write "Forbid IP."
			Response.End
		End If
		Rs.Close
		Set Rs = Nothing
	End If
	If GBL_board_ID > 0 Then Borad_GetBoardIDValue(GBL_board_ID)

	If cCur(session.sessionID) < 1 or isNull(session.sessionID) or session.sessionID = "" or isNumeric(session.sessionID) = 0 Then
		Response.Write "浏览器不支持Cookie"
		CloseDatabase
		Response.End
	End If

	If GBL_CHK_PWdFlag = 1 Then GBL_UserID = CheckPass
	If isTrueDate(GBL_CookieTime) = 0 Then
		Response.Cookies(DEF_MasterCookies & "Time") = DEF_Now
		'Exit sub '此处开启的话，则可以屏蔽在线时间一分钟以下的用户成为在线用户
	Else
		LastDoingTime = DateDiff("s",GBL_CookieTime, DEF_Now)
		If LastDoingTime<0 or LastDoingTime > DEF_UserOnlineTimeOut Then
			LastDoingTime = 0
			Response.Cookies(DEF_MasterCookies & "Time") = DEF_Now
			Exit sub
		End If
		If LastDoingTime < 120 Then '120秒
			Exit sub
		Else
			Response.Cookies(DEF_MasterCookies & "Time") = DEF_Now
		End If
	End If

	DayFlag = application(DEF_MasterCookies & "UserDateChangesoieiu")
	If isNumeric(DayFlag) = False or DayFlag = "" Then
		Application.Lock
		application(DEF_MasterCookies & "UserDateChangesoieiu") = 0
		Application.UnLock
		DayFlag = 0
	End If

	If DayFlag <> Day(Date) and DayFlag <> 0 Then
		Application.Lock
		application(DEF_MasterCookies & "UserDateChangesoieiu") = Day(Date)
		Application.UnLock
		
		Set Rs = Con.ExeCute("Select top 1 YesterDay from LeadBBS_SiteInfo")
		If Rs.Eof Then
			DayFlag = 0
		Else
			DayFlag = cCur(Rs(0))
			If DayFlag > 0 Then
				If Day(RestoreTime(DayFlag)) = Day(DEF_Now) Then DayFlag = 0
			Else
				DayFlag = -1
			End If
		End If

		If DayFlag <> 0 Then
			Set Rs = Con.ExeCute("select sum(TodayAnnounce) from LeadBBS_Boards")
			GBL_DBNum = GBL_DBNum + 1
			If Rs.Eof Then
				SQL = 0
			Else
				SQL = Rs(0)
				If isNull(SQL) Then SQL = 0
				SQL = cCur(SQL)
			End If
			Rs.Close
			Set Rs = Nothing
			Con.Execute("Update LeadBBS_SiteInfo set YesterdayAnc=" & SQL & ",YesterDay=" & GetTimeValue(DEF_Now))
			GBL_DBNum = GBL_DBNum + 1
			ReloadStatisticData
			Dim TmpData
			TmpData = Application(DEF_MasterCookies & "StatisticData")
			If SQL > cCur(TmpData(6,0)) Then
				Con.ExeCute("Update LeadBBS_SiteInfo Set MaxAnnounce=" & SQL & ",MaxAncTime=" & GetTimeValue(DEF_Now))
				GBL_DBNum = GBL_DBNum + 1
				UpdateStatisticDataInfo SQL,6,0
				UpdateStatisticDataInfo GetTimeValue(DEF_Now),7,0
			End If
			Con.exeCute("Update LeadBBS_Boards Set TodayAnnounce=0,TodayAnnounce_All=0")
			GBL_DBNum = GBL_DBNum + 1
			If isArray(application(DEF_MasterCookies & "BListAll")) = True Then
				SQL = Ubound(application(DEF_MasterCookies & "BListAll"),2)
				For I = 0 To SQL
					UpdateBoardApplicationInfo application(DEF_MasterCookies & "BListAll")(0,I),0,18
					UpdateBoardApplicationInfo application(DEF_MasterCookies & "BListAll")(0,I),0,31
				Next
			End If
			Con.ExeCute("insert into LeadBBS_Log(LogType,LogTime,LogInfo,UserName,IP,BoardID) Values(0," & GetTimeValue(DEF_Now) & ",'论坛进入新的一天，成功完成一系列更新．','" & Replace(Replace(htmlencode(Left(GBL_CHK_User,14)),"\","\\"),"'","''") & "','" & Replace(GBL_IPAddress,"'","''") & "'," & GBL_Board_ID & ")")
			GBL_DBNum = GBL_DBNum + 1
		End If
	ElseIf DayFlag = 0 then
		DayFlag = Day(DayFlag)
		Application.Lock
		application(DEF_MasterCookies & "UserDateChangesoieiu") = DayFlag
		Application.UnLock
		RepairOnlineUser
		Con.ExeCute("insert into LeadBBS_Log(LogType,LogTime,LogInfo,UserName,IP,BoardID) Values(0," & GetTimeValue(DEF_Now) & ",'系统在线人数已经成功重新统计，可能原因是论坛或WEB服务器重启．','" & Replace(Replace(htmlencode(Left(GBL_CHK_User,14)),"\","\\"),"'","''") & "','" & Replace(GBL_IPAddress,"'","''") & "'," & GBL_Board_ID & ")")
		GBL_DBNum = GBL_DBNum + 1
	End If

	If GBL_CHK_PWdFlag = 0 Then GBL_UserID = CheckPass
	SQL=cCur(Timer)
	If SQL>(cCur("0" & application(DEF_MasterCookies & "UserRefreshNum1oieiu"))+DEF_UserOnlineTimeOut) or SQL<cCur("0" & application(DEF_MasterCookies & "UserRefreshNum1oieiu")) Then
		Application.Lock
		SQL = Application(DEF_MasterCookies & "ActiveUsers")
		application(DEF_MasterCookies & "UserRefreshNum1oieiu") = Timer
		Application.UnLock
		Server.ScriptTimeOut = 600
		Con.ExeCute("delete from LeadBBS_onlineUser where LastDoingTime<" & GetTimeValue(DateAdd("s", 0-DEF_UserOnlineTimeOut, DEF_Now)))
		GBL_DBNum = GBL_DBNum + 1
		RepairOnlineUser
		Con.ExeCute("insert into LeadBBS_Log(LogType,LogTime,LogInfo,UserName,IP,BoardID) Values(0," & GetTimeValue(DEF_Now) & ",'系统在线人数隔时更新成功,清除前在线" & SQL & "人,后" & Application(DEF_MasterCookies & "ActiveUsers") & "人．','" & Replace(Replace(htmlencode(Left(GBL_CHK_User,14)),"\","\\"),"'","''") & "','" & Replace(GBL_IPAddress,"'","''") & "'," & GBL_Board_ID & ")")
		GBL_DBNum = GBL_DBNum + 1
	End If

	'If GBL_IPAddress = "61.154.122.50" Then Exit Sub
	If GBL_UserID > 0 Then
		SQL = "select top 2 UserID,LastDoingTime,sessionID,ID from LeadBBS_onlineUser where UserID=" & GBL_UserID
	Else
		SQL = "select top 2 UserID,LastDoingTime,sessionID,ID from LeadBBS_onlineUser where IP='" & Replace(GBL_IPAddress,"'","''") & "' and UserID=0"
	End If
	Set Rs = Con.ExeCute(SQL)
	GBL_DBNum = GBL_DBNum + 1

	If GBL_CHK_ShowFlag = 1 and DEF_EnableUserHidden = 1 Then
		i = "隐身会员"
		tmp = 0
	Else
		If GBL_UserID > 0 Then
			i = GBL_CHK_User
			tmp = GBL_CHK_UserLimit
		Else
			I = ""
			tmp = 0
		End If
	End If
	If Not Rs.Eof Then
		Dim LastDoingTime
		SQL = cCur(Rs(0))
		TmpSessionID = cCur(Rs(2))
		NIP = cCur(Rs(3))
		LastDoingTime = DateDiff("s",RestoreTime(Rs(1)), DEF_Now)
		If LastDoingTime < 0 or LastDoingTime > DEF_UserOnlineTimeOut Then LastDoingTime = 0
		Rs.MoveNext
		If Not Rs.Eof Then
			Count = 2
		Else
			Count = 1
		End If
		Rs.Close
		Set Rs = Nothing
		If LastDoingTime > 120 Then '120秒保存一次经验
			con.execute("Update LeadBBS_onlineUser set LastDoingTime=" & GetTimeValue(DEF_Now) & ",IP='" & GBL_IPAddress & "' where ID=" & NIP)
			GBL_DBNum = GBL_DBNum + 1
			UpdateSessionValue 17,GBL_IPAddress,0
			UpdateSessionValue 18,GetTimeValue(DEF_Now),0
			
			If GBL_UserID>0 and SQL > 0 Then
				con.Execute("Update LeadBBS_User set OnlineTime=OnlineTime+" & LastDoingTime & ",LastDoingTime=" & GetTimeValue(DEF_Now) & " where ID=" & GBL_UserID)
				UpdateSessionValue 5,LastDoingTime,1
				GBL_DBNum = GBL_DBNum + 1
			End If
			
			Application.Lock
			If isNumeric(application(DEF_MasterCookies & "SiteOlTime")) = False Then application(DEF_MasterCookies & "SiteOlTime") = 0
			application(DEF_MasterCookies & "SiteOlTime") = application(DEF_MasterCookies & "SiteOlTime") + LastDoingTime
			Application.UnLock
			If application(DEF_MasterCookies & "SiteOlTime") > 53873 Then '1小时多保存一次
				Application.Lock
				NewIP = application(DEF_MasterCookies & "SiteOlTime")
				application(DEF_MasterCookies & "SiteOlTime") = 0
				Application.UnLock
				con.execute("Update LeadBBS_SiteInfo Set OnlineTime=OnlineTime+" & NewIP)
				GBL_DBNum = GBL_DBNum + 1
				UpdateStatisticDataInfo NewIP,0,1
			End If
		End If
		If Count > 1 Then
			If GBL_UserID > 0 Then
				UpdateOnlineUserInfo("from LeadBBS_onlineUser where UserID=" & GBL_UserID & " and ID>" & NIP)
			Else
				UpdateOnlineUserInfo("from LeadBBS_onlineUser where IP='" & Replace(GBL_IPAddress,"'","''") & "' and UserID=0 and ID>" & NIP)
			End If
			SetActiveUserCount
		Else
			If SQL <> GBL_UserID Then
				con.execute("Update LeadBBS_onlineUser set UserID=" & GBL_UserID & ",HiddenFlag=" & tmp & ",UserName='" & Replace(i,"'","''") & "',LastDoingTime=" & GetTimeValue(DEF_Now) & ",IP='" & GBL_IPAddress & "' where ID=" & NIP)
				GBL_DBNum = GBL_DBNum + 1
				UpdateSessionValue 17,GBL_IPAddress,0
				UpdateSessionValue 18,GetTimeValue(DEF_Now),0
			ElseIf cCur(session.sessionID) <> cCur(TmpSessionID) And GBL_UserID> 0 Then
				con.execute("Update LeadBBS_onlineUser set sessionID=" & cCur(session.sessionID) & ",HiddenFlag=" & tmp & ",LastDoingTime=" & GetTimeValue(DEF_Now) & ",IP='" & GBL_IPAddress & "' where ID=" & NIP)
				GBL_DBNum = GBL_DBNum + 1
				UpdateSessionValue 17,GBL_IPAddress,0
				UpdateSessionValue 18,GetTimeValue(DEF_Now),0
			End If
		End If
	Else
		Rs.Close
		Set Rs = Nothing
		UpdateOnlineUserInfo("from LeadBBS_onlineUser where SessionID=" & cCur(session.sessionID))
		Session(DEF_MasterCookies & "RndNum") = (Fix(Timer) mod 9999)
		con.execute("insert into LeadBBS_onlineUser(SessionID,UserID,LastDoingTime,IP,StartTime,AtBoardID,AtUrl,AtInfo,Browser,System,UserName,HiddenFlag,LastRndNumber) values(" & cCur(session.sessionID) & "," & cCur(GBL_UserID) & "," & GetTimeValue(DEF_Now) & ",'" & GBL_IPAddress & "'," & GetTimeValue(DEF_Now) & ",0,'" & Replace(Left(Request.Servervariables("SCRIPT_NAME") & "?" & Request.QueryString,255),"'","''") & "','其它页面','" & Left(Replace(GetSBInfo(Request.ServerVariables("HTTP_USER_AGENT"),1),"'","''"),30) & "','" & Left(Replace(GetSBInfo(Request.ServerVariables("HTTP_USER_AGENT"),2),"'","''"),30) & "','" & Replace(i,"'","''") & "'," & cCur(tmp) & "," & Session(DEF_MasterCookies & "RndNum") & ")")
		GBL_DBNum = GBL_DBNum + 1
		
		If GBL_CHK_User <> "" and GBL_UserID > 0 and CheckSupervisorUserName = 1 Then
			Con.ExeCute("insert into LeadBBS_Log(LogType,LogTime,LogInfo,UserName,IP,BoardID) Values(0," & GetTimeValue(DEF_Now) & ",'管理员登录论坛.','" & Replace(Replace(htmlencode(Left(GBL_CHK_User,14)),"\","\\"),"'","''") & "','" & Replace(GBL_IPAddress,"'","''") & "'," & GBL_Board_ID & ")")
			GBL_DBNum = GBL_DBNum + 1
		End If

		Application.Lock
		application(DEF_MasterCookies & "ActiveUsers") = application(DEF_MasterCookies & "ActiveUsers") + 1
		Application.UnLock
	End If
	GBL_CHK_TempStr=""

End Sub

Function GetSBInfo(Str,Flag)

	If inStr(Str,";")>0 then
		Dim T
		T = split(Str,";")
		If Ubound(T) >= 2 then
			T(2) = replace(T(2),")","")
			T(2) = replace(T(2),"NT 5.2","2003")
			T(2) = replace(T(2),"NT 5.1","XP")
			T(2) = replace(T(2),"NT 5.0","2000")
			T(2) = replace(T(2),"9x","Me")
			T(1) = Trim(T(1))
			T(2) = Trim(T(2))
			If Flag = 1 then
				GetSBInfo = T(1)
			Else
				GetSBInfo = T(2)
			End If
		Else
			If Flag = 1 then
				GetSBInfo = "未知"
			Else
				GetSBInfo = "未知"
			End If
		End If
	Else
		If Flag = 1 then
			GetSBInfo = "未知"
		Else
			GetSBInfo = "未知"
		End If
	End If

End Function

Sub SiteHead(headString)

	Dim Temp
	If GBL_SiteHeadString = "" and GBL_SiteBottomString = "" Then
		'针对多个版面不同风格需求 Temp = Left(Request.Cookies(DEF_MasterCookies & "style")("border" & GBL_board_ID),14)
		Temp = Left(Request.Cookies(DEF_MasterCookies & "style")("border"),14)
		If isNumeric(Temp) = 0 or Temp="" Then Temp = -1
		Temp = cCur(Temp)
		If Temp >= 0 and Temp <= DEF_BoardStyleStringNum Then GBL_Board_BoardStyle = Temp
	End If

	If GBL_Board_BoardStyle > DEF_BoardStyleStringNum Then GBL_Board_BoardStyle = DEF_BoardStyleStringNum
	GBL_Board_BoardStyle = cCur(GBL_Board_BoardStyle)

	Temp = application(DEF_MasterCookies & "Style" & GBL_Board_BoardStyle)
	If isArray(Temp) = False Then
		If Temp & "" <> "yes" Then
			If GBL_ConFlag = 1 Then ReloadBoardStyleInfo(GBL_Board_BoardStyle)
			Temp = application(DEF_MasterCookies & "Style" & GBL_Board_BoardStyle)
		End If
	End If
	If isArray(Temp) = True Then
		DEF_BBS_ScreenWidth = RTrim(Temp(1,0))
		DEF_BBS_DisplayTopicLength = Temp(2,0)
		GBL_DefineImage = Temp(3,0)
		If GBL_DefineImage = True or GBL_DefineImage = 1 Then
			GBL_DefineImage = "Skin/" & GBL_Board_BoardStyle & "/"
		Else
			GBL_DefineImage = ""
		End If
		If GBL_SiteHeadString = "" Then GBL_SiteHeadString = Temp(4,0)
		If GBL_SiteBottomString = "" Then GBL_SiteBottomString = Temp(5,0)
		GBL_TableHeadString = Temp(6,0)
		GBL_TableBottomString = Temp(7,0)
		GBL_ShowBottomSure = Temp(8,0)
		GBL_TempletID = cCur("0" & Temp(9,0))
		GBL_TempletFlag = cCur("0" & Temp(10,0))
	End If
	%>
<html>
<head>
	<%
	If Application(DEF_MasterCookies & "MyHomeUrl") <> "" Then
		Response.Write "<Base href=""" & Application(DEF_MasterCookies & "MyHomeUrl") & GBL_FileDir & """>"
	End If%>
	<meta HTTP-EQUIV="Content-Type" content="text/html; charset=gb2312">
	<meta http-equiv="Content-Language" content="zh-cn">
	<META name="description" content="LeadBBS论坛,ASP论坛,计数器,统计系统,dotNet,asp.Net,源代码下载,组件,免费代码,ASP,数据库,SQL,文章,入门,ASP精品屋">
	<title>
		<%=headString%>
	</title>
	<link rel="stylesheet" type="text/css" href="<%=DEF_BBS_homeUrl%>inc/style<%=GBL_Board_BoardStyle%>.css">
	<style>
	<!--
		.l {FONT-FAMILY: 宋体; FONT-SIZE: 12px;}
		table {WORD-BREAK: break-all;}
	-->
	</style>
</head>
<%If Left(headString,3) = "   " Then%>
	<script language=javascript>
		function ctlent()
		{
			if(window.event.keyCode==27)
			{window.close();}
		}
	</script>
	<body onkeydown="ctlent();" class=TBBG9>
	<%
Else%>
<body bgcolor="<%=DEF_BBS_LightestColor%>" leftmargin="0" topmargin="0" marginwidth="0" marginheight="0" class=TBBGbody>

<%
If GBL_SiteHeadString <> "" Then
	Response.Write GBL_SiteHeadString
End If%>
<table width="<%=DEF_BBS_ScreenWidth%>" border="0" cellspacing="1" cellpadding="0" align="center" bgcolor=<%=DEF_BBS_DarkColor%> class=<%If GBL_TableHeadString = "" Then
		Response.Write "TBone"
	Else
		Response.Write "TBthree"
	End If%>>
<tr><td>
<table width="100%" border="0" cellspacing="0" cellpadding="0" align="center">
<tr height=17 valign=bottom>
	<td bgcolor="<%=DEF_BBS_LightColor%>">
		<table width="100%" border="0" cellspacing="0" cellpadding="0" class=TBTop>
		<tr>
			<td>
			<script language=javascript>
			function MM_findObj(n,d)
			{
				var p,i,x;
				if(!d)d=document;
				if((p=n.indexOf("?"))>0&&parent.frames.length)
				{
					d=parent.frames[n.substring(p+1)].document; n=n.substring(0,p);
				}
				if(!(x=d[n])&&d.all)x=d.all[n];for(i=0;!x&&i<d.forms.length;i++)x=d.forms[i][n];
				for(i=0;!x&&d.layers&&i<d.layers.length;i++)x=MM_findObj(n,d.layers[i].document);
				if(!x && document.getElementById)x=document.getElementById(n);return(x);
			}

			function MSHL()
			{
				var i,p,v,obj,args=MSHL.arguments;
				for(i=0;i<(args.length-2);i+=3)if((obj=MM_findObj(args[i]))!=null){v=args[i+2];
				if(obj.style){obj=obj.style;v=(v=='show')?'visible':(v='hide')?'hidden':v;}
			    obj.visibility=v;}
			}
			function MN1(n)
			{
				document.write("<div id=Layer" + n + " style='position:absolute'>");
				document.write("<div id=serve" + n + " style='position:absolute; left:0px; top:14px; width:90px; height:30px; z-index:20; visibility: hidden;' onMouseOut=MSHL('serve" + n + "','','hide') onMouseOver=MSHL('serve" + n + "','','show')>");
				document.write("<table width=100% border=0 cellspacing=1 cellpadding=3 bgcolor=<%=DEF_BBS_DarkColor%> class=TBMenu style='FILTER: alpha(opacity=85)'>");
				document.write("<tr bgcolor=<%=DEF_BBS_LightColor%> class=MenuBG><td style='line-height:16px'>");
				document.write("<table width=100% border=0 border=0 cellspacing=0 cellpadding=1 style=cursor:hand>");
			}
			function MN(m,n)
			{
				document.write("<tr><td onmouseover=\"this.className='MenuColor';\" onmouseout=\"this.className='';\">");
				document.write("<img src=<%=DEF_BBS_HomeUrl%>images/blank.gif height=2 width=2><br><img src=<%=DEF_BBS_HomeUrl%>images/blank.gif height=2 width=2><a href=\"");
				if(m.substr(0,5) != "http:"){document.write("<%=DEF_BBS_HomeUrl%>" + m + "\">" + n + "</a></td></tr>");}
				else{document.write(m + "\">" + n + "</a></td></tr>");}
			}
			function MN2(i,m,n)
			{
				document.write("</table></td></td></tr></table></div></div>");
				document.write("<a href=\"<%=DEF_BBS_HomeUrl%>" + m + "\" onMouseOver=\"MSHL('serve" + i + "','','show','subscibe','','hide','order','','hide','feature','','hide','defuser','','hide','spread','','hide')\" onMouseOut=\"MSHL('serve" + i + "','','hide','subscibe','','hide','order','','hide','feature','','hide','defuser','','hide','spread')\">" + n + "</a>");
			}
			function MNL(){document.write(" <img src=<%=DEF_BBS_HomeUrl%>images/<%=GBL_DefineImage%>splt.gif align=absmiddle width=7 height=15> ");}
			</script>
			<img src=<%=DEF_BBS_HomeUrl%>images/null.gif width=2 height=2><br><%If GBL_SiteHeadString = "" Then Response.Write " &nbsp;"
				If GBL_CHK_User <> "" Then
					Select Case Hour(DEF_Now)
					Case 0,1:Response.Write "凌晨"
					Case 2,3,4:Response.Write "深夜"
					Case 5,6,7,8,9,10:Response.Write "早上"
					Case 11,12,13:Response.Write "中午"
					Case 14,15,16,17:Response.Write "下午"
					Case 18:Response.Write "黄昏"
					Case 19,20,21,22,23:Response.Write "晚上"
					End Select
					Response.Write "好，<a href=" & DEF_BBS_HomeUrl & "User/LookUserInfo.asp>" & htmlEncode(GBL_CHK_User) & "</a> "
					If DEF_EnableUserHidden = 1 Then
						If GBL_CHK_ShowFlag = False or GBL_CHK_ShowFlag = 0 Then
							Response.Write "<a href=" & DEF_BBS_HomeUrl & "User/Hidden.asp>隐身</a> <img src=" & DEF_BBS_HomeUrl & "images/" & GBL_DefineImage & "splt.gif align=absmiddle width=7 height=15>"
						Else
							Response.Write "<a href=" & DEF_BBS_HomeUrl & "User/Hidden.asp>上线</a> <img src=" & DEF_BBS_HomeUrl & "images/" & GBL_DefineImage & "splt.gif align=absmiddle width=7 height=15>"
						End If
					End If
					Response.Write " <a href=" & DEF_BBS_HomeUrl & "User/Login.asp?R=Yes>重登录</a>"
				Else
					Response.Write "<a href=" & DEF_BBS_HomeUrl & "User/UserJoin.asp>注册</a>"
					Response.Write " <img src=" & DEF_BBS_HomeUrl & "images/" & GBL_DefineImage & "splt.gif align=absmiddle width=7 height=15> <a href=" & DEF_BBS_HomeUrl & "User/Login.asp>登录</a>"
				End If

				If DEF_BBS_SearchMode = 2 Then
					Response.Write " <img src=" & DEF_BBS_HomeUrl & "images/" & GBL_DefineImage & "splt.gif align=absmiddle width=7 height=15> <a href=" & DEF_BBS_HomeUrl & "Search/Search.asp>检索</a>"
				ElseIf DEF_BBS_SearchMode = 1 Then
					Response.Write " <img src=" & DEF_BBS_HomeUrl & "images/" & GBL_DefineImage & "splt.gif align=absmiddle width=7 height=15> <a href=" & DEF_BBS_HomeUrl & "Search/Search.asp>查询</a>"
				End If

				Response.Write "<script language=javascript>" & VbCrLf
				If GBL_CHK_User <> "" Then
				%>
	MNL();
	MN1(2);
	MN("User/LookUserInfo.asp","查看我的信息");
	MN("User/UserModify.asp","修改我的资料");
	MN("User/SendMessage.asp","发送短消息");
	MN("User/MyInfoBox.asp","我的收件箱");
	MN("User/MySendBox.asp","我的发件箱");
	MN("User/UserCollect.asp","帖子收藏夹");
	MN("User/UserAncTopic.asp","我发表的主题");
	MN("User/UserUpload.asp","我上传的附件");
	MN("User/UserFriend.asp?need=23","我的在线好友");
	MN2(2,"User/MyInfoBox.asp","用户专区")<%
				End If%>

	MNL();
	MN1(3);
	MN("User/UserTop.asp","用户排行榜");
	MN("User/UserOnline.asp","在线用户列表");
	MN("Search/List.asp","查看最新帖子");
	MN("Search/UploadList.asp","查看上传附件");
	MN("User/Help/About.asp","联系管理人员");
	MN2(3,"User/UserTop.asp","论坛信息")
	MNL();
	MN1(4);
	MN("User/Help/Cal.asp","论坛万年历");
	MN("User/Help/Color.asp","颜色对照表");
        MN("plug-ins/MusicBar/default.asp\" target=\"_parent","网络音乐");  
	MN2(4,"User/Help/Cal.asp","工具箱")
	<%
	If DEF_BoardStyleStringNum > 0 Then
	%>
	MNL();
	MN1(1);
	var tu="User/BoardStyle.asp?b=<%=GBL_Board_ID%>&s=";<%
	For Temp = 0 to DEF_BoardStyleStringNum
		Response.Write "	MN(tu+""" & Temp & """,""" & DEF_BoardStyleString(Temp) & """);" & VbCrLf
	Next%>
	MN2(1,tu,"风格");
				<%
				End If%>
	</script><%

				If CheckSupervisorUserName = 1 Then
					Response.Write " <img src=" & DEF_BBS_HomeUrl & "images/" & GBL_DefineImage & "splt.gif align=absmiddle width=7 height=15> <a href=" & DEF_BBS_HomeUrl & DEF_ManageDir & "/default.asp><font color=red class=RedFont>管理</font></a>"
				ElseIf GetBinarybit(GBL_CHK_UserLimit,10) = 1 Then
					Response.Write " <img src=" & DEF_BBS_HomeUrl & "images/" & GBL_DefineImage & "splt.gif align=absmiddle width=7 height=15> <a href=" & DEF_BBS_HomeUrl & "User/BoardMaster/default.asp><font color=blue class=BlueFont>管理</font></a>"
				End If

				If GBL_CHK_Flag = 1 Then
					Response.Write " <img src=" & DEF_BBS_HomeUrl & "images/" & GBL_DefineImage & "splt.gif align=absmiddle width=7 height=15> <a href=" & DEF_BBS_HomeUrl & "User/Logout.asp>退出</a>"
				End If%></td>
		</tr>
		</table></td>
</tr>
</table></td>
</tr>
<%If GBL_SiteHeadString = "" Then%><tr><td>
<table width="100%" border="0" cellspacing="2" cellpadding="0" align="center" bgcolor=<%=DEF_BBS_LightestColor%> class=TBBG9>
<tr>
	<td valign="bottom" width="212"><img src="<%=DEF_BBS_HomeUrl%>images/<%=GBL_DefineImage%>LeadBBS.GIF" width="207" height="60"></td>
	<td align=center><%=DEF_TopAdString%></td>
	<td width=60 align=right valign=top>
		<img src="<%=DEF_BBS_HomeUrl%>images/null.GIF" width="5" height="5"><br>
		<a href=#33><span style="CURSOR: hand" onClick="window.external.AddFavorite('http://<%=Request.Servervariables("SERVER_NAME") & Request.Servervariables("SCRIPT_NAME") & "?" & Request.QueryString%>', '<%=DEF_SiteNameString%>')">加入收藏</span></a>&nbsp;
		<br><img src="<%=DEF_BBS_HomeUrl%>images/null.GIF" width="5" height="5"><br><a href="<%=DEF_BBS_HomeUrl%>User/help/help.asp">使用帮助</a>&nbsp;
		<br><img src="<%=DEF_BBS_HomeUrl%>images/null.GIF" width="5" height="5"><br><a href="<%=DEF_BBS_HomeUrl%>User/help/about.asp">联系我们</a>&nbsp;</td>
		</td>
</tr>
</table>
		</td>
</tr><%End If%>
</table>

<table width="<%=DEF_BBS_ScreenWidth%>" border="0" cellspacing="0" cellpadding="0" align="center" height="2">
<tr>
	<td><img src=<%=DEF_BBS_HomeUrl%>images/null.gif width=1 height=1></td>
</tr>
</table>
	<%
	End If

End Sub

Sub SiteBottom

	%><table width=<%=DEF_BBS_ScreenWidth%> border=0 cellspacing=0 cellpadding=0 align=center height=2>
	<tr>
		<td><p align=center class=NavColor><br>
	<a name=bottom></a>Copyright <font size=2>&copy;</font> <%=year(date)%>&nbsp;<%=DEF_SiteNameString%> 版权所有<br><br>
	<a href=http://www.leadbbs.com target=_blank class=NavColor>LeadBBS</a> v3.14<%
	DEF_PageExeTime1 = FormatNumber(cCur(Timer - DEF_PageExeTime1),4,True)

	Response.Write " <font class=NavColor>耗时" & DEF_PageExeTime1*1000 & "毫秒</font>"
	'Response.Write " DB请求" & GBL_DBNum & "次"
	%><br><img src=<%=DEF_BBS_HomeUrl%>images/null.gif width=2 height=5></p>
	</td></tr></table></BODY>
	</HTML><%

End Sub

Sub SiteBottom_Spend

	DEF_PageExeTime1 = FormatNumber(cCur(Timer - DEF_PageExeTime1),4,True)
	Response.Write "<p align=center><a href=http://www.leadbbs.com target=_blank class=NavColor>LeadBBS</a> v3.14 耗时" & DEF_PageExeTime1*1000 & "毫秒"
	'Response.Write " DB请求" & GBL_DBNum & "次"
	%></center>
	</BODY>
	</HTML><%

End Sub

Function htmlEncode(str)

	If str & "" <> "" Then
		htmlEncode=Replace(Replace(Replace(str,">","&gt;"),"<","&lt;"),"""","&quot;")
	Else
		htmlEncode=str
	End If

End Function

Function UrlEncode(str)

	If str & "" <> "" Then
		urlencode = Server.UrlEncode(str)
	Else
		UrlEncode = str
	End If

End Function

Function RestoreTime(DateString)

	If isNull(DateString) Then Exit Function
	DateString = cstr(DateString)
	If len(DateString)<8 then
		RestoreTime=DateString
	Else
		If len(DateString)<14 then
			RestoreTime = Mid(DateString,1,4) & "-" & Mid(DateString,5,2) & "-" & Mid(DateString,7,2)
		Else
			RestoreTime = Mid(DateString,1,4) & "-" & Mid(DateString,5,2) & "-" & Mid(DateString,7,2) & " " & Mid(DateString,9,2) & ":" & Mid(DateString,11,2) & ":" & Mid(DateString,13,2)
		End If
	End If

End Function

Function StrLength(str)

	If isNull(str) or Str = "" Then
		StrLength = 0
		Exit function
	End If
	If len("例子") = 2 then
		Dim l,t,c,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
			End If
		next
		StrLength=t
	Else 
		StrLength=len(str)
	End If
End Function

Function GetTimeValue(DateString)

	Dim Temp,TempStr
	If isNull(DateString) or isTrueDate(DateString) = 0  Then Exit Function
	Temp = csTr(Year(DateString))
	If len(temp)<3 Then
		Temp = left(year(date),2) & temp
	End If
	TempStr = Temp
	
	Temp = csTr(month(DateString))
	If len(temp)<2 Then Temp = "0" & temp
	TempStr = TempStr & Temp

	Temp = csTr(day(DateString))
	If len(temp)<2 Then Temp = "0" & temp
	TempStr = TempStr & Temp

	Temp = csTr(Hour(DateString))
	If len(temp)<2 Then Temp = "0" & temp
	TempStr = TempStr & Temp

	Temp = csTr(Minute(DateString))
	If len(temp)<2 Then Temp = "0" & temp
	TempStr = TempStr & Temp

	Temp = csTr(Second(DateString))
	If len(temp)<2 Then Temp = "0" & temp
	TempStr = TempStr & Temp

	GetTimeValue = cCur(TempStr)

End Function

Dim GBL_CHK_pass,GBL_CHK_User,GBL_CHK_ShowFlag,GBL_CHK_Flag,GBL_CHK_TempStr,GBL_CHK_UserLimit,GBL_CHK_CharmPoint,GBL_CHK_CachetValue
Dim GBL_CHK_Points,GBL_CHK_OnlineTime,GBL_CHK_MessageFlag,GBL_CHK_LastWriteTime,GBL_CHK_LastAnnounceID
Dim GBL_CHK_PWdFlag,GBL_CHK_GuestFlag
GBL_CHK_PWdFlag = 1
GBL_CHK_GuestFlag = 1
GBL_CHK_LastWriteTime = 0

GetUserNamePassword

Sub GetUserNamePassword

	GBL_CHK_Flag = 1
	If Request.QueryString("dontRequestFormFlag") = "" Then
		GBL_CHK_user = Trim(Request.Form("user"))
		GBL_CHK_Pass = Left(Request.Form("pass"),15)
	End If
	If GBL_CHK_user = "" Then GBL_CHK_user = Trim(Request.QueryString("user"))
	If GBL_CHK_User = "" Then GBL_CHK_user = Request.Cookies(DEF_MasterCookies)("User")
	If GBL_CHK_user = "" Then GBL_CHK_Flag = 0

	GBL_CHK_user = Replace(Left(GBL_CHK_user,20),",","")
	If isArray(GBL_UDT) and GBL_CHK_User <> "" Then
		If LCase(GBL_CHK_User) = LCase(GBL_UDT(1)) Then
			GBL_UserID = cCur(GBL_UDT(0))
			GBL_CHK_UserLimit = GBL_UDT(2)
			GBL_CHK_ShowFlag = GBL_UDT(3)
			GBL_CHK_MessageFlag = GBL_UDT(6)
			Dim CkiExp
			If Request.QueryString("dontRequestFormFlag")="" Then CkiExp = Request.Form("CkiExp")
			If CkiExp & "" = "" and GBL_CHK_Pass = "" Then GBL_CHK_Pass = GBL_UDT(9) & ""
			Exit Sub
		End If
	End If
	GBL_CHK_ShowFlag = 0
	GBL_CHK_UserLimit = 0
	If GBL_CHK_Pass = "" and GBL_CHK_Flag = 1 Then GBL_CHK_Pass = Left(Request.Cookies(DEF_MasterCookies)("pass"),15)
	If GBL_CHK_Pass = "" Then GBL_CHK_Flag = 0

End Sub

Function CheckPass

	Dim IPADDRESS,SubmitFlag,MD5Pass
	If Request.QueryString("dontRequestFormFlag")="" Then
		SubmitFlag = request.Form("submitflag")
		If SubmitFlag = "" Then SubmitFlag = request.QueryString("submitflag")
	Else
		SubmitFlag = request.QueryString("submitflag")
	End If
	If GBL_CheckPassDoneFlag = 1 Then Exit Function
	GBL_CheckPassDoneFlag = 1
	GBL_UserID = 0

	'If SubmitFlag <> "" Then
	'	IPADDRESS = "http://" & LCase(Request.ServerVariables("server_name"))
	'	If Left(LCase(Request.ServerVariables("HTTP_REFERER")),Len(IPADDRESS)) <> IPADDRESS Then
	'		GBL_CHK_TempStr = "发生错误．<br>" & VbCrLf
	'		GBL_CHK_Flag = 0
	'		Exit Function
	'	End If
	'End If

	IPADDRESS = GBL_IPAddress
	If GBL_IPAddress = "1.1.1.1" Then
		GBL_CHK_TempStr = "非法IP地址，无法安全提交任何数据．<br>" & VbCrLf
		GBL_CHK_Flag = 0
		Exit Function
	End If

	Dim UpdateString

	If GBL_CHK_Flag <> 1 Then
		GBL_CHK_User = ""
		GBL_UserID = 0
		Exit Function
	End If

	Dim Rs
	Dim SQL
	If isArray(GBL_UDT) Then
		If cCur(GBL_UDT(11)) > 19800000000000 Then
			SQL = DateDiff("s",RestoreTime(GBL_UDT(11)), DEF_Now)
			If SQL<0 Then SQL=0
		Else
			SQL = 0
		End If
		If LCase(GBL_UDT(1)) <> LCase(GBL_CHK_User) Then SQL = 120
	Else
		SQL = 120
	End If

	If SQL >= 120 Then
		If DEF_RepeatLoginTimeOut > 0 and DEF_RepeatLoginTimeOut < DEF_UserOnlineTimeOut Then
			SQL = "Select top 1 T.ID,T.UserName,T.UserLimit,T.ShowFlag,T.Points,T.OnlineTime,T.MessageFlag,T.Login_lastpass,T.Login_falsenum,T.Pass,T.Login_RightIP,T.Prevtime,T.LockIP,T.LastWriteTime,T.LastAnnounceID,CharmPoint,CachetValue,S.IP,S.LastDoingTime from LeadBBS_User as T left join LeadBBS_OnlineUser as S on T.ID=S.UserID Where T.Username = '" & Replace(GBL_CHK_User,"'","''") & "'"
		Else
			SQL = "Select top 1 ID,UserName,UserLimit,ShowFlag,Points,OnlineTime,MessageFlag,Login_lastpass,Login_falsenum,Pass,Login_RightIP,Prevtime,LockIP,LastWriteTime,LastAnnounceID,CharmPoint,CachetValue from LeadBBS_User Where Username = '" & Replace(GBL_CHK_User,"'","''") & "'"
		End If
		Set Rs = Con.ExeCute(SQL)
		GBL_DBNum = GBL_DBNum + 1
		If ((Rs.Eof) or (Rs.Bof)) Then
			Rs.Close
			Set Rs = Nothing
			GBL_CHK_TempStr = GBL_CHK_TempStr & "您所填的用户不存在， 登录失败!<br>" & VbCrLf
			GBL_CHK_user = ""
			GBL_CHK_Flag = 0
			GBL_UserID = 0
			Set Session(DEF_MasterCookies & "UDT") = Nothing
			Session(DEF_MasterCookies & "UDT") = ""
			Exit Function
		Else
			ReDim GBL_UDT(18)
			GBL_UDT(0) = Rs(0)
			GBL_UDT(1) = Rs(1)
			GBL_UDT(2) = Rs(2)
			GBL_UDT(3) = Rs(3)
			GBL_UDT(4) = Rs(4)
			GBL_UDT(5) = Rs(5)
			GBL_UDT(6) = Rs(6)
			GBL_UDT(7) = Rs(7)
			GBL_UDT(8) = Rs(8)
			GBL_UDT(9) = Rs(9)
			GBL_UDT(10) = Rs(10)
			GBL_UDT(11) = Rs(11)
			GBL_UDT(12) = Rs(12)
			GBL_UDT(13) = Rs(13)
			GBL_UDT(14) = Rs(14)
			GBL_UDT(15) = Rs(15)
			GBL_UDT(16) = Rs(16)
			If DEF_RepeatLoginTimeOut > 0 and DEF_RepeatLoginTimeOut < DEF_UserOnlineTimeOut Then
				GBL_UDT(17) = Rs(17)
				GBL_UDT(18) = Rs(18)
			End If
			Rs.Close
			Set Rs = Nothing
			Session(DEF_MasterCookies & "UDT") = GBL_UDT
		End If
	End If
	
	If DEF_RepeatLoginTimeOut > 0 and DEF_RepeatLoginTimeOut < DEF_UserOnlineTimeOut Then
		If GBL_IPAddress <> GBL_UDT(17) and DateDiff("s",RestoreTime(GBL_UDT(18)),DEF_Now) < DEF_RepeatLoginTimeOut Then
			If SubmitFlag <> "" Then GBL_CHK_TempStr = GBL_CHK_TempStr & "此用户已经在线，系统已经设置成" & Fix(DEF_RepeatLoginTimeOut/60) & "分钟后才允许再次登录!<br>" & VbCrLf
			GBL_CHK_User = ""
			GBL_CHK_Flag = 0
			Set Session(DEF_MasterCookies & "UDT") = Nothing
			Session(DEF_MasterCookies & "UDT") = ""
			Exit Function
		End If
	End If

	If GBL_CHK_CachetValue > 127 Then GBL_CHK_CachetValue = 127-GBL_CHK_CachetValue
	If GBL_UDT(12) & "" <> "" and GBL_UDT(12) <> GBL_IPAddress Then
		If SubmitFlag <> "" Then GBL_CHK_TempStr = GBL_CHK_TempStr & "此用户已经开启IP绑定访问，您无权使用此用户!<br>" & VbCrLf
		GBL_CHK_User = ""
		GBL_CHK_Flag = 0
		Set Session(DEF_MasterCookies & "UDT") = Nothing
		Session(DEF_MasterCookies & "UDT") = ""
		Exit Function
	End If
	SQL = 0
	Dim Login_lastpass,Login_falsenum,Pass,Login_RightIP,Prevtime
	GBL_UserID = GBL_UDT(0)
	GBL_CHK_User = GBL_UDT(1)
	GBL_CHK_UserLimit = GBL_UDT(2)
	GBL_CHK_ShowFlag = GBL_UDT(3)
	If GBL_CHK_ShowFlag = 1 or GBL_CHK_ShowFlag = True Then
		GBL_CHK_ShowFlag = 1
	Else
		GBL_CHK_ShowFlag = 0
	End If
	GBL_CHK_Points = cCur(GBL_UDT(4))
	GBL_CHK_OnlineTime = cCur(GBL_UDT(5))
	GBL_CHK_MessageFlag = GBL_UDT(6)
	Login_lastpass = Trim(GBL_UDT(7))
	Login_falsenum = cCur(GBL_UDT(8))
	Prevtime = ReStoretime(cCur(GBL_UDT(11)))
	Pass = GBL_UDT(9)
	Login_RightIP = GBL_UDT(10)
	GBL_CHK_LastWriteTime = DateDiff("s",RestoreTime(GBL_UDT(13)),DEF_Now)
	GBL_CHK_LastAnnounceID = cCur(GBL_UDT(14))
	GBL_CHK_CharmPoint = cCur(GBL_UDT(15))
	GBL_CHK_CachetValue = cCur(GBL_UDT(16))

	If GBL_CHK_LastWriteTime < 0 Then GBL_CHK_LastWriteTime = DEF_WriteEventSpace + 1
	If GetTimeValue(PrevTime) > 19800000000000 Then
		PrevTime = DateDiff("s",Prevtime, DEF_Now)
		If PrevTime<0 Then PrevTime=0
	Else
		PrevTime = 0
	End If
	If Len(GBL_CHK_Pass) > 15 Then
		MD5Pass = GBL_CHK_Pass
	Else
		MD5Pass = MD5(GBL_CHK_Pass)
	End If
	If(Login_lastpass & "" <> trim(MD5Pass) & "") Then
		If(Login_falsenum<DEF_MaxLoginTimes) Then
			UpdateString = ",Prevtime=" & GetTimeValue(DEF_Now) & ",Login_IP='" & Replace(IPADDRESS,"'","''") & "',Login_falsenum=Login_falsenum+1,Login_lastpass='" & Replace(MD5Pass,"'","''") & "'"
			UpdateSessionValue 11,GetTimeValue(DEF_Now),0
			UpdateSessionValue 8,1,1
			UpdateSessionValue 7,MD5Pass,0
		Else
			If(Prevtime < DEF_RestSpaceTime and Prevtime >= 0) Then
				If IPADDRESS = Login_RightIP Then
				Else
					If SubmitFlag <> "" Then GBL_CHK_TempStr = GBL_CHK_TempStr & "登录太频，请稍休息后再登录或联系管理员!<br>" & VbCrLf
					UpdateString = ",Prevtime=" & GetTimeValue(DEF_Now)
					UpdateSessionValue 11,GetTimeValue(DEF_Now),0
					If GBL_CHK_LastWriteTime < DEF_WriteEventSpace Then
						Con.ExeCute("Update LeadBBS_User Set " & Mid(UpdateString,2) & ",LastWriteTime=" & GetTimeValue(DEF_Now) & " where ID=" & GBL_UserID)
						UpdateSessionValue 13,GetTimeValue(DEF_Now),0
					End If
					GBL_DBNum = GBL_DBNum + 1
					CheckPass = 0
					GBL_UserID = 0
					GBL_CHK_Flag = 0
					GBL_CHK_UserLimit = 0
					GBL_CHK_Points = 0
					GBL_CHK_OnlineTime = 0
					GBL_CHK_MessageFlag = 0
					GBL_CHK_user = ""
					GBL_CHK_CharmPoint = 0
					GBL_CHK_CachetValue = 0
					Set Session(DEF_MasterCookies & "UDT") = Nothing
					Session(DEF_MasterCookies & "UDT") = ""
					Exit function
				End If
			Else
				UpdateString = UpdateString & ",Prevtime=" & GetTimeValue(DEF_Now) & ",Login_IP='" & Replace(IPADDRESS,"'","''") & "',Login_falsenum=1,Login_lastpass='" & Replace(MD5Pass,"'","''") & "'"
				UpdateSessionValue 11,GetTimeValue(DEF_Now),0
				UpdateSessionValue 13,GetTimeValue(DEF_Now),0
				UpdateSessionValue 7,MD5Pass,0
				UpdateSessionValue 8,1,1
			End If
		End If
	Else
		If PrevTime >= 120 Then
			If GBL_CHK_LastWriteTime > DEF_WriteEventSpace Then
				UpdateString = UpdateString & ",Prevtime=" & GetTimeValue(DEF_Now) & ",Login_IP='" & Replace(IPADDRESS,"'","''") & "'"
				UpdateSessionValue 11,GetTimeValue(DEF_Now),0
			End If
		End If
	End If

	If Pass <> MD5Pass and Mid(MD5Pass,9,16) <> Pass Then
		If cstr(IPADDRESS&chr(0)) = cstr(Login_RightIP&chr(0)) Then
			UpdateString = UpdateString & ",Login_RightIP='as'"
			UpdateSessionValue 10,"as",0
		End If
		If inStr(UpdateString,"Prevtime") = 0 then
			UpdateString = UpdateString & ",Prevtime=" & GetTimeValue(DEF_Now)
			UpdateSessionValue 11,GetTimeValue(DEF_Now),0
		End If
		Con.ExeCute("Update LeadBBS_User Set " & Mid(UpdateString,2) & " where ID=" & GBL_UserID)
		GBL_DBNum = GBL_DBNum + 1
		GBL_CHK_TempStr = GBL_CHK_TempStr & "您的密码不正确, 登录失败! <br>" & VbCrLf
		GBL_CHK_Flag = 0
		CheckPass = 0
		GBL_UserID = 0
		GBL_CHK_UserLimit = 0
		GBL_CHK_Points = 0
		GBL_CHK_OnlineTime = 0
		GBL_CHK_MessageFlag = 0
		GBL_CHK_user = ""
		GBL_CHK_CharmPoint = 0
		GBL_CHK_CachetValue = 0
		Set Session(DEF_MasterCookies & "UDT") = Nothing
		Session(DEF_MasterCookies & "UDT") = ""
		Exit Function
	Else
		If SubmitFlag = "ddddls-+++" Then
			If GBL_CHK_LastWriteTime > DEF_WriteEventSpace Then
				UpdateString = ",Prevtime=" & GetTimeValue(DEF_Now) & ",Login_IP='" & Replace(IPADDRESS,"'","''") & "',Login_RightIP='" & Replace(IPADDRESS,"'","''") & "',Login_falsenum=0,Login_oknum=Login_oknum+1"
				UpdateSessionValue 11,GetTimeValue(DEF_Now),0
				UpdateSessionValue 10,IPADDRESS,0
				UpdateSessionValue 8,0,0
			End If
		End If
		Rem GBL_CHK_TempStr = "<font color=008800 class=GreenFont>您已经登录成功!</font>" & VbCrLf
		If Request.QueryString("dontRequestFormFlag")="" Then
			IPADDRESS = Request.Form("CkiExp")
			If IPADDRESS = "" Then IPADDRESS = Request.QueryString("CkiExp")
		Else
			IPADDRESS = ""
		End If
		If IPADDRESS <> "" Then
			If Len(GBL_CHK_Pass) > 15 Then GBL_CHK_TempStr = "<font color=red class=RedFont>登录失败，请输入你的密码!</font>" & VbCrLf
			Select Case IPADDRESS
				Case "-1": IPADDRESS = 0
				Case "1": IPADDRESS = 1
				Case "2": IPADDRESS = 2
				Case "7": IPADDRESS = 7
				Case "31": IPADDRESS = 31
				Case else: IPADDRESS = 365
			End Select
			If IPADDRESS > 0 Then Response.Cookies(DEF_MasterCookies).Expires = Date + IPADDRESS
			Response.Cookies(DEF_MasterCookies)("user") = GBL_CHK_User
			Response.Cookies(DEF_MasterCookies)("pass") = GBL_CHK_Pass
			If GBL_CHK_ShowFlag = 1 and DEF_EnableUserHidden = 1 Then
				IPADDRESS = "隐身会员"
				SQL = 0
			Else
				IPADDRESS = GBL_CHK_User
				SQL = cCur(GBL_CHK_UserLimit)
			End If
			If GBL_CHK_LastWriteTime < DEF_WriteEventSpace Then con.execute("Update LeadBBS_onlineUser set UserID=" & GBL_UserID & ",UserName='" & Replace(IPADDRESS,"'","''") & "',HiddenFlag=" & SQL & ",LastDoingTime=" & GetTimeValue(DEF_Now) & ",IP='" & GBL_IPAddress & "' where sessionID=" & cCur(session.sessionID))
			GBL_DBNum = GBL_DBNum + 1
			Set Session(DEF_MasterCookies & "UDT") = Nothing
			Session(DEF_MasterCookies & "UDT") = ""
		End If
	End If
	If UpdateString <> "" Then
		Con.ExeCute("Update LeadBBS_User Set " & Mid(UpdateString,2) & ",LastDoingTime=" & GetTimeValue(DEF_Now) & ",LastWriteTime=" & GetTimeValue(DEF_Now) & " where ID=" & GBL_UserID)
		GBL_DBNum = GBL_DBNum + 1
		UpdateSessionValue 13,GetTimeValue(DEF_Now),0
	End If
	GBL_UserID = cCur(GBL_UserID)
	CheckPass = GBL_UserID

End Function

Sub UpdateSessionValue(N,Value,T)

	If (DEF_RepeatLoginTimeOut <= 0 or DEF_RepeatLoginTimeOut > DEF_UserOnlineTimeOut) and N >=17 Then Exit Sub
	Dim TA
	TA = Session(DEF_MasterCookies & "UDT")
	If isArray(TA) = False Then Exit Sub
	If T = 0 Then
		TA(N) = Value
	Else
		TA(N) = cCur(TA(N)) + Value
	End If
	Session(DEF_MasterCookies & "UDT") = TA

End Sub

Function CheckSupervisorUserName

	If GBL_CHK_User <> "" and inStr(GBL_CHK_User,",") = 0 and inStr(LCase(DEF_SupervisorUserName),"," & LCase(GBL_CHK_User) & ",") > 0 Then
		If Session(DEF_MasterCookies & "Manager") = "manage" Then
			CheckSupervisorUserName = 1
		Else
			CheckSupervisorUserName = 0
		End If
	Else
		CheckSupervisorUserName = 0
	End If

End Function

rem 显示左边的n个字符(自动识别汉字)
Function LeftTrue(str,n)

	If len(str) <= n/2 Then
		LeftTrue = str
	Else
		Dim TStr,l,t,c,i
		l = len(str)
		TStr = ""
		t = 0
		For i=1 To l
			c = asc(mid(str,i,1))
			If c < 0 then c=c+65536
			If c > 255 then
				t = t+2
			Else
				t = t+1
			End If
			If t > n Then exit for
			TStr = TStr&(mid(str,i,1))
		Next
		LeftTrue = TStr
	End If

End Function

Rem 为VBScript的isDate缺陷而编写的函数,用on error resume next也拦不住
Function isTrueDate(TStr)

	Dim T
	T = TStr
	T = Replace(Replace(Replace(Replace(Replace(Replace(Replace(T,"年","-"),"月","-"),"日"," "),"上午"," "),"下午"," "),"  "," "),"  "," ")
	
	Dim N1,N2
	N1 = inStr(T,"-")
	If N1>0 Then N2 = inStrRev(T,"-")
	If N1 = N2 and N1 >0 Then
		isTrueDate = 0
		Exit Function
	End If

	N1 = inStr(T,":")
	If N1>0 Then N2 = inStrRev(T,"-")
	If N1 = N2 and N1 >0 Then
		isTrueDate = 0
		Exit Function
	End If

	If isDate(TStr) Then
		isTrueDate = 1
	Else
		isTrueDate = 0
	End If

End Function

Dim BinaryData,BinaryDataNum
BinaryData = Array(1,2,4,8,16,32,64,128,256,512,1024,2048,4096,8192,16384,32768,65536,131072,262144,524288,1048576,2097152,4194304,8388608,16777216,33554432,67108864,134217728,268435456,536870912,1073741824,2147483648)
BinaryDataNum = Ubound(BinaryData,1)
	
Function GetBinarybit(Number,bit)

	If bit = BinaryDataNum Then
		If Number = BinaryData(bit) Then
			GetBinarybit = 1
		Else
			GetBinarybit = 0
		End If
	Else
		If (Number mod BinaryData(bit)) >= BinaryData(bit-1) Then
			GetBinarybit = 1
		Else
			GetBinarybit = 0
		End If
	End if

End Function

Function DisplayAnnounceTitle(str,Sty)

	If Sty >= 60 Then
		DisplayAnnounceTitle = "<font color=gray class=GrayFont>帖子等待审核中...</font>"
		Exit Function
	End If
	Select Case Sty
		Case 1: DisplayAnnounceTitle = str
		Case 2: DisplayAnnounceTitle = "<font color=red class=RedFont>" & htmlencode(str) & "</font>"
		Case 3: DisplayAnnounceTitle = "<font color=green class=GreenFont>" & htmlencode(str) & "</font>"
		Case 4: DisplayAnnounceTitle = "<font color=blue class=BlueFont>" & htmlencode(str) & "</font>"
		Case else: DisplayAnnounceTitle = htmlencode(str)
	End Select

End Function

Function KillHTMLLabel(str)

	Dim n,m,str2
	n = inStr(str,"<")
	m = inStr(str,">")
	str2 = str
	Do while n > 0 and n < m
		str2 = Left(str2,n-1) & Mid(str2,m+1)
		n = inStr(str2,"<")
		m = inStr(str2,">")
	Loop
	KillHTMLLabel = str2

End Function

Sub SetActiveUserCount

	Dim Rs,Temp
	Set Rs = Con.ExeCute("Select Count(*) from LeadBBS_OnlineUser")
	GBL_DBNum = GBL_DBNum + 1
	If Rs.Eof Then
		Application.Lock
		application(DEF_MasterCookies & "ActiveUsers") = 0
		Application.UnLock
	Else
		Temp = Rs(0)
		If isNull(Temp) Then Temp = 0
		Application.Lock
		application(DEF_MasterCookies & "ActiveUsers") = cCur(Temp)
		Application.UnLock
	End If
	Rs.Close
	Set Rs = Nothing

End Sub

Sub UpdateBoardApplicationInfo(BoardID,Value,N)

	If isArray(Application(DEF_MasterCookies & "BoardInfo" & BoardID)) = True Then
		Dim TmpArray
		TmpArray = Application(DEF_MasterCookies & "BoardInfo" & BoardID)
		TmpArray(N,0) = Value
		Application.Lock
		Application(DEF_MasterCookies & "BoardInfo" & BoardID) = TmpArray
		Application.UnLock
	End If

End Sub

Sub ReloadPubMessageInfo

	Dim Rs
	Set Rs = Con.ExeCute("Select top " & DEF_TopicContentMaxListNum & " title,SendTime from LeadBBS_InfoBox where ToUser='' Order by ID DESC")
	GBL_DBNum = GBL_DBNum + 1
	If Not Rs.Eof Then
		Application.Lock
		application(DEF_MasterCookies & "PubMsg") = Rs.GetRows(-1)
		Application.UnLock
	Else
		Application.Lock
		application(DEF_MasterCookies & "PubMsg") = VbCrLf & VbCrLf
		Application.UnLock
	End If
	Rs.Close
	Set Rs = Nothing

End Sub

Sub ReloadBoardStyleInfo(ID)

	If GBL_ConFlag = 0 Then Exit Sub
	Dim Rs,Temp
	Set Rs = con.ExeCute("Select top 1 T1.StyleID,T1.ScreenWidth,T1.DisplayTopicLength,T1.DefineImage,T1.SiteHeadString,T1.SiteBottomString,T1.TableHeadString,T1.TableBottomString,T1.ShowBottomSure,T1.TempletID,T2.TempletFlag from LeadBBS_Skin as T1 Left Join LeadBBS_Templet as T2 on T1.TempletID=T2.ID Where T1.StyleID=" & ID)
	GBL_DBNum = GBL_DBNum + 1
	If Rs.Eof Then
		Rs.Close
		Set Rs = Nothing
		GBL_Board_BoardLimit = 0
		Application.Lock
		Application(DEF_MasterCookies & "Style" & ID) = "yes"
		Application.UnLock
		Exit Sub
	Else
		GBL_SiteHeadString = Rs(4)
		GBL_SiteBottomString = Rs(5)
		GBL_TableHeadString = Rs(6)
		GBL_TableBottomString = Rs(7)
		Temp = Rs.GetRows(1)
		Application.Lock
		Set Application(DEF_MasterCookies & "Style" & ID) = Nothing
		Application(DEF_MasterCookies & "Style" & ID) = Temp
		Application.UnLock
		Temp = Application(DEF_MasterCookies & "Style" & ID)
		Temp(4,0) = GBL_SiteHeadString
		Temp(5,0) = GBL_SiteBottomString
		Temp(6,0) = GBL_TableHeadString
		Temp(7,0) = GBL_TableBottomString
		Application(DEF_MasterCookies & "Style" & ID) = Temp
		Rs.Close
		Set Rs = Nothing
	End If

End Sub

Sub ReloadStatisticData

	dim Rs,SQL
	SQL = "select top 1 OnlineTime,UserCount,MaxOnline,MaxolTime,PageCount,UploadNum,MaxAnnounce,MaxAncTime,YesterdayAnc from LeadBBS_SiteInfo"
	Set Rs = Con.Execute(SQL)
	GBL_DBNum = GBL_DBNum + 1
	If Not Rs.Eof Then
		SQL = Rs.GetRows(1)
		Rs.Close
		Set Rs = Nothing
		Application.Lock
		Application(DEF_MasterCookies & "StatisticData") = SQL
		Application.UnLock
	Else
		Rs.Close
		Set Rs = Nothing
		con.ExeCute("insert into LeadBBS_SiteInfo(OnlineTime) Values(0)")
		GBL_DBNum = GBL_DBNum + 1

		SQL = "select top 1 OnlineTime,UserCount,MaxOnline,MaxolTime,PageCount,UploadNum,MaxAnnounce,MaxAncTime,YesterdayAnc from LeadBBS_SiteInfo"
		Set Rs = Con.Execute(SQL)
		GBL_DBNum = GBL_DBNum + 1
		SQL = Rs.GetRows(1)
		Rs.Close
		Set Rs = Nothing
		Application.Lock
		Application(DEF_MasterCookies & "StatisticData") = SQL
		Application.UnLock
	End If

End Sub

Sub UpdateStatisticDataInfo(Value,N,T)

	If isArray(Application(DEF_MasterCookies & "StatisticData")) = True Then
		Dim TmpArray
		TmpArray = Application(DEF_MasterCookies & "StatisticData")
		If T = 0 Then
			TmpArray(N,0) = Value
		Else
			TmpArray(N,0) = cCur(TmpArray(N,0)) + Value
		End If
		Application.Lock
		Application(DEF_MasterCookies & "StatisticData") = TmpArray
		Application.UnLock
	Else
		ReloadStatisticData
	End If

End Sub%>