?? index.asp
字號:
If Not IsObject(Application(Dvbbs.CacheName & "_Pagecache_index_" & Dvbbs.BoardID)) Then
LoadBoardlistData()
Else
If DateDiff("s",Application(Dvbbs.CacheName & "_Pagecache_index_" & Dvbbs.BoardID).documentElement.selectSingleNode("@lastupdate").text,Now()) > CacheTime Then
LoadBoardlistData()
Else
Set XmlDom=Application(Dvbbs.CacheName & "_Pagecache_index_" & Dvbbs.BoardID).cloneNode(True)
End If
End If
Else
LoadBoardlistData()
End If
If Dvbbs.GroupSetting(37)="0" Then
For each node in XMLDOM.documentElement.selectNodes("board[@hidden=1]")
XMLDom.documentElement.removeChild(node)
Next
End If
If Dvbbs.BoardID=0 Then
Xpath1="board[@depth=0]"
Else
Xpath1="board[@boardid="& Dvbbs.Boardid&"]"
End If
Set Node=XMLDom.documentElement.selectSingleNode("forum_setting")
If Dvbbs.IsSearch Then
Node.setAttribute "issearch",1
Else
Node.setAttribute "issearch",0
End If
For Each Node In XMLDom.documentElement.selectNodes(Xpath1)
BoardId=Node.selectSingleNode("@boardid").text
ShowMod=Request.Cookies("List")("list"&BoardId)
If ShowMod<>"" And IsNumeric(ShowMod) Then
Node.selectSingleNode("@mode").text=ShowMod
End If
Next
If Dvbbs.BoardID=0 Then
XMLDom.documentElement.appendChild(Dvbbs.UserSession.documentElement.firstChild.cloneNode(True))
XMLDom.documentElement.appendChild(Dvbbs.UserSession.documentElement.lastChild.cloneNode(True))
If Dvbbs.UserID <>0 Then
'身份切換數據節點
If UBound(Dvbbs.UserGroupParentID) <> -1 Then
For Each Node In Dvbbs.UserGroupParentID
XMLDom.documentElement.appendChild(XMLDom.createNode(1,"myusergroup","")).text = Node
Next
ElseIf Dvbbs.IsUserPermissionOnly = 1 Then
XMLDom.documentElement.appendChild(XMLDom.createNode(1,"myusergroup","")).text = Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usergroupid2").text
End If
End If
End If
If Dvbbs.Forum_ads(2)="1" or Dvbbs.Forum_ads(13)="1" Then Response.Write "<script language=""javascript"" src=""inc/Dv_Adv.js"" type=""text/javascript""></script>"
'插入圈子信息
If Not IsObject(Application(Dvbbs.CacheName&"_indivgroup")) Then
Call CreatedIndivGroup
Else
'兩個小時更新一次
If Not Application(Dvbbs.CacheName&"_indivgroup") Is Nothing Then
If DateDiff("h",Now(),Cdate(Application(Dvbbs.CacheName&"_indivgroup").documentElement.getAttribute("datecreated")))>2 Then
Call CreatedIndivGroup
End If
Else
Call CreatedIndivGroup
End If
End If
XMLDom.documentElement.appendChild(Application(Dvbbs.CacheName&"_indivgroup").documentElement.cloneNode(True))
transform_BoardList()
If Dvbbs.Boardid=0 Then
If Dvbbs.Forum_Setting(14)="1" Or Dvbbs.Forum_Setting(15)="1" Then
Response.Write "<iframe style=""border:0px;width:0px;height:0px;"" src=""Online.asp?action=1&Boardid=0"" name=""hiddenframe""></iframe>"
Else
Response.Write "<iframe style=""border:0px;width:0px;height:0px;"" src="""" name=""hiddenframe""></iframe>"
End If
End If
If Dvbbs.Forum_ads(2)="1" or Dvbbs.Forum_ads(13)="1" Then
Response.Write "<script language=""javascript"" type=""text/javascript"">" & vbNewLine
If Dvbbs.Forum_ads(2)="1" Then Response.Write Chr(9) & "move_ad('"&Dvbbs.Forum_ads(3)&"','"&Dvbbs.Forum_ads(4)&"','"&Dvbbs.Forum_ads(5)&"','"&Dvbbs.Forum_ads(6)&"');" & vbNewLine
If Dvbbs.Forum_ads(13)="1" Then Response.Write Chr(9) & "fix_up_ad('"& Dvbbs.Forum_ads(8) & "','" & Dvbbs.Forum_ads(10) & "','" & Dvbbs.Forum_ads(11) & "','" & Dvbbs.Forum_ads(9) & "');"& vbNewLine
Response.Write vbNewLine&"</script>"
End If
End Sub
'創建圈子調用緩存
Sub CreatedIndivGroup
Dim Rs,IndivGroupXMLDom,Node
Set IndivGroupXMLDom = Server.CreateObject("msxml2.FreeThreadedDOMDocument"& MsxmlVersion)
IndivGroupXMLDom.appendChild(IndivGroupXMLDom.createElement("indivgroup"))
Set Rs = Dvbbs.Execute("Select Top 3 * From Dv_GroupName Where Stats>0 Order By ID Desc")
Set Node = Dvbbs.RecordsetToxml(Rs,"row","newigroup")
IndivGroupXMLDom.documentElement.appendChild(Node.documentElement.cloneNode(True))
Rs.Close
Set Rs = Dvbbs.Execute("Select Top 3 * From Dv_GroupName Where Stats>0 Order By PostNum Desc,ID")
Set Node = Dvbbs.RecordsetToxml(Rs,"row","activityigroup")
IndivGroupXMLDom.documentElement.appendChild(Node.documentElement.cloneNode(True))
Rs.Close
Set Rs = Dvbbs.Execute("Select Top 3 * From Dv_GroupName Where Stats>0 Order By UserNum Desc,ID")
Set Node = Dvbbs.RecordsetToxml(Rs,"row","hotigroup")
IndivGroupXMLDom.documentElement.appendChild(Node.documentElement.cloneNode(True))
Rs.Close:Set Rs=Nothing
IndivGroupXMLDom.documentElement.setAttribute "datecreated",now()
Set Application(Dvbbs.CacheName&"_indivgroup")=IndivGroupXMLDom
End Sub
Sub transform_BoardList()
Dim proc,XMLStyle
If (Not Response.IsClientConnected) and Dvbbs.userid=0 Then
Response.Clear
Session(Dvbbs.CacheName & "UserID")=empty
Response.End
Else
If Not IsObject(Application(Dvbbs.CacheName & "_indextemplate_"& Dvbbs.SkinID)) Then
Set Application(Dvbbs.CacheName & "_indextemplate_"& Dvbbs.SkinID)=Server.CreateObject("Msxml2.XSLTemplate" & MsxmlVersion)
Set XMLStyle=Server.CreateObject("Msxml2.FreeThreadedDOMDocument"& MsxmlVersion)
XMLStyle.loadxml template.html(0) ' Server.MapPath("index.xslt")
'XMLStyle.load Server.MapPath("index.xslt")
Application(Dvbbs.CacheName & "_indextemplate_"& Dvbbs.SkinID).stylesheet=XMLStyle
End If
Set proc = Application(Dvbbs.CacheName & "_indextemplate_"& Dvbbs.SkinID).createProcessor()
proc.input = XMLDom
proc.transform()
Response.Write Dvbbs.ArchiveHtml(proc.output)
'XMLDom.save Server.MapPath("index.xml")
Set XMLDom=Nothing
Set proc=Nothing
End If
End Sub
Sub ShowNews()
Dim Rs,proc,NewsDom,XMLStyle
If Not IsObject(Application(Dvbbs.CacheName & "_News")) Then
Set Rs=Dvbbs.Execute("Select boardid,title,addtime,bgs From Dv_bbsnews order by id desc")
Set Application(Dvbbs.CacheName & "_News")=Dvbbs.RecordsetToxml(rs,"news","")
End If
Set NewsDom=Application(Dvbbs.CacheName & "_News").cloneNode(True)
NewsDom.documentElement.setAttribute "boardid",Dvbbs.BoardID
If not IsObject(Application(Dvbbs.CacheName & "_shownews_"&Dvbbs.SkinID)) Then
Set Application(Dvbbs.CacheName & "_shownews_"&Dvbbs.SkinID)=Server.CreateObject("Msxml2.XSLTemplate" & MsxmlVersion)
Set XMLStyle=Server.CreateObject("Msxml2.FreeThreadedDOMDocument"& MsxmlVersion)
If UBound(template.html)>3 Then
XMLStyle.loadxml template.html(3)
Else
XMLStyle.load Server.MapPath(MyDbPath &"inc\Templates\Dv_News.xslt")
End If
Application(Dvbbs.CacheName & "_shownews_"&Dvbbs.SkinID).stylesheet=XMLStyle
End If
Set proc = Application(Dvbbs.CacheName & "_shownews_"&Dvbbs.SkinID).createProcessor()
proc.input = NewsDom
proc.transform()
Response.Write proc.output
Set NewsDom=Nothing
Set proc=Nothing
End Sub
Sub LoadlinkList()
Dim rs
Set Rs=Dvbbs.Execute("select * From Dv_bbslink Order by islogo desc,id ")
Set Application(Dvbbs.CacheName & "_link")=Dvbbs.RecordsetToxml(rs,"link","bbslink")
Set Rs=Nothing
End Sub
Sub Forum_BirUser()
Dim Rs,SQL,NowMonth,NowDate,todaystr0,todaystr1,node
NowMonth=Month(Date())
NowDate=Day(Date())
If NowMonth< 10 Then
todaystr0="0"&NowMonth
Else
todaystr0=CStr(NowMonth)
End If
If NowDate < 10 Then
todaystr0=todaystr0&"-"&"0"&NowDate
Else
todaystr0=todaystr0&"-"&NowDate
End If
todaystr1=NowMonth&"-"&NowDate
If todaystr0=todaystr1 Then
SQL="select username,Userbirthday from [Dv_user] where Userbirthday like '%"&todaystr1&"' Order by UserID"
Else
SQL="select username,Userbirthday from [Dv_user] where Userbirthday like '%"&todaystr1&"' Or Userbirthday like '%"&todaystr0&"' Order by UserID"
End If
Set Rs=Dvbbs.Execute(SQL)
Set Application(Dvbbs.CacheName & "_biruser")=Dvbbs.RecordsetToxml(rs,"user","biruser")
Set Rs=Nothing
For Each node In Application(Dvbbs.CacheName & "_biruser").documentElement.selectNodes("user")
todaystr0=Node.selectSingleNode("@userbirthday").text
If IsDate(todaystr0) Then
Node.setAttribute "age",datediff("yyyy",todaystr0,Now())
Else
Application(Dvbbs.CacheName & "_biruser").documentElement.removeChild(node)
End If
Next
Application(Dvbbs.CacheName & "_biruser").documentElement.setAttribute "date",Date()
End Sub
Function LoadToolsInfo()
Dim Tools_Info,i,ShowTools,TempStr
Dvbbs.Name="Plus_ToolsInfo"
If Dvbbs.ObjIsEmpty() Then
Dim Rs,Sql
Sql = "Select ID,ToolsName From Dv_Plus_Tools_Info order by ID"
Set Rs = Dvbbs.Plus_Execute(Sql)
If Not Rs.Eof Then
Sql = Rs.GetString(,, "§§§", "@#@", "")
End If
Rs.Close : Set Rs = Nothing
Tools_Info = Split(Sql,"@#@")
TempStr = "var ShowTools = new Array();" & vbNewLine
For i=0 To Ubound(Tools_Info)-1
ShowTools = Split(Tools_Info(i),"§§§")
TempStr = TempStr & "ShowTools["&ShowTools(0)&"]='"&Replace(Replace(Replace(ShowTools(1),"\","\\"),"'","\'"),chr(13),"")&"';"
Next
Dvbbs.value = TempStr & vbNewLine
End If
LoadToolsInfo = Dvbbs.value
End Function
Sub Passport_Main()
Dim UserID,ForumID,token,t,ForumMsg,toUrl,Passport
UserID = Request("uid")
ForumID = Request("fid")
token = Request("token")
Passport = Request("passport")
t = Request("t")
If UserID = "" Or Not IsNumeric(UserID) Then UserID = 0
UserID = cCur(UserID)
If ForumID = "" Or Not IsNumeric(ForumID) Then ForumID = 0
ForumID = cCur(ForumID)
If t = "" Or Not IsNumeric(t) Then t = 1
t = cCur(t)
If UserID = 0 Or ForumID = 0 Or token = "" Or Passport = "" Then
Response.Write "非法的參數！"
Response.End
End If
Dim iForumUrl
Select Case t
Case "1"
ForumMsg = "<li>您成功的注冊了論壇通行證帳號，請牢記您填寫的通行證帳號和密碼。"
toUrl = "reg.asp?action=redir"
Case "2"
ForumMsg = "<li>login suc。"
toUrl = "login.asp?action=redir"
Case Else
ForumMsg = "<li>您成功的注冊了論壇通行證帳號，請牢記您填寫的通行證帳號和密碼。"
toUrl = "index.asp"
End Select
iForumUrl = toUrl & "&ErrorCode=1&ErrorMsg="&ForumMsg&"&passport="&Passport&"&token="&token
%>
<html>
<head>
<!--禁止被框架-->
<script type="text/javascript" language="JavaScript">
<!--
if (top.location !== self.location) {
top.location = "index.asp?w=1&t=<%=t%>&uid=<%=UserID%>&fid=<%=ForumID%>&passport=<%=Passport%>&token=<%=token%>";
}
-->
</script>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<title>歡迎訪問<%=Dvbbs.Forum_Info(0)%></title>
</head>
<frameset border=0 rows=*,79 frameborder=0 framespacing=0>
<frame longdesc="" src="<%=iForumUrl%>" name="MainWin" noresize frameborder="0" marginwidth=0 marginheight=0 scrolling="auto">
<frame longdesc="" src="http://www.dvbbs.net/passport/index.asp?uid=<%=UserID%>&fid=<%=ForumID%>&token=<%=token%>&t=<%=t%>&s=1" name="top" noresize frameborder="0" marginwidth=0 marginheight=0 scrolling="no">
</frameset>
<noframes>
<a href="http://www.dvbbs.net" target="_top">動網論壇_國內最大的免費論壇軟件服務提供</a> 版權所有 2005
此 html 框架集顯示多個 web 頁。若要查看此框架集，請使用支持 html 4.0 及更高版本的 web 瀏覽器。
</noframes>
</html>
<%
End Sub
%>?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -