📄 admin_special.asp

📁 个人网站比较简短
💻 ASP
📖 第 1 页 / 共 5 页
字号:
        FoundErr = True
        ErrMsg = ErrMsg & "<li>请指定要修改的专题ID！</li>"
        Exit Sub
    Else
        SpecialID = PE_CLng(SpecialID)
    End If
    If UseCreateHTML > 0 Then
        Dim trs, SpecialDir
        Set trs = Conn.Execute("select SpecialDir from PE_Special where SpecialID=" & SpecialID)
        SpecialDir = trs(0)
        Set trs = Nothing
        Call DelSpecialDir(SpecialDir)
    End If
    If FoundErr = True Then Exit Sub

    Dim rsInfo
    Set rsInfo = Conn.Execute("select * from PE_InfoS where SpecialID=" & SpecialID & " order by InfoID desc")
    Do While Not rsInfo.EOF
        If PE_CLng(Conn.Execute("select count(InfoID) from PE_InfoS where ModuleType=" & rsInfo("ModuleType") & " and ItemID=" & rsInfo("ItemID") & "")(0)) > 1 Then
            Conn.Execute ("delete from PE_InfoS where InfoID=" & rsInfo("InfoID") & "")
        Else
            Conn.Execute ("update PE_InfoS set SpecialID=0 where InfoID=" & rsInfo("InfoID") & "")
        End If
        rsInfo.MoveNext
    Loop
    rsInfo.Close
    Set rsInfo = Nothing

    Conn.Execute ("delete from PE_Special where SpecialID=" & SpecialID)
    Conn.Execute ("update PE_Channel set SpecialCount=SpecialCount-1 where ChannelID=" & ChannelID & "")
    Call CreateJS_Special
    Call CloseConn
    Response.Redirect "Admin_Special.asp?ChannelID=" & ChannelID
End Sub

Sub DelSpecialDir(DirName)
    On Error Resume Next
    If ObjInstalled_FSO = False Then
        Exit Sub
    End If
    Dim tmpDir
    tmpDir = InstallDir & ChannelDir & "/Special/" & DirName
    If fso.FolderExists(Server.MapPath(tmpDir)) Then
        fso.DeleteFolder Server.MapPath(tmpDir)
    End If
    If Err Then
        Error.Clear
        FoundErr = True
        ErrMsg = ErrMsg & "<li>专题目录无法删除！可能有文件正在使用中。请稍后再试！</li>"
    End If
End Sub

Sub DelSpecialDir1()
    Dim SpecialID, rsSpecial, sql
    SpecialID = PE_CLng(Trim(Request("SpecialID")))
    If SpecialID = 0 Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>请指定要修改的专题ID！</li>"
        Exit Sub
    End If
    sql = "Select SpecialDir from PE_Special Where SpecialID=" & SpecialID
    Set rsSpecial = Server.CreateObject("Adodb.RecordSet")
    rsSpecial.Open sql, Conn, 1, 3
    If rsSpecial.BOF And rsSpecial.EOF Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>找不到指定的专题，可能已经被删除！</li>"
        rsSpecial.Close
        Set rsSpecial = Nothing
    Else
        Call DelSpecialDir(rsSpecial(0))
    End If
    rsSpecial.Close
    Set rsSpecial = Nothing

    If FoundErr = False Then Call WriteSuccessMsg("删除专题目录成功！", ComeUrl)
End Sub

Sub ClearSpecial()
    Dim SpecialID
    SpecialID = Trim(Request("SpecialID"))
    If SpecialID = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>请指定要修改的专题ID！</li>"
        Exit Sub
    Else
        SpecialID = PE_CLng(SpecialID)
    End If
    If UseCreateHTML > 0 Then
        Dim trs, SpecialDir
        Set trs = Conn.Execute("select SpecialDir from PE_Special where SpecialID=" & SpecialID)
        SpecialDir = trs(0)
        Set trs = Nothing
        Call ClearSpecialDir(SpecialDir)
    End If
    If FoundErr = True Then Exit Sub

    Dim rsInfo
    Set rsInfo = Conn.Execute("select * from PE_InfoS where SpecialID=" & SpecialID & " order by InfoID desc")
    Do While Not rsInfo.EOF
        If PE_CLng(Conn.Execute("select count(InfoID) from PE_InfoS where ModuleType=" & rsInfo("ModuleType") & " and ItemID=" & rsInfo("ItemID") & "")(0)) > 1 Then
            Conn.Execute ("delete from PE_InfoS where InfoID=" & rsInfo("InfoID") & "")
        Else
            Conn.Execute ("update PE_InfoS set SpecialID=0 where InfoID=" & rsInfo("InfoID") & "")
        End If
        rsInfo.MoveNext
    Loop
    rsInfo.Close
    Set rsInfo = Nothing
    
    Call CloseConn
    Response.Redirect "Admin_Special.asp?ChannelID=" & ChannelID
End Sub

Sub ClearSpecialDir(DirName)
    On Error Resume Next
    If ObjInstalled_FSO = False Then
        Exit Sub
    End If
    Dim tmpDir
    tmpDir = InstallDir & ChannelDir & "/Special/" & DirName
    If fso.FolderExists(Server.MapPath(tmpDir)) Then
        fso.DeleteFile Server.MapPath(tmpDir) & "\*.*"
    End If
    If Err Then
        Error.Clear
        FoundErr = True
        ErrMsg = ErrMsg & "<li>无法完全清除此专题目录下的文件！可能有文件正在使用中。请稍后再试！</li>"
    End If
End Sub

Sub UpOrder()
    Dim SpecialID, sqlOrder, rsOrder, MoveNum, cOrderID, tOrderID, i, rsSpecial
    SpecialID = Trim(Request("SpecialID"))
    cOrderID = Trim(Request("cOrderID"))
    MoveNum = Trim(Request("MoveNum"))
    If SpecialID = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>参数不足！</li>"
    Else
        SpecialID = PE_CLng(SpecialID)
    End If
    If cOrderID = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>错误参数！</li>"
    Else
        cOrderID = CInt(cOrderID)
    End If
    If MoveNum = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>错误参数！</li>"
    Else
        MoveNum = CInt(MoveNum)
        If MoveNum = 0 Then
            FoundErr = True
            ErrMsg = ErrMsg & "<li>请选择要提升的数字！</li>"
        End If
    End If
    If FoundErr = True Then
        Exit Sub
    End If

    Dim mrs, MaxOrderID
    Set mrs = Conn.Execute("select max(OrderID) from PE_Special")
    MaxOrderID = mrs(0) + 1
    '先将当前专题移至最后，包括子专题
    Conn.Execute ("update PE_Special set OrderID=" & MaxOrderID & " where SpecialID=" & SpecialID)
    
    '然后将位于当前专题以上的专题的OrderID依次加一，范围为要提升的数字
    sqlOrder = "select * from PE_Special where OrderID<" & cOrderID & " order by OrderID desc"
    Set rsOrder = Server.CreateObject("adodb.recordset")
    rsOrder.Open sqlOrder, Conn, 1, 3
    If rsOrder.BOF And rsOrder.EOF Then
        Exit Sub        '如果当前专题已经在最上面，则无需移动
    End If
    i = 1
    Do While Not rsOrder.EOF
        tOrderID = rsOrder("OrderID")     '得到要提升位置的OrderID，包括子专题
        Conn.Execute ("update PE_Special set OrderID=OrderID+1 where OrderID=" & tOrderID)
        i = i + 1
        If i > MoveNum Then
            Exit Do
        End If
        rsOrder.MoveNext
    Loop
    rsOrder.Close
    Set rsOrder = Nothing
    
    '然后再将当前专题从最后移到相应位置，包括子专题
    Conn.Execute ("update PE_Special set OrderID=" & tOrderID & " where SpecialID=" & SpecialID)
    Call CreateJS_Special
    Call CloseConn
    Response.Redirect "Admin_Special.asp?Action=Order&ChannelID=" & ChannelID
End Sub

Sub DownOrder()
    Dim SpecialID, sqlOrder, rsOrder, MoveNum, cOrderID, tOrderID, i, rsSpecial, PrevID, NextID
    SpecialID = Trim(Request("SpecialID"))
    cOrderID = Trim(Request("cOrderID"))
    MoveNum = Trim(Request("MoveNum"))
    If SpecialID = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>参数不足！</li>"
    Else
        SpecialID = PE_CLng(SpecialID)
    End If
    If cOrderID = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>错误参数！</li>"
    Else
        cOrderID = CInt(cOrderID)
    End If
    If MoveNum = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>错误参数！</li>"
    Else
        MoveNum = CInt(MoveNum)
        If MoveNum = 0 Then
            FoundErr = True
            ErrMsg = ErrMsg & "<li>请选择要提升的数字！</li>"
        End If
    End If
    If FoundErr = True Then
        Exit Sub
    End If

    Dim mrs, MaxOrderID
    Set mrs = Conn.Execute("select max(OrderID) from PE_Special")
    MaxOrderID = mrs(0) + 1
    '先将当前专题移至最后，包括子专题
    Conn.Execute ("update PE_Special set OrderID=" & MaxOrderID & " where SpecialID=" & SpecialID)
    
    '然后将位于当前专题以下的专题的OrderID依次减一，范围为要下降的数字
    sqlOrder = "select * from PE_Special where OrderID>" & cOrderID & " order by OrderID"
    Set rsOrder = Server.CreateObject("adodb.recordset")
    rsOrder.Open sqlOrder, Conn, 1, 3
    If rsOrder.BOF And rsOrder.EOF Then
        Exit Sub        '如果当前专题已经在最下面，则无需移动
    End If
    i = 1
💿 文件大小 7095 K
👤 上传用户 foreverlovely
📂 所属分类家庭/个人应用
🏷️ 相关标签

#网站 #比较
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -