<% @ Language=VBScript %> <% Option Explicit %> <% '**************************************************************************************** '** Copyright Notice '** '** Web Wiz Guide - Web Wiz Forums '** '** Copyright 2001-2004 Bruce Corkhill All Rights Reserved. '** '** This program is free software; you can modify (at your own risk) any part of it '** under the terms of the License that accompanies this software and use it both '** privately and commercially. '** '** All copyright notices must remain in tacked in the scripts and the '** outputted HTML. '** '** You may use parts of this program in your own private work, but you may NOT '** redistribute, repackage, or sell the whole or any part of this program even '** if it is modified or reverse engineered in whole or in part without express '** permission from the author. '** '** You may not pass the whole or any part of this application off as your own work. '** '** All links to Web Wiz Guide and powered by logo's must remain unchanged and in place '** and must remain visible when the pages are viewed unless permission is first granted '** by the copyright holder. '** '** This program is distributed in the hope that it will be useful, '** but WITHOUT ANY WARRANTY; without even the implied warranty of '** MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE OR ANY OTHER '** WARRANTIES WHETHER EXPRESSED OR IMPLIED. '** '** You should have received a copy of the License along with this program; '** if not, write to:- Web Wiz Guide, PO Box 4982, Bournemouth, BH8 8XP, United Kingdom. '** '** '** No official support is available for this program but you may post support questions at: - '** http://www.webwizguide.info/forum '** '** Support questions are NOT answered by email ever! '** '** For correspondence or non support questions contact: - '** info@webwizguide.info '** '** or at: - '** '** Web Wiz Guide, PO Box 4982, Bournemouth, BH8 8XP, United Kingdom '** '**************************************************************************************** 'Set the response buffer to true Response.Buffer = True 'Dimension variables Dim intForum 'Holds the number of fourms Dim lngTopic 'Holds the number of topics Dim dtmTopic 'Holds the date of the last topic Dim lngPost 'Holds the number of posts Dim dtmPost 'Holds the date of the last post Dim lngPm 'Holds the number of private messages Dim dtmPm 'Holds the date of the last private message Dim lngPoll 'Holds the number of polls Dim intActiveUsers 'Holds the number of active users Dim intGroups 'Holds the number of groups Dim lngMember 'Holds the number of members Dim dtmMember 'Holds the date of the last members signup Dim lngUserID 'Holds the active users ID Dim strActUser 'Holds the active users username Dim strForumName 'Holds the forum name Dim intGuestNumber 'Holds the Guest Number Dim intActiveGuests 'Holds the number of active guests Dim intActiveMembers 'Holds the nunber of active members Dim strBrowserUserType 'Holds the users browser type Dim strOS 'Holds the users OS Dim dtmLastActive 'Holds the last active date Dim dtmLoggedIn 'Holds the date the user logged in Dim blnActiveUsers 'Set to true if active users is enabled Dim intArrayPass 'Holds array iteration possition Dim saryActiveUsers 'Initilise variables intActiveMembers = 0 intActiveGuests = 0 intActiveUsers = 0 intGuestNumber = 0 intForum = 0 lngTopic = 0 lngPost = 0 lngPm = 0 intActiveUsers = 0 intGroups = 0 lngMember = 0 'Initialise the SQL variable with an SQL statement to get the configuration details from the database If strDatabaseType = "SQLServer" Then strSQL = "EXECUTE " & strDbProc & "SelectConfiguration" Else strSQL = "SELECT " & strDbTable & "Configuration.* From " & strDbTable & "Configuration;" End If 'Query the database rsCommon.Open strSQL, adoCon 'Read in ifg active users is anbaled If NOT rsCommon.EOF Then blnActiveUsers = CBool(rsCommon("Active_users")) 'Clean up rsCommon.Close '****************************************** '*** Read in the Counts *** '****************************************** 'Initalise the strSQL variable with an SQL statement to query the database strSQL = "SELECT " & strDbTable & "Forum.No_of_topics, " & strDbTable & "Forum.No_of_posts FROM " & strDbTable & "Forum;" 'Query the database rsCommon.Open strSQL, adoCon 'Get the number of topics posts and forums Do While NOT rsCommon.EOF 'Count the number of forums intForum = intForum + 1 'Count the number of topics lngTopic = lngTopic + CLng(rsCommon("No_of_topics")) 'Count the number of posts lngPost = lngPost + CLng(rsCommon("No_of_posts")) 'Move to the next record rsCommon.MoveNext Loop 'Clean up rsCommon.Close 'Initalise the strSQL variable with an SQL statement to query the database strSQL = "SELECT Count(" & strDbTable & "Author.Author_ID) AS CountAuthor FROM " & strDbTable & "Author;" 'Query the database rsCommon.Open strSQL, adoCon 'Read in the count If NOT rsCommon.EOF Then lngMember = CLng(rsCommon("CountAuthor")) 'Clean up rsCommon.Close 'Initalise the strSQL variable with an SQL statement to query the database strSQL = "SELECT Count(" & strDbTable & "PMMessage.PM_ID) AS CountPm FROM " & strDbTable & "PMMessage;" 'Query the database rsCommon.Open strSQL, adoCon 'Read in the count If NOT rsCommon.EOF Then lngPm = CLng(rsCommon("CountPm")) 'Clean up rsCommon.Close 'Initalise the strSQL variable with an SQL statement to query the database strSQL = "SELECT Count(" & strDbTable & "Poll.Poll_ID) AS CountPoll FROM " & strDbTable & "Poll;" 'Query the database rsCommon.Open strSQL, adoCon 'Read in the count If NOT rsCommon.EOF Then lngPoll = CLng(rsCommon("CountPoll")) 'Clean up rsCommon.Close 'Initalise the strSQL variable with an SQL statement to query the database strSQL = "SELECT Count(" & strDbTable & "Group.Group_ID) AS CountGroup FROM " & strDbTable & "Group;" 'Query the database rsCommon.Open strSQL, adoCon 'Read in the count If NOT rsCommon.EOF Then intGroups = CLng(rsCommon("CountGroup")) 'Clean up rsCommon.Close '****************************************** '*** Read in Dates *** '****************************************** 'Initalise the strSQL variable with an SQL statement to query the database strSQL = "SELECT TOP 1 " & strDbTable & "Topic.Start_date FROM " & strDbTable & "Topic ORDER BY " & strDbTable & "Topic.Start_date DESC;" 'Query the database rsCommon.Open strSQL, adoCon 'Read in the count If NOT rsCommon.EOF Then dtmTopic = CDate(rsCommon("Start_date")) 'Clean up rsCommon.Close 'Initalise the strSQL variable with an SQL statement to query the database strSQL = "SELECT TOP 1 " & strDbTable & "Thread.Message_date FROM " & strDbTable & "Thread ORDER BY " & strDbTable & "Thread.Message_date DESC;" 'Query the database rsCommon.Open strSQL, adoCon 'Read in the count If NOT rsCommon.EOF Then dtmPost = CDate(rsCommon("Message_date")) 'Clean up rsCommon.Close 'Initalise the strSQL variable with an SQL statement to query the database strSQL = "SELECT TOP 1 " & strDbTable & "Author.Join_date FROM " & strDbTable & "Author ORDER BY " & strDbTable & "Author.Join_date DESC;" 'Query the database rsCommon.Open strSQL, adoCon 'Read in the count If NOT rsCommon.EOF Then dtmMember = CDate(rsCommon("Join_date")) 'Clean up rsCommon.Close 'Initalise the strSQL variable with an SQL statement to query the database strSQL = "SELECT TOP 1 " & strDbTable & "PMMessage.PM_Message_Date FROM " & strDbTable & "PMMessage ORDER BY " & strDbTable & "PMMessage.PM_Message_Date DESC;" 'Query the database rsCommon.Open strSQL, adoCon 'Read in the count If NOT rsCommon.EOF Then dtmPm = CDate(rsCommon("PM_Message_Date")) 'Clean up rsCommon.Close %> Forum Statistics

