<% '############## Active users V3.4 ################
' WHOS ONLINE SCRIPT
Dim strOnlinePathInfo, strOnlineQueryString, strOnlineLocation
Dim strOnlineUser, strOnlineDate, strOnlineCheckInTime, strOnlineTimedOut
Dim strOnlineUsersCount, strOnlineGuestsCount, strOnlineMembersCount, strOnlineTempCount
Dim strOnlineCountType, strOnlinePageName, iOnlinePathLen
Dim strOnlineGuestUserIP

' ******************************************************
' ADD HERE WHAT YOU WANT THE PREFIX OF YOUR COOKIE TO BE
' it will either be 'strCookieURL' or 'strUniqueID'
strTempCookieType = strUniqueID
' ******************************************************

Function OnlineSQLencode(byVal strPass)
	If not isNull(strPass) and strPass <> "" Then
 		strPass = Replace(strPass, "%", "'%'")
	 	strPass = Replace(strPass, "'", "''")
 		strPass = Replace(strPass, "|", "'|'")
	 	OnlineSQLencode = strPass
	 End If
End Function

Function OnlineSQLdecode(byVal strPass)
	If not isNull(strPass) and strPass <> "" Then
 		strPass = Replace(strPass, "'%'", "%")
 		strPass = Replace(strPass, "''", "'")
	 	strPass = Replace(strPass, "'|'", "|")
 		OnlineSQLdecode = strPass
	End If
End Function

'################################################
' LETS GET WHAT PAGE THEY ARE ON
strOnlinePathInfo = Request.ServerVariables("Path_Info")
strOnlineQueryString = Request.QueryString

