📄 opendj.asp
字号:
<!--#include file="mdb.asp"-->
<!--#include file="dj_path.asp"-->
<!--#include file="inc/inc.asp"-->
<!--#include file="inc/md5.asp"-->
<%
'****************************************************
From_url = Cstr(Request.ServerVariables("HTTP_REFERER"))
Serv_url = Cstr(Request.ServerVariables("SERVER_NAME"))
if mid(From_url,8,len(Serv_url)) <> Serv_url then
response.write "非法链接!" '防止盗链
response.end
end if
Function LoadFile(ByVal File)
Dim objStream
On Error Resume Next
Set objStream = Server.CreateObject("ADODB.Stream")
If Err.Number=-2147221005 Then
Response.Write "<div align='center'>非常遗憾,您的主机不支持ADODB.Stream,不能使用本程序</div>"
Err.Clear
Response.End
End If
With objStream
.Type = 2
.Mode = 3
.Open
.LoadFromFile Server.MapPath(File)
If Err.Number<>0 Then
Response.Write "<div align='center'>文件<font color='#ff0000'>"&File&"</font>无法被打开,请检查是否存在!</font></div>"
Err.Clear
Response.End
End If
.Charset = "GB2312"
.Position = 2
LoadFile = .ReadText
.Close
End With
Set objStream = Nothing
End Function
Sub SaveToFile(ByVal strBody,ByVal File)
Dim objStream
On Error Resume Next
Set objStream = Server.CreateObject("ADODB.Stream")
If Err.Number=-2147221005 Then
Response.Write "<div align='center'>非常遗憾,您的主机不支持ADODB.Stream,不能使用本程序</div>"
Err.Clear
Response.End
End If
With objStream
.Type = 2
.Open
.Charset = "GB2312"
.Position = objStream.Size
.WriteText = strBody
.SaveToFile Server.MapPath(File),2
.Close
End With
Set objStream = Nothing
End Sub
function dl(f,n)
on error resume next
Set S=CreateObject("Adodb.Stream")
S.Mode=3
S.Type=1
S.Open
S.LoadFromFile(f)
if Err.Number>0 then
Response.Status="404"
else
Response.ContentType="application/octet-stream"
Response.AddHeader "Content-Disposition:","attachment; filename=" & n
Range=Mid(Request.ServerVariables("HTTP_RANGE"),7)
if Range="" then
Response.BinaryWrite(S.Read)
else
S.position=Clng(Split(Range,"-")(0))
Response.BinaryWrite(S.Read)
End if
end if
Response.End
end function
if request.querystring("dj_id")<>"" then
colname=clng(request.querystring("dj_id"))
else
colname=0
end if
sql="select * from [dj] where dj_id="&colname
set rs=server.createobject("adodb.recordset")
rs.open sql,conn,1,3
dim djpath,dj_path,downurl,djname,djpoints
djpath=rs("path")
If djpath=0 Then
downurl=rs("dj_url")
else
If djpath="" or IsNull(djpath) Then
djpath=1
End If
Select Case djpath
Case 1
dj_path=d_path1
Case 2
dj_path=d_path2
Case 3
dj_path=d_path3
Case 4
dj_path=d_path4
Case 5
dj_path=d_path5
Case else
dj_path=d_path1
End Select
downurl=dj_path&rs("dj_url")
End If
djname=rs("dj_name")
djGrade=rs("Grade")
djpoints=rs("points")
rs("dj_dcount")=rs("dj_dcount")+1
rs.update
FileExt = Mid(downurl, InStrRev(downurl, ".") + 1)
F_Ext=UCase(FileExt)
if UserLogined<>True then
Grade=0
else
Grade=Hx66_Grade+1
end if
if Grade<djGrade then
Response.Write "<script language=javascript>alert('对不起,你的权限不够,不能下载此音乐!');JavaScript:window.close();</script>"
Response.End
elseif Hx66_points<djpoints then
Response.Write "<script language=javascript>alert('你的点数不足(你当前点数为:" &Hx66_points& "),无法下载此音乐。\n\n请与我们联系进行充值。');JavaScript:window.close();</script>"
Response.End
elseif djGrade>0 and djpoints>0 then
djID=md5(trim(request("dj_id"))+123)
if Request.Cookies("hx66")("pay_dj" & djID)<>"yes" then
sql="UPDATE [user] SET points = points - "&djpoints&" where userid="&Hx66_uid
conn.execute (sql)
response.Cookies("hx66")("pay_dj" & djID)="yes"
Response.Cookies("hx66").Expires=date+365
end if
end if
if lcase(left(downurl,7))="http://" or lcase(left(downurl,6))="ftp://" then
response.redirect downurl
else
call dl(Server.MapPath(""&downurl&""),""&djname&"." & F_Ext & "")
end if
rs.close
set rs=nothing
'****************************************************
%>
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -