<!-- #include file=../inc/BBSsetup.asp -->
<!-- #include file=../inc/Board_Popfun.asp -->
<!-- #include file=../inc/Limit_fun.asp -->
<!-- #include file=../inc/ubbcode.asp -->
<%
DEF_BBS_HomeUrl = "../"
initDatabase
GBL_CHK_TempStr = ""
siteHead("   帖子内容自动排版")

Dim DoingFlag,NotReplay,TitleStyle,ParentID,RepairID,RootIDBAK,Title
DoingFlag = 0 '0-自动排版,1-解或锁帖,2-通过审核
%>
<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 CheckIsCanTypeSetSure = 1 Then
		DisplayRepairAnnounce
	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 CheckIsCanTypeSetSure

	Dim UserID
	RepairID = Left(Request("RepairID"),14)
	If isNumeric(RepairID) = 0 or inStr(RepairID,",") > 0 or RepairID = "" Then
		Response.Write "错误,请提供要自动排版的帖子的ID!<br>" & VbCrLf
		CheckIsCanTypeSetSure = 0
		Exit Function
	End if

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

	RepairID = cCur(RepairID)
	Dim Rs,SQL
	SQL = "Select top 1 BoardID,UserID,NotReplay,TitleStyle,ParentID,RootIDBAK,Title from LeadBBS_Announce where id=" & RepairID
	Set Rs = Con.ExeCute(SQL)
	GBL_DBNum = GBL_DBNum + 1
	If Rs.Eof Then
		Response.Write "错误,要自动排版的帖子ID不存在!<br>" & VbCrLf
		Rs.Close
		Set Rs = Nothing
		CheckIsCanTypeSetSure = 0
		Exit Function
	End if

	GBL_Board_ID = Rs(0)
	UserID = cCur(Rs(1))
	NotReplay = Rs(2)
	TitleStyle = Rs(3)
	ParentID = cCur(Rs(4))
	RootIDBAK = cCur(Rs(5))
	Title = Rs(6)
	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
		CheckIsCanTypeSetSure = 0
		Set Rs = Nothing
	End If
	GBL_Board_BoardAssort = Temp(1,0)
	GBL_Board_MasterList = Temp(10,0)
	
	CheckisBoardMaster
	If GBL_UserID >= 1 and (GBL_BoardMasterFlag >= 5 and GetBinarybit(GBL_CHK_UserLimit,4) = 0) Then
		CheckIsCanTypeSetSure = 1
		DoingFlag = Request.Form("DoingFlag")
		If DoingFlag <> "0" and DoingFlag <> "1" and DoingFlag <> "2" Then DoingFlag = 0
		DoingFlag = cCur(DoingFlag)
	Else
		DoingFlag = 0
		If (UserID = GBL_UserID) Then
			CheckIsCanTypeSetSure = 1
		Else
			CheckIsCanTypeSetSure = 0
			Response.Write "错误,权限不足."
		End If
	End If

End Function

Function DisplayRepairAnnounce

	RepairID = Left(Request("RepairID"),14)
	If isNumeric(RepairID) = 0 or inStr(RepairID,",") > 0 or RepairID = "" Then
		Response.Write "错误,请提供要自动排版的帖子的ID!<br>" & VbCrLf
		Exit Function
	End if
	If Request.Form("DeleteSureFlag")="dk9@dl9s92lw_SWxl" Then
		RepairID = cCur(RepairID)
		Select Case DoingFlag
			Case 1:	If NotReplay = 0 Then
						NotReplay = 1
						Response.Write "成功锁定帖子。"
					Else
						NotReplay = 0
						Response.Write "成功完成帖子解锁。"
					End If
					Con.ExeCute("Update LeadBBS_Announce Set NotReplay=" & NotReplay & " where ID=" & RepairID)
					Con.ExeCute("Update LeadBBS_Topic Set NotReplay=" & NotReplay & " where ID=" & RepairID)
			Case 2:	If TitleStyle >= 60 Then	
						TitleStyle = TitleStyle - 60
						If inStr(application(DEF_MasterCookies & "TopAncList"),"," & RepairID & ",") Then
							UpdateAnnounceApplicationInfo RepairID,2,Title,0,0
							UpdateAnnounceApplicationInfo RepairID,16,TitleStyle,0,0
						Else
							If inStr(application(DEF_MasterCookies & "TopAncList" & GBL_Board_BoardAssort),"," & RepairID & ",") Then
								UpdateAnnounceApplicationInfo RepairID,2,Title,0,GBL_Board_BoardAssort
								UpdateAnnounceApplicationInfo RepairID,16,TitleStyle,0,GBL_Board_BoardAssort
							End If
						End If
						If TitleStyle = 1 Then Title = KillHTMLLabel(Title)
						Response.Write "帖子成功通过审核操作。"
					Else
						TitleStyle = TitleStyle + 60
						Title = "新审核帖子..."
						If inStr(application(DEF_MasterCookies & "TopAncList"),"," & RepairID & ",") Then
							UpdateAnnounceApplicationInfo RepairID,2,Title,0,0
							UpdateAnnounceApplicationInfo RepairID,16,TitleStyle,0,0
						Else
							If inStr(application(DEF_MasterCookies & "TopAncList" & GBL_Board_BoardAssort),"," & RepairID & ",") Then
								UpdateAnnounceApplicationInfo RepairID,2,Title,0,GBL_Board_BoardAssort
								UpdateAnnounceApplicationInfo RepairID,16,TitleStyle,0,GBL_Board_BoardAssort
							End If
						End If
						Response.Write "帖子关闭成功。"
					End If
					Con.ExeCute("Update LeadBBS_Announce Set TitleStyle=" & TitleStyle & " where ID=" & RepairID)
					Con.ExeCute("Update LeadBBS_Topic Set TitleStyle=" & TitleStyle & " where ID=" & RepairID)
					If ParentID = 0 Then UpdateBoardLastAnnounce
			Case Else: ReMakeIDDoc(RepairID)
					   Response.Write "成功自动排版社区帖子，请按ESC键退出。"
		End Select
	Else
		%>
		<form name=DellClientForm action=TypeSetAnnounce.asp method=post>
			<input type=hidden name=DeleteSureFlag value="dk9@dl9s92lw_SWxl">
			<input type=hidden name=RepairID value="<%=RepairID%>">
			<input type=hidden name=BoardID value="<%=GBL_Board_ID%>">
			<%If GBL_UserID >= 1 and (GBL_BoardMasterFlag >= 5 and GetBinarybit(GBL_CHK_UserLimit,4) = 0) Then%>
			<b>请选择操作：</b>
			<input type=radio name=DoingFlag value=0 checked>自动排版
			<input type=radio name=DoingFlag value=1><%If NotReplay = 0 Then%>锁定帖子<%Else%>解除锁定<%End If%>
			<input type=radio name=DoingFlag value=2><%If TitleStyle >= 60 Then%>通过审核<%Else%>关闭显示<%End If%>
			<%Else%>
			<b>确认要自动排版编号为<font color=ff0000 class=RedFont><%=RepairID%></font>的帖子内容吗？</b>
			<%End If%>
			<p><input type=submit value=确定 class=fmbtn>
			<input type=button value=取消此操作 onclick="javascript:window.close();" class=fmbtn>
		</form>
		<%
	End If

End Function

Function ResumeCode(Tstr)

	Dim str
	str = Tstr
	str = Replace(str,"&gt;",">")
	Str = Replace(str,"&lt;","<")
	Str = Replace(str,"&quot;","""")
	Str = Replace(str," &nbsp; &nbsp; &nbsp;",chr(9))
	Str = Replace(str,"<br>" & "&nbsp;",VbCrLf & " ")
	Str = Replace(str,"<br>" & VbCrLf,VbCrLf)
	Str = Replace(str,"&nbsp;"," ")
	ResumeCode = Str

End Function

Function ReMakeIDDoc(ID)

	Dim Rs,htmlflag,Content,PrintContent
	Set Rs = Server.CreateObject("ADODB.RecordSet")
	Set Rs = Con.ExeCute("Select top 1 Content,htmlflag,PrintContent from LeadBBS_Announce where ID=" & ID)
	If Rs.Eof Then
		ReMakeIDDoc = 0
		Rs.Close
		Set Rs = Nothing
		GBL_CHK_TempStr = GBL_CHK_TempStr & "找不到此帖子！<br>" & VbCrLf
		Exit Function
	Else
		htmlflag = Rs("htmlflag")
		If htmlflag <> 0 and htmlflag <> 2 and htmlflag <> 3 then
			ReMakeIDDoc = 0
			Rs.Close
			Set Rs = Nothing
			GBL_CHK_TempStr = GBL_CHK_TempStr & "稿件输入类型不是纯文本或UBB格式，不能进行自动排版！<br>" & VbCrLf
			Exit Function
		End if
		
		Dim NewTemp,N,I,moredataArray,TN,tm,Tmp
		Select Case htmlflag
			Case 0: Content = ResumeCode(Rs("PrintContent"))
			Case 1: Content = Rs("PrintContent")
			Case 2: Content = Rs("Content")
			Case 3: Content = ResumeCode(Rs("PrintContent"))
					htmlflag = 2
		End Select
		
		Rs.Close
		Set Rs = Nothing
		NewTemp = Content
		If isNull(NewTemp) or NewTemp = "" Then
		Else
			moredataArray = split(NewTemp,VbCrLf)
			I = Ubound(moredataArray,1)
			
			NewTemp = ""
			NewTemp = moredataArray(0)
			For N = 0 to I-1
				TN = strLength(moredataArray(N))
				tm = Trim(moredataArray(N))
				Tmp = right(tm,1)
				If Tmp<>"?" and Tmp<>"？" and Tmp<>"." and Tmp<>"。" and Tmp<>"‘"  and Tmp<>";" and Tmp<>"；" and Tmp<>"!" and Tmp<>":" and Tmp<>"：" and Tmp<>"！" and Tmp<>"`" and Tmp<>"`｀" and Tmp<>"”"  and Tmp<>"“" and Tmp<>chr(34) and (Left(moredataArray(N+1),1)<>" " and Left(moredataArray(N+1),1)<>"　") and TN>50 Then
					If tm="" or isNull(tm) Then
						NewTemp = NewTemp & VbCrLf & moredataArray(N+1)
					Else
						NewTemp = Rtrim(NewTemp) & moredataArray(N+1)
					End If
				Else
					NewTemp = NewTemp & VbCrLf & moredataArray(N+1)
				End If
			Next

			If htmlflag = 2 Then
				PrintContent = Ubb_code(NewTemp)
				If PrintContent = UBB_FiltrateBadWords(PrintTrueText(content)) Then
					htmlflag = 3
					content = ""
				End If
			ElseIf htmlflag = 1 and CheckSupervisorUserName = 1 and GBL_UserID > 0 Then
				PrintContent = content
				content = ""
			Else
				PrintContent = UBB_FiltrateBadWords(PrintTrueText(NewTemp))
				content = ""
			End If
			Con.ExeCute("Update LeadBBS_Announce Set Content='" & Replace(content,"'","''") & "',PrintContent='" & Replace(PrintContent,"'","''") & "' where ID=" & ID)
			GBL_DBNum = GBL_DBNum + 1
		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
		ReMakeIDDoc = 1
	End if

End Function

sub UpdateBoardLastAnnounce

	Dim Rs,SQL
	Set Rs = Server.CreateObject("ADODB.RecordSet")
	Dim LastAnnounceID
	LastAnnounceID = cCur(Application(DEF_MasterCookies & "BoardInfo" & GBL_Board_ID)(19,0))

	If LastAnnounceID = RepairID or LastAnnounceID = RootIDBAK Then
		con.ExeCute("Update LeadBBS_Boards Set LastTopicName='" & Replace(Title,"'","''") & "' where BoardID=" & GBL_Board_ID)
		GBL_DBNum = GBL_DBNum + 1
		UpdateBoardApplicationInfo GBL_Board_ID,Title,20
	End If

End sub

Sub UpdateAnnounceApplicationInfo(AncID,IndexN,Value,tp,tid)

	Dim GetDataTop,AllTopNum,N,Str
	If tid = 0 Then
		Str = ""
	Else
		Str = tid
	End if
	AllTopNum = -1
	GetDataTop = Application(DEF_MasterCookies & "TopAnc" & Str)
	If isArray(GetDataTop) = False Then
		'If GetDataTop <> "yes" Then ReloadTopAnnounceInfo(tid)
		Exit Sub
	Else
		AllTopNum = Ubound(GetDataTop,2)
	End If

	For N = 0 to AllTopNum
		If cCur(AncID) = cCur(GetDataTop(0,N)) Then
			If tp = 1 Then
				GetDataTop(IndexN,N) = cCur(GetDataTop(IndexN,N)) + Value
			Else
				GetDataTop(IndexN,N) = Value
			End If
			Application.Lock
			Application(DEF_MasterCookies & "TopAnc" & Str) = GetDataTop
			Application.UnLock
			Exit Sub
		End If
	Next

End Sub
%>