📄 dv_loadcache.asp
字号:
<%
'===================================
'更新缓存函数合集
'===================================
Dim BoardListDOM
Sub ReloadSetup()
'id=0, Forum_Setting=1, Forum_ads=2, Forum_Badwords=3, Forum_rBadword=4, Forum_Maxonline=5, Forum_MaxonlineDate=6, Forum_TopicNum=7, Forum_PostNum=8, Forum_TodayNum=9, Forum_UserNum=10, Forum_YesTerdayNum=11, Forum_MaxPostNum=12, Forum_MaxPostDate=13, Forum_lastUser=14, Forum_LastPost=15, Forum_BirthUser=16, Forum_Sid=17, Forum_Version=18, Forum_NowUseBBS=19, Forum_IsInstall=20, Forum_challengePassWord=21, Forum_Ad=22, Forum_ChanName=23, Forum_ChanSetting=24, Forum_LockIP=25, Forum_Cookiespath=26, Forum_Boards=27, Forum_alltopnum=28, Forum_pack=29, Forum_Cid=30, Forum_AvaSiteID=31, Forum_AvaSign=32, Forum_AdminFolder=33, Forum_BoardXML=34, Forum_Css=35
Dim Rs
Set Rs = Dvbbs.Execute("Select id, Forum_Setting, Forum_ads, Forum_Badwords, Forum_rBadword, Forum_Maxonline, Forum_MaxonlineDate, Forum_TopicNum, Forum_PostNum, Forum_TodayNum, Forum_UserNum, Forum_YesTerdayNum, Forum_MaxPostNum, Forum_MaxPostDate, Forum_lastUser, Forum_LastPost, Forum_BirthUser, Forum_Sid, Forum_Version, Forum_NowUseBBS, Forum_IsInstall, Forum_challengePassWord, Forum_Ad, Forum_ChanName, Forum_ChanSetting, Forum_LockIP, Forum_Cookiespath, Forum_Boards, Forum_alltopnum, Forum_pack, Forum_Cid, Forum_AvaSiteID, Forum_AvaSign, Forum_AdminFolder, Forum_BoardXML, Forum_Css From [Dv_Setup]")
Dvbbs.Name="setup"
Dvbbs.Value = Rs.GetRows(1)
Set Rs = Nothing
Dvbbs.CacheData=Dvbbs.Value
End Sub
'==========MakXMLBoardList========
'作用,生成一份简单的XML数据
'参数 uporders 0不修正排序,1修正
'upRootid 0 不修正rootid 1修正
'此过程用于后台修改版面信息数据后的更新,前台勿用
Sub MakXMLBoardList(uporders,upRootid)
Dim NodeList,BoardIDlist,Node,i
Set BoardListDOM=Server.CreateObject("Microsoft.FreeThreadedXMLDOM")
BoardListDOM.appendChild(BoardListDOM.createProcessingInstruction("xml","version=""1.0"" encoding=""gb2312"""))
BoardListDOM.appendChild(BoardListDOM.createElement("BoardList"))
BoardListDOM.documentElement.attributes.setNamedItem(BoardListDOM.createNode(2,"Product","")).text="Dvbbs"
BoardListDOM.documentElement.attributes.setNamedItem(BoardListDOM.createNode(2,"Version","")).text=Dvbbs.CacheData(18,0)
BoardListDOM.documentElement.attributes.setNamedItem(BoardListDOM.createNode(2,"Copyright","")).text="Aspsky.net"
BoardListDOM.documentElement.attributes.setNamedItem(BoardListDOM.createNode(2,"boardid","")).text=0
LoadChildBoard BoardListDOM.documentElement,0
If uporders=1 Then
Set NodeList=BoardListDOM.documentElement.getElementsByTagName("board")
i=1
For Each Node In nodeList
Dvbbs.Execute("Update Dv_board Set Orders="&i&" Where Boardid="&Node.attributes.getNamedItem("boardid").text)
i=i+1
Next
End If
If upRootid =1 Then UpdateRootID
Dvbbs.Execute("update Dv_setup Set Forum_Boards='"& Dvbbs.Checkstr(BoardListDOM.XML) &"'")
'同步缓存数据
Dvbbs.CacheData(27,0)=BoardListDOM.XML
Application.Lock
Set Application(Dvbbs.CacheName&"_sBoradlist")= BoardListDOM.cloneNode(True)
Application.UnLock
Set BoardListDOM=Nothing
MakXMLBoardInfo 0
End Sub
'递归过程,生成XML节点
Sub LoadChildBoard(Node,ParentID)
Dim Rs,Board_setting,i,ChildNode
Set Rs=Dvbbs.Execute("Select boardid,boardtype,depth,Board_setting From Dv_Board where ParentID="& ParentID &" Order By RootID,orders")
Do While Not Rs.EOF
Board_setting=split(Rs("Board_setting")&"",",")
Set ChildNode=BoardListDOM.createNode(1,"board","")
For i = 0 To Rs.Fields.Count-2
ChildNode.attributes.setNamedItem(BoardListDOM.createNode(2,Rs(i).name,"")).text = Rs(i)&""
Next
'属性checkout 1 认证论坛
ChildNode.attributes.setNamedItem(BoardListDOM.createNode(2,"checkout","")).text=Board_setting(2)
'属性hidden=1 隐藏论坛
ChildNode.attributes.setNamedItem(BoardListDOM.createNode(2,"hidden","")).text=Board_setting(1)
'属性nopost 作为分类不可以发贴和回贴
ChildNode.attributes.setNamedItem(BoardListDOM.createNode(2,"nopost","")).text=Board_setting(43)
Node.appendChild(ChildNode)
LoadChildBoard ChildNode,Rs(0)
Rs.MoveNext
Loop
Rs.Close
Set Rs = Nothing
End Sub
Sub UpdateRootID()'修正所有版面的RootID,Child
Dim Node,Nodelist,nodelist1,Node1,i
Set Nodelist=BoardListDOM.documentElement.selectNodes("board")
i=1
For Each Node in nodelist
Set Nodelist1=node.getElementsByTagName("board")
Dvbbs.Execute("Update Dv_Board Set Rootid="&i&" Where BoardID="& Node.attributes.getNamedItem("boardid").text)
For Each Node1 in nodelist1
Dvbbs.Execute("Update Dv_Board Set Rootid="&i&" Where BoardID="& Node1.attributes.getNamedItem("boardid").text)
Next
i=i+1
Next
Set Nodelist=BoardListDOM.documentElement.getElementsByTagName("board")
For Each Node in nodelist
Dvbbs.Execute("update Dv_Board set parentstr='"&Getparentstr(Node.attributes.getNamedItem("boardid").text,Node)&"',Child="&Node.selectNodes("board").length&" Where BoardID="& Node.attributes.getNamedItem("boardid").text)
Next
End Sub
Function Getparentstr(BordID,Node)
Dim CNode,parentstr
If Not (Node.parentNode.nodeName="board") Then
Getparentstr="0"
Else
Set CNode=Node
parentstr=""
Do While CNode.parentNode.nodeName="board"
Set CNode=CNode.parentNode
If parentstr="" Then
parentstr=CNode.attributes.getNamedItem("boardid").text
Else
parentstr=CNode.attributes.getNamedItem("boardid").text&","&parentstr
End If
Loop
Getparentstr=parentstr
End If
End Function
'重新整理含版面信息的XML数据,后台使用
Sub MakXMLBoardInfo(BoardID)
Dim Node,Nodelist,Fields,SQL,Rs,i,Board_setting,j,lastpost,BoardMasterList,BoardMaster,BoardNode,ChildNode
Fields=LCase("boardid,BoardType,ParentID,ParentStr,Depth,RootID,Child,readme,BoardMaster,PostNum,TopicNum,indexIMG,todayNum,boarduser,LastPost,Sid,Board_Setting,Board_Ads,Board_user,IsGroupSetting,BoardTopStr,cid,Rules")
If BoardID=0 Then
Set BoardListDOM=Application(Dvbbs.CacheName&"_sBoradlist").cloneNode(True)
SQL="Select "&Fields&" From Dv_Board Order By Rootid,orders"
Else
Set BoardListDOM=Application(Dvbbs.CacheName&"_Boradlist").cloneNode(True)
SQL="Select "&Fields&" From Dv_Board where BoardID="& BoardID &""
End If
Set Rs=Dvbbs.Execute(SQL)
Fields=Split(Fields,",")
Set Nodelist=BoardListDOM.documentElement.getElementsByTagName("board")
If Not Rs.EOF Then
SQL=Rs.GetRows(-1)
i=0
For Each ChildNode in Nodelist
If CStr(SQL(0,i))=ChildNode.attributes.getNamedItem("boardid").text Then
Board_setting=split(SQL(16,i)&"",",")
lastpost=Split(SQL(14,i)&"","$")
BoardMasterList=Split(SQL(8,i)&"","|")
For j=0 to UBound(sql,1)
ChildNode.attributes.setNamedItem(BoardListDOM.createNode(2,Fields(j),"")).text = SQL(j,i)&""
Next
'属性checklock 1 认证论坛
ChildNode.attributes.setNamedItem(BoardListDOM.createNode(2,"checklock","")).text=Board_setting(0)
'属性checkout 1 认证论坛
ChildNode.attributes.setNamedItem(BoardListDOM.createNode(2,"checkout","")).text=Board_setting(2)
'属性hidden=1 隐藏论坛
ChildNode.attributes.setNamedItem(BoardListDOM.createNode(2,"hidden","")).text=Board_setting(1)
'属性 mode下属论坛显示模式
ChildNode.attributes.setNamedItem(BoardListDOM.createNode(2,"mode","")).text=Board_setting(39)
'属性simplenessCount简洁模式每行显示数
ChildNode.attributes.setNamedItem(BoardListDOM.createNode(2,"simplenessCount","")).text=Board_setting(41)
'属性nopost 作为分类不可以发贴和回贴
ChildNode.attributes.setNamedItem(BoardListDOM.createNode(2,"nopost","")).text=Board_setting(43)
'该版固顶帖数
ChildNode.attributes.setNamedItem(BoardListDOM.createNode(2,"toptopiccount","")).text = ""
'属性hasnew 有无新贴
ChildNode.attributes.setNamedItem(BoardListDOM.createNode(2,"hasnew","")).text=0
'公告,小字报
ChildNode.attributes.setNamedItem(BoardListDOM.createNode(2,"boardnews","")).text="当前没有公告|||"&Now()&"|||"
'TextAd文字广告
ChildNode.attributes.setNamedItem(BoardListDOM.createNode(2,"textad",""))
'master节点集,每个版主一个节点,每个节点含序号order,版主的urlencode两个属性
j=0
For Each BoardMaster in BoardMasterlist
Set BoardNode=ChildNode.appendChild(BoardListDOM.createNode(1,"boardmasterlist",""))
BoardNode.attributes.setNamedItem(BoardListDOM.createNode(2,"master","")).text=BoardMaster
BoardNode.attributes.setNamedItem(BoardListDOM.createNode(2,"urlencode","")).text=Server.urlencode(BoardMaster)
BoardNode.attributes.setNamedItem(BoardListDOM.createNode(2,"order","")).text=j
j=j+1
Next
If UBound(lastpost)<6 Then
ReDim lastpost(7)
lastpost(2)=Now()
End If
For j=0 to UBound(LastPost)
ChildNode.attributes.setNamedItem(BoardListDOM.createNode(2,"lastpost"&j,"")).text=LastPost(j)
Next
i= i+1
If BoardID>0 Then Exit For
End If
If i >UBound(SQL,2) Then Exit For
Next
Set Rs=Nothing
Else
Set Rs=Nothing
End If
'同步数据
Dvbbs.Execute("update Dv_setup Set Forum_BoardXML='"& Dvbbs.Checkstr(BoardListDOM.XML) &"'")
Dvbbs.CacheData(34,0)=BoardListDOM.XML
Application.Lock
Set Application(Dvbbs.CacheName&"_Boradlist")= BoardListDOM.cloneNode(True)
Application.UnLock
Set BoardListDOM=Nothing
End Sub
'更新模版列表缓存
Sub ReloadTemplateslist()
Dvbbs.Name="Templateslist"
Dim Rs,SQL,tmpdata
SQL = "select ID,StyleName from [Dv_Style]"
Set Rs = Dvbbs.Execute(SQL)
tmpdata = Rs.GetString(,,"|||","@@@","")
tmpdata = Left(tmpdata,Len(tmpdata)-3)
Set Rs = Nothing
Dvbbs.value=tmpdata
End Sub
Sub LoadBoardNews_Paper()
Dvbbs.LoadTemplates("")
Dim tRs,bgs,MyGetData,TempStr,NoAnn,NoColor
NoAnn = Dvbbs.lanstr(9)
NoColor = Dvbbs.mainsetting(10)
Dim Node,Nodelist,BoardNode
Set Dvbbs.BoardXML=Application(Dvbbs.CacheName&"_Boradlist").cloneNode(True)
Set Nodelist=Dvbbs.BoardXML.documentElement.getElementsByTagName("board")
For Each Node in nodelist
Set tRs=Dvbbs.Execute("Select Top 1 title,addtime,bgs From [Dv_bbsnews] Where boardid="&Node.attributes.getNamedItem("boardid").text&" Order By ID Desc")
If tRs.BOF And tRs.EOF Then
TempStr = NoAnn & "|||"
Else
bgs=tRs(2)
If bgs="" or IsNull(bgs) Then
TempStr=tRs(0) & "|||" & tRs(1)
Else
TempStr="<img src=Skins/Default/filetype/mid.gif border=0><bgsound src="&bgs&" border=0>"&tRs(0)&"|||"&tRs(1)
End if
End If
'小字报部分
If IsSqlDataBase=1 Then
Set tRs=Dvbbs.Execute("Select Top 5 S_id as id,S_username as postuser,S_title as topic From Dv_Smallpaper Where Datediff(D,S_addtime,"&SqlNowString&")<=1 And S_boardid="&Node.attributes.getNamedItem("boardid").text&" Order By S_addtime Desc")
Else
Set tRs=Dvbbs.Execute("Select Top 5 S_id as id,S_username as postuser,S_title as topic From Dv_Smallpaper Where Datediff('D',S_addtime,"&SqlNowString&")<=1 And S_boardid="&Node.attributes.getNamedItem("boardid").text&" Order By S_addtime Desc")
End If
If tRs.Eof And tRs.Bof Then
TempStr=TempStr & "|||"
Else
Dim TempData,i
TempData=tRs.GetRows(-1)
For i=0 To Ubound(TempData,2)
If i=0 Then
TempStr = TempStr & "||| <font color="&NoColor&">"&Dvbbs.HtmlEncode(TempData(1,i))&"</font>:<a href=javascript:openScript(""viewinfo.asp?id="&TempData(0,i)&"&boardid="&Node.attributes.getNamedItem("boardid").text&""",500,400)>"&Dvbbs.HtmlEncode(TempData(2,i))&"</a> "
Else
TempStr = TempStr & " <font color="&NoColor&">"&Dvbbs.HtmlEncode(TempData(1,i))&"</font>:<a href=javascript:openScript(""viewinfo.asp?id="&TempData(0,i)&"&boardid="&Node.attributes.getNamedItem("boardid").text&""",500,400)>"&Dvbbs.HtmlEncode(TempData(2,i))&"</a> "
End If
Next
End If
Node.attributes.getNamedItem("boardnews").text = TempStr
Set tRs=Nothing
Next
Application.Lock
Set Application(Dvbbs.CacheName&"_Boradlist")=Dvbbs.BoardXML
Application.unLock
End Sub
'输出缓存用户组GroupSetting(58)设置 (用户名在帖子内容中显示标记) 组ID,姓名代码|||
Sub iGroupSetting_UserName()
Dvbbs.Name="GroupSetting_UserName"
Dim i,Str,OutputStr,Outputvalue
Dim Rs,SQL
SQL = "Select UserGroupID,GroupSetting From [Dv_UserGroups] order by UserGroupID"
Set Rs = Dvbbs.Execute(SQL)
Do while not Rs.Eof
Str = Str & Rs(0) &","& Split(Rs(1),",")(58)
Str = Str & "|||"
Rs.MoveNext
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -