📄 online.asp

📁 此程序是一个个人主页创造程序,该程序无插件,无任何恶意程序.
💻 ASP
字号:
<%
'#############################################################
'#      中国在线--极酷论坛 ver.2001 3.0
'#
'#  版权所有: 中国在线 (ChinaXP.Net)
'#
'#  制作人  : 周周 (SeeYa!)
'#
'#
'#  主页地址: http://www.ChinaXP.net/    中国在线
'#	      http://www.ChinaXP.Net/bbs/    中国在线--极酷论坛
'#
'#############################################################
%>
<script language="JavaScript">
<!-- hide from JavaScript-challenged browsers
function pop_online() { var MainWindow = window.open ("pop_online.asp", "","toolbar=no,location=no,menubar=no,scrollbars=yes,width=250,height=500,resizeable=yes,status=no");
}
// done hiding -->
</script>
<!--
<% if strShowStatistics <> "1" then %>
<tr>
<td bgcolor="<% =strCategoryCellColor %>" colspan="<%=sGetColspan(7, 6)%>">
	<font face="<% =strDefaultFontFace %>" size="<% =strDefaultFontSize %>" color="<% =strCategoryFontColor %>" size="+1"><b>论坛在线会员</b></font>
</td>
</tr>
<% End If %>
-->
<table cellspacing=0 cellpadding=0 width="<% Response.Write strTableWidth  %>" bgcolor="<% =strTableBorderColor %>" align=center border=0 nowrap valign="bottom">
<tr>
<td>
<table cellspacing=1 cellpadding=3 width=100% border=0>
<TR>
<TD noWrap width="92%" bgcolor="<% =strHeadCellColor %>">　<B>-=&gt;</B> 目前论坛总共有 <B><FONT color="<% =strInsistFontColor %>"><% =strOnlineGuestsCount + strOnlineMembersCount %></FONT></B> 人在线。其中，注册用户 <B><FONT color="<% =strInsistFontColor %>"><% =strOnlineMembersCount %></FONT></B> 人，访客 <B><FONT color="<% =strInsistFontColor %>"><% =strOnlineGuestsCount %></FONT></B> 人。　　　<a HREF="active_users.asp"><font face="<% =strDefaultFontFace %>" size="<% =strFooterFontSize %>">[查看详细的在线名单]</a>
</TD>
<TD valign=center noWrap bgcolor="<% =strHeadCellColor %>" width="8%" align=center><a HREF="javascript:this.location.reload()"><img src="<%=strImageURL %>refresh.gif" border="0"></a></TD>
</TR>
<TR bgcolor="<% =strForumCellColor %>">
<TD valign=top colspan="<%=sGetColspan(6, 5)%>" rowspan=2 align=center>
<table cellspacing=1 cellpadding=3 width="95%" border=0>
<TR>
<TD noWrap bgcolor="<% =strForumCellColor %>">
<%
	set rso = Server.CreateObject("ADODB.Recordset")
	'## Forum_SQL
	strSql ="SELECT " & strTablePrefix & "ONLINE.UserID, " & strTablePrefix & "ONLINE.M_BROWSE, " & strTablePrefix & "ONLINE.DateCreated, "
	strSql = strSql & strTablePrefix & "ONLINE.DateCreated, " & strTablePrefix & "ONLINE.CheckedIn, " & strTablePrefix & "ONLINE.LastChecked, "
	strSql = strSql & strTablePrefix & "ONLINE.UserIP, " & strTablePrefix & "ONLINE.M_OS, " & strTablePrefix & "ONLINE.M_BROWSER "
	strSql = strSql & " FROM " & strMemberTablePrefix & "ONLINE "
	strSql = strSql & " ORDER BY " & strTablePrefix & "ONLINE.DateCreated DESC"

	rso.cachesize = 100
	rso.open  strSql, my_Conn, 3

	rec = 1
	gg = 1

	If rso.EOF or rso.BOF then		'## No categories found in DB
		Response.Write ""
	Else
		rso.movefirst
		do until rso.EOF

			strOnLineTemp = Trim(RSO("M_BROWSE"))
			if Instr(strOnLineTemp, ".asp")>0 or Instr(strOnLineTemp, "</a>")>0 then
				strOnLineTemp = Replace(strOnLineTemp, "</a>", "")
				strPlace1 = Instr(strOnLineTemp, "<")
				if strPlace1 > 0 then
					strOnLineTemp = Replace(strOnLineTemp, "<", "|")
					strOnLineTemp = Replace(strOnLineTemp, ">", "|")
					strIpArr = Split(strOnLineTemp, "|")
					strOnLineTemp = strIpArr(0) & strIpArr(2)
				else
					strOnLineTemp = Right(strOnLineTemp, Len(strOnLineTemp)-strPlace1)
				end if
			end if
			strOnLineTemp = "目前位置：" & strOnLineTemp & chr(13)
			strOnLineTemp = strOnLineTemp & "来访时间：" & Chkdate(RSO("CheckedIn")) & " " & ChkTimeShort(RSO("CheckedIn")) & chr(13)
			strOnLineTemp = strOnLineTemp & "活动时间：" & ChkDate(RSO("LastChecked")) & " " & ChkTimeShort(RSO("LastChecked")) & chr(13)
			strOnLineTemp = strOnLineTemp & "操作系统：" & RSO("M_OS") & chr(13)
			strOnLineTemp = strOnLineTemp & "浏&nbsp;览&nbsp;器：&nbsp;" & RSO("M_BROWSER") & chr(13)
			strOnLineTemp = strOnLineTemp & "ＩＰ地址：" & GetUserIP(RSO("UserIP")) & chr(13)
			strOnLineTemp = strOnLineTemp & "来源鉴定：" & chkUserSource(RSO("UserIP"))
			set strPlace1 = Nothing

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

			if Right(rso("UserID"), 5) <> "Guest" then
				strOnineList = "<font face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """ color=""" & strForumLinkFontColor & """>"
				strOnineList = strOnineList & "<A href=""privatesend.asp?method=Topic&mname=" & chkString(rso("UserID"),"name") & """ title="
				if rsMember("M_LEVEL")=3 then
					strOnineList = strOnineList & "特殊人物：坛主><img src=""" & strImageURL & "messages3.gif"""
				elseif rsMember("M_LEVEL")=2 then
					strOnineList = strOnineList & "特殊人物：版主><img src=""" & strImageURL & "messages2.gif"""
				else
					strOnineList = strOnineList & "论坛成员><img src=""" & strImageURL & "messages1.gif"""
				end if
				strOnineList = strOnineList & " border=0 width=12 height=11 ALIGN=absmiddle></A>"

				'######## 这是我添加的高亮功能 by ChinaXP http://www.ChinaXP.Net #########
				bShowSelf = False
				if strDBNTUserName = rso("UserID") then
					'是自己的ID的时候，高亮
					strOnineList = strOnineList & "<ACRONYM TITLE=""" & strOnLineTemp & """><A href=""pop_profile.asp?mode=display&id=" & rsMember("MEMBER_ID") & """ target=_blank nowarp style=""color:#0000ff""><img src="""" border=0 width=3 height=0>" & chkString(rso("UserID"),"name") & "</A></ACRONYM></font>"
					bShowSelf = True
				else
					'不是自己的ID
					strOnineList = strOnineList & "<ACRONYM TITLE=""" & strOnLineTemp & """><A href=""pop_profile.asp?mode=display&id=" & rsMember("MEMBER_ID") & """ target=_blank nowarp><img src="""" border=0 width=3 height=0>" & chkString(rso("UserID"),"name") & "</A></ACRONYM></font>"
				end if
				'####################################################################

				if rec<>strOnlineMembersCount then
					strOnineList = strOnineList & "&nbsp;　　　"
				end if
				if rec mod 10 = 1 and rec > 1 then
					strOnineList = strOnineList & "<BR>　"
				end if
				Response.Write strOnineList
				rec = rec + 1
			end if
			rso.MoveNext
		loop
		if strOnlineMembersCount > 0 then Response.Write "<BR>"
		rso.movefirst
		do until rso.EOF
			strOnLineTemp = Trim(RSO("M_BROWSE"))
			if Instr(strOnLineTemp, ".asp")>0 or Instr(strOnLineTemp, "</a>")>0 then
				strOnLineTemp = Replace(strOnLineTemp, "</a>", "")
				strPlace1 = Instr(strOnLineTemp, "<")
				if strPlace1 > 0 then
					strOnLineTemp = Replace(strOnLineTemp, "<", "|")
					strOnLineTemp = Replace(strOnLineTemp, ">", "|")
					strIpArr = Split(strOnLineTemp, "|")
					strOnLineTemp = strIpArr(0) & strIpArr(2)
				else
					strOnLineTemp = Right(strOnLineTemp, Len(strOnLineTemp)-strPlace1)
				end if
			end if
			strOnLineTemp = "目前位置：" & strOnLineTemp & chr(13)
			strOnLineTemp = "来访时间：" & Chkdate(RSO("CheckedIn")) & " " & ChkTimeShort(RSO("CheckedIn")) & chr(13)
			strOnLineTemp = strOnLineTemp & "ＩＰ地址：" & GetUserIP(RSO("UserIP")) & chr(13)
			strOnLineTemp = strOnLineTemp & "来源鉴定：" & chkUserSource(RSO("UserIP"))

			set strPlace1 = Nothing

			if Right(rso("UserID"), 5) = "Guest" then
				strOnineList = "<font face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """ color=""" & strForumLinkFontColor & """>"

				'######## 这是我添加的高亮功能 by ChinaXP http://www.ChinaXP.Net #########
				if Request.ServerVariables("REMOTE_ADDR") = rso("UserIP") then
					if bShowSelf = False then
						'自己是客人，且为自己的ID的时候，高亮
						strOnineList = strOnineList & "<img src=""" & strImageURL & "messages4.gif"" border=0 ALIGN=absmiddle><ACRONYM TITLE=""" & strOnLineTemp & """><A href=# style=""color:#0000ff""><img src="""" border=0 width=3 height=0>客人</A></ACRONYM></FONT>"
					end if
				else
					'自己是客人但不是自己的ID
					strOnineList = strOnineList & "<img src=""" & strImageURL & "messages4.gif"" border=0 ALIGN=absmiddle><ACRONYM TITLE=""" & strOnLineTemp & """><A href=#><img src="""" border=0 width=3 height=0>客人</A></ACRONYM></FONT>"
				end if
				'####################################################################

				if gg<>strOnlineGuestsCount then
					strOnineList = strOnineList & "&nbsp;　"
				end if
				if gg mod 11 = 1 and gg > 11 then
					strOnineList = strOnineList & "<BR>"
				end if
				gg = gg + 1
				Response.Write strOnineList
			end if
			rso.MoveNext
		loop

	end if
rso.Close
SET rso = Nothing
SET rec = Nothing
SET gg = Nothing
SET strGuest = Nothing
%>
</font>
</TD>
</TR>
</table>
</TD>
</TR>
</table>
</td>
</tr>
</table>
⌨️ 快捷键说明

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