📄 online2.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="<% if (strShowModerators = "1") or (mlev = 4 or mlev = 3) then Response.Write("2") else Response.Write("2")%>"><img src="<%=strImageURL %>icon_2.gif" width="10" height="10" border="0"> <font face="<% =strDefaultFontFace %>" size="<% =strDefaultFontSize %>" color="<% =strCategoryFontColor %>" size="+1"><b><a HREF="active_users.asp">论坛在线统计</A></b></font></TD>
	</TR>
	<TR>
	  <TD align="center" bgcolor="<% =strAltForumCellColor %>" valign="middle"><a HREF="javascript:pop_online()"><img src="<%=strImageURL %>online.gif" border="0"></a></TD>
	  <TD valign=top bgcolor="<% =strForumCellColor %>" colspan="1"> <font face="<% =strDefaultFontFace %>" size="<% =strFooterFontSize %>" color="<% =strActiveLinkColor %>">&nbsp;&nbsp;目前论坛总共有 <B><FONT color="<% =strInsistFontColor %>"><% =strOnlineGuestsCount + strOnlineMembersCount %></FONT></B> 人在线。其中，注册用户 <B><FONT color="<% =strInsistFontColor %>"><% =strOnlineMembersCount %></FONT></B> 人，访客 <B><FONT color="<% =strInsistFontColor %>"><% =strOnlineGuestsCount %></FONT></B> 人。<BR>
	  <font face="<% =strDefaultFontFace %>" size="<% =strFooterFontSize %>" color="<% =strActiveLinkColor %>">&nbsp;&nbsp;在线名单图例：　<img src="<% =strImageURL %>messages_1.gif" width="12" height="11"> 论坛坛主， <img src="<% =strImageURL %>messages_2.gif" width="12" height="11"> 论坛版主， <img src="<% =strImageURL %>messages_4.gif" width="12" height="11"> 普通会员， <img src="<% =strImageURL %>messages_5.gif" width="12" height="11"> 客人或隐身会员</font><br>
	  <hr size=1 width=98%><img src="" width=1 height=2><br>

<% if strOnlineMembersCount > 0 then Response.Write("&nbsp; ")%>
<%
'if Request.Cookies(strUniqueID & "User")("Name") <> "" Then

	set rs = Server.CreateObject("ADODB.Recordset")
	'## Forum_SQL
'	strSql ="SELECT " & strTablePrefix & "ONLINE.UserID, " & strTablePrefix & "ONLINE.M_BROWSE, " & strTablePrefix & "ONLINE.DateCreated, " & strTablePrefix & "ONLINE.DateCreated, " & strTablePrefix & "ONLINE.CheckedIn, " & strTablePrefix & "ONLINE.LastChecked, " & strTablePrefix & "ONLINE.UserIP "

	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"

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

	rec = 1
	gg = 1
	If rs.EOF or rs.BOF then  '## No categories found in DB
		Response.Write ""
	Else
		rs.movefirst
		do until rs.EOF
			strOnLineTemp = Trim(RS("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(rs("CheckedIn")) & " " & ChkTimeShort(rs("CheckedIn")) & chr(13)
			strOnLineTemp = strOnLineTemp & "活动时间：" & ChkDate(rs("LastChecked")) & " " & ChkTimeShort(rs("LastChecked")) & chr(13)
			strOnLineTemp = strOnLineTemp & "操作系统：" & RS("M_OS") & chr(13)
			strOnLineTemp = strOnLineTemp & "浏&nbsp;览&nbsp;器：&nbsp;" & RS("M_BROWSER") & chr(13)
			strOnLineTemp = strOnLineTemp & "ＩＰ地址：" & GetUserIP(RS("UserIP")) & chr(13)
			strOnLineTemp = strOnLineTemp & "来源鉴定：" & chkUserSource(RS("UserIP"))

			set strPlace1 = Nothing				

			if Right(rs("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 = '" & rs("UserID") & "' AND " & strTablePrefix & "ONLINE.UserID = M_NAME"
				set rsMember =  my_Conn.Execute (strSql)
			end if

			if Right(rs("UserID"), 5) <> "Guest" then
				strOnineList = "<font face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """ color=""" & strForumLinkFontColor & """>"
				strOnineList = strOnineList & "<A href=""privatesend.asp?method=Topic&mname=" & chkString(rs("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 = rs("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(rs("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(rs("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
			RS.MoveNext
		loop
		strOnLineTemp = ""
		if strOnlineMembersCount > 0 then Response.Write "<BR>"
		if strOnlineGuestsCount > 0 then Response.Write "&nbsp; "
		RS.movefirst
		do until RS.EOF
			strOnLineTemp = Trim(RS("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(rs("CheckedIn")) & " " & ChkTimeShort(rs("CheckedIn")) & chr(13)
			strOnLineTemp = strOnLineTemp & "ＩＰ地址：" & GetUserIP(RS("UserIP")) & chr(13)
			strOnLineTemp = strOnLineTemp & "来源鉴定：" & chkUserSource(RS("UserIP"))

			set strPlace1 = Nothing

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

				'######## 这是我添加的高亮功能 by ChinaXP http://www.ChinaXP.Net #########
				if Request.ServerVariables("REMOTE_ADDR") = RS("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 mod 10 = 1 and gg > 10 then
					strOnineList = strOnineList & "<BR>"
				end if
				if gg<>strOnlineGuestsCount then
					strOnineList = strOnineList & "　&nbsp;"
				end if
				gg = gg + 1
				Response.Write strOnineList
			end if
			RS.MoveNext
		loop

	end if

	rs.Close
	SET rs = Nothing
	strOnLineTemp = ""
	SET strOnLineTemp = Nothing
	if IsObject(rsMember) then
		rsMember.Close
		SET rsMember = Nothing
	end if
'end if
%>
</font>
</TD>
</TR>
<%' End If %>
⌨️ 快捷键说明

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