downtop.asp

多用户管理分权限发布、管理软件信息； 自由选择系统默认为静态HTML或动态ASP； 无限制添加下载服务器

<!--#include file="conn.asp" -->
<%
Dim kind, sortid, rootid, sortname, depth, strTop, topic, SoftTime
Dim lockurl, Rs, SQL
Set Rs = server.CreateObject("Adodb.recordset")
If Not IsNumeric(Request("sortid")) and Request("sortid") <> "" then
	Response.write"错误的系统参数!ID必须是数字"
	Response.end
Else
	sortid = CLng(Request.querystring("sortid"))
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://www.371down.com/" '请填写你的下载站正确地址,要以"HTTP://"开头
Const maxLen = 22 '主题最多显示字数，字母算一个汉字算两个
Const listNum = 10 '显示调用数量
Const bullet = "<font color=green face=Webdings>1</font>" '标题前的图片或符号
Const hitsColor = "white" '点击数的颜色
Const new_color = "red" '新软件日期的颜色
Const old_color = "gray" '旧软件日期的颜色
Const isSorting = 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 sortid <> "" Then
        sql = "select * from [NC_softsort] where sortid="&sortid
        rs.Open sql, conn, 1, 1
        If rs.bof And rs.EOF Then
                strTop = strTop & "没有找到任何软件信息。或者您选择了错误的系统参数!"
                response.End
        Else
                sortname = rs("sortname")
                rootid = rs("rootid")
                depth = rs("depth")
        End If
        rs.Close

End If
If request.querystring("sortid")<>"" Then
        If depth<>0 Then
                sql = "select top "&listNum&" SoftID,sortid,SoftName,SoftVer,SortName,SoftTime,Hits from NC_softinfo where isLock=0 and sortid="&sortid&" "
        Else
                sql = "select top "&listNum&" SoftID,sortid,SoftName,SoftVer,SortName,SoftTime,Hits from NC_softinfo where isLock=0 and rootid="&sortid&" "
        End If
Else
        sql = "select top "&listNum&" SoftID,sortid,SoftName,SoftVer,SortName,SoftTime,Hits from NC_softinfo where isLock=0 "
End If
Select Case kind
        Case "1" sql = sql&" order by softTime desc,SoftID desc"
        Case "2" sql = sql&" order by hits desc,SoftID 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("SoftName")) &" "& Trim(Rs("SoftVer"))
                topic = Replace(Replace(topic, "'", ""),"&nbsp;"," ")
                topic = gotTopic(topic, maxLen)
                If Rs("SoftTime")>= Date() Then
                        SoftTime = "<FONT color="&new_color&">"&Month(Rs("SoftTime"))&"月"&Day(Rs("SoftTime"))&"日</FONT >"
                Else
                        SoftTime = "<FONT color="&old_color&">"&Month(Rs("SoftTime"))&"月"&Day(Rs("SoftTime"))&"日</FONT >"
                End If
                strTop = strTop & bullet
                If isSorting Then
                        If CInt(Newasp.setting(5)) = 0 Then
                                strTop = strTop & "[<A href='"&WebUrl&"Sorting/Catalog"&Rs("sortid")&"/Sorting_Indate_Desc_1.html' target='_blank'>"&Trim(rs("SortName"))&"</a>]"
                        Else
                                strTop = strTop & "[<A href='"&WebUrl&"Sorting.Asp?sortid="&Rs("sortid")&"' target='_blank'>"&Trim(rs("SortName"))&"</a>]"
                        End If
                End If
                If CInt(Newasp.setting(5)) = 0 Then
                        strTop = strTop & " <A href='"&WebUrl&"Software/Catalog"&Rs("sortid")&"/"&Rs("SoftID")&".html' title='" & Trim(Rs("SoftName")) &" "& Trim(Rs("SoftVer")) & "' class='TableLink' target='_blank'>" & topic & "</a> " & SoftTime & ")<br>"
                Else
                        strTop = strTop & " <A href='"&WebUrl&"Software.Asp?id="&Rs("SoftID")&"' title='" & Trim(Rs("SoftName")) &" "& Trim(Rs("SoftVer")) & "' class='TableLink' target='_blank'>" & topic & "</a> " & SoftTime & ")<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)&");"
%>