📄 active_users.asp

📁 此程序是一个个人主页创造程序,该程序无插件,无任何恶意程序.
💻 ASP
字号:
<%
'#############################################################
'#      中国在线--极酷论坛 ver.2001 3.0
'#
'#  版权所有: 中国在线 (ChinaXP.Net)
'#
'#  制作人  : 周周 (SeeYa!)
'#
'#
'#  主页地址: http://www.ChinaXP.net/    中国在线
'#	      http://www.ChinaXP.Net/bbs/    中国在线--极酷论坛
'#
'#############################################################
%>
<!--#INCLUDE FILE="config.asp" -->
<!--#INCLUDE FILE="inc_functions.asp" -->
<!--#INCLUDE FILE="inc_top.asp" -->
<!--#INCLUDE FILE="inc_functions2.asp" -->
<%
If Request("whichpage") = "" or Request("whichpage") <= 0 then
	mypage = 1
Else
	mypage = CINT(Request("whichpage"))
End If

'## Do Cookie stuffs with reload
nRefreshTime = Request.Cookies(strTempCookieType & "Reload")

if Request.form("cookie") = "1" then
	if strSetCookieToForum = 1 then
		Response.Cookies(strTempCookieType & "Reload").Path = strTempCookieType
	end if
	Response.Cookies(strTempCookieType & "Reload") = Request.Form("RefreshTime")
	Response.Cookies(strTempCookieType & "Reload").expires = strForumTimeAdjust + 365
	nRefreshTime = Request.Form("RefreshTime")
end if

if nRefreshTime = "" then
	nRefreshTime = 0
end if
ActiveSince = Request.Cookies(strTempCookieType & "ActiveSince")
'## Do Cookie stuffs with show last date

if Request.form("cookie") = "2" then
	ActiveSince = Request.Form("ShowSinceDateTime")
	if strSetCookieToForum = 1 then
		Response.Cookies(strTempCookieType & "ActiveSince").Path = strTempCookieType
	end if
	Response.Cookies(strTempCookieType & "ActiveSince") = ActiveSince
end if

mypagesize = Request.Cookies("paging")("pagesize")
If mypagesize = "" then
	mypagesize = 15
end if
%>
<script language="JavaScript">
<!--
function autoReload()
{
	document.ReloadFrm.submit()
}
//-->
</script>
<script language="JavaScript">
<!--
function SetLastDate()
{
	document.LastDateFrm.submit()
}
//-->
</script>
<script language="JavaScript">
<!--
function jumpTo(s) {if (s.selectedIndex != 0) location.href = s.options[s.selectedIndex].value;return 1;}
// -->
</script>
<% '################################## %>
	<TD width="70%" align="left" valign="top">
<TABLE border="0" width="85%" align=center>
  <TR>
    <TD width="33%" align="left" nowrap><font face="<% Response.Write strDefaultFontFace %>" size="<% Response.Write strDefaultFontSize %>"><a href="default.asp"><img src="<% =strImageURL %>icon_folder_open.gif" alt="返回论坛首页" border="0">&nbsp;<% =strForumTitle %></a>
<BR><img src="<%=strImageURL %>icon_bar.gif" border="0"><img src="<% =strImageURL %>icon_folder_open_topic.gif" border="0">&nbsp;论坛在线会员列表（最后更新时间：<% =chkDate(DateToStr(strForumTimeAdjust)) %> <% =chkTime(DateToStr(strForumTimeAdjust)) %>）
</FONT></TD>
  </TR>
</TABLE>
</TD>
</TR>
</TABLE>
<% '################################## %>

<table width="<% Response.Write strTableWidth %>" align="center" border=0>
  <tr>
    <td></td>
    <td align="right">
    <form name="ReloadFrm" action="active_users.asp" method="post"><font face="<% =strDefaultFontFace %>" size="<% =strDefaultFontSize %>">
    <select name="RefreshTime" size="1" onchange="autoReload();">
        <option value="0"  <% if nRefreshTime = "0" then Response.Write(" SELECTED")%>>不要刷新</option>
        <option value="1"  <% if nRefreshTime = "1" then Response.Write(" SELECTED")%>>每分钟刷新一次</option>
        <option value="5"  <% if nRefreshTime = "5" then Response.Write(" SELECTED")%>>每隔五分钟刷新一次</option>
        <option value="10" <% if nRefreshTime = "10" then Response.Write(" SELECTED")%>>每隔十分钟刷新一次</option>
        <option value="15" <% if nRefreshTime = "15" then Response.Write(" SELECTED")%>>每隔十五分钟刷新一次</option>
        <option value="30" <% if nRefreshTime = "30" then Response.Write(" SELECTED")%>>每隔半个小时刷新一次</option>
    </select>
    <input type="hidden" name="Cookie" value="1">
    </font>
    </form>
    </td>
  </tr>
