ftpgo.asp

主要实现三大功能：记录统计功能、账号控制功能、文件上载自动校验功能

<!-- #include file="inc/ftp.asp" -->
<!-- #include file="inc/md5.asp" -->
<%
Dvbbs.LoadTemplates("usermanager")
Dvbbs.Stats="购买流量方式"
Dvbbs.Nav()
Dvbbs.Head_var 0,0,"FTP服务中心首页","ftpfuwu.asp"

dim membername,ustatus
membername = Dvbbs.membername

%>
<br>
<table cellpadding=3 cellspacing=1 align=center class=tableborder1>
<tr>
<th width=14%  id=tabletitlelink><a href=ftpfuwu.asp>FTP服务中心</a></th>
<th width=14%  id=tabletitlelink><a href=ftpgo.asp>购买流量方式</a></th>
<%if UseBuyPassword then%><th width=14%  id=tabletitlelink><a href=ftpbuy.asp>购买密码方式</a></th><%end if%>
<%if UseFTPUnion then%><th width=14%  id=tabletitlelink><a href=ftpunion.asp>联盟FTP</a></th><%end if%>
<th width=14%  id=tabletitlelink><a href=ftpdown.asp>FTP下载必看</a></th>
</tr>
</table>

<br>


<%	
If dvbbs.userid=0 Then
	Dvbbs.AddErrCode(6)	
Else
	
	select case request("action")
	case "buysave"
		call buysize()	
	case "chgip"
		call chgip()	
	case "query"
		call queryinfo()
	case "active"		
	    call active()
	case "checkftp"
		call checkftp()    
	case else
		call main()
	end select
	
end if
Dvbbs.Stats="plus"
Dvbbs.Showerr()
response.write "<br>"
BBSFTP_Footer




sub main()

dim I_Gold

I_Gold=GetGold()

'---------------------
response.write"<table cellpadding=3 cellspacing=1 align=center class=tableborder1>"&_
              "<th colspan=7 height=25 align=center>FTP购买流量方式</th></tr>"&_
            "<tr>"&_
                "<td align=center width=100% class=tablebody1><b>"&_
                "欢迎<font color=red>"& membername &"</font>来到社区服务中心,你现有的现金<font color=blue>$" & I_Gold &"</font>单位，我们将给您提供优质的服务,请选择您的服务项目吧!"&_
"</b></td></tr></table>"


'---------------------
set rs=logconn.execute("select * from FTPConfig")
dim ftpidx
dim mrs,logrs
dim scount,sgb,sseller,stime,sstate
dim starttime,webclick
ftpidx=0

response.write"<br><table cellpadding=3 cellspacing=1 align=center class=tableborder1>"&_
              "<tr><th height=25 width=5% align=center>状态</th><th width=30% align=center>FTP名称</th><th width=10% align=center>单价</th><th width=8% align=center>点击次数</th><th width=8% align=center>注册人数</th><th width=8% align=center>售出流量</th><th width=16% align=center>卖方</th><th width=15% align=center>上架日期</th></tr>"


if rs.eof and rs.bof then
	response.write"<tr><td class=tablebody1 align=center valign=middle colspan=7>当前没有FTP可供购买流量。</td></tr>"
else
    
	do while not rs.eof 
		set mrs = logconn.execute("select * from FtpLog_FtpStatistic where FTP='"&rs("ftp")&"'")
		if mrs.eof then
			scount = 0
			sgb = 0
			sseller = "-"
			stime = now
			sstate = "-"
		else
			scount = mrs("WebClick")
			sgb = mrs("SelleGB")
			stime = mrs("StartTime")
			sseller = mrs("Seller")
			sstate = mrs("State")
		end if
		set mrs = nothing
		
		response.write "<tr><td align=center class=tablebody2>"&sstate&"</td>"  
		response.write	"<td align=center valign=middle class=tablebody1><font color=blue><a href='ftpgo.asp?action=checkftp&ftpid="&rs("id")&"'>"& replace(rs("FTPName"),vbcrlf,"<br>")&"</a></font></td>"
		response.write	"<td align=center valign=middle class=tablebody2>"& rs("Value") &" 单位/"&BuyUnit&"</td>"
		
        response.write	"<td align=center valign=middle class=tablebody1>"& scount &"</td>"
        set mrs = bbsconn.execute("select count(*) from ftpuserdown where FTP='"&rs("ftp")&"'")
        if mrs.eof then
        	ftpidx = 0
        else
        	ftpidx = mrs(0)
        end if
        set mrs = nothing
		response.write	"<td align=center valign=middle class=tablebody2>"& ftpidx &"</td>"
		response.write	"<td align=center valign=middle class=tablebody1>"& sgb & BuyUnit &"</td>"
		response.write	"<td align=center valign=middle class=tablebody1>"& sseller &"</td>"
		response.write	"<td align=center valign=middle class=tablebody2>"& stime &"</td>"
		response.write	"</tr>"		
		rs.movenext
	loop
end if
rs.close
set rs=nothing

response.write"</table><br>"

end sub

'激活
sub active()
dim ftpid,ftpip
dim upass
upass = ""
ftpid=request("ftpid")
if ftpid="" or not isnumeric(ftpid) then
	Dvbbs.AddErrCode("<br><li><b>错误的Ftp.")
	exit sub
end if
if not ValidUseFtp(dvbbs.userid) then
	Dvbbs.AddErrCode("<br><li><b>你没有使用该项功能的权限.")
exit sub
end if

set rs=logconn.execute("select FTP from FTPConfig where ID="&ftpid)
if rs.bof and rs.eof then
	Dvbbs.AddErrCode("<br><li><b>没有找到指定购买的ftp信息.")
	rs.close
	set rs=nothing
	exit sub
end if
ftpip = rs("ftp")
set rs=nothing

set rs=server.createobject("adodb.recordset")

rs.open "select * from FtpUserDown where UserID=" & dvbbs.userid & " and FTP='" & ftpip & "'",bbsconn,1,3
if rs.eof and rs.bof then
  rs.addnew
  rs("FTP")=ftpip
  rs("UserID")=dvbbs.userid  
  rs("AllowIP")= "*" 'dvbbs.usertrueIP
  rs("MaxDownSize")= 0
  rs("LinkName") = GetLinkName(ftpip)
  rs("MaxDownSpeed") = GetUserSpeed(dvbbs.userid)
  rs("QuotaUsed") = 0
  rs("QuotaMax") = 0  
  if UseDvbbsUserNameAndPassword<>1 then
  	if request("newpass")<>"" then
  		rs("UserPassword") = md5(request("newpass"),16)
  	else	
  		upass = CreateMypass(6)
  		rs("UserPassword") = md5(upass,16)
  	end if
  	rs("UserName") =FtpUserNamePrefix & dvbbs.membername
  else
  	if 1 <> UseDvbbs7Database then
  		rs("UserPassword") = GetBbsUserPassword(dvbbs.userid)
  		rs("UserName") = dvbbs.membername
  	end if
  end if
  rs("ExpireTime") = dateadd("d",30,Now)
else
  	rs.close
	set rs=nothing
	Dvbbs.AddErrCode("<br><li><b><font color=red>你的FTP帐号已经激活过了。</font></b>")
	
	exit sub
end if
rs.update
rs.close
set rs=nothing

if upass<>"" then
Dvbbs.Dvbbs_Suc( "<br>"&"<li><b>帐号激活成功。Ftp帐号密码为：<font color=blue>"&upass&"</font>。")
else
Dvbbs.Dvbbs_Suc( "<br>"&"<li><b>帐号激活成功。")
end if
end sub

'购买流量
sub buysize()
dim value
dim ftpid,ftpip
dim count
dim cost

count = request("buyvalue")
if count <0 then
Dvbbs.AddErrCode("<br><li><b>购买量不能小于0.")
exit sub
end if
ftpid=request("ftpid")
if ftpid="" or not isnumeric(ftpid) then
Dvbbs.AddErrCode("<br><li><b>没有找到指定购买的ftp信息1.")
exit sub
end if
if not ValidUseFtp(dvbbs.userid) then
	Dvbbs.AddErrCode("<br><li><b>你没有使用该项功能的权限.")
	exit sub
end if
if UseDvbbsUserNameAndPassword<>1 and request("newpass")<>request("newrpass")then
	Dvbbs.AddErrCode("<br><li><b>两次密码不匹配！")
	exit sub
end if
set rs=logconn.execute("select Value,Ftp from FTPConfig where ID="&ftpid)
if rs.bof and rs.eof then
	Dvbbs.AddErrCode("<br><li><b>没有找到指定购买的ftp信息.")
	rs.close
	set rs=nothing
	exit sub
end if
value=rs(0)
ftpip = rs(1)
rs.close
set rs=nothing
if count>0 then
	'rem cost = clng(count*value + 0.4)  do cast this will cost one more gold each time.
	cost = clng(count*value)
	if(cost > clng(GetGold())) then
		Dvbbs.AddErrCode("<br><li><b><font color=red>你的金钱不够购买这么多流量.</font>")
		
		exit sub
	end if
	logconn.execute "update FtpLog_FtpStatistic set SelleGB=SelleGB+"& count &" where FTP='" & ftpip & "'"
else
	count = 0
	cost = 0	
end if

set rs=server.createobject("adodb.recordset")

rs.open "select * from FtpUserDown where UserID=" & dvbbs.userid & " and FTP='" & ftpip & "'",bbsconn,1,3
if rs.eof and rs.bof then

	rs.close
	set rs=nothing
	Dvbbs.AddErrCode("<br><li><b><font color=red>你的FTP帐号还没有激活，请在FTP服务中心激活帐号先。</font></b>")
	exit sub	
else
  rs("MaxDownSize")=rs("MaxDownSize") + Cdbl(count)*BuyUnitSize
  rs("MaxDownSpeed") = GetUserSpeed(dvbbs.userid)
  '如果你希望 用户在购买流量时或者更新信息时自动 更新用户对应的角色信息，请将下面一行的注释 ' 去掉。  
  'rs("LinkName") = GetLinkName(ftpip)
  '另外要强调一点，如果这个ftp在联盟中配置过了别的角色出售，请不要去掉注释。
  rs("AllowIP") = request("allowip")
  rs("ExpireTime") = dateadd("d",30,Now)
  if UseDvbbsUserNameAndPassword<>1 then
  	if request("newpass")<>"" then
  		rs("UserPassword") = md5(request("newpass"),16)
  	end if
  else
  	if 1 <> UseDvbbs7Database then
  		rs("UserPassword") = GetBbsUserPassword(dvbbs.userid)
  	end if
  end if
end if

if count>0 then
	dvbbs.execute "update [DV_user] set [userWealth]=[userWealth]-"& cost &" where [UserName]='" & dvbbs.membername & "'"
end if
rs.update
rs.close
set rs=nothing

Dvbbs.Dvbbs_Suc( "<br>"+"<li><b>购买成功。本次购买量 <font color=blue>"&count&"</font> "&BuyUnit&"，交易金额 <font color=blue>"&cost&"</font> 单位。" )

end sub


sub CheckFtp()
dim I_Gold
dim id,ftpip,i,mrs
dim upspeed,downspeed,sonline
I_Gold=GetGold()

'---------------------
response.write"<table cellpadding=3 cellspacing=1 align=center class=tableborder1>"&_
              "<th colspan=7 height=25 align=center>FTP购买流量方式</th></tr>"&_
            "<tr>"&_
                "<td align=center width=100% class=tablebody1><b>"&_
                "欢迎<font color=red>"& membername &"</font>来到社区服务中心,你现有的现金<font color=blue>$" & I_Gold &"</font>单位，我们将给您提供优质的服务,请选择您的服务项目吧!"&_
"</b></td></tr></table><br>"


id = request("ftpid")
if id="" or not isnumeric(id) then
Dvbbs.AddErrCode( "<br><li><b><font color=red>错误的Ftp!</font></b>" )
	exit sub
end if
set rs=logconn.execute("select * from FTPConfig where ID="&request("ftpid"))
if rs.eof then
	Dvbbs.AddErrCode( "<br><li><b><font color=red>错误的Ftp!</font></b>" )
	exit sub
end if
ftpip = lcase(rs("ftp"))
I_Gold = rs("value")
if ftpip = "default" then
set mrs=logconn.execute("select count(*) from FTPUserOnline")
else
set mrs=logconn.execute("select count(*) from FTPUserOnline where Ftp='"&ftpip&"'")
end if
sonline = mrs(0)
set mrs = nothing

set mrs=logconn.execute("select * from FtpLog_FtpStatistic where FTP='"&ftpip&"'")

if mrs.eof then
	set mrs=nothing
	set mrs=server.createobject("adodb.recordset")
	mrs.open  "select * from FtpLog_FtpStatistic where FTP='"&ftpip&"'",logconn,1,3
	mrs.addnew
	
	mrs("StartTime") = Now
	mrs("EndTime") = Now
	mrs("UpLoadFileSize") = 0
	mrs("UpLoadFileCount") = 0
	mrs("DownLoadFileSize") = 0
	mrs("DownLoadFileCount") = 0
	mrs("LoginTimes") = 0
	mrs("ConnectionTimes") = 0
	mrs("UpTime") = 0
	mrs("DownTime") = 0
	mrs("SelleGB") = 0
	mrs("WebClick") = 1
	mrs("Seller") = Dvbbs.Forum_info(0)
	mrs("FTP") = ftpip
	mrs("State") = "<font color=blue>正常</font>"