<!-- #include file=../inc/BBSsetup.asp -->
<!-- #include file=../inc/Board_Popfun.asp -->
<!-- #include file=../inc/Limit_fun.asp -->
<%
DEF_BBS_HomeUrl = "../"
server.scriptTimeOut = 9999
initDatabase
GBL_CHK_TempStr = ""
siteHead("   删除帖子")

Dim DelID
%>
<script language=javascript>
	window.moveTo(window.screen.width/2-225,window.screen.height/2-18);
</script>
<%
UpdateOnlineUserAtInfo GBL_board_ID,"删除帖子"

If GBL_CHK_Flag=1 Then
	If CheckIsCanDellSure = 1 Then
		DisplayDelAnnounce
	End If
Else
	If Request("submitflag")="" Then
		Response.Write "<br><b>请先登录</b>"
	Else
		Response.Write "<br><p align=left><font color=ff0000 class=RedFont><b>" & GBL_CHK_TempStr & "</b></font>"
	End If
	Response.Write "</p>"
End If

closeDataBase
SiteBottom_Spend

Function CheckIsCanDellSure

	If GetBinarybit(GBL_CHK_UserLimit,5) = 1 Then
		Response.Write "你已经被" & LimitUserStringData(4) & "!<br>" & VbCrLf
		CheckIsCanDellSure = 0
		Exit Function
	End If
	DelID = Left(Request("DelID"),14)
	If isNumeric(DelID) = 0 or inStr(DelID,",") > 0 or DelID = "" Then
		Response.Write "错误,要删除的帖子不存在!<br>" & VbCrLf
		CheckIsCanDellSure = 0
		Exit Function
	End if

	If GBL_CHK_LastWriteTime < DEF_WriteEventSpace Then
		Response.Write "<b><font color=Red Class=RedFont>您的操作太频，请稍候再作提交!</font></b> <br>" & VbCrLf
		CheckIsCanDellSure = 0
		Exit Function
	End If

	DelID = cCur(DelID)
	Dim Rs,SQL
	SQL = "Select top 1 BoardID,ParentID,UserID,RootID from LeadBBS_Announce where id=" & DelID
	Set Rs = Con.ExeCute(SQL)
	GBL_DBNum = GBL_DBNum + 1
	If Rs.Eof Then
		Response.Write "错误,要删除的帖子不存在!<br>" & VbCrLf
		Rs.Close
		Set Rs = Nothing
		CheckIsCanDellSure = 0
		Exit Function
	End if

	GBL_Board_ID = cCur(Rs("BoardID"))
	Rs.Close
	Set Rs = Nothing

	Dim Temp
	Temp = Application(DEF_MasterCookies & "BoardInfo" & GBL_Board_ID)
	If isArray(Temp) = False Then
		ReloadBoardInfo(GBL_Board_ID)
		Temp = Application(DEF_MasterCookies & "BoardInfo" & GBL_Board_ID)
	End If
	If isArray(Temp) = False Then
		Response.Write "错误论坛发生错误,请联系管理员!<br>" & VbCrLf
		CheckIsCanDellSure = 0
		Set Rs = Nothing
	End If
	GBL_Board_MasterList = Temp(10,0)
	GBL_Board_BoardLimit = Temp(9,0)
	If GetBinarybit(GBL_Board_BoardLimit,5) = 1 Then
		Response.Write "此版面不允许删除帖子."
		CheckIsCanDellSure = 0
		Exit Function
	End If

	CheckisBoardMaster
	If GBL_UserID >= 1 and GBL_BoardMasterFlag >= 5 Then
		CheckIsCanDellSure = 1
	Else
		CheckIsCanDellSure = 0
		Response.Write "错误,权限不足."
	End If

End Function

Function DisplayDelAnnounce

	Dim AnnounceTitle
	Dim Rs,SQL
	SQL = "Select top 1 BoardID,ParentID,UserID,RootID,Layer,TopicType,ndatetime,GoodFlag,RootIDBak,Title,GoodAssort from LeadBBS_Announce where id=" & DelID
	Set Rs = Con.ExeCute(SQL)
	GBL_DBNum = GBL_DBNum + 1
	If Rs.Eof Then
		Response.Write "错误,要删除的帖子ID不存在!<br>" & VbCrLf
		Rs.Close
		Set Rs = Nothing
		Exit Function
	End if

	Dim BoardID,ParentID,UserID,RootID,Layer,TopicType,ndatetime,GoodFlag,RootIDBak,GoodAssort
	BoardID = cCur(Rs("BoardID"))
	ParentID = cCur(Rs("ParentID"))
	UserID = cCur(Rs("UserID"))
	RootID = cCur(Rs("RootID"))
	Layer = cCur(Rs("Layer"))
	TopicType = Rs("TopicType")
	ndatetime = RestoreTime(Rs("ndatetime"))
	If IsNull(TopicType) Then TopicType = 0
	GoodFlag = Rs("GoodFlag")
	RootIDBak = cCur(Rs("RootIDBak"))
	AnnounceTitle = Replace(htmlencode(Rs("Title")),"\","\\")
	GoodAssort = cCur(Rs("GoodAssort"))

	If ParentID = 0 Then
		GBL_CHK_TempStr = "<b><font color=ff0000 class=RedFont>删除的帖子是主题帖,将删除主题帖和所有回复帖！</font></b><br>"
	Else
		GBL_CHK_TempStr = "将删除的帖子是个回复帖子．<br>"		
	End If
	
	Rs.Close
	Set Rs = Nothing

	Dim RootIDTopicType
	If ParentID > 0 Then
		SQL = "Select top 1 TopicType from LeadBBS_Topic where ID=" & RootIDBak
		Set Rs = Con.ExeCute(SQL)
		GBL_DBNum = GBL_DBNum + 1
		If Not Rs.Eof Then
			RootIDTopicType = Rs(0)
			If isNull(RootIDTopicType) Then RootIDTopicType = 0
		Else
			RootIDTopicType = 0
		End If
		Rs.Close
		Set Rs = Nothing
	Else
		RootIDTopicType = 0
	End If
	
	Dim todayAnnounce,GoodNum,GoodNum2
	todayAnnounce = 0
	
	If Day(ndatetime) = Day(DEF_Now) and Year(ndatetime) = year(DEF_Now) and Month(ndatetime) = Month(DEF_Now) Then todayAnnounce = 1
	If GoodFlag = 1 Then
		GoodNum = 1
	Else
		GoodNum = 0
	End If
	GoodNum2 = 0
	
	If GBL_Board_ID <> 444 and DEF_EnableDelAnnounce = 0 and ParentID = 0 Then
		Response.Write "系统已经禁止直接删除主题帖子，请使用回收站功能。"
		Exit Function
	End If
	Dim DelPoints
	If Request.Form("DeleteSureFlag")="dk9@dl9s92lw_SWxl" Then
		If ParentID > 0 Then
			DelPoints = DEF_BBS_AnnouncePoints
			If GoodFlag = 1 Then DelPoints = DelPoints + DEF_BBS_MakeGoodAnnouncePoints
			Con.ExeCute("Delete from LeadBBS_Announce where id=" & DelID)
			GBL_DBNum = GBL_DBNum + 1

			Dim TmpMaxID,TmpMinID
			SQL = "select max(ID) from LeadBBS_Announce where RootIDBak=" & RootIDBak
			Set Rs = Con.ExeCute(SQL)
			GBL_DBNum = GBL_DBNum + 1
			If Rs.Eof Then
				TmpMaxID = 0
			Else
				TmpMaxID = Rs(0)
				If isNull(TmpMaxID) then TmpMaxID = 0
			End If
			Rs.Close
			Set Rs = Nothing
			SQL = "select min(ID) from LeadBBS_Announce where RootIDBak=" & RootIDBak
			Set Rs = Con.ExeCute(SQL)
			GBL_DBNum = GBL_DBNum + 1
			If Rs.Eof Then
				TmpMinID = 0
			Else
				TmpMinID = Rs(0)
				If isNull(TmpMinID) then TmpMinID = 0
			End If
			Rs.Close
			Set Rs = Nothing
			If ParentID = 0 Then
				UpdateBoardAnnounceNum Application(DEF_MasterCookies & "BoardInfo" & BoardID)(28,0),-1,-1,0-todayAnnounce,0-GoodNum
			Else
				SQL = "Select top 1 ID,ndatetime,UserName,ParentID from LeadBBS_Announce where id=" & TmpMaxID
				Set Rs = Con.ExeCute(SQL)
				GBL_DBNum = GBL_DBNum + 1
				Dim LastTime,LastUser
				If Not Rs.Eof Then
					LastTime = Rs("ndatetime")
					If cCur(Rs("ParentID")) = 0 Then
						LastUser = ""
					Else
						LastUser = Rs("UserName")
					End If
				Else
					LastTime = GetTimeValue(DEF_Now)
				End If
				Rs.Close
				Set Rs = Nothing
				UpdateBoardAnnounceNum Application(DEF_MasterCookies & "BoardInfo" & BoardID)(28,0),0,-1,0-todayAnnounce,0-GoodNum
				If Layer>2 Then
					Con.ExeCute("  Update LeadBBS_Announce Set ChildNum=ChildNum-1,LastTime=" & LastTime & ",LastUser='" & Replace(LastUser,"'","''") & "',LastInfo='' where ID=" & RootIDBak)
					GBL_DBNum = GBL_DBNum + 1
					Con.ExeCute("  Update LeadBBS_Topic Set ChildNum=ChildNum-1,LastTime=" & LastTime & ",LastUser='" & Replace(LastUser,"'","''") & "',LastInfo='' where ID=" & RootIDBak)
					GBL_DBNum = GBL_DBNum + 1
					Con.ExeCute(" Update LeadBBS_Announce Set ChildNum=ChildNum-1,LastTime=" & LastTime & ",LastUser='" & Replace(LastUser,"'","''") & "' where id=" & ParentID)
					GBL_DBNum = GBL_DBNum + 1
					Con.ExeCute(" Update LeadBBS_Topic Set ChildNum=ChildNum-1,LastTime=" & LastTime & ",LastUser='" & Replace(LastUser,"'","''") & "' where id=" & ParentID)
					GBL_DBNum = GBL_DBNum + 1
				Else
					Con.ExeCute(" Update LeadBBS_Announce Set ChildNum=ChildNum-1,LastTime=" & LastTime & ",LastUser='" & Replace(LastUser,"'","''") & "',LastInfo='' where id=" & RootIDBak)
					GBL_DBNum = GBL_DBNum + 1
					Con.ExeCute(" Update LeadBBS_Topic Set ChildNum=ChildNum-1,LastTime=" & LastTime & ",LastUser='" & Replace(LastUser,"'","''") & "',LastInfo='' where id=" & RootIDBak)
					GBL_DBNum = GBL_DBNum + 1
				End If
			End If
                                    '控制删帖扣分
                                    If DEF_BBS_PrizeAnnouncePoints = 0 then DelPoints = 0
			Con.ExeCute(" Update LeadBBS_User set Points=Points-" & DelPoints & ",AnnounceNum=AnnounceNum-1,AnnounceGood=AnnounceGood-" & GoodNum & " Where ID =" & UserID)
			GBL_DBNum = GBL_DBNum + 1
			Response.Write "成功删除论坛帖子"
			UpdateBoardValue(BoardID)
			Rem 更新MaxRootID
			
			SQL = "Update LeadBBS_Announce set RootMaxID=" & TmpMaxID & _
					",RootMinID=" & TmpMinID &_
					" where ID=" & RootIDBak
			Con.Execute(SQL)
			GBL_DBNum = GBL_DBNum + 1
			
			SQL = "Update LeadBBS_Topic set RootMaxID=" & TmpMaxID & _
					",RootMinID=" & TmpMinID &_
					" where ID=" & RootIDBak
			Con.Execute(SQL)
			GBL_DBNum = GBL_DBNum + 1
		Else
			Server.ScriptTimeOut = 65535
			Dim LoopFlag,NowID,GetData,N
			LoopFlag = 1
			NowID = 0
			
			GoodNum2 = 0
			Dim TmpTopicNum,TmpAnnounceNum,GoodNum3
			TmpAnnounceNum = 0
			TmpTopicNum = 0
			todayAnnounce = 0
			DelPoints = 0
			Do While LoopFlag = 1
				Rem 主题帖留着最后删除，以免删除中央意外中止，导致主题损坏

				SQL = "Select top 100 ID,BoardID,ParentID,UserID,ndatetime,GoodFlag from LeadBBS_Announce where RootIDBak=" & RootIDBak & " and id>" & NowID & " order by ID"
				Set Rs = Con.ExeCute(SQL)
				GBL_DBNum = GBL_DBNum + 1
				If Not Rs.Eof Then
					GetData = Rs.GetRows(100)
					Rs.Close
					Set Rs = Nothing
					SQL = Ubound(GetData,2)
					For N = 0 to SQL
						If GetData(5,n) = 1 Then
							GoodNum2 = GoodNum2 + 1
							GoodNum3 = 1
							DelPoints = DEF_BBS_MakeGoodAnnouncePoints
						Else
							GoodNum3 = 0
							DelPoints = 0
						End If
						If cCur(GetData(2,N)) = 0 Then
							TmpAnnounceNum = TmpAnnounceNum + 1
							TmpTopicNum = TmpTopicNum + 1
							DelPoints = DelPoints + DEF_BBS_AnnouncePoints * 2
						Else
							TmpAnnounceNum = TmpAnnounceNum + 1
							DelPoints = DelPoints + DEF_BBS_AnnouncePoints
						End If
						GetData(4,n) = RestoreTime(GetData(4,n))
						If Day(GetData(4,n)) = Day(DEF_Now) and Year(GetData(4,n)) = year(DEF_Now) and Month(GetData(4,n)) = Month(DEF_Now) Then todayAnnounce = todayAnnounce + 1
                                    '控制删帖扣分
                                    If DEF_BBS_PrizeAnnouncePoints = 0 then DelPoints = 0
						If cCur(GetData(2,N)) = 0 Then
							Con.ExeCute(" Update LeadBBS_User set Points=Points-" & DelPoints & ",AnnounceNum=AnnounceNum-1,AnnounceTopic=AnnounceTopic-1,AnnounceGood=AnnounceGood-" & GoodNum3 & " Where ID =" & GetData(3,N))
							GBL_DBNum = GBL_DBNum + 1
						Else
							Con.ExeCute(" Update LeadBBS_User set Points=Points-" & DelPoints & ",AnnounceNum=AnnounceNum-1,AnnounceGood=AnnounceGood-" & GoodNum3 & " Where ID =" & GetData(3,N))
							GBL_DBNum = GBL_DBNum + 1
						End If
						NowID = cCur(GetData(0,N))
					Next
					Con.ExeCute("Delete from LeadBBS_Announce where RootIDBak=" & RootIDBak & " and id<=" & NowID)
					GBL_DBNum = GBL_DBNum + 1
				Else
					LoopFlag = 0
					Rs.Close
					Set Rs = Nothing
				End If
			Loop
			Con.ExeCute("Delete from LeadBBS_Topic where ID=" & RootIDBak)

			Response.Write "成功删除所有回复帖子！"
			If TopicType = 80 or TopicType = 54 Then
				Con.ExeCute("Delete from LeadBBS_VoteUser Where AnnounceID=" & DelID)
				GBL_DBNum = GBL_DBNum + 1
				If TopicType = 80 Then
					Con.ExeCute("Delete from LeadBBS_VoteItem Where AnnounceID=" & DelID)
					GBL_DBNum = GBL_DBNum + 1
				End if
			End If
			UpdateBoardAnnounceNum Application(DEF_MasterCookies & "BoardInfo" & BoardID)(28,0),0-TmpTopicNum,0-TmpAnnounceNum,0-todayAnnounce,0-GoodNum2

			UpdateBoardValue(BoardID)
			Response.Write "<br>成功删除论坛主题帖子"
			If GoodAssort > 0 Then ChangeGoodAssort GoodAssort,0
		End If
		If CheckSupervisorUserName = 0 Then
			Con.ExeCute("Update LeadBBS_User Set LastWriteTime=" & GetTimeValue(DEF_Now) & " where ID=" & GBL_UserID)
			GBL_DBNum = GBL_DBNum + 1
			UpdateSessionValue 13,GetTimeValue(DEF_Now),0
		End If
		Con.ExeCute("insert into LeadBBS_Log(LogType,LogTime,LogInfo,UserName,IP,BoardID) Values(101," & GetTimeValue(DEF_Now) & ",'" & Left("成功删除版面编号" & BoardID & "，帖子编号" & DelID & "，作者编号" & UserID & "的帖子．标题内容：" & Replace(AnnounceTitle,"'","''"),255) & "','" & Replace(GBL_CHK_User,"'","''") & "','" & Replace(GBL_IPAddress,"'","''") & "'," & GBL_Board_ID & ")")
		GBL_DBNum = GBL_DBNum + 1
	Else
		%>
		<form name=DellClientForm action=DelAnnounce.asp method=post>
			<input type=hidden name=DeleteSureFlag value="dk9@dl9s92lw_SWxl">
			<input type=hidden name=BoardID value="<%=GBL_Board_ID%>">
			<input type=hidden name=DelID value="<%=DelID%>"><%=GBL_CHK_TempStr%>
			<b>确认要删除编号为<font color=ff0000 class=RedFont><%=DelID%></font>的帖子吗？</b>
			<p><input type=submit value=确定 class=fmbtn>
			<input type=button value=改变主意留着不删 onclick="javascript:window.close();" class=fmbtn>
		</form>
		<%
	End If
	Set Rs = Nothing

End Function

Function UpdateBoardValue(BoardID)

	Dim Rs,SQL
	Dim N,AllMinRootID,AllMaxRootID		
	Set Rs = Con.ExeCute("select Min(RootID) from LeadBBS_Topic where BoardID=" & BoardID)
	GBL_DBNum = GBL_DBNum + 1
	If Rs.Eof Then
		AllMinRootID = 0
	Else
		AllMinRootID = Rs(0)
		If isNull(AllMinRootID) Then AllMinRootID = 0
		AllMinRootID = cCur(AllMinRootID)
	End If
	Rs.Close

	Set Rs = Con.ExeCute("select Max(RootID) from LeadBBS_Topic where BoardID=" & BoardID)
	GBL_DBNum = GBL_DBNum + 1
	If Rs.Eof Then
		AllMaxRootID = 0
	Else
		AllMaxRootID = Rs(0)
		If isNull(AllMaxRootID) Then AllMaxRootID = 0
		AllMaxRootID = cCur(AllMaxRootID)
	End If
	Rs.Close
	Set Rs = Nothing
	
	Dim LastAnnounceID,LastTopicName,LastWriter,LastTime
	Set Rs = Con.ExeCute("Select top 1 ID,title,LastUser,UserName,LastTime,TitleStyle from LeadBBS_Topic where BoardID=" & BoardID & " and RootID<" & DEF_BBS_TOPMinID & " order By RootID DESC")
	GBL_DBNum = GBL_DBNum + 1
	If Rs.Eof Then
		LastAnnounceID = 0
		LastTopicName = ""
		LastTime = 0
		LastWriter = ""
	Else
		LastAnnounceID = Rs(0)
		LastTopicName = Rs(1)
		LastWriter = Rs(2)
		If LastWriter = "" or isNull(LastWriter) Then LastWriter = Rs(3)
		LastTime = cCur(Rs(4))
		If isNull(LastTime) then LastTime = 0
		If Rs(5) = 1 Then LastTopicName = KillHTMLLabel(LastTopicName)
	End If
	Rs.Close
	Set Rs = Nothing
	UpdateBoardApplicationInfo BoardID,LastWriter,3
	UpdateBoardApplicationInfo BoardID,LastTime,4
	UpdateBoardApplicationInfo BoardID,LastAnnounceID,19
	UpdateBoardApplicationInfo BoardID,LastTopicName,20
	UpdateBoardApplicationInfo BoardID,0,33
	UpdateBoardApplicationInfo BoardID,0,34
	Con.ExeCute ("Update LeadBBS_Boards Set AllMinRootID=" & AllMinRootID & ",AllMaxRootID=" & AllMaxRootID & ",LastAnnounceID=" & LastAnnounceID & ",LastTopicName='" & Replace(LastTopicName,"'","''") & "',LastWriter='" & Replace(LastWriter,"'","''") & "',LastWriteTime=" & LastTime & " where boardID=" & BoardID)
	GBL_DBNum = GBL_DBNum + 1
	'ReloadBoardInfo(BoardID)
	'If isArray(application(DEF_MasterCookies & "TopAnc")) Then ReloadTopAnnounceInfo(0)
	If inStr(application(DEF_MasterCookies & "TopAncList"),"," & DelID & ",") Then ReloadTopAnnounceInfo(0)
	If inStr(application(DEF_MasterCookies & "TopAncList" & GBL_Board_BoardAssort),"," & DelID & ",") Then ReloadTopAnnounceInfo(GBL_Board_BoardAssort)

End Function

Function UpdateBoardAnnounceNum(BoardList,TopicNum,AnnounceNum,TodayAnnounce,GoodNum)

	Dim SQL,N
	If BoardList = "" or (TopicNum = 0 and AnnounceNum = 0 and TodayAnnounce = 0 and GoodNum = 0) Then Exit Function
	SQL = "Update LeadBBS_Boards Set AnnounceNum=AnnounceNum+" & AnnounceNum & ",AnnounceNum_All=AnnounceNum_All+" & AnnounceNum
	If TopicNum <> 0 Then SQL = SQL & ",TopicNum=TopicNum+" & TopicNum
	If TopicNum <> 0 Then SQL = SQL & ",TopicNum_All=TopicNum_All+" & TopicNum
	If TodayAnnounce <> 0 Then  SQL = SQL & ",TodayAnnounce=TodayAnnounce+" & TodayAnnounce
	If TodayAnnounce <> 0 Then  SQL = SQL & ",TodayAnnounce_All=TodayAnnounce_All+" & TodayAnnounce
	If GoodNum <> 0 Then  SQL = SQL & ",GoodNum=GoodNum+" & GoodNum
	If GoodNum <> 0 Then  SQL = SQL & ",GoodNum_All=GoodNum_All+" & GoodNum
	SQL = SQL & " where BoardID in(" & BoardList & ")"
	Con.ExeCute(SQL)
	GBL_DBNum = GBL_DBNum + 1
	BoardList = Split(BoardList,",")
	SQL = Ubound(BoardList,1)
	Dim Temp
	For N = 0 To SQL
		Temp = Application(DEF_MasterCookies & "BoardInfo" & BoardList(N))
		If isArray(Temp) = False Then
			ReloadBoardInfo(BoardList(N))
			Temp = Application(DEF_MasterCookies & "BoardInfo" & BoardList(N))
		End If
		If isArray(Temp) = True Then
			If TopicNum <> 0 Then
				UpdateBoardApplicationInfo BoardList(N),cCur(Temp(5,0))+TopicNum,5
				UpdateBoardApplicationInfo BoardList(N),cCur(Temp(29,0))+TopicNum,29
			End If
			If AnnounceNum <> 0 Then
				UpdateBoardApplicationInfo BoardList(N),cCur(Temp(6,0))+AnnounceNum,6
				UpdateBoardApplicationInfo BoardList(N),cCur(Temp(30,0))+AnnounceNum,30
			End If
			If TodayAnnounce <> 0 Then
				UpdateBoardApplicationInfo BoardList(N),cCur(Temp(18,0))+TodayAnnounce,18
				UpdateBoardApplicationInfo BoardList(N),cCur(Temp(31,0))+TodayAnnounce,31
			End If
			If GoodNum <> 0 Then
				UpdateBoardApplicationInfo BoardList(N),cCur(Temp(13,0))+GoodNum,13
				UpdateBoardApplicationInfo BoardList(N),cCur(Temp(32,0))+GoodNum,32
			End If
		End If
	Next
	'28,T1.ParentBoardStr,29.TopicNum_All,30.AnnounceNum_All,31.TodayAnnounce_All,32.GoodNum_All

End Function

Sub ChangeGoodAssort(ID,ID2)

	If ID = ID2 Then Exit Sub
	Dim TArray,N,Num,NN,ExitN
	TArray = Application(DEF_MasterCookies & "BoardInfo" & GBL_Board_ID & "_TI")
	If isArray(TArray) = False Then
		CheckGoodAssort = 0
		Exit Sub
	End If
	Num = Ubound(TArray,2)
	NN = 0
	ExitN = 2
	If ID = 0 or ID2 = 0 Then ExitN = 1
	For N = 0 To Num
		If ID = cCur(TArray(0,N)) Then
			If cCur(TArray(2,N)) <> 0 Then
				If cCur(TArray(2,N)) = -1 Then
				Else
					TArray(2,N) = cCur(TArray(2,N)) - 1
					TArray(3,N) = 0
					TArray(4,N) = 0
				End If
			End If
			NN = NN + 1
			If NN >= 2 Then Exit For
		End If
		If ID2 = cCur(TArray(0,N)) Then
			If cCur(TArray(2,N)) <> 0 Then
				If cCur(TArray(2,N)) = -1 Then
					TArray(2,N) = 1
				Else
					TArray(2,N) = cCur(TArray(2,N)) + 1
					TArray(3,N) = 0
					TArray(4,N) = 0
				End If
			End If
			TArray(2,N) = 0
			NN = NN + 1
			If NN >= ExitN Then Exit For
		End If
	Next
	If NN > 0 Then
		Application.Lock
		Application(DEF_MasterCookies & "BoardInfo" & GBL_board_ID & "_TI") = TArray
		Application.UnLock
	End If

End Sub

Sub ReloadTopAnnounceInfo(TID)

	If isNumeric(TID) = 0 Then Exit Sub
	TID = Fix(cCur(TID))
	Dim Rs,GetDataTop,TIDStr
	If TID = 0 Then
		TIDStr = ""
	Else
		TIDStr = TID
	End If
	Set Rs = Con.ExeCute("Select RootID,BoardID from LeadBBS_TopAnnounce where TopType=" & TID)
	GBL_DBNum = GBL_DBNum + 1
	If Rs.Eof Then
		Application.Lock
		application(DEF_MasterCookies & "TopAnc" & TIDStr) = "yes"
		application(DEF_MasterCookies & "TopAncList" & TIDStr) = ""
		Application.UnLock
		Rs.Close
		Set Rs = Nothing
		Exit Sub
	Else
		GetDataTop = Rs.GetRows(-1)
		Rs.close
		Set Rs = Nothing
	End If
	
	Dim Temp,N
	Temp = ""
	If cCur(GetDataTop(0,0)) > 0 Then Temp = GetDataTop(0,0)
	For N = 1 to Ubound(GetDataTop,2)
		If cCur(GetDataTop(0,N)) > 0 Then Temp = Temp & "," & GetDataTop(0,N)
	Next
	If Left(Temp,1) = "," Then Temp = Mid(Temp,2)
	If cStr(Temp) <> "" Then
		Set Rs = Con.ExeCute("select top " & Ubound(GetDataTop,2)+1 & " id,ChildNum,Title,FaceIcon,LastTime,Hits,Length,UserName,UserID,RootID,LastUser,NotReplay,GoodFlag,BoardID,TopicType,PollNum,TitleStyle,LastInfo,ndatetime,GoodAssort from LeadBBS_Topic where ID in(" & Temp & ")")
		GBL_DBNum = GBL_DBNum + 1
		If Not Rs.Eof Then
			GetDataTop = Rs.GetRows(-1)
			Rs.Close
			Set Rs = Nothing
			Application.Lock
			application(DEF_MasterCookies & "TopAnc" & TIDStr) = GetDataTop
			Application.UnLock
			Application.Lock
			application(DEF_MasterCookies & "TopAncList" & TIDStr) = "," & Temp & ","
			Application.UnLock
		Else
			Rs.Close
			Set Rs = Nothing
			Application.Lock
			application(DEF_MasterCookies & "TopAnc" & TIDStr) = "yes"
			Application.UnLock
		End If
	Else
		Application.Lock
		application(DEF_MasterCookies & "TopAnc" & TIDStr) = "yes"
		Application.UnLock
	End If

End Sub%>