<!-- #include file=../../inc/BBSSetup.asp -->
<!-- #include file=../../inc/Board_Popfun.asp -->
<!-- #include file=../inc/bbsmanage_Fun.asp -->
<%
Server.ScriptTimeOut = 6000
DEF_BBS_HomeUrl = "../../"
initDatabase
GBL_CHK_TempStr = ""
checkSupervisorPass
'Response.End

If GBL_CHK_Flag = 0 or GBL_CHK_TempStr <> "" Then
	CloseDatabase
	Response.End
End If

If Request.Form("submitflag") <> "" Then
	GBL_Form_Day = Left(Request("GBL_Form_Day"),14)
	If isNumeric(GBL_Form_Day) = 0 Then GBL_Form_Day = 0
	GBL_Form_Day = Fix(cCur(GBL_Form_Day))
	GBL_Form_BoardID = Left(Request("BoardID2"),14)
	If isNumeric(GBL_Form_BoardID) = 0 Then GBL_Form_BoardID = 0
	GBL_Form_BoardID = Fix(cCur(GBL_Form_BoardID))
	
	If GBL_Form_Day < 7 or GBL_Form_Day > 9999 Then
		GBL_CHK_TempStr = "<p>错误的天数指定，要求值至少要求为7天前．"
	Else
		If GBL_Form_BoardID < 1 Then
			GBL_CHK_TempStr = "<p>错误的社区版面．"
		End If
	End If	
End If
	
If Request.Form("submitflag") = "" or GBL_CHK_TempStr <> "" Then
	Dim GBL_Form_Day,GBL_Form_BoardID
	SiteHead(DEF_SiteNameString & " - 管理员")
	UserTopicTopInfo
	DisplayUserNavigate("批量删除社区指定条件的历史数据")
	if GBL_CHK_TempStr <> "" Then
		Response.Write "<br><p align=left><font color=ff0000 class=RedFont><b>" & GBL_CHK_TempStr & "</b></font>"
		DisplayForm
	Else%>
		<table width=100%>
		<tr>
			<td>
				<br><%DisplayForm%>
			</td>
		</tr>
		</table>
		<%
	End If
	UserTopicBottomInfo
	SiteBottom
	If GBL_ShowBottomSure = 1 Then Response.Write GBL_SiteBottomString
Else
	If GBL_CHK_Flag = 1 and GBL_UserID > 0 and CheckSupervisorUserName = 1 Then
		if GBL_CHK_TempStr <> "" Then
			Response.Write "<br><p align=center><font color=ff0000 class=RedFont><b>" & GBL_CHK_TempStr & "</b></font>"
		Else
			DeleteExpiresAnnounceData
		End If
	End If
	closeDataBase
	SiteBottom_Spend
End If

Function DisplayForm
		%>
				<script LANGUAGE="JavaScript" TYPE="text/javascript">
				function submitonce(theform)
				{
					if (document.all||document.getElementById)
					{
						for (i=0;i<theform.length;i++)
						{
							var tempobj=theform.elements[i];
							if(tempobj.type.toLowerCase()=="submit"||tempobj.type.toLowerCase()=="reset")
							tempobj.disabled=true;
						}
					}
				}
				</script>
				<form name=LeadBBSFm action=DeleteExpiresAnnounceData.asp method=post onSubmit="submitonce(this);">
					<input type=hidden name=submitflag value="dk9@dl9s92lw_SWxl">
					<b>警告：</b><p>
					目前时间：<%=DEF_Now%> (最小要求７天前)<p>
					批量删除<input type=text value="<%=GBL_Form_Day%>" size=4 maxlength=4 name=GBL_Form_Day>天前的数据<p>
					<!-- #include file=../../inc/incHTM/BoardForMoveList.asp -->(一定要指定所要批量删除的版面)
					<p></b><font color=Red class=RedFont><b>社区数据删除后将无法恢复，一切操作不可逆！！<br>
					建议在删除前作好数据库备份，以防不测．确定要继续吗？</b><br>
					<p><input type=submit value=确定批量删除指定条件的社区数据 class=fmbtn>
				</form>
	<%
