ftpunion.asp

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

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

dim membername
membername = Dvbbs.membername
dim prefix,ustatus
%>
<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
	logconn.close
	set logconn = nothing	
	set bbsconn = nothing
	Set logconn = Server.CreateObject("ADODB.Connection")
	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=dvbbs.execute("select * from dv_bbsftp")
dim ftpidx
dim mrs,logrs
dim scount,sgb,sseller,stime,sstate,istate
dim starttime,webclick
ftpidx=0

response.write"<br><table cellpadding=3 cellspacing=1 align=center class=tableborder1>"&_
              "<tr><th height=25 width=8% align=center>状态</th><th width=25% align=center>FTP名称</th><th width=8% align=center>威望限制</th><th width=8% align=center>单价</th><th width=8% align=center>点击次数</th><th width=8% align=center>注册人数</th><th width=8% align=center>售出流量</th><th width=12% 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=9>当前没有FTP可供购买流量。</td></tr>"
else
    
	do while not rs.eof 
		scount = rs("WebClick")
		sgb = rs("SelleGB")
		stime = rs("AddTime")
		sseller = rs("Seller")
		istate = rs("State")
		if istate = 0 then
			sstate = "<font color=blue>正常运行</font>"
		elseif istate = 1 then
			sstate = "<font color=red>停止运行</font>"		
		else
			sstate = "<font color=red>故障维修</font>"
		end if
		ftpidx = rs("usernumber")
		response.write "<tr><td align=center class=tablebody2>"&sstate&"</td>"  
		if istate = 0 then
		response.write	"<td align=center valign=middle class=tablebody1><font color=blue><a href='ftpunion.asp?action=checkftp&ftpid="&rs("ID")&"'>"& replace(rs("FTPName"),vbcrlf,"<br>")&"</a></font></td>"
		else
		response.write	"<td align=center valign=middle class=tablebody1><font color=blue>"& replace(rs("FTPName"),vbcrlf,"<br>")&"</font></td>"
		end if
		response.write	"<td align=center valign=middle class=tablebody2>"& rs("scorelimit") &"</td>"
		response.write	"<td align=center valign=middle class=tablebody1>"& rs("unit_price") &" 单位/"&BuyUnit&"</td>"
		response.write	"<td align=center valign=middle class=tablebody2>"& scount &"</td>"
        
        
		response.write	"<td align=center valign=middle class=tablebody1>"& ftpidx &"</td>"
		response.write	"<td align=center valign=middle class=tablebody2>"& 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
dim tmpconnstr,linkname
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=dvbbs.execute("select * from dv_bbsftp 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
if not rs("regenable") then
	Dvbbs.AddErrCode("<br><li><b>指定的ftp不允许新用户注册.")
	rs.close
	set rs=nothing
	exit sub
end if
if GetUserPower(dvbbs.userid) < rs("scorelimit") then
	Dvbbs.AddErrCode("<br><li><b>威望限制你没有使用该项功能的权限.")
	rs.close
	set rs=nothing
	exit sub
end if
ftpip = rs("FTP")
tmpconnstr = rs("dbServer")
prefix = rs("prefixchar")
linkname = rs("LinkName")
logconn.open tmpconnstr
if err then 
	Dvbbs.AddErrCode("<br><li><b>无法连接指定的ftp.")
	rs.close
	set rs=nothing
	exit sub
end if
set rs=nothing
set rs=logconn.execute("select FTP from FTPConfig where FTP='" & ftpip & "'")

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

rs.open "select * from FtpUserDown where UserID=" & dvbbs.userid & " and FTP='" & ftpip & "'",logconn,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") = linkname
  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
  	
  else
  	rs("UserPassword") = GetBbsUserPassword(dvbbs.userid)  	  	
  end if
  rs("UserName") = Prefix & dvbbs.membername
  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
dvbbs.execute "update dv_bbsftp set usernumber = usernumber + 1"
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,linkname

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=dvbbs.execute("select * from dv_bbsftp 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
if GetUserPower(dvbbs.userid) < rs("scorelimit") then
	Dvbbs.AddErrCode("<br><li><b>威望限制你没有使用该项功能的权限.")
	rs.close
	set rs=nothing
	exit sub
end if
ftpip = rs("FTP")
value = rs("unit_price")
prefix = rs("prefixchar")
linkname = rs("LinkName")
logconn.open rs("dbServer")
if err then 
	Dvbbs.AddErrCode("<br><li><b>无法连接指定的ftp.")
	rs.close
	set rs=nothing
	exit sub
end if

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
	dvbbs.execute "update dv_bbsftp set SelleGB=SelleGB+"& count &" where ID=" & ftpid
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 & "'",logconn,1,3
if rs.eof and rs.bof then

	rs.close
	set rs=nothing
	Dvbbs.AddErrCode("<br><li><b><font color=red>你的FTP帐号还没有激活，请激活帐号先。</font></b>")
	exit sub	
else
  rs("MaxDownSize")=rs("MaxDownSize") + Cdbl(count)*BuyUnitSize
  rs("MaxDownSpeed") = GetUserSpeed(dvbbs.userid)
  rs("LinkName") = linkname
  rs("AllowIP") = request("allowip")
  rs("UserName") = prefix & dvbbs.membername
  if UseDvbbsUserNameAndPassword<>1 then
  	if request("newpass")<>"" then
  		rs("UserPassword") = md5(request("newpass"),16)
  	end if
  else  	
  	rs("UserPassword") = GetBbsUserPassword(dvbbs.userid)  	
  end if
  rs("ExpireTime") = dateadd("d",30,Now)
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,ftpname,ftpurl
dim id,ftpip,i,mrs,StartTime
dim upspeed,downspeed,sonline
dim fup,fdown,upsize,downsize,connecttimes,logintimes,breg
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

if not ValidUseFtp(dvbbs.userid) then
	Dvbbs.AddErrCode("<br><li><b>你没有使用该项功能的权限.")
exit sub
end if

set rs=dvbbs.execute("select * from dv_bbsftp where ID="&id)

if rs.bof and rs.eof then
	Dvbbs.AddErrCode("<br><li><b>没有找到指定的ftp信息.")
	rs.close
	set rs=nothing
	exit sub
end if

if GetUserPower(dvbbs.userid) < rs("scorelimit") then
	Dvbbs.AddErrCode("<br><li><b>威望限制你没有使用该项功能的权限.")
	rs.close
	set rs=nothing
	exit sub
end if

ftpip = rs("FTP")
I_Gold = rs("unit_price")
ftpname = rs("FTPName")
prefix = rs("prefixchar")
logconn.open rs("dbServer")
breg = rs("regenable")
if err then 
	Dvbbs.AddErrCode("<br><li><b>无法连接指定的ftp.")
	rs.close
	set rs=nothing
	exit sub
end if