Forum Statistics
Return to the the Administration Menu

Below is a list of statistics for the board.

Forum Statistics
Number of Forums <% = intForum %>    
Number of Topics <% = lngTopic %> Last New Topic <% = FormatDateTime(dtmTopic, vbLongDate) & ", " & FormatDateTime(dtmTopic, vbShortTime) %>
Number of Posts <% = lngPost %> Last New Post <% = FormatDateTime(dtmPost, vbLongDate) & ", " & FormatDateTime(dtmPost, vbShortTime) %>
Number of Members <% = lngMember %> Last New Member <% = FormatDateTime(dtmMember, vbLongDate) & ", " & FormatDateTime(dtmMember, vbShortTime) %>
Number of Private Messages <% = lngPm %> Last Private Message <% = FormatDateTime(dtmPm, vbLongDate) & ", " & FormatDateTime(dtmPm, vbShortTime) %>
Number of Polls <% = lngPoll %>    
Number of User Groups <% = intGroups %>    


<% '****************************************** '*** Active users list *** '****************************************** 'If active sers is ebaled show the table If blnActiveUsers Then 'Initialise the array from the application veriable If IsArray(Application("saryAppActiveUsers")) Then 'Place the application level active users array into a tmporary static array saryActiveUsers = Application("saryAppActiveUsers") 'Else Initialise the an empty array Else ReDim saryActiveUsers(7,1) End If 'Get the number of active users 'Get the active users online For intArrayPass = 1 To UBound(saryActiveUsers, 2) 'If this is a guest user then increment the number of active guests veriable If saryActiveUsers(1, intArrayPass) = 2 Then intActiveGuests = intActiveGuests + 1 End If Next 'Calculate the number of members online and total people online intActiveUsers = UBound(saryActiveUsers, 2) intActiveMembers = intActiveUsers - intActiveGuests Response.Write(" There are currently " & intActiveUsers & " Active Users on-line, " & intActiveGuests & " Guest(s) and " & intActiveMembers & " Member(s)
") %>
<% 'Sort the active users array Call SortActiveUsersList(saryActiveUsers) 'display the active users For intArrayPass = 1 To UBound(saryActiveUsers, 2) 'Read in the details from the rs lngUserID = saryActiveUsers(1, intArrayPass) strActUser = saryActiveUsers(2, intArrayPass) dtmLoggedIn = saryActiveUsers(3, intArrayPass) dtmLastActive = saryActiveUsers(4, intArrayPass) strOS = saryActiveUsers(5, intArrayPass) strBrowserUserType = saryActiveUsers(6, intArrayPass) 'Write the HTML of the Topic descriptions as hyperlinks to the Topic details and message %> <% Next %>
Username Logged In Last Active Active OS Browser
<% 'If the user is a Guest then display them as a Guest If lngUserID = 2 Then 'Add 1 to the Guest number intGuestNumber = intGuestNumber + 1 'Display the User as Guest Response.Write("Guest "& intGuestNumber) 'Else display the users name Else Response.Write("" & strActUser & "") End If %> <% Response.Write(FormatDateTime(dtmLoggedIn, vbLongDate) & " at " & FormatDateTime(dtmLoggedIn, vbShortTime)) %> <% Response.Write(FormatDateTime(dtmLastActive, vbLongDate) & " at " & FormatDateTime(dtmLastActive, vbShortTime)) %> <% = DateDiff("n", dtmLoggedIn, dtmLastActive) %> Minutes <% = strOS %> <% = strBrowserUserType %>

This data is based on users active over the past ten minutes


<% End If 'Clean up Set rsCommon = Nothing adoCon.Close Set adoCon = Nothing %>