<!-- #include file=../../inc/BBSsetup.asp -->
<!-- #include file=../../inc/Board_popfun.asp -->
<!-- #include file=../../inc/Limit_Fun.asp -->
<!-- #include file=../inc/bbsmanage_Fun.asp -->
<%
DEF_BBS_HomeUrl = "../../"
initDatabase
GBL_CHK_TempStr = ""
checkSupervisorPass

SiteHead(DEF_SiteNameString & " - 管理员")


Dim Sdm_FromUser,Sdm_ToUser,Sdm_Title,Sdm_Content,Smd_ToUserID,SdM_ToUserClass
Sdm_FromUser = GBL_CHK_User

SdM_ToUserClass = 0
UserTopicTopInfo
DisplayUserNavigate("社区短消息群发")%>
<p>
<%
If GBL_CHK_Flag=1 Then
	If GBL_CHK_TempStr="" Then
		If Request.Form("submitFlag")<>"" Then
			CheckSubmitFormData
			If GBL_CHK_TempStr = "" Then
				WriteNewMessageToDatabase
				Response.Write "<br>" & GBL_CHK_TempStr
			Else
				Response.Write "<br>		<font color=ff0000 class=RedFont>" & GBL_CHK_TempStr & "</font>" & VbCrLf
				NewMessageForm
			End If
		Else
			NewMessageForm
		End If
	Else%>
		<table width=96%>
		<tr>
			<td>
				<%Response.Write GBL_CHK_TempStr%>
			</td>
		</tr>
		</table>
	<%End If
Else%>
	<table width=96%>
	<tr>
	<td>
	<%
	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
	DisplayLoginForm
	Response.Write "</p>"%>
	</td>
	</tr>
	</table>
<%End If
UserTopicBottomInfo
closeDataBase
SiteBottom
If GBL_ShowBottomSure = 1 Then Response.Write GBL_SiteBottomString

Function NewMessageForm

	Dim TempN
