PM or Email specific Usergroups ? - Snitz™ Forums 2000

The Forum has been Updated

The code has been upgraded to the latest .NET core version. Please check instructions in the Community Announcements about migrating your account.
PM or Email specific Usergroups ? - Postet den 08 Nov 2011 (1222 Views)
Webbo
Average Member
Innlegg: 982
982
Has anyone written a Mod that enables the administrator to Private Message or Email specific Usergroups?
I have the Usergroups Mod installed, Private Messaging, and Email all Users and it would be a good feature to be able to send PMs or emails to each specific usergroup rather than doing it individually
Postet den 09 Nov 2011
Carefree
Advanced Member
Innlegg: 4224
4224
If nobody has done it, I'll write it for you today.
Postet den 09 Nov 2011
Webbo
Average Member
Innlegg: 982
982
I've searched and all I can find is a similar request in 2005 (http://forum.snitz.com/Forum/topic.asp?ARCHIVE=true&TOPIC_ID=58850)+

I'll leave it in your capable hands [^]
Postet den 10 Nov 2011
Carefree
Advanced Member
Innlegg: 4224
4224
Here you go. Either copy the following and replace your "admin_pop_mail.asp" or get it from SnitzBitz.
Code:

<%
'###############################################################################
'##
'##      Snitz Forums 2000 v3.4.07
'##
'###############################################################################
'##
'## Copyright © 2000-09 Michael Anderson, Pierre Gorissen,
'##      Huw Reddick and Richard Kinser
'##
'## This program is free. You can redistribute and/or modIfy it under the
'## terms of the GNU General Public License as published by the Free Software
'## Foundation; either version 2 or (at your option) any later version.
'##
'## All copyright notices regarding Snitz Forums 2000 must remain intact in
'## the scripts and in the HTML output. The "powered by" text/logo with a
'## link back to http://forum.snitz.com in the footer of the pages MUST
'## remain visible when the pages are viewed on the internet or intranet.
'##
'## This program is distributed in the hope that it will be useful but
'## WITHOUT ANY WARRANTY; without even an implied warranty of MERCHANTABILITY
'## or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
'## for more details.
'##
'## You should have received a copy of the GNU General Public License along
'## with this program; If not, write to:
'##
'##      Free Software Foundation, Inc.
'##      59 Temple Place, Suite 330
'##      Boston, MA 02111-1307
'##
'## Support can be obtained from our support forums at:
'##
'##      http://forum.snitz.com
'##
'## Correspondence and marketing questions can be sent to:
'##
'##      manderson@snitz.com
'##
'###############################################################################
'##
'## Email All Users 3.4b by Kevin Whipp (http://the-nut.com)
'##
'###############################################################################
%>
<!--#INCLUDE FILE="config.asp"-->
<!--#INCLUDE FILE="inc_func_member.asp"-->
<!--#INCLUDE FILE="inc_sha256.asp"-->
<!--#INCLUDE FILE="inc_header.asp"-->
<!--#INCLUDE FILE="inc_func_secure.asp"-->
<%
If Session(strCookieURL & "Approval") <> "15916941253" Then
	scriptname = split(request.servervariables("SCRIPT_NAME"),"/")
	Response.Redirect "admin_login.asp?target=" & scriptname(ubound(scriptname))
End If
Response.Write  "<table border=""0"" width=""100%"" align=""center"">" & vbNewLine & _
	"	<tr>" & vbNewLine & _
	"		<td width=""33%"" align=""left"" nowrap><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """>" & vbNewLine & _
	"		" & getCurrentIcon(strIconFolderOpen,"","") & " <a href=""default.asp"">All Forums</a><br />" & vbNewLine & _
	"		" & getCurrentIcon(strIconBar,"","") & getCurrentIcon(strIconFolderOpen,"","") & " <a href=""admin_home.asp"">Admin Section</a><br />" & vbNewLine & _
	"		" & getCurrentIcon(strIconBlank,"","") & getCurrentIcon(strIconBar,"","") & getCurrentIcon(strIconFolderOpenTopic,"","") & " Group Mailer<br /></font></td>" & vbNewLine & _
	"	</tr>" & vbNewLine & _
	"</table><br /><br />" & vbNewLine
If lcase(strEmail) <> "1" Then
	Response.Write	"<p><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strHiLiteFontColor & """>You do not have E-mail enabled.</font></p>" & vbNewLine
	WriteFooter
	Response.End
End If
dim strGroup, intGroup, strTable
strTable = strTablePrefix & "USERGROUPS"
If Request.Form("Method_Type") = "Send_EMail" Then
	Err_Msg = ""
	txtSubject = trim(Request.Form("Subject"))
	txtMessage = trim(Request.Form("Message"))
	If txtSubject = "" Then
		Err_Msg = "<li>You must enter a subject.</li>"
	End If
	If txtMessage = "" Then
		Err_Msg = Err_Msg & "<li>You must enter a message.</li>"
	End If
	If Err_Msg = "" Then
		If (TableExists(strTable) and Request.Form("UserGroup") > "0") Then
			intGroup = Request.Form("UserGroup")
			strSql = "SELECT USERGROUP_NAME FROM " & strTablePrefix & "USERGROUPS WHERE USERGROUP_ID = " & intGroup
			Set rsGroups = my_Conn.Execute(strSql)
			If NOT rsGroups.EOF Then
				strGroups=rsGroups("USERGROUP_NAME")
				rsGroups.Close
			End If
			Set rsGroups = Nothing
			strSql = "SELECT MEMBER_ID FROM " & strTablePrefix & "USERGROUP_USERS WHERE USERGROUP_ID = " & intGroup
			Set rsGroups = my_Conn.Execute(strSql)
			If NOT rsGroups.EOF Then
				rsGroups.MoveFirst
				Do While NOT rsGroups.EOF
					intMember = rsGroups("MEMBER_ID")
					strSql1 = "SELECT M_NAME, M_EMAIL FROM " & strMemberTablePrefix & "MEMBERS WHERE M_STATUS=1 AND MEMBER_ID=" & rsGroups("MEMBER_ID")
					Set rsMail = my_Conn.Execute(strSql1)
					If not rsMail.EOF Then
						strRecipientsName = rsMail("M_NAME")
						strRecipients = rsMail("M_EMAIL")
						strFromName = strForumTitle
						strFrom = strSEnder
						strSubject = txtSubject
						If Request.Form("emailfooter") = 1 Then
							strMessage = txtMessage & vbNewLine & vbNewLine
							strMessage = strMessage & "----------" & vbNewLine
							strMessage = strMessage & "You received this message from " & strForumTitle & " because you are a member of " & strGroups
							strMessage = strMessage & "Your username is: " & Member_Name & vbNewLine
							strMessage = strMessage & "The forums are located at " & strForumURL & "."
						Else
							strMessage = txtMessage
						End If
						%>
						<!--#INCLUDE FILE="inc_mail.asp" -->
						<%
						rsMail.Close
					End If
					Set rsMail = Nothing
					intMailSent = intMailSent+1
					rsGroups.MoveNext
				Loop
				rsGroups.Close
			End If
			Set rsGroups = Nothing
			Response.Write  "<table align=""center"" width=""50%"" border=""0"" cellpadding=""0"" cellspacing=""0"">" & vbNewLine & _
				"	<tr valign=""middle"">" & vbNewLine & _
				"		<td align=""center"" width=""100%"">" & vbNewLine & _
				"			<font face=""" & strDefaultFontFace & """ size=""" & strHeaderFontSize & """ color=""" & strDefaultFontColor & """>Mail sent to " & intMailSent & " " & strGroups & " member"
			If intMailSent = 0 or intMailSent > 1 Then
				Response.Write  "s"
			End If
			Response.Write  "." & vbNewLine & _
				"			</font>" & vbNewLine & _
				"			<meta http-equiv=""Refresh"" content=""5; URL=admin_pop_mail.asp""><br /><br />" & vbNewLine & _
				"			<font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """><a href=""admin_home.asp"">Return to Admin Home</a>" & vbNewLine & _
				"			</font>" & vbNewLine & _
				"		</td>" & vbNewLine & _
				"	</tr>" & vbNewLine & _
				"</table><br /><br />" & vbNewLine
		Else
			strSql = "SELECT M_NAME, M_EMAIL, M_LEVEL "
			strSql = strSql & " FROM " & strMemberTablePrefix & "MEMBERS"
			strSql = strSql & " WHERE M_STATUS = " & 1
			If Request.Form("optin") = 1 Then
				strSql = strSql & " AND M_RECEIVE_EMAIL = " & 1
			End If
			Select Case Request.Form("limitmods")
				Case 1
					strSql = strSql & " AND M_LEVEL = " & 2
				Case 2
					strSql = strSql & " AND M_LEVEL = " & 3
				Case 3
					strSql = strSql & " AND M_LEVEL >= " & 2
			End Select
			If Request.Form("strInitial") = 1 Then
				Initial = split("A|B|C|D|E|F","|")
				strSql = strSql & " AND (M_NAME LIKE '" & Initial(0) & "%'"
				For icnt = 1 to ubound(Initial)
					strSql = strSql & " OR M_NAME LIKE '" & Initial(icnt) & "%'"
				Next
				strSql = strSql & ")"
			ElseIf Request.Form("strInitial") = 2 Then
				Initial = split("G|H|I|J|K|L|M","|")
				strSql = strSql & " AND (M_NAME LIKE '" & Initial(0) & "%'"
				For icnt = 1 to ubound(Initial)
					strSql = strSql & " OR M_NAME LIKE '" & Initial(icnt) & "%'"
				Next
				strSql = strSql & ")"
			ElseIf Request.Form("strInitial") = 3 Then
				Initial = split("N|O|P|Q|R|S","|")
				strSql = strSql & " AND (M_NAME LIKE '" & Initial(0) & "%'"
				For icnt = 1 to ubound(Initial)
					strSql = strSql & " OR M_NAME LIKE '" & Initial(icnt) & "%'"
				Next
				strSql = strSql & ")"
			ElseIf Request.Form("strInitial") = 4 Then
				Initial = split("T|U|V|W|X|Y|Z","|")
				strSql = strSql & " AND (M_NAME LIKE '" & Initial(0) & "%'"
				For icnt = 1 to ubound(Initial)
					strSql = strSql & " OR M_NAME LIKE '" & Initial(icnt) & "%'"
				Next
				strSql = strSql & ")"
			End If
			Set rsMail = Server.CreateObject("ADODB.RecordSet")
			rsMail.Open strSql, my_Conn, 0, 1, &H0001
			If rsMail.EOF Then
				recMemberCount = ""
			Else
				allMemberData = rsMail.GetRows(-1)
				recMemberCount = UBound(allMemberData, 2)
			End If
			rsMail.Close
			Set rsMail = Nothing
			Server.ScriptTimeout = 10000
			If recMemberCount <> "" Then
				mM_NAME = 0
				mM_EMAIL = 1
				mM_LEVEL = 2
				Response.Write  "<p align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """>Sending E-Mail</font></p>" & vbNewLine
				For RowCount = 0 to recMemberCount
					Member_Name = allMemberData(mM_NAME,RowCount)
					Member_EMail = allMemberData(mM_EMAIL,RowCount)
					Member_Level = allMemberData(mM_LEVEL,RowCount)
					strRecipientsName = Member_Name
					strRecipients = Member_EMail
					strFromName = strForumTitle
					strFrom = strSEnder
					strSubject = txtSubject
					If Request.Form("emailfooter") = 1 Then
						strMessage = txtMessage & vbNewLine & vbNewLine
						strMessage = strMessage & "----------" & vbNewLine
						strMessage = strMessage & "You received this message from " & strForumTitle & " because you are "
						Select Case Member_Level
							Case 1
								strMessage = strMessage & "a member "
							Case 2
								strMessage = strMessage & "a moderator "
							Case 3
								strMessage = strMessage & "an administrator "
						End Select
						strMessage = strMessage & "of the forums." & vbNewLine
						strMessage = strMessage & "Your username is: " & Member_Name & vbNewLine
						strMessage = strMessage & "The forums are located at " & strForumURL & "."
					Else
						strMessage = txtMessage
					End If
					%>
					<!--#INCLUDE FILE="inc_mail.asp" -->
					<%
				Next
				If recMemberCount = 0 Then
					Response.Write	"<p align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """>Sent " & (recMemberCount + 1) & " E-Mail</font></p>" & vbNewLine
				Else
					Response.Write	"<p align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """>Sent " & (recMemberCount + 1) & " E-Mails</font></p>" & vbNewLine
				End If
			Else
				Response.Write	"<p><font face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """>No Members found</font></p>" & vbNewLine
			End If
		End If
	Else
		Response.Write	"<p><font face=""" & strDefaultFontFace & """ size=""" & strHeaderFontSize & """ color=""" & strHiLiteFontColor & """>There Was A Problem With Your E-mail</font></p>" & vbNewLine & _
			"<table>" & vbNewLine & _
			"	<tr>" & vbNewLine & _
			"		<td><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strHiLiteFontColor & """><ul>" & Err_Msg & "</ul></font></td>" & vbNewLine & _
			"	</tr>" & vbNewLine & _
			"</table>" & vbNewLine & _
			"<p><font size=""" & strDefaultFontSize & """><a href=""JavaScript:history.go(-1)"">Go Back To Enter Data</a></font></p>" & vbNewLine
	End If
Else
	Response.Write	"<form action=""admin_pop_mail.asp"" method=""Post"" id=""Form1"" name=""Form1"">" & vbNewLine & _
		"	<input type=""hidden"" name=""Method_Type"" value=""Send_EMail"">" & vbNewLine & _
		"	<table align=""center"" border=""0"" width=""70%"" cellspacing=""0"" cellpadding=""0"">" & vbNewLine & _
		"		<tr>" & vbNewLine & _
		"			<td bgcolor=""" & strPopUpBorderColor & """>" & vbNewLine & _
		"				<table border=""0"" width=""100%"" cellspacing=""1"" cellpadding=""1"">" & vbNewLine & _
		"					<tr valign=""middle"" height=""40"">" & vbNewLine & _
		"						<td align=""center"" bgColor=""" & strHeadCellColor  & """ noWrap colspan=""2""><font  face=""" & strDefaultFontFace & """ size=""" & strHeaderFontSize  & """ color=""" & strHeadFontColor & """><b>Group Mailer</b></font></td>" & vbNewLine & _
		"					</tr>" & vbNewLine & _
		"					<tr>" & vbNewLine & _
		"						<td bgColor=""" & strPopUpTableColor & """ noWrap vAlign=""top"" align=""right""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """><b>Subject:</b></font></td>" & vbNewLine & _
		"						<td bgColor=""" & strPopUpTableColor & """><input maxLength=""50"" name=""Subject"" tabindex=""1"" value="""" size=""50""></td>" & vbNewLine & _
		"					</tr>" & vbNewLine & _
		"					<script language=""JavaScript"">document.Form1.Subject.focus();</script>" & vbNewLine & _
		"					<tr>" & vbNewLine & _
		"						<td bgColor=""" & strPopUpTableColor & """ noWrap vAlign=""top"" align=""right""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """><b>Message:</b></font></td>" & vbNewLine & _
		"						<td bgColor=""" & strPopUpTableColor & """><textarea cols=""80"" name=""Message"" rows=""10"" tabindex=""2"" wrap=""VIRTUAL""></textarea></td>" & vbNewLine & _
		"					</tr>" & vbNewLine & _
		"					<tr>" & vbNewLine & _
		"						<td bgColor=""" & strPopUpTableColor & """ noWrap vAlign=""top"" align=""right""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """><b>User Names:</b></font></td>" & vbNewLine & _
		"						<td bgColor=""" & strPopUpTableColor & """><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """><input type=""radio"" class=""radio"" name=""strInitial"" value=""1"">A-F <input type=""radio"" class=""radio"" name=""strInitial"" value=""2"">G-M <input type=""radio"" class=""radio"" name=""strInitial"" value=""3"">N-S <input type=""radio"" class=""radio"" name=""strInitial"" value=""4"">T-Z <input type=""radio"" class=""radio"" name=""strInitial"" value=""5"" checked>All</font></td>" & vbNewLine & _
		"					</tr>" & vbNewLine
	If TableExists(strTable) Then
		Response.Write	"					<tr>" & vbNewLine & _
			"						<td bgColor=""" & strPopUpTableColor & """ noWrap vAlign=""top"" align=""right"">" & vbNewLine & _
			"							<font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """><b>User Groups:</b>" & vbNewLine & _
			"							</font>" & vbNewLine & _
			"						</td>" & vbNewLine & _
			"						<td bgColor=""" & strPopUpTableColor & """>" & vbNewLine & _
			"							<font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """>" & vbNewLine & _
			"								<input type=""radio""  class=""radio"" name=""UserGroup"" value=""0"" Checked> None" & vbNewLine
		strSql = "SELECT USERGROUP_ID, USERGROUP_NAME FROM " & strTablePrefix & "USERGROUPS ORDER BY USERGROUP_NAME ASC"
		Set rsGroups=my_Conn.Execute(strSql)
		If NOT rsGroups.EOF Then
			rsGroups.MoveFirst
			Do While NOT rsGroups.EOF
				strGroup=rsGroups("USERGROUP_NAME")
				intGroup=rsGroups("USERGROUP_ID")
				Response.Write	"								<input type=""radio""  class=""radio"" name=""UserGroup"" value=""" & intGroup & """> " & strGroup & vbNewLine
				rsGroups.MoveNext
			Loop
			rsGroups.Close
		End If
		Set rsGroups = Nothing
		Response.Write	"							</font>" & vbNewLine & _
			"						</td>" & vbNewLine & _
			"					</tr>" & vbNewLine
	End If
	Response.Write	"					<tr>" & vbNewLine & _
		"						<td bgColor=""" & strPopUpTableColor & """ noWrap vAlign=""top"" align=""right"">" & vbNewLine & _
		"							<font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """><B>Member <br>Level:</B>" & vbNewLine & _
		"							</font>" & vbNewLine & _
		"						</td>" & vbNewLine & _
		"						<td bgColor=""" & strPopUpTableColor & """>" & vbNewLine & _
		"							<font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """>" & vbNewLine & _
		"								<input type=""radio"" class=""radio"" name =""limitmods"" value=""0"" checked>All Members.<br>" & vbNewLine & _
		"								<input type=""radio"" class=""radio"" name =""limitmods"" value=""1"">Moderators Only<br>" & vbNewLine & _
		"								<input type=""radio"" class=""radio"" name =""limitmods"" value=""2"">Administrators Only<br>" & vbNewLine & _
		"								<input type=""radio"" class=""radio"" name =""limitmods"" value=""3"">Administrators and Moderators" & vbNewLine & _
		"							</font>" & vbNewLine & _
		"						</td>" & vbNewLine & _
		"					</tr>" & vbNewLine & _
		"					<tr>" & vbNewLine & _
		"						<td bgColor=""" & strPopUpTableColor & """ noWrap vAlign=""top"" align=""right"">" & vbNewLine & _
		"							<font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """> " & vbNewLine & _
		"							</font>" & vbNewLine & _
		"						</td>" & vbNewLine & _
		"						<td bgColor=""" & strPopUpTableColor & """>" & vbNewLine & _
		"							<font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """>" & vbNewLine & _
		"								<input name =""optin"" type=""checkbox"" value=""1"" checked>Check here For opt-in users ONLY. <br />" & vbNewLine & _
		"								<input name =""emailfooter"" type=""checkbox"" value=""1"" checked>Check here to include email footer." & vbNewLine & _
		"							</font>" & vbNewLine & _
		"						</td>" & vbNewLine & _
		"					</tr>" & vbNewLine & _
		"					<tr>" & vbNewLine & _
		"						<td bgColor=""" & strPopUpTableColor & """ colspan=""2"" align=""center"">" & vbNewLine & _
		"							<input type=""submit"" value=""Send E-Mail"" id=""submit1"" name=""submit1"" tabindex=""3""> " & vbNewLine & _
		"							<input type=""reset"" value=""Reset"" id=""reSet1"" name=""reSet1"" tabindex=""4"">" & vbNewLine & _
		"						</td>" & vbNewLine & _
		"					</tr>" & vbNewLine & _
		"				</table>" & vbNewLine & _
		"			</td>" & vbNewLine & _
		"		</tr>" & vbNewLine & _
		"	</table>" & vbNewLine & _
		"</form>" & vbNewLine
End If
WriteFooter
Response.End

Function TableExists(TabletoFind)
	TableExists = False
	Set adoxConn = CreateObject("ADOX.Catalog")
	Set adodbConn = Server.CreateObject("ADODB.Connection")
	adodbConn.Open(strConnString)
	adoxConn.activeConnection = adodbConn
	IsThere = False
	For each table in adoxConn.tables
		If lcase(table.name) = lcase(TabletoFind) Then
			IsThere = True
			Exit For
		End If
	Next
	adodbConn.Close
	Set adodbConn = Nothing
	Set adoxConn = Nothing
	If IsThere Then TableExists = True
End Function
%>
Sist redigert av