📄 admin_friendsite.asp

📁 个人网站比较简短
💻 ASP
📖 第 1 页 / 共 5 页
字号:
上一页 1 2 3 45
    rsFsKind.Update
    rsFsKind.Close
    Set rsFsKind = Nothing

    Call ClearSiteCache(0)
    Call CloseConn
    Response.Redirect "Admin_FriendSite.asp?Action=FsKind&KindType=" & KindType
End Sub

Sub DelFsKind()
    If KindID = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>请指定要删除的" & KindTypeName & "ID！</li>"
        Exit Sub
    Else
        KindID = PE_CLng(KindID)
    End If

    Conn.Execute ("delete from PE_FsKind where KindID=" & KindID)
    Conn.Execute ("update PE_FriendSite set KindID=0 where KindID=" & KindID)
    Call ClearSiteCache(0)
    Call CloseConn
    Response.Redirect "Admin_FriendSite.asp?Action=FsKind&KindType=" & KindType
End Sub

Sub ClearFsKind()
    If KindID = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>请指定要清空的" & KindTypeName & "ID！</li>"
        Exit Sub
    Else
        KindID = PE_CLng(KindID)
    End If
    Conn.Execute ("update PE_FriendSite set KindID=0 where KindID=" & KindID)
    Call WriteSuccessMsg("清空此" & KindTypeName & "的友情链接成功。", ComeUrl)
    Call ClearSiteCache(0)
End Sub

Sub Order()
    Dim rsFriendSite, sqlFriendSite, iCount, i, j

    Response.Write "<br>"
    Response.Write "<table width='100%' border='0' cellpadding='0' cellspacing='0'>"
    Response.Write "  <tr>"
    Response.Write "  <form name='myform' method='Post' action='Admin_FriendSite.asp' onsubmit='return ConfirmDel();'>"
    Response.Write "    <td>"
    Response.Write "      <table class='border' border='0' cellspacing='1' width='100%' cellpadding='0'>"
    Response.Write "        <tr class='title' height='22'> "
    Response.Write "          <td width='30' align='center'><strong>序号</strong></td>"
    Response.Write "          <td width='80' align='center'><strong>链接" & KindTypeName & "</strong></td>"
    Response.Write "          <td width='60' align='center'><strong>链接类型</strong></td>"
    Response.Write "          <td align='center'><strong>网站名称</strong></td>"
    Response.Write "          <td width='100' align='center'><strong>网站LOGO</strong></td>"
    Response.Write "          <td width='60' align='center'><strong>站长</strong></td>"
    Response.Write "          <td width='240' Colspan='2' align='center'><strong>操作</strong></td>"
    Response.Write "        </tr>"

    sqlFriendSite = "select ID,KindID,SpecialID,LinkType,SiteName,SiteUrl,SiteIntro,LogoUrl,SiteAdmin,SiteEmail,Stars,Hits,Elite,OrderID,Passed,UpdateTime from PE_FriendSite"
    sqlFriendSite = sqlFriendSite & " order by OrderID asc"

    Set rsFriendSite = Server.CreateObject("ADODB.Recordset")
    rsFriendSite.Open sqlFriendSite, Conn, 1, 1
    iCount = rsFriendSite.RecordCount
    j = 1
    If rsFriendSite.BOF And rsFriendSite.EOF Then
        If ShowType = "1" Then
            Response.Write "<tr class='tdbg'><td colspan='20' align='center'><br>没有任何LOGO链接！<br><br></td></tr>"
        ElseIf ShowType = "2" Then
            Response.Write "<tr class='tdbg'><td colspan='20' align='center'><br>没有任何文字链接！<br><br></td></tr>"
        Else
            Response.Write "<tr class='tdbg'><td colspan='20' align='center'><br>没有任何友情链接！<br><br></td></tr>"
        End If
    Else
        Do While Not rsFriendSite.EOF
            Response.Write "        <tr class='tdbg' onmouseout=""this.className='tdbg'"" onmouseover=""this.className='tdbgmouseover'"">"
            Response.Write "          <td width='30' align='center'>"
            Response.Write rsFriendSite("OrderID")
            Response.Write "          </td>"
            Response.Write "          <td width='80' align='center'>"
            If KindType = 1 Then
                Response.Write GetKindName(rsFriendSite("KindID"))
            ElseIf KindType = 2 Then
                Response.Write GetKindName(rsFriendSite("SpecialID"))
            End If
            Response.Write "          </td>"
            Response.Write "          <td width='60' align='center'>"
            If rsFriendSite("LinkType") = 1 Then
                Response.Write "            <a href='Admin_FriendSite.asp?KindType=" & KindType & "&ShowType=1'>LOGO链接</a>"
            Else
                Response.Write "            <a href='Admin_FriendSite.asp?KindType=" & KindType & "&ShowType=2'>文字链接</a>"
            End If
            Response.Write "          </td>"
            Response.Write "          <td>"
            Response.Write "            <a href='" & rsFriendSite("SiteUrl") & "' target='blank' title='"
            Response.Write "网站名称：" & rsFriendSite("SiteName") & vbCrLf
            Response.Write "网站地址：" & rsFriendSite("SiteUrl") & vbCrLf
            Response.Write "评分等级："
            If rsFriendSite("Stars") = 0 Or IsNull(rsFriendSite("Stars")) Then
                Response.Write "无" & vbCrLf
            Else
                Response.Write String(rsFriendSite("Stars"), "★") & vbCrLf
            End If
            Response.Write "点 击 数：" & rsFriendSite("Hits") & vbCrLf
            Response.Write "更新时间：" & rsFriendSite("UpdateTime") & vbCrLf
            Response.Write "网站简介：" & rsFriendSite("SiteIntro")
            Response.Write "'>" & rsFriendSite("SiteName") & "</a>"
            Response.Write "          </td>"
            Response.Write "          <td width='100' align='center'>"
            If rsFriendSite("LogoUrl") <> "" And rsFriendSite("LogoUrl") <> "http://" Then
                If LCase(Right(rsFriendSite("LogoUrl"), 3)) = "swf" Then
                    Response.Write "<object classid='clsid:D27CDB6E-AE6D-11cf-96B8-444553540000' codebase='http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#versFriendSiteion=5,0,0,0' width='88' height='31'><param name='movie' value='" & rsFriendSite("LogoUrl") & "'><param name='quality' value='high'><embed src='" & rsFriendSite("LogoUrl") & "' pluginspage='http://www.macromedia.com/shockwave/download/index.cgi?P1_Prod_Version=ShockwaveFlash' type='application/x-shockwave-flash' width='88' height='31'></embed></object>"
                Else
                    Response.Write "<a href='" & rsFriendSite("SiteUrl") & "' target='_blank' title='" & rsFriendSite("LogoUrl") & "'><img src='" & rsFriendSite("LogoUrl") & "' width='88' height='31' border='0'></a>"
                End If
            Else
                Response.Write "&nbsp;"
            End If
            Response.Write "          </td>"
            Response.Write "          <td width='60' align='center'>"
            Response.Write "            <a href='mailto:" & rsFriendSite("SiteEmail") & "'>" & rsFriendSite("SiteAdmin") & "</a>"
            Response.Write "          </td>"
            Response.Write "<form action='Admin_FriendSite.asp?Action=UpOrder' method='post'>"
            Response.Write "          <td width='120' align='center'>"

            If j > 1 Then
                Response.Write "<select name=MoveNum size=1><option value=0>向上移动</option>"
                For i = 1 To j - 1
                    Response.Write "<option value=" & i & ">" & i & "</option>"
                Next
                Response.Write "</select>"
                Response.Write "<input type=hidden name=iFriendSiteID value=" & rsFriendSite("ID") & ">"
                Response.Write "<input type=hidden name=cOrderID value=" & rsFriendSite("OrderID") & ">&nbsp;<input type=submit name=Submit value=修改>"
            Else
                Response.Write "&nbsp;"
            End If
            Response.Write "</td></form>"
            Response.Write "<form action='Admin_FriendSite.asp?Action=DownOrder' method='post'>"
            Response.Write "  <td width='120' align='center'>"
            If iCount > j Then
                Response.Write "<select name=MoveNum size=1><option value=0>向下移动</option>"
                For i = 1 To iCount - j
                    Response.Write "<option value=" & i & ">" & i & "</option>"
                Next
                Response.Write "</select>"
                Response.Write "<input type=hidden name=iFriendSiteID value=" & rsFriendSite("ID") & ">"
                Response.Write "<input type=hidden name=cOrderID value=" & rsFriendSite("OrderID") & ">&nbsp;<input type=submit name=Submit value=修改>"
            Else
                Response.Write "&nbsp;"
            End If
            Response.Write "</td></form></tr>"
            j = j + 1
            rsFriendSite.MoveNext
        Loop
    End If
    rsFriendSite.Close
    Set rsFriendSite = Nothing
    Response.Write "      </table>"

    Response.Write "    </td>"
    Response.Write "  </form>"
    Response.Write "  </tr>"
    Response.Write "</table>"

    Response.Write "<br>"

End Sub


Sub UpOrder()
    Dim FriendSiteID, sqlOrder, rsOrder, MoveNum, cOrderID, tOrderID, i, rsFriendSite
    FriendSiteID = Trim(Request("iFriendSiteID"))
    cOrderID = Trim(Request("cOrderID"))
    MoveNum = Trim(Request("MoveNum"))
    If FriendSiteID = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>参数不足！</li>"
    Else
        FriendSiteID = PE_CLng(FriendSiteID)
    End If
    If cOrderID = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>错误参数！</li>"
    Else
        cOrderID = PE_CLng(cOrderID)
    End If
    If MoveNum = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>错误参数！</li>"
    Else
        MoveNum = PE_CLng(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_FriendSite")
    MaxOrderID = mrs(0) + 1
    '先将当前项目移至最后
    Conn.Execute ("update PE_FriendSite set OrderID=" & MaxOrderID & " where ID=" & FriendSiteID)
    
    '然后将位于当前项目以上的项目的OrderID依次加一，范围为要提升的数字
    sqlOrder = "select * from PE_FriendSite 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
        Response.Redirect ("Admin_FriendSite.asp?Action=Order")
        Exit Sub        '如果当前项目已经在最上面，则无需移动
    End If
    i = 1
    Do While Not rsOrder.EOF
        tOrderID = rsOrder("OrderID")     '得到要提升位置的OrderID
        Conn.Execute ("update PE_FriendSite 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_FriendSite set OrderID=" & tOrderID & " where ID=" & FriendSiteID)

    Response.Redirect ("Admin_FriendSite.asp?Action=Order")
    Call ClearSiteCache(0)
End Sub

Sub DownOrder()
    Dim FriendSiteID, sqlOrder, rsOrder, MoveNum, cOrderID, tOrderID, i, rsFriendSite, PrevID, NextID
    FriendSiteID = Trim(Request("iFriendSiteID"))
    cOrderID = Trim(Request("cOrderID"))
    MoveNum = Trim(Request("MoveNum"))
    If FriendSiteID = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>参数不足！</li>"
    Else
        FriendSiteID = PE_CLng(FriendSiteID)
    End If
    If cOrderID = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>错误参数！</li>"
    Else
        cOrderID = PE_CLng(cOrderID)
    End If
    If MoveNum = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>错误参数！<
上一页 1 2 3 45
💿 文件大小 7095 K
👤 上传用户 foreverlovely
📂 所属分类家庭/个人应用
🏷️ 相关标签

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

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