powereasy.common.front.asp

个人网站比较简短

            Case 3
                strAnnounce = strAnnounce & "<div class=""announce"">"
                strAnnounce = strAnnounce & "<div class=""announce_title""><a class=""announcetitle"" href=""#"" onclick=""javascript:window.open('" & strInstallDir & "Announce.asp?ChannelID=" & ChannelID & "&ID=" & rsAnnounce("id") & "', 'newwindow', 'height=440, width=400, toolbar=no, menubar=no, scrollbars=auto, resizable=no, location=no, status=no')"">" & rsAnnounce("title") & "</a></div>"
                If ShowAuthor = True Then
                    strAnnounce = strAnnounce & "<div class=""announce_author"">" & rsAnnounce("Author") & "</div>"
                End If
                If ShowDate = True Then
                    strAnnounce = strAnnounce & "<div class=""announce_time"">" & FormatDateTime(rsAnnounce("DateAndTime"), 1) & "</div>"
                End If
                If ContentLen > 0 Then
                    strAnnounce = strAnnounce & ("<div class=""announce_content"">" & GetSubStr(nohtml(PE_HtmlDecode(rsAnnounce("Content"))), ContentLen, False) & "</div>")
                Else
                    strAnnounce = strAnnounce & ("<div class=""announce_content"">" & nohtml(PE_HtmlDecode(rsAnnounce("Content"))) & "</div>")
                End If
                strAnnounce = strAnnounce & "</div>"
                rsAnnounce.MoveNext
            Case 4
                XMLDOM.appendChild (XMLDOM.createElement("item"))
                Set Node = XMLDOM.documentElement.appendChild(XMLDOM.createElement("title"))
                Node.Text = xml_nohtml(rsAnnounce("title"))
                Set Node = XMLDOM.documentElement.appendChild(XMLDOM.createElement("link"))
                Node.Text = "http://" & Trim(Request.ServerVariables("HTTP_HOST")) & "/Announce.asp?ChannelID=" & ChannelID & "&ID=" & rsAnnounce("id")
                Set Node = XMLDOM.documentElement.appendChild(XMLDOM.createElement("description"))
                If ContentLen > 0 Then
                    Node.Text = GetSubStr(xml_nohtml(rsAnnounce("Content")), ContentLen, False)
                Else
                    Node.Text = xml_nohtml(rsAnnounce("Content"))
                End If
                Set Node = XMLDOM.documentElement.appendChild(XMLDOM.createElement("author"))
                Node.Text = xml_nohtml(rsAnnounce("Author"))
                Set Node = XMLDOM.documentElement.appendChild(XMLDOM.createElement("category"))
                Node.Text = "网站公告"
                Set Node = XMLDOM.documentElement.appendChild(XMLDOM.createElement("pubDate"))
                Node.Text = rsAnnounce("DateAndTime")
                strAnnounce = strAnnounce & XMLDOM.documentElement.xml
                rsAnnounce.MoveNext
            End Select
        Loop
    End If
    rsAnnounce.Close
    Set rsAnnounce = Nothing
    ShowAnnounce = strAnnounce
End Function

'==================================================
'函数名：ShowFriendSite
'作  用：显示友情链接站点
'参  数：LinkType  ----链接方式，1为LOGO链接，2为文字链接
'       SiteNum   ----最多显示多少个站点
'       Cols      ----分几列显示
'       ShowType  ----显示方式。1为向上滚动，2为横向列表，3为下拉列表框，4为输出DIV格式
'       KindID    ----所属类别
'       SpecialID ----所属专题
'       TDWidth   ----所用表格宽度
'       IsOnlyElite ----是否只显示推荐
'       IsElitFirst ----是否推荐优先
'       OrderType ----排序方式：1---友情链接ID升序；
'                               2---友情链接ID降序；
'                               3---排序ID升序；
'                               4---排序ID降序；
'                               5---网站评分等级升序；
'                               6---网站评分等级降序；
'==================================================
Function ShowFriendSite(LinkType, SiteNum, Cols, ShowType, KindID, SpecialID, TDWidth, IsOnlyElite, IsElitFirst, OrderType)
    Dim sqlLink, rsLink, SiteCount, i, j, strLink, strLogo
    Dim LinkSiteUrl
    
    LinkType = PE_CLng(LinkType)
    If LinkType <> 1 And LinkType <> 2 Then
        LinkType = 1
    End If
    If SiteNum <= 0 Or SiteNum > 100 Then
        SiteNum = 10
    End If
    If Cols <= 0 Or Cols > 20 Then
        Cols = 10
    End If
    If ShowType = 1 Then
        strLink = strLink & "<div id=rolllink style=overflow:hidden;height:100;width:100><div id=rolllink1>"
    ElseIf ShowType = 3 Then
        strLink = strLink & "<select name='FriendSite' onchange=""if(this.options[this.selectedIndex].value!=''){window.open(this.options[this.selectedIndex].value,'_blank');}""><option value=''>" & XmlText("Site", "ShowFriendSite/option", "友情文字链接站点") & "</option>"
    End If
    If ShowType = 1 Or ShowType = 2 Then
        strLink = strLink & XmlText("Site", "ShowFriendSite/Showtable", "<table width='100%' cellSpacing='5'><tr align='center' class='tdbg'>")
    End If
    If IsValidID(KindID) = True Then
        KindID = Replace(Replace(KindID, "|", ","), " ", "")
    Else
        KindID = 0
    End If
    If IsValidID(SpecialID) = True Then
        SpecialID = Replace(Replace(SpecialID, "|", ","), " ", "")
    Else
        SpecialID = 0
    End If
    If PE_CLng(TDWidth) <= 0 Then
        TDWidth = 88
    End If
    sqlLink = "select top " & SiteNum & " * from PE_FriendSite where Passed=" & PE_True & " and LinkType=" & LinkType
    If KindID <> 0 Then
        sqlLink = sqlLink & " and KindID in (" & KindID & ")"
    End If
    If SpecialID <> 0 Then
        sqlLink = sqlLink & " and SpecialID in (" & SpecialID & ")"
    End If
    If IsOnlyElite = True Then
        sqlLink = sqlLink & " and Elite=" & PE_True
    End If
    'sqlLink = sqlLink & " order by Elite " & PE_OrderType & ",ID desc"
    sqlLink = sqlLink & " order by "
    If IsElitFirst = True Then
        sqlLink = sqlLink & "Elite " & PE_OrderType & ","
    End If
    Select Case OrderType
    Case 1
        sqlLink = sqlLink & "ID asc"
    Case 2
        sqlLink = sqlLink & "ID desc"
    Case 3
        sqlLink = sqlLink & "OrderID asc,ID desc"
    Case 4
        sqlLink = sqlLink & "OrderID desc,ID desc"
    Case 5
        sqlLink = sqlLink & "Stars asc,ID desc"
    Case 6
        sqlLink = sqlLink & "Stars desc,ID desc"
    Case Else
        sqlLink = sqlLink & "OrderID asc,ID desc"
    End Select

    Dim strGetFriendSite
    strGetFriendSite = XmlText("Site", "ShowFriendSite/GetFriendSite", "点击申请")
    Set rsLink = Conn.Execute(sqlLink)
    If rsLink.BOF And rsLink.EOF Then
        If ShowType = 1 Or ShowType = 2 Then
            For i = 1 To SiteNum
                strLink = strLink & "<td><a class='LinkFriendSite' href='" & strInstallDir & "FriendSite/FriendSiteReg.asp' target='_blank'>"
                If LinkType = 1 Then
                    strLink = strLink & "<img src='" & strInstallDir & "images/nologo.gif' width='88' height='31' border='0' alt='" & strGetFriendSite & "'>"
                Else
                    strLink = strLink & strGetFriendSite
                End If
                strLink = strLink & "</a></td>"
                If i Mod Cols = 0 And i < SiteNum Then
                    strLink = strLink & "</tr><tr align='center' class='tdbg'>"
                End If
            Next
        ElseIf ShowType = 4 Then
            For i = 1 To SiteNum
                strLink = strLink & "<div class=""linkfriendsite""><a href=""" & strInstallDir & "FriendSite/FriendSiteReg.asp"" target=""_blank"">"
                If LinkType = 1 Then
                    strLink = strLink & "<img src=""" & strInstallDir & "images/nologo.gif"" width=""88"" height=""31"" border=""0"" alt=""" & strGetFriendSite & """>"
                Else
                    strLink = strLink & strGetFriendSite
                End If
                strLink = strLink & "</a></div>"
            Next
        End If
    Else
        i = 1
        Dim strFriendSiteTitle
        strFriendSiteTitle = XmlText("Site", "ShowFriendSite/FriendSiteTitle", "<a class='LinkFriendSite' href='{$LinkSiteUrl}' target='_blank' title='网站名称：{$SiteName}{$br}网站地址：{$SiteUrl}{$br}网站简介：{$SiteIntro}'>{$SiteShow}</a>")
        Do While Not rsLink.EOF
            If EnableCountFriendSiteHits = True Then
                LinkSiteUrl = strInstallDir & "FriendSite/FriendSiteUrl.asp?ID=" & rsLink("ID")
            Else
                LinkSiteUrl = rsLink("SiteUrl")
            End If
            Select Case ShowType
            Case 1, 2
                If LinkType = 1 Then
                    If rsLink("LogoUrl") = "" Or rsLink("LogoUrl") = "http://" Then
                        strLogo = "<img src='" & strInstallDir & "images/nologo.gif' width='88' height='31' border='0'>"
                    Else
                        If LCase(Right(rsLink("LogoUrl"), 3)) = "swf" Then
                            strLogo = "<object classid='clsid:D27CDB6E-AE6D-11cf-96B8-444553540000' codebase='http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=5,0,0,0' width='88' height='31'><param name='movie' value='" & rsLink("LogoUrl") & "'><param name='quality' value='high'><embed src='" & rsLink("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
                            strLogo = "<img src='" & rsLink("LogoUrl") & "' width='88' height='31' border='0'>"
                        End If
                    End If
                    strLink = strLink & "<td width='" & TDWidth & "'>"
                    strLink = strLink & Replace(Replace(Replace(Replace(Replace(Replace(strFriendSiteTitle, "{$LinkSiteUrl}", LinkSiteUrl), "{$SiteName}", rsLink("SiteName")), "{$SiteUrl}", rsLink("SiteUrl")), "{$SiteIntro}", rsLink("SiteIntro")), "{$SiteShow}", strLogo), "{$br}", vbCrLf)
                    strLink = strLink & "</td>"
                Else
                    strLink = strLink & "<td width='" & TDWidth & "'>"
                    strLink = strLink & Replace(Replace(Replace(Replace(Replace(Replace(strFriendSiteTitle, "{$LinkSiteUrl}", LinkSiteUrl), "{$SiteName}", rsLink("SiteName")), "{$SiteUrl}", rsLink("SiteUrl")), "{$SiteIntro}", rsLink("SiteIntro")), "{$SiteShow}", rsLink("SiteName")), "{$br}", vbCrLf)
                    strLink = strLink & "</td>"
                End If
                If i Mod Cols = 0 And i < SiteNum Then
                    strLink = strLink & "</tr><tr align='center' class='tdbg'>"
                End If
            Case 3
                strLink = strLink & "<option value='" & LinkSiteUrl & "'>" & rsLink("SiteName") & "</option>"
            Case 4
                If LinkType = 1 Then
                    If rsLink("LogoUrl") = "" Or rsLink("LogoUrl") = "http://" Then
                        strLogo = "<img src=""" & strInstallDir & "images/nologo.gif"" width=""88"" height=""31"" border=""0"">"
                    Else
                        If LCase(Right(rsLink("LogoUrl"), 3)) = "swf" Then
                            strLogo = "<object classid=""clsid:D27CDB6E-AE6D-11cf-96B8-444553540000"" codebase=""http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=5,0,0,0"" width=""88"" height=""31""><param name=""movie"" value=""" & rsLink("LogoUrl") & """><param name=""quality"" value=""high""><embed src=""" & rsLink("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
                            strLogo = "<img src=""" & rsLink("LogoUrl") & """ width=""88"" height=""31"" border=""0"">"
                        End If
                    End If
                    strLink = strLink & "<div class=""linkfriendsite"">"
                    strLink = strLink & Replace(Replace(Replace(Replace(Replace(Replace(strFriendSiteTitle, "{$LinkSiteUrl}", LinkSiteUrl), "{$SiteName}", rsLink("SiteName")), "{$SiteUrl}", rsLink("SiteUrl")), "{$SiteIntro}", rsLink("SiteIntro")), "{$SiteShow}", strLogo), "{$br}", vbCrLf)
                    strLink = strLink & "</div>"
                Else
                    strLink = strLink & "<div class=""linkfriendsite"">"
                    strLink = strLink & Replace(Replace(Replace(Replace(Replace(Replace(strFriendSiteTitle, "{$LinkSiteUrl}", LinkSiteUrl), "{$SiteName}", rsLink("SiteName")), "{$SiteUrl}", rsLink("SiteUrl")), "{$SiteIntro}", rsLink("SiteIntro")), "{$SiteShow}", rsLink("SiteName")), "{$br}", vbCrLf)
                    strLink = strLink & "</div>"
                End If
            End Select
            rsLink.MoveNext
            i = i + 1
        Loop
        If i < SiteNum And (ShowType = 1 Or ShowType = 2 Or ShowType = 4) Then
            For j = i To SiteNum
                If ShowType = 4 Then
                    If LinkType = 1 Then
                        strLink = strLink & "<div class=""linkfriendsite""><a href=""" & strInstallDir & "FriendSite/FriendSiteReg.asp"" target=""_blank""><img src=""" & strInstallDir & "images/nologo.gif"" width=""88"" height=""31"" border=""0"" alt=""" & strGetFriendSite & """></a></div>"
                    Else
                        strLink = strLink & "<div class=""linkfriendsite""><a href=""" & strInstallDir & "FriendSite/FriendSiteReg.asp"" target=""_blank"">" & strGetFriendSite & "</a></div>"
                    End If
                Else
                    If LinkType = 1 Then
                        strLink = strLink & "<td width='" & TDWidth & "'><a class='LinkFriendSite' href='" & strInstallDir & "FriendSite/FriendSiteReg.asp' target='_blank'><img src='" & strInstallDir & "images/nologo.gif' width='88' height='31' border='0' alt='" & strGetFriendSite & "'></a></td>"
                    Else
                        strLink = strLink & "<td width='" & TDWidth & "'><a class='LinkFriendSite' href='" & strInstallDir & "FriendSite/FriendSiteReg.asp' target='_blank'>" & strGetFriendSite & "</a></td>"
                    End If
                    If j Mod Cols = 0 And j < SiteNum Then
                        strLink = strLink & "</tr><tr align='center' class='tdbg'>"
                    End If
                End If
            Next
        End If
    End If
    Select Case ShowType
    Case 1
        strLink = strLink & "</tr></table>"
        strLink = strLink & "</div><div id=rolllink2></div></div>"
        strLink = strLink & RollFriendSite()
    Case 2
        strLink = strLink & "</tr></table>"
    Case 3
        strLink = strLink & "</select>"
    End Select
    rsLink.Close
    Set rsLink = Nothing
    ShowFriendSite = strLink
End Function

'==================================================
'函数名：RollFriendSite
'作  用：滚动显示友情链接站点
'参  数：无
'==================================================
Function RollFriendSite()
    Dim strTemp
    strTemp = "<script>" & vbCrLf
    strTemp = strTemp & "var rollspeed=30" &