Snitz Forums 2000
Snitz Forums 2000
Home | Profile | Register | Active Topics | Members | Search | FAQ
Username:
Password:
Save Password
Forgot your Password?

 All Forums
 Help Groups for Snitz Forums 2000 Users
 Help: General / Classic ASP versions(v3.4.XX)
 subscription_list error
 New Topic
 Printer Friendly
Next Page
Author Previous Topic Topic Next Topic
Page: of 2

Torborg
Junior Member

Norway
109 Posts

Posted - 28 December 2013 :  18:59:54  Show Profile  Reply with Quote
Hello

Earlier i could delete members subscriptions. The forum is almost 13 years and some users is no longer there and their email stops working. I need to clean up in some of the subscriptions.

For a while the subscription_list.asp has not been working.

I get this error:

Response object error 'ASP 0251 : 80004005'
Response Buffer Limit Exceeded
/enbiolog/subscription_list.asp, line 0
Execution of the ASP page caused the Response Buffer to exceed it's configured limit.

I read somewhere that it could be something with IIS6

Can any of you help??

Davio
Development Team Member

Jamaica
12217 Posts

Posted - 28 December 2013 :  20:22:09  Show Profile
It sounds like you have a lot of subscriptions to manage, that the server can't handle showing all of them at the same time.
Would need to recode the page so that it shows like maybe 10 or 50 at a time.

Either that, or server admin would need to increase the limit (default is 4mb) to something higher. But that really shouldn't be needed.

P.S. Hi Torborg!

Support Snitz Forums

Edited by - Davio on 28 December 2013 20:36:11
Go to Top of Page

Webbo
Average Member

United Kingdom
982 Posts

Posted - 29 December 2013 :  04:13:32  Show Profile  Visit Webbo's Homepage
Create a new asp file as below and name it lostsubscriptions.asp


<!--#INCLUDE FILE="config.asp" -->

<%

Dim strSql, conn, lngCount


strSql = "DELETE " & strTablePrefix & "SUBSCRIPTIONS FROM " & strTablePrefix & "SUBSCRIPTIONS LEFT JOIN " & _
strTablePrefix & "TOPICS ON " & strTablePrefix & "SUBSCRIPTIONS.TOPIC_ID = " & strTablePrefix & _
"TOPICS.TOPIC_ID WHERE " & strTablePrefix & "TOPICS.TOPIC_ID Is Null;"



Set conn = Server.CreateObject("ADODB.Connection")

conn.Open strConnString

conn.Execute strSql, lngCount, 1 + 128

Response.Write lngCount & " Subscriptions to lost Topics were Deleted<br>"

conn.Close

%>


Upload the file to your website forum directory and then run it in your browser, ie http://yoursitename/forumdirectory/lostsubscriptions.asp

This will remove any subscriptions that no longer link to a topic, ie topics that have been deleted or archived, which should reduce the number in your subscription list substantially

Go to Top of Page

Carefree
Advanced Member

Philippines
4217 Posts

Posted - 29 December 2013 :  12:42:59  Show Profile
Here's another subscription management program (limits results to 50 per page, searchable by member name). Links are provided on each row to delete all subscriptions by member or individually (the first deletion link of each row will remove all subscriptions for that particular member, the second will delete only the particular subscription on that row). I wrote this to sort by "date last here". That way, you can easily remove subscriptions of those who no longer visit the forum. I did not include any other sorting, because I couldn't see any benefit.

"subscriptions.asp"


<%
'#################################################################################
'## Snitz Forums 2000 v3.4.07
'#################################################################################
'## Copyright (C) 2000-09 Michael Anderson, Pierre Gorissen,
'## Huw Reddick and Richard Kinser
'##
'## This program is free software; you can redistribute it and/or
'## modify it under the terms of the GNU General Public License
'## as published by the Free Software Foundation; either version 2
'## of the License, or (at your option) any later version.
'##
'## All copyright notices regarding Snitz Forums 2000
'## must remain intact in the scripts and in the outputted HTML
'## 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 the 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 the Free Software
'## Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
'##
'## Support can be obtained from our support forums at:
'## http://forum.snitz.com
'##
'## Correspondence and Marketing Questions can be sent to:
'## manderson@snitz.com
'##
'#################################################################################

'#################################################################################
'## Subscription_List.asp - This page will search through all subscriptions.
'## If the user is an administrator, then it will loop
'## through all the subscriptions, otherwise it will only
'## look for those subscriptions which apply directly to
'## them.
'#################################################################################
%>
<!--#INCLUDE FILE="config.asp"-->
<!--#INCLUDE FILE="inc_header.asp" -->
<%
If mLev < 4 or strSubscription = 0 Then
Response.Redirect "default.asp"
end if
Response.Write " <table border=""0"" width=""100%"">" & vbNewline & _
" <tr>" & vbNewline & _
" <td width=""33%"" align=""left"" nowrap>" & vbNewline & _
" <font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """>" & vbNewline & _
" " & getCurrentIcon(strIconFolderOpen,"","") & " <a href=""default.asp"">All Forums</a><br />" & vbNewline & _
" " & getCurrentIcon(strIconBar,"","") & getCurrentIcon(strIconFolderOpenTopic,"","") & " Subscription Manager<br /></font></td>" & vbNewline & _
" </tr>" & vbNewline & _
" </table><br />" & vbNewline
if strSubscription = 0 then
Go_Result : Response.End
end if
If Request("mode")="del" Then
my_Conn.Execute("DELETE FROM " & strTablePrefix & "SUBSCRIPTIONS WHERE SUBSCRIPTION_ID=" & Request("ID"))
Response.Redirect "subscriptions.asp"
End If
If Request("mode")="mem" Then
my_Conn.Execute("DELETE FROM " & strTablePrefix & "SUBSCRIPTIONS WHERE MEMBER_ID=" & Request("ID"))
Response.Redirect "subscriptions.asp"
End If
Response.Write " <script language=""JavaScript"" type=""text/javascript"">" & vbNewLine & _
" function ChangePage(fnum){" & vbNewLine & _
" if (fnum == 1) {" & vbNewLine & _
" document.PageNum1.submit();" & vbNewLine & _
" }" & vbNewLine & _
" else {" & vbNewLine & _
" document.PageNum2.submit();" & vbNewLine & _
" }" & vbNewLine & _
" }" & vbNewLine & _
" </script>" & vbNewLine
mypage = trim(chkString(request("whichpage"),"SQLString"))
If ((mypage = "") or (IsNumeric(mypage) = FALSE)) Then
mypage = 1
mypage = cLng(mypage)
End If
If Request("Search")>"" Then
strSearched=Request("Search")
strSearch=" WHERE M.M_NAME LIKE '%" & Request("Search") & "%'"
strSql="SELECT MEMBER_ID FROM " & strMemberTablePrefix & "MEMBERS WHERE M_NAME LIKE '%" & Request("Search") & "%'"
Set rsMem=my_Conn.Execute(strSql)
If not rsMem.EOF Then
strSearch1=" WHERE MEMBER_ID=" & rsMem("MEMBER_ID")
rsMem.Close
End If
Set rsMem=Nothing
End If
If Request("total")>"" Then
strSearch=""
strSearch1=""
strSearched=""
End If
strSQL = "SELECT COUNT(SUBSCRIPTION_ID) AS CNT FROM " & strTablePrefix & "SUBSCRIPTIONS" & strSearch1
Set rsCnt=my_Conn.Execute(strSql)
If not rsCnt.EOF Then
intCnt=rsCnt("CNT")
If intCnt>50 Then
MaxPages=intCnt/50
If MaxPages<>cInt(intCnt/50) Then
MaxPages=cInt(MaxPages)+1
End If
End If
rsCnt.Close
End If
Set rsCnt=Nothing
If intCnt > 0 Then
strSQL1 = "SELECT S.SUBSCRIPTION_ID, S.MEMBER_ID, M.M_NAME, M.M_LASTHEREDATE, " & _
"S.CAT_ID, C.CAT_NAME, C.CAT_STATUS, C.CAT_SUBSCRIPTION, " & _
"S.FORUM_ID, F.F_SUBJECT, F.F_STATUS, F.F_SUBSCRIPTION, " & _
"S.TOPIC_ID, T.T_SUBJECT, T.T_STATUS " & _
"FROM (((" & strTablePrefix & "SUBSCRIPTIONS S INNER JOIN " & strMemberTablePrefix & "MEMBERS M ON S.MEMBER_ID = M.MEMBER_ID) " & _
"LEFT JOIN " & strTablePrefix & "TOPICS T ON S.TOPIC_ID = T.TOPIC_ID) " & _
"LEFT JOIN " & strTablePrefix & "FORUM F ON S.FORUM_ID = F.FORUM_ID) " & _
"LEFT JOIN " & strTablePrefix & "CATEGORY C ON S.CAT_ID = C.CAT_ID" & strSearch & " ORDER BY M.M_LASTHEREDATE ASC"
Set rsC = my_Conn.Execute(strSQL1)
If not rsC.EOF Then
If myPage>1 Then
rsC.Move(cInt(myPage-1)*50)
Else
rsC.MoveFirst
End If
intI=0:intC=0
Response.Write "<form action=""subscriptions.asp"" method=""post"">" & vbNewLine &_
" <table border=""0"" width=""100%"" cellspacing=""0"" cellpadding=""0"" align=""center"">" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td bgcolor=""" & strTableBorderColor & """>" & vbNewLine & _
" <table border=""0"" width=""100%"" cellspacing=""1"" cellpadding=""4"" align=""center"">" & vbNewLine & _
" <tr valign=""middle"" bgcolor=""" & strCategoryCellColor & """>" & vbNewLine & _
" <td align=""center"" colspan=""2"" width=""100%"">" & vbNewLine & _
" <font face=""" & strDefaultFontFace & """ size=""" & strHeaderFontSize+1 & """ color=""" & strCategoryFontColor & """><b>Subscription Manager</b></font>" & vbNewLine & _
" </td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" <tr valign=""middle"" bgcolor=""" & strHeadCellColor & """>" & vbNewLine & _
" <td colspan=""2"" align=""center"" width=""100%"">" & vbNewLine & _
" <font face=""" & strDefaultFontFace & """ size=""" & strHeaderFontSize & """ color=""" & strHeadFontColor & """><b>Search</b></font>" & vbNewLine & _
" </td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" <tr valign=""middle"" bgcolor=""" & strForumCellColor & """>" & vbNewLine & _
" <td align=""right"" width=""20%"">" & vbNewLine & _
" <font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """>Member Name:  </font>" & vbNewLine & _
" </td>" & vbNewLine & _
" <td align=""left"" width=""80%"">" & vbNewLine & _
" <input type=""text"" name=""Search"" maxlength=""75"" style=""width:100%; color:maroon; font-weight:bold;"" value=""" & strSearched & """ />" & vbNewLine & _
" </td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" </table>" & vbNewLine & _
" </td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" <tr valign=""top"" bgColor=""transparent"">" & vbNewLine & _
" <td align=""center"" width=""100%"">" & vbNewLine & _
" <input type=""submit"" name=""submit"" value=""Submit"" />   <input type=""submit"" name=""total"" value=""Clear"" />" & vbNewLine & _
" </td>" & vbNewLine &_
" </tr>" & vbNewLine & _
" </table>" & vbNewLine & _
"</form><br />" & vbNewLine & _
"<table border=""0"" width=""100%"" cellspacing=""0"" cellpadding=""0"" align=""center"">" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td bgcolor=""" & strTableBorderColor & """>" & vbNewLine & _
" <table border=""0"" width=""100%"" cellspacing=""1"" cellpadding=""4"" align=""center"">" & vbNewLine & _
" <tr valign=""middle"" bgcolor=""" & strHeadCellColor & """>" & vbNewLine & _
" <td align=""center"" width=""23%"">" & vbNewLine & _
" <font face=""" & strDefaultFontFace & """ size=""" & strHeaderFontSize & """ color=""" & strHeadFontColor & """><b>Category</b></font>" & vbNewLine & _
" </td>" & vbNewLine & _
" <td align=""center"" width=""23%"">" & vbNewLine & _
" <font face=""" & strDefaultFontFace & """ size=""" & strHeaderFontSize & """ color=""" & strHeadFontColor & """><b>Forum</b></font>" & vbNewLine & _
" </td>" & vbNewLine & _
" <td align=""center"" width=""23%"">" & vbNewLine & _
" <font face=""" & strDefaultFontFace & """ size=""" & strHeaderFontSize & """ color=""" & strHeadFontColor & """><b>Topic</b></font>" & vbNewLine & _
" </td>" & vbNewLine & _
" <td align=""center"" width=""14%"">" & vbNewLine & _
" <font face=""" & strDefaultFontFace & """ size=""" & strHeaderFontSize & """ color=""" & strHeadFontColor & """><b>Member</b></font>" & vbNewLine & _
" </td>" & vbNewLine & _
" <td align=""center"" width=""12px;"">" & vbNewLine & _
" <font face=""" & strDefaultFontFace & """ size=""" & strHeaderFontSize & """ color=""" & strHeadFontColor & """><b> </b></font>" & vbNewLine & _
" </td>" & vbNewLine & _
" <td align=""center"" width=""14%"">" & vbNewLine & _
" <font face=""" & strDefaultFontFace & """ size=""" & strHeaderFontSize & """ color=""" & strHeadFontColor & """><b>Last Here</b></font>" & vbNewLine & _
" </td>" & vbNewLine & _
" <td align=""center"" width=""12px;"">" & vbNewLine & _
" <font face=""" & strDefaultFontFace & """ size=""" & strHeaderFontSize & """ color=""" & strHeadFontColor & """><b> </b></font>" & vbNewLine & _
" </td>" & vbNewLine & _
" </tr>" & vbNewLine
Do while not rsC.EOF
intMem=rsC("MEMBER_ID")
strCat=rsC("CAT_NAME")
strFor=rsC("F_SUBJECT")
strTop=rsC("T_SUBJECT")
strMem=rsC("M_NAME")
strHer=rsC("M_LASTHEREDATE")
intC=intC+1
If intC/50 = cInt(intC/50) Then
Exit Do
End If
If intI=0 Then
CColor=strForumCellColor
Else
CColor=strForumFirstCellColor
End If
Response.Write " <tr valign=""middle"" bgColor=""" & CColor & """>" & vbNewLine & _
" <td align=""left"">" & vbNewLine & _
" <font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontSize & """>" & strCat & "</font>" & vbNewLine & _
" </td>" & vbNewLine & _
" <td align=""left"">" & vbNewLine & _
" <font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontSize & """>" & strFor & "</font>" & vbNewLine & _
" </td>" & vbNewLine & _
" <td align=""left"">" & vbNewLine & _
" <font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontSize & """>" & strTop & "</font>" & vbNewLine & _
" </td>" & vbNewLine & _
" <td align=""left"">" & vbNewLine & _
" <font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontSize & """>" & strMem & "</font>" & vbNewLine & _
" </td>" & vbNewLine & _
" <td align=""left"">" & vbNewLine & _
" <a href=""subscriptions.asp?mode=mem&ID="&intMem&"""" & dWStatus("Delete All Member's Subscriptions") & "><acronym style=""border:none; text-decoration:none"" title=""Delete All Member's Subscriptions""><img src="""& strImageURL &"icon_trashcan.gif"" style=""border:none"" alt=""Delete All Member's Subscriptions"" hspace=""0"" style=""text-decoration:none;""></acronym></a>" & vbNewLine & _
" </td>" & vbNewLine & _
" <td align=""left"">" & vbNewLine & _
" <font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontSize & """>" & strtoDate(strHer) & "</font>" & vbNewLine & _
" </td>" & vbNewLine & _
" <td align=""left"">" & vbNewLine & _
" <a href=""subscriptions.asp?mode=del&ID="&rsC("SUBSCRIPTION_ID")&"""" & dWStatus("Delete Subscription") & "><acronym style=""border:none; text-decoration:none"" title=""Delete Subscription""><img src="""& strImageURL &"icon_trashcan.gif"" style=""border:none"" alt=""Delete Subscription"" hspace=""0"" style=""text-decoration:none;""></acronym></a>" & vbNewLine & _
" </td>" & vbNewLine & _
" </tr>" & vbNewLine
intI=1-intI
rsC.MoveNext
Loop
rsC.Close
End If
Set rsC=Nothing
Else
Response.Write "<table border=""0"" width=""100%"" cellspacing=""0"" cellpadding=""0"" align=""center"">" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td bgcolor=""" & strTableBorderColor & """>" & vbNewLine & _
" <table border=""0"" width=""100%"" cellspacing=""1"" cellpadding=""4"" align=""center"">" & vbNewLine & _
" <tr valign=""middle"">" & vbNewLine & _
" <td bgColor=""" & strForumCellColor & """>" & vbNewLine & _
" <font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontSize & """>No subscriptions found!</font>" & vbNewLine & _
" </td>" & vbNewLine & _
" </tr>" & vbNewLine
End If
Response.Write " </table>" & vbNewLine & _
" </td>" & vbNewLine & _
" </tr>" & vbNewLine & _
"</table>" & vbNewLine
If MaxPages>1 Then
Call DropDownPaging(1)
End If
WriteFooter
Response.End

Sub DropDownPaging(fnum)
If maxpages > 1 Then
If mypage = "" Then
pge = 1
Else
pge = mypage
End If
If Request.QueryString("type")>"" Then strAction=Request.QueryString("type")
Response.Write "<form name=""PageNum" & fnum & """ action=""subscriptions.asp"">" & vbNewLine & _
" <input type=""hidden"" name=""type"" value=""" & strAction & """>" & vbNewLine & _
" <table border=""0"" width=""100%"" cellspacing=""0"" cellpadding=""0"" align=""center"">" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td align=""left"" width=""160px;"">" & vbNewLine & _
" <font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontSize & """>" & vbNewLine & _
" <b>Page: </b>" & vbNewLine & _
" <Select name=""whichpage"" size=""1"" onchange=""ChangePage(" & fnum & ");"">" & vbNewLine
For counter = 1 to maxpages
If counter <> cLng(pge) Then
Response.Write " <option value=""" & counter & """>" & counter & "</option>" & vbNewLine
Else
Response.Write " <option selected value=""" & counter & """>" & counter & "</option>" & vbNewLine
End If
Next
Response.Write " </select><b> of " & maxpages & "</b>" & vbNewLine & _
" </font>" & vbNewLine & _
" </td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" </table>" & vbNewLine &_
"</form>" & vbNewLine
End If
End Sub
%>
[/CODE]


I made some small modifications to the original code I posted above, primarily for aesthetics.

Edited by - Carefree on 29 December 2013 21:07:07
Go to Top of Page

Torborg
Junior Member

Norway
109 Posts

Posted - 29 December 2013 :  14:27:57  Show Profile
Thanks Carefree and Webbo! I will try the last script. I haven't archived anything and deleted very few posts, so I don't think the first one will help.

And hi DAVIO !! So nice that you are still here.

I have been a member since January 2001. Davio and Rui has helped me a lot. But in this forum I will remain new member as long as I don't talk much

Edited by - Torborg on 29 December 2013 14:33:15
Go to Top of Page

Webbo
Average Member

United Kingdom
982 Posts

Posted - 01 January 2014 :  09:57:34  Show Profile  Visit Webbo's Homepage
Carefree, have you got a subscription file that will delete all subscriptions before a specific date, or for instance 'older than...' and a drop down of options ie 1 month, 2 months, 3 months, etc, etc ?
Go to Top of Page

Carefree
Advanced Member

Philippines
4217 Posts

Posted - 01 January 2014 :  11:58:05  Show Profile
No, but wouldn't be too difficult to write one. It's 1:00 a.m. here and time for some rest, but will write it tomorrow.

Edited by - Carefree on 02 January 2014 01:42:36
Go to Top of Page

Webbo
Average Member

United Kingdom
982 Posts

Posted - 01 January 2014 :  16:46:59  Show Profile  Visit Webbo's Homepage
Get some rest you've a busy year ahead [;D]
Go to Top of Page

Carefree
Advanced Member

Philippines
4217 Posts

Posted - 02 January 2014 :  01:42:51  Show Profile
OK - in order to do this, have to add a date field to the subscriptions when they are made, since that isn't currently recorded. So if you wanted to use this function now to purge your subscriptions, it isn't possible.

If you want it for future use; however, it's easy enough.
Go to Top of Page

Webbo
Average Member

United Kingdom
982 Posts

Posted - 02 January 2014 :  01:56:27  Show Profile  Visit Webbo's Homepage
Wouldn't it be easier to do it using the topic date record as that is already used?

Effectively deleting subscriptions for topics started by date
Go to Top of Page

Carefree
Advanced Member

Philippines
4217 Posts

Posted - 02 January 2014 :  02:06:00  Show Profile
Not at all. Suppose you just joined a forum, read an older topic about something you were interested in and subscribed to it. Then your subscription gets deleted the next day because the topic is old....

The only effective method will require adding a field.
Go to Top of Page

Carefree
Advanced Member

Philippines
4217 Posts

Posted - 02 January 2014 :  04:55:12  Show Profile
OK - I wrote this, get it at SnitzBitz.

CAUTION! If there are existing subscriptions when you add this, and you use the drop-down menu to delete older subscriptions, they will ALL be deleted without warning.

New subscriptions, made after this modification, will have the date of the subscription added to the database and the drop-down menu will function properly for them.

You can search for members with subscriptions and filter accordingly.

The default display of subscriptions are sorted based upon the length of time since the member last visited, with the longest gap listed first. That makes deletion of older subscriptions simpler.

You can delete subscriptions in one of three ways:

1) Individually, by using the deletion link (trashcan) at the end of each line.
2) By member, by using the deletion link (trashcan) after the member's name.
3) By using the drop-down menu.
Go to Top of Page

Webbo
Average Member

United Kingdom
982 Posts

Posted - 02 January 2014 :  17:19:29  Show Profile  Visit Webbo's Homepage
I'll give this a go Carefree in a couple of days after warning my members I'm going to purge all existing subscriptions, thanks
Go to Top of Page

Carefree
Advanced Member

Philippines
4217 Posts

Posted - 02 January 2014 :  21:00:31  Show Profile
You're welcome.
Go to Top of Page

Webbo
Average Member

United Kingdom
982 Posts

Posted - 06 January 2014 :  03:12:30  Show Profile  Visit Webbo's Homepage
Hi Carefree,

I've added the above and have made a couple of changes to the subscriptions.asp file as below:

Altered lines 150-166 inclusive to:

           Response.Write "<form action=""subscriptions.asp"" id=""older"" name=""older"" method=""get"">" & vbNewLine & _
" <table border=""0"" width=""100%"" cellspacing=""0"" align=""right"">" & vbNewLine & _
" <tr valign=""bottom"">" & vbNewLine & _
" <td align=""right"" width=""100%"" bgcolor=""transparent"">" & vbNewLine & _
" <font face=""" & strDefaultFontFace & """ color=""" & strDefaultFontColor & """ size=""" & strDefaultFontSize & """>Delete all Subscriptions Older Than: " & vbNewLine & _
" <select name=""delold"" size=""1"" onchange=""document.older.submit()""><font face=""lucida console"">" & vbNewLine & _
" <option selected value=""0"">Select</option>" & vbNewLine & _
" <option value=""1"">All</option>" & vbNewLine & _
" <option value=""2""> 1</option>" & vbNewLine & _
" <option value=""3""> 2</option>" & vbNewLine & _
" <option value=""4""> 3</option>" & vbNewLine & _
" <option value=""5""> 6</option>" & vbNewLine & _
" <option value=""6"">12</option></font>" & vbNewLine & _
" </select> months</font>" & vbNewLine & _
" </td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" </table>" & vbNewLine & _
"</form><br />" & vbNewLine & _
"<form action=""subscriptions.asp"" method=""post"">" & vbNewLine &_
" <p> </p>" & vbNewLine & _


This gives the option of removing all subscriptions, plus in the original the 'selected' option (1 month) cannot work as it cannot be selected from what I can see.
I've also added a paragraph at the end to create a break before the next table.

A couple of things though, I couldn't see it working as the original subscriptions remained after running the options in the changed file in your download. So I deleted all subscriptions from the database and created a new subscription.

When running the file again with the option 'All' in my changes above, nothing was deleted so this part needs some of your magic (),
However, altering the SUB_DATE for the new subscription to a year older and selecting 6months option your file worked

Thanks


Edited by - Webbo on 06 January 2014 03:17:21
Go to Top of Page

Carefree
Advanced Member

Philippines
4217 Posts

Posted - 06 January 2014 :  09:59:52  Show Profile
Here:


<%
'###############################################################################
'##
'##	              Snitz Forums 2000 v3.4.07
'##
'###############################################################################
'##
'## Copyright © 2000-14 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
'##
'###############################################################################
%>
<!--#INCLUDE FILE="config.asp"-->
<!--#INCLUDE FILE="inc_header.asp" -->
<%
If mLev < 4 or strSubscription = 0 Then
	Response.Redirect	"default.asp"
end if
Response.Write	"      <table border=""0"" width=""100%"">" & vbNewline & _
		"        <tr>" & vbNewline & _
		"          <td width=""33%"" align=""left"" nowrap>" & vbNewline & _
		"          <font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """>" & vbNewline & _
		"          " & getCurrentIcon(strIconFolderOpen,"","") & " <a href=""default.asp"">All Forums</a><br />" & vbNewline  & _
		"          " & getCurrentIcon(strIconBar,"","") & getCurrentIcon(strIconFolderOpenTopic,"","") & " Subscription Manager<br /></font></td>" & vbNewline & _
		"        </tr>" & vbNewline & _
		"      </table><br />" & vbNewline
