<% 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 & "
  • 错误的系统参数!请输入正确的软件ID
    • " FoundErr=True End If If Not Newasp.CheckOuterUrl Then ErrMsg = ErrMsg & "
  • 非法下载，请不要盗链本站资源！
    • " FoundErr=True End If Newasp.Checkspider() 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 & "
  • 对不起！你是" & GroupName & "；不能下载本站资源。
    • " FoundErr=True Exit Sub End If On Error Resume Next SQL = "SELECT ClassID,SoftName,SoftVer,PointNum,UserGroup,username,PauseDown 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 & "
  • 对不起~！没有找到你想下载的软件。
    • " 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") & "" If Rs("PauseDown") > 0 Then ErrMsg = ErrMsg & "
  • 对不起！本软件暂时停止下载。
    • " FoundErr=True Exit Sub End If SoftPointNum = PointNum End If 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 & "
  • 您没有登录或者你的会员级别不够！
  • 如果你是本站会员, 请先登陆后再下载!
    • " 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 & "
  • 注意：您所下载的文件不存在。
    • " 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 & "
  • 注意：此下载服务器是会员专用；
  • 如果你是本站会员, 请先登陆后再下载!
  • 或者你的会员级别不够，请联系管理员...
    • " 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 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 & "
  • 注意：您所下载的文件不存在。
    • " 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 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 & "
  • 注意：您所下载的文件不存在。
    • " FoundErr=True Set Rs = Nothing Exit Sub Else DownloadUrl = Trim(Rs("DownFileName")) End If Set Rs = Nothing End If If CInt(UserGroup) > 0 And User_Group = 0 Then If Trim(Newasp.memberName) = "" Then ErrMsg = ErrMsg & "
  • 此软件是会员软件，非会员不能下载。 如果你是本站会员请先登陆!
    • " 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 NewCloud.ThunderUnionID <> "0" Then ThunderDownloadUrl(ThunderEncode(DownloadUrl)) ElseIf IsOuter = 3 And NewCloud.FlashGetUnionID <> "0" Then FlashGetDownloadUrl(DownloadUrl) Else Response.Redirect (DownloadUrl) End If End If End Sub Function ThunderDownloadUrl(url) Response.Write "" & vbNewLine Response.Write "" & vbNewLine Response.Write "" & vbCrLf End Function Function FlashGetDownloadUrl(url) Dim m_strFlashGetUrl,m_strDownUrl '--此处为文件实际下载地址 m_strDownUrl = url m_strFlashGetUrl = FlashgetEncode(m_strDownUrl,NewCloud.FlashGetUnionID) Response.Write "" & vbCrLf Response.Write ""& vbCrLf Response.Write "" & vbCrLf Response.Write "" & vbCrLf 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 & "
  • 非法操作~！
    • " FoundErr=True Set Rs = Nothing Exit Function Else If DateDiff("D", CDate(Rs("ExpireTime")), Now()) > 0 Or Rs("UserClass") = 999 Then ErrMsg = ErrMsg & "
  • 对不起！您的会员已到期，不能下载此软件；
  • 如果你要下载此软件请联系管理员。
    • " 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 & "
  • 非法操作~！
    • " FoundErr=True Set Rs = Nothing Exit Function Else userpoint = Rs("userpoint") If userpoint < 0 Then Rs("userpoint").Value = 0 Rs.Update 'ErrMsg = ErrMsg & "
  • 对不起!您的点数不足。不能下载此软件
  • 下载本软件所需的点数："& PointNum &"
  • 如果你确实要下载此软件请到会员中心充值。
    • " 'FoundErr=True Set Rs = Nothing Exit Function End If UserGrade = Rs("UserGrade") UserToday = Rs("UserToday") UserToday = Split(UserToday, "|") If UserGrade < UserGroup Then ErrMsg = ErrMsg & "
  • 您的级别不够，下载此软件需要"& GroupName &"以上级别的会员；
  • 如果你要下载此软件请联系管理员。
    • " FoundErr=True Set Rs = Nothing Exit Function End If If userpoint < PointNum Then ErrMsg = ErrMsg & "
  • 对不起!您的点数不足。不能下载此软件
  • 下载本软件所需的点数："& PointNum &"
  • 如果你确实要下载此软件请到会员中心充值。
    • " 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 "" & SoftName & "" & vbCrLf Response.Write "" & vbCrLf Response.Write "" & vbNewLine Response.Write "

    " & vbCrLf Response.Write "" Response.Write "" Response.Write " " Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write "
    " & SoftName & "
    提示：下载此软件需要扣除 " & PointNum & "点
    立即下载 -- " & SoftName & "
    返回首页... | 关闭本窗口...
    " Response.Write "

    " End Function %>