gusucode.com > 仿MOP对开式论坛程序 1.0源码程序 > forum.asp
<!--#include file="title.asp"-->
<!--#include file="sub.asp"-->
<%
Function topictypec(topictype)
if topictype=1 then
topictypec=" 精华帖"
elseif topictype=0 then
topictypec=" 求助帖"
else
topictypec=""
end if
end Function
contents=contents &"<title>列表－"& caption &"</title>"&_
"<script language=""JavaScript"">"&_
"if (top==self)"&_
"{"&_
"document.location="".?"& Request.QueryString &""";"&_
"}"&_
"function notype()"&_
"{"&_
"window.location.hash=""notype"";"&_
"}"&_
"var mtd=null;"&_
"function afoc()"&_
"{"&_
"if (window.event.srcElement.tagName=='A'||window.event.srcElement.tagName=='FONT')"&_
"{"&_
"if (mtd!=null)"&_
"{"&_
"mtd.className='';"&_
"}"&_
"mtd=window.event.srcElement;"&_
"mtd.className='anonymity';"&_
"}"&_
"}"&_
"</script>"&_
"</head>"&_
"<base target="""& bbssn &"right"">"&_
"<body onmousedown=""sm();"" ondblclick=""tm();"" onmousemove=""mp();"" onclick=""afoc();"" onload=""notype();"">"&_
""&_
"<table border=""0"" cellpadding=""0"" cellspacing=""0"" width=""100%"" class=""tdc"">"
Dim rsa,i,n,ttopic,atopic,forum,types,sql,ntsql,nfsql,erryes,sn,pn,forumtype,forumname,forumadmin,topictype,page
Sub delot
rs.Open "Update topic Set overtime=Null Where overtime<#"& Now() &"#",conn,1,3
end Sub
forum=Request.QueryString("forum")
if IsNumeric(forum) then
forum=Clng(forum)
else
call connclose
Response.Redirect "forum.asp"
end if
types=Request.QueryString("types")
if IsNumeric(types) then
types=Clng(types)
else
call connclose
Response.Redirect "forum.asp"
end if
topictype=Request.QueryString("topictype")
if topictype="help" then
topictype=0
elseif topictype="elite" then
topictype=1
else
topictype=""
end if
sn=Request.QueryString("sn")
if IsNumeric(sn) then
sn=Clng(sn)
else
sn=0
end if
pn=sn
if sn=0 then
sn=50
elseif sn=1 then
sn=100
elseif sn=2 then
sn=200
elseif sn=3 then
sn=300
elseif sn=4 then
sn=500
else
sn=50
end if
page=Request.QueryString("page")
if IsNumeric(page) then
page=Abs(Clng(page))
else
page=0
end if
if page=0 then page=1
if IsNull(bbsadmin) or bbsadmin="" then
ntsql=" and typeshow=1"
nfsql=" and forumshow=1"
end if
if types>0 then
call delot
rs.Open "forumtype Where id="& types & ntsql,conn,1,1
if rs.Eof then
contents=contents &"<tr class=""toptr""><td class=""tdc"" height=""20"" background="""& theme &"02.gif"">出错</td></tr><tr><td><br>该分类不存在或者是隐藏的。<br><a href=""forum.asp"" target=""_self"">返回分类浏览以选择分类或版面</a>。<br><a href=""JavaScript:history.back();"">返回刚才的页面</a>。<br><br></td></tr>"
erryes="yes"
else
forumadmin=Split(rs("typeadmin"),"{gb|mad}")
contents=contents &"<tr class=""toptr""><td class=""tdc"" height=""20"" colspan=""3"" background="""& theme &"02.gif""> <img border=""0"" src="""& theme &"02.gif"" align=""absbottom""> <a href=""forum.asp"" target=""_self"">"& caption &"</a> -> <a href=""forum.asp?types="& types &""" target=""_self"">"& rs("forumtype") &"</a></td></tr>"
end if
rs.Close
if erryes<>"yes" then
Set rsa=Server.CreateObject("ADODB.Recordset")
rs.Open "forum Where forumtype="& types & nfsql &" Order by forumorder",conn,1,1
if rs.Eof then
contents=contents &"</table><table border=""0"" cellpadding=""0"" cellspacing=""0"" width=""100%"" class=""tdc"">"&_
"<tr class=""toptr""><td class=""tdc"" height=""20"" background="""& theme &"02.gif"">出错</td></tr><tr><td><br>该分类还没有版面或公开的版面。<br><a href=""forum.asp"" target=""_self"">返回分类浏览以选择分类或版面</a>。<br><a href=""JavaScript:history.back();"">返回刚才的页面</a>。<br><br></td></tr>"
erryes="yes"
else
sql=" title,gbmaduser,posttime,anonymity,click,link,reply,lastupdate,lastuser,overtime,topictype From topic Where deler is Null and ("
For i=1 to rs.RecordCount
rsa.Open "Select count(posttime) From topic Where deler is Null and posttime>#"& Date() &"# and forumid="& rs("id"),conn,1,1
ttopic=rsa(0)
rsa.Close
rsa.Open "Select count(posttime) From topic Where deler is Null and forumid="& rs("id"),conn,1,1
atopic=rsa(0)
rsa.Close
n=n+1
if n=4 then n=1
if n=1 then
contents=contents &"<tr><td width=""33%"" class=""ftd"">┇<a href=""forum.asp?forum="& rs("id") &""" target=""_self"">"& rs("forumname") &"</a>┇<br><font class=""del"">今日:</font>"& ttopic &" <font class=""del"">所有:</font>"& atopic &"</td>"
elseif n=2 then
contents=contents &"<td width=""34%"" class=""ftd"">┇<a href=""forum.asp?forum="& rs("id") &""" target=""_self"">"& rs("forumname") &"</a>┇<br><font class=""del"">今日:</font>"& ttopic &" <font class=""del"">所有:</font>"& atopic &"</td>"
elseif n=3 then
contents=contents &"<td width=""33%"" class=""ftd"">┇<a href=""forum.asp?forum="& rs("id") &""" target=""_self"">"& rs("forumname") &"</a>┇<br><font class=""del"">今日:</font>"& ttopic &" <font class=""del"">所有:</font>"& atopic &"</td></tr>"
end if
if i=rs.RecordCount then
sql=sql &"forumid="& rs("id") &")"
else
sql=sql &"forumid="& rs("id") &" or "
end if
rs.MoveNext
Next
if topictype<>"" then sql=sql &" and topictype="& topictype
if n=1 then
contents=contents &"<td width=""34%"" class=""ftd""></td><td width=""33%"" class=""ftd""></td></tr>"
elseif n=2 then
contents=contents &"<td width=""33%"" class=""ftd""></td></tr>"
end if
contents=contents &"<tr><td colspan=""2"" class=""ftd""> <a name=""notype""></a> 版主："
For i=1 to Ubound(forumadmin)-1
if i=1 then
contents=contents &"<a href=""sendmessage.asp?username="& forumadmin(i) &""" onClick=""return shows(this.href);"" title=""发送密信给 "& forumadmin(i) &""">"& forumadmin(i) &"</a>"
else
contents=contents &" <a href=""sendmessage.asp?username="& forumadmin(i) &""" onClick=""return shows(this.href);"" title=""发送密信给 "& forumadmin(i) &""">"& forumadmin(i) &"</a>"
end if
Next
contents=contents &"</td><td class=""ftd""> <a href=""topic.asp?types="& types &""" class=""anonymity"">发帖子</a></td></tr>"&_
"<tr><td colspan=""3"" class=""ftd""> 精华帖 <a href=""forum.asp?topictype=elite&types="& types &""" target=""_self"">精华帖</a> <a href=""forum.asp?topictype=help&types="& types &""" target=""_self"">求助帖</a> 最新[<a href=""forum.asp?sn=1&types="& types &""" target=""_self"">100</a> <a href=""forum.asp?sn=2&types="& types &""" target=""_self"">200</a> <a href=""forum.asp?sn=3&types="& types &""" target=""_self"">300</a> <a href=""forum.asp?sn=4&types="& types &""" target=""_self"">500</a>]个帖 <a href=""#"" target=""_self"" onClick=""javascript:parent."& bbssn &"leftsearch.rows='55%,45%';"">搜索/工具栏</a></td></tr>"&_
"</table><table border=""0"" cellpadding=""0"" cellspacing=""0"" width=""100%"" class=""tdc"">"
end if
rs.Close
Set rsa=Nothing
end if
if erryes<>"yes" then
rs.Open "Select Top 1"& sql,conn,1,1
if rs.Eof then
if topictype="0" then
topictype="求助帖"
elseif topictype="1" then
topictype="精华帖"
end if
contents=contents &"<tr class=""toptr""><td class=""tdc"" height=""20"" background="""& theme &"02.gif"">出错</td></tr><tr><td><br>该分类暂时还没有任何的"& topictype &"帖子。<br>你可以发一个<a href=""topic.asp?forum="& forum &""">新的帖子</a>。<br><a href=""forum.asp"" target=""_self"">返回分类浏览以选择分类或版面</a>。<br><a href=""JavaScript:history.back();"">返回刚才的页面</a>。<br><br></td></tr>"
erryes="yes"
end if
rs.Close
end if
if erryes<>"yes" then
contents=contents &"<tr class=""toptr""><td class=""tdc"" colspan=""2"" height=""20"" background="""& theme &"02.gif"">"
rs.Open "Select"& sql &" and overtime is Not Null Order by lastupdate Desc",conn,1,1
For i=1 to rs.RecordCount
if rs("anonymity")<>"" then
contents=contents &"<tr height=""20"" onmouseover=""this.className='otr';"" onmouseout=""this.className='';""><td class=""tdc""> 置顶 <a href=""topic/"& rs("link") &""" title=""帖子作者：神秘人物"& rs("anonymity") & vbcrlf &"发贴时间："& rs("posttime") & vbcrlf &"最后回复："& rs("lastuser") & vbcrlf &"更新时间："& rs("lastupdate") &""">"& rs("title") &"</a>"& topictypec(rs("topictype")) &"</td><td class=""tdc"" align=""center"">"& rs("reply") &"/"& rs("click") &"</td></tr>"
else
contents=contents &"<tr height=""20"" onmouseover=""this.className='otr';"" onmouseout=""this.className='';""><td class=""tdc""> 置顶 <a href=""topic/"& rs("link") &""" title=""帖子作者："& rs("gbmaduser") & vbcrlf &"发贴时间："& rs("posttime") & vbcrlf &"最后回复："& rs("lastuser") & vbcrlf &"更新时间："& rs("lastupdate") &""">"& rs("title") &"</a>"& topictypec(rs("topictype")) &"</td><td class=""tdc"" align=""center"">"& rs("reply") &"/"& rs("click") &"</td></tr>"
end if
rs.MoveNext
Next
rs.Close
rs.Open "Select"& sql &" and overtime is Null Order by lastupdate Desc",conn,1,1
if Not rs.Eof then
rs.PageSize=sn
if page>rs.PageCount then page=rs.PageCount
rs.AbsolutePage=page
m=1
For i=1 to rs.PageSize
if i mod 10=0 then m=m+1
if rs("anonymity")<>"" then
contents=contents &"<tr height=""20"" onmouseover=""this.className='otr';"" onmouseout=""this.className='';""><td class=""tdc""><a href=""topic/"& rs("link") &""" title=""帖子作者：神秘人物"& rs("anonymity") & vbcrlf &"发贴时间："& rs("posttime") & vbcrlf &"最后回复："& rs("lastuser") & vbcrlf &"更新时间："& rs("lastupdate") &""">"& rs("title") &"</a>"& topictypec(rs("topictype")) &"</td><td class=""tdc"" align=""center"">"& rs("reply") &"/"& rs("click") &"</td></tr>"
else
contents=contents &"<tr height=""20"" onmouseover=""this.className='otr';"" onmouseout=""this.className='';""><td class=""tdc""><a href=""topic/"& rs("link") &""" title=""帖子作者："& rs("gbmaduser") & vbcrlf &"发贴时间："& rs("posttime") & vbcrlf &"最后回复："& rs("lastuser") & vbcrlf &"更新时间："& rs("lastupdate") &""">"& rs("title") &"</a>"& topictypec(rs("topictype")) &"</td><td class=""tdc"" align=""center"">"& rs("reply") &"/"& rs("click") &"</td></tr>"
end if
rs.MoveNext
if rs.Eof then Exit For
Next
contents=contents & unitetopic()
contents=contents &"</table><table border=""0"" cellpadding=""0"" cellspacing=""0"" width=""100%"" class=""tdc""><tr height=""20""><td class=""tdc""> 第 "& page &"/"& rs.PageCount &" 页 每页 "& sn &" 条 "
if rs.PageCount+1>page and page>1 then contents=contents &"<a href=""forum.asp?sn="& pn &"&types="& types &"&page="& page-1 &""" target=""_self"">上一页</a> "
if rs.PageCount>page then contents=contents &"<a href=""forum.asp?sn="& pn &"&types="& types &"&page="& page+1 &""" target=""_self"">下一页</a>"
contents=contents &" 页码：<input name=""page"" type=""text"" size=""3"" maxlength=""5"" class=""iptwin"" value="""& page &"""> <input type=""submit"" value=""转到"" class=""out"" onmouseover=""this.className='over'"" onmouseout=""this.className='out'"" onClick=""location.href='forum.asp?sn="& pn &"&types="& types &"&page='+document.all.page.value""></td></tr>"
end if
rs.Close
end if
elseif forum>0 then
call delot
rs.Open "forum Where id="& forum & nfsql,conn,1,1
if rs.Eof then
contents=contents &"<tr class=""toptr""><td class=""tdc"" height=""20"" background="""& theme &"02.gif"">出错</td></tr><tr><td><br>该版面不存在或者是隐藏的。<br><a href=""forum.asp"" target=""_self"">返回分类浏览以选择分类或版面</a>。<br><a href=""JavaScript:history.back();"">返回刚才的页面</a>。<br><br></td></tr>"
erryes="yes"
else
forumtype=rs("forumtype")
forumname=rs("forumname")
forumadmin=Split(rs("forumadmin"),"{gb|mad}")
end if
rs.Close
if erryes<>"yes" then
rs.Open "forumtype Where id="& forumtype & ntsql,conn,1,1
if rs.Eof then
contents=contents &"<tr class=""toptr""><td class=""tdc"" height=""20"" background="""& theme &"02.gif"">出错</td></tr><tr><td><br>该版面不属于任何的分类或者分类是隐藏的，请<a href=""reporting.asp"">联系管理员报告错误</a>。<br><a href=""forum.asp"" target=""_self"">返回分类浏览以选择分类或版面</a>。<br><a href=""JavaScript:history.back();"">返回刚才的页面</a>。<br><br></td></tr>"
erryes="yes"
else
contents=contents &"</tr>"&_
"<tr><td width=""33%"" class=""ftd""> <a href=""forum.asp?sn=1&forum="& forum &""" target=""_self"">刷新</a> <a href=""topic.asp?forum="& forum &""" class=""anonymity"">发表新帖</a></td></tr>"&_
"<tr></tr>"&_
"</table><table border=""0"" cellpadding=""0"" cellspacing=""0"" width=""100%"" class=""tdc"">"
end if
rs.Close
end if
if erryes<>"yes" then
sql=" title,gbmaduser,posttime,anonymity,click,link,reply,lastupdate,lastuser,overtime,topictype From topic Where forumid="& forum &" and deler is Null"
if topictype<>"" then sql=sql &" and topictype="& topictype
rs.Open "Select Top 1"& sql,conn,1,1
if rs.Eof then
if topictype="0" then
topictype="求助帖"
elseif topictype="1" then
topictype="精华帖"
end if
contents=contents &"<tr class=""toptr""><td class=""tdc"" height=""20"" background="""& theme &"02.gif"">出错</td></tr><tr><td><br>该版面暂时还没有任何的"& topictype &"帖子。<br>你可以发一个<a href=""topic.asp?forum="& forum &""">新的帖子</a>。<br><a href=""forum.asp"" target=""_self"">返回分类浏览以选择分类或版面</a>。<br><a href=""JavaScript:history.back();"">返回刚才的页面</a>。<br><br></td></tr>"
erryes="yes"
end if
rs.Close
end if
if erryes<>"yes" then
contents=contents &"<tr class=""toptr""><td class=""tdc"" colspan=""2"" height=""20"" background="""& theme &"02.gif"">"
rs.Open "Select"& sql &" and overtime is Not Null Order by lastupdate Desc",conn,1,1
For i=1 to rs.RecordCount
if rs("anonymity")<>"" then
contents=contents &"<tr height=""20"" onmouseover=""this.className='otr';"" onmouseout=""this.className='';""><td class=""tdc""> 置顶 <a href=""topic/"& rs("link") &""" title=""帖子作者：神秘人物"& rs("anonymity") & vbcrlf &"发贴时间："& rs("posttime") & vbcrlf &"最后回复："& rs("lastuser") & vbcrlf &"更新时间："& rs("lastupdate") &""">"& rs("title") &"</a>"& topictypec(rs("topictype")) &"</td><td class=""tdc"" align=""center"">"& rs("reply") &"/"& rs("click") &"</td></tr>"
else
contents=contents &"<tr height=""20"" onmouseover=""this.className='otr';"" onmouseout=""this.className='';""><td class=""tdc""> 置顶 <a href=""topic/"& rs("link") &""" title=""帖子作者："& rs("gbmaduser") & vbcrlf &"发贴时间："& rs("posttime") & vbcrlf &"最后回复："& rs("lastuser") & vbcrlf &"更新时间："& rs("lastupdate") &""">"& rs("title") &"</a>"& topictypec(rs("topictype")) &"</td><td class=""tdc"" align=""center"">"& rs("reply") &"/"& rs("click") &"</td></tr>"
end if
rs.MoveNext
Next
rs.Close
rs.Open "Select"& sql &" and overtime is Null Order by lastupdate Desc",conn,1,1
if Not rs.Eof then
rs.PageSize=sn
if page>rs.PageCount then page=rs.PageCount
rs.AbsolutePage=page
m=1
For i=1 to rs.PageSize
if i mod 10=0 then m=m+1
if rs("anonymity")<>"" then
contents=contents &"<tr height=""20"" onmouseover=""this.className='otr';"" onmouseout=""this.className='';""><td class=""tdc""><a href=""topic/"& rs("link") &""" title=""帖子作者：神秘人物"& rs("anonymity") & vbcrlf &"发贴时间："& rs("posttime") & vbcrlf &"最后回复："& rs("lastuser") & vbcrlf &"更新时间："& rs("lastupdate") &""">"& rs("title") &"</a>"& topictypec(rs("topictype")) &"</td><td class=""tdc"" align=""center"">"& rs("reply") &"/"& rs("click") &"</td></tr>"
else
contents=contents &"<tr height=""20"" onmouseover=""this.className='otr';"" onmouseout=""this.className='';""><td class=""tdc""><a href=""topic/"& rs("link") &""" title=""帖子作者："& rs("gbmaduser") & vbcrlf &"发贴时间："& rs("posttime") & vbcrlf &"最后回复："& rs("lastuser") & vbcrlf &"更新时间："& rs("lastupdate") &""">"& rs("title") &"</a>"& topictypec(rs("topictype")) &"</td><td class=""tdc"" align=""center"">"& rs("reply") &"/"& rs("click") &"</td></tr>"
end if
rs.MoveNext
if rs.Eof then Exit For
Next
contents=contents & unitetopic()
contents=contents &"</table><table border=""0"" cellpadding=""0"" cellspacing=""0"" width=""100%"" class=""tdc""><tr height=""20""><td class=""tdc""> 第 "& page &"/"& rs.PageCount &" 页 每页 "& sn &" 条 "
if rs.PageCount+1>page and page>1 then contents=contents &"<a href=""forum.asp?sn="& pn &"&forum="& forum &"&page="& page-1 &""" target=""_self"">上一页</a> "
if rs.PageCount>page then contents=contents &"<a href=""forum.asp?sn="& pn &"&forum="& forum &"&page="& page+1 &""" target=""_self"">下一页</a>"
contents=contents &" 页码：<input name=""page"" type=""text"" size=""3"" maxlength=""5"" class=""iptwin"" value="""& page &"""> <input type=""submit"" value=""转到"" class=""out"" onmouseover=""this.className='over'"" onmouseout=""this.className='out'"" onClick=""location.href='forum.asp?sn="& pn &"&forum="& forum &"&page='+document.all.page.value""></td></tr>"
end if
rs.Close
end if
else
%>
<!--#include file="forums.asp"-->
<%
end if
contents=contents &"</table>"&_
""
%>
<!--#include file="bottom.asp"-->