<%@ CodePage=65001 Language="VBScript"%> <% Option Explicit %> <% sBBSLangPage = "statistics" BBS.SetupBBS BBS.SetScheme(0) dictEnvironment.item("V-LOCATIONLINKS") = dictEnvironment.item("V-LOCATIONLINKS") & " -> " & dictLanguage("GLOBAL-LOCATION2") & " -> " & dictLanguage("GLOBAL-LOCATION4") if not(BBS.HasPermission(PERM_ViewBBS, -1)) then response.redirect sBBSForumRoot & "/logon.asp?error=needregistration" if not (dictConfiguration("bGUESTSVIEWSTATISTICS") = 1 or iBBSUserlevel >= USERLEVEL_User) then response.redirect sBBSForumRoot & "/logon.asp?error=needregistration" dim rank, sListUsername, sListPassword , itotalposts, dDateRegistered, iPage, iCurrentPage dim SQL, dLastLogon, bdisablepostcount, sUserType, iEndCount, index, sOrdering dim sOppositeUsernameOrdering, sOppositeLocationOrdering, sOppositePostsOrdering, sOppositeRegisteredOrdering, sOppositeLastlogonOrdering dim iStart, iUserCount, sSortOrder, iRecordCount, sLocation, iColumns, iMove, iPageSize, sUserRank iColumns = 8 iPageSize = 100 if dictConfiguration("bFORUMENABLEPOSTCOUNT") = 0 then iColumns = iColumns - 1 dictEnvironment("V-COLUMNS") = iColumns ' Retrieve querystrings iStart = BBS.ValidateNumeric(request("start")) iUserCount = 0 sSortOrder = request.form("sortorder") sOrdering = request.form("ordering") if len(trim(sSortOrder))=0 then sSortOrder = "username" if len(trim(sOrdering))=0 then sOrdering = "ASC" if sOrdering <> "DESC" then sOrdering = "ASC" SQL = "select count(*) as usercount from members" rsMaster.open SQL, dbConnection, adOpenForwardOnly, adLockReadOnly BBS.AddQuery(SQL) if not rsMaster.EOF then iRecordCount = rsMaster.fields(0).value rsMaster.Close ' Generate the paging & sorting box vbString.Append "

" & CRLF vbString.Append dictLanguage("STATS-SORTBY") & " " & CRLF vbString.Append "" & dictLanguage("GLOBAL-USERNAME") & "" & CRLF vbString.Append "" & dictLanguage("STATS-LOCATION") & "" & CRLF vbString.Append "" & dictLanguage("STATS-POSTS") & "" & CRLF vbString.Append "" & dictLanguage("STATS-DATEREGISTERED") & "" & CRLF vbString.Append "" & dictLanguage("STATS-LASTLOGIN") & "" & CRLF vbString.Append " " & CRLF vbString.Append " " & CRLF vbString.Append "" & dictLanguage("GLOBAL-ASC") & "" & CRLF vbString.Append "" & dictLanguage("GLOBAL-DESC") & "" & CRLF vbString.Append " " & CRLF vbString.Append dictLanguage("STATS-JUMP") & " " & CRLF iCurrentPage = int(iStart / iPageSize)+1 iMove=0 iPage = 1 do until iMove >= iRecordCount vbString.Append "" & iPage & "" & CRLF iPage = iPage + 1 iMove = iMove + iPageSize loop vbString.Append "

" dictEnvironment("V-PAGINGBOX") = vbString.ToString() vbString.Clear() ' Generate the ranks table if isArray(vBBSRankArray) then ' Left side vbString.Append "

" for index = 0 to ((ubound(vBBSRankArray, 2) \ 2)-1) vbString.Append "" next vbString.Append " " & BBS.MBBSDecode(vBBSRankArray(2, index), 1) & " " if vBBSRankArray(0, index) > 0 or vBBSRankArray(1, index) > 0 then vbString.Append "- " if vBBSRankArray(0, index) > 0 then vbString.Append vBBSRankArray(0, index) & " " & dictLanguage("STATS-POSTS") & " " if vBBSRankArray(1, index) > 0 then vbString.Append vBBSRankArray(1, index) & " " & dictLanguage("STATS-DAYS") vbString.Append "

" for index = ubound(vBBSRankArray, 2) \ 2 to ubound(vBBSRankArray, 2) vbString.Append "" next vbString.Append " " & BBS.MBBSDecode(vBBSRankArray(2, index), 1) & " " if vBBSRankArray(0, index) > 0 or vBBSRankArray(1, index) > 0 then vbString.Append "- " if vBBSRankArray(0, index) > 0 then vbString.Append vBBSRankArray(0, index) & " " & dictLanguage("STATS-POSTS") & " " if vBBSRankArray(1, index) > 0 then vbString.Append vBBSRankArray(1, index) & " " & dictLanguage("STATS-DAYS") vbString.Append "

" dictEnvironment("V-RANKS") = vbString.ToString() vbString.Clear() end if if IsArray(vBBSDecorationArray) then ' Left Side vbString.Append "

" for index = 0 to ((ubound(vBBSDecorationArray, 2) \ 2)-1) vbString.Append "" & CRLF vbString.Append "" & CRLF next vbString.Append " " & (vBBSDecorationArray(0, index)) & " " & BBS.GetDecorations(vBBSDecorationArray(0, index)) & "

" for index = (ubound(vBBSDecorationArray, 2) \ 2) to ubound(vBBSDecorationArray,2) vbString.Append "" & CRLF vbString.Append "" & CRLF next vbString.Append " " & (vBBSDecorationArray(0, index)) & " " & BBS.GetDecorations(vBBSDecorationArray(0, index)) & "

" dictEnvironment("V-DECORATIONS") = vbString.ToString() vbString.Clear() end if ' Create the userlisting rank = iStart SQL = "select username, location, totalposts, dateregistered, lastlogon, disablepostcount, memberid, usecustomrank, customrank, totalposts, dateregistered from members where active=1" if sSortOrder="username" then SQL = SQL & " order by username " & sOrdering elseif sSortOrder="posts" then SQL = SQL & " order by disablepostcount ASC, totalposts " & sOrdering elseif sSortOrder="location" then SQL = SQL & " order by location " & sOrdering elseif sSortOrder="registered" then SQL = SQL & " order by dateregistered " & sOrdering elseif sSortOrder="lastlogon" then SQL = SQL & " order by lastlogon " & sOrdering end if if ucase(sBBSDatabaseType) = "MYSQL" Then rsMaster.CursorLocation = adUseClient rsMaster.open SQL, dbConnection, adOpenForwardOnly, adLockReadOnly else rsMaster.open SQL, dbConnection, adOpenForwardOnly, adLockReadOnly end if BBS.AddQuery(SQL) if not rsMaster.EOF then vbString.Append "" & CRLF vbString.Append "" & CRLF vbString.Append "" & CRLF vbString.Append "" & CRLF vbString.Append "" & CRLF if dictConfiguration("bFORUMENABLEPOSTCOUNT") = 1 then vbString.Append "" & CRLF end if vbString.Append "" & CRLF vbString.Append "" & CRLF end if if not(rsMaster.EOF) then rsMaster.move (iStart) do until rsMaster.EOF or (rank = (iStart + iPageSize)) rank = rank + 1 sListUsername = rsMaster.fields("username").value sLocation = rsMaster.fields("location").value itotalposts = rsMaster.fields("totalposts").value dDateRegistered = rsMaster.fields("dateregistered").value dLastLogon = rsMaster.fields("lastlogon").value bdisablepostcount = rsMaster.fields("disablepostcount").value vbString.Append "" & CRLF ' Find the user rank quickly without adding extra calls to the database if rsMaster.fields("usecustomrank").value = 1 then sUserRank = rsMaster.fields("customrank").value else sUserRank = BBS.GetRank(rsMaster.fields("totalposts").value, DateDiff("d", rsMaster.fields("dateregistered").value, now)) end if vbString.Append "" & CRLF vbString.Append "" & CRLF if dictConfiguration("bFORUMENABLEPOSTCOUNT") = 1 then if bDisablePostCount = 0 or iBBSUserLevel >= USERLEVEL_SupportAdministrator then vbString.Append "" & CRLF else vbString.Append "" & CRLF end if end if vbString.Append "" & CRLF vbString.Append "" & CRLF rsMaster.MoveNext loop rsMaster.Close if ucase(sBBSDatabaseType) = "MYSQL" Then rsMaster.CursorLocation = adUseServer end if vbString.Append "

	" & dictLanguage("GLOBAL-USERNAME") & "	" & dictLanguage("STATS-RANK") & "	" & dictLanguage("STATS-LOCATION") & "	" & dictLanguage("STATS-POSTS") & "	" & dictLanguage("STATS-DATEREGISTERED") & "	" & dictLanguage("STATS-LASTLOGIN") & "
" & rank & "	" & BBS.CreateUsernameLinkByID(rsMaster.fields("memberid").value) & BBS.ValidateField(sListUsername) & "	" & BBS.MBBSDecode(sUserRank, 1) & "	" & BBS.ValidateField(sLocation) & "	" & iTotalPosts & "	" & dictLanguage("STATS-DISABLED") & "	" & BBS.GetShortDate(dDateRegistered) & "	" & BBS.GetShortDate(dLastLogon) & "

" dictEnvironment("V-USERLIST") = vbSTring.ToSTring() vbString.Clear() dictEnvironment.add "V-TITLE", dictLanguage.item("STATS-USERLISTING") dictEnvironment.add "C-SHOWRANDOMQUOTES", dictConfiguration("bDISPLAYBBSQUOTES") if iBBSUserLevel >= USERLEVEL_SupportAdministrator then dictEnvironment.add "C-SHOWADMINLINK", 1 %> <% Filesystem.ExecuteBBSTemplate("/statistics/user-listing.asp") %>