plus_tools_const.asp

来自「现在好了」· ASP 代码 · 共 257 行

<%
Dim Dv_Tools
Set Dv_Tools=new Plus_Tools_Cls

Class Plus_Tools_Cls
	Public ToolsID,ToolsInfo,ToUserInfo,UserToolsInfo,ToolsSetting
	Private BuyCount

	Private Sub Class_Initialize()
		BuyCount = 1
		ToolsID = CheckNumeric(Request("ToolsID"))
		If DVbbs.Forum_Setting(90)=0 and IsEmpty(session("flag")) Then ShowErr(1)	'中心已关闭
	End Sub

	Public Sub ChkToolsLogin()
		If Dvbbs.UserID=0 Then Dvbbs.AddErrCode(6):Dvbbs.Showerr()	'判断用户是否在线。
		If ToolsID=0 Then ShowErr(3):Exit Sub
		GetToolsInfo	'提取道具设置信息
	End Sub

	'---------------------------------------------------
	'读取道具系统信息
	'---------------------------------------------------
	Private Sub GetToolsInfo()
		Dim Sql,Rs
		'ID=0 ,ToolsName=1 ,ToolsInfo=2 ,IsStar=3 ,SysStock=4 ,UserStock=5 ,UserMoney=6 ,UserPost=7 ,UserWealth=8 ,UserEp=9 ,UserCp=10 ,UserGroupID=11 ,BoardID=12,UserTicket=13,BuyType=14,ToolsImg=15,ToolsSetting=16
		Sql = "Select ID,ToolsName,ToolsInfo,IsStar,SysStock,UserStock,UserMoney,UserPost,UserWealth,UserEp,UserCp,UserGroupID,BoardID,UserTicket,BuyType,ToolsImg,ToolsSetting From [Dv_Plus_Tools_Info] Where ID="& ToolsID
		Set Rs = Dvbbs.Plus_Execute(Sql)
		If Rs.Eof Then
			ShowErr(3):Exit Sub
		Else
			Sql = Rs.GetString(,1, "§§§", "", "")
			Sql = Split(Sql,"§§§")
		End If
		Rs.Close : Set Rs = Nothing
		ToolsInfo = Sql
		ToolsSetting = Split(ToolsInfo(16),",")
	End Sub
	'---------------------------------------------------
	'读取用户道具信息
	'---------------------------------------------------
	Public Sub GetUserToolsInfo(G_USerID,G_ToolsID)
		Dim Sql,Rs
		G_USerID = CheckNumeric(G_USerID)
		G_ToolsID = CheckNumeric(G_ToolsID)
		If G_USerID = 0 or G_ToolsID = 0 Then ShowErr(3):Exit Sub
		'ID=0 ,UserID=1 ,UserName=2 ,ToolsID=3 ,ToolsName=4 ,ToolsCount=5 ,SaleCount=6 ,UpdateTime=7 ,SaleMoney=8 ,SaleTicket=9
		Sql = "Select ID,UserID,UserName,ToolsID,ToolsName,ToolsCount,SaleCount,UpdateTime,SaleMoney,SaleTicket From [Dv_Plus_Tools_Buss] Where ToolsCount>0 and UserID="& G_USerID &" and ToolsID="& G_ToolsID
		Set Rs = Dvbbs.Plus_Execute(Sql)
		If Rs.Eof Then
			ShowErr(3):Exit Sub
		Else
			Sql = Rs.GetString(,1, "§§§", "", "")
			Sql = Split(Sql,"§§§")
		End If
		Rs.Close : Set Rs = Nothing
		UserToolsInfo = Sql
	End Sub
	'---------------------------------------------------
	'读取目标用户信息
	'---------------------------------------------------
	Public Sub GetToUserInfo()
		Dim Sql,Rs,ToUserID
		ToUserID = Dv_Tools.CheckNumeric(Request("ToUserID"))
		If ToUserID = 0 Then ShowErr(11):Exit Sub
		'UserID=0,UserName=1,LockUser=2,UserPost=3,UserTopic=4,UserMoney=5,UserTicket=6,userWealth=7,userEP=8,userCP=9,UserPower=10,UserGroupID=11
		Sql = "Select UserID,UserName,LockUser,UserPost,UserTopic,UserMoney,UserTicket,userWealth,userEP,userCP,UserPower,UserGroupID From [Dv_User] Where UserID="& ToUserID
		Set Rs = Dvbbs.Execute(Sql)
		If Rs.Eof Then
			ShowErr(11):Exit Sub
		Else
			Sql = Rs.GetString(,1, "§§§", "", "")
			Sql = Split(Sql,"§§§")
		End If
		Rs.Close : Set Rs = Nothing
		ToUserInfo = Sql
	End Sub
	'---------------------------------------------------
	'检查用户使用道具权限
	'---------------------------------------------------
	Public Sub ChkUseTools()
		If Not IsArray(ToolsInfo) Then GetToolsInfo
		ChkUserGroup
		If Dvbbs.BoardID>0 Then ChkBoard
		If cCur(Dvbbs.MyUserInfo(8))<=cCur(ToolsInfo(7)) or cCur(Dvbbs.MyUserInfo(21))<=cCur(ToolsInfo(8)) or cCur(Dvbbs.MyUserInfo(22))<=cCur(ToolsInfo(9)) or cCur(Dvbbs.MyUserInfo(23))<=cCur(ToolsInfo(10))Then ShowErr(12):Exit Sub
		Call GetUserToolsInfo(Dvbbs.UserID,ToolsID)
	End Sub

	'---------------------------------------------------
	'检查目标用户使用道具权限
	'---------------------------------------------------
	Public Sub ChkToUseTools()
		If Not IsArray(ToUserInfo) Then GetToUserInfo
		If cCur(ToUserInfo(3))<=cCur(ToolsSetting(0)) or cCur(ToUserInfo(7))<=cCur(ToolsSetting(1)) or cCur(ToUserInfo(8))<=cCur(ToolsSetting(2)) or cCur(ToUserInfo(9))<=cCur(ToolsSetting(3)) Then ShowErr(13):Exit Sub
	End Sub

	'---------------------------------------------------
	'检查用户组限制使用道具权限
	'---------------------------------------------------
	Public Sub ChkUserGroup()
		If Not IsArray(ToolsInfo) Then GetToolsInfo
		If Cint(ToolsInfo(3)) = 0 Then ShowErr(6):Exit Sub
		If ToolsInfo(11) = "" or Instr(","& ToolsInfo(11) &",",","& Dvbbs.UserGroupID &",") = 0 Then ShowErr(4):Exit Sub
	End Sub
	'---------------------------------------------------
	'检查版块限制使用道具权限
	'---------------------------------------------------
	Public Sub ChkBoard()
		If Not IsArray(ToolsInfo) Then GetToolsInfo
		If ToolsInfo(12) = "" or Instr(","& ToolsInfo(12) &",",","& Dvbbs.BoardID &",") = 0 Then ShowErr(5):Exit Sub
	End Sub
	
	Public Property Let BuySum(ByVal Value)
		BuyCount = Value
	End Property

	'---------------------------------------------------
	'检查用户购买道具权限： BType 数字型，为用户选取的购买类型
	'---------------------------------------------------
	Public Sub ChkBuyTools(Byval BType)
		Dim CanBuyTools
		CanBuyTools = False
		If BType="" or Not Isnumeric(BType) Then
			BType = -1
		Else
			BType = Cint(BType)
		End If
		If Not IsArray(ToolsInfo) Then GetToolsInfo
		If Int(ToolsInfo(4)) = 0 OR BuyCount>Int(ToolsInfo(4)) OR BuyCount = 0 Then ShowErr(8):Exit Sub '库存不足
		Select Case Cint(ToolsInfo(14))
			Case 0 '只需金币
				If cCur(Dvbbs.MyUserInfo(37))>=Int(ToolsInfo(6))*BuyCount and BType=0 Then
					CanBuyTools = True
				End If
			Case 1 '只需点券
				If cCur(Dvbbs.MyUserInfo(38))>=Int(ToolsInfo(13))*BuyCount and BType=1 Then
					CanBuyTools = True
				End If
			Case 2 '金币+点券
				If cCur(Dvbbs.MyUserInfo(37))<Int(ToolsInfo(6))*BuyCount Or cCur(Dvbbs.MyUserInfo(38))<Int(ToolsInfo(13))*BuyCount Then
					CanBuyTools = False
				Else
					CanBuyTools = True
				End If
			Case 3 '金币或点券
				If BType=0 Then
					If cCur(Dvbbs.MyUserInfo(37))>Int(ToolsInfo(6))*BuyCount Then CanBuyTools = True
				ElseIf BType=1 Then
					If cCur(Dvbbs.MyUserInfo(38))>Int(ToolsInfo(13))*BuyCount Then CanBuyTools = True
				Else
					CanBuyTools = False
				End If
			Case Else
				ShowErr(10):Exit Sub
		End Select
		If CanBuyTools = False Then ShowErr(7):Exit Sub
	End Sub
	'---------------------------------------------------
	'购买方式
	'---------------------------------------------------
	Public Property Get BuyType(Byval BType)
		Select Case Cint(BType)
			Case 0 : BuyType = "只需金币"
			Case 1 : BuyType = "只需金币"
			Case 2 : BuyType = "金币+点券"
			Case 3 : BuyType = "金币或点券"
			Case Else : BuyType = "暂停购买"
		End Select
		BuyType = "<font class=redfont>"&BuyType&"</font>"
	End Property

	Public Sub ShowErr(Byval Code)
		If Code<>"" Then Response.redirect "showerr.asp?ErrCodes="& ErrCodes(Code) &"&action=NoHeadErr"
	End Sub
	'---------------------------------------------------
	'错误信息
	'---------------------------------------------------
	Public Function ErrCodes(Byval ErrNum)
		Select Case ErrNum
			Case 1 : ErrCodes = "<li>道具中心已经关闭！"
			Case 2 : ErrCodes = "<li>道具交易中心已经关闭，不能进行道具交易！"
			Case 3 : ErrCodes = "<li>该道具不存在或参数不正确！"
			Case 4 : ErrCodes = "<li>您没有购买或使用该道具的权限！"
			Case 5 : ErrCodes = "<li>本版块不能使用该道具！"
			Case 6 : ErrCodes = "<li>该道具已被系统禁止使用！"
			Case 7 : ErrCodes = "<li>您的金币或点券不足或选取的购买方式不正确，不能购买该道具！"
			Case 8 : ErrCodes = "<li>该道具系统库存不足，暂停购买！"
			Case 9 : ErrCodes = "<li>转让的数量已超过了您拥有的道具数据或没有填写正确的道具数量，出售中止！"
			Case 10 : ErrCodes = "<li>暂停购买！"
			Case 11 : ErrCodes = "<li>道具使用目标用户不存在或参数不正确！"
			Case 12 : ErrCodes = "<li>由于你的文章数或金钱值或积分值或魅力值不足，所以没有使用该道具的权限！"
			Case 13 : ErrCodes = "<li>由于使用的目标用户的文章数或金钱值或积分值或魅力值不足，所以你不能使用该道具！"
			Case 14 : ErrCodes = "<li>此操作不能在相同用户名之间进行！"
			Case 15 : ErrCodes = "<li>后悔药只能用在自己发表的帖子上！"
			Case 16 : ErrCodes = "<li>您设置的转让金币或点券数不正确！"
			Case 17 : ErrCodes = "<li>您的金币或点券不足，不能转让！"
			Case 18 : ErrCodes = "<li>该用户没有任何道具。"
		End Select
	End Function

	Public Function CheckNumeric(Byval CHECK_ID)
		If CHECK_ID<>"" and IsNumeric(CHECK_ID) Then _
			CHECK_ID = Int(CHECK_ID) _
		Else _
			CHECK_ID = 0
		CheckNumeric = CHECK_ID
	End Function

End Class

'--------------------------------------------------------------------------------
'用户信息
'--------------------------------------------------------------------------------
Sub UserInfo()
	Dim Sql,Rs,UserToolsCount
	Sql = "Select Sum(ToolsCount) From [Dv_Plus_Tools_Buss] where UserID="& Dvbbs.UserID
	Set Rs = Dvbbs.Plus_Execute(Sql)
	UserToolsCount = Rs(0)
	If IsNull(UserToolsCount) Then UserToolsCount = 0
%>
<table border="0" cellpadding=3 cellspacing=1 align=center class=Tableborder1 Style="Width:100%">
	<tr>
	<th height=23 >个人资料</th>
	</tr>
	<tr>
	<td align=center class=TableBody1>
	<table border="0" cellpadding=3 cellspacing=1 align=center Style="Width:90%">
	<tr><td class=TableBody2>金币：<B><font color="<%=Dvbbs.mainsetting(1)%>"><%=Dvbbs.MyUserInfo(37)%></font></B> 个</td></tr>
	<tr><td class=TableBody1>点券：<B><font color="<%=Dvbbs.mainsetting(1)%>"><%=Dvbbs.MyUserInfo(38)%></font></B> 张</td></tr>
	<tr><td class=TableBody2>道具：<a href="?action=UserTools_List"><B><font color="<%=Dvbbs.mainsetting(1)%>"><%=UserToolsCount%></font></B></a> 个</td></tr>
	<tr><td class=TableBody1>金钱：<%=Dvbbs.MyUserInfo(21)%></td></tr>
	<tr><td class=TableBody2>文章：<%=Dvbbs.MyUserInfo(8)%></td></tr>
	<tr><td class=TableBody1>经验：<%=Dvbbs.MyUserInfo(22)%></td></tr>
	<tr><td class=TableBody2>魅力：<%=Dvbbs.MyUserInfo(23)%></td></tr>
	<tr><td class=TableBody1>威望：<%=Dvbbs.MyUserInfo(24)%></td></tr>
	<tr><td class=TableBody2></td></tr>
	</table>
	</td>
	</tr>
</table>
<%
End Sub

Sub Tools_Nav_Link()
%>
	<table border="0" width="<%=Dvbbs.mainsetting(0)%>" cellpadding=2 cellspacing=0 align=center>
		<tr>
		<th height=23 id=TableTitleLink><a href="plus_Tools_Center.asp">系统交易中心</a></th>
		<th id=TableTitleLink><a href="plus_Tools_Center.asp?action=UserBussTools_List" >用户交易中心</a></th>
		<th id=TableTitleLink><a href="?action=UserTools_List">我的道具箱</a></th>
		<th id=TableTitleLink><a href="UserPay.asp">购买论坛点券</a></th>
		</tr>
	</table>
<%
End Sub
%>