木子屋 Dnawo's BLOG

PowerEasy® SiteWeaver™ CMS 6.5点券、有效期兑换多扣修正

👤 dnawo 📅 2008-02-18 👁 5669 👍 0 💬 0 🔄 来源：本站原创
假设资金与点券的兑换比率是1:1，当输入资金1.9兑换点券时，提示的是"成功将1.9元资金兑换成1点券"，查看资金余额你会发现被扣了1.9，而点券只增加了1，也就是说，其中0.9元被多扣了！积分与点券的兑换也存在同样的问题！在User\User_Exchange_Code.asp中找到相关函数SaveExchange内容如下：

Sub SaveExchange()
    If UserSetting(18) = 0 Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>不允许进行自助兑换" & PointName & "！</li>"
        Exit Sub
    End If

    Dim rsUser, sqlUser
    Dim ChangeType, ChangeMoney, ChangeExp, GetPoint
    ChangeType = Abs(PE_CLng(Trim(Request("ChangeType"))))
    ChangeMoney = Abs(PE_CDbl(Trim(Request("ChangeMoney"))))
    ChangeExp = Abs(PE_CLng(Trim(Request("ChangeExp"))))

    If ChangeType = 1 Then '使用货币
        If ChangeMoney = 0 Then
            FoundErr = True
            ErrMsg = ErrMsg & "<li>请输入要兑换的资金数！</li>"
        Else
            If ChangeMoney > Balance Then
                FoundErr = True
                ErrMsg = ErrMsg & "<li>输入的资金数大于您的资金余额！</li>"
            Else
                If Fix(ChangeMoney / MoneyExchangePoint) < 1 Then
                    FoundErr = True
                    ErrMsg = ErrMsg & "<li>输入的资金数不足以兑换 1 " & PointUnit & PointName & "！</li>"
                End If
            End If
        End If
    Else  '使用积分
        If ChangeExp = 0 Then
            FoundErr = True
            ErrMsg = ErrMsg & "<li>请输入要减去的积分数！</li>"
        Else
            If ChangeExp > UserExp Then
                FoundErr = True
                ErrMsg = ErrMsg & "<li>输入的积分数大于您的可用积分！</li>"
            Else
                If Fix(ChangeExp / UserExpExchangePoint) < 1 Then
                    FoundErr = True
                    ErrMsg = ErrMsg & "<li>输入的积分数不足以兑换 1 " & PointUnit & PointName & "！</li>"
                End If
            End If
        End If
    End If

    If FoundErr = True Then
        Exit Sub
    End If

    Set rsUser = Server.CreateObject("Adodb.RecordSet")
    sqlUser = "select * from PE_User where UserID=" & UserID
    rsUser.Open sqlUser, Conn, 1, 3

    If ChangeType = 1 Then
        GetPoint = Fix(ChangeMoney / MoneyExchangePoint)
        [color=Blue]rsUser("Balance") = rsUser("Balance") - ChangeMoney[/color]
        rsUser("UserPoint") = rsUser("UserPoint") + GetPoint
        Call AddBankrollItem("System", UserName, ClientID, ChangeMoney, 4, "", 0, 2, 0, 0, "用于兑换 " & GetPoint & " " & PointUnit & PointName, Now())
        Call AddConsumeLog("System", 0, UserName, 0, GetPoint, 1, "将 " & ChangeMoney & " 元资金兑换成 " & GetPoint & " " & PointUnit & PointName)
        Call WriteSuccessMsg("成功将 " & ChangeMoney & " 元资金兑换成 " & GetPoint & " " & PointUnit & PointName & " ！", ComeUrl)
    Else
        GetPoint = Fix(ChangeExp / UserExpExchangePoint)
        [color=Blue]rsUser("UserExp") = rsUser("UserExp") - ChangeExp[/color]
        rsUser("UserPoint") = rsUser("UserPoint") + GetPoint
        Call AddConsumeLog("System", 0, UserName, 0, GetPoint, 1, "将 " & ChangeExp & " 分积分兑换成 " & GetPoint & " " & PointUnit & PointName)
        Call WriteSuccessMsg("成功将 " & ChangeExp & " 分积分兑换成 " & GetPoint & " " & PointUnit & PointName & " ！", ComeUrl)
    End If

    rsUser.Update
    rsUser.Close
    Set rsUser = Nothing
End Sub

注意其中的蓝色部分，都是直接减去输入的值，没有考虑到输入的值可能不是兑换比率的倍数，所以才出现了上述多扣现象，解决的方法是减去输入的值后还应加上相除的余数部分，修改后的代码如下：

Sub SaveExchange()
    If UserSetting(18) = 0 Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>不允许进行自助兑换" & PointName & "！</li>"
        Exit Sub
    End If

    Dim rsUser, sqlUser
    Dim ChangeType, ChangeMoney, ChangeExp, GetPoint[color=Blue], ChangeMoney2, ChangeExp2[/color]
    ChangeType = Abs(PE_CLng(Trim(Request("ChangeType"))))
    ChangeMoney = Abs(PE_CDbl(Trim(Request("ChangeMoney"))))
    ChangeExp = Abs(PE_CLng(Trim(Request("ChangeExp"))))

    If ChangeType = 1 Then '使用货币
        If ChangeMoney = 0 Then
            FoundErr = True
            ErrMsg = ErrMsg & "<li>请输入要兑换的资金数！</li>"
        Else
            If ChangeMoney > Balance Then
                FoundErr = True
                ErrMsg = ErrMsg & "<li>输入的资金数大于您的资金余额！</li>"
            Else
                If Fix(ChangeMoney / MoneyExchangePoint) < 1 Then
                    FoundErr = True
                    ErrMsg = ErrMsg & "<li>输入的资金数不足以兑换 1 " & PointUnit & PointName & "！</li>"
                End If
            End If
        End If
    Else  '使用积分
        If ChangeExp = 0 Then
            FoundErr = True
            ErrMsg = ErrMsg & "<li>请输入要减去的积分数！</li>"
        Else
            If ChangeExp > UserExp Then
                FoundErr = True
                ErrMsg = ErrMsg & "<li>输入的积分数大于您的可用积分！</li>"
            Else
                If Fix(ChangeExp / UserExpExchangePoint) < 1 Then
                    FoundErr = True
                    ErrMsg = ErrMsg & "<li>输入的积分数不足以兑换 1 " & PointUnit & PointName & "！</li>"
                End If
            End If
        End If
    End If

    If FoundErr = True Then
        Exit Sub
    End If

    Set rsUser = Server.CreateObject("Adodb.RecordSet")
    sqlUser = "select * from PE_User where UserID=" & UserID
    rsUser.Open sqlUser, Conn, 1, 3

    [color=Blue]If ChangeType = 1 Then
        GetPoint = Fix(ChangeMoney / MoneyExchangePoint)
		ChangeMoney2 = GetPoint * MoneyExchangePoint
        rsUser("Balance") = rsUser("Balance") - ChangeMoney2
        rsUser("UserPoint") = rsUser("UserPoint") + GetPoint
        Call AddBankrollItem("System", UserName, ClientID, ChangeMoney2, 4, "", 0, 2, 0, 0, "用于兑换 " & GetPoint & " " & PointUnit & PointName, Now())
        Call AddConsumeLog("System", 0, UserName, 0, GetPoint, 1, "将 " & ChangeMoney2 & " 元资金兑换成 " & GetPoint & " " & PointUnit & PointName)
        Call WriteSuccessMsg("成功将 " & ChangeMoney2 & " 元资金兑换成 " & GetPoint & " " & PointUnit & PointName & " ！", ComeUrl)
    Else
        GetPoint = Fix(ChangeExp / UserExpExchangePoint)
		ChangeExp2 = GetPoint * UserExpExchangePoint
        rsUser("UserExp") = rsUser("UserExp") - ChangeExp2
        rsUser("UserPoint") = rsUser("UserPoint") + GetPoint
        Call AddConsumeLog("System", 0, UserName, 0, GetPoint, 1, "将 " & ChangeExp2 & " 分积分兑换成 " & GetPoint & " " & PointUnit & PointName)
        Call WriteSuccessMsg("成功将 " & ChangeExp2 & " 分积分兑换成 " & GetPoint & " " & PointUnit & PointName & " ！", ComeUrl)
    End If[/color]

    rsUser.Update
    rsUser.Close
    Set rsUser = Nothing
End Sub

同样有效期兑换也存在同样的问题，修改User\User_Exchange_Code.asp的SaveValid函数如下：