%>
	<p>
	<br>
	<table width="100%" border="0" cellspacing="0" cellpadding="0">
	<tr> 
		<td> 
			<div align="center">
				<b>
					群发送新的短信息</b>（加“<font color="#CC0000" class=RedFont><b>*</b></font>”号为必填项）
			</div>
		</td>
		<td> 
		</td>
	</tr>
	</table>

	<script language="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;
			}
		}
	}
	function ctlkey()
	{
		if(event.ctrlKey && window.event.keyCode==13){submitonce(document.frmReg);document.frmReg.submit();}
		if(event.altKey && (window.event.keyCode==83 || window.event.keyCode==115)){submitonce(document.frmReg);document.frmReg.submit();}
	}
	var ie = (document.all)? true:false
	if (ie)
	{
		window.document.onkeydown=ctlkey;
	}
	function smilie(smilietext)
	{
		smilietext=smilietext;
		if (document.frmReg.SdM_Content.createTextRange && document.frmReg.SdM_Content.caretPos)
		{
			var caretPos = document.frmReg.SdM_Content.caretPos;
			caretPos.text = caretPos.text.charAt(caretPos.text.length - 1) == ' ' ? smilietext + ' ' : smilietext;document.frmReg.SdM_Content.focus();
		}
		else
		{
			document.frmReg.SdM_Content.value+=smilietext;document.frmReg.SdM_Content.focus();
		}
	}
	function storeCaret (textEl)
	{
		if (textEl.createTextRange) 
		textEl.caretPos = document.selection.createRange().duplicate(); 
	}
	</script>
	<form method="post" action="SendGroupMessage.asp" id="frmReg" name="frmReg" onSubmit="submitonce(this);">
	<table border=0 cellpadding=5 cellspacing=1 width=95% bgcolor="<%=DEF_BBS_Color%>" class=TBone>
	
	<tr bgcolor="<%=DEF_BBS_LightestColor%>" class=TBBG9> 
		<td>
			发送者</td>
		<td valign=top>
			<%=Sdm_FromUser%>
			<input name=submitFlag value="<%=Second(time)&minute(time)%>" type=hidden>
		</td>
	</tr>
	<tr bgcolor="<%=DEF_BBS_LightestColor%>" class=TBBG9>
		<td>
			<%If CheckSupervisorUserName = 0 Then%><font color="#CC0000" class=RedFont><b>*</b></font><%End If%>接收人</td>
		<td valign=top>
			<select name=SdM_ToUserClass>
				<option value=0<%If SdM_ToUserClass = 0 Then Response.Write " selected"%>>全体版主</option>
				<option value=1<%If SdM_ToUserClass = 1 Then Response.Write " selected"%>>全体总版主</option>
				<option value=2<%If SdM_ToUserClass = 2 Then Response.Write " selected"%>>全体认证社员</option>
				<option value=3<%If SdM_ToUserClass = 3 Then Response.Write " selected"%>>全体社员，占用资源大，谨慎使用</option>
		</td>
	</tr>
	<tr bgcolor="<%=DEF_BBS_LightestColor%>" class=TBBG9> 
		<td align=left width=20%><font color="#CC0000" class=RedFont><b>*</b></font>信息标题</td>
		<td height=24 valign=top width=80%>
			<input class=fminpt name=SdM_Title value="<%=htmlencode(SdM_Title)%>" size=60 maxlength=50>
		</td>
	</tr>
	<tr bgcolor="<%=DEF_BBS_LightestColor%>" class=TBBG9> 
		<td align=left width=20%>短消息内容<br><br><a href="javascript:smilie('[IMGA][/IMGA]');">支持[IMG]标<br>签插入图片</td>
		<td height=24 valign=top width=80%>
			<textarea cols=58 name="SdM_Content" rows=10" onselect="storeCaret(this);" onclick="storeCaret(this);" onkeyup="storeCaret(this);" class=fmtxtra><%If SdM_Content<>"" Then Response.Write VbCrLf & Htmlencode(SdM_Content)%></textarea>
		</td>
	</tr><%If DEF_UBBiconNumber > 0 Then%>
	<tr bgcolor="<%=DEF_BBS_LightestColor%>" class=TBBG9>
		<td align=left width=20%>插入表情,时间</td>
		<td height=24 valign=top width=80%>
			&nbsp;<%
			Dim Temp_N
			For Temp_N = 1 to DEF_UBBiconNumber%><a href="javascript:smilie('[em<%=Right("0" & Temp_N,Len(DEF_UBBiconNumber))%>]');"><img src="../../images/UBBicon/em<%=Right("0" & Temp_N,Len(DEF_UBBiconNumber))%>.GIF" width="20" height="20" align="absmiddle" border=0></a>
			<%Next%>
		</td>
	</tr><%End If%>
	</table>
	<br>
	<table width="153" border="0" cellspacing="2" cellpadding="2" align="CENTER">
	<tr align="center">
		<td width="88">
			<div align="CENTER">
				<input type="submit" name="Submit" value="提交" class=fmbtn>
			</div>
		</td>
		<td width="88"> 
			<input type="reset" name="reset" value="清除" class=fmbtn>
			</td>
	</tr>
	</table>
	</form>
<%
End Function

Function CheckSubmitFormData

	SdM_ToUserClass = Trim(Request("SdM_ToUserClass"))
	SdM_Title = Trim(Request("SdM_Title"))
	SdM_ConTent = Request("SdM_ConTent")

	If SdM_ToUserClass <> "0" and SdM_ToUserClass <> "1" and SdM_ToUserClass <> "2" and SdM_ToUserClass <> "3" Then SdM_ToUserClass = -1
	SdM_ToUserClass = cCur(SdM_ToUserClass)
	If SdM_ToUserClass = -1 Then
		GBL_CHK_TempStr = GBL_CHK_TempStr & "错误，接收对象选择错误!<br>" & VbCrLf
		Exit Function
	End If

	If len(SdM_Title) > 50 Then
		GBL_CHK_TempStr = GBL_CHK_TempStr & "错误，信息标题请不要超过50个字. <br>" & VbCrLf
		Exit Function
	End if

	If SdM_Title = "" Then
		GBL_CHK_TempStr = GBL_CHK_TempStr & "错误，信息标题必须填写. <br>" & VbCrLf
		Exit Function
	End if

	If Len(SdM_Content) > DEF_MaxTextLength then
		GBL_CHK_TempStr = GBL_CHK_TempStr & "错误，内容不能超过" & DEF_MaxTextLength & "个字!<br>" & VbCrLf
		Exit Function
	End If

End Function


Function WriteNewMessageToDatabase

	Dim Rs,Flag,N,GetData
	If SdM_toUserClass = 0 Then
		Set Rs = Con.ExeCute("select UserID,UserName from LeadBBS_SpecialUser Where Assort=1 order by UserID")
		GBL_DBNum = GBL_DBNum + 1
		If Not Rs.Eof Then
			GetData = Rs.GetRows(-1)
			Rs.Close
			Set Rs = Nothing
			Rs = Ubound(GetData,2)
			Flag = 0
			For N = 0 to Rs
				If Flag <> cCur(GetData(0,N)) Then
					SendNewMessage(GetData(1,N))
					Flag = cCur(GetData(0,N))
				End If
			Next
		Else
			Rs.Close
			Set Rs = Nothing
			Response.Write "<p>没有任何版主，群发结束！<br>" & VbCrLf
		End If
	ElseIf SdM_toUserClass = 1 Then
		Set Rs = con.ExeCute("select UserName from LeadBBS_SpecialUser Where Assort=2")
		GBL_DBNum = GBL_DBNum + 1
		If Rs.Eof Then
			Rs.Close
			Set Rs = Nothing
		Else
			GetData = Rs.GetRows(-1)
			Rs.Close
			Set Rs = Nothing
			Rs = Ubound(GetData,2)
			For N = 0 to Rs
				SendNewMessage(GetData(0,N))
			Next
		End If
	ElseIf SdM_toUserClass = 2 Then
		Set Rs = con.ExeCute("select UserName from LeadBBS_SpecialUser Where Assort=0")
		GBL_DBNum = GBL_DBNum + 1
		If Rs.Eof Then
			Rs.Close
			Set Rs = Nothing
		Else
			GetData = Rs.GetRows(-1)
			Rs.Close
			Set Rs = Nothing
			Rs = Ubound(GetData,2)
			For N = 0 to Rs
				SendNewMessage(GetData(0,N))
			Next
		End If
	ElseIf SdM_toUserClass = 3 Then
		Set Rs = con.ExeCute("select UserName from LeadBBS_User")
		GBL_DBNum = GBL_DBNum + 1
		Do while Not Rs.Eof
			SendNewMessage(Rs(0))
			Rs.MoveNext
		Loop
	End If

End Function


Function SendNewMessage(SdM_toUser)

	If CheckUserNameExist(SdM_ToUser) = 0 Then
		Response.Write "<br><font color=Red class=RedFont>社员 " & htmlencode(SdM_toUser) & " 不存在，发送短消息失败！</font>"
		Exit Function
	End If

	Dim SQL
	SdM_Content = Replace(SdM_Content & "","\" & VbCrLf,"\\" & VbCrLf & VbCrLf)
	
	SQL = "inSert into LeadBBS_InfoBox(FromUser,ToUser,Title,Content,IP,SendTime,ReadFlag)" & _
		" Values('" & Replace(SdM_fromUser,"'","''") & "','" & Replace(SdM_ToUser,"'","''") & "','" & Replace(SdM_Title,"'","''") & "'" & _
		",'" & Replace(SdM_Content,"'","''") & "','" & GBL_IPAddress & "'," & GetTimeValue(DEF_Now) & ",0)"
	con.Execute(SQL)
	GBL_DBNum = GBL_DBNum + 1

	If SdM_ToUser = "" Then
		Application.Lock
		application(DEF_MasterCookies & "PubMsg") = SdM_Title
		Application.UnLock
	End If

	Response.Write "<br><font color=008800 class=GreenFont>成功发送消息，接收者：" & htmlencode(SdM_toUser) & "</font>"
	Con.Execute("Update LeadBBS_User Set MessageFlag=1 where ID=" & Smd_ToUserID)
	GBL_DBNum = GBL_DBNum + 1
	If Smd_ToUserID = GBL_UserID Then UpdateSessionValue 6,1,0

End Function

Rem 检测某社员名ID是否存在
Function CheckUserNameExist(UserName)

	Dim Rs
	Set Rs = Server.CreateObject("ADODB.RecordSet")
	Rs.Open "Select top 1 ID,UserName from LeadBBS_User where UserName='" & Replace(UserName,"'","''") & "'",con,0,1
	GBL_DBNum = GBL_DBNum + 1
	If Rs.Eof Then
		CheckUserNameExist = 0
		Smd_ToUserID = 0
	Else
		CheckUserNameExist = 1
		Smd_ToUserID = Rs(0)
		Sdm_ToUser = Rs(1)
	End if
	Rs.Close
	Set Rs = Nothing

End Function
%>