fnews.asp

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

<!-- #include file="conn.asp" -->
<!-- #include file="INC/Const.asp" -->
<%
Dim tID,fID,x1,x2,MyNews,WebUrl
fID = HRF(2,2,"fid")
WebUrl = team.Club_Class(2)
Set MyNews = New ClNews

Class ClNews
	Private Sub Class_Initialize()
		If CID(team.Forum_setting(85)) = 0 Then
			Call NotCallNews
		End If
		If Not CheckServer() then
			OutNews "数据被保护,禁止被其他站点调用!"
			Response.End	
		End If
		team.LoadTemps
		Select Case Request("action")
			'========调用类型======
			Case "recallaffiche"
				Call recallaffiche
			Case "recallmembers"
				Call recallmembers
			Case "recallinfos"
				Call recallinfos
			Case "recallboardfids"
				Call recallboardfids
			Case "recallshowlinks"
				Call recallshowlinks
			'========结束==========
			Case "Next1"
				Call Next1
			Case "Next2"
				Call Next2
			Case Else
				Call Main()
		End Select
	End Sub

	Sub recallshowlinks
		Dim tmp,myclass
		myclass = HRF(2,2,"myclass")
		tmp = Stringhtml(Team.HtmlNews (2))
		tmp = Replace(tmp,"{$myclass}",BBs_Value_List(0,0,myclass))
		OutNews Fixjs(tmp)
	End Sub

	Function BBs_Value_List(a,b,c)
		Dim tmp,i,Boards
		Dim U,Y
		Boards = team.myBoardJump()
		If isArray(Boards) Then
			For i=0 To Ubound(Boards,2)
				If Boards(2,i) = a Then
					U = 1+b
					For Y=0 To U
						tmp = tmp & "&nbsp; &nbsp;"
					Next
					If a = 0 Then tmp = tmp & "<br />"
					If C = 0 Then
						If a = 0 Then
							tmp = tmp & "╋"
						Else
							tmp = tmp & "├"
						End If
					End If 
					tmp = tmp & "<a href="""& WebUrl &"/Forums.asp?fid="& Boards(0,i)&""" target=""_blank"">"& Boards(1,i)&"</a>"& Vbcrlf
					If C = 0 Then
						tmp = tmp & "<br />" & Vbcrlf
					Else
						tmp = tmp & " &nbsp;" & Vbcrlf
						If a = 0 Then tmp = tmp & "<br />"
					End if	
					tmp = tmp & BBs_Value_List(Boards(0,i),U,C) 
				End if
			Next
		End if
		BBs_Value_List = tmp
	End function

	Sub recallboardfids
		Dim tmp,psize,formattime,showboards,showorders,icon,showtypes,total,showname
		Dim Rs,t,i,SQL,Orders,ts,u,m,p
		icon = HRF(2,2,"icon")
		psize = HRF(2,2,"psize")
		total = HRF(2,2,"total")
		showname = HRF(2,2,"showname")
		showtypes = HRF(2,2,"showtypes")
		formattime = HRF(2,2,"formattime")
		showboards = HRF(2,2,"showboards")
		showorders = HRF(2,2,"showorders")
		SQL = "" : Orders=""
		t = team.BoardList
		If showboards > 0 Then
			SQL = " and forumid = " & Int(showboards)
		End If
		If showtypes = 0 Then
			SQL = " and goodtopic = 1 "
		End If
		Select Case showorders
			Case "1"
				Orders = " PostTime "
			Case "2"
				Orders = " Lasttime "
			Case "3"
				Orders = " Views "
			Case "4"
				Orders = " Replies "
			Case Else
				Orders = " ID "
		End Select
		Set Rs = team.execute("Select ID,Topic,UserName,Views,Replies,Posttime,ICON,Forumid From ["&Isforum&"Forum] Where deltopic=0 "& SQL &" Order By "& Orders &" Desc ")
		If Not Rs.Eof Then
			ts = Rs.GetRows(total)
		End If
		Rs.Close:Set Rs=Nothing
		If IsArray(ts) Then
			m = "" : P=""
			For u = 0 To UBound(ts,2)
				If INT(icon) = 1 Then
					If Int(ts(6,u))>0 Then
						m = "<img src="""&WebUrl&"/images/brow/icon"&ts(6,u)&".gif"" align=""absmiddle"" border=""0""> "
					End if
				End If 
				If INT(showname) = 1 Then
					If IsArray(t) Then
						For I = 0 To UBound(t,2)
							If Int(t(0,i)) = Int(ts(7,u)) Then
								p = " <a href="""&WebUrl&"/Forums.asp?fid="&t(0,i)&""" target=""_blank"">["& t(1,i) &"]</a> " 
							End if
						Next
					End If
				End If
				tmp = tmp & Stringhtml(Team.HtmlNews (1))
				tmp = Replace(tmp,"{$class}",m)
				tmp = Replace(tmp,"{$show}",p)
				tmp = Replace(tmp,"{$weburl}",WebUrl)
				tmp = Replace(tmp,"{$tid}",ts(0,u))
				tmp = Replace(tmp,"{$title}",Cutstr(ts(1,u),psize))
				tmp = Replace(tmp,"{$infos}","发表用户："& ts(2,u) &"&#xA;查看数："& ts(3,u) &"&#xA;回复数："& ts(4,u) &"")
				tmp = Replace(tmp,"{$times}",FormatDateTime(ts(5,u),formattime))
			Next
		End If
		OutNews Fixjs(tmp)
	End Sub


	Sub recallinfos
		Dim tmp,psize,formattime,Onlinemany
		psize = HRF(2,2,"psize")
		formattime = HRF(2,2,"formattime")
		tmp = Stringhtml(Team.HtmlNews (0))
		Onlinemany = team.execute("Select Count(*) From ["&IsForum&"Online]")(0)
		tmp = Replace(tmp,"{$weburl}",WebUrl)
		tmp = Replace(tmp,"{$TopicNum}",Application(CacheName&"_PostNum"))
		tmp = Replace(tmp,"{$PostNum}",Application(CacheName&"_ConverPostNum"))
		tmp = Replace(tmp,"{$Regmember}",Application(CacheName&"_UserNum"))
		tmp = Replace(tmp,"{$AllOnline}",Onlinemany)
		tmp = Replace(tmp,"{$LastReg}",team.Club_Class(12))
		tmp = Replace(tmp,"{$TodayPostNum}",Application(CacheName&"_TodayNum"))
		tmp = Replace(tmp,"{$OLdPost}",Application(CacheName&"_OldTodayNum"))
		tmp = Replace(tmp,"{$TopOnline}",Split(Team.Club_Class(20),"|")(0))
		tmp = Replace(tmp,"{$StarDay}",FormatDateTime(team.Club_Class(29),formattime))
		OutNews Fixjs(tmp)
	End Sub

	Sub recallmembers
		Dim tmp,total,psize,userorder,t,i
		Dim ExtCredits,u,m,Byorders,Rs,S
		ExtCredits = Split(team.Club_Class(21),"|")
		total = HRF(2,2,"total")
		psize = HRF(2,2,"psize")
		userorder = CID(Request("orderys"))
		Select Case userorder
			Case "0"
				Byorders = "Regtime Desc"
			Case "1"
				Byorders = "Posttopic Desc"
			Case "2"
				Byorders = "Posttopic+Postrevert Desc"
			Case "3"
				Byorders = "Goodtopic Desc"
			Case "4"
				Byorders = "Extcredits0 Desc"
			Case "5"
				Byorders = "Extcredits1 Desc"
			Case "6"
				Byorders = "Extcredits2 Desc"
			Case "7"
				Byorders = "Extcredits3 Desc"
			Case "8"
				Byorders = "Extcredits4 Desc"
			Case "9"
				Byorders = "Extcredits5 Desc"
			Case "10"
				Byorders = "Extcredits6 Desc"
			Case "11"
				Byorders = "Extcredits7 Desc"
			Case Else
				Byorders = "Regtime Desc"
		End Select
    	Cache.Reloadtime = CID(team.Forum_setting(86))
		Cache.Name="recallmembers_" & userorder
		If Cache.ObjIsEmpty() Then
			Set Rs = team.execute("Select UserName,Posttopic,Postrevert,goodtopic,Extcredits0,Extcredits1,Extcredits2,Extcredits3,Extcredits4,Extcredits5,Extcredits6,Extcredits7 From ["&IsForum&"User] Where not (UserGroupID=5) Order By "& Byorders&" ")
			If Not Rs.Eof Then
				t = Rs.GetRows(total)
				Cache.Value = t
			End If
			Rs.Close:Set Rs=Nothing 
		End If
		t = Cache.Value
		If IsArray(t) Then
			For i = 0 To UBound(t,2)
				If i =>total Then Exit For
				tmp = tmp & Stringhtml(Team.HtmlNews (3))
				tmp = Replace(tmp,"{$weburl}",WebUrl)
				tmp = Replace(tmp,"{$Csslist}",team.Styleurl)
				tmp = Replace(tmp,"{$username}",t(0,i))
				tmp = Replace(tmp,"{$title}",Cutstr(HtmlEncode(t(0,i)),psize))
				tmp = Replace(tmp,"{$postnum}",t(1,i))
				tmp = Replace(tmp,"{$repostnum}",t(2,i))
				tmp = Replace(tmp,"{$godnum}",t(3,i))
				s = ""
				for m = 0 to ubound(ExtCredits)
					If Split(ExtCredits(m),",")(4) =1 Then
						s = s & ""& Split(ExtCredits(m),",")(0) & "&nbsp;"& t(4+m,i) &"&nbsp;"& Split(ExtCredits(m),",")(1) &"&#xA;"
					End if
				Next