📄 download.asp

📁 这些都是我以前学习是用到的源码
💻 ASP
字号:
<!--#include file="config.asp" -->
<!--#include file="../inc/base64.asp"-->
<script>
<!--
//window.moveTo(100,100);
//window.resizeTo(550,400);
//-->
</script>
<%
Dim Rs,SQL,ErrMsg,id,IsUseServer
Dim softid,SoftName,downid,ClassID
Dim DownFileName,PointNum,UserGroup
Dim DownloadUrl,User_Group,username
Dim ReturnPoint,addPoint,SoftPointNum,IsOuter
IsUseServer = False
'--是否开启返点功能,是=True,否=False
ReturnPoint = False
'-- 当软件不需要点数下载时返回用户的点数
addPoint = 0

softid = Newasp.ChkNumeric(Request.Querystring("softid"))
downid = Newasp.ChkNumeric(Request.Querystring("downid"))
id = Newasp.ChkNumeric(Request.Querystring("id"))

If softid = 0 Then
	ErrMsg = ErrMsg & "<li>错误的系统参数!请输入正确的软件ID</li>"
	FoundErr=True
End If
If Not Newasp.CheckOuterUrl Then
	ErrMsg = ErrMsg & "<li>非法下载，请不要盗链本站资源！</li>"
	FoundErr=True
End If

Call SoftDown

If FoundErr Then
	Returnerr(ErrMsg)
End If
Set NewCloud = Nothing
CloseConn

Sub SoftDown()
	If FoundErr Then Exit Sub
	Dim GroupSetting,GroupName,gradeid,rootid

	If Trim(Newasp.membergrade) <> "" Then
		gradeid = CInt(Newasp.membergrade)
	Else
		gradeid = 0
	End If
	User_Group = 0
	GroupSetting = Split(Newasp.UserGroupSetting(gradeid), "|||")
	GroupName = GroupSetting(UBound(GroupSetting))
	If CInt(GroupSetting(31)) = 0 Then
		ErrMsg = ErrMsg & "<li>对不起！你是" & GroupName & "；不能下载本站资源。</li>"
		FoundErr=True
		Exit Sub
	End If
	On Error Resume Next
	SQL = "SELECT ClassID,SoftName,SoftVer,PointNum,UserGroup,username FROM NC_SoftList WHERE ChannelID="& ChannelID &" And isAccept <> 0 And SoftID=" & SoftID
	Set Rs = Newasp.Execute(SQL)
	If Rs.EOF And Rs.BOF Then
		ErrMsg = ErrMsg & "<li>对不起~！没有找到你想下载的软件。</li>"
		FoundErr=True
		Set Rs = Nothing
		Exit Sub
	Else
		ClassID  = CLng(Rs("ClassID"))
		SoftName = Rs("SoftName") &" "& Rs("SoftVer")
		PointNum = CLng(Rs("PointNum"))
		UserGroup = CInt(Rs("UserGroup"))
		username = Rs("username") & ""
		SoftPointNum = PointNum
	End If
	Rs.Close:Set Rs = Nothing
	Set Rs = Newasp.Execute("SELECT UserGroup FROM NC_Classify WHERE ChannelID="& ChannelID &" And ClassID="& ClassID)
	If Rs("UserGroup") > gradeid Then
		ErrMsg = ErrMsg & "<li>您没有登录或者你的会员级别不够！</li><li>如果你是本站会员, 请先<a href=""../user/"">登陆</a>后再下载!</li>"
		FoundErr=True
		Set Rs = Nothing
		Exit Sub
	End If
	Set Rs = Nothing
	If downid <> 0 Then
		IsUseServer = True
		SQL = "SELECT rootid,downid,DownloadPath,UserGroup,DownPoint,IsOuter FROM NC_DownServer WHERE ChannelID="& ChannelID &" And isLock=0 And downid=" & downid
		Set Rs = Newasp.Execute(SQL)
		If Rs.EOF And Rs.BOF Then
			ErrMsg = ErrMsg & "<li>注意：您所下载的文件不存在。</li>"
			FoundErr=True
			Set Rs = Nothing
			Exit Sub
		Else
			rootid = Rs("rootid")
			DownloadUrl = Trim(Rs("DownloadPath"))
			User_Group = Rs("UserGroup")
			IsOuter = Rs("IsOuter")
			If User_Group > gradeid Then
				ErrMsg = ErrMsg & "<li>注意：此下载服务器是会员专用；</li><li>如果你是本站会员, 请先<a href=""../user/"">登陆</a>后再下载!</li><li>或者你的会员级别不够，请联系管理员...</li>"
				FoundErr=True
				Set Rs = Nothing
				Exit Sub
			End If
			If Rs("UserGroup") > 0 Then
				PointNum = Rs("DownPoint")
				CheckUserDownload softid,PointNum,User_Group,GroupName
			Else
				PointNum = PointNum
			End If
		End If
		Rs.Close:Set Rs = Nothing
		If IsOuter <> 1 Then
			SQL = "SELECT downid,DownFileName FROM NC_DownAddress WHERE ChannelID="& ChannelID &" And softid="& softid &" And downid="& rootid &" And id=" & id
			Set Rs = Newasp.Execute(SQL)
			If Rs.EOF And Rs.BOF Then
				ErrMsg = ErrMsg & "<li>注意：您所下载的文件不存在。</li>"
				FoundErr=True
				Set Rs = Nothing
				Exit Sub
			Else
				Dim strDownFileName
				strDownFileName = Rs("DownFileName") & ""
				If Len(strDownFileName) > 0 Then strDownFileName = Left(strDownFileName,10)
				If InStr(1, strDownFileName, "://") > 0 Then
					DownloadUrl = Trim(Rs("DownFileName"))
				Else
					DownloadUrl = Trim(DownloadUrl & Rs("DownFileName"))
				End If
			End If
			Rs.Close:Set Rs = Nothing
		
		End If
	Else
		IsUseServer = False
		SQL = "SELECT DownFileName FROM NC_DownAddress WHERE ChannelID="& ChannelID &" And softid="& softid &" And id=" & id
		Set Rs = Newasp.Execute(SQL)
		If Rs.EOF And Rs.BOF Then
			ErrMsg = ErrMsg & "<li>注意：您所下载的文件不存在。</li>"
			FoundErr=True
			Set Rs = Nothing
			Exit Sub
		Else
			DownloadUrl = Trim(Rs("DownFileName"))
		End If
		Rs.Close:Set Rs = Nothing
	End If
	
	If CInt(UserGroup) > 0 And User_Group = 0 Then
		If Trim(Newasp.memberName) = "" Then
			ErrMsg = ErrMsg & "<li>此软件是会员软件，非会员不能下载。 如果你是本站会员请先<a href=""../user/"">登陆</a>!</li>"
			FoundErr=True
			Exit Sub
		End If
		
		CheckUserDownload softid,PointNum,UserGroup,GroupName
	End If
	If FoundErr=True Then Exit Sub
	Dim hits
	Set Rs = Server.CreateObject("ADODB.Recordset")
	SQL = "SELECT AllHits,DayHits,WeekHits,MonthHits,HitsTime FROM NC_SoftList WHERE softid="& softid
	Rs.Open SQL,Conn,1,3
	If Not(Rs.BOF And Rs.EOF) Then
		hits = CLng(Rs("AllHits"))+1
		Rs("AllHits").Value = hits
		If DateDiff("Ww", Rs("HitsTime"), Now()) <= 0 Then
			Rs("WeekHits").Value = Rs("WeekHits").Value + 1
		Else
			Rs("WeekHits").Value = 1
		End If
		If DateDiff("M", Rs("HitsTime"), Now()) <= 0 Then
			Rs("MonthHits").Value = Rs("MonthHits").Value + 1
		Else
			Rs("MonthHits").Value = 1
		End If
		If DateDiff("D", Rs("HitsTime"), Now()) <= 0 Then
			Rs("DayHits").Value = Rs("DayHits").Value + 1
		Else
			Rs("DayHits").Value = 1
			Rs("HitsTime").Value = Now()
		End If
		Rs.Update
	End If
	Rs.Close:Set Rs = Nothing
	If downid > 0 Then
		Set Rs = Server.CreateObject("ADODB.Recordset")
		SQL = "SELECT AllDownHits,DayDownHits,HitsTime FROM NC_DownServer WHERE downid="& downid
		Rs.Open SQL,Conn,1,3
		If Not(Rs.BOF And Rs.EOF) Then
			hits = CLng(Rs("AllDownHits"))+1
			Rs("AllDownHits").Value = hits
			If DateDiff("D", Rs("HitsTime"), Now()) <= 0 Then
				Rs("DayDownHits").Value = Rs("DayDownHits").Value + 1
			Else
				Rs("DayDownHits").Value = 1
				Rs("HitsTime").Value = Now()
			End If
			Rs.Update
		End If
		Rs.Close:Set Rs = Nothing
	End If
	Call addMemberPoint()
	If CInt(GroupSetting(34)) <> 0 Then
		RevealDownloadUrl(DownloadUrl)
	Else
		If IsOuter = 2 And Newasp.ThunderPid <> "0" Then
			ThunderDownloadUrl(ThunderEncode(DownloadUrl))
		Else
			Response.Redirect (DownloadUrl)
		End If
	End If
End Sub

Function ThunderDownloadUrl(url)
	Response.Write "<script src='http://pstatic.xunlei.com/js/webThunderDetect.js'></script>" & vbNewLine
	Response.Write "<script>OnDownloadClick('" & url & "','',location.href,'" & Newasp.ThunderPid & "',false)</script>" & vbNewLine
End Function

Function CheckUserDownload(softid,PointNum,UserGroup,GroupName)
	If FoundErr Then Exit Function
	If CInt(Newasp.membergrade) = 999 Then Exit Function
	On Error Resume Next
	Dim CookiesID,userpoint,UserGrade,UserToday,DownCooliesID
	Dim CookieSoftID,CookieDownID,UpdateUserInfo
	UpdateUserInfo = True
	If CInt(Newasp.memberclass) > 0 Then
		Set Rs = Server.CreateObject("ADODB.Recordset")
		SQL = "SELECT userid,UserGrade,UserClass,ExpireTime FROM NC_User WHERE UserClass>0 And username='" & Newasp.CheckBadstr(Newasp.memberName) & "' And userid=" & CLng(Newasp.memberid)
		Rs.Open SQL,Conn,1,3
		If Rs.BOF And Rs.EOF Then
			ErrMsg = ErrMsg & "<li>非法操作~！</li>"
			FoundErr=True
			Set Rs = Nothing
			Exit Function
		Else
			If DateDiff("D", CDate(Rs("ExpireTime")), Now()) > 0 Or Rs("UserClass") = 999 Then
				ErrMsg = ErrMsg & "<li>对不起！您的会员已到期，不能下载此软件；</li><li>如果你要下载此软件请联系管理员。</li>"
				FoundErr=True
				Set Rs = Nothing
				Exit Function
			Else
				Set Rs = Nothing
				Exit Function
			End If
		End If
		Rs.Close:Set Rs = Nothing
	End If
	If PointNum < 1 Then
		Exit Function
	End If
	CookiesID = "softid_" & softid
	DownCooliesID = "downid_" & downid & "_" & softid
	CookieSoftID = Newasp.ChkNumeric(Request.Cookies("DownLoadSoft")(CookiesID))
	CookieSoftID = CLng(CookieSoftID)
	CookieDownID = Newasp.ChkNumeric(Request.Cookies("DownLoadSoft")(DownCooliesID))
	CookieDownID = CLng(CookieDownID)
	If Trim(Request.Cookies("DownLoadSoft")) = "" Then
		Response.Cookies("DownLoadSoft")("userip") = Newasp.GetUserIP
		Response.Cookies("DownLoadSoft").Expires = Date + 1
	End If
	If CookieSoftID = softid And IsUseServer = False Then UpdateUserInfo = False
	If CookieSoftID = softid And IsUseServer And User_Group = 0 Then UpdateUserInfo = False
	If IsUseServer And CookieSoftID = softid And CookieDownID = downid And User_Group > 0 Then
		 UpdateUserInfo = False
	End If
	
	If CInt(UserGroup) > 0 And UpdateUserInfo Then
		Set Rs = Server.CreateObject("ADODB.Recordset")
		SQL = "SELECT userid,UserGrade,userpoint,UserToday,ExpireTime FROM NC_User WHERE username='" & Newasp.CheckBadstr(Newasp.memberName) & "' And userid=" & CLng(Newasp.memberid)
		Rs.Open SQL,Conn,1,3
		If Rs.BOF And Rs.EOF Then
			ErrMsg = ErrMsg & "<li>非法操作~！</li>"
			FoundErr=True
			Set Rs = Nothing
			Exit Function
		Else
			userpoint = Rs("userpoint")
			If userpoint < 0 Then
				Rs("userpoint").Value = 0
				Rs.Update
				'ErrMsg = ErrMsg & "<li>对不起!您的点数不足。不能下载此软件</li><li>下载本软件所需的点数："& PointNum &"</li><li>如果你确实要下载此软件请到<a href=""../user/"">会员中心</a>充值。</li>"
				'FoundErr=True
				Set Rs = Nothing
				Exit Function
			End If
			UserGrade = Rs("UserGrade")
			UserToday = Rs("UserToday")
			UserToday = Split(UserToday, "|")
			If UserGrade < UserGroup  Then
				ErrMsg = ErrMsg & "<li>您的级别不够，下载此软件需要<font color=blue>"& GroupName &"</font>以上级别的会员；</li><li>如果你要下载此软件请联系管理员。</li>"
				FoundErr=True
				Set Rs = Nothing
				Exit Function
			End If
			
			If userpoint < PointNum Then
				ErrMsg = ErrMsg & "<li>对不起!您的点数不足。不能下载此软件</li><li>下载本软件所需的点数："& PointNum &"</li><li>如果你确实要下载此软件请到<a href=""../user/"">会员中心</a>充值。</li>"
				FoundErr=True
				Set Rs = Nothing
				Exit Function
			Else
				Rs("userpoint").Value = CLng(Rs("userpoint") - PointNum)
				Rs.Update
				Response.Cookies("DownLoadSoft")(CookiesID) = softid
				Response.Cookies("DownLoadSoft")(DownCooliesID) = downid
			End If
		End If
		Rs.Close:Set Rs = Nothing
	End If
	
End Function

Sub addMemberPoint()
	Dim CookiesID
	If ReturnPoint Then
		If SoftPointNum = 0 Then SoftPointNum = addPoint
		If SoftPointNum > 0 Then
			CookiesID = "Point_" & softid
			If Trim(Request.Cookies("DownLoadSoft")) = "" Then
				Response.Cookies("DownLoadSoft")("userip") = Newasp.GetUserIP
				Response.Cookies("DownLoadSoft").Expires = Date + 1
			End If
			If Request.Cookies("DownLoadSoft")(CookiesID) <> "yes" Then
				Newasp.Execute ("UPDATE NC_User SET userpoint=userpoint+" & SoftPointNum & " WHERE username='" & Replace(username, "'", "") & "'")
			End If
			Response.Cookies("DownLoadSoft")(CookiesID) = "yes"
		End If
	End If
End Sub

Function RevealDownloadUrl(url)
	Response.Write "<html><head><title>" & SoftName & "</title>" & vbCrLf
	Response.Write "<meta http-equiv=Content-Type content=text/html; charset=gb2312>" & vbCrLf
	Response.Write "<style type=""text/css"">" & vbNewLine
	Response.Write "body {font-size: 12px;font-family: 宋体;}" & vbNewLine
	Response.Write "td {font-size: 12px; font-family: 宋体; line-height: 18px;table-layout:fixed;word-break:break-all}" & vbNewLine
	Response.Write "a {color: #555555; text-decoration: none}" & vbNewLine
	Response.Write "a:hover {color: #FF8C40; text-decoration: underline}" & vbNewLine
	Response.Write "th{ background-color: #3795D2;color: white;font-size: 12px;font-weight:bold;height: 25;}" & vbNewLine
	Response.Write ".TableRow1 {background-color:#F7F7F7;}" & vbNewLine
	Response.Write ".TableRow2 {background-color:#F0F0F0;}" & vbNewLine
	Response.Write ".TableBorder {border: 1px #3795D2 solid ; background-color: #FFFFFF;font: 12px;}" & vbNewLine
	Response.Write "</style>" & vbNewLine
	Response.Write "</head><body><br /><br />" & vbCrLf
	Response.Write "<table width=500 border=0 align=center cellpadding=0 cellspacing=0 class=TableBorder>"
	Response.Write "<tr>"
	Response.Write "  <th>" & SoftName & "</th>"
	Response.Write "</tr>"
	Response.Write "<tr height=50>"
	Response.Write "<td class=TableRow1 align=center>提示：下载此软件需要扣除 <b><font color=red>" & PointNum & "</font></b>点</td>"
	Response.Write "</tr>"
	Response.Write "<tr height=50>"
	Response.Write "<td class=TableRow1 align=center><a href=""" & url & """><font color=blue>立即下载</font> -- " & SoftName & "</a></td>"
	Response.Write "</tr>"
	Response.Write "<tr height=22><td align=center class=TableRow2><a href=./>返回首页...</a> | <a href=javascript:window.close()>关闭本窗口...</a></td></tr>"
	Response.Write "</table>"
	Response.Write "<br /><br /></body></html>"
End Function
%>
⌨️ 快捷键说明

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