<% Head() Server.ScriptTimeout=9999999 Dim admin_flag Dim Numc admin_flag = ",6," If Not Dvbbs.Master or instr(","&session("flag")&",",admin_flag)=0 then Errmsg=ErrMsg + "
  • 本页面为管理员专用，请登录后进入。
  • 您没有管理本页面的权限。" dvbbs_error() Else Dim Body If Request("action") = "add" Then Call Savemsg() Elseif Request("action")="del" Then Call Del() Elseif Request("action")="delall" Then Call Delall() Elseif Request("action")="delchk" Then Call Delchk() Else Call Sendmsg() End if %>

    <%=body%>

    <% Footer() End If Sub Savemsg() Dim Sendtime,sender,userlist,message,isshow isshow=Request("isshow") message=Request("message") message=Dvbbs.checkStr(message) If Len(message)>255 Then Response.Write "消息内容不能多于255字节" 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&"', '"&TRim(Request("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 Body = Body & "
    操作成功！请继续别的操作。" End Sub sub sendmsg() %>
    论坛短信管理
    批量删除某用户短消息（主要用于删除系统批量信息：动网小精灵）：
    批量删除用户指定日期内短消息（默认为删除已读信息）：
     包括未读信息
    批量删除含有某关键字短信（注意：本操作将删除所有已读和未读信息）：
    关键字： 在  
    论坛短信广播
    消息标题
    接收方选择

    消息内容

    (HTML代码支持)
    显示发送过程 不显示发送过程（速度较快）
    <% end sub Sub Del() If Request("username") = "" Then Body = Body + "
    " + "请输入要批量删除的用户名。" Exit Sub End If Sql = "DELETE FROM Dv_Message WHERE Sender = '" & Request("username") & "'" Dvbbs.Execute(Sql) Body = Body + "
    " + "操作成功！请继续别的操作。" End Sub Sub Delall() REM 改数组循环避免删除论坛短信超时 2004-5-11 Dvbbs.YangZheng Dim Selflag, Summid If Request("isread") = "yes" Then Selflag = " ORDER BY Id" Else Selflag = " AND Flag = 1 ORDER BY Id" End If Select Case Request("delDate") Case "all" Sql = "SELECT Id FROM Dv_Message WHERE Id > 0 " & Selflag Case 7 If IsSqlDataBase = 1 Then Sql = "SELECT Id From Dv_Message WHERE DATEDIFF(d, Sendtime, " & SqlNowString & ") > 7 " & Selflag Else Sql = "SELECT Id FROM Dv_Message WHERE DATEDIFF('d', Sendtime, " & SqlNowString & ") > 7 " & Selflag End If Case 30 If IsSqlDataBase = 1 Then Sql = "SELECT Id From Dv_Message WHERE DATEDIFF(d, Sendtime, " & SqlNowString & ") > 30 " & Selflag Else Sql = "SELECT Id FROM Dv_Message WHERE DATEDIFF('d', Sendtime, " & SqlNowString & ") > 30 " & Selflag End If Case 60 If IsSqlDataBase = 1 Then Sql = "SELECT Id From Dv_Message WHERE DATEDIFF(d, Sendtime, " & SqlNowString & ") > 60 " & Selflag Else Sql = "SELECT Id FROM Dv_Message WHERE DATEDIFF('d', Sendtime, " & SqlNowString & ") > 60 " & Selflag End If Case 180 If IsSqlDataBase = 1 Then Sql = "SELECT Id From Dv_Message WHERE DATEDIFF(d, Sendtime, " & SqlNowString & ") > 180 " & Selflag Else Sql = "SELECT Id FROM Dv_Message WHERE DATEDIFF('d', Sendtime, " & SqlNowString & ") > 180 " & Selflag End If End Select Set Rs = Dvbbs.Execute(Sql) Summid = 0 If Not (Rs.Eof And Rs.Bof) Then Sql = Rs.GetRows(-1) Rs.Close:Set Rs = Nothing For i = 0 To Ubound(Sql,2) Dvbbs.Execute("DELETE FROM Dv_Message Where Id = " & Sql(0,i)) Summid = Summid + 1 Next End If Body = Body + "
    " + "操作删除" & Summid & "条论坛短信成功！请继续别的操作。" End Sub sub delchk() if request.form("keyword")="" then body="请输入关键字！" exit sub end if if request.form("selaction")=1 then Dvbbs.Execute("delete from dv_message where title like '%"&replace(request.form("keyword"),"'","")&"%'") body="操作成功！请继续别的操作。" elseif request.form("selaction")=2 then Dvbbs.Execute("delete from dv_message where content like '%"&replace(request.form("keyword"),"'","")&"%'") body="操作成功！请继续别的操作。" else body="未指定相关参数！" exit sub end if 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 %>