End Function

Function DeleteExpiresAnnounceData

	GBL_Form_Day = DateAdd("d",0-GBL_Form_Day,DEF_Now)
	Dim Flag2
	Dim Rs,SQL
	Dim NowID,EndFlag
	NowID = 0
	EndFlag = 0
	Response.Write "<p style=font-size:9pt>下需开始删除更新时间" & GBL_Form_Day & "前的旧社区帖子，程序将开始扫描并删除版面编号号为<font color=blue class=BlueFont>" & GBL_Form_BoardID & "</font>的符合条件的主题．．．"
	'Response.Write "<br>进度(需要时间可能会很长，请等待出现完成，■表示删除，□表示略过)："
	GBL_Form_Day = GetTimeValue(GBL_Form_Day)
	NowID = 0
	EndFlag = 0
	Dim GetData,N,DeleteNum
	DeleteNum = 0

	Dim RecordCount,CountIndex
	SQL = "Select count(*) from [LeadBBS_Topic] where BoardID=" & GBL_Form_BoardID
	Set Rs = Con.ExeCute(SQL)
	If Rs.Eof Then
		RecordCount = 0
	Else
		RecordCount = Rs(0)
		If isNull(RecordCount) Then RecordCount = 0
	End If
	Rs.Close
	Set Rs = Nothing
	If RecordCount < 1 Then RecordCount = 1
	CountIndex = 0
	%>
	<p style="font-size:9pt">下面扫描可删除的主题，共有<%=RecordCount%>个主题待扫描

	<table width="400" border="0" cellspacing="1" cellpadding="1">
		<tr> 
			<td bgcolor=000000>
	<table width="400" border="0" cellspacing="0" cellpadding="1">
		<tr> 
			<td bgcolor=ffffff height=9><img src=../../images/vote.gif width=0 height=16 id=img1 name=img1 align=absmiddle></td></tr></table>
	</td></tr></table> <span id=txt1 name=txt1 style="font-size:9pt">0</span><span style="font-size:9pt">%</span>
	<%
	Response.Flush
	Do while EndFlag = 0
		SQL = "Select top 100 RootID,LastTime,ID,GoodFlag from LeadBBS_Topic where BoardID=" & GBL_Form_BoardID & " and RootID>" & NowID & " order by RootID ASC"
		Set Rs = Con.ExeCute(SQL)
		GBL_DBNum = GBL_DBNum + 1
		If Rs.Eof Then
			EndFlag = 1
			Rs.Close
			Set Rs = Nothing
		Else
			GetData = Rs.GetRows(-1)
			Rs.Close
			Set Rs = Nothing
			SQL = Ubound(GetData,2)
			Flag2 = 0
			For N = 0 to SQL
				NowID = cCur(GetData(0,n))
				If cCur(GetData(1,n)) < GBL_Form_Day and (GetData(3,n) = 0 or GetData(3,n) = False) Then
					Flag2 = 1
					DelAnnounce(GetData(2,n))
					Con.ExeCute("delete from LeadBBS_Announce Where ID=" & GetData(2,n))
					Con.ExeCute("delete from LeadBBS_Topic Where ID=" & GetData(2,n))
					'Response.Write "■[" & GetData(1,n) & "]"
					Response.Flush
					DeleteNum = DeleteNum + 1
				Else
					'If (N mod 10) = 0 Then Response.Write "□"
					'EndFlag = 1
					'Exit For
				End If
				CountIndex = CountIndex + 1
				If (CountIndex mod 20) = 0 Then
					Response.Write "<script>img1.width=" & Fix((CountIndex/RecordCount) * 400) & ";" & VbCrLf
					Response.Write "txt1.innerHTML=""" & FormatNumber(CountIndex/RecordCount*100,4,-1) & """;" & VbCrLf
					Response.Write "img1.title=""(" & CountIndex & ")"";</script>" & VbCrLf
					Response.Flush
				End If
			Next
			'If Flag2 = 0 Then EndFlag = 1
			'Response.Write "[" & GetData(1,SQL) & "]"
			'Response.Flush
		End If
	Loop
	UpdateBoardValue(GBL_Form_BoardID)
	ReloadTopAnnounceInfo(0)
	Borad_GetBoardIDValue(GBL_Form_BoardID)
	ReloadTopAnnounceInfo(GBL_Board_BoardAssort)
	Set Rs = Nothing
	%>
	<script>img1.width=400;
	txt1.innerHTML="100";</script>
	共计<%=DeleteNum%>个主题帖子被删除
	<%

End Function
Function DelAnnounce(DelID)

	Dim Rs,SQL
	Set Rs = Server.CreateObject("ADODB.RecordSet")
	SQL = "Select top 1 BoardID,ParentID,UserID,RootID,Layer,TopicType,ndatetime,GoodFlag,RootIDBak from LeadBBS_Announce where id=" & DelID
	Rs.Open SQL,con,1,1
	If Rs.Eof Then
		Rs.Close
		Set Rs = Nothing
		Exit Function
	End if

	Dim BoardID,ParentID,UserID,RootID,Layer,TopicType,ndatetime,GoodFlag,RootIDBak
	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 isTrueDate(ndatetime) = 0 Then ndatetime = DEF_Now
	If IsNull(TopicType) Then TopicType = 0
	GoodFlag = Rs("GoodFlag")
	RootIDBak = cCur(Rs("RootIDBak"))

	Rs.Close
	
	Dim RootIDTopicType
	If ParentID > 0 Then
		SQL = "Select top 1 TopicType from LeadBBS_Announce where ID=" & RootIDBak
		Rs.Open SQL,con,1,1
		If Not Rs.Eof Then
			RootIDTopicType = Rs(0)
			If isNull(RootIDTopicType) Then RootIDTopicType = 0
		Else
			RootIDTopicType = 0
		End If
		Rs.Close
	Else
		RootIDTopicType = 0
	End If
	
	Dim todayAnnounce,GoodNum,GoodNum2
	todayAnnounce = 0
	
	If Day(ndatetime) = Day(now) and Year(ndatetime) = year(now) and Month(ndatetime) = Month(now) Then todayAnnounce = 1
	If GoodFlag = 1 Then
		GoodNum = 1
	Else
		GoodNum = 0
	End If
	GoodNum2 = 0

		If ParentID > 0 Then
			Con.ExeCute("Delete from LeadBBS_Announce where id=" & DelID)

			Dim TmpMaxID,TmpMinID
			SQL = "select max(ID) from LeadBBS_Announce where RootIDBak=" & RootIDBak
			Rs.Open SQL,con,1,1
			If Rs.Eof Then
				TmpMaxID = 0
			Else
				TmpMaxID = Rs(0)
				If isNull(TmpMaxID) then TmpMaxID = 0
			End If
			Rs.Close
			SQL = "select min(ID) from LeadBBS_Announce where RootIDBak=" & RootIDBak
			Rs.Open SQL,con,1,1
			If Rs.Eof Then
				TmpMinID = 0
			Else
				TmpMinID = Rs(0)
				If isNull(TmpMinID) then TmpMinID = 0
			End If
			Rs.Close
			If ParentID = 0 Then
				Con.ExeCute("Update LeadBBS_Boards Set TopicNum=TopicNum-1,AnnounceNum=AnnounceNum-1,todayAnnounce=todayAnnounce-" & todayAnnounce & ",GoodNum=GoodNum-" & GoodNum & " where BoardID=" & BoardID)
			Else
				SQL = "Select top 1 ID,ndatetime,UserName,ParentID from LeadBBS_Announce where id=" & TmpMaxID
				Rs.Open SQL,con,1,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(now)
				End If
				Rs.Close
				Con.ExeCute("Update LeadBBS_Boards Set AnnounceNum=AnnounceNum-1,todayAnnounce=todayAnnounce-" & todayAnnounce & ",GoodNum=GoodNum-" & GoodNum & " where BoardID=" & BoardID)
				If Layer>2 Then
					Con.ExeCute("  Update LeadBBS_Announce Set ChildNum=ChildNum-1,LastTime=" & LastTime & ",LastUser='" & Replace(LastUser,"'","''") & "' where ID=" & RootIDBak)
					Con.ExeCute("  Update LeadBBS_Topic Set ChildNum=ChildNum-1,LastTime=" & LastTime & ",LastUser='" & Replace(LastUser,"'","''") & "' where ID=" & RootIDBak)
					Con.ExeCute(" Update LeadBBS_Announce Set ChildNum=ChildNum-1,LastTime=" & LastTime & ",LastUser='" & Replace(LastUser,"'","''") & "' where id=" & ParentID)
				Else
					Con.ExeCute(" Update LeadBBS_Announce Set ChildNum=ChildNum-1,LastTime=" & LastTime & ",LastUser='" & Replace(LastUser,"'","''") & "' where id=" & ParentID)
					Con.ExeCute(" Update LeadBBS_Topic Set ChildNum=ChildNum-1,LastTime=" & LastTime & ",LastUser='" & Replace(LastUser,"'","''") & "' where id=" & ParentID)
				End If				
			End If
			'Con.ExeCute(" Update LeadBBS_User set Points=Points-" & DEF_BBS_DelAnnouncePoints & ",AnnounceNum=AnnounceNum-1,AnnounceGood=AnnounceGood-" & GoodNum & " Where ID =" & UserID)
			Con.ExeCute(" Update LeadBBS_User set AnnounceNum=AnnounceNum-1,AnnounceGood=AnnounceGood-" & GoodNum & " Where ID =" & UserID)
			'UpdateBoardValue(BoardID)
			Rem 更新MaxRootID
	
			SQL = "Update LeadBBS_Announce set RootMaxID=" & TmpMaxID & _
					",RootMinID=" & TmpMinID &_
					" where ID=" & RootIDBak
			Con.Execute(SQL)
			SQL = "Update LeadBBS_Topic set RootMaxID=" & TmpMaxID & _
					",RootMinID=" & TmpMinID &_
					" where ID=" & RootIDBak
			Con.Execute(SQL)
		Else
			Dim LoopFlag,NowID,GetData,N
			LoopFlag = 1
			NowID = 0
			
			GoodNum2 = 0
			Dim TmpTopicNum,TmpAnnounceNum,GoodNum3
			TmpAnnounceNum = 0
			TmpTopicNum = 0
			todayAnnounce = 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"
				Rs.Open SQL,con,1,1
				If Not Rs.Eof Then
					GetData = Rs.GetRows(100)
					Rs.Close
					SQL = Ubound(GetData,2)
					For N = 0 to SQL
						If GetData(5,n) = 1 Then
							GoodNum2 = GoodNum2 + 1
							GoodNum3 = 1
						Else
							GoodNum3 = 0
						End If
						If cCur(GetData(2,N)) = 0 Then
							TmpAnnounceNum = TmpAnnounceNum + 1
							TmpTopicNum = TmpTopicNum + 1
						Else
							TmpAnnounceNum = TmpAnnounceNum + 1
						End If
						GetData(4,n) = RestoreTime(GetData(4,n))
						If Day(GetData(4,n)) = Day(now) and Year(GetData(4,n)) = year(now) and Month(GetData(4,n)) = Month(now) Then todayAnnounce = todayAnnounce + 1
						If cCur(GetData(2,N)) = 0 Then
							'Con.ExeCute(" Update LeadBBS_User set Points=Points-" & DEF_BBS_DelAnnouncePoints & ",AnnounceNum=AnnounceNum-1,AnnounceTopic=AnnounceTopic-1,AnnounceGood=AnnounceGood-" & GoodNum3 & " Where ID =" & GetData(3,N))
							Con.ExeCute(" Update LeadBBS_User set AnnounceNum=AnnounceNum-1,AnnounceTopic=AnnounceTopic-1,AnnounceGood=AnnounceGood-" & GoodNum3 & " Where ID =" & GetData(3,N))
						Else
							'Con.ExeCute(" Update LeadBBS_User set Points=Points-" & DEF_BBS_DelAnnouncePoints & ",AnnounceNum=AnnounceNum-1,AnnounceGood=AnnounceGood-" & GoodNum3 & " Where ID =" & GetData(3,N))
							Con.ExeCute(" Update LeadBBS_User set AnnounceNum=AnnounceNum-1,AnnounceGood=AnnounceGood-" & GoodNum3 & " Where ID =" & GetData(3,N))
						End If
						NowID = cCur(GetData(0,N))
					Next
					Con.ExeCute("Delete from LeadBBS_Announce where RootIDBak=" & RootIDBak & " and id<=" & NowID)
				Else
					LoopFlag = 0
					Rs.Close
				End If
			Loop

			Con.ExeCute("Delete from LeadBBS_Topic where ID=" & DelID)
			If TopicType = 80 or TopicType = 54 Then
				Con.ExeCute("Delete from LeadBBS_VoteUser Where AnnounceID=" & DelID)
				If TopicType = 80 Then
					Con.ExeCute("Delete from LeadBBS_VoteItem Where AnnounceID=" & DelID)
				End If
			End If
			Con.ExeCute("Update LeadBBS_Boards Set TopicNum=TopicNum-" & TmpTopicNum & ",AnnounceNum=AnnounceNum-" & TmpAnnounceNum & ",todayAnnounce=todayAnnounce-" & todayAnnounce & ",GoodNum=GoodNum-" & GoodNum2 & " where BoardID=" & BoardID)

			'UpdateBoardValue(BoardID)
		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 = Nothing
	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
	Set Rs = Con.ExeCute("Select top 1 ID,title,LastUser,UserName 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 = ""
	Else
		LastAnnounceID = Rs(0)
		LastTopicName = Rs(1)
		LastWriter = Rs(2)
		If LastWriter = "" or isNull(LastWriter) Then LastWriter = Rs(3)
	End If
	Rs.Close
	Set Rs = Nothing
	Con.ExeCute ("Update LeadBBS_Boards Set AllMinRootID=" & AllMinRootID & ",AllMaxRootID=" & AllMaxRootID & ",LastAnnounceID=" & LastAnnounceID & ",LastTopicName='" & Replace(LastTopicName,"'","''") & "',LastWriter='" & Replace(LastWriter,"'","''") & "' where boardID=" & BoardID)
	GBL_DBNum = GBL_DBNum + 1
	ReloadBoardInfo(BoardID)
	ReloadTopicAssort(BoardID)

End Function

Sub ReloadTopicAssort(BoardID)

	Dim Rs
	Set Rs = Con.ExeCute("select ID,AssortName,0,0,0 from LeadBBS_GoodAssort where BoardID=" & BoardID & " Order by BoardID,OrderID")
	If Not Rs.Eof Then
		Application.Lock
		Application(DEF_MasterCookies & "BoardInfo" & BoardID & "_TI") = Rs.GetRows(-1)
		Application.UnLock
	Else
		Application.Lock
		Set Application(DEF_MasterCookies & "BoardInfo" & BoardID & "_TI") = Nothing
		Application(DEF_MasterCookies & "BoardInfo" & BoardID & "_TI") = "yes"
		Application.UnLock
	End If
	Rs.Close
	Set Rs = Nothing

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%>