sendemail.asp

公司企业网站管理系统全站源码,用于企业内部对网站的管理

	Loop
	Rs.close
	Set Rs=Nothing
	%>
	</td></tr>
	<tr><td height=20 class="td2"><input type="button" class="button" value="打开高级设置" NAME="OPENSET" onclick="openset(this,'UpSetting')"></td></tr>
	<tr><td height=20 ID="UpSetting" style="display:NONE" class="td2">
		<table width="100%" border="0" cellspacing="1" cellpadding="3" align=center>
		<tr><td height=20 colspan="4">符合条件设置(若不选取用户组，则以下条件将对所有用户生效)</td></tr>
		<tr>
		<td class="td1" width="15%">最后登陆时间：</td>
		<td class="td1" width="35%">
		<input type="text" name="LoginTime" onkeyup="CheckNumer(this.value,this,'')" size=6>天 &nbsp;<INPUT TYPE="radio" class="radio" NAME="LoginTimeType" checked value="0">多于 <INPUT TYPE="radio" class="radio" NAME="LoginTimeType" value="1">少于
		</td>
		<td class="td1" width="15%">注册时间：</td>
		<td class="td1" width="35%">
		<input type="text" name="RegTime" onkeyup="CheckNumer(this.value,this,'')" size=6>天 &nbsp;<INPUT TYPE="radio" class="radio" NAME="RegTimeType" checked value="0">多于 <INPUT TYPE="radio" class="radio" NAME="RegTimeType" value="1">少于
		</td>
		</tr>
		<tr>
		<td class="td1">登陆次数：</td>
		<td class="td1"><input type="text" name="Logins" size=6 onkeyup="CheckNumer(this.value,this,'')">次 &nbsp;<INPUT TYPE="radio" class="radio" NAME="LoginsType" checked value="0">多于 <INPUT TYPE="radio" class="radio" NAME="LoginsType" value="1">少于
		</td>
		<td class="td1">发表文章：</td>
		<td class="td1"><input type="text" name="UserPost" size=6 onkeyup="CheckNumer(this.value,this,'')">篇 &nbsp;<INPUT TYPE="radio" class="radio" NAME="UserPostType" checked value="0">多于 <INPUT TYPE="radio" class="radio" NAME="UserPostType" value="1">少于</td>
		</tr>
		<tr>
		<td class="td1">主题文章：</td>
		<td class="td1"><input type="text" name="UserTopic" size=6 onkeyup="CheckNumer(this.value,this,'')">篇 &nbsp;<INPUT TYPE="radio" class="radio" NAME="UserTopicType" checked value="0">多于 <INPUT TYPE="radio" class="radio" NAME="UserTopicType" value="1">少于</td>
		<td class="td1">精华文章：</td>
		<td class="td1"><input type="text" name="UserBest" size=6 onkeyup="CheckNumer(this.value,this,'')">篇 &nbsp;<INPUT TYPE="radio" class="radio" NAME="UserBestType" checked value="0">多于 <INPUT TYPE="radio" class="radio" NAME="UserBestType" value="1">少于
		</td>
		</tr>
		</table>
	</td></tr>
	</table>
</div>
</td>
</tr>
<tr>
<td class="td2" align="right">
邮件标题：
</td>
<td class="td1">
<INPUT TYPE="text" NAME="EmailTopic" size="80">
</td>
</tr>
<tr>
<td class="td2" align="right">
邮件内容：
</td>
<td class="td1">
<TEXTAREA NAME="EmailBody" Style="width:100%;height:250;"></TEXTAREA>
</td>
</tr>
<tr>
<td class="td2" align="right">&nbsp;
</td>
<td class="td2" align="center">
<INPUT TYPE="hidden" name="Act" value="sendemail">
<INPUT TYPE="submit" class="button" value="提交">&nbsp;&nbsp;&nbsp;<INPUT TYPE="reset" class="button" value="重填">
</td>
</tr>
</form>
</table>
<SCRIPT LANGUAGE="JavaScript">
<!--
function openset(v,s){
	if (v.value=='打开高级设置'){
		document.getElementById(s).style.display = "";
		v.value="关闭高级设置";
	}
	else{
		v.value="打开高级设置";
		document.getElementById(s).style.display = "none";
	}
}
function UType(n){
	var ToUserGroup = document.getElementById("ToUserGroup");
	if (n==0&&TheForm.UserName.disabled==true){
		TheForm.UserName.disabled = false;
		ToUserGroup.style.display = "none";
	}
	else{
		TheForm.UserName.disabled=true;
		if (n==1){
			ToUserGroup.style.display = "";
		}else{
			ToUserGroup.style.display = "none";
		}
	}
}
//-->
</SCRIPT>
<%
End Sub

Sub SendStep2()
	Server.ScriptTimeout=999999
	Dim UserType
	UserType = Request.Form("UserType")
	EmailTopic = Request.Form("EmailTopic")
	EmailBody = Request.Form("EmailBody")
	If EmailTopic="" or EmailBody="" Then
		ErrMsg = "请填写邮件的标题和内容!"
		Dvbbs_Error()
		Exit Sub
	End If
	Select Case UserType
		Case "0" : Call Sendtype_0()	'按指定用户
		Case "1" : Call Sendtype_1()	'按指定用户组
		Case "2" : Call Sendtype_2()	'按所有用户
		Case Else
			ErrMsg = "请选收信的用户!"
			Dvbbs_Error()
			Exit Sub
	End Select
	Dv_suc("已经成功将发送事件存入列表，请在发送列表中选取发送!")
End Sub

'按指定用户
Sub Sendtype_0()
	Dim Searchstr
	Dim ToUserName,Rs,Sql,i,ToUserID,FirstUserID
	ToUserName = Trim(Request.Form("UserName"))
	If ToUserName = "" Then
		ErrMsg = "请填写目标用户名，注意区分大小写。"
		Dvbbs_Error()
		Exit Sub
	End If
	ToUserName = Replace(ToUserName,"'","")
	ToUserName = Split(ToUserName,",")
	If Ubound(ToUserName)>100 Then
		ErrMsg = "限制一次不能超过100位目标用户。"
		Dvbbs_Error()
		Exit Sub
	End If
	For i=0 To Ubound(ToUserName)
		SQL = "Select UserID From [Dv_user] Where UserName = '"&ToUserName(i)&"' order by userid"
		SET Rs = Dvbbs.Execute(SQL)
		If Not Rs.eof Then
			If i=0 or ToUserID="" Then
				ToUserID = ToUserID & Rs(0)
				FirstUserID = Rs(0)
			Else
				ToUserID = ToUserID &","& Rs(0)
			End If
		End If
	Next
	Rs.Close : Set Rs = Nothing
	Dim Total
	Total = Ubound(Split(ToUserID,","))+1
	If Total = 0 Then
		ErrMsg = "系统找不到相应目标用户名，注意区分大小写。"
		Dvbbs_Error()
		Exit Sub
	Else
		SearchStr = "UserID in ("&ToUserID&")"
		Call CreateXmlLog(Total,SearchStr,FirstUserID)
	End If
End Sub

'按指定用户组及条件发送
Sub Sendtype_1()
	Dim GetGroupID
	Dim SearchStr,TempValue,DayStr
	GetGroupID = Replace(Request.Form("GetGroupID"),chr(32),"")
	If GetGroupID<>"" and Not Isnumeric(Replace(GetGroupID,",","")) Then
		ErrMsg = "请正确选取相应的用户组。"
	Else
		GetGroupID = Dvbbs.Checkstr(GetGroupID)
	End If
	If IsSqlDataBase=1 Then
		DayStr = "d"
	Else
		DayStr = "'d'"
	End If
	If GetGroupID<>"" Then
		If Isnumeric(GetGroupID) Then
			SearchStr = "UserGroupID = "&GetGroupID
		Else
			SearchStr = "UserGroupID in ("&GetGroupID&")"
		End If
	End If
	'登陆次数
	TempValue = Request.Form("Logins")
	If TempValue<>"" and IsNumeric(TempValue) Then
		SearchStr = GetSearchString(TempValue,SearchStr,Request.Form("LoginsType"),"UserLogins")
	End If
	'发表文章
	TempValue = Request.Form("UserPost")
	If TempValue<>"" and IsNumeric(TempValue) Then
		SearchStr = GetSearchString(TempValue,SearchStr,Request.Form("UserPostType"),"UserPost")
	End If
	'主题文章
	TempValue = Request.Form("UserTopic")
	If TempValue<>"" and IsNumeric(TempValue) Then
		SearchStr = GetSearchString(TempValue,SearchStr,Request.Form("UserTopicType"),"UserTopic")
	End If
	'精华文章
	TempValue = Request.Form("UserBest")
	If TempValue<>"" and IsNumeric(TempValue) Then
		SearchStr = GetSearchString(TempValue,SearchStr,Request.Form("UserBestType"),"UserIsBest")
	End If
	'最后登陆时间
	TempValue = Request.Form("LoginTime")
	If TempValue<>"" and IsNumeric(TempValue) Then
		SearchStr = GetSearchString(TempValue,SearchStr,Request.Form("LoginTimeType"),"Datediff("&DayStr&",Lastlogin,"&SqlNowString&")")
	End If
	'注册时间
	TempValue = Request.Form("RegTime")
	If TempValue<>"" and IsNumeric(TempValue) Then
		SearchStr = GetSearchString(TempValue,SearchStr,Request.Form("RegTimeType"),"Datediff("&DayStr&",JoinDate,"&SqlNowString&")")
	End If
	If SearchStr="" Then
		ErrMsg = "请填写发送的条件选项。"
	End If
	If ErrMsg<>"" Then Dvbbs_Error() : Exit Sub
	Dim Rs,Sql,Total,FirstUserID
	Sql = "Select Count(UserID) From Dv_user Where "& SearchStr
	Total = Dvbbs.Execute(Sql)(0)
	If Total>0 Then
		Sql = "Select Top 1 UserID From Dv_user Where "& SearchStr & " order by userid"
		FirstUserID = Dvbbs.Execute(Sql)(0)
		Call CreateXmlLog(Total,SearchStr,FirstUserID)
	Else
		ErrMsg = "发送目标用户为空，请更改发送条件再进行发送。"
		Dvbbs_Error()
		Exit Sub
	End If
End Sub

'按所有用户
Sub Sendtype_2()
	Dim SearchStr
	Dim Rs,Sql,Total,FirstUserID
	Sql = "Select Count(UserID) From Dv_user"
	Total = Dvbbs.Execute(Sql)(0)
	If Total>0 Then
		Sql = "Select Top 1 UserID From Dv_user order by userid"
		FirstUserID = Dvbbs.Execute(Sql)(0)
		Call CreateXmlLog(Total,SearchStr,FirstUserID)
	Else
		ErrMsg = "发送目标用户为空，请更改发送条件再进行发送。"
		Dvbbs_Error()
		Exit Sub
	End If
End Sub

'添加发送记录
Sub CreateXmlLog(SendTotal,Search,LasterUserID)
	Dim node,attributes,createCDATASection,ChildNode
	Set XmlDom = Server.CreateObject("MSXML.DOMDocument")
	If Not XmlDom.load(FilePath) Then
		XmlDom.loadxml "<?xml version=""1.0"" encoding=""gb2312""?><EmailLog/>"
	End If
	Set node=XmlDom.createNode(1,"SendLog","")
	Set attributes=XmlDom.createAttribute("Total")
	attributes.text = SendTotal
	node.attributes.setNamedItem(attributes)
	Set attributes=XmlDom.createAttribute("Remain")
	attributes.text = SendTotal
	node.attributes.setNamedItem(attributes)
	Set attributes=XmlDom.createAttribute("LasterUserID")
	attributes.text = LasterUserID
	node.attributes.setNamedItem(attributes)
	Set attributes=XmlDom.createAttribute("MasterName")
	attributes.text = Dvbbs.Membername
	node.attributes.setNamedItem(attributes)
	Set attributes=XmlDom.createAttribute("MasterUserID")
	attributes.text = Dvbbs.UserID
	node.attributes.setNamedItem(attributes)
	Set attributes=XmlDom.createAttribute("MasterIP")
	attributes.text = Dvbbs.UserTrueIP
	node.attributes.setNamedItem(attributes)
	Set attributes=XmlDom.createAttribute("AddTime")
	attributes.text = Now()
	node.attributes.setNamedItem(attributes)
	Set attributes=XmlDom.createAttribute("LastTime")
	attributes.text = Now()
	node.attributes.setNamedItem(attributes)
	Set ChildNode = XmlDom.createNode(1,"Search","")
	Set createCDATASection=XmlDom.createCDATASection(replace(Search,"]]>","]]&gt;"))
	ChildNode.appendChild(createCDATASection)
	node.appendChild(ChildNode)
	Set ChildNode = XmlDom.createNode(1,"EmailTopic","")
	Set createCDATASection=XmlDom.createCDATASection(replace(EmailTopic,"]]>","]]&gt;"))
	ChildNode.appendChild(createCDATASection)
	node.appendChild(ChildNode)
	Set ChildNode = XmlDom.createNode(1,"EmailBody","")
	Set createCDATASection=XmlDom.createCDATASection(replace(EmailBody,"]]>","]]&gt;"))
	ChildNode.appendChild(createCDATASection)
	node.appendChild(ChildNode)
	XmlDom.documentElement.appendChild(node)
	XmlDom.save FilePath
	Set XmlDom = Nothing
End Sub

Function GetSearchString(Get_Value,Get_SearchStr,UpType,UpColumn)
	Get_Value = Clng(Get_Value)
	If Get_SearchStr<>"" Then Get_SearchStr = Get_SearchStr & " and " 
	If UpType="1" Then
		Get_SearchStr = Get_SearchStr & UpColumn &" <= "&Get_Value
	Else
		Get_SearchStr = Get_SearchStr & UpColumn &" >= "&Get_Value
	End If
	GetSearchString = Get_SearchStr
End Function
%>