<% Head() Dim Admin_Flag Dim NewsConfigFile Dim XmlDoc,Node Dim NewsName,NewsType,Updatetime,Skin_Head,Skin_Main,Skin_Footer,NewsSql Admin_flag=",1," NewsConfigFile = MyDbPath & "Dv_ForumNews/Dv_NewsSetting.config" NewsConfigFile = Server.MapPath(NewsConfigFile) If Not Dvbbs.master Or InStr(","&Session("flag")&",",admin_flag)=0 Then Errmsg=ErrMsg + "
  • 本页面为管理员专用，请登录后进入。
  • 您没有管理本页面的权限。
    • " Dvbbs_Error() Else Main() If FoundErr Then Call Dvbbs_Error() Footer() End If Sub Main() %>
    论坛首页调用管理
    ①添加调用后，在列表中点击相应的预览可以看到效果，将调用代码复制到你的首页就可以了。
    ②如果你的首页是和论坛程序分开，在填写调用模板时建议用上绝对地址路径。
    ③若需要设置外部调用限制和设置临时文件名，修改Dv_News.asp文件，文件里附有说明。
    ④建议根据不同的调用设定更新时间间隔，如不是经常更新的版块调用可以设置长一些时间间隔，这样可以有效地减低消耗。
    添加首页调用 | 首页调用列表 | 查看所有调用演示
    <% Select Case Request("Act") Case "NewsList": Call NewsList() Case "AddSetting" , "EditNewsInfo" : Call AddSetting() Case "SaveSetting" , "SaveEditSetting" : Call SaveSetting() Case "DelNewsInfo" : Call DelNewsInfo() Case Else Call NewsList() End Select End Sub '删除记录 Sub DelNewsInfo() Dim DelNodes,DelChildNodes Set XmlDoc = Server.CreateObject("msxml2.FreeThreadedDOMDocument"& MsxmlVersion) If Not XmlDoc.load(NewsConfigFile) Then ErrMsg = "调用列表中为空，请填写调用后再执行本操作!" Dvbbs_Error() Exit Sub End If 'Response.Write Request.Form("DelNodes").count For Each DelNodes in Request.Form("DelNodes") Set DelChildNodes = XmlDoc.DocumentElement.selectSingleNode("NewsCode[@AddTime='"&DelNodes&"']") If Not (DelChildNodes is nothing) Then XmlDoc.DocumentElement.RemoveChild(DelChildNodes) End If Next Call SaveXml() Dv_suc("所选的记录已删除!") End Sub Sub SaveSetting() NewsName = Replace(Request.Form("NewsName"),"""","") NewsType = Replace(Request.Form("NewsType"),"""","") Updatetime = Dvbbs.CheckNumeric(Request.Form("Updatetime")) Skin_Head = Request.Form("Skin_Head") Skin_Main = Request.Form("Skin_Main") Skin_Footer = Request.Form("Skin_Footer") If NewsName="" Then Errmsg=ErrMsg + "
  • 请填写调用标识！
    • " Else NewsName = Lcase(NewsName) End If If NewsType < "1" Then Errmsg=ErrMsg + "
  • 选取调用类型！
    • " End If If Skin_Main = "" Then Errmsg=ErrMsg + "
  • 模板_主体循环标记部分不能为空！
    • " End If If Errmsg<>"" Then Dvbbs_Error() : Exit Sub Call LoadXml() If FoundNewsName(NewsName) and Request("Act") <> "SaveEditSetting" Then Errmsg=ErrMsg + "
  • 调用标识已存在，不能重复添加！
    • " Dvbbs_Error() Exit Sub End If Select Case NewsType Case "1" '帖子调用 Call NewsType_1() Case "2" '信息调用 Call NewsType_2() Case "3" '版块调用 Call NewsType_3() Case "4" '会员调用 Call NewsType_4() Case "5" '公告调用 Call NewsType_5() Case "6" '展区调用 Call NewsType_6() Case Else Errmsg=ErrMsg + "
  • 请正确选取调用类型！
    • " Dvbbs_Error() End Select Call CreateXmlLog() Call SaveXml() Dv_suc("调用设置成功!") End Sub Sub LoadXml() Set XmlDoc = Server.CreateObject("msxml2.FreeThreadedDOMDocument"& MsxmlVersion) If Not XmlDoc.load(NewsConfigFile) Then XmlDoc.loadxml "" End If End Sub '检查是否存在相同的标识 Function FoundNewsName(NewsName) Dim Test Set Test = XmlDoc.DocumentElement.selectSingleNode("NewsCode[@NewsName="""&NewsName&"""]") FoundNewsName = not (Test is nothing) End Function Sub SaveXml() XmlDoc.save NewsConfigFile Set XmlDoc = Nothing End Sub '公共记录 Sub CreateXmlLog() Dim attributes,createCDATASection,ChildNode Dim FormName,NoAttFormName Dim Addtime AddTime = Now() If Request("Act") = "SaveEditSetting" and Request.Form("AddTime")<>"" Then Set Node = XmlDoc.DocumentElement.selectSingleNode("NewsCode[@AddTime='"&Request.Form("AddTime")&"']") If Not (Node is nothing) Then AddTime = Node.getAttribute("AddTime") XmlDoc.DocumentElement.RemoveChild(Node) End If End If '创建节点 Set Node=XmlDoc.createNode(1,"NewsCode","") NoAttFormName = ",Skin_Head,Skin_Main,Skin_Footer,Act,AddTime,Board_Input0,Board_Input1,Board_Input2,Board_Input3,Board_Input4," For Each FormName In Request.Form If Instr(NoAttFormName,","&FormName&",")=0 Then Set attributes=XmlDoc.createAttribute(FormName) If FormName="NewsName" Then attributes.text = Lcase(Replace(Request.Form(FormName),"""","")) Else attributes.text = Replace(Request.Form(FormName),"""","") End If node.attributes.setNamedItem(attributes) End If Next Set attributes=XmlDoc.createAttribute("MasterName") attributes.text = Dvbbs.Membername node.attributes.setNamedItem(attributes) Set attributes=XmlDoc.createAttribute("MasterUserID") attributes.text = Dvbbs.UserID node.attributes.setNamedItem(attributes) Set attributes=XmlDoc.createAttribute("MasterIP") attributes.text = Dvbbs.UserTrueIP node.attributes.setNamedItem(attributes) Set attributes=XmlDoc.createAttribute("AddTime") attributes.text = AddTime node.attributes.setNamedItem(attributes) Set attributes=XmlDoc.createAttribute("LastTime") attributes.text = DateAdd("s", -Updatetime,now()) node.attributes.setNamedItem(attributes) Set ChildNode = XmlDoc.createNode(1,"Search","") Set createCDATASection=XmlDoc.createCDATASection(replace(NewsSql,"]]>","")) ChildNode.appendChild(createCDATASection) node.appendChild(ChildNode) Set ChildNode = XmlDoc.createNode(1,"Skin_Head","") Set createCDATASection=XmlDoc.createCDATASection(replace(Skin_Head,"]]>","]]>")) ChildNode.appendChild(createCDATASection) node.appendChild(ChildNode) Set ChildNode = XmlDoc.createNode(1,"Skin_Main","") Set createCDATASection=XmlDoc.createCDATASection(replace(Skin_Main,"]]>","]]>")) ChildNode.appendChild(createCDATASection) node.appendChild(ChildNode) Set ChildNode = XmlDoc.createNode(1,"Skin_Footer","") Set createCDATASection=XmlDoc.createCDATASection(replace(Skin_Footer,"]]>","]]>")) ChildNode.appendChild(createCDATASection) node.appendChild(ChildNode) ''特殊版面增加 If NewsType = "3" Then Set ChildNode = XmlDoc.createNode(1,"Board_Input0","") Set createCDATASection=XmlDoc.createCDATASection(Replace(Request.Form("Board_Input0"),"]]>","]]>")) ChildNode.appendChild(createCDATASection) node.appendChild(ChildNode) Set ChildNode = XmlDoc.createNode(1,"Board_Input1","") Set createCDATASection=XmlDoc.createCDATASection(Replace(Request.Form("Board_Input1"),"]]>","]]>")) ChildNode.appendChild(createCDATASection) node.appendChild(ChildNode) Set ChildNode = XmlDoc.createNode(1,"Board_Input2","") Set createCDATASection=XmlDoc.createCDATASection(Replace(Request.Form("Board_Input2"),"]]>","]]>")) ChildNode.appendChild(createCDATASection) node.appendChild(ChildNode) Set ChildNode = XmlDoc.createNode(1,"Board_Input3","") Set createCDATASection=XmlDoc.createCDATASection(Replace(Request.Form("Board_Input3"),"]]>","]]>")) ChildNode.appendChild(createCDATASection) node.appendChild(ChildNode) Set ChildNode = XmlDoc.createNode(1,"Board_Input4","") Set createCDATASection=XmlDoc.createCDATASection(Replace(Request.Form("Board_Input4"),"]]>","]]>")) ChildNode.appendChild(createCDATASection) node.appendChild(ChildNode) ElseIf NewsType = "6" Then Set ChildNode = XmlDoc.createNode(1,"Board_Input0","") Set createCDATASection=XmlDoc.createCDATASection(Replace(Request.Form("Board_Input0"),"]]>","]]>")) ChildNode.appendChild(createCDATASection) node.appendChild(ChildNode) End If XmlDoc.documentElement.appendChild(node) End Sub '帖子调用 Sub NewsType_1() Dim News_Total,Topiclen,Orders,TopicType,Boardid,BoardLimit,BoardType,UserIDList,Sdate News_Total = Dvbbs.CheckNumeric(Request.Form("Total")) Topiclen = Dvbbs.CheckNumeric(Request.Form("Topiclen")) Orders = Request.Form("Orders") Sdate = Dvbbs.CheckNumeric(Request.Form("Sdate")) TopicType = Request.Form("TopicType") Boardid = Dvbbs.CheckNumeric(Request.Form("Boardid")) BoardLimit = Dvbbs.CheckNumeric(Request.Form("BoardLimit")) BoardType = Request.Form("BoardType") UserIDList = Request.Form("UserIDList") If News_Total = 0 Then News_Total = 10 Dim OrderBy,Searchstr,SearchBoard,Tempstr NewsSql = "SELECT TOP "& News_Total If Orders = "3" Then OrderBy = " Hits Desc, " ElseIf orders = "1" or orders = "2" Then OrderBy = " Dateandtime Desc, " End If '指定版面 If Boardid>0 Then SearchBoard = " AND Boardid = " & Boardid If BoardType > "0" Then Tempstr = GetChildBoardID(Boardid) If BoardType = "2" Then Tempstr = Boardid & "," &Tempstr End If If Tempstr<>"" Then Tempstr = Left(Tempstr,InStrRev(Tempstr, ",")-1) SearchBoard = " AND Boardid in (" & Tempstr &") " End If End If Else Tempstr = Cstr(Boardid) End If '限制不显示特列版面 If BoardLimit="1" and Tempstr<>"" Then Tempstr = GetBoardid(Tempstr) If Boardid<>0 Then SearchBoard = " AND Boardid in (" & Tempstr &") " Else If Tempstr<>"" Then SearchBoard = " AND Boardid not in (" & Tempstr &") " End If End If End If If SearchBoard<>"" Then Searchstr = SearchBoard End If If UserIDList<>"" Then If Instr(UserIDList,",") Then If IsNumeric(Replace(UserIDList,",","")) Then Searchstr = Searchstr & " AND PostUserID IN ("&UserIDList&")" End If Else UserIDList = Dvbbs.CheckNumeric(UserIDList) If UserIDList > 0 Then Searchstr = Searchstr & " AND PostUserID = "&UserIDList End If End If End If If Sdate>0 Then If IsSqlDataBase=1 Then Searchstr = Searchstr & " AND Datediff(day,DateAndTime,"&SqlNowString&") < " & Sdate Else Searchstr = Searchstr & " AND Datediff('d',DateAndTime,"&SqlNowString&") < " & Sdate End If End If If TopicType = 1 Then '显示精华主题 If Searchstr<>"" Then Searchstr = " Where "& Mid(Searchstr,InStr(Searchstr, "AND")+3) End If NewsSql = NewsSql & " PostUserName,Title,Rootid,Boardid,Dateandtime,Announceid,Id,Expression From [Dv_BestTopic] " & Searchstr & " ORDER BY " & OrderBy & " Id Desc" ElseIf TopicType=2 Then '显示主题和回复 NewsSql = NewsSql & " UserName,Topic,Rootid,Boardid,Dateandtime,Announceid,Body,Expression From "&Dvbbs.NowUseBBS&" Where not (Boardid in (444,777)) "& Searchstr &" ORDER BY "& OrderBy &" AnnounceID Desc" Else '显示主题 If Orders = 2 Then OrderBy = " Lastposttime Desc, " NewsSql = NewsSql & " PostUserName,Title,Topicid,Boardid,Dateandtime,Topicid,Hits,Expression,LastPost From [Dv_topic] Where not (Boardid in (444,777)) "& Searchstr & " ORDER BY "& OrderBy &" Topicid Desc" End If End Sub '信息调用 Sub NewsType_2() End Sub '版块调用 Sub NewsType_3() End Sub '会员调用 Sub NewsType_4() Dim News_Total,Orders News_Total = Dvbbs.CheckNumeric(Request.Form("Total")) Orders = Request.Form("Orders") Dim OrderBy If News_Total = 0 Then News_Total = 10 NewsSql = "SELECT TOP "& News_Total &" UserID,UserName,UserTopic,UserPost,UserIsBest,UserWealth,UserCP,UserEP,UserDel,UserSex,JoinDate,UserLogins From [Dv_user] " Select Case Request.Form("UserOrders") Case "0" 'OrderBy = " JoinDate desc, " OrderBy = "" Case "1" OrderBy = " UserPost desc, " Case "2" OrderBy = " UserTopic desc, " Case "3" OrderBy = " UserIsBest desc, " Case "4" OrderBy = " UserWealth desc, " Case "5" OrderBy = " UserEP desc, " Case "6" OrderBy = " UserCP desc, " Case "7" OrderBy = " UserDel desc, " Case "8" OrderBy = " UserLogins desc, " End Select NewsSql = NewsSql & " ORDER BY " & OrderBy & " UserID desc " End Sub '公告调用 Sub NewsType_5() Dim News_Total,Boardid News_Total = Dvbbs.CheckNumeric(Request.Form("Total")) Boardid = Dvbbs.CheckNumeric(Request.Form("Boardid")) If News_Total = 0 Then News_Total = 10 NewsSql = "SELECT TOP "& News_Total &" ID,Boardid,Title,UserName,AddTime FROM [Dv_bbsnews] " If Boardid > 0 Then NewsSql = NewsSql & " WHERE Boardid="& Boardid End If NewsSql = NewsSql & " ORDER BY ID DESC" End Sub '展区调用 Sub NewsType_6() Dim News_Total,Boardid,FileOrders,BoardLock,FileType,BoardLimit Dim Searchstr,OrderBy News_Total = Dvbbs.CheckNumeric(Request.Form("Total")) Boardid = Dvbbs.CheckNumeric(Request.Form("Boardid")) FileOrders = Request.Form("FileOrders") BoardLock = Dvbbs.CheckNumeric(Request.Form("BoardLock")) FileType = Request.Form("FileType") BoardLimit = Dvbbs.CheckNumeric(Request.Form("BoardLimit")) If News_Total = 0 Then News_Total = 8 If FileType<>"all" Then FileType = Dvbbs.CheckNumeric(FileType) Searchstr = " AND F_Type = "&FileType End If '指定版面 Dim SearchBoard Dim Rs,Tempstr If Boardid > 0 Then Select Case BoardLock Case 1 SearchBoard = " AND F_BoardID <> " & Boardid Tempstr = "0" Case 3,4 Tempstr = GetChildBoardID(Boardid) If BoardLock = 4 Then Tempstr = Boardid & "," &Tempstr End If If TempStr<>"" Then Tempstr = Left(Tempstr,InStrRev(Tempstr, ",")-1) SearchBoard = " AND F_BoardID in (" & Tempstr &") " End If Case Else SearchBoard = " AND F_BoardID = " & Boardid End Select Else Tempstr = Cstr(Boardid) End If '限制不显示特列版面 If BoardLimit="1" and Tempstr<>"" Then Tempstr = GetBoardid(Tempstr) If Boardid<>0 Then If BoardLock = 1 Then SearchBoard = " AND F_BoardID in (" & Boardid &","& Tempstr &") " Else SearchBoard = " AND F_BoardID in (" & Tempstr &") " End If Else If Tempstr<>"" Then SearchBoard = " AND F_BoardID not in (" & Tempstr &") " End If End If End If Select Case FileOrders Case 1 OrderBy = " F_ViewNum DESC, " Case 2 OrderBy = " F_DownNum DESC, " Case 3 OrderBy = " F_FileSize DESC, " Case Else OrderBy = "" End Select Searchstr = Searchstr & SearchBoard NewsSql = "SELECT TOP "& News_Total &" F_ID,F_AnnounceID,F_BoardID,F_Username,F_Filename,F_Readme,F_Type,F_FileType,F_AddTime,F_Viewname,F_ViewNum,F_DownNum,F_FileSize FROM [DV_Upfile] WHERE F_Flag<>4 " NewsSql = NewsSql & Searchstr & " ORDER BY "& OrderBy &" F_ID DESC" End Sub 'BoardidVal<>0 取出调用的版面ID，当BoardidVal=0 取出不被调用的版面ID Function GetBoardid(BoardidVal) Dim TempData,Nodelist,Nodes If BoardidVal<>"0" Then BoardidVal = "," & BoardidVal & "," End If Set Nodelist = Application(Dvbbs.CacheName&"_boardlist").cloneNode(True).documentElement.getElementsByTagName("board") For Each Nodes in Nodelist If BoardidVal<>"0" Then If Instr(BoardidVal,","&Nodes.attributes.getNamedItem("boardid").text&",") and Nodes.attributes.getNamedItem("hidden").text="0" and Nodes.attributes.getNamedItem("checkout").text="0" Then TempData = TempData & Nodes.attributes.getNamedItem("boardid").text &"," End If Else If Nodes.attributes.getNamedItem("hidden").text="1" or Nodes.attributes.getNamedItem("checkout").text="1" Then TempData = TempData & Nodes.attributes.getNamedItem("boardid").text &"," End If End If Next If TempData<>"" Then GetBoardid = Left(TempData,InStrRev(TempData, ",")-1) End If End Function '获取下属版块ID Private Function GetChildBoardID(BoardIDVal) Dim TempData,Nodelist,Node Set Nodelist = Application(Dvbbs.CacheName&"_boardlist").cloneNode(True).documentElement.getElementsByTagName("board") For Each Node in Nodelist If Instr(","&Node.attributes.getNamedItem("parentstr").text&",",","&BoardIDVal&",")>0 Then TempData = TempData & Node.attributes.getNamedItem("boardid").text &"," End If Next GetChildBoardID = TempData End Function Sub AddSetting() Dim ChildNode,attributes,Action Call LoadXml() If Request("Act") = "EditNewsInfo" Then Set Node = XmlDoc.DocumentElement.selectSingleNode("NewsCode[@AddTime='"&Request("DelNodes")&"']") If (Node is nothing) Then ErrMsg = "
  • 所选取的调用已不存在!
    • " Dvbbs_Error() Exit Sub End If Action = "SaveEditSetting" Else Set Node=XmlDoc.createNode(1,"NewsCode","") Set ChildNode = XmlDoc.createNode(1,"Skin_Head","") node.appendChild(ChildNode) Set ChildNode = XmlDoc.createNode(1,"Skin_Main","") node.appendChild(ChildNode) Set ChildNode = XmlDoc.createNode(1,"Skin_Footer","") node.appendChild(ChildNode) Action = "SaveSetting" End If '当不是编辑版面调用时创建临时节点 If NewsType <> "3" or NewsType <> "6" Then Set ChildNode = XmlDoc.createNode(1,"Board_Input0","") node.appendChild(ChildNode) Set ChildNode = XmlDoc.createNode(1,"Board_Input1","") node.appendChild(ChildNode) Set ChildNode = XmlDoc.createNode(1,"Board_Input2","") node.appendChild(ChildNode) Set ChildNode = XmlDoc.createNode(1,"Board_Input3","") node.appendChild(ChildNode) Set ChildNode = XmlDoc.createNode(1,"Board_Input4","") node.appendChild(ChildNode) End If Set XmlDoc = Nothing Dim Boardid Boardid = "0" If Node.getAttribute("Boardid") <> "" Then Boardid = Node.getAttribute("Boardid") End If %>
    首页调用管理
    调用标识名称： ">(请使用英文或数字设定调用名称,并且是唯一标识.不能超出10个字符)
    调用代码： ">">
    调用说明： ">(提示说明,以作管理区分.不能超出30个字符)
    调用类型：
    数据更新间隔： ">(单位：秒)
    时间显示格式： (按服务器时间区域格式显示。)
    调用设置：
    调用模板设置(请用HTML语法填写)
    模板_开始标记部分
    模板_主体循环标记部分
     模板变量说明 

    模板_结束标记部分
        ">
    <% End Sub Sub NewsList() Set XmlDoc = Server.CreateObject("msxml2.FreeThreadedDOMDocument"& MsxmlVersion) If Not XmlDoc.load(NewsConfigFile) Then ErrMsg = "首页调用列表为空，请添加首页调用后再执行本操作!" Dvbbs_Error() Exit Sub End If Dim SendLogNode,Childs Set SendLogNode = XmlDoc.DocumentElement.SelectNodes("NewsCode") Childs = SendLogNode.Length '列表数 %>
    <% Dim SearchStr,Topic,i i=0 For Each Node in SendLogNode %> <% i=i+1 Next %>
    首页调用列表
    选取 类别 名称 说明 添加时间/更新时间 添加者 操作
    "> <%=NewsCodeType(Node.getAttribute("NewsType"))%> <%=Node.getAttribute("NewsName")%> <%=Node.getAttribute("Intro")%>
    更新时间间隔为：(<%=Node.getAttribute("Updatetime")%>) 秒。     		<%=Node.getAttribute("AddTime")%>
    <%=Node.getAttribute("LastTime")%>    		 <%=Node.getAttribute("MasterName")%>
    <%=Node.getAttribute("MasterIP")%>    		 ');">
    全选
    <% Set XmlDoc = Nothing End Sub Function NewsCodeType(TypeVal) NewsCodeType = "未知" Select Case Cstr(TypeVal) Case "1" NewsCodeType = "帖子" Case "2" NewsCodeType = "信息" Case "3" NewsCodeType = "版块" Case "4" NewsCodeType = "会员" Case "5" NewsCodeType = "公告" Case "6" NewsCodeType = "展区" End Select NewsCodeType = NewsCodeType & "调用" End Function %>