<% '################################################################################# '## Snitz Forums 2000 v3.4.05 '################################################################################# '## Copyright (C) 2000-05 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 '## '################################################################################# %> <% 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 " " & vbNewLine mypage = trim(chkString(request("whichpage"),"SQLString")) if ((mypage = "") or (IsNumeric(mypage) = FALSE)) then mypage = 1 mypage = cLng(mypage) if mypage > 1 then strPage = "?whichpage=" & mypage selID = Request.QueryString("id") strAction = Request.QueryString("action") if strAction = "approve" then if selID = "-1" then Call EmailMembers("all") '## Forum_SQL - Approve all members strSql = "UPDATE " & strMemberTablePrefix & "MEMBERS_PENDING" strSql = strSql & " SET M_APPROVE = " & 1 my_Conn.Execute (strSql),,adCmdText + adExecuteNoRecords Response.Write "

Members Approved!

" & vbNewLine & _ " " & vbNewLine & _ "

All Pending Members have been approved! Their registration e-mails have been sent to them.

" & vbNewLine & _ "

Back To Members Pending


" & vbNewLine WriteFooter Response.End else Call EmailMembers("selected") aryID = split(selID, ",") for i = 0 to ubound(aryID) '## Forum_SQL - Approve all members strSql = "UPDATE " & strMemberTablePrefix & "MEMBERS_PENDING" strSql = strSql & " SET M_APPROVE = " & 1 strSql = strSql & " WHERE MEMBER_ID = " & aryID(i) my_Conn.Execute (strSql),,adCmdText + adExecuteNoRecords next Response.Write "

Members Approved!

" & vbNewLine & _ " " & vbNewLine & _ "

Selected Pending Members have been approved! Their registration e-mails have been sent to them.

" & vbNewLine & _ "

Back To Members Pending


" & vbNewLine WriteFooter Response.End end if elseif strAction = "delete" then if selID = "-1" then '## Forum_SQL - Delete the Member strSql = "DELETE FROM " & strMemberTablePrefix & "MEMBERS_PENDING " strSql = strSql & " WHERE M_STATUS = " & 0 strSql = strSql & " AND M_LEVEL = " & -1 my_Conn.Execute (strSql),,adCmdText + adExecuteNoRecords Response.Write "

Members Deleted!

" & vbNewLine & _ " " & vbNewLine & _ "

All pending members have been deleted!

" & vbNewLine & _ "

Back To Members Pending


" & vbNewLine WriteFooter Response.End else aryID = split(selID, ",") for i = 0 to ubound(aryID) '## Forum_SQL - Delete the Member strSql = "DELETE FROM " & strMemberTablePrefix & "MEMBERS_PENDING " strSql = strSql & " WHERE MEMBER_ID = " & aryID(i) my_Conn.Execute (strSql),,adCmdText + adExecuteNoRecords next Response.Write "

Members Deleted!

" & vbNewLine & _ " " & vbNewLine & _ "

Selected members have been deleted!

" & vbNewLine & _ "

Back To Members Pending


" & vbNewLine WriteFooter Response.End end if end if '## Forum_SQL - Find all records with the search criteria in them strSql = "SELECT M_NAME, M_EMAIL, MEMBER_ID, M_DATE, M_IP, M_KEY, M_APPROVE" strSql2 = " FROM " & strMemberTablePrefix & "MEMBERS_PENDING" strSql3 = " ORDER BY MEMBER_ID ASC" if strDBType = "mysql" then 'MySql specific code if mypage > 1 then OffSet = cLng((mypage - 1) * strPageSize) strSql4 = " LIMIT " & OffSet & ", " & strPageSize & " " end if '## Forum_SQL - Get the total pagecount strSql1 = "SELECT COUNT(MEMBER_ID) AS PAGECOUNT " set rsCount = my_Conn.Execute(strSql1 & strSql2) iPageTotal = rsCount(0).value rsCount.close set rsCount = nothing If iPageTotal > 0 then maxpages = (iPageTotal \ strPageSize ) if iPageTotal mod strPageSize <> 0 then maxpages = maxpages + 1 end if if iPageTotal < (strPageSize + 1) then intGetRows = iPageTotal elseif (mypage * strPageSize) > iPageTotal then intGetRows = strPageSize - ((mypage * strPageSize) - iPageTotal) else intGetRows = strPageSize end if else iPageTotal = 0 maxpages = 0 end if if iPageTotal > 0 then set rs = Server.CreateObject("ADODB.Recordset") rs.open strSql & strSql2 & strSql3 & strSql4, my_Conn, adOpenForwardOnly, adLockReadOnly, adCmdText arrMemberData = rs.GetRows(intGetRows) iMemberCount = UBound(arrMemberData, 2) rs.close set rs = nothing else iMemberCount = "" end if else 'end MySql specific code set rs = Server.CreateObject("ADODB.Recordset") rs.cachesize = strPageSize rs.open strSql & strSql2 & strSql3, my_Conn, adOpenStatic if not (rs.EOF or rs.BOF) then rs.movefirst rs.pagesize = strPageSize rs.absolutepage = mypage '** maxpages = cLng(rs.pagecount) if maxpages >= mypage then arrMemberData = rs.GetRows(strPageSize) iMemberCount = UBound(arrMemberData, 2) else iMemberCount = "" end if else iMemberCount = "" end if rs.Close set rs = nothing end if Response.Write " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine if maxpages > 1 then Response.Write " " & vbNewLine else Response.Write " " & vbNewLine end if Response.Write " " & vbNewLine & _ "
" & vbNewLine & _ " " & getCurrentIcon(strIconFolderOpen,"","") & " All Forums
" & vbNewLine & _ " " & getCurrentIcon(strIconBar,"","") & getCurrentIcon(strIconFolderOpen,"","") & " Admin Section
" & vbNewLine & _ " " & getCurrentIcon(strIconBlank,"","") & getCurrentIcon(strIconBar,"","") & getCurrentIcon(strIconFolderOpenTopic,"","") & " Members Pending...

" & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine Call DropDownPaging(1) Response.Write " " & vbNewLine & _ "
" & vbNewLine & _ "
 
" & vbNewLine if iMemberCount <> "" then if strRestrictReg = "1" then scolspan = " colspan=""2""" Response.Write " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ "
" & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine if strRestrictReg = "1" then Response.Write " " & vbNewLine end if Response.Write " " & vbNewLine & _ " " & vbNewLine & _ "
Administrator Options:
" & vbNewLine & _ "
  • Approve All Pending Members
  • " & vbNewLine & _ "
  • Approve Selected Pending Members
  • " & vbNewLine & _ "
  • Delete All Pending Members
  • " & vbNewLine & _ "
  • Delete Selected Pending Members
  • " & vbNewLine & _ "

    " & vbNewLine end if Response.Write " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ "
    NOTE: The following table will show you a list of registered users that are waiting to be authenticated.
    " & vbNewLine & _ " " & vbNewLine if iMemberCount <> "" then Response.Write " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine end if Response.Write " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine if strRestrictReg = "1" then Response.Write " " & vbNewLine end if Response.Write " " & vbNewLine & _ " " & vbNewLine if iMemberCount = "" then '## No members found in DB if strRestrictReg = "1" then intcolspan = 8 else intcolspan = 7 Response.Write " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine else mM_NAME = 0 mM_EMAIL = 1 mMEMBER_ID = 2 mM_DATE = 3 mM_IP = 4 mM_KEY = 5 mM_APPROVE = 6 rec = 1 intI = 0 for iMember = 0 to iMemberCount if (rec = strPageSize + 1) then exit for MP_MemberName = arrMemberData(mM_NAME, iMember) MP_MemberEMail = arrMemberData(mM_EMAIL, iMember) MP_MemberID = arrMemberData(mMEMBER_ID, iMember) MP_MemberDate = arrMemberData(mM_DATE, iMember) MP_MemberIP = arrMemberData(mM_IP, iMember) MP_MemberKey = arrMemberData(mM_KEY, iMember) MP_MemberApprove = arrMemberData(mM_APPROVE, iMember) if intI = 1 then CColor = strAltForumCellColor else CColor = strForumCellColor end if if MP_MemberApprove = 1 then Approved = "Yes" else Approved = "No" end if days = DateDiff("d", StrToDate(MP_MemberDate), strForumTimeAdjust) if days >= 15 then days2 = "" & days & "" else days2 = days end if Response.Write " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine if strRestrictReg = "1" then Response.Write " " & vbNewLine end if Response.Write " " & vbNewLine & _ " " & vbNewLine rec = rec + 1 intI = intI + 1 if intI = 2 then intI = 0 end if next Response.Write " " end if Response.Write "
    User NameE-mail AddressIP AddressRegisteredDays SinceActionApproved?" if iMemberCount <> "" then Response.Write "" else Response.Write " " end if Response.Write "
    No Members Found
    " & chkString(MP_MemberName, "display") & "" & MP_MemberEMail & "" & MP_MemberIP & "" & ChkDate(MP_MemberDate,"
    ",true) & "
    = 7 then Response.Write(strHiLiteFontColor) else Response.Write(strForumFontColor) Response.Write """>" & days2 & "Activate Account" & Approved & "
    " & vbNewLine & _ "
    " & vbNewLine if maxpages > 1 then Response.Write " " & vbNewLine & _ " " & vbNewLine Call DropDownPaging(2) Response.Write " " & vbNewLine & _ "

    " & vbNewLine else Response.Write "
    " & vbNewLine end if WriteFooter Response.End sub DropDownPaging(fnum) if maxpages > 1 then if mypage = "" then pge = 1 else pge = mypage end if scriptname = request.servervariables("script_name") Response.write "
    " & vbNewLine Response.Write " " & vbNewLine if fnum = 1 then Response.Write(" Page: " & vbNewLine) end if for counter = 1 to maxpages if counter <> cLng(pge) then Response.Write " " & vbNewLine else Response.Write " " & vbNewLine end if next if fnum = 1 then Response.Write(" of " & maxPages & "" & vbNewLine) else Response.Write(" " & vbNewLine) end if Response.Write(" " & vbNewLine) Response.Write("
    " & vbNewLine) end if end sub sub EmailMembers(who) if who = "all" then '## Forum_SQL - Get all pending members strSql = "SELECT M_NAME, M_EMAIL, M_KEY, M_APPROVE" strSql = strSql & " FROM " & strMemberTablePrefix & "MEMBERS_PENDING" strSql = strSql & " ORDER BY MEMBER_ID ASC" set rsApprove = Server.CreateObject("ADODB.Recordset") rsApprove.Open strSql, my_Conn, adOpenForwardOnly, adLockReadOnly, adCmdText if rsApprove.EOF then recApproveCount = "" else allApproveData = rsApprove.GetRows(adGetRowsRest) recApproveCount = UBound(allApproveData, 2) end if rsApprove.Close set rsApprove = Nothing if recApproveCount <> "" then mM_NAME = 0 mM_EMAIL = 1 mM_KEY = 2 mM_APPROVE = 3 for RowCount = 0 to recApproveCount MP_MemberName = allApproveData(mM_NAME,RowCount) MP_MemberEMail = allApproveData(mM_EMAIL,RowCount) MP_MemberKey = allApproveData(mM_KEY,RowCount) MP_MemberApprove = allApproveData(mM_APPROVE,RowCount) if MP_MemberApprove = 0 then '## E-mails Message to all pending members. strRecipientsName = MP_MemberName strRecipients = MP_MemberEMail strFrom = strSender strFromName = strForumTitle strsubject = strForumTitle & " Registration " strMessage = "Hello " & MP_MemberName & vbNewline & vbNewline strMessage = strMessage & "You received this message from " & strForumTitle & " because you have registered for a new account which allows you to post new messages and reply to existing ones on the forums at " & strForumURL & vbNewline & vbNewline if strAuthType="db" then strMessage = strMessage & "Please click on the link below to complete your registration." & vbNewline & vbNewLine strMessage = strMessage & strForumURL & "register.asp?actkey=" & MP_MemberKey & vbNewline & vbNewline end if strMessage = strMessage & "You can change your information at our website by selecting the ""Profile"" link." & vbNewline & vbNewline strMessage = strMessage & "Happy Posting!" %> <% end if next end if elseif who = "selected" then aryID = split(selID, ",") for i = 0 to ubound(aryID) '## Forum_SQL - Get all pending members strSql = "SELECT M_NAME, M_EMAIL, M_KEY, M_APPROVE" strSql = strSql & " FROM " & strMemberTablePrefix & "MEMBERS_PENDING" strSql = strSql & " WHERE MEMBER_ID = " & aryID(i) set rsApprove = my_Conn.Execute(strSql) if not(rsApprove.EOF) and not(rsApprove.BOF) and rsApprove("M_APPROVE") = 0 then '## E-mails Message to all pending members. strRecipientsName = rsApprove("M_NAME") strRecipients = rsApprove("M_EMAIL") strFrom = strSender strFromName = strForumTitle strsubject = strForumTitle & " Registration " strMessage = "Hello " & rsApprove("M_NAME") & vbNewline & vbNewline strMessage = strMessage & "You received this message from " & strForumTitle & " because you have registered for a new account which allows you to post new messages and reply to existing ones on the forums at " & strForumURL & vbNewline & vbNewline if strAuthType="db" then strMessage = strMessage & "Please click on the link below to complete your registration." & vbNewline & vbNewLine strMessage = strMessage & strForumURL & "register.asp?actkey=" & rsApprove("M_KEY") & vbNewline & vbNewline end if strMessage = strMessage & "You can change your information at our website by selecting the ""Profile"" link." & vbNewline & vbNewline strMessage = strMessage & "Happy Posting!" %> <% rsApprove.movenext end if rsApprove.Close set rsApprove = nothing next end if end sub %>