⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 admin_friendsite.asp

📁 个人网站比较简短
💻 ASP
📖 第 1 页 / 共 5 页
字号:
🔍
12345 
    rsFriendSite("UpdateTime") = UpdateTime
    rsFriendSite("Elite") = Elite
    rsFriendSite("Passed") = Passed
    rsFriendSite.Update
    rsFriendSite.Close
    Set rsFriendSite = Nothing
    Call ClearSiteCache(0)
    Call CloseConn
    Response.Redirect "Admin_FriendSite.asp"
End Sub

Sub SetProperty()
    Dim ID, sqlProperty, rsProperty
    ID = Trim(Request("ID"))
    If IsValidID(ID) = False Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>请先选定友情链接！</li>"
        Exit Sub
    End If
    If Action = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>参数不足！</li>"
        Exit Sub
    End If

    If InStr(ID, ",") > 0 Then
        sqlProperty = "select * from PE_FriendSite where ID in (" & ID & ")"
    Else
        sqlProperty = "select * from PE_FriendSite where ID=" & ID
    End If
    Set rsProperty = Server.CreateObject("ADODB.Recordset")
    rsProperty.Open sqlProperty, Conn, 1, 3
    Do While Not rsProperty.EOF
        Select Case Action
        Case "SetElite"
            rsProperty("Elite") = True
        Case "CancelElite"
            rsProperty("Elite") = False
        Case "SetPassed"
            rsProperty("Passed") = True
        Case "CancelPassed"
            rsProperty("Passed") = False
        Case "Del"
            rsProperty.Delete
        End Select
        rsProperty.Update
        rsProperty.MoveNext
    Loop
    rsProperty.Close
    Set rsProperty = Nothing
    
    Call ClearSiteCache(0)
    Call CloseConn
    Response.Redirect ComeUrl
End Sub

Sub MoveToKind()
    Dim ID
    ID = Trim(Request("ID"))
    If IsValidID(ID) = False Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>请选择要移动的友情链接！</li>"
        Exit Sub
    End If
    If KindID = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>请指定目标类别！</li>"
        Exit Sub
    Else
        KindID = PE_CLng(KindID)
    End If
    If KindType = 1 Then
        Conn.Execute ("update PE_FriendSite set KindID=" & KindID & " where ID in (" & ID & ")")
    ElseIf KindType = 2 Then
        Conn.Execute ("update PE_FriendSite set SpecialID=" & KindID & " where ID in (" & ID & ")")
    End If
    Call ClearSiteCache(0)
    Call CloseConn
    Response.Redirect ComeUrl
End Sub


Sub FsKind()
    Dim rsFsKind, sqlFsKind
    Response.Write "<br>"
    Response.Write "<table width='100%' border='0' align='center' cellpadding='0' cellspacing='1' class='border'>"
    Response.Write "  <tr class='title' height='22'>"
    Response.Write "    <td width='30' align='center'><strong>ID</strong></td>"
    Response.Write "    <td width='200' align='center'><strong>" & KindTypeName & "名称</strong></td>"
    Response.Write "    <td align='center'><strong>" & KindTypeName & "说明</strong></td>"
    Response.Write "    <td width='80' align='center'><strong>包含链接数</strong></td>"
    Response.Write "    <td width='120' align='center'><strong>常规操作</strong></td>"
    Response.Write "  </tr>"

    sqlFsKind = "select * from PE_FsKind where KindType=" & KindType & " order by KindID"
    Set rsFsKind = Conn.Execute(sqlFsKind)
    Do While Not rsFsKind.EOF
        Response.Write "  <tr class='tdbg' onmouseout=""this.className='tdbg'"" onmouseover=""this.className='tdbgmouseover'"">"
        Response.Write "    <td width='30' align='center'>" & rsFsKind("KindID") & "</td>"
        Response.Write "    <td width='200' align='center'>"
        Response.Write "      <a href='Admin_FriendSite.asp?KindID=" & rsFsKind("KindID") & "' title='点击进入管理此" & KindTypeName & "的友情链接'>" & PE_HTMLEncode(rsFsKind("KindName")) & "</a>"
        Response.Write "    </td>"
        Response.Write "    <td>" & rsFsKind("ReadMe") & "</td>"
        Response.Write "    <td width='80' align='center'>" & GetLinkNum(KindType, rsFsKind("KindID")) & "</td>"
        Response.Write "    <td width='120' align='center'>"
        Response.Write "      <a href='Admin_FriendSite.asp?action=ModifyFsKind&KindType=" & KindType & "&KindID=" & rsFsKind("KindID") & "'>修改</a>&nbsp;"
        Response.Write "      <a href='Admin_FriendSite.asp?Action=DelFsKind&KindType=" & KindType & "&KindID=" & rsFsKind("KindID") & "' onClick=""return confirm('确定要删除此" & KindTypeName & "吗？删除此" & KindTypeName & "后原属于此" & KindTypeName & "的友情链接将不属于任何" & KindTypeName & "。');"">删除</a>&nbsp;"
        Response.Write "      <a href='Admin_FriendSite.asp?Action=ClearFsKind&KindType=" & KindType & "&KindID=" & rsFsKind("KindID") & "' onClick=""return confirm('确定要清空此" & KindTypeName & "中的友情链接吗？本操作将原属于此" & KindTypeName & "的友情链接改为不属于任何" & KindTypeName & "。');"">清空</a>"
        Response.Write "    </td>"
        Response.Write "  </tr>"
        rsFsKind.MoveNext
    Loop
    rsFsKind.Close
    Set rsFsKind = Nothing
    Response.Write "</table>"
End Sub

Sub AddFsKind()
    Response.Write "<form name='myform' method='post' action='Admin_FriendSite.asp'>"
    Response.Write "  <table width='100%' border='0' align='center' cellpadding='2' cellspacing='1' class='border' >"
    Response.Write "    <tr class='title'>"
    Response.Write "      <td height='22' colspan='2' align='center'><strong>添加友情链接" & KindTypeName & "</strong></td>"
    Response.Write "    </tr>"
    Response.Write "    <tr class='tdbg'>"
    Response.Write "      <td width='350' class='tdbg'><strong>" & KindTypeName & "名称：</strong></td>"
    Response.Write "      <td class='tdbg'>"
    Response.Write "        <input name='KindName' type='text' id='KindName' size='49' maxlength='30'>"
    Response.Write "      </td>"
    Response.Write "    </tr>"
    Response.Write "    <tr class='tdbg'>"
    Response.Write "      <td width='350' class='tdbg'><strong>" & KindTypeName & "说明</strong><br>鼠标移至" & KindTypeName & "名称上时将显示设定的说明文字（不支持HTML）</td>"
    Response.Write "      <td class='tdbg'>"
    Response.Write "        <textarea name='ReadMe' cols='40' rows='5' id='ReadMe'></textarea>"
    Response.Write "      </td>"
    Response.Write "    </tr>"
    Response.Write "    <tr class='tdbg'>"
    Response.Write "      <td colspan='2' align='center' class='tdbg'>"
    Response.Write "        <input name='Action' type='hidden' id='Action' value='SaveAddFsKind'>"
    Response.Write "        <input name='KindType' type='hidden' id='KindType' value='" & KindType & "'>"
    Response.Write "        <input  type='submit' name='Submit' value=' 添 加 '>&nbsp;&nbsp;"
    Response.Write "        <input name='Cancel' type='button' id='Cancel' value=' 取 消 ' onClick=""window.location.href='Admin_FriendSite.asp'"" style='cursor:hand;'>"
    Response.Write "      </td>"
    Response.Write "    </tr>"
    Response.Write "  </table>"
    Response.Write "</form>"
End Sub

