📄 elist.asp
字号:
sql="select username,startime,lastimebk,ip,stats,userclass,browser from online where username='"&guests&"'"
set rs=server.createobject("adodb.recordset")
rs.open sql,conn,1,1
if rs.eof and rs.bof then
rs.close
else
arrRow=rs.getrows
rs.close
for i=0 to Ubound(arrRow,2)
if instr(arrRow(4,i),boardtype)>0 then
sip=arrRow(3,i)
response.write "<img src="&picurl&"messages2.gif> "
response.write "<a href=#>"
response.write "<ACRONYM TITLE=""目前位置："&arrRow(4,i)&" 来访时间："&arrRow(1,i)&" 活动时间："&arrRow(2,i)&" "&system(arrRow(6,i))&" "&browser(arrRow(6,i))&" ＩＰ地址："
if IpFlag=0 then
if memberclass=grade(19) or memberclass=grade(20) then
response.write sip
else
response.write "已设置保密"
end if
else
response.write sip
end if
response.write " 来源鉴定："
if FromFlag=0 then
if memberclass=grade19 or memberclass=grade20 then
response.write address(sip)
else
response.write "已设置保密"
end if
else
response.write address(sip)
end if
response.write """>客人</ACRONYM></a> "
end if
next
arrRow=null
end if
end if
end sub
sub AnnounceList1()
'on error resume next
sql="select bbs1.AnnounceID,bbs1.parentID,bbs1.boardID,bbs1.UserName,bbs1.child,bbs1.Topic,bbs1.body,bbs1.DateAndTime,bbs1.hits,bbs1.RootID,bbs1.Expression,bbs1.times,bbs1.locktopic,bbs1.istop,bbs1.isbest,board.lockboard from bbs1,board where bbs1.boardid=board.boardid and bbs1.boardID="&cstr(boardID)&" and bbs1.isbest=1 "&tl&" ORDER BY bbs1.times desc,bbs1.announceid desc"
rs.open sql,conn,1,1
if err.number<>0 then
foundErr = true
ErrMsg = "<li>数据库操作失败：" & err.description & "</li>"
else
if rs.bof and rs.eof then
'论坛无内容
call showEmptyBoard1()
bBoardEmpty = true
else
totalrec=rs.recordcount
if currentpage<1 then
currentpage=1
end if
if (currentpage-1)*MaxAnnouncePerPage>totalrec then
if (totalrec mod MaxAnnouncePerPage)=0 then
currentpage= totalrec \ MaxAnnouncePerPage
else
currentpage= totalrec \ MaxAnnouncePerPage + 1
end if
end if
if currentPage=1 then
call showpagelist1()
else
if (currentPage-1)*MaxAnnouncePerPage<totalrec then
rs.move (currentPage-1)*MaxAnnouncePerPage
call showpagelist1()
else
currentPage=1
call showpagelist1()
end if
end if
end if
end if
if err.number<>0 then err.clear
end sub
REM 显示贴子列表
sub showPageList1()
i=0
%>
<table cellpadding=0 cellspacing=0 border=0 width=95% bgcolor=<%=Tablebackcolor%> align=center>
<tr><td height=1>
</td>
</tr>
</table>
<TABLE bgColor="<%=Tablebackcolor%>" border=0 cellPadding=0 cellSpacing=0 width="95%" align=center>
<TBODY>
<TR>
<td bgcolor=<%=Tablebackcolor%> valign=middle width=1></td>
<TD align=middle height=27 bgColor="<%=Tabletitlecolor%>" width=32><font color=<%=TableFontcolor%>>状态</font></TD>
<td bgcolor=<%=Tablebackcolor%> valign=middle width=1></td>
<TD align=middle bgColor="<%=Tabletitlecolor%>" width=365><font color=<%=TableFontcolor%>>主 题 (点<img src=<%=picurl%>plus.gif>即可展开贴子列表)</font></TD>
<td bgcolor=<%=Tablebackcolor%> valign=middle width=1></td>
<TD align=middle bgColor="<%=Tabletitlecolor%>" width=80><font color=<%=TableFontcolor%>>作 者 </font></TD>
<td bgcolor=<%=Tablebackcolor%> valign=middle width=1></td>
<TD align=middle bgColor="<%=Tabletitlecolor%>" width=64><font color=<%=TableFontcolor%>>回复/人气</font></TD>
<td bgcolor=<%=Tablebackcolor%> valign=middle width=1></td>
<TD align=middle bgColor="<%=Tabletitlecolor%>" width=195><font color=<%=TableFontcolor%>>最后更新 | 回复人</font></TD>
<td bgcolor=<%=Tablebackcolor%> valign=middle width=1></td></TR>
</TBODY></TABLE>
<table cellpadding=0 cellspacing=0 border=0 width=95% bgcolor=<%=Tablebackcolor%> align=center>
<tr><td height=1>
</td>
</tr>
</table>
<%
do while not rs.eof
%>
<TABLE bgColor="<%=Tablebackcolor%>" border=0 cellPadding=0 cellSpacing=0 width="95%" align=center>
<TBODY>
<TR>
<td bgcolor=<%=Tablebackcolor%> valign=middle width=1></td>
<TD align=middle bgColor="<%=aTablebodycolor%>" width=32 height=27><font color="<%=TableContent%>">
<%
if rs("istop")=1 then
response.write "<img src="""&picurl&"/istop.gif"" alt=固顶主题>"
else
if rs("lockboard")=1 then
response.write "<img src="""&picurl&"/lockfolder.gif"" alt=本论坛已锁定>"
else
if rs("child")>=10 then
response.write "<img src="""&picurl&"/hotfolder.gif"" alt=热门主题>"
else
response.write "<img src="""&picurl&"/folder.gif"" alt=开放主题>"
end if
end if
end if
%></font>
</TD>
<td bgcolor="<%=Tablebackcolor%>" valign=middle width=1></td>
<TD bgcolor="<%=Tablebodycolor%>" width="365" onmouseover="javascript:this.bgColor='<%=aTablebodycolor%>';this.style.cursor='default';" onmouseout="javascript:this.bgColor='<%=Tablebodycolor%>';"><font color=<%=TableContent%>>
<!--<a href='dispbbs.asp?boardID=<%=boardID%>&RootID=<%=rs("RootID")%>&ID=<%=rs("announceID")%>&skin=<%=skin%>' target=_blank><img src='images/<%=rs("Expression")%>' border=0 alt="开新窗口浏览此主题"></a>-->
<img src="<%=picurl%>nofollow.gif" id="followImg<%=rs("rootid")%>">
<a href='showannounce.asp?boardID=<%=boardID%>&RootID=<%=rs("RootID")%>&ID=<%=rs("announceID")%>&skin=<%=skin%>' title="《<%=htmlencode(rs("topic"))%>》 作者：<%=htmlencode(rs("username"))%> 发表于<%=rs("dateandtime")%>">
<%
if len(rs("topic"))>26 then
response.write ""&htmlencode(left(rs("topic"),26))&"..."
else
response.write htmlencode(rs("topic"))
end if
response.write "</a>"
%></font>
</TD>
<td bgcolor=<%=Tablebackcolor%> valign=middle width=1></td>
<TD align=middle bgColor="<%=aTablebodycolor%>" width=80><font color=<%=TableContent%>><a href=javascript:openScript('dispuser.asp?name=<%=htmlencode(rs("username"))%>',350,300)><%=htmlencode(rs("username"))%></a></font></TD>
<td bgcolor=<%=Tableback%> valign=middle width=1></td>
<TD align=middle bgColor="<%=Tablebodycolor%>" width=64><font color=<%=TableContent%>><%=rs("child")%>/<%=rs("hits")%></font></TD>
<td bgcolor=<%=Tablebackcolor%> valign=middle width=1></td>
<TD bgColor=<%=aTablebodycolor%> width=195> <font color=<%=TableContent%>>
<IMG border=0 src="<%=picurl%>lastpost.gif">
<%
response.write ""&FormatDateTime(rs("dateandtime"),2)&" "&FormatDateTime(rs("dateandtime"),4)&""
response.write " <font color=#990000>|</font> "
response.write "<a href=javascript:openScript('dispuser.asp?name="&htmlencode(rs("username"))&"',350,300)>"&htmlencode(rs("username"))&"</a>"
%>
</FONT></TD>
<td bgcolor=<%=Tablebackcolor%> valign=middle width=1></td></TR>
</TBODY></TABLE>
<table cellpadding=0 cellspacing=0 border=0 width=95% bgcolor=<%=Tablebackcolor%> align=center>
<tr><td height=1>
</td>
</tr>
</table>
<%
i=i+1
if i>=MaxAnnouncePerPage then exit do
rs.movenext
loop
rs.close
if err.number<>0 then err.clear
end sub
sub listPages3()
'on error resume next
dim n
if totalrec mod MaxAnnouncePerPage=0 then
n= totalrec \ MaxAnnouncePerPage
else
n= totalrec \ MaxAnnouncePerPage+1
end if
%>
<table border="0" cellpadding="0" cellspacing="3" width="95%" align="center">
<form method="post" action="elist.asp" name="frmList2">
<input type=hidden name="selTimeLimit" value="<%=request("selTimeLimit")%>">
<input type=hidden name="skin" value="<%=skin%>">
<tr>
<td valign="middle" nowrap><span class="smallFont">页次：<strong><%=currentPage%></strong>/<strong><%=n%></strong>页 每页<strong><%=MaxAnnouncePerPage%></strong> 主题数<strong><%=totalrec%></strong></td>
<td valign="middle" nowrap>
<div align="right"><p>分页：
<%
for p=1 to n
if p<10 then
if p=currentPage then
response.write "["+Cstr(p)+"] "
else
response.write "<a href='javascript:viewPage2("+Cstr(p)+")' language='javascript'>["+Cstr(p)+"]</a> "
end if
end if
next
%>
<span class="smallFont">转到:<input type="text" name="Page" size=3 maxlength=10 value="<%=currentpage%>"><input type="button" value="Go" language="javascript" onclick="viewPage1(document.frmList2.Page.value)" id="button1" name="button1"></span></p>
</div>
</td>
</tr>
<input type="hidden" name="BoardID" value="<%=BoardID%>">
</form>
</table>
<% if err.number<>0 then err.clear
end sub
sub showEmptyBoard1()
%>
<TABLE bgColor='<%=Tablebackcolor%>' border=0 cellPadding=4 cellSpacing=1 width="95%" align=center>
<TBODY>
<TR bgColor='<%=Tabletitlecolor%>'>
<TD align=middle noWrap height=25><font color=<%=TableFontcolor%>>状态</font></TD>
<TD align=middle noWrap><font color=<%=TableFontcolor%>>主 题 (点心情符为开新窗浏览)</font></TD>
<TD align=middle noWrap><font color=<%=TableFontcolor%>>作 者 </font></TD>
<TD align=middle noWrap><font color=<%=TableFontcolor%>>回复/人气</font></TD>
<TD align=middle noWrap><font color=<%=TableFontcolor%>>最新回复</font></TD></TR>
<tr bgColor="<%=Tablebodycolor%>"><td colSpan=5 vAlign=center width="100%">本精华版面暂无内容，欢迎发贴：）</td></tr>
</TBODY></TABLE>
<%
rs.close
end sub
function online()
guests="客人"
tmprs=conn.execute("Select count(id) from online where username<>'"&guests&"'")
online=tmprs(0)
set tmprs=nothing
if isnull(online) then online=0
end function
function guest()
guests="客人"
tmprs=conn.execute("Select count(id) from online where username='"&guests&"'")
guest=tmprs(0)
set tmprs=nothing
if isnull(guest) then guest=0
end function
Sub getInput()
'On Error Resume Next
Rem ------获取版面ID------
BoardID = Request("BoardID")
Rem ------获取页次------
currentPage=request("page")
End Sub
sub chkInput
'on error resume next
if BoardID="" then
BoardID=1
elseif not isInteger(BoardID) then
BoardID=1
else
BoardID=clng(BoardID)
if err then
BoardID=1
err.clear
end if
end if
if currentpage="" then
currentpage=1
elseif not isInteger(currentpage) then
currentpage=1
else
currentpage=clng(currentpage)
if err then
currentpage=1
err.clear
end if
end if
if request("selTimeLimit")="all" then
tl=""
elseif request("selTimeLimit")="" then
tl=""
else
limitime=request("selTimeLimit")
tl=" and dateandtime>=#"&cstr(cdate(now()-limitime))&"# "
end if
end sub
sub activeuser()
dim rsactiveusers,activeuser
if membername="" then
if session("userid")="" then
'activeuser="select * from online"
activeuser="insert into online(id,username,userclass,ip,startime,lastimebk,lastime,browser,stats) values "&_
"("&Session.SessionID&",'客人','客人','"&_
Request.ServerVariables("REMOTE_HOST")&"',now(),now(),'"&DateToStr(now())&"','"&_
Request.ServerVariables("HTTP_USER_AGENT")&"','"&_
boardtype&"')"
conn.execute(activeuser)
else
activeuser="select * from online where id="&cstr(session("userid"))
set rsactiveusers=server.createobject("adodb.recordset")
rsactiveusers.open activeuser,conn,1,3
if rsactiveusers.eof and rsactiveusers.bof then
activeuser="insert into online(id,username,userclass,ip,startime,lastimebk,lastime,browser,stats) values "&_
"("&Session.SessionID&",'客人','客人','"&_
Request.ServerVariables("REMOTE_HOST")&"',now(),now(),'"&DateToStr(now())&"','"&_
Request.ServerVariables("HTTP_USER_AGENT")&"','"&_
boardtype&"')"
conn.execute(activeuser)
else
activeuser="update online set lastimebk=now(),lastime='"&DateToStr(now())&"',stats='"&boardtype&"' where id="&cstr(session("userid"))
conn.execute(activeuser)
end if
end if
session("userid")=Session.SessionID
set rsactiveusers=nothing
else
activeuser="select username from online where username='"&membername&"'"
set rsactiveusers=server.createobject("adodb.recordset")
rsactiveusers.open activeuser,conn,1,3
if rsactiveusers.eof and rsactiveusers.bof then
activeuser="insert into online(id,username,userclass,ip,startime,lastimebk,lastime,browser,stats) values "&_
"("&Session.SessionID&",'"&membername&"','"&memberclass&"','"&_
Request.ServerVariables("REMOTE_HOST")&"',now(),now(),'"&DateToStr(now())&"','"&_
Request.ServerVariables("HTTP_USER_AGENT")&"','"&_
boardtype&"')"
conn.execute(activeuser)
else
activeuser="update online set lastimebk=now(),lastime='"&DateToStr(now())&"',stats='"&boardtype&"' where username='"&membername&"'"
'response.write activeuser
conn.execute(activeuser)
end if
rsactiveusers.close
activeuser="select username,userpassword from [user] where username='"&membername&"' and userpassword='"&memberword&"'"
rsactiveusers.open activeuser,conn,1,1
if rsactiveusers.eof and rsactiveusers.bof then
rsactiveusers.close
set rsactiveusers=nothing
Errmsg=Errmsg+"<br>"+"<li>一般程序保护错误，您试图进行不合法的操作。<li>您的密码不正确，请<a href=login.asp>重新登陆</a>。"
Founderr=true
call error(errmsg)
response.end
end if
rsactiveusers.close
end if
set rsactiveusers=nothing
'设置用户不活动超时时间--660秒
dim strOnlineTimedOut,strOnlineCheckInTime
strOnlineCheckInTime = DateToStr(Now())
strOnlineTimedOut = strOnlineCheckInTime - 1200
activeuser="delete from online where lastime<'" & strOnlineTimedOut & "'"
Conn.Execute activeuser
end sub
set rs=nothing
Call endConnection
%>
<!--#include file="footer.asp"-->
<IFRAME HEIGHT="0" WIDTH="0" SRC="" NAME="hiddenframe" id="hiddenframe"></IFRAME>
</body>
</html>
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -