opensoft.asp

后台登陆admin.asp

<!--#include file="mdb.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("soft_id")<>"" then
  colname=clng(request.querystring("soft_id"))
else
  colname=0
end if
url="soft_url"+request("url")
sql="select * from [soft] where soft_id="&colname
set rs=server.createobject("adodb.recordset")
rs.open sql,conn,1,3
downurl=rs(url)
softname=rs("soft_name")
softGrade=rs("Grade")
softpoints=rs("points")
rs("soft_dcount")=rs("soft_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<softGrade then
  Response.Write "<script language=javascript>alert('对不起，你的权限不够，不能下载此软件!');JavaScript:window.close();</script>"
  Response.End
elseif Hx66_points<softpoints then
  Response.Write "<script language=javascript>alert('你的点数不足(你当前点数为：" &Hx66_points& ")，无法下载此软件。\n\n请与我们联系进行充值。');JavaScript:window.close();</script>"
  Response.End
elseif softGrade>0 and softpoints>0 then
    downID=md5(trim(request("soft_id"))+123)
    if Request.Cookies("hx66")("Pay_down" & downID)<>"yes" then
       sql="UPDATE [user] SET points = points - "&softpoints&" where userid="&Hx66_uid
       conn.execute (sql)
       response.Cookies("hx66")("Pay_down" & downID)="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&""),""&softname&"." & F_Ext & "")
end if
rs.close
set rs=nothing

'****************************************************
%>