Sub SaveValid()
    If UserSetting(19) = 0 Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>不允许进行自助兑换有效期！</li>"
        Exit Sub
    End If

    Dim rsUser, sqlUser
    Dim ChangeType, ChangeMoney, ChangeExp, GetValidDay[color=Blue], ChangeMoney2, ChangeExp2[/color]
    ChangeType = Abs(PE_CLng(Trim(Request("ChangeType"))))
    ChangeMoney = Abs(PE_CDbl(Trim(Request("ChangeMoney"))))
    ChangeExp = Abs(PE_CLng(Trim(Request("ChangeExp"))))

    If ChangeType = 1 Then '使用货币
        If ChangeMoney = 0 Then
            FoundErr = True
            ErrMsg = ErrMsg & "<li>请输入要兑换的资金数！</li>"
        Else
            If ChangeMoney > Balance Then
                FoundErr = True
                ErrMsg = ErrMsg & "<li>输入的资金数大于您的资金余额！</li>"
            Else
                If Fix(ChangeMoney / MoneyExchangeValidDay) < 1 Then
                    FoundErr = True
                    ErrMsg = ErrMsg & "<li>输入的资金数不足以兑换 1 天有效期！</li>"
                End If
            End If
        End If
    Else  '使用积分
        If ChangeExp = 0 Then
            FoundErr = True
            ErrMsg = ErrMsg & "<li>请输入要减去的积分数！</li>"
        Else
            If ChangeExp > UserExp Then
                FoundErr = True
                ErrMsg = ErrMsg & "<li>输入的积分数大于您的可用积分！</li>"
            Else
                If Fix(ChangeExp / UserExpExchangeValidDay) < 1 Then
                    FoundErr = True
                    ErrMsg = ErrMsg & "<li>输入的积分数不足以兑换 1 天有效期！</li>"
                End If
            End If
        End If
    End If

    If FoundErr = True Then
        Exit Sub
    End If
    
    Set rsUser = Server.CreateObject("Adodb.RecordSet")
    sqlUser = "select * from PE_User where UserID=" & UserID
    rsUser.Open sqlUser, Conn, 1, 3

    If rsUser("ValidNum") = -1 Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>您的有效期为“无限期”，无需兑换有效期。"
    Else
        [color=Blue]If ChangeType = 1 Then
            GetValidDay = Fix(ChangeMoney / MoneyExchangeValidDay)
			ChangeMoney2 = GetValidDay * MoneyExchangeValidDay
            rsUser("Balance") = rsUser("Balance") - ChangeMoney2
            Call AddBankrollItem("System", UserName, ClientID, ChangeMoney2, 4, "", 0, 2, 0, 0, "用于兑换 " & GetValidDay & " 天有效期", Now())
        Else
            GetValidDay = Fix(ChangeExp / UserExpExchangeValidDay)
			ChangeExp2 = GetValidDay * UserExpExchangeValidDay
            rsUser("UserExp") = rsUser("UserExp") - ChangeExp2
        End If[/color]

        If ValidDays > 0 Then
            If rsUser("ValidUnit") = 1 Then
                rsUser("ValidNum") = rsUser("ValidNum") + GetValidDay
                rsUser.Update
            Else
                rsUser("ValidNum") = ValidNumToValidDays(rsUser("ValidNum"), rsUser("ValidUnit"), rsUser("BeginTime")) + GetValidDay
                rsUser("ValidUnit") = 1
                rsUser.Update
                Call AddRechargeLog("System", UserName, 0, 0, 0, "兑换有效期时更改有效期计费单位")
            End If
        Else
            rsUser("BeginTime") = Now()
            rsUser("ValidNum") = GetValidDay
            rsUser("ValidUnit") = 1
            rsUser.Update
            Call AddRechargeLog("System", UserName, 0, 0, 0, "兑换有效期时将原来过期的有效期重新计算")
        End If

        [color=Blue]If ChangeType = 1 Then
            Call AddRechargeLog("System", UserName, GetValidDay, 1, 1, "将 " & ChangeMoney2 & " 元资金兑换成 " & GetValidDay & " 天有效期")
            Call WriteSuccessMsg("成功将 " & ChangeMoney2 & " 元资金兑换成 " & GetValidDay & " 天有效期！", ComeUrl)
        Else
            Call AddRechargeLog("System", UserName, GetValidDay, 1, 1, "将 " & ChangeExp2 & " 分积分兑换成 " & GetValidDay & " 天有效期")
            Call WriteSuccessMsg("成功将 " & ChangeExp2 & " 分积分兑换成 " & GetValidDay & " 天有效期！", ComeUrl)
        End If[/color]
    End If
    rsUser.Close
    Set rsUser = Nothing
End Sub

本次修改的版本为：PowerEasy® SiteWeaver™ CMS 6.5 Build 0128

评论（0）

暂无评论。

计算题
评论需审核通过后显示
← 上一篇 一次网上选购显示器历程 下一篇 → Serv-U搭建服务器连接出错：PORT 模式成功, 请更新你…