</table>
<SCRIPT>
<!--
if (document.ReloadFrm.RefreshTime.options[document.ReloadFrm.RefreshTime.selectedIndex].value > 0) {
	reloadTime = 60000 * document.ReloadFrm.RefreshTime.options[document.ReloadFrm.RefreshTime.selectedIndex].value
	self.setInterval('autoReload()', 60000 * document.ReloadFrm.RefreshTime.options[document.ReloadFrm.RefreshTime.selectedIndex].value)
}
//-->
</SCRIPT>
<DIV align=center>
<B><FONT SIZE="4" FACE="宋体, Arial" COLOR="<% =strDefaultFontColor %>">论坛在线会员列表</FONT></B>
</DIV>
<table bgcolor="<% =strTableBorderColor %>" cellpadding=2 border=0 cellspacing=1 width="<% Response.Write strTableWidth %>" align="center">
  <tr>
    <td bgcolor="<% =strHeadCellColor %>" align=center valign=top nowrap><font face="<% =strDefaultFontFace %>" size="<% =strDefaultFontSize %>" color="<% =strHeadFontColor %>"><B>会员名</B></FONT></td>
<%'	if (mlev = 4 or mlev = 3) then %>
    <td bgcolor="<% =strHeadCellColor %>" align=center valign=top nowrap><font face="<% =strDefaultFontFace %>" size="<% =strDefaultFontSize %>" color="<% =strHeadFontColor %>"><B>IP 地址</B></FONT></td>
<%'	end if %>
    <td bgcolor="<% =strHeadCellColor %>" align=center valign=top nowrap><font face="<% =strDefaultFontFace %>" size="<% =strDefaultFontSize %>" color="<% =strHeadFontColor %>"><B>状态</B></FONT></td>
    <td bgcolor="<% =strHeadCellColor %>" align=center valign=top nowrap><font face="<% =strDefaultFontFace %>" size="<% =strDefaultFontSize %>" color="<% =strHeadFontColor %>"><B>登陆时间</B></FONT></td>
    <td bgcolor="<% =strHeadCellColor %>" align=center valign=top nowrap><font face="<% =strDefaultFontFace %>" size="<% =strDefaultFontSize %>" color="<% =strHeadFontColor %>"><B>最近活动时间</B></FONT></td>
    <td bgcolor="<% =strHeadCellColor %>" align=center valign=top nowrap><font face="<% =strDefaultFontFace %>" size="<% =strDefaultFontSize %>" color="<% =strHeadFontColor %>"><B>停留时间</B></FONT></td>
</tr>
<%
	set rs = Server.CreateObject("ADODB.Recordset")
	'## Forum_SQL
	strSql ="SELECT " & strTablePrefix & "ONLINE.UserID, " & strTablePrefix & "ONLINE.UserIP, " & strTablePrefix & "ONLINE.M_BROWSE, " & strTablePrefix & "ONLINE.DateCreated, " & strTablePrefix & "ONLINE.LastChecked, " & strTablePrefix & "ONLINE.CheckedIn "
	strSql = strSql & " FROM " & strMemberTablePrefix & "ONLINE "
	strSql = strSql & " ORDER BY " & strTablePrefix & "ONLINE.DateCreated, " & strTablePrefix & "ONLINE.CheckedIn DESC"

	rs.cachesize = 20
	rs.open  strSql, my_Conn, 3

	i = 0

	If rs.EOF or rs.BOF then  '## No categories found in DB
		Response.Write ""
	Else
		num = 0
		RS.MoveFirst
		RS.PageSize = 12
		RS.CacheSize = RS.PageSize
		maxPages = cint(RS.PageCount)
		If myPage > RS.PageCount Then
			myPage = RS.PageCount
		end if
		RS.AbsolutePage = myPage

		StartPageNum=1
		do while StartPageNum+10<=myPage
			StartPageNum = StartPageNum+10
		Loop
		EndPageNum = StartPageNum+9
		If EndPageNum > RS.Pagecount then EndPageNum = RS.Pagecount

		howmanyrecs = 0
		rec = 1
		do until rs.EOF or (rec = 12 + 1)
			if strI = 0 then
				CColor = strAltForumCellColor
			else
				CColor = strForumCellColor
			end if

  			strTheUserID = rs("UserID")
  			strTheUserID = OnlineSQLdecode(strTheUserID)

  			if Right(rs("UserID"), 5) <> "Guest" then
				strSql = "SELECT "   & strMemberTablePrefix & "MEMBERS.MEMBER_ID, " & strMemberTablePrefix & "MEMBERS.M_NAME,  " & strTablePrefix & "ONLINE.UserID "
				strSql = strSql & " FROM " & strTablePrefix & "MEMBERS, " & strTablePrefix & "ONLINE "
				strSql = strSql & " WHERE " & strMemberTablePrefix & "MEMBERS.M_NAME = '" & rs("UserID") & "' "
				set rsMember =  my_Conn.Execute (strSql)
			end if
			if Right(rs("UserID"), 5) = "Guest" then
				num = num + 1
			end if

strRSCheckedIn = rs("CheckedIn")
strOnlineLastDateChecked = rs("LastChecked")
strOnlineDateCheckedIn = StrToDate(strRSCheckedIn)
strOnlineLastDateChecked = StrToDate(strOnlineLastDateChecked)

strOnlineTotalTime = DateDiff("n",strOnlineDateCheckedIn,strOnlineLastDateChecked)

If strOnlineTotalTime > 60 then
' they must have been online for like an hour or so.
strOnlineHours = 0
do until strOnlineTotalTime < 60
strOnlineTotalTime = (strOnlineTotalTime - 60)
strOnlineHours = strOnlineHours + 1
loop
strOnlineTotalTime = strOnlineHours & " 小时 " & strOnlineTotalTime & " 分钟"
Else
strOnlineTotalTime = strOnlineTotalTime & " 分钟"
End If

%>
  <tr bgcolor="<% =CColor %>">
<%  if Right(rs("UserID"), 5) = "Guest" then %>
    <td valign="middle" align="center"><font face="<% =strDefaultFontFace %>" size="<% =strDefaultFontSize %>" color="<% =strDefaultFontColor %>">游客 #<% =num %></font></td>
    <% else %>
    <td valign="middle" align="center"><font face="<% =strDefaultFontFace %>" size="<% =strDefaultFontSize %>" color="<% =strDefaultFontColor %>">