iOnlinePathLen = InStrRev(strOnlinePathInfo,"/",-1)
strOnlinePageName = lcase(Right(strOnlinePathInfo,(len(strOnlinePathInfo)-iOnlinePathLen)))
strOnlineLocation = "<a href=""" & strOnlinePageName & """>"
if strOnlineQueryString <> "" then
	strOnlineLocation = "<a href=""" & strOnlinePageName & "?" & strOnlineQueryString & """>"
end if
Select Case strOnlinePageName
	Case "active.asp"
		strOnlineLocation = strOnlineLocation & "Active Topics"
	Case "members.asp"
		strOnlineLocation = strOnlineLocation & "Members"
	Case "search.asp"
		strOnlineLocation = strOnlineLocation & "Search"
	Case "events.asp"
		strOnlineLocation = strOnlineLocation & "Events Calendar"	
	Case "faq.asp"
		strOnlineLocation = strOnlineLocation & "FAQ"
	Case "pm_view.asp"
		strOnlineLocation = strOnlineLocation & "Private Message Inbox"
	Case "pm_options.asp"
		strOnlineLocation = strOnlineLocation & "Private Messages Options"
	Case "privatesend.asp"
		strOnlineLocation = strOnlineLocation & "Sending Private Message"
	Case "active_users.asp"
		strOnlineLocation = strOnlineLocation & "Active Users"
	Case "guestbook.asp"
		strOnlineLocation = strOnlineLocation & "GuestBook"
	Case "default.asp"
		strOnlineLocation = strOnlineLocation & "Forums"
	Case "members.asp"
		strOnlineLocation = strOnlineLocation & "Members"
' ##############add by safwanet###############
	Case "pop_profile.asp"
		strOnlineLocation = strOnlineLocation & "pop profile"
	Case "bookmark.asp"
		strOnlineLocation = strOnlineLocation & "bookmark"
	Case "admin_login.asp"
		strOnlineLocation = strOnlineLocation & "admin login"
	Case "my.asp"
		strOnlineLocation = strOnlineLocation & "my"
	Case "forum.asp"
		strOnlineLocation = strOnlineLocation & "forum"
	Case "topic.asp"
		strOnlineLocation = strOnlineLocation & "topic.asp"
	Case "Favourites_Home.asp"
		strOnlineLocation = strOnlineLocation & "Favourites Home"
	Case "Favourites_ShowFavourites.asp"
		strOnlineLocation = strOnlineLocation & "Favourites ShowFavourites"
	Case "classifieds.asp"
		strOnlineLocation = strOnlineLocation & "classifieds"
	Case "classadmin.asp"
		strOnlineLocation = strOnlineLocation & "classadmin"
	Case "buddy.asp"
		strOnlineLocation = strOnlineLocation & "buddy.asp"
	Case "portal_Resources.asp"
		strOnlineLocation = strOnlineLocation & "portal Resources"
	Case "subscription_list.asp"
		strOnlineLocation = strOnlineLocation & "subscription list"
	Case "view_announcements.asp"
		strOnlineLocation = strOnlineLocation & "view announcements"
	Case "faq.asp"
		strOnlineLocation = strOnlineLocation & "faq"
	Case "events.asp"
		strOnlineLocation = strOnlineLocation & "events"
' ############## end ##########################
	Case "pop_profile.asp"
		If Request.QueryString("mode") = "Display" Then
			strOnlineLocation = strOnlineLocation & "Members Profile"
		else
			strOnlineLocation = strOnlineLocation & "Profile"
		end If
	Case "forum.asp"
		If Request.QueryString("FORUM_ID") <> "" Then
			set rst = my_conn.execute("SELECT FORUM_ID, F_SUBJECT FROM " & strTablePrefix & "FORUM WHERE FORUM_ID = " & Request.QueryString("FORUM_ID"))
			Forum_Subject = rst("F_SUBJECT")
			rst.close
			set rst = nothing	
			strOnlineLocation = "Viewing Topics in: <a href=""link.asp?FORUM_ID=" & Request.QueryString("FORUM_ID") & """>"
		end if
		strOnlineLocation = strOnlineLocation &	Forum_Subject
	Case "topic.asp"
		if Request.QueryString("ARCHIVE") = "true" Then
			strOnlineLocation = strOnlineLocation &	 "Viewing Archived Message"
		else
			if Request.Querystring("TOPIC_ID") <> "" Then
				set rst = my_conn.execute("SELECT TOPIC_ID, T_SUBJECT FROM " & strTablePrefix & "TOPICS WHERE TOPIC_ID = " & Request.Querystring("TOPIC_ID"))
				Topic_Subject = rst("T_SUBJECT")
				rst.close
				set rst = nothing
				strOnlineLocation = "Viewing Topic: <a href=""link.asp?TOPIC_ID=" & Request.QueryString("TOPIC_ID") & """>"
				strOnlineLocation = strOnlineLocation & Topic_Subject
			end if
		end if
	Case "post.asp"
		if Request.QueryString("method") = "Reply" Then
			strOnlineLocation = "Replying To Message:  <a href=""link.asp?TOPIC_ID=" & Request.QueryString("TOPIC_ID") & """>" & Request.QueryString("Topic_Title")
		elseif Request.QueryString("method") = "Topic" Then
			strOnlineLocation = "Posting New Topic in: <a href=""link.asp?FORUM_ID=" & Request.QueryString("FORUM_ID") & """>" & Request.QueryString("Forum_Title")
		else
			strOnlineLocation = strOnlineLocation & "Unknown"
		end if
	Case else
		strOnlineLocation = strOnlineLocation & "Unknown Page"
End Select
strOnlineLocation = strOnlineLocation & "</a>"
if lcase(instr(strOnlinePathInfo, "admin_")) > 0 Then
	strOnlineLocation = "Admin Options"	
end if

'#######################################################

' FIND OUT IF THEY ARE A GUEST, OR A USER
if Request.Cookies(strTempCookieType & "User")("Name") = "" then
	strOnlineUser = "Guest"
else
	strOnlineUser = Request.Cookies(strTempCookieType & "User")("Name")
end if

strOnlineUserIP = Request.ServerVariables("REMOTE_ADDR")


' LETS ENCODE THIS INFO
strOnlineUser = OnlineSQLencode(strOnlineUser)
strOnlineLocation = OnlineSQLencode(strOnlineLocation)

' SET WHEN TO TIMEOUT THE USER
' DO THIS IN MINUTES
strOnlineDate = DateToStr(strForumTimeAdjust)
strOnlineCheckInTime = DateToStr(strForumTimeAdjust)
strOnlineTimedOut = DateToStr(DateAdd("n",-7,strForumTimeAdjust))     'time out the user after 7 minutes

'CHECK IF USER NAME AND IP ADDRESS MATCH
set rsWho = Server.CreateObject("ADODB.Recordset")
strSql = "SELECT " & strTablePrefix & "ONLINE.UserID, " & strTablePrefix & "ONLINE.UserIP, " & strTablePrefix & "ONLINE.LastChecked"
strSql = strSql & " FROM " & strTablePrefix & "ONLINE "
strSql = strSql & " WHERE " & strTablePrefix & "ONLINE.UserIP='" & strOnlineUserIP & "' AND " & strTablePrefix & "ONLINE.UserID='" & strOnlineUser & "'"
rsWho.Open strSql,my_conn,3,1,1

'STORE THE INFORMATION IN DATABASE
if rsWho.eof or rsWho.bof then
	on error resume next
	if strOnlineUser = "Guest" then
		strSql =  "INSERT INTO " & strTablePrefix & "ONLINE (UserID,UserIP,DateCreated,CheckedIn,LastChecked,M_BROWSE) VALUES ('"
		strSql = strSQL & strOnlineUser & "','" & strOnlineUserIP & "','" & strOnlineDate & "','" & strOnlineCheckInTime & "','" & strOnlineCheckInTime & "','" & strOnlineLocation & "')"
	else
		'CHECK IF THE USER NAME IS ALREADY THERE
		set rsUserExists = Server.CreateObject("ADODB.Recordset")
		strSql = "SELECT " & strTablePrefix & "ONLINE.UserID, " & strTablePrefix & "ONLINE.UserIP, " & strTablePrefix & "ONLINE.LastChecked"
		strSql = strSql & " FROM " & strTablePrefix & "ONLINE "
		strSql = strSql & " WHERE " & strTablePrefix & "ONLINE.UserID='" & strOnlineUser & "'"
		rsUserExists.Open strSql,my_conn,3,1,1
		if rsUserExists.eof or rsUserExists.bof then 
		' THEY ARE A NEW USER SO INSERT THEIR USERNAME
			strSql =  "INSERT INTO " & strTablePrefix & "ONLINE (UserID,UserIP,DateCreated,CheckedIn,LastChecked,M_BROWSE) VALUES ('"
			strSql = strSQL & strOnlineUser & "','" & strOnlineUserIP & "','" & strOnlineDate & "','" & strOnlineCheckInTime & "','" & strOnlineCheckInTime & "','" & strOnlineLocation & "')"
		else 
			' LETS UPDATE THE TABLE SO IT SHOWS THERE LAST ACTIVE VISIT AND NEW IP ADDRESS
			strSql = "UPDATE " & strTablePrefix & "ONLINE SET M_BROWSE='" & strOnlineLocation & "' , LastChecked='" & strOnlineCheckInTime & "' , UserIP='" & strOnlineUserIP & "' WHERE UserID='" & strOnlineUser & "'" 
		end if
		'rsUserExists.close
		'set rsUserExists = nothing
	end if
	my_Conn.Execute (strSql)
	if err.number <> 0 then response.write err.number & "|" & err.description
else
	' LETS UPDATE THE TABLE SO IT SHOWS THERE LAST ACTIVE VISIT
	strSql = "UPDATE " & strTablePrefix & "ONLINE SET M_BROWSE='" & strOnlineLocation & "' , LastChecked='" & strOnlineCheckInTime & "' WHERE UserID='" & strOnlineUser & "' AND " & strTablePrefix & "ONLINE.UserIP='" & strOnlineUserIP & "'"
	my_Conn.Execute (strSql)
end if


' LETS DELETE ALL INACTIVE USERS
strSql = "DELETE FROM " & strTablePrefix & "ONLINE WHERE LastChecked < '" & strOnlineTimedOut & "'"
strSql = strSql & " OR (" & strTablePrefix & "ONLINE.UserIP='" & strOnlineUserIP & "' AND " & strTablePrefix & "ONLINE.UserID <> '" & strOnlineUser & "')"
my_Conn.Execute strSql


' Get Active Users count for display on Default.asp
strOnlineCountType = "U"
onlinecount = GetOnlineActiveCount(strOnlineCountType)
strOnlineUsersCount = onlinecount
'Get Guest count for display on Default.asp
strOnlineCountType = "G"
Guests = GetOnlineActiveCount(strOnlineCountType)
strOnlineGuestsCount = Guests
' Get Member count for display on Default.asp
strOnlineCountType = "M"
Members = GetOnlineActiveCount(strOnlineCountType)
strOnlineMembersCount = Members
' Get Chatter count for display on Default.asp
strOnlineCountType = "C"
Chatters = GetOnlineActiveCount(strOnlineCountType)
strOnlineChattersCount = Chatters

'rsWho.close
'set rsWho = nothing

function GetOnlineActiveCount(strOnlineCountType)
	strSqL = ""
	On Error Resume Next
	if strDBType = "access" then
		strSqL = "SELECT count(UserID) AS [ActiveCount] "
	else
		strSqL = "SELECT count(UserID) AS ActiveCount "
	end if
	strSql = strSql & "FROM " & strTablePrefix & "ONLINE "
	Select case strOnlineCountType
		Case "U"
			strSql = strSql
		Case "G"
			strSql = strSql & " WHERE Right(UserID, 5) = 'Guest' "
		Case "M"
			strSql = strSql & " WHERE Right(UserID, 5) <> 'Guest' "
		Case "C"
			strSql = strSql & " WHERE Right(M_BROWSE, 8) = 'chat.asp' " 
		Case else
			'Do nothing
	end select
	Set rsOnlineActiveCount = Server.CreateObject("ADODB.Recordset")
	rsOnlineActiveCount.Open strSql,my_conn,3,1,1
	if not rsOnlineActiveCount.eof then
		strOnlineTempCount = rsOnlineActiveCount("ActiveCount")
	else
		strOnlineTempCount = 0
	end if
	GetOnlineActiveCount = strOnlineTempCount
	rsOnlineActiveCount.close
	Set rsOnlineActiveCount = nothing		
end function
if Err.description <> "" then
	Err.Clear
end if


'########### END WHOS ONLINE SCRIPT #################
%>