if strSubscription = 0 then
	Go_Result : Response.End
end if
If Request("mode")="del" Then
	my_Conn.Execute("DELETE FROM " & strTablePrefix & "SUBSCRIPTIONS WHERE SUBSCRIPTION_ID=" & Request("ID"))
	Response.Redirect	"subscriptions.asp"
End If
If Request("mode")="mem" Then
	my_Conn.Execute("DELETE FROM " & strTablePrefix & "SUBSCRIPTIONS WHERE MEMBER_ID=" & Request("ID"))
	Response.Redirect	"subscriptions.asp"
End If
Response.Write	"    <script language=""JavaScript"" type=""text/javascript"">" & vbNewLine & _
	"    function ChangePage(fnum){" & vbNewLine & _
	"    	if (fnum == 1) {" & vbNewLine & _
	"    		document.PageNum1.submit();" & vbNewLine & _
	"    	}" & vbNewLine & _
	"    	else {" & vbNewLine & _
	"    		document.PageNum2.submit();" & vbNewLine & _
	"    	}" & vbNewLine & _
	"    }" & vbNewLine & _
	"    </script>" & vbNewLine
mypage = trim(chkString(request("whichpage"),"SQLString"))
If ((mypage = "") or (IsNumeric(mypage) = FALSE)) Then
	mypage = 1
	mypage = cLng(mypage)
End If
If Request("Search")>"" Then
	strSearched=Request("Search")
	strSearch=" WHERE M.M_NAME LIKE '%" & Request("Search") & "%'"
	strSql="SELECT MEMBER_ID FROM " & strMemberTablePrefix & "MEMBERS WHERE M_NAME LIKE '%" & Request("Search") & "%'"
	Set rsMem=my_Conn.Execute(strSql)
	If not rsMem.EOF Then
		strSearch1=" WHERE MEMBER_ID=" & rsMem("MEMBER_ID")
		rsMem.Close
	End If
	Set rsMem=Nothing
End If
If Request("total")>"" Then
	strSearch=""
	strSearch1=""
	strSearched=""
End If
If Request("delold")>"" Then
	intDel=cInt(Request("delold"))
	If intDel=6 Then
		my_Conn.Execute("DELETE FROM " & strTablePrefix & "SUBSCRIPTIONS")
		Response.Write	"<table border=""0"" width=""100%"" cellspacing=""0"" cellpadding=""0"" align=""center"">" & vbNewLine & _
			"	<tr>" & vbNewLine & _
			"		<td bgcolor=""transparent"" align=""center"">" & vbNewLine & _
			"			<font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontSize & """>Old subscriptions deleted!</font>" & vbNewLine & _
			"		</td>" & vbNewLine & _
			"	</tr>" & vbNewLine & _
			"</table>" & vbNewLine & _
			"<meta http-equiv=""Refresh"" content=""3; URL=subscriptions.asp"">" & vbNewLine
		WriteFooter
		Response.End
	ElseIf intDel=4 Then 
		intDel=6
	ElseIf intDel=5 Then
		intDel=12
	End If
	strDate=DateAdd("m",-intDel,date)
	strDate=DatetoStr(strDate)
	strSql="DELETE FROM " & strTablePrefix & "SUBSCRIPTIONS WHERE SUB_DATE < '" & strDate & "'"
	my_Conn.Execute(strSql)
	Response.Write	"<table border=""0"" width=""100%"" cellspacing=""0"" cellpadding=""0"" align=""center"">" & vbNewLine & _
		"	<tr>" & vbNewLine & _
		"		<td bgcolor=""transparent"" align=""center"">" & vbNewLine & _
		"			<font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontSize & """>Old subscriptions deleted!</font>" & vbNewLine & _
		"		</td>" & vbNewLine & _
		"	</tr>" & vbNewLine & _
		"</table>" & vbNewLine & _
		"<meta http-equiv=""Refresh"" content=""3; URL=subscriptions.asp"">" & vbNewLine
	WriteFooter
	Response.End