<%          if strUseExtendedProfile then
				Response.Write("<a href=""pop_profile.asp?mode=display&id="& rsMember("MEMBER_ID") & """>")
			else
				Response.Write("<a href=""JavaScript:openWindow2('pop_profile.asp?mode=display&id=" & rsMember("MEMBER_ID") & "')"">")
			end if
			Response.Write(rs("UserID") & "</a></font>")
%>
    <% end if %>
	<td valign="middle" align="center"><font face="<% =strDefaultFontFace %>" size="<% =strDefaultFontSize %>" color="<% =strDefaultFontColor %>"><% =GetUserIP(RS("UserIP")) %></font></td>
	<td valign="middle" align="center"><font face="<% =strDefaultFontFace %>" size="<% =strDefaultFontSize %>" color="<% =strDefaultFontColor %>">
<% if strAllowHTML = "1" then %>
	<% =ChkString(rs("M_BROWSE"),"display") %>
<% else %>
<%
	strOnLoneTemp = Trim(RS("M_BROWSE"))
	if Instr(strOnLoneTemp, ".asp")>0 or Instr(strOnLoneTemp, "</a>")>0 then
		strOnLoneTemp = Replace(strOnLoneTemp, "</a>", "")
		strPlace1 = Instr(strOnLoneTemp, "<")
		if strPlace1 > 0 then
			strOnLoneTemp = Replace(strOnLoneTemp, "<", "|")
			strOnLoneTemp = Replace(strOnLoneTemp, ">", "|")
			strIpArr = Split(strOnLoneTemp, "|")
			strOnLoneTemp = strIpArr(0) & strIpArr(2)
		else
			strOnLoneTemp = Right(strOnLoneTemp, Len(strOnLoneTemp)-strPlace1)
		end if
	end if
	Response.Write(strOnLoneTemp)
%>
<% end if %>
</A></font></td>
    <td align="center" valign="middle" nowrap><font face="<% =strDefaultFontFace %>" size="<% =strDefaultFontSize %>" color="<% =strDefaultFontColor %>"><% =chkTime(strRSCheckedIn) %></FONT></td>
    <td align="center" valign="middle" nowrap><font face="<% =strDefaultFontFace %>" size="<% =strDefaultFontSize %>" color="<% =strDefaultFontColor %>"><% =chkTime(DateToStr(strOnlineLastDateChecked)) %></FONT></td>
    <td align="center" valign="middle" nowrap><font face="<% =strDefaultFontFace %>" size="<% =strDefaultFontSize %>" color="<% =strDefaultFontColor %>"><%=strOnlineTotalTime%></FONT></td>
  </tr>
<%
			rec = rec + 1
			strI = strI + 1
			if strI = 2 then
				strI = 0
			end if
			rs.MoveNext
		loop
	end if
%>

</table>
<table width="<%=strTableWidth%>" align=center>
<tr>
     <td></td>
     <td align=right width=100>
<% if maxPages > 1 then %>
	<table width="<% =strTableWidth %>" border=0 align="right">
  	<tr>
    	<td valign="top"><font face="<% =strDefaultFontFace %>" size="<% =strDefaultFontSize %>"><b>本页共有 <% = maxPages %> 页，页码：</b>　　<% Call Paging() %></font></td>
  	</tr>
	</table>
<% end if %>
</td>
</tr>
</table>
<p align=center>
<font face="<% =strDefaultFontFace %>" size="<% =strDefaultFontSize %>-1" color="<% =strCategoryFontColor %>">
<a href="default.asp">返回论坛</A>
</FONT>
<p>
<!--#INCLUDE FILE="inc_adv.asp" -->
<!--#INCLUDE FILE="inc_footer.asp" -->

<%
sub Paging()
	if maxPages > 1 then
		sScriptName = Request.ServerVariables("script_name")

		ref = "<B>[&nbsp;"
		if myPage-10 > 0 then
			ref = ref & "<A HREF=""" & sScriptName
			ref = ref & "?whichpage=" & StartPageNum - 1
			ref = ref & "&pagesize=" & request.cookies("paging")("pagesize")
			ref = ref & """>←</a>&nbsp;"
		end if

		For I = StartPageNum to EndPageNum
			if I <> myPage then
				ref = ref & "<A href=""" & sScriptName & "?whichpage=" & I
				ref = ref & "&pagesize=" & request.cookies("paging")("pagesize")
				ref = ref & """>" & I & "</a>&nbsp;"
			else
				ref = ref & "<font face=" & strDefaultFontFace & " size=" & strDefaultFontSize & " color=" & strInsistFontColor & ">" & I & "</FONT>&nbsp;"
			end if
		Next

		if EndPageNum < maxPages then
			ref = ref & "<A href=""" & sScriptName & "?whichpage=" & EndPageNum + 1
			ref = ref & "&pagesize=" & request.cookies("paging")("pagesize")
			ref = ref & """>→</a>&nbsp;"
		end if
		ref = ref & "]</B>"
		Response.Write (ref)
	end if
end sub

sub Paging2()
	if maxPages > 1 then
		if Request.QueryString("whichpage") = "" then
			pge = 1
		else
			pge = Request.QueryString("whichpage")
		end if
		scriptname = request.servervariables("script_name")
		Response.Write("<table border=0 width=50% cellspacing=0 cellpadding=1 align=top><tr>")
		for counter = 1 to maxPages
			if counter <> cint(pge) then
				ref = "<td align=right bgcolor=" & strPageBGColor & "><font face=" & strDefaultFontFace & " size=" & strDefaultFontSize & ">" & "&nbsp;" & widenum(counter) & "<a href='" & scriptname
				ref = ref & "?whichpage=" & counter
				ref = ref & "&pagesize=" & request.cookies("paging")("pagesize")
				if top = "1" then
					ref = ref & ">"
					ref = ref & "</font><b><font face='" & strDefaultFontFace & "' "
					ref = ref & "color='" & strHeadFontColor & "'"
					ref = ref & ">" & counter & "</font></b></a></td>"
					Response.Write ref
				else
					ref = ref & "'>" & counter & "</font></a></td>"
					Response.Write ref
				end if
			else
				Response.Write("<td align=right bgcolor=" & strPageBGColor & "><font face=" & strDefaultFontFace & " size=" & strDefaultFontSize & ">" & "&nbsp;" & widenum(counter) & "<b>" & counter & "</b></font></td>")
			end if
			if counter mod 15 = 0 then
				Response.Write("</tr><tr>")
			end if
		next
		Response.Write("</tr></table>")
	end if
	top = "0"
end sub
%>
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -