inc_top.asp

一个不错的ASP论坛源码

	End If
ElseIf lcase(Right(strOnlinePathInfo, 11)) = "pm_view.asp" Then
	strOnlineLocation = "<a href=""pm_view.asp"">正在查看悄悄话收件箱</a>"
ElseIf lcase(Right(strOnlinePathInfo, 14)) = "pm_options.asp" Then
	strOnlineLocation = "<a href=""pm_view.asp"">查看悄悄话参数设置</a>"
ElseIf lcase(Right(strOnlinePathInfo, 15)) = "privatesend.asp" Then
	strOnlineLocation = "<a href=""privatesend.asp"">正在发送悄悄话</a>"
ElseIf lcase(Right(strOnlinePathInfo, 16)) = "active_users.asp" Then
	strOnlineLocation = "<a href=""active_users.asp"">正在查看在线人员列表</a>"
Else
	strOnlineLocation = "不知道在哪里"
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 = remoteIP()

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

' SET WHEN TO TIMEOUT THE USER
' DO THIS IN SECONDS
strOnlineDate = DateToStr(Date)
strOnlineCheckInTime = DateToStr(Now())

strOnlineTimedOut = strOnlineCheckInTime - 660      'time out the user after 11 minutes ( 660 seconds )

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 & "'"

set rsWho =  my_Conn.Execute (strSql)

if rsWho.eof or rsWho.bof then
	' THEY ARE A NEW USER SO INSERT THERE USERNAME
	on error resume next
	Set objRS2 = Server.CreateObject("ADODB.Recordset")
	strSQL =  "INSERT INTO " & strTablePrefix & "ONLINE (UserID,UserIP,DateCreated,CheckedIn,LastChecked,M_BROWSE) VALUES ('"
	strSql = strSQL & strOnlineUser & "','" & strOnlineUserIP & "','" & strOnlineDate & "','" & strOnlineCheckInTime & "','" & strOnlineCheckInTime & "','" & strOnlineLocation & "')"
	my_Conn.Execute (strSql)
	if err.number <> 0 then response.write err.number & "|" & err.description
else
	' THEY ARE A ACTIVE USER
	strSql = "SELECT " & strTablePrefix & "ONLINE.UserID, " & strTablePrefix & "ONLINE.UserIP, " & strTablePrefix & "ONLINE.LastChecked"
	strSql = strSql & " FROM " & strTablePrefix & "ONLINE "
	strSql = strSql & " WHERE " & strTablePrefix & "ONLINE.UserID='" & strOnlineUser & "' AND " & strTablePrefix & "ONLINE.UserIP = '" & strOnlineUserIP & "'"
	set rsLastChecked =  my_Conn.Execute (strSql)

	' 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
SQL = "DELETE FROM " & strTablePrefix & "ONLINE WHERE LastChecked < '" & strOnlineTimedOut & "'"
my_Conn.Execute SQL

set rsOnline = Server.CreateObject("ADODB.Recordset")

if strDBType = "access" then
	strSqL = "SELECT count(UserID) AS [onlinecount] "
else
	strSqL = "SELECT count(UserID) AS onlinecount  "
end if

strSql = strSql & "FROM " & strTablePrefix & "ONLINE "
Set rsOnline = my_Conn.Execute(strSql)
onlinecount = rsOnline("onlinecount")
strOnlineUsersCount = rsOnline("onlinecount")

' Get Guest count for display on Default.asp
set rsGuests = Server.CreateObject("ADODB.Recordset")
if strDBType = "access" then
	strSqL = "SELECT count(UserID) AS [Guests] "
else
	strSqL = "SELECT count(UserID) AS Guests  "
end if
strSql = strSql & "FROM " & strTablePrefix & "ONLINE "
strSql = strSql & " WHERE Right(UserID, 5) = 'Guest' "

Set rsGuests = my_Conn.Execute(strSql)
Guests = rsGuests("Guests")
strOnlineGuestsCount = rsGuests("Guests")


' Get Member count for display on Default.asp
set rsGuests = Server.CreateObject("ADODB.Recordset")
if strDBType = "access" then
	strSqL = "SELECT count(UserID) AS [Members] "
else
	strSqL = "SELECT count(UserID) AS Members  "
end if
strSql = strSql & "FROM " & strTablePrefix & "ONLINE "
strSql = strSql & " WHERE Right(UserID, 5) <> 'Guest' "

Set rsMembers = my_Conn.Execute(strSql)
Members = rsMembers("Members")
strOnlineMembersCount = rsMembers("Members")

' END WHOS ONLINE SCRIPT
%>
<body background="<%= strPageBGImage %>" topmargin="5" leftmargin="20" bgColor="<% =strPageBGColor %>" text="<% =strDefaultFontColor %>" link="<% =strLinkColor %>" aLink="<% =strActiveLinkColor %>" vLink="<% =strActiveLinkColor %>" <% If intSideMenu = 1 then response.write "onload=init()" end if %> >
<table width="100%" align="center" cellspacing="0" cellpadding="1"  border="0" bgcolor=#000000>
  <tr>
    <td>
      <table width="100%" cellspacing="0" cellpadding="4" border="0">
        <tr>
          <td bgcolor="<% =strForumCellColor %>" valign="middle" align=left>
           <b>>></b> 
<% if strAuthType="nt" then %><b><% =Session(strCookieURL & "username")%>&nbsp;(<% =Session(strCookieURL & "userid") %>)</b>&nbsp;
<%
	else 
		if strAuthType = "db" then %>
<b><% = ChkString(strDBNTUserName, "display") %></b>
<a href="<% =strHomeURL %>"><acronym title="返回主页">主页</acronym></a> | 
<% if strUseExtendedProfile then %>
<a href="pop_profile.asp?mode=Edit"><acronym title="编辑你的个人资料">资料</acronym></a>
<% else %>
<a href="javascript:openWindow3('pop_profile.asp?mode=Edit')"><acronym title="编辑你的个人资料">资料</acronym></a>
<%
			end if 
			if strAutoLogon <> 1 then %> | <a href="policy.asp"><acronym title="注册了才能发表文章哦！">注册</acronym></a><% end if %>
        |
        <a href="active.asp"><acronym title="看看有什么新文章吧！">最新</acronym></a>
        |
        <a href="active_users.asp"><acronym title="看看有谁在线..">在线</acronym></a>
        |
        <a href="topic_stats.asp"><acronym title="查看主题相关统计数字">统计</acronym></a>
        |
        <a href="members.asp"><acronym title="论坛现有会员">会员</acronym></a>
        |
        <a href="search.asp"><acronym title="按关键字、日期、作者来搜寻">搜索</acronym></a>
        |
        <a href="bookmark.asp"><acronym title="查看收藏的贴子">收藏</acronym></a>
        |
        <a href="faq.asp"><acronym title="常见问题的解答">帮助</acronym></a>
        |
        <a href="cancel_replies.asp"><acronym title="取消提醒电子邮件">设置</acronym></a>
        |
        <a href="events.asp"><acronym title="查看或新增日记">日记</acronym></a></font>
<% if (lcase(strNoCookies) = "1") then %> | <a href="admin_home.asp">管理选项</a>
<% end if %>
<% if (mlev = 4) or (lcase(strNoCookies) = "1") then %>
 | <a href="admin_home.asp">管理</a>
<% end if %>
          </td>
<td bgcolor="<% =strForumCellColor %>" valign="middle" align=right><b><% =strForumTitle %></b></td>
            </tr>
        </table>
        </td>
    </tr>
</table>
<% If intSideMenu = 1 then %>
<!--#include file="popout_menu.asp"-->
<% End If %>
<a name="top"></a>

<font face="<% =strDefaultFontFace %>">
<table align="center" border="0" cellPadding="0" cellSpacing="0" width="100%">
  <tr>
    <td valign="top" width="30%"><a href="default.asp"><img alt="<% =strForumTitle %>" border="0" src="<%=strTitleImage%>"></a>
<% '################ Poll Mentor
	if intPollMentor = 1 then
			Dim aTitle
			Dim aQuestion
			Dim aAnswers(8)
			Dim aCount(8)
			'Get active one...
			PollMentor_GetPollInfo -1, aTitle, aQuestion, aAnswers, aCount %>
			<div align="center" class="PollHeader" id="PollHeader" onmouseup="javascript:openpollWindow('pollmentor.asp')">
			<TABLE  BORDER=0 bgcolor="<% =strTableBorderColor %>" cellspacing="1" cellpadding="3" width="100%">
			<tr onmouseup="javascript:openpollWindow('pollmentor.asp')">
			      <TD onmouseup="javascript:openpollWindow('pollmentor.asp')" colspan="2" bgcolor="<% =strCategoryCellColor %>" ALIGN="LEFT"><b><font face="<% =strDefaultFontFace %>" color="<% =strHeadFontColor %>" size="<% =strDefaultFontSize %>"><%= aTitle %><%= aQuestion %>