End If
strSQL = "SELECT COUNT(SUBSCRIPTION_ID) AS CNT FROM " & strTablePrefix & "SUBSCRIPTIONS" & strSearch1
Set rsCnt=my_Conn.Execute(strSql)
If not rsCnt.EOF Then
	intCnt=rsCnt("CNT")
	If intCnt>50 Then
		MaxPages=intCnt/50
		If MaxPages<>cInt(intCnt/50) Then
			MaxPages=cInt(MaxPages)+1
		End If
	End If
	rsCnt.Close
End If
Set rsCnt=Nothing
If intCnt > 0 Then
	strSQL1 = "SELECT S.SUBSCRIPTION_ID, S.MEMBER_ID, M.M_NAME, M.M_LASTHEREDATE, " & _
		"S.CAT_ID, C.CAT_NAME, C.CAT_STATUS, C.CAT_SUBSCRIPTION, " & _
		"S.FORUM_ID, F.F_SUBJECT, F.F_STATUS, F.F_SUBSCRIPTION, " & _
		"S.TOPIC_ID, T.T_SUBJECT, T.T_STATUS " & _
		"FROM (((" & strTablePrefix & "SUBSCRIPTIONS S INNER JOIN " & strMemberTablePrefix & "MEMBERS M ON S.MEMBER_ID = M.MEMBER_ID) " & _
		"LEFT JOIN " & strTablePrefix & "TOPICS T ON S.TOPIC_ID = T.TOPIC_ID) " & _
		"LEFT JOIN " & strTablePrefix & "FORUM F ON S.FORUM_ID = F.FORUM_ID) " & _
		"LEFT JOIN " & strTablePrefix & "CATEGORY C ON S.CAT_ID = C.CAT_ID" & strSearch & " ORDER BY M.M_LASTHEREDATE ASC"
	Set rsC = my_Conn.Execute(strSQL1)
	If not rsC.EOF Then
		If myPage>1 Then
			rsC.Move(cInt(myPage-1)*50)
		Else
			rsC.MoveFirst
		End If
		intI=0:intC=0
		Response.Write	"<form action=""subscriptions.asp"" id=""older"" name=""older"" method=""get"">" & vbNewLine & _
			"	<table border=""0"" width=""100%"" cellspacing=""0"" align=""right"">" & vbNewLine & _
			"		<tr valign=""bottom"">" & vbNewLine & _
			"			<td align=""right"" width=""100%"" bgcolor=""transparent"">" & vbNewLine & _
			"				<font face=""" & strDefaultFontFace & """ color=""" & strDefaultFontColor & """ size=""" & strDefaultFontSize & """>Delete all Subscriptions Older Than: " & vbNewLine & _
			"				<select name=""delold"" size=""1"" onchange=""document.older.submit()""><font face=""lucida console"">" & vbNewLine & _
			"					<option value="""">Select</option>" & vbNewLine & _
			"					<option value=""1""> 1</option>" & vbNewLine & _
			"					<option value=""2""> 2</option>" & vbNewLine & _
			"					<option value=""3""> 3</option>" & vbNewLine & _
			"					<option value=""4""> 6</option>" & vbNewLine & _
			"					<option value=""5"">12</option>" & vbNewLine & _
			"					<option value=""6"">All</otion></font>" & vbNewLine & _
			"				</select> months</font>" & vbNewLine & _
			"			</td>" & vbNewLine & _
			"		</tr>" & vbNewLine & _
			"	</table>" & vbNewLine & _
			"</form><br />" & vbNewLine & _
			"<form action=""subscriptions.asp"" method=""post"">" & vbNewLine  &_
			"	<table border=""0"" width=""100%"" cellspacing=""0"" cellpadding=""0"" align=""center"">" & vbNewLine & _
			"		<tr>" & vbNewLine & _
			"			<td bgcolor=""" & strTableBorderColor & """>" & vbNewLine & _
			"				<table border=""0"" width=""100%"" cellspacing=""1"" cellpadding=""4"" align=""center"">" & vbNewLine & _
			"					<tr valign=""middle"" bgcolor=""" & strCategoryCellColor & """>" & vbNewLine & _
			"						<td align=""center"" colspan=""2"" width=""100%"">" & vbNewLine & _
			"							<font face=""" & strDefaultFontFace & """ size=""" & strHeaderFontSize+1 & """ color=""" & strCategoryFontColor & """><b>Subscription Manager</b></font>" & vbNewLine & _
			"						</td>" & vbNewLine & _
			"					</tr>" & vbNewLine & _
			"					<tr valign=""middle"" bgcolor=""" & strHeadCellColor & """>" & vbNewLine & _
			"						<td colspan=""2"" align=""center"" width=""100%"">" & vbNewLine & _
			"							<font face=""" & strDefaultFontFace & """ size=""" & strHeaderFontSize & """ color=""" & strHeadFontColor & """><b>Search</b></font>" & vbNewLine & _
			"						</td>" & vbNewLine & _
			"					</tr>" & vbNewLine & _
			"					<tr valign=""middle"" bgcolor=""" & strForumCellColor & """>" & vbNewLine & _
			"						<td align=""right"" width=""20%"">" & vbNewLine & _
			"							<font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """>Member Name:  </font>" & vbNewLine & _
			"						</td>" & vbNewLine & _
			"						<td align=""left"" width=""80%"">" & vbNewLine & _
			"							<input type=""text"" name=""Search"" maxlength=""75"" style=""width:100%; color:maroon; font-weight:bold;"" value=""" & strSearched & """ />" & vbNewLine & _
			"						</td>" & vbNewLine & _
			"					</tr>" & vbNewLine & _
			"				</table>" & vbNewLine & _
			"			</td>" & vbNewLine & _
			"		</tr>" & vbNewLine & _
			"		<tr valign=""top"" bgColor=""transparent"">" & vbNewLine & _
			"			<td align=""center"" width=""100%"">" & vbNewLine & _
			"				<input type=""submit"" name=""submit"" value=""Submit"" />   <input type=""submit"" name=""total"" value=""Clear"" />" & vbNewLine & _
			"			</td>" & vbNewLine  &_
			"		</tr>" & vbNewLine & _
			"	</table>" & vbNewLine & _
			"</form><br />" & vbNewLine & _
			"<table border=""0"" width=""100%"" cellspacing=""0"" cellpadding=""0"" align=""center"">" & vbNewLine & _
			"	<tr>" & vbNewLine & _
			"		<td bgcolor=""" & strTableBorderColor & """>" & vbNewLine & _
			"			<table border=""0"" width=""100%"" cellspacing=""1"" cellpadding=""4"" align=""center"">" & vbNewLine & _
			"				<tr valign=""middle"" bgcolor=""" & strHeadCellColor & """>" & vbNewLine & _
			"					<td align=""center"" width=""23%"">" & vbNewLine & _
			"						<font face=""" & strDefaultFontFace & """ size=""" & strHeaderFontSize & """ color=""" & strHeadFontColor & """><b>Category</b></font>" & vbNewLine & _
			"					</td>" & vbNewLine & _
			"					<td align=""center"" width=""23%"">" & vbNewLine & _
			"						<font face=""" & strDefaultFontFace & """ size=""" & strHeaderFontSize & """ color=""" & strHeadFontColor & """><b>Forum</b></font>" & vbNewLine & _
			"					</td>" & vbNewLine & _
			"					<td align=""center"" width=""23%"">" & vbNewLine & _
			"						<font face=""" & strDefaultFontFace & """ size=""" & strHeaderFontSize & """ color=""" & strHeadFontColor & """><b>Topic</b></font>" & vbNewLine & _
			"					</td>" & vbNewLine & _
			"					<td align=""center"" width=""14%"">" & vbNewLine & _
			"						<font face=""" & strDefaultFontFace & """ size=""" & strHeaderFontSize & """ color=""" & strHeadFontColor & """><b>Member</b></font>" & vbNewLine & _
			"					</td>" & vbNewLine & _
			"					<td align=""center"" width=""12px;"">" & vbNewLine & _
			"						<font face=""" & strDefaultFontFace & """ size=""" & strHeaderFontSize & """ color=""" & strHeadFontColor & """><b> </b></font>" & vbNewLine & _
			"					</td>" & vbNewLine & _
			"					<td align=""center"" width=""14%"">" & vbNewLine & _
			"						<font face=""" & strDefaultFontFace & """ size=""" & strHeaderFontSize & """ color=""" & strHeadFontColor & """><b>Last Here</b></font>" & vbNewLine & _
			"					</td>" & vbNewLine & _
			"					<td align=""center"" width=""12px;"">" & vbNewLine & _
			"						<font face=""" & strDefaultFontFace & """ size=""" & strHeaderFontSize & """ color=""" & strHeadFontColor & """><b> </b></font>" & vbNewLine & _
			"					</td>" & vbNewLine & _
			"				</tr>" & vbNewLine
		Do while not rsC.EOF
			intMem=rsC("MEMBER_ID")
			strCat=rsC("CAT_NAME")
			strFor=rsC("F_SUBJECT")
			strTop=rsC("T_SUBJECT")
			strMem=rsC("M_NAME")
			strHer=rsC("M_LASTHEREDATE")
			intC=intC+1
			If intC/50 = cInt(intC/50) Then
				Exit Do
			End If
			If intI=0 Then
				CColor=strForumCellColor
			Else 
				CColor=strForumFirstCellColor
			End If
			Response.Write	"				<tr valign=""middle"" bgColor=""" & CColor & """>" & vbNewLine & _
				"					<td align=""left"">" & vbNewLine & _
				"						<font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontSize & """>" & strCat & "</font>" & vbNewLine & _
				"					</td>" & vbNewLine & _
				"					<td align=""left"">" & vbNewLine & _
				"						<font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontSize & """>" & strFor & "</font>" & vbNewLine & _
				"					</td>" & vbNewLine & _
				"					<td align=""left"">" & vbNewLine & _
				"						<font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontSize & """>" & strTop & "</font>" & vbNewLine & _
				"					</td>" & vbNewLine & _
				"					<td align=""left"">" & vbNewLine & _
				"						<font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontSize & """>" & strMem & "</font>" & vbNewLine & _
				"					</td>" & vbNewLine & _
				"					<td align=""left"">" & vbNewLine & _
				"						<a href=""subscriptions.asp?mode=mem&ID="&intMem&"""" & dWStatus("Delete All Member's Subscriptions") & "><acronym style=""border:none; text-decoration:none"" title=""Delete All Member's Subscriptions""><img src="""& strImageURL &"icon_trashcan.gif"" style=""border:none"" alt=""Delete All Member's Subscriptions"" hspace=""0"" style=""text-decoration:none;""></acronym></a>" & vbNewLine & _
				"					</td>" & vbNewLine & _
				"					<td align=""left"">" & vbNewLine & _
				"						<font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontSize & """>" & strtoDate(strHer) & "</font>" & vbNewLine & _
				"					</td>" & vbNewLine & _
				"					<td align=""left"">" & vbNewLine & _
				"						<a href=""subscriptions.asp?mode=del&ID="&rsC("SUBSCRIPTION_ID")&"""" & dWStatus("Delete Subscription") & "><acronym style=""border:none; text-decoration:none"" title=""Delete Subscription""><img src="""& strImageURL &"icon_trashcan.gif"" style=""border:none"" alt=""Delete Subscription"" hspace=""0"" style=""text-decoration:none;""></acronym></a>" & vbNewLine & _
				"					</td>" & vbNewLine & _
				"				</tr>" & vbNewLine
			intI=1-intI
			rsC.MoveNext
		Loop
		rsC.Close
	End If
	Set rsC=Nothing
Else
	Response.Write	"<table border=""0"" width=""100%"" cellspacing=""0"" cellpadding=""0"" align=""center"">" & vbNewLine & _
		"	<tr>" & vbNewLine & _
		"		<td bgcolor=""" & strTableBorderColor & """>" & vbNewLine & _
		"			<table border=""0"" width=""100%"" cellspacing=""1"" cellpadding=""4"" align=""center"">" & vbNewLine & _
		"				<tr valign=""middle"">" & vbNewLine & _
		"					<td bgColor=""" & strForumCellColor & """>" & vbNewLine & _
		"						<font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontSize & """>No subscriptions found!</font>" & vbNewLine & _
		"					</td>" & vbNewLine & _
		"				</tr>" & vbNewLine
End If
Response.Write	"			</table>" & vbNewLine & _
	"		</td>" & vbNewLine & _
	"	</tr>" & vbNewLine & _
	"</table>" & vbNewLine
If MaxPages>1 Then
	Call DropDownPaging(1)
End If
WriteFooter
Response.End

Sub DropDownPaging(fnum)
	If maxpages > 1 Then
		If mypage = "" Then
			pge = 1
		Else
			pge = mypage
		End If
		If Request.QueryString("type")>"" Then strAction=Request.QueryString("type")
		Response.Write	"<form name=""PageNum" & fnum & """ action=""subscriptions.asp"">" & vbNewLine & _
			"	<input type=""hidden"" name=""type"" value=""" & strAction & """>" & vbNewLine & _
			"	<table border=""0"" width=""100%"" cellspacing=""0"" cellpadding=""0"" align=""center"">" & vbNewLine & _
			"		<tr>" & vbNewLine & _
			"			<td align=""left"" width=""160px;"">" & vbNewLine & _
			"				<font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontSize & """>" & vbNewLine & _
			"					<b>Page: </b>" & vbNewLine & _
			"					<Select name=""whichpage"" size=""1"" onchange=""ChangePage(" & fnum & ");"">" & vbNewLine
		For counter = 1 to maxpages
			If counter <> cLng(pge) Then
				Response.Write "						<option value=""" & counter &	""">" & counter & "</option>" & vbNewLine
			Else
				Response.Write "						<option selected value=""" & counter &	""">" & counter & "</option>" & vbNewLine
			End If
		Next
		Response.Write	"				</select><b> of " & maxpages & "</b>" & vbNewLine & _
			"				</font>" & vbNewLine & _
			"			</td>" & vbNewLine & _
			"		</tr>" & vbNewLine & _
			"	</table>" & vbNewLine  &_
			"</form>" & vbNewLine
	End If
End Sub
%>
Go to Top of Page
Page: of 2 Previous Topic Topic Next Topic  
Next Page
 New Topic
 Printer Friendly
Jump To:
Snitz Forums 2000 © 2000-2021 Snitz™ Communications Go To Top Of Page
This page was generated in 0.38 seconds. Powered By: Snitz Forums 2000 Version 3.4.07