admin_advertisement.asp

个人网站比较简短

        Response.Write "    <td width='200'><strong>开始位置（上）：</strong></td>"
        Response.Write "    <td>"
        Response.Write "      <input name='Float_Top' type='text' id='Float_Top' size='5' maxlength='4' value='" & GetSettingItem(Setting, 5, 3) & "'>"
        Response.Write "    </td>"
        Response.Write "  </tr>"
        Response.Write "</table>"
    Case 6
        Response.Write "<table width='100%' border='0' cellpadding='2' cellspacing='1' bgcolor='#ffffff'>"
        Response.Write "  <tr align='center' class='tdbg2'>"
        Response.Write "    <td colspan='2'><strong>版位参数设置--" & ZoneConfig(6, 1) & "</strong></td>"
        Response.Write "  </tr>"
        Response.Write "  <tr class='tdbg'>"
        Response.Write "    <td colspan='2' align='center'>此类型无版位参数设置！</td>"
        Response.Write "  </tr>"
        Response.Write "</table>"
    Case 7
        Response.Write "<table width='100%' border='0' cellpadding='2' cellspacing='1' bgcolor='#ffffff'>"
        Response.Write "  <tr align='center' class='tdbg2'>"
        Response.Write "    <td colspan='2'><strong>版位参数设置--" & ZoneConfig(7, 1) & "</strong></td>"
        Response.Write "  </tr>"
        Response.Write "  <tr class='tdbg'>"
        Response.Write "    <td colspan='2' align='center'>此类型无版位参数设置！</td>"
        Response.Write "  </tr>"
        Response.Write "</table>"
    Case 8
        Response.Write "<table width='100%' border='0' cellpadding='2' cellspacing='1' bgcolor='#ffffff'>"
        Response.Write "  <tr align='center' class='tdbg2'>"
        Response.Write "    <td colspan='2'><strong>版位参数设置--" & ZoneConfig(8, 1) & "</strong></td>"
        Response.Write "  </tr>"
        Response.Write "  <tr class='tdbg'>"
        Response.Write "    <td colspan='2' align='center'>此类型无版位参数设置！</td>"
        Response.Write "  </tr>"
        Response.Write "</table>"
    Case 9
        Response.Write "<table width='100%' border='0' cellpadding='2' cellspacing='1' bgcolor='#ffffff'>"
        Response.Write "  <tr align='center' class='tdbg2'>"
        Response.Write "    <td colspan='2'><strong>版位参数设置--" & ZoneConfig(9, 1) & "</strong></td>"
        Response.Write "  </tr>"
        Response.Write "  <tr class='tdbg'>"
        Response.Write "    <td colspan='2' align='center'>此类型无版位参数设置！</td>"
        Response.Write "  </tr>"
        Response.Write "</table>"
    End Select
End Sub

Sub SaveZone()
    Dim ZoneID, ChannelID, ZoneName, ZoneJSName, ZoneIntro, ZoneType, DefaultSetting, ZoneSetting, ZoneWidth, ZoneHeight, ShowType, Active
    Dim rsZone, sqlZone
    ZoneID = PE_CLng(Trim(Request.Form("ZoneID")))
    ChannelID = PE_CLng(Trim(Request.Form("ChannelID")))
    ZoneName = Trim(Request.Form("ZoneName"))
    ZoneJSName = Trim(Request.Form("ZoneJSName"))
    ZoneIntro = Trim(Request.Form("ZoneIntro"))
    ZoneType = PE_CLng(Trim(Request.Form("ZoneType")))
    DefaultSetting = CBool(Trim(Request.Form("DefaultSetting")))
    ZoneWidth = PE_CLng(Trim(Request.Form("ZoneWidth")))
    ZoneHeight = PE_CLng(Trim(Request.Form("ZoneHeight")))
    ShowType = PE_CLng(Trim(Request.Form("ShowType")))
    Active = Trim(Request.Form("Active"))

    If ZoneName = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>版位名称不能为空！</li>"
    End If
    If CheckZoneJSName(ZoneJSName) = False Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>输入的JS文件名不符合要求<br>&nbsp;&nbsp;文件名中只能包含英文字母、数字、下划线及“-”符号<br>&nbsp;&nbsp;只支持一级路径，并且要使用相对路径地址</li>"
    End If
    If FoundErr = True Then Exit Sub

    If DefaultSetting = True Then
        ZoneSetting = ZoneConfig(ZoneType, 2)
    Else
        Select Case ZoneType
        Case 1
            ZoneSetting = ZoneType
        Case 2
            ZoneSetting = ZoneType & "," & RequestSetting("Pop_PopType") & "," & RequestSetting("Pop_Left") & "," & RequestSetting("Pop_Top") & "," & RequestSetting("Pop_CookieHour")
        Case 3
            ZoneSetting = ZoneType & "," & RequestSetting("Move_Left") & "," & RequestSetting("Move_Top") & "," & RequestSetting("Move_Delta")
        Case 4
            ZoneSetting = ZoneType & "," & RequestSetting("Fixed_Left") & "," & RequestSetting("Fixed_Top")
        Case 5
            ZoneSetting = ZoneType & "," & RequestSetting("Float_Type") & "," & RequestSetting("Float_Left") & "," & RequestSetting("Float_Top")
        Case 6
            ZoneSetting = ZoneType
        End Select
    End If

    ZoneName = PE_HTMLEncode(ZoneName)
    ZoneIntro = PE_HTMLEncode(ZoneIntro)
    ZoneSetting = PE_HTMLEncode(ZoneSetting)
    Active = CBool(Active = "yes")
    If (ShowType = 3 And ZoneType <> 1) Or ShowType = 0 Then ShowType = 1

    Set rsZone = Server.CreateObject("adodb.recordset")
    If Action = "SaveAddZone" Then
        sqlZone = "select top 1 * from PE_AdZone"
        rsZone.Open sqlZone, Conn, 1, 3
        rsZone.addnew
        ZoneID = PE_CLng(Conn.Execute("select max(ZoneID) from PE_AdZone")(0)) + 1
        rsZone("ZoneID") = ZoneID
        rsZone("UpdateTime") = Now()
    ElseIf Action = "SaveModifyZone" Then
        If ZoneID = 0 Then
            FoundErr = True
            ErrMsg = ErrMsg & "<li>不能确定版位ID的值</li>"
            Exit Sub
        End If
        sqlZone = "select * from PE_AdZone where ZoneID=" & ZoneID
        rsZone.Open sqlZone, Conn, 1, 3
        If rsZone.BOF And rsZone.EOF Then
            FoundErr = True
            ErrMsg = ErrMsg & "<li>找不到指定的版位！</li>"
            rsZone.Close
            Set rsZone = Nothing
            Exit Sub
        End If
    End If
    rsZone("ChannelID") = ChannelID
    rsZone("ZoneName") = ZoneName
    rsZone("ZoneJSName") = ZoneJSName
    rsZone("ZoneIntro") = ZoneIntro
    rsZone("ZoneType") = ZoneType
    rsZone("DefaultSetting") = DefaultSetting
    rsZone("ZoneSetting") = ZoneSetting
    rsZone("ZoneWidth") = ZoneWidth
    rsZone("ZoneHeight") = ZoneHeight
    rsZone("ShowType") = ShowType
    rsZone("Active") = Active
    rsZone.Update
    rsZone.Close
    Set rsZone = Nothing

    Call WriteEntry(2, AdminName, "保存广告版位设置成功：" & ZoneName)

    Call CreateJSZoneID(ZoneID)

    Call ClearSiteCache(0)
    Call CloseConn
    Response.Redirect "Admin_Advertisement.asp?Action=ZoneList&ChannelID=" & ChannelID
End Sub

Sub SetZoneProperty()
    If ZoneID = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>请指定版位ID</li>"
        Exit Sub
    End If
    If Action = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>参数不足！</li>"
        Exit Sub
    End If

    Dim sqlProperty, rsProperty
    Dim MoveChannelID
    If InStr(ZoneID, ",") > 0 Then
        sqlProperty = "select * from PE_AdZone where ZoneID in (" & ZoneID & ")"
    Else
        sqlProperty = "select * from PE_AdZone where ZoneID=" & ZoneID
    End If
    Set rsProperty = Server.CreateObject("ADODB.Recordset")
    rsProperty.Open sqlProperty, Conn, 1, 3
    Do While Not rsProperty.EOF
        Select Case Action
        Case "SetZoneActive"
            rsProperty("Active") = True
        Case "CancelZoneActive"
            rsProperty("Active") = False
        Case "MoveZone"
            MoveChannelID = Trim(Request("ChannelID"))
            If MoveChannelID = "" Then
                MoveChannelID = -1
            Else
                MoveChannelID = PE_CLng(MoveChannelID)
            End If
            rsProperty("ChannelID") = MoveChannelID
        Case "DelZone"
            Call DelZoneID_AD(rsProperty("IncludeADID"), rsProperty("ZoneID"))
            Dim ZoneJSFile
            ZoneJSFile = GetZoneJSName(rsProperty("ZoneJSName"), rsProperty("ZoneID"), rsProperty("UpdateTime"))
            If fso.FileExists(Server.MapPath(ZoneJSFile)) Then
                fso.DeleteFile Server.MapPath(ZoneJSFile)
            End If
            rsProperty.Delete
        End Select
        rsProperty.Update
        rsProperty.MoveNext
    Loop
    rsProperty.Close
    Set rsProperty = Nothing

    If Action = "SetZoneActive" Or Action = "CancelZoneActive" Then
        Call CreateJSZoneID(ZoneID)
    End If
    Call WriteEntry(2, AdminName, "设置广告版位属性成功，版位ID：" & ZoneID)

    Call ClearSiteCache(0)
    Call CloseConn
    Response.Redirect ComeUrl
End Sub

Sub CopyZone()
    Dim MaxZoneID
    ZoneID = PE_CLng(ZoneID)
    If ZoneID = 0 Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>参数不足！</li>"
        Exit Sub
    End If
    
    MaxZoneID = PE_CLng(Conn.Execute("select max(ZoneID) from PE_AdZone")(0)) + 1
    Conn.Execute ("insert into PE_AdZone select " & MaxZoneID & " as ZoneID,ChannelID,'' as IncludeADID,'复制 '+ZoneName as ZoneName,'" & GetCurrentZoneJSName() & "' as ZoneJSName,ZoneIntro,ZoneType,DefaultSetting,ZoneSetting,ZoneWidth,ZoneHeight,Active,ShowType,UpdateTime from PE_AdZone where ZoneID=" & ZoneID)
    Call WriteEntry(2, AdminName, "复制广告版位成功，版位ID：" & ZoneID)
    Response.Redirect ComeUrl
End Sub

Sub ClearZone()
    If ZoneID = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>参数不足！</li>"
        Exit Sub
    Else
        ZoneID = PE_CLng(ZoneID)
    End If

    Dim rs, IncludeADID
    Set rs = Conn.Execute("select IncludeADID from PE_AdZone where ZoneID=" & ZoneID)
    If rs.BOF And rs.EOF Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>版位不存在，或者已经被删除</li>"
    Else
        IncludeADID = rs(0)
    End If
    rs.Close
    Set rs = Nothing
    If FoundErr = Tr