www.gusucode.com > 艺术签名文章资讯网源代码 > 艺术签名文章资讯网源代码/624/flash/download.asp

    <!--#include file="config.asp" -->
<!--#include file="../inc/base64.asp"-->
<%
Dim Rs,SQL,ErrMsg
Dim flashid,downid,ClassID,title,IsOuter
Dim DownFileName,DownAddress,PointNum,UserGroup
Dim DownloadUrl,strDownAddress,strDownloadUrl,User_Group
Dim strInstallPath
If Newasp.BindDomain = "0" Then
	strInstallPath = Newasp.InstallDir
Else
	strInstallPath = Newasp.SiteUrl & Newasp.InstallDir
End If

flashid = Newasp.ChkNumeric(Request.Querystring("id"))
downid = Newasp.ChkNumeric(Request.Querystring("downid"))
If flashid = 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 BeginDownload

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

Sub BeginDownload()
	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

	SQL = "SELECT ClassID,title,DownAddress,PointNum,UserGroup FROM NC_FlashList WHERE ChannelID="& ChannelID &" And isAccept > 0 And flashid=" & flashid
	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 = Rs("ClassID")
		title = Rs("title")
		DownAddress = Rs("DownAddress")
		PointNum = Rs("PointNum")
		UserGroup = Rs("UserGroup")
		
	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
		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>"
				FoundErr=True
				Set Rs = Nothing
				Exit Sub
			End If
			If Rs("UserGroup") > 0 Then
				PointNum = Rs("DownPoint")
				CheckUserDownload flashid,PointNum,User_Group,GroupName
			Else
				PointNum = PointNum
			End If
		End If
		Rs.Close:Set Rs = Nothing
		DownloadUrl = Trim(DownloadUrl & DownAddress)
	Else
		DownloadUrl = Trim(DownAddress)
	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 flashid,PointNum,UserGroup,GroupName
	End If
	If FoundErr=True Then Exit Sub
	
	If IsOuter = 2 And NewCloud.ThunderUnionID <> "0" Then
		ThunderDownloadUrl(ThunderEncode(DownloadUrl))
		Exit Sub
	ElseIf IsOuter = 3 And NewCloud.FlashGetUnionID <> "0" Then
		FlashGetDownloadUrl(DownloadUrl)
		Exit Sub
	ElseIf IsOuter = 4 And NewCloud.PPGouUnionID <> "0" Then
		PPGouDownloadUrl(DownloadUrl)
		Exit Sub
	Else
		Response.Redirect (DownloadUrl)
	End If
End Sub

Sub ThunderDownloadUrl(url)
	'--WEB迅雷专用连接JS文件
	'Response.Write "<script src='http://pstatic.xunlei.com/js/webThunderSpecial.js'></script>" & vbNewLine
	'--迅雷5专用连接JS文件
	Response.Write "<script src='http://pstatic.xunlei.com/js/webThunderDetect.js'></script>" & vbNewLine
	Response.Write "<script>OnDownloadClick('" & url & "','',location.href,'" & NewCloud.ThunderUnionID & "',false)</script>" & vbNewLine
	'Response.Write "<script>window.setInterval(""window.close()"",3000);</script>" & vbCrLf
End Sub

Sub FlashGetDownloadUrl(url)
	Dim m_strFlashGetUrl,m_strDownUrl
	'--此处为文件实际下载地址
	m_strDownUrl = url   
	m_strFlashGetUrl = FlashgetEncode(m_strDownUrl,NewCloud.FlashGetUnionID)
	Response.Write "<script src=""http://ufile.kuaiche.com/Flashget_union.php?fg_uid=" & NewCloud.FlashGetUnionID & """></script>" & vbCrLf
	Response.Write "<script>function ConvertURL2FG(url,fUrl,uid){	try{		FlashgetDown(url,uid);	}catch(e){		location.href = fUrl;		}}"& vbCrLf
	Response.Write "function Flashget_SetHref(obj){obj.href = obj.fg;}</script>"& vbCrLf
	Response.Write "<script>ConvertURL2FG('" & m_strFlashGetUrl & "','" & m_strDownUrl & "'," & NewCloud.FlashGetUnionID & ")</script>" & vbCrLf
	'Response.Write "<script>window.setInterval(""window.close()"",3000);</script>" & vbCrLf
End Sub

Sub PPGouDownloadUrl(url)
	Response.Write "<script language='javascript' src='"& strInstallPath &"js/ppgou.js'></script>" & vbNewLine
	Response.Write "<script>IPPGouDown('" & url & "','','','" & NewCloud.PPGouUnionID & "')</script>" & vbNewLine
End Sub

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