<% Dim Action Dim Errmsg,Numc Dvbbs.LoadTemplates("") Dvbbs.Stats = "联盟信息管理" Dvbbs.Nav() Dvbbs.Head_var 0,0,Plus_Popwan.Program,"plus_popwan_Message.asp" Dvbbs.ActiveOnline() action = Request("action") Page_main() If action<>"frameon" Then Dvbbs.Footer End If Dvbbs.PageEnd() '页面右侧内容部分 Sub Page_Center() If Not (Dvbbs.master Or Dvbbs.GroupSetting(70)="1") Then Dvbbs.AddErrcode(28) Dvbbs.ShowErr() End If Select Case action Case "add" Call Savemsg() Case Else sendmsg() End Select End Sub sub sendmsg() %>
论坛短信广播
消息标题
接收方选择

消息内容

(HTML代码支持)


显示发送过程 不显示发送过程(速度较快)
 
<% end sub Sub Savemsg() Dim Sendtime,sender,userlist,Title,message,isshow,Rs,Sql,i isshow=Request("isshow") Title = TRim(Request("title")) message=Replace(Request("message"),Chr(13)&Chr(10),"
") message=Dvbbs.checkStr(message) If Len(Title)=0 Then Errmsg = Errmsg + "消息标题不能为空" Response.Redirect "showerr.asp?ErrCodes=
  • "& Errmsg &"&action=OtherErr" Exit Sub End If If Len(message)=0 Then Errmsg = Errmsg + "消息内容不能为空" Response.Redirect "showerr.asp?ErrCodes=
  • "& Errmsg &"&action=OtherErr" Exit Sub End If If Len(message)>255 Then Errmsg = Errmsg + "消息内容不能多于255字节" Response.Redirect "showerr.asp?ErrCodes=
  • "& Errmsg &"&action=OtherErr" Exit Sub End If sendtime=Now() sender=Dvbbs.Forum_info(0) Select case request("stype") case 1 Sql = "SELECT Count(*) FROM [dv_online] where userid>0" Set Rs = Dvbbs.execute(Sql) Numc = Rs(0) sql="select username from dv_online where userid>0" Case 2 Sql = "SELECT Count(*) FROM [dv_user] where usergroupid=8" Set Rs = Dvbbs.execute(Sql) Numc = Rs(0) sql = "select username from [dv_user] where usergroupid=8 order by userid desc" Case 3 Sql = "SELECT Count(*) FROM [dv_user] where usergroupid=3" Set Rs = Dvbbs.execute(Sql) Numc = Rs(0) sql = "select username from [dv_user] where usergroupid=3 order by userid desc" Case 4 Sql = "SELECT Count(*) FROM [dv_user] where usergroupid=1" Set Rs = Dvbbs.execute(Sql) Numc = Rs(0) sql = "select username from [dv_user] where usergroupid=1 order by userid desc" Case 5 Sql = "SELECT Count(*) FROM [dv_user] where usergroupid<4" Set Rs = Dvbbs.execute(Sql) Numc = Rs(0) sql = "select username from [dv_user] where usergroupid<4 order by userid desc" Case 6 Sql = "SELECT Count(*) FROM [Dv_user]" Set Rs = Dvbbs.execute(Sql) Numc = Rs(0) Rs.Close Sql = "SELECT Username FROM [Dv_user] ORDER BY Userid DESC" Case 7 Sql = "SELECT COUNT(*) FROM [Dv_User] WHERE UserGroupID = 2" Set Rs = Dvbbs.Execute(Sql) Numc = Rs(0) sql = "SELECT UserName FROM [Dv_User] WHERE UserGroupID = 2 ORDER BY UserID DESC" Case Else REM 加入自定义用户组群发短信功能 2004-5-19 Dv.Yz Sql = "SELECT COUNT(*) FROM [Dv_User] WHERE Usergroupid = " & Cint(Request("stype")) Set Rs = Dvbbs.Execute(Sql) Numc = Rs(0) Sql = "SELECT Username FROM [Dv_User] WHERE Usergroupid = " & Cint(Request("stype")) & " ORDER BY Userid DESC" End Select %>
    下面开始发送短消息,预计本次发送<%=Numc%>个用户。
    0
    <% Response.Flush Set Rs = Dvbbs.Execute(Sql) '修正所属用户组用户数为0时的错误 Dv.Yz 2005-1-27 If Not (Rs.Eof And Rs.Bof) Then userlist=Rs.GetRows(-1) Set Rs = Nothing Response.Write "" & VbCrLf Response.Flush For i=0 to UBound(userlist,2) userlist(0,i)=Dvbbs.checkStr(userlist(0,i)) If Response.IsClientConnected Then If isshow="1" Then Response.Write "" & VbCrLf Response.Flush End If Sql = "INSERT into dv_message(incept, sender, title, content, sendtime, flag, issend) values('"&userlist(0,i) &"', '"&sender&"', '"&Title&"', '"&Trim(message)&"', "&SqlNowString&",0,1)" Dvbbs.Execute(Sql) Update_user_msg(userlist(0,i)) userlist(0,i)="" End If Next Response.Write "" & VbCrLf Response.Flush End If Dvbbs.Dvbbs_Suc("操作成功!请继续别的操作。") End Sub Function inceptid(stype,iusername) Dim ars set ars=Dvbbs.Execute("Select top 1 id,sender from dv_Message Where flag=0 and issend=1 and delR=0 And incept ='"& iusername &"'") If stype=1 Then inceptid=ars(0) Else inceptid=ars(1) End If set ars=nothing End Function Function update_user_msg(username) Dim msginfo If newincept(username)>0 Then msginfo=newincept(username) & "||" & inceptid(1,username) & "||" & inceptid(2,username) Else msginfo="0||0||null" End If Dvbbs.Execute("update [dv_user] set UserMsg='"&dvbbs.CheckStr(msginfo)&"' where username='"&dvbbs.CheckStr(username)&"'") End Function '统计留言 Function newincept(iusername) Dim rs Rs=Dvbbs.Execute("Select Count(id) from dv_Message Where flag=0 and issend=1 and delR=0 And incept='"& iusername &"'") newincept=Rs(0) Set Rs=Nothing If IsNull(newincept) Then newincept=0 End Function %>