index.asp

一个asp写的论坛源代码,论坛所需要的功能都有

<!--#include file="../conn.asp"-->
<!--#include file="const.asp"-->
<%
Header()
Select Case Request("action")
	Case "show"
		show
	Case Else
		Main()
End Select
Footer()

Sub Header() 
	Echo "<link href=""../Skins/teams/bbs.css"" rel=""stylesheet"" type=""text/css"">"
	Echo "<script language=""javascript"" src=""../Js/common.js""></script>"
	Echo "<title>"& team.Club_Class(1) &" - 简约版本</title><center><div id=""divline"" Style=""width:99%""><div id=""csscontent""><table cellpadding=""5"" cellspacing=""1"" border=""0"" align=""center"" class=""a2"" width=""98%"">"
	Echo "	<tr class=""a1"">"
	Echo "	<td>"& team.Club_Class(1) &" - <a href=index.asp Style=""color:ffffff"">[简约版本]</a></td></tr>"
	Echo "</table><BR />"
End Sub

Sub Main()
	Echo "<table cellpadding=""5"" cellspacing=""1"" border=""0"" align=""center"" class=""a2"" width=""98%"">"
	Echo "	<tr>"
	Echo "	<td class=""tab1"">"& team.Club_Class(1) &" 版块设置</td></tr>"
	Echo "	<tr>"
	Echo "	<td class=""a4""> "
	Call ForumList()
	Echo " </td></tr></table><BR />"
End Sub

Sub show()
	Dim Rs,fid,iRs,Bbsname,SQL,Page,u
	Dim Maxpage,PageNum,IsPage,i
	fid = HRF(2,2,"fid")
	Set Rs = team.Execute("Select ID,Pass,Bbsname,toltopic,lookperm From ["&IsForum&"bbsconfig] where hide=0 and id="& fid)
	If ( Rs.Eof and RS.Bof) Then
		Error "此板块不存在或您没有查看此板块的权限"
	Else
		Bbsname = RS(2)
	End If
	If Rs(0) = 0 Then 
		Response.Redirect "../Default.asp?rootid="&fid
	End if
	If Not (RS(4) = ",") Then
		If Instr(RS(4),",") > 0 Then Response.Redirect "../Forums.asp?fid="& fid
	End If
	If Rs(1) <> "" Then
		Response.Redirect "../Forums.asp?fid="& fid
	End if
	RS.Close:Set RS=Nothing
	Echo " <table cellpadding=""5"" cellspacing=""1"" border=""0"" align=""center"" width=""98%"" class=""a2"">"
	Echo "<tr>"
	Echo "<td colspan=""2"" class=""tab1""> "& team.Club_Class(1) &" -  <a href='?action=show&fid="&fid&"'>"& BbsName &"</a> - 帖子列表</td></tr>"
	IsPage = team.execute("Select Count(*) from ["&IsForum&"Forum] Where deltopic=0 and (Toptopic=2 or Forumid="&fid&" ) ")(0)
	Set Rs=Server.CreateObject ("adodb.RecordSet")
	SQL="SELECT ID,Topic,replies,goodtopic,toptopic From ["&IsForum&"Forum] Where deltopic=0 and (Toptopic=2 or Forumid="&fid&") Order By Toptopic DESC,Lasttime DESC" 
	Set Rs = Server.CreateObject ("Adodb.RecordSet")
	If Not IsObject(Conn) Then ConnectionDatabase
	Rs.Open Sql,Conn,1,1,&H0001
	If Not (Rs.Eof and Rs.Bof) Then 
		SqlQueryNum=SqlQueryNum+1
		Maxpage = 20		'每页分页数
		PageNum = Abs(int(-Abs(IsPage/Maxpage)))	'页数
		Page = CheckNum(Request.QueryString("page"),1,1,1,PageNum)	'当前页
		Rs.AbsolutePosition=(Page-1)*Maxpage+1
		iRs=Rs.GetRows(Maxpage)
	End if
	RS.Close:Set Rs=Nothing
	If Page<2 Then 
		U=0
	Else
		U=page*Maxpage-Maxpage
	End If
	If Not Isarray(iRs) Then
		Echo "<tr class=""tab4""><td Colspan=""2""> 暂无帖子记录 </td></tr>"
	Else
		For i=0 To Ubound(iRs,2)
			U= U+1
			Echo "<tr class=""a4""> "
			Echo "<td width=""5""> " & U &". </td>"
			Echo " <td> "
			If iRs(3,i)=1 Then Echo "[精]" 
			If iRs(4,i)=1 Then Echo "[置顶]" 
			If iRs(4,i)=2 Then Echo "[总置顶]" 
			Echo" <a href=Archiver.asp?fid="&fid&"&tid=" & iRs(0,i) &">" & HTMLEncode(iRs(1,i)) &" </a>  - <Span Style='Color:red'>回复(" & iRs(2,i) &" )</Span> </td>"
			Echo " </tr>"
		Next
	End If
	Echo "</table><BR /><table cellpadding=""0"" cellspacing=""1"" border=""0"" align=""center"" width=""98%""><tr><td>"
	Echo " <script language=""JavaScript"">"
	Echo " var pg = new showPages('pg'); "
	Echo " pg.pageCount ="&PageNum&"; "
	Echo " pg.printHtml(1); "
	Echo " </script></td> <td><input onclick=""history.back(-1)"" type=""submit"" value="" << 返 回 上 一 页 "" name=""Submit""></td></tr></table>"
	Echo " "
End Sub

Sub Footer()
	Dim MSCode
	If IsSqlDataBase = 1 Then
		MSCode="SQL"
	Else
		MSCode="ACC"
	End If
	Echo "<div ID=""cssfooter""><table cellpadding=""5"" cellspacing=""0"" border=""0"" align=""center""  width=""100%""><tr>"
	Echo "	<td class=""tab1"">  查看完整版本: [-- <a href=""../""> " & team.Club_Class(1) &" --] <A href=""#"">[-- top --] </a> </td></tr>"
	Echo "	<tr>"
	Echo "	<td class=""tab4"" style=""color:#999999""> Powered by <a target=""_blank"" 	href=""http://www.team5.cn"">" & team.Forum_setting(8) &" - <a href=""Licence.asp""><b style='color:#FF9900'> "& MSCode &"</b></a>  <BR /> Time "& Fix((Timer-Startime)*1000) &" second(s),query: "& SqlQueryNum &" "
	Echo " </td></tr></table><BR /></div></div></div>"
	team.HtmlEnd
End Sub

Sub ForumList()
	Dim ShowBbs,i,tmp
	Showbbs = team.BoardList()
	If Isarray(Showbbs) Then
		For i = 0 To UBound(Showbbs,2)
			If Showbbs(3,i) = 0 Then
				Echo "<ul><li>"& Showbbs(1,i) &" "
				Call miniForumList(Showbbs(0,i))
				Echo " </li></ul>"
			End If
		Next
	End if
End Sub

Sub miniForumList(a)
	Dim ShowBbs,i,tmp
	Showbbs = team.BoardList()
	If Isarray(Showbbs) Then
		For i = 0 To UBound(Showbbs,2)
			If Int(Showbbs(3,i)) = Int(a) Then
				Echo "<ul><li> <a href=""?action=show&fid="&Showbbs(0,i)&""">"& Showbbs(1,i) &"</a>" 
				If Showbbs(5,i) > 0 Then  Echo "<img src=""../skins/teams/new.gif"" border=""0"" align=""absmiddle""> "
				Echo "　　　<span style=""color:#666666"">( "&Showbbs(6,i)&" / "&Showbbs(7,i)&" )</span>"
 				If Showbbs(10,i)<>"" Then
					Echo "<FONT COLOR=""red"">[密码验证]</FONT>"
				End If
				Call miniForumList(Showbbs(0,i))
				Echo " </li></ul> "
			End If
		Next
	End if
End Sub
%>