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 %>