quote:

---

<%
'#################################################################################
'## Copyright (C) 2000-01 Michael Anderson and Pierre Gorissen
'##
'## 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 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 support forums at:
'## http://forum.snitz.com
'##
'## Correspondence and Marketing Questions can be sent to:
'## reinhold@bigfoot.com
'##
'## or
'##
'## Snitz Communications
'## C/O: Michael Anderson
'## PO Box 200
'## Harpswell, ME 04079
'#################################################################################
'#################################################################################
'# Inactive Users version 1.00 for Snitz 3.4
'# This mod was origionally written for version 3.3 by Sean Gorman (MotoX)
'# This has been a collaboration effort between Wesley Brown and Sean Gorman
'#################################################################################
on error resume next
response.buffer = true
Server.ScriptTimeout = "1200"
%>
<!--#INCLUDE FILE="config.asp" -->
<% If Session(strCookieURL & "Approval") = "15916941253" Then %>
<!--#INCLUDE FILE="inc_func_common.asp" -->
<!--#INCLUDE file="inc_header.asp" -->
<%
on error resume next
Response.Write " <table border=""0"" width=""100%"">" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td width=""33%"" align=""left"" nowrap><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """>" & vbNewLine & _
" " & getCurrentIcon(strIconFolderOpen,"","align=""absmiddle""") & " <a href=""default.asp"">All Forums</a><br />" & vbNewLine & _
" " & getCurrentIcon(strIconBar,"","align=""absmiddle""") & getCurrentIcon(strIconFolderOpenTopic,"","align=""absmiddle""") & " Admin Section<br />" & vbNewLine & _
" " & getCurrentIcon(strIconBlank,"","align=""absmiddle""") & getCurrentIcon(strIconBar,"","align=""absmiddle""") & getCurrentIcon(strIconFolderOpen,"","align=""absmiddle""") & " Inactive User List<br /></font></td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" </table>" & vbNewLine & _
" <br />" & vbNewLine
intDaysOut = request.QueryString("intDaysOut")
intDaysOut = cint(intDaysOut)
intEmailAll = cint(request.QueryString("intEmailAll"))
if intDaysOut = 0 then
intDaysOut = 365
end if
'pull the number of days back if none is set default it to 90
'forcing it to a number keeps the sqlinsert bug from effecting
'this app
'this is a sloppy way to build the string for the date used in the query
strYear = year(now() - IntDaysOut)
strMonth = month(now() - IntDaysOut)
strMonth = dFormat(strMonth)
strDay = day(now()-intDaysOut)
strDay = dFormat(strDay)
strHour = FormatDateTime(now(),4)
strHour = left(strHour,2)
strMinute = minute(now())
strMinute = dFormat(strMinute)
strSecond = second(now())
strSecond = dFormat(strSecond)
nDate = strYear&strMonth&strDay&strHour&strMinute&strSecond
'if you can make it better go for it.
on error resume next
strSql = "SELECT " &strMemberTablePrefix & "MEMBERS.M_NAME, " &strMemberTablePrefix & "MEMBERS.M_LASTHEREDATE, " &strMemberTablePrefix & "MEMBERS.M_POSTS, " &strMemberTablePrefix & "MEMBERS.MEMBER_ID, " &strMemberTablePrefix & "MEMBERS.M_EMAIL "
strSql = strSql & " FROM " &strMemberTablePrefix & "MEMBERS Where M_STATUS = 1 and "&strMemberTablePrefix & "MEMBERS.M_LASTHEREDATE < '"&ndate&"'"
strSql = strSql & " ORDER BY " &strMemberTablePrefix & "MEMBERS.M_LASTHEREDATE "
'only pull valid data no more pulling all records and paging through them
'response.write strSql&"<BR>" 'for testing only
set oRs = server.createobject("ADODB.Recordset")
oRs.open strSql, My_Conn
aData = oRs.GetRows
oRs.close
set oRs = nothing
'load up our array with all the data from the query and disconnect from the record set.
if isnull(aData(0,0)) = true then
aDataerr = 1
end if
'check for an empty array if so set the error flag.
if intEmailAll = 1 then
strMsg = "Dies ist eine Nachricht vom " & strForumTitle & _
". Da Sie unser Forum schon lange nicht mehr besucht haben,"& _
" wurde er zur Löschung freigegeben. Möchten Sie ihren Account beibehalten,"& _
" dann besuchen Sie uns und schauen was es neues gibt: " & strForumURL & _
" Möchten Sie dass der Account gelöscht wird dann brauchen Sie nichts zu tun"& _
" Mit freundlichen Grüßen, Admin " & strForumTitle
intLastRecord = ubound(aData,2)
' intLastRecord = intLastRecord + 1
' response.write intLastRecord&"<BR>"
i = 0
for i = 0 to intLastRecord
' response.write i&" email sent to "&aData(0,i)&"<BR>"
trRecipientsName = trim(aData(0,i))
strRecipients = trim(aData(4,i))
strFrom = STRSENDER
strFromName = "Administrator"
strSubject = "Sent From " & strForumTitle & " by Board Administrator"
strMessage = "Hello " & trim(aData(0,i)) & vbNewline & vbNewline
strMessage = strMessage & "You received the following message from : Administrator (" & STRSENDER & ") " & vbNewline & vbNewline
strMessage = strMessage & "At: " & strForumURL & vbNewline & vbNewline
strMessage = strMessage & strMsg & vbNewline & vbNewline'
%>
<!--#INCLUDE FILE="inc_mail.asp" -->
<%
next
response.write" <p align=""center""><font face="""& strDefaultFontFace &""" size="""& strHeaderFontSize &""">All Users Have Been E-Mailed!</font></p>"& vbNewLine & _
" <meta http-equiv=""Refresh"" content=""7; URL=admin_home.asp"">"& vbNewLine & _
" <p align=""center""><font face="""& strDefaultFontFace &""" size="""& strDefaultFontSize &"""><a href=""admin_home.asp"">Back To Admin Home</font></a></p>"& vbNewLine
else
'this is a javascript to help build the drop down nav
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
'end javascript block

mypage = request("page")
if ((Trim(mypage) = "") or (IsNumeric(mypage) = False)) then mypage = 1
mypage = cLng(mypage)
'set the mypage for the drop down

if Request.QueryString("page") <> "" then
intPage = cint(Request.QueryString("page"))
else
intPage = 1
end if
'check to see what page we are on if not set default it to the first page

intRecordsPerPage = 50 '10 Records per page
'this could be made dynamic too

intFirstRecord = (intPage - 1) * intRecordsPerPage 'The first record to display

'block to build the forward and back navigation
ref = "<div align = ""Center"">"
if intPage > 1 then ' We're not on the 1st page, show a previous link
ref = ref & "<font face="""& strDefaultFontFace &""" size="""& strFooterFontSize &"""><a href=admin_inactive_users.asp?"
ref = ref &"page="&intPage - 1
ref = ref &"&intDaysOut="&intDaysOut
ref = ref &">"&getCurrentIcon(strIconGoLeft,"","align=""absmiddle""")&"Previous</a></font> "
end if
if intFirstRecord + (intRecordsPerPage - 1) >= ubound(aData,2) then 'We're on the last page
intLastRecord = ubound(aData, 2)
else 'There's more pages - show a next link
intLastRecord = intFirstRecord + (intRecordsPerPage - 1)
ref = ref &" <font face="""& strDefaultFontFace &""" size="""& strFooterFontSize &"""><a href=admin_inactive_users.asp?"
ref = ref &"page="&intPage + 1
ref = ref &"&intDaysOut="&intDaysOut
ref = ref &">"&getCurrentIcon(strIconGoRight,"","align=""absmiddle""")&"Next</a></font>"

ref = pref & ref
end if
ref = ref &"</div>"
'end block
if ((ubound(aData, 2)+1) / intRecordsPerPage) > cint(((ubound(aData, 2)+1) / intRecordsPerPage)) then
'check for any hangover records
maxpages = cint(((ubound(aData, 2)+1) / intRecordsPerPage))
maxpages = maxpages + 1
'make sure we have enough pages to cover all the records
else
maxpages = cint(((ubound(aData, 2)+1) / intRecordsPerPage))
end if
'needed for the dropdown navigation. Only likes Whole numbers no fractions!
response.write "<p><font face="""& strDefaultFontFace &""" size="""& strDefaultFontSize &"""><b>NOTE:</b> The following users have not visited "& STRFORUMTITLE &" in "& intDaysOut &" days or greater and have not been locked out.</font></p>"&VbnewLine
if maxpages > 1 then
response.write "<table border=""0"" width=""100%"" cellspacing=""0"" cellpadding=""0"" align=""center"">"&VbnewLine&_
" <tr>"&VbnewLine&_
" <td width=""50%"" valign=""bottom""><b><font face="""& strDefaultFontFace &""" size="""& strDefaultFontSize &""" color="""& strDefaultFontColor &""">"
Call DropDownPaging(1)
response.write "</font></b></td>"&VbnewLine&_
" <td width=""50%"" align=""right""><b><font face="""& strDefaultFontFace &""" size="""& strDefaultFontSize &""" color="""& strDefaultFontColor &""">"&vbNewLine&_
ref & vbNewLine &_
"</font></b><BR></td>"&VbnewLine&_
" </tr>"&VbnewLine&_
" </table>"&VbnewLine
'if there are more than 1 page build and show the drop down nav
end if

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"">" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td align=center bgColor="""& strHeadCellColor &"""><b><font face="""& strDefaultFontFace &""" size="""& strDefaultFontSize &""" color="""& strHeadFontColor &""">Username</font></b></td>"&VbnewLine&_
" <td align=center bgColor="""& strHeadCellColor &"""><b><font face="""& strDefaultFontFace &""" size="""& strDefaultFontSize &""" color="""& strHeadFontColor &""">Profile</font></b></td>"&VbnewLine&_
" <td align=center bgColor="""& strHeadCellColor &"""><b><font face="""& strDefaultFontFace &""" size="""& strDefaultFontSize &""" color="""& strHeadFontColor &""">Last Seen On Forum Date</font></b></td>"&VbnewLine&_
" <td align=center bgColor="""& strHeadCellColor &"""><b><font face="""& strDefaultFontFace &""" size="""& strDefaultFontSize &""" color="""& strHeadFontColor &""">Total Posts</font></b></td>"&VbnewLine&_
" <td align=center bgColor="""& strHeadCellColor &"""><b><font face="""& strDefaultFontFace &""" size="""& strDefaultFontSize &""" color="""& strHeadFontColor &""">Days Since Last Seen</font></b></td>"&VbnewLine&_
" <td align=center bgColor="""& strHeadCellColor &"""><b><font face="""& strDefaultFontFace &""" size="""& strDefaultFontSize &""" color="""& strHeadFontColor &""">Warn Member</font></b></td>"&VbnewLine&_
" <td align=center bgColor="""& strHeadCellColor &"""><b><font face="""& strDefaultFontFace &""" size="""& strDefaultFontSize &""" color="""& strHeadFontColor &""">Delete Member</font></b></td>"&VbnewLine&_
" <td align=center bgColor="""& strHeadCellColor &"""><b><font face="""& strDefaultFontFace &""" size="""& strDefaultFontSize &""" color="""& strHeadFontColor &""">Email Member</font></b></td>"&VbnewLine&_
" </tr>"&VbnewLine
'our table head

if aDataerr = 1 then '## No new topic posts found in DB
response.write" <tr>"& VbnewLine &_
" <td align=center bgcolor="""& strForumCellColor &""" colspan=""7""><font face="""& strDefaultFontFace &""" size="""& strDefaultFontSize &"""><b>No Members Found</b></font></td>"&VbnewLine &_
" </tr>"& VbnewLine
'if the error flag is here there are no records tell the user so!
else

reccnt = intLastRecord + 1
i = intFirstRecord
'setup the loop variables first and last record counts
do while not(i = reccnt)
'loop through the records
strMember = aData(0,i)
strRSLastHere = aData(1,i)
strRSRightNow = strForumTimeAdjust
strLastHere = StrToDate(strRSLastHere)
strRightNow = StrToDate(strRSRightNow)
strOnlineTDays = DateDiff("d",strLastHere,strRightNow)

response.write" <tr bgcolor="""& CColor &""">"&VbnewLine&_
" <td bgcolor="""& strForumCellColor &"""><font face="""& strDefaultFontFace &""" size="""& strDefaultFontSize &""">"& aData(0,i) &"</font></td>"&VbnewLine&_
" <td align=""center"" bgcolor="""& strForumCellColor &""">"&VbnewLine
if strUseExtendedProfile then
response.write" <a href=""pop_profile.asp?mode=display&id="& aData(3,i) &""">"&VbnewLine
else
response.write" <a href=""JavaScript:openWindow3('pop_profile.asp?mode=display&id="& aData(3,i) &"')"&VbnewLine
end if
response.write" "&getCurrentIcon(strIconProfile,"","align=""absmiddle""")&VbnewLine&_
" <td align=center bgcolor="""& strForumCellColor &"""><font face="""& strDefaultFontFace &""" size="""& strDefaultFontSize &""">"& StrToDate(aData(1,i)) &"</font></td>"&VbnewLine&_
" <td align=center bgcolor="""& strForumCellColor &"""><font face="""& strDefaultFontFace &""" size="""& strDefaultFontSize &""">"& aData(2,i) &"</font></td>"&VbnewLine&_
" <td align=center bgcolor="""& strForumCellColor &"""><font face="""& strDefaultFontFace &""" size="""& strDefaultFontSize &""">"& strOnlineTDays &"</font></td>"&VbnewLine&_
" <td align=center bgcolor="""& strForumCellColor &"""><a href=""JavaScript:openWindow('pop_warn_mail.asp?id="& aData(3,i) &"')"">"&VbnewLine&_
" "&getCurrentIcon(strIconEmail,"","align=""absmiddle""")&"</a>"&VbnewLine&_
" <td align=center bgcolor="""& strForumCellColor &"""><a href=""JavaScript:openWindow('pop_delete.asp?mode=Member&MEMBER_ID="& aData(3,i) &"')"">"&getCurrentIcon(strIconTrashCan,"","align=""absmiddle""")&"</a></font></td>"&VbnewLine&_
" </tr>"&VbnewLine
i = i + 1
loop
end if

response.write" </table>"&VbnewLine&_
" </td>"&VbnewLine&_
" </tr>"&VbnewLine&_
"</table>"&VbnewLine&_
" </td>"&VbnewLine&_
" </tr>"&VbnewLine&_
"</table>"&VbnewLine
'rap up the table

'block so users can pick the number of days back. I hard set this to three digits 999 days is a long way back!

Response.Write "<table border=""0"" width=""100%"" cellspacing=""0"" cellpadding=""0"" align=""center"">" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td align=""center""><BR>"&vbNewline&_
" <font face="""& strDefaultFontFace &""" size="""& strDefaultFontSize &"""><form action=""admin_inactive_users.asp"" method=""get"">"&VbnewLine&_
" Enter Number of Days inactivity you would like to check for: <input type=""text"" name=""intDaysOut"" value="""&intDaysOut&""" size=""3"" maxlength=""3"">"&VbnewLine&_
" <input type=""submit"" value=""Submit"">"&VbnewLine&_
" </font></form>"&VbnewLine&_
" </td>" & vbNewLine & _
" </tr>" & vbNewLine & _
"</table>" & vbNewLine

if aDataerr = 0 then
Response.Write "<table border=""0"" width=""100%"" cellspacing=""0"" cellpadding=""0"" align=""center"">" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td align=""center""><BR>"&vbNewline&_
" <b> WARNING! </b> This could take up to 20 minutes to e-mail large groups!"&vbNewline&_
" </td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td align=""center""><BR>"&vbNewline&_
" <font face="""& strDefaultFontFace &""" size="""& strDefaultFontSize &"""><form action=""admin_inactive_users.asp"" method=""get"">"&VbnewLine&_
" <input type=""hidden"" name=""intDaysOut"" value="""&intDaysOut&""">"&VbnewLine&_
" <input type=""hidden"" name=""intEmailAll"" value=""1"">"&VbnewLine&_
" <input type=""submit"" value=""Email All Inactive Members"">"&VbnewLine&_
" </font></form>"&VbnewLine&_
" </td>" & vbNewLine & _
" </tr>" & vbNewLine & _
"</table>" & vbNewLine
end if

end if
'end if

WriteFooter
Else
scriptname = split(request.servervariables("SCRIPT_NAME"),"/")
Response.Redirect "admin_login.asp?target=scriptname"
End if

function dFormat(tmp)
'**************************************
'* used to pad parts of a datetime
'* for use in a single string
'* used for the search string
'**************************************
lenStr = len(tmp)
if lenStr = 1 then
tmp = "0"&tmp
dFormat = tmp
else
dFormat = tmp
end if
end function


sub DropDownPaging(fnum)
'********************************************
'* ripped from topic.asp and modified to work
'* for our little purpose
'********************************************
if maxpages > 1 then
if mypage = "" then
pge = 1
else
pge = mypage
end if
scriptname = request.servervariables("script_name")
Response.Write("<form name=""PageNum" & fnum & """ action=""admin_inactive_users.asp"">" & vbNewLine)
Response.Write("<b>Page: </b><select name=""page"" 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)
Response.Write("</font>" & vbNewLine)
Response.Write("<input type=""hidden"" name=""intDaysOut"" value=""" & intDaysOut & """>" & vbNewLine)
Response.Write("</form>" & vbNewLine)
end if
top = "0"
end sub


%>

---