📄 user_exchange_code.asp
字号:
ErrMsg = ErrMsg & "<li>卡号或密码错误！</li>"
Else
If rsCard("CardType") <> 0 Then
FoundErr = True
ErrMsg = ErrMsg & "<li>你输入的充值卡是其他公司的卡，不能在本站进行充值。请尽快去有关公司或网站的充值入口进行充值。</li>"
End If
If rsCard("UserName") <> "" Then
FoundErr = True
ErrMsg = ErrMsg & "<li>你输入的充值卡已经使用过了！</li>"
End If
If rsCard("EndDate") < Date Then
FoundErr = True
ErrMsg = ErrMsg & "<li>你输入的充值卡已经失效！此卡的充值截止日期为：" & rsCard("EndDate")
End If
End If
If FoundErr = True Then
rsCard.Close
Set rsCard = Nothing
Exit Sub
End If
Dim strMsg
strMsg = "充值成功！"
If rsCard("ValidUnit") = 5 Then
strMsg = strMsg & " <font color='red'>恭喜您已升级成 “" & GetValidNum(rsCard("ValidNum"), rsCard("ValidUnit")) & "”</font>"
End If
strMsg = strMsg & "<br><br>充值卡卡号：" & rsCard("CardNum") & "<br>"
strMsg = strMsg & "充值卡面值：" & rsCard("Money") & "元" & "<br>"
If rsCard("ValidUnit") = 5 Then
strMsg = strMsg & "会员级别："
Else
strMsg = strMsg & "充值卡点数："
End If
strMsg = strMsg & GetValidNum(rsCard("ValidNum"), rsCard("ValidUnit")) & arrCardUnit(rsCard("ValidUnit")) & "<br>"
strMsg = strMsg & "充值截止日期：" & rsCard("EndDate") & "<br><br>"
Dim rsUser, sqlUser
Set rsUser = Server.CreateObject("Adodb.RecordSet")
sqlUser = "select * from PE_User where UserID=" & UserID
rsUser.Open sqlUser, Conn, 1, 3
Select Case rsCard("ValidUnit")
Case 0 '点数
strMsg = strMsg & "您充值前的" & PointName & "数：" & rsUser("UserPoint") & "<br>"
rsUser("UserPoint") = rsUser("UserPoint") + rsCard("ValidNum")
rsUser.Update
strMsg = strMsg & "您充值后的" & PointName & "数：" & rsUser("UserPoint") & "<br>"
Call AddConsumeLog("System", 0, UserName, 0, rsCard("ValidNum"), 1, "充值卡充值。卡号：" & rsCard("CardNum") & "")
Case 4 '元
strMsg = strMsg & "您充值前的资金余额为： " & rsUser("Balance") & " 元<br>"
rsUser("Balance") = rsUser("Balance") + rsCard("ValidNum")
rsUser.Update
strMsg = strMsg & "您充值后的资金余额为： " & rsUser("Balance") & " 元<br>"
Call AddBankrollItem("System", UserName, ClientID, rsCard("ValidNum"), 4, "", 0, 1, 0, 0, "充值卡充值。卡号：" & rsCard("CardNum") & "", Now())
Case 5 '会员组
Conn.Execute ("Update PE_User Set GroupID = " & rsCard("ValidNum") & " where UserName='" & UserName & "'")
Case Else '有效期
If rsUser("ValidNum") = -1 Then
FoundErr = True
ErrMsg = ErrMsg & "<li>您的有效期为“无限期”，无需充值。"
Else
If ValidDays > 0 Then
strMsg = strMsg & "您充值前的有效期：" & rsUser("ValidNum") & arrCardUnit(rsUser("ValidUnit")) & "<br>"
If rsUser("ValidUnit") = rsCard("ValidUnit") Then
rsUser("ValidNum") = rsUser("ValidNum") + rsCard("ValidNum")
rsUser.Update
ElseIf rsUser("ValidUnit") < rsCard("ValidUnit") Then
If rsUser("ValidUnit") = 1 Then
If rsCard("ValidUnit") = 2 Then
rsUser("ValidNum") = rsUser("ValidNum") + rsCard("ValidNum") * 30
Else
rsUser("ValidNum") = rsUser("ValidNum") + rsCard("ValidNum") * 365
End If
Else
rsUser("ValidNum") = rsUser("ValidNum") + rsCard("ValidNum") * 12
End If
rsUser.Update
Else
If rsCard("ValidUnit") = 1 Then
If rsUser("ValidUnit") = 2 Then
rsUser("ValidNum") = rsCard("ValidNum") + rsUser("ValidNum") * 30
Else
rsUser("ValidNum") = rsCard("ValidNum") + rsUser("ValidNum") * 365
End If
Else
rsUser("ValidNum") = rsCard("ValidNum") + rsUser("ValidNum") * 12
End If
rsUser("ValidUnit") = rsCard("ValidUnit")
rsUser.Update
Call AddRechargeLog("System", UserName, 0, 0, 0, "充值卡充值时更改有效期计费单位。卡号：" & rsCard("CardNum") & "")
End If
strMsg = strMsg & "您充值后的有效期：" & rsUser("ValidNum") & arrCardUnit(rsUser("ValidUnit")) & "<br>"
Else
strMsg = strMsg & "您充值前有效期已经过期 " & Abs(ValidDays) & " 天<br>"
rsUser("BeginTime") = Now()
rsUser("ValidNum") = rsCard("ValidNum")
rsUser("ValidUnit") = rsCard("ValidUnit")
rsUser.Update
strMsg = strMsg & "您充值后的有效期：" & rsUser("ValidNum") & arrCardUnit(rsUser("ValidUnit")) & "，开始计算日期：" & Date & "<br>"
Call AddRechargeLog("System", UserName, 0, 0, 0, "充值卡充值时将原来过期的有效期重新计算。卡号：" & rsCard("CardNum") & "")
End If
Call AddRechargeLog("System", UserName, rsCard("ValidNum"), rsCard("ValidUnit"), 1, "充值卡充值。卡号：" & rsCard("CardNum") & "")
End If
End Select
If FoundErr = False Then
rsCard("UserName") = UserName
rsCard("UseTime") = Now()
rsCard.Update
Call WriteSuccessMsg(strMsg, "")
End If
rsUser.Close
Set rsUser = Nothing
rsCard.Close
Set rsCard = Nothing
End Sub
Sub SaveSendPoint()
If UserSetting(20) = 0 Then
FoundErr = True
ErrMsg = ErrMsg & "<li>不允许将" & PointName & "赠送给他人！</li>"
Exit Sub
End If
Dim SendObject, SendPoint, i, j
Dim arrSendObject
Dim rsUser, rsObject
SendObject = Trim(Request("SendObject"))
SendPoint = PE_CLng(Trim(Request("SendPoint")))
If SendObject = "" Then
FoundErr = True
ErrMsg = ErrMsg & "<li>请输入对方的用户名！</li>"
Else
If CheckBadChar(SendObject) = False Then
ErrMsg = ErrMsg + "<li>用户名中含有非法字符</li>"
FoundErr = True
End If
End If
If SendPoint <= 0 Then
FoundErr = True
ErrMsg = ErrMsg & "<li>您还未输入" & PointName & "数或输入的" & PointName & "数中存在非法字符！</li>"
End If
If FoundErr = True Then
Exit Sub
End If
j = 0
arrSendObject = Split(SendObject, ",")
Set rsUser = Conn.Execute("select * from PE_User where UserID=" & UserID & "")
If rsUser("UserPoint") - SendPoint * (UBound(arrSendObject) + 1) < 0 Then
FoundErr = True
ErrMsg = ErrMsg & "<li>您的" & PointName & "不够！</li>"
Exit Sub
Else
For i = 0 To UBound(arrSendObject)
Set rsObject = Conn.Execute("select UserID from PE_User where UserName='" & arrSendObject(i) & "'")
If Not rsObject.EOF Then
Conn.Execute "Update PE_User set UserPoint=UserPoint + " & SendPoint & " where UserName='" & arrSendObject(i) & "'"
Conn.Execute "Update PE_User set UserPoint=UserPoint - " & SendPoint & " where UserID=" & UserID
Call AddConsumeLog("System", 0, UserName, 0, SendPoint, 2, "向" & arrSendObject(i) & "用户赠送" & PointName & "")
Call AddConsumeLog("System", 0, arrSendObject(i), 0, SendPoint, 1, "获得" & UserName & "用户赠送的" & PointName & "")
Conn.Execute "Insert into PE_Message (Incept,Sender,Title,IsSend,Content,Flag) values('" & arrSendObject(i) & "','" & UserName & "','获赠" & PointName & "',1,'" & UserName & "赠给您" & PointName & "" & SendPoint & PointUnit & "',0)"
Else
j = j + 1
End If
Set rsObject = Nothing
Next
If j = 0 Then
Call WriteSuccessMsg(PointName & "赠送成功！", ComeUrl)
Else
Call WriteSuccessMsg("对" & UBound(arrSendObject) - j + 1 & "位用户赠送成功！其中有" & j & "位用户不存在！", ComeUrl)
End If
End If
rsUser.Close
Set rsUser = Nothing
End Sub
Function GetValidNum(intValidNum, intValidUnit)
If intValidUnit = 5 Then
Dim rsGroupList
Set rsGroupList = Conn.Execute("Select GroupName from PE_UserGroup where GroupID = " & intValidNum)
If Not (rsGroupList.EOF And rsGroupList.BOF) Then
GetValidNum = rsGroupList("GroupName")
Else
GetValidNum = intValidNum
End If
rsGroupList.Close
Set rsGroupList = Nothing
Else
GetValidNum = intValidNum
End If
End Function
'**************************************************
'函数名：ValidNumToValidDays
'作 用：转换有效期为有效天数
'参 数：iValidNum ----有效期
' iValidUnit ----有效期单位
' iBeginTime ---- 开始计算日期
'返回值：有效天数
'**************************************************
Function ValidNumToValidDays(iValidNum, iValidUnit, iBeginTime)
If (iValidNum = "" Or IsNumeric(iValidNum) = False Or iValidUnit = "" Or IsNumeric(iValidUnit) = False Or iBeginTime = "" Or IsDate(iBeginTime) = False) Then
ValidNumToValidDays = 0
Exit Function
End If
Dim tmpDate, arrInterval
arrInterval = Array("h", "D", "m", "yyyy")
If iValidNum = -1 Then
ValidNumToValidDays = 99999
Else
ValidNumToValidDays = DateDiff("D", iBeginTime, DateAdd(arrInterval(iValidUnit), iValidNum, iBeginTime))
End If
End Function
%>
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -