<!-- #include file=../../inc/BBSsetup.asp -->
<!-- #include file=../../inc/Upload_Setup.asp -->
<!-- #include file=../../inc/Board_Popfun.asp -->
<!-- #include file=../../inc/Ubbcode.asp -->
<!-- #include file=../../inc/Constellation2.asp -->
<!-- #include file=../inc/bbsmanage_Fun.asp -->
<%
DEF_BBS_HomeUrl = "../../"
server.scriptTimeOut = 99999
Rem -------------------------------------------------------
Rem ------------批量扫描及删除空用户-----------------------
Rem -------------------------------------------------------
initDatabase
checkSupervisorPass
If GBL_UserID > 0 and GBL_CHK_Flag = 1 and GBL_CHK_TempStr = "" Then
	If Request("dflag") <> "upload" Then
		DeleteBlankUser
	Else
		DeleteUploadBlock
	End If
Else
	Response.Write ""
End If	
CloseDatabase

Function DeleteBlankUser()

	If CheckSupervisorUserName = 0 or GBL_UserID = 0 Then Exit Function
	
	
	If Request.Form("DeleteSureFlag") <> "E72ksiOkw2" Then
		%>
			<p><form action=DeleteBlankUser.asp method=post>
			<b><font color=ff0000 class=RedFont>再次确认信息：确定删除无任何发帖在一个月前注册且经验低于100的用户<br>
			<br>
			<input type=hidden name=DeleteSureFlag value="E72ksiOkw2">
			
			<input type=submit value=确定删除 class=fmbtn>
			</form>
		<%
	Else
	
		Response.Write "<span style='font-size:9pt;'>开始删除无实际发帖及经验小于100的用户(灰色表示略过删除，黑色表示删除用户)："
	
		Dim RecordCount,CountIndex
		SQL = "Select count(*) from [LeadBBS_User] where OnlineTime<100"
		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
		Dim EndFlag,Temp,DeleteNum
		Dim Rs,SQL
		DeleteNum = 0
		SQL = "Select ID,UserName,AnnounceNum,OnlineTime,ApplyTime,UploadNum from LeadBBS_User where OnlineTime<100"
		Set Rs = Con.ExeCute(SQL)
		GBL_DBNum = GBL_DBNum + 1
		Do While Not Rs.Eof
			Temp = RestoreTime(Rs(4))
			If isTrueDate(Temp) Then
				If DateDiff("d",Temp,DEF_Now) > 30 Then
					Temp = 1
				Else
					Temp = 0
				End If
			Else
				Temp = 0
			End If
			If cCur(Rs(2)) = 0 and Temp = 1 Then
				Con.Execute("Delete from LeadBBS_FriendUser where UserID=" & Rs(0))
				Con.Execute("Delete from LeadBBS_FriendUser where FriendUserID=" & Rs(0))
				Con.Execute("Delete from LeadBBS_InfoBox where FromUser='" & Replace(Rs(1),"'","''") & "'")
				Con.Execute("Delete from LeadBBS_InfoBox where ToUser='" & Replace(Rs(1),"'","''") & "'")
				'Response.Write " " & Rs(1) & "[" & Rs(0) & "," & Rs(2) & "," & Fix(cCur(Rs(3))/60) & "]"
				If cCur(Rs(5)) > 0 Then DeleteUploadInfo(Rs(0))
				Con.Execute("Delete from LeadBBS_User where ID=" & Rs(0))
				DeleteNum = DeleteNum + 1
			Else
				'Response.Write " <font color=Gray>" & Rs(1) & "[" & Rs(0) & ",<font color=Red class=RedFont>" & Rs(2) & "</font>]</font>"
			End If
			CountIndex = CountIndex + 1
			If (CountIndex mod 100) = 10 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
			Rs.MoveNext
		Loop
		Rs.Close
		Set Rs = Nothing
		ReloadStatisticData
		%>
		<script>img1.width=400;
		txt1.innerHTML="100";</script>
		共有<%=DeleteNum%>个用户被删除(包括上传附件)
		<%
	End If

End Function

Function DeleteUploadInfo(DelUserID)

	Dim Rs,SQL
	Dim NowID,EndFlag
	NowID = 0
	EndFlag = 0

	Dim TempNum
	If DEF_FSOString = "" Then
		'Response.Write " <font color=Red class=RedFont>不支持FSO，略过附件删除．</font>"
	Else
		Do while EndFlag = 0
			SQL = "Select top 100 ID,PhotoDir,SPhotoDir from LeadBBS_Upload where UserID=" & DelUserID & " and ID>" & NowID & " order by ID ASC"
			GBL_DBNum = GBL_DBNum + 1
			Set Rs = Con.ExeCute(SQL)
			If Rs.Eof Then
				EndFlag = 1
				Rs.Close
				Set Rs = Nothing
			Else
				TempNum = 0
				Do while Not Rs.Eof
					If Rs("PhotoDir") <> "" Then DeleteFiles(Server.Mappath(Replace(Replace(DEF_BBS_HomeUrl & DEF_BBS_UploadPhotoUrl & Rs("PhotoDir"),"/","\"),"\\","\")))
					If Rs("SPhotoDir") <> "" Then DeleteFiles(Server.Mappath(Replace(Replace(DEF_BBS_HomeUrl & DEF_BBS_UploadPhotoUrl & Rs("SPhotoDir"),"/","\"),"\\","\")))
					TempNum = TempNum + 1
					NowID = Rs(0)
					Rs.MoveNext
				Loop
				'Response.Write "■"
				Rs.Close
				Set Rs = Nothing
				Con.Execute("Delete from LeadBBS_Upload where UserID=" & DelUserID & " and ID<=" & NowID)
				con.Execute("update LeadBBS_SiteInfo set UploadNum=UploadNum-" & TempNum)
				Con.ExeCute("Update LeadBBS_User Set UploadNum=UploadNum-" & TempNum & " where id=" & DelUserID)
				GBL_DBNum = GBL_DBNum + 3
				Response.Write " <font color=Red class=RedFont>删除" & TempNum & "个附件</font>"
			End If
		Loop
		
		SQL = "Select ID,PhotoDir,SPhotoDir from LeadBBS_UserFace where UserID=" & DelUserID & " order by ID ASC"
		GBL_DBNum = GBL_DBNum + 1
		Set Rs = Con.ExeCute(SQL)
		If Rs.Eof Then
			Rs.Close
			Set Rs = Nothing
		Else
			If Rs("PhotoDir") <> "" Then DeleteFiles(Server.Mappath(DEF_BBS_HomeUrl & DEF_BBS_UploadPhotoUrl & "face/" & Rs("PhotoDir")))
			If Rs("SPhotoDir") <> "" Then DeleteFiles(Server.Mappath(DEF_BBS_HomeUrl & DEF_BBS_UploadPhotoUrl & "face/" & Rs("SPhotoDir")))
			'Response.Write "■"
			Rs.Close
			Set Rs = Nothing
			Con.Execute("Delete from LeadBBS_UserFace where UserID=" & DelUserID)
			GBL_DBNum = GBL_DBNum + 1
		End If
	End If

End Function

Function DeleteUploadBlock

	Dim FirstDate,LastDate
	FirstDate = Request.Form("FirstDate")
	LastDate = Request.Form("LastDate")
	If Request.Form("DeleteSureFlag") = "sure" Then
		If isTrueDate(FirstDate) = 0 Then
			GBL_CHK_TempStr = "<br>起始日期错误,请正确填写,必须为日期格式!<br>"
		ElseIf isTrueDate(LastDate) = 0 Then
			GBL_CHK_TempStr = "<br>终止日期错误,请正确填写,必须为日期格式!<br>"
		End If
	End If
	If Request.Form("DeleteSureFlag") <> "sure" or GBL_CHK_TempStr <> "" Then
		SiteHead(DEF_SiteNameString & " - 管理员")
		UserTopicTopInfo
		DisplayUserNavigate("批量删除论坛指定条件的历史附件")
	%>
		<p style="font-size:9pt">删除指定时间之间的附件(现在日期<%=now%>)</p>
		<%If GBL_CHK_TempStr <> "" Then Response.Write "<b style=font-size:9pt><font color=red class=RedFont>" & GBL_CHK_TempStr & "</font></b>"%>
		<form name=DellClientForm action=DeleteBlankUser.asp method=post style="font-size:9pt">
			<input type=hidden name=dflag value="upload">
			<input type=hidden name=DeleteSureFlag value="sure">
			删除日期<input name=firstDate value="<%=htmlencode(firstDate)%>">至日期
			<input name=LastDate value="<%=htmlencode(LastDate)%>">之间的附件
			<p><b>确认要删除指定日期之间的附件吗？</b>
			<p><input type=submit value=确定 class=fmbtn style="font-size:9pt">
			<input type=button value=不删 onclick="javascript:window.close();" class=fmbtn style="font-size:9pt">
		</form>
	<%
		UserTopicBottomInfo
		SiteBottom
		If GBL_ShowBottomSure = 1 Then Response.Write GBL_SiteBottomString
	Else
		FirstDate = GetTimeValue(FirstDate)
		LastDate = GetTimeValue(LastDate)

		Dim Rs,SQL
		

		Dim RecordCount,CountIndex
		SQL = "Select count(*) from [LeadBBS_Upload] where NDatetime >=" & FirstDate & " and NDatetime <= " & LastDate
		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%>个附件待删除,如果服务器不支持FSO将无法删除硬盘上的文件
	
		<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
		Dim NowID,EndFlag
		NowID = 0
		EndFlag = 0

		If DEF_FSOString = "" Then
			Response.Write " <font color=Red class=RedFont>不支持FSO，略过附件删除．</font>"
		Else
			SQL = "Select ID,PhotoDir,SPhotoDir,UserID from LeadBBS_Upload where NDatetime >=" & FirstDate & " and NDatetime <= " & LastDate
			GBL_DBNum = GBL_DBNum + 1
			Set Rs = Con.ExeCute(SQL)
			If Rs.Eof Then
				Rs.Close
				Set Rs = Nothing
			Else
				Do while Not Rs.Eof
					If Rs("PhotoDir") <> "" Then DeleteFiles(Server.Mappath(Replace(Replace(DEF_BBS_HomeUrl & DEF_BBS_UploadPhotoUrl & Rs("PhotoDir"),"/","\"),"\\","\")))
					If Rs("SPhotoDir") <> "" Then DeleteFiles(Server.Mappath(Replace(Replace(DEF_BBS_HomeUrl & DEF_BBS_UploadPhotoUrl & Rs("SPhotoDir"),"/","\"),"\\","\")))
					Con.ExeCute("Delete from LeadBBS_Upload where id=" & Rs(0))
					Con.ExeCute("Update LeadBBS_User Set UploadNum=UploadNum-1 where id=" & Rs(0))
					con.Execute("update LeadBBS_SiteInfo set UploadNum=UploadNum-1")
					Rs.MoveNext
					CountIndex = CountIndex + 1
					If (CountIndex mod 100) = 10 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
				Loop
				Rs.Close
				Set Rs = Nothing
			End If
		End If
		%>
		<script>img1.width=400;
		txt1.innerHTML="100";</script>
		<%
	End If
	ReloadStatisticData

End Function

Function DeleteFiles(path)

	If DEF_FSOString = "" Then Exit Function
    on error resume next
    Dim fs
    Set fs = Server.CreateObject(DEF_FSOString)
	If err <> 0 Then
		Err.Clear
		'Response.Write "<br>服务器不支持FSO，硬盘文件未删除．"
		Exit Function
	End If
    If fs.FileExists(path) Then
      fs.DeleteFile path,True
      DeleteFiles = 1
    Else
      DeleteFiles = 0
    End If
    Set fs = Nothing
         
End Function
%>