articletop.asp

来自「多用户管理分权限发布、管理软件信息； 自由选择系统默认为静态HTML或动态A」· ASP 代码 · 共 136 行

<!--#include file="conn.asp" -->
<%
Dim kind, classid, rootid, classname, depth, strTop, topic, infoTime
Dim lockurl, Rs, SQL
Set Rs = server.CreateObject("Adodb.recordset")
If Not IsNumeric(Request("classid")) and Request("classid") <> "" then
	Response.write"错误的系统参数!ID必须是数字"
	Response.end
Else
	classid = CLng(Request.querystring("classid"))
End If
kind = request.querystring("kind")
If kind <> "" Then
        kind = Clnt(kind)
Else
        kind = 1 '首页调用类型，1表示新软件，2表示热门软件
End If
'*******************以下为修改项*************************
'只允许调用网址,要以"HTTP://"开头,为空则不开放此功能.(可允许多网址限制，要以","分隔。)
'例如只允许此两个网址调用: lockurl="http://www.newasp.net/,http://www.newcloud.net/"
lockurl = ""
Const WebUrl = "http://127.0.0.1/ncdown/" '请填写你的下载站正确地址,要以"HTTP://"开头
Const maxLen = 30 '主题最多显示字数，字母算一个汉字算两个
Const listNum = 10 '显示调用数量
Const bullet = "<font color=green face=Webdings>1</font>" '标题前的图片或符号
Const hitsColor = "red" '点击数的颜色
Const new_color = "red" '新软件日期的颜色
Const old_color = "gray" '旧软件日期的颜色
Const isClass = False '是否显示专题连接 true表示是 False表示否
'*********************以上为修改项*************************
If Trim(lockurl)<>"" And CheckServer(lockurl) = False Then
        response.Write "document.write ('数据被保护,禁止被其他站点调用!');"
        response.End
End If

Private Function gotTopic(Str, strlen)
        Dim l, t, c, i
        l = Len(Str)
        t = 0
        For i = 1 To l
                c = Abs(Asc(Mid(Str, i, 1)))
                If c>255 Then
                        t = t + 2
                Else
                        t = t + 1
                End If
                If t>= strlen Then
                        gotTopic = Left(Str, i)&"..."
                        Exit For
                Else
                        gotTopic = Str
                End If
        Next
End Function


Private Function CheckServer(Str)
        Dim i, servername
        checkserver = false
        If Str = "" Then Exit Function
        Str = Split(CStr(Str), ",")
        servername = Request.ServerVariables("HTTP_REFERER")
        For i = 0 To UBound(Str)
                If Right(Str(i), 1) = "/" Then Str(i) = Left(Trim(Str(i)), Len(Str(i)) -1)
                If LCase(Left(servername, Len(Str(i)))) = LCase(Str(i)) Then
                        CheckServer = True
                        Exit For
                Else
                        CheckServer = False
                End If
        Next
End Function

If classid <> "" Then
        sql = "select * from [NC_class] where classid="&classid
        rs.Open sql, conn, 1, 1
        If rs.bof And rs.EOF Then
                strTop = strTop & "没有找到任何软件信息。或者您选择了错误的系统参数!"
                response.End
        Else
                classname = rs("classname")
                rootid = rs("rootid")
                depth = rs("depth")
        End If
        rs.Close

End If
If classid <> "" Then
        If depth<>0 Then
                sql = "select top "&listNum&" id,classid,title,classname,infoTime,Hits from NC_Article where isLock=0 and classid="&classid&" "
        Else
                sql = "select top "&listNum&" id,classid,title,classname,infoTime,Hits from NC_Article where isLock=0 and rootid="&classid&" "
        End If
Else
        sql = "select top "&listNum&" id,classid,title,classname,infoTime,Hits from NC_Article where isLock=0 "
End If
Select Case kind
        Case "1" sql = sql&" order by infoTime desc,id desc"
        Case "2" sql = sql&" order by hits desc,id desc"
End Select
rs.Open sql , conn, 1, 1
If rs.bof And rs.EOF Then
        strTop = strTop & "没有找到任何软件！"
Else
        Do While Not rs.EOF
                topic = Trim(Rs("title"))
                topic = Replace(Replace(topic, "'", ""),"&nbsp;"," ")
                topic = gotTopic(topic, maxLen)
                If Rs("infoTime")>= Date() Then
                        infoTime = "<FONT color="&new_color&">"&Month(Rs("infoTime"))&"月"&Day(Rs("infoTime"))&"日</FONT >"
                Else
                        infoTime = "<FONT color="&old_color&">"&Month(Rs("infoTime"))&"月"&Day(Rs("infoTime"))&"日</FONT >"
                End If
                strTop = strTop & bullet
                If isClass Then
                        If CInt(Newasp.setting(5)) = 0 Then
                                strTop = strTop & "[<A href='"&WebUrl&"Listing/Catalog"&Rs("classid")&"/Listing_Indate_Desc_1.html' target='_blank'>"&Trim(rs("classname"))&"</a>]"
                        Else
                                strTop = strTop & "[<A href='"&WebUrl&"Listing.Asp?classid="&Rs("classid")&"' target='_blank'>"&Trim(rs("classname"))&"</a>]"
                        End If
                End If
                If CInt(Newasp.setting(5)) = 0 Then
                        strTop = strTop & " <A href='"&WebUrl&"Article/Catalog"&Rs("classid")&"/"&Rs("id")&".html' title='" & Trim(Rs("title")) &"' class='TableLink' target='_blank'>" & topic & "</a> " & infoTime & ",<font color="& hitscolor &">"& rs("Hits") &"</font>)<br>"
                Else
                        strTop = strTop & " <A href='"&WebUrl&"Article.Asp?id="&Rs("id")&"' title='" & Trim(Rs("title")) &"' class='TableLink' target='_blank'>" & topic & "</a> " & infoTime & ",<font color="& hitscolor &">"& rs("Hits") &"</font>)<br>"
                End If
                rs.movenext
        Loop
End If
rs.Close
 conn.Close
Set rs = Nothing
 Set conn = Nothing
response.Write "document.write ("&Chr(34)&strTop&Chr(34)&");"
%>