archiver.asp

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

<!--#include file="../conn.asp"-->
<!--#include file="const.asp"-->
<%
Dim Fso,tid,tmp
tid = HRF(2,2,"tid")
Cache.Name = "Archiver"
Cache.Reloadtime = 14400
If Cache.ObjIsEmpty() Then
	Cache.Value = Now()
End If
If DateDiff("d",CDate(Cache.Value),Now())<>0 Then
	tmp = Header
	tmp = tmp & Main
	tmp = tmp & Footer
	Echo team.BuildFile ("Html/HTML_"&tID&".html", Replace(tmp,"../","../../") )
	Echo tmp
Else
	Set Fso = Server.CreateObject("Scripting.FileSystemObject")
	If (Fso.FileExists(Server.MapPath("Html/HTML_"&tid&".html"))) then
		Response.redirect "Html/Html_"&tid&".html"
	Else
		tmp = Header
		tmp = tmp & Main
		tmp = tmp & Footer
		Echo team.BuildFile ("Html/HTML_"&tID&".html", Replace(tmp,"../","../../") )
		Echo tmp
	End If
End If

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

Function footer()
	Dim MSCode,tmp
	If IsSqlDataBase = 1 Then
		MSCode="SQL"
	Else
		MSCode="ACC"
	End If
	tmp = "<div ID=""cssfooter""><table cellpadding=""5"" cellspacing=""0"" border=""0"" align=""center""  width=""100%""><tr>"
	tmp = tmp &  "	<td class=""tab1"">  查看完整版本: [-- <a href=""../""> " & team.Club_Class(1) &" --] <A href=""#"">[-- top --] </a> </td></tr>"
	tmp = tmp &  "	<tr>"
	tmp = tmp &  "	<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 &" "
	tmp = tmp &  " </td></tr></table><BR /></div></div></div>"
	footer = tmp
End Function


Function Main()
	Dim Rs,fid,iRs,Bbsname,SQL,Page,ReList
	Dim Maxpage,PageNum,IsPage,i,u,tmp
	Page = Request.QueryString("page")
	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(0)
	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 "../Thread.asp?tid="& fid
		End If
	End If
	If Rs(1) <> "" Then
		Response.Redirect "../Thread.asp?tid="& fid
	End if
	RS.Close:Set RS=Nothing
	Set Rs = team.execute("SELECT Topic,ReList,Goodtopic,toptopic,Username,Posttime,Content,Replies From ["&IsForum&"Forum] Where deltopic=0 and id="& tid)
	If Not (Rs.Eof And Rs.Bof) Then
		tmp = "<title> "& Rs(0) &" - Power By team board</title>"
		tmp = tmp &  "<table cellpadding=""5"" cellspacing=""1"" border=""0"" align=""center"" width=""98%"" class=""a2"">" 
		tmp = tmp &  "<tr>" 
		tmp = tmp &  "<td colspan=""2"" class=""a4""> 标题： <a href='?fid="&fid&"&tid="&tid&"'>"& RS(0) &"</a>" 
		If Rs(2)=1 Then tmp = tmp &  "[精]" 
		If Rs(3)=1 Then tmp = tmp &  "[置顶]" 
		If Rs(3)=2 Then tmp = tmp &  "[总置顶]" 
		tmp = tmp & " </td></tr></table><BR>" 
		If Page < 2 Then
			tmp = tmp &  " <table cellpadding=""5"" cellspacing=""1"" border=""0"" align=""center"" width=""98%"" class=""a2"" style=""table-layout: fixed; overflow: hidden"">" 
			tmp = tmp &  "<tr class=""a4""> " 
			tmp = tmp &  "<td width=""50%""><FONT COLOR=""Red"">[楼主]</FONT> / 用户名："&RS(4)&" </td>" 
			tmp = tmp &  " <td>发布时间："&RS(5)&" / 查看 "& Rs(7) &"</td>" 
			tmp = tmp &  " </tr>" 
			tmp = tmp &  "<tr class=""a4""> " 
			tmp = tmp &  "<td colspan=""2"">"& iUbb_Code(Replace(RS(6),"'","")) &"</td>" 
			tmp = tmp &  " </tr>" 
			tmp = tmp &	"</table><BR />" 
		End if
		ReList = Rs(1)
	Else
		Exit Function 
	End If
	RS.Close:Set RS=Nothing
	Set Rs=Server.CreateObject ("adodb.RecordSet")
	IsPage = team.execute("Select Count(*) From ["&IsForum & ReList&"] Where topicid="&tid)(0)
	SQL="SELECT Username,Content,Posttime,Lock From ["&IsForum & ReList&"] Where topicid="&tid&" Order By ID Asc"
	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 = 50		'每页分页数
		PageNum = Abs(int(-Abs(IsPage/Maxpage)))	'页数
		Page = CheckNum(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=1
	Else
		U=Page*Maxpage+1-Maxpage
	End If
	If Isarray(iRs) Then
		For i=0 To Ubound(iRs,2)
			U = U+1
			tmp = tmp &  " <table cellpadding=""5"" cellspacing=""1"" border=""0"" align=""center"" width=""98%"" class=""a2"" style=""table-layout: fixed; overflow: hidden"">" 
			tmp = tmp &  "<tr class=""a4""> " 
			tmp = tmp &  "<td width=""50%""><FONT COLOR=""Red"">[第"&U&"楼]</FONT> / 用户名："&iRs(0,i)&"</td>" 
			tmp = tmp &  " <td>发布时间："&iRs(2,i)&"</td>" 
			tmp = tmp &  " </tr>" 
			tmp = tmp &  "<tr class=""a4""> " 
			tmp = tmp &  "<td colspan=""2"">"&IIF(irs(3,i)=1,"==帖子已经锁定==",iUbb_Code(Replace(iRs(1,i),"'","")))&"</td>" 
			tmp = tmp &  " </tr>" 
			tmp = tmp &	"</table><BR />" 
		Next
	End If
	tmp = tmp &  "<table cellpadding=""0"" cellspacing=""1"" border=""0"" align=""center"" width=""98%""><tr><td>" 
	tmp = tmp &  " <script language=""JavaScript"">" 
	tmp = tmp &  " var pg = new showPages('pg'); " 
	tmp = tmp &  " pg.pageCount ="&PageNum&"; " 
	tmp = tmp &  " pg.printHtml(1); " 
	tmp = tmp &  " </script></td> <td><input onclick=""history.back(-1)"" type=""submit"" value="" << 返 回 上 一 页 "" name=""Submit""></td></tr></table>" 
	Main = tmp
End Function

team.HtmlEnd
%>