<% Dim Action Dim Errmsg Dim NewsConfigFile Dim popwan_ads,Forum_Api,AdsList Dvbbs.LoadTemplates("") Dvbbs.Stats = "投放广告推广" Dvbbs.Nav() Dvbbs.Head_var 0,0,Plus_Popwan.Program,"plus_popwan_ads.asp" Dvbbs.ActiveOnline() action = Request("action") Page_main() If action<>"frameon" Then Dvbbs.Footer End If Dvbbs.PageEnd() '页面右侧内容部分 Sub Page_Center() If Not (Dvbbs.master Or Dvbbs.GroupSetting(70)="1") Then Dvbbs.AddErrcode(28) Dvbbs.ShowErr() End If Dim act Act = Request("act") NewsConfigFile = Plus_Popwan.FilePath(Plus_Popwan.CachePath&"Temp_Plus_popwan_ads.config") ChkForum_api() Page_main1() Select Case Act Case "addads" '发布广告位 Addads() Case "saveads" '保存广告位 Call saveads() Case "adslist" '我的广告位 Call MyAdsList() Case "editads" '编辑广告位 Call Editads() Case "saveeditads" '保存编辑广告位 Call SaveEditads() Case "restore" '清掉广告 Call Restore() Case Else Addads() End Select End Sub Sub Page_main1() %>
游戏联盟说明
  • 说明①:广告位名称唯一,不能重复;
  • 说明②:请注意选择在页面中显示的位置
发布广告位 | 我的广告位 | 清掉广告

<% End Sub '添加/编辑广告位 Sub Addads() %>
发布广告位信息(以下为必填项)
广告位信息演示:
广告位名称: (例如:xxx网站顶部广告位)
广告形式: 文字广告 图片广告
广告代码:
广告显示位置:
论坛默认广告:(除具体版面内容以外的页面)
选择显示的版面:(请按 CTRL 键进行多选)
选择在页面中显示的位置
页面顶部广告位:
页面底部广告位:
帖子楼主顶部广告位:
帖子楼主左边广告位:
帖子楼主右边广告位:
帖子楼主底部广告位:
广告位置预览
<% End Sub '保存广告位信息 Sub SaveAds() Dim zonename,format,adsize,getboard,adsset,zonedesc Dim homepage zonename = Trim(Request.Form("zonename")) '广告位名称 format = Trim(Request.Form("format")) '广告形式 getboard = Trim(Request.Form("getboard")) '选择显示的版面 adsset = Trim(Request.Form("adsset")) zonedesc = Trim(Request.Form("zonedesc")) '广告代码 '提交信息验证 If zonename=""or Len(zonename)<1 or Len(zonename)>32 Then Errmsg=ErrMsg + "
广告位名称不能为空或超过32个字符!" Response.Redirect "showerr.asp?ErrCodes=
  • "& Errmsg &"&action=OtherErr" Exit Sub End If If format="" or Not IsNumeric(format) Then Errmsg=ErrMsg + "
    请正确选择广告形式!" Response.Redirect "showerr.asp?ErrCodes=
  • "& Errmsg &"&action=OtherErr" Exit Sub End If If zonedesc="" Then Errmsg=ErrMsg + "
    广告代码不能为空!" Response.Redirect "showerr.asp?ErrCodes=
  • "& Errmsg &"&action=OtherErr" Exit Sub End If If adsset = "" or Not Isnumeric(adsset) Then Errmsg=ErrMsg + "
    请选取广告在页面中显示的位置!" Response.Redirect "showerr.asp?ErrCodes=
  • "& Errmsg &"&action=OtherErr" Exit Sub End If If format = "1" and (adsset="3" or adsset="4") Then Errmsg=ErrMsg + "
    文字广告类型,不能设置在浮动或右下固定广告位!" Response.Redirect "showerr.asp?ErrCodes=
  • "& Errmsg &"&action=OtherErr" Exit Sub End If '是否显示在首页类型 homepage = Request.Form("getskinid") '在首页:1 论坛默认广告 Set AdsList = popwan_ads.selectNodes("ads[@name='"&zonename&"']") If AdsList.Length>0 Then Errmsg=ErrMsg + "
    广告位名称不能有重复!" Response.Redirect "showerr.asp?ErrCodes=
  • "& Errmsg &"&action=OtherErr" Exit Sub End If Set AdsList = popwan_ads.selectNodes("ads[@adsset='"&adsset&"' and @getboard='"&getboard&"' ]") If AdsList.Length>0 Then Errmsg=ErrMsg + "
    已经有该相同设置的广告信息,请不要重复新增设置!" Response.Redirect "showerr.asp?ErrCodes=
  • "& Errmsg &"&action=OtherErr" Exit Sub End If '创建一个新的广告数据节点 Set AdsList = popwan_ads.appendChild(Forum_Api.createNode(1,"ads","")) AdsList.setAttribute "createtime",Now() AdsList.setAttribute "updatetime",Now() AdsList.setAttribute "name",zonename AdsList.setAttribute "format",format AdsList.setAttribute "homepage",homepage AdsList.setAttribute "adsset",adsset AdsList.setAttribute "getboard",getboard AdsList.setAttribute "zonedesc",zonedesc Update_Forum_Api() UpdateAdsSeting() Dvbbs.Dvbbs_suc("发布广告位成功!") End Sub '我的广告位 Sub MyAdsList() Set AdsList = popwan_ads.selectNodes("ads") If AdsList.Length=0 Then Errmsg=ErrMsg + "
    暂未有广告位数据!" Response.Redirect "showerr.asp?ErrCodes=
  • "& Errmsg &"&action=OtherErr" Exit Sub End If Dim Node %>
    <% For Each Node In AdsList %> <% Next %>
    我的广告位信息
    广告位名称 广告位形式 创建时间 更新时间 操作
    <%=Node.getAttribute("name")%> <%=adssettype(Node.getAttribute("adsset"))%> <% If IsDate(Node.getAttribute("createtime")) Then Response.Write Formatdatetime(Node.getAttribute("createtime"),0) Else Response.Write Node.getAttribute("createtime") End If %> <% If IsDate(Node.getAttribute("updatetime")) Then Response.Write Formatdatetime(Node.getAttribute("updatetime"),0) Else Response.Write Node.getAttribute("updatetime") End If %> ">编辑
    <% Set AdsList = Nothing End Sub Function adssettype(num) Select Case num Case "1" : adssettype = "页面顶部" Case "2" : adssettype = "页面底部" Case "7" : adssettype = "帖子楼主顶部" Case "8" : adssettype = "帖子楼主左边" Case "9" : adssettype = "帖子楼主右边" Case "10" : adssettype = "帖子楼主底部" Case Else adssettype = "未知" End Select End Function '编辑广告位 Sub Editads() Dim adzoneid Adzoneid = Request.QueryString("name") If Adzoneid<>"" Then Set AdsList = popwan_ads.selectSingleNode("ads[@name='"&Adzoneid&"']") If AdsList is Nothing Then Errmsg=ErrMsg + "
    您需要编辑的广告位不存在!" Response.Redirect "showerr.asp?ErrCodes=
  • "& Errmsg &"&action=OtherErr" Exit Sub End If End If %>
    编辑广告位信息(以下为必填项)
    广告位信息演示:
    广告位名称: " disabled/>(例如:xxx网站顶部广告位)
    广告形式: 文字广告 图片广告
    广告代码:
    广告显示位置:
    论坛默认广告:(除具体版面内容以外的页面)
    选择显示的版面:(请按 CTRL 键进行多选)
    选择在页面中显示的位置
    页面顶部广告位:
    页面底部广告位:
    帖子楼主顶部广告位:
    帖子楼主左边广告位:
    帖子楼主右边广告位:
    帖子楼主底部广告位:
    广告位置预览
    <% End Sub '保存广告位设置 Sub SaveEditads() Dim zonename,format,adsize,getboard,adsset,zonedesc Dim homepage zonename = Trim(Request.Form("zonename")) '广告位名称 format = Trim(Request.Form("format")) '广告形式 getboard = Trim(Request.Form("getboard")) '选择显示的版面 adsset = Trim(Request.Form("adsset")) zonedesc = Trim(Request.Form("zonedesc")) '广告代码 '提交信息验证 If format="" or Not IsNumeric(format) Then Errmsg=ErrMsg + "
    请正确选择广告形式!" Response.Redirect "showerr.asp?ErrCodes=
  • "& Errmsg &"&action=OtherErr" Exit Sub End If If zonedesc="" Then Errmsg=ErrMsg + "
    广告代码不能为空!" Response.Redirect "showerr.asp?ErrCodes=
  • "& Errmsg &"&action=OtherErr" Exit Sub End If If adsset = "" or Not Isnumeric(adsset) Then Errmsg=ErrMsg + "
    请选取广告在页面中显示的位置!" Response.Redirect "showerr.asp?ErrCodes=
  • "& Errmsg &"&action=OtherErr" Exit Sub End If If format = "1" and (adsset="3" or adsset="4") Then Errmsg=ErrMsg + "
    文字广告类型,不能设置在浮动或右下固定广告位!" Response.Redirect "showerr.asp?ErrCodes=
  • "& Errmsg &"&action=OtherErr" Exit Sub End If '是否显示在首页类型 homepage = Request.Form("getskinid") '在首页:1 论坛默认广告 Set AdsList = popwan_ads.selectSingleNode("ads[@adzoneid="&Adzoneid&"]") If AdsList is Nothing Then Errmsg=ErrMsg + "
    您需要编辑的广告位不存在!" Response.Redirect "showerr.asp?ErrCodes=
  • "& Errmsg &"&action=OtherErr" Exit Sub End If AdsList.setAttribute "updatetime",Now() AdsList.setAttribute "format",format AdsList.setAttribute "homepage",homepage AdsList.setAttribute "adsset",adsset AdsList.setAttribute "getboard",getboard AdsList.setAttribute "zonedesc",zonedesc Update_Forum_Api() UpdateAdsSeting() Dvbbs.Dvbbs_suc("广告位置修改成功!") End Sub '测试用 Sub Restore() Set Forum_Api = Server.CreateObject("Msxml2.FreeThreadedDOMDocument"& MsxmlVersion) Forum_Api.LoadXml("") Set popwan_ads = Forum_Api.documentElement.appendChild(Forum_Api.createNode(1,"popwan_ads","")) popwan_ads.setAttribute "memberid","" popwan_ads.setAttribute "email","" popwan_ads.setAttribute "password","" popwan_ads.setAttribute "nickname","" popwan_ads.setAttribute "webname","" Update_Forum_Api() End Sub Sub ChkForum_api() Set Forum_Api = Dvbbs.CreateXmlDoc("msxml2.FreeThreadedDOMDocument"& MsxmlVersion) If Not Forum_Api.load(NewsConfigFile) Then Creat_Forum_Api() Else Set Forum_Api = Server.CreateObject("Msxml2.FreeThreadedDOMDocument"& MsxmlVersion) Forum_Api.load(NewsConfigFile) Set popwan_ads = Forum_Api.documentElement.selectSingleNode("popwan_ads") End If End Sub Sub Creat_Forum_Api() Set Forum_Api = Server.CreateObject("Msxml2.FreeThreadedDOMDocument"& MsxmlVersion) Forum_Api.LoadXml("") Set popwan_ads = Forum_Api.documentElement.appendChild(Forum_Api.createNode(1,"popwan_ads","")) popwan_ads.setAttribute "memberid","" popwan_ads.setAttribute "email","" popwan_ads.setAttribute "password","" popwan_ads.setAttribute "nickname","" popwan_ads.setAttribute "webname","" Update_Forum_Api() End Sub Sub Update_Forum_Api() Forum_Api.save NewsConfigFile Set Forum_Api=Nothing End Sub '设置广告位数据在页面显示的位置 Sub UpdateAdsSeting() Dim iSetting,i,Forum_ads Dim adsset,adsstr Dim Sql '广告代码字串 'mm_alimama会员id_网站id_广告位id adsset = AdsList.getAttribute("adsset") Adsstr = AdsList.getAttribute("zonedesc") Adsstr = Replace(Adsstr,"$","") '过滤未完整 If AdsList.getAttribute("homepage")="1" Then For i = 0 To 30 iSetting = Trim(Dvbbs.Forum_ads(i)) If (i = 2 or i = 7 or i = 13 or i=12 or i=15 or i = 17) and Dvbbs.Forum_ads(i)="" Then iSetting = 0 If adsset = "1" and i=0 Then '顶部 iSetting = adsstr End If If adsset = "2" and i=1 Then '底部 iSetting = adsstr End If If adsset = "7" Then '帖子楼主顶部广告位 If i = 18 Then iSetting = 1 '开启帖子楼主顶部广告位 End If If i = 19 Then iSetting = Adsstr End If End If If adsset = "8" Then '帖子楼主左边广告位 If i = 22 Then iSetting = 1 '开启帖子楼主左边广告位 End If If i = 23 Then iSetting = Adsstr End If End If If adsset = "9" Then '帖子楼主右边广告位 If i = 22 Then iSetting = 2 '开启帖子楼主右边广告位 End If If i = 23 Then iSetting = Adsstr End If End If If adsset = "10" Then '帖子楼主底部广告位 If i = 20 Then iSetting = 1 '开启帖子楼主底部广告位 End If If i = 21 Then iSetting = Adsstr End If End If If i = 0 Then Forum_ads = iSetting Else Forum_ads = Forum_ads & "$" & iSetting End If Next Sql = "Update Dv_Setup Set Forum_ads='"&Replace(Forum_ads,"'","''")&"'" Dvbbs.Execute(sql) End If If AdsList.getAttribute("getboard")<>"" Then '查获更新版面数据,只更新设置投放广告项,避免清空原广告其他设置 Dim Rs Set Rs = Dvbbs.Execute("select Boardid,Board_Ads from Dv_board where boardid in ("&Dvbbs.Checkstr(AdsList.getAttribute("getboard"))&")") do while not rs.eof Dvbbs.Forum_ads = Split(Rs(1),"$") For i = 0 To 30 iSetting = Trim(Dvbbs.Forum_ads(i)) If (i = 2 or i = 7 or i = 13 or i=12 or i=15 or i = 17) and Dvbbs.Forum_ads(i)="" Then iSetting = 0 If adsset = "1" and i=0 Then '顶部 iSetting = adsstr End If If adsset = "2" and i=1 Then '底部 iSetting = adsstr End If If adsset = "7" Then '帖子楼主顶部广告位 If i = 18 Then iSetting = 1 '开启帖子楼主顶部广告位 End If If i = 19 Then iSetting = Adsstr End If End If If adsset = "8" Then '帖子楼主左边广告位 If i = 22 Then iSetting = 1 '开启帖子楼主左边广告位 End If If i = 23 Then iSetting = Adsstr End If End If If adsset = "9" Then '帖子楼主右边广告位 If i = 22 Then iSetting = 2 '开启帖子楼主右边广告位 End If If i = 23 Then iSetting = Adsstr End If End If If adsset = "10" Then '帖子楼主底部广告位 If i = 20 Then iSetting = 1 '开启帖子楼主底部广告位 End If If i = 21 Then iSetting = Adsstr End If End If If i = 0 Then Forum_ads = iSetting Else Forum_ads = Forum_ads & "$" & iSetting End If Next Sql = "Update Dv_Board Set Board_Ads='"&Replace(Forum_ads,"'","''")&"' Where BoardID ="&Rs(0) Dvbbs.Execute(Sql) Rs.movenext Loop Rs.close Set Rs = Nothing End If RestoreBoardCache() Dvbbs.loadSetup() End Sub '更新版面广告缓存数据 Sub RestoreBoardCache() Dim Board,node Dvbbs.LoadBoardList() For Each node in Application(Dvbbs.CacheName &"_style").documentElement.selectNodes("style/@id") Application.Contents.Remove(Dvbbs.CacheName & "_showtextads_"&node.text) For Each board in Application(Dvbbs.CacheName&"_boardlist").documentElement.selectNodes("board/@boardid") Dvbbs.LoadBoardData board.text Application.Contents.Remove(dvbbs.CacheName & "_Text_ad_"& board.text &"_"&node.text) Application.Contents.Remove(dvbbs.CacheName & "_Text_ad_"& board.text &"_"&node.text&"_-time") Next Application.Contents.Remove(dvbbs.CacheName & "_Text_ad_0_"& node.text) Application.Contents.Remove(dvbbs.CacheName & "_Text_ad_0_"& node.text&"_-time") Next End Sub %>