Sub ModifyFsKind()
    If KindID = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>请指定要修改的" & KindTypeName & "ID！</li>"
        Exit Sub
    Else
        KindID = PE_CLng(KindID)
    End If
    Dim rsFsKind, sqlFsKind
    sqlFsKind = "Select * from PE_FsKind Where KindID=" & KindID
    Set rsFsKind = Conn.Execute(sqlFsKind)
    If rsFsKind.BOF And rsFsKind.EOF Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>找不到指定的" & KindTypeName & "！</li>"
        rsFsKind.Close
        Set rsFsKind = Nothing
        Exit Sub
    End If

    Response.Write "<form name='myform' method='post' action='Admin_FriendSite.asp'>"
    Response.Write "  <table width='100%' border='0' align='center' cellpadding='2' cellspacing='1' class='border' >"
    Response.Write "    <tr class='title'>"
    Response.Write "      <td height='22' colspan='2' align='center'><strong>修改友情链接" & KindTypeName & "</strong></td>"
    Response.Write "    </tr>"
    Response.Write "    <tr class='tdbg'>"
    Response.Write "      <td width='350' class='tdbg'><strong>" & KindTypeName & "名称：</strong></td>"
    Response.Write "      <td class='tdbg'>"
    Response.Write "        <input name='KindName' type='text' id='KindName' size='49' maxlength='30' value='" & rsFsKind("KindName") & "'>"
    Response.Write "      </td>"
    Response.Write "    </tr>"
    Response.Write "    <tr class='tdbg'>"
    Response.Write "      <td width='350' class='tdbg'><strong>" & KindTypeName & "说明</strong><br>鼠标移至" & KindTypeName & "名称上时将显示设定的说明文字（不支持HTML）</td>"
    Response.Write "      <td class='tdbg'>"
    Response.Write "        <textarea name='ReadMe' cols='40' rows='5' id='ReadMe'>" & PE_ConvertBR(rsFsKind("ReadMe")) & "</textarea>"
    Response.Write "      </td>"
    Response.Write "    </tr>"
    Response.Write "    <tr class='tdbg'>"
    Response.Write "      <td colspan='2' align='center' class='tdbg'>"
    Response.Write "        <input name='KindID' type='hidden' id='KindID' value='" & rsFsKind("KindID") & "'>"
    Response.Write "        <input name='Action' type='hidden' id='Action' value='SaveModifyFsKind'>"
    Response.Write "        <input name='KindType' type='hidden' id='KindType' value='" & KindType & "'>"
    Response.Write "        <input  type='submit' name='Submit' value='保存修改结果'>&nbsp;&nbsp;"
    Response.Write "        <input name='Cancel' type='button' id='Cancel' value=' 取 消 ' onClick=""window.location.href='Admin_FriendSite.asp'"" style='cursor:hand;'>"
    Response.Write "      </td>"
    Response.Write "    </tr>"
    Response.Write "  </table>"
    Response.Write "</form>"

    rsFsKind.Close
    Set rsFsKind = Nothing
End Sub

Sub SaveFsKind()
    Dim KindID, KindName, ReadMe
    Dim rsFsKind, sqlFsKind
    KindID = PE_CLng(Trim(Request.Form("KindID")))
    KindName = Trim(Request.Form("KindName"))
    ReadMe = Trim(Request.Form("ReadMe"))

    If KindName = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>" & KindTypeName & "名称不能为空！</li>"
    Else
        If CheckBadChar(KindName) = False Then
            FoundErr = True
            ErrMsg = ErrMsg & "<li>" & KindTypeName & "名称中含有非法字符！</li>"
        End If
    End If
    If FoundErr = True Then Exit Sub
    
    KindName = PE_HTMLEncode(KindName)
    ReadMe = PE_HTMLEncode(ReadMe)

    Set rsFsKind = Server.CreateObject("Adodb.RecordSet")
    If Action = "SaveAddFsKind" Then
        sqlFsKind = "select top 1 * from PE_FsKind"
        rsFsKind.Open sqlFsKind, Conn, 1, 3
        rsFsKind.addnew
        Dim mrs
        Set mrs = Conn.Execute("select max(KindID) from PE_FsKind")
        If IsNull(mrs(0)) Then
            KindID = 1
        Else
            KindID = mrs(0) + 1
        End If
        Set mrs = Nothing
        rsFsKind("KindID") = KindID
    ElseIf Action = "SaveModifyFsKind" Then
        If KindID = 0 Then
            FoundErr = True
            ErrMsg = ErrMsg & "<li>请指定要修改的" & KindTypeName & "ID！</li>"
            Exit Sub
        Else
            sqlFsKind = "Select * from PE_FsKind Where KindID=" & KindID
            rsFsKind.Open sqlFsKind, Conn, 1, 3
            If rsFsKind.BOF And rsFsKind.EOF Then
                FoundErr = True
                ErrMsg = ErrMsg & "<li>找不到指定的" & KindTypeName & "！</li>"
                rsFsKind.Close
                Set rsFsKind = Nothing
                Exit Sub
            End If
        End If
    End If
    rsFsKind("KindName") = KindName
    rsFsKind("KindType") = KindType
    rsFsKind("ReadMe") = ReadMe
12345

⌨️ 快捷键说明

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