admin_card.asp

个人网站比较简短

    Response.Write "      <td width='40%' align='right'><strong>代理商：</strong></td>" & vbCrLf
    Response.Write "      <td width='60%'><input name='AgentName' type='text' value='" & rsCard("AgentName") & "' size='20' maxlength='20'></td>" & vbCrLf
    Response.Write "    </tr>" & vbCrLf
    Response.Write "    <tr align='center' class='tdbg'>" & vbCrLf
    Response.Write "      <td height='30' colspan='2'><input name='Action' type='hidden' id='Action' value='SaveModify'>" & vbCrLf
    Response.Write "      <input name='CardID' type='hidden' id='CardID' value='" & CardID & "'>" & vbCrLf
    Response.Write "      <input type='submit' name='Submit' value='保存修改结果'></td>" & vbCrLf
    Response.Write "    </tr>" & vbCrLf
    Response.Write "  </table>" & vbCrLf
    Response.Write "</form>" & vbCrLf
    Set rsCard = Nothing
End Sub

Sub Show()
    Dim CardID, rsCard
    CardID = Trim(Request("CardID"))
    If CardID = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>请指定要删除的充值卡ID</li>"
        Exit Sub
    Else
        CardID = PE_CLng(CardID)
    End If
    Set rsCard = Conn.Execute("select * from PE_Card where CardID=" & CardID & "")
    If rsCard.Bof And rsCard.EOF Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>找不到指定的充值卡！</li>"
    End If
    If FoundErr = True Then
        Set rsCard = Nothing
        Exit Sub
    End If
    Response.Write "<br><table width='100%'  border='0' cellpadding='2' cellspacing='1' class='border'>" & vbCrLf
    Response.Write "    <tr align='center'>" & vbCrLf
    Response.Write "      <td colspan='2' class='title'><strong>查 看 充 值 卡 信 息</strong></td>" & vbCrLf
    Response.Write "    </tr>" & vbCrLf
    Response.Write "    <tr class='tdbg'>" & vbCrLf
    Response.Write "      <td width='40%' align='right'><b>充值卡类型：</b></td>" & vbCrLf
    Response.Write "      <td>"
    If rsCard("CardType") = 0 Then
        Response.Write "本站充值卡"
    Else
        Response.Write "其他公司卡"
    End If
    Response.Write "</td>" & vbCrLf
    Response.Write "    </tr>" & vbCrLf
    Response.Write "    <tr class='tdbg'>" & vbCrLf
    Response.Write "      <td width='40%' align='right'><b>所属商品：</b></td>" & vbCrLf
    Response.Write "      <td>" & GetProductName(rsCard("ProductID")) & "</td>" & vbCrLf
    Response.Write "    </tr>" & vbCrLf
    Response.Write "    <tr class='tdbg'>" & vbCrLf
    Response.Write "      <td width='40%' align='right'><b>充值卡卡号：</b></td>" & vbCrLf
    Response.Write "      <td>" & rsCard("CardNum") & "</td>" & vbCrLf
    Response.Write "    </tr>" & vbCrLf
    Response.Write "    <tr class='tdbg'>" & vbCrLf
    Response.Write "      <td width='40%' align='right'><b>充值卡密码：</b></td>" & vbCrLf
    Response.Write "      <td>" & Base64decode(rsCard("Password")) & "</td>" & vbCrLf
    Response.Write "    </tr>" & vbCrLf
    Response.Write "    <tr class='tdbg'>" & vbCrLf
    Response.Write "      <td width='40%' align='right'><b>充值卡面值：</b></td>" & vbCrLf
    Response.Write "      <td>" & rsCard("Money") & " 元</td>" & vbCrLf
    Response.Write "    </tr>" & vbCrLf
    Response.Write "    <tr class='tdbg'>" & vbCrLf
    Response.Write "      <td width='40%' align='right'><b>充值卡点数：</b></td>" & vbCrLf
    Response.Write "      <td>" & GetValidNum(rsCard("ValidNum"), rsCard("ValidUnit")) & arrCardUnit(rsCard("ValidUnit")) & "</td>" & vbCrLf
    Response.Write "    </tr>" & vbCrLf
    Response.Write "    <tr class='tdbg'>" & vbCrLf
    Response.Write "      <td width='40%' align='right'><b>充值截止日期：</b></td>" & vbCrLf
    Response.Write "      <td>" & rsCard("EndDate") & "</td>" & vbCrLf
    Response.Write "    </tr>" & vbCrLf
    Response.Write "    <tr class='tdbg'>" & vbCrLf
    Response.Write "      <td width='40%' align='right'><b>充值卡生成时间：</b></td>" & vbCrLf
    Response.Write "      <td>" & rsCard("CreateTime") & "</td>" & vbCrLf
    Response.Write "    </tr>" & vbCrLf
    Response.Write "    <tr class='tdbg'>" & vbCrLf
    Response.Write "      <td width='40%' align='right'><b>充值卡状态：</b></td>" & vbCrLf
    Response.Write "      <td>"

        If rsCard("UserName") <> "" Then
            Response.Write "已使用"
        Else
            If rsCard("OrderFormItemID") > 0 Then
                Response.Write "已售出"
            Else
                If rsCard("EndDate") < Date Then
                    Response.Write "<font color='red'>已失效</font>"
                Else
                    If rsCard("ProductID") > 0 Then
                        Response.Write "<font color='green'>未售出</font>"
                    Else
                        Response.Write "<font color='green'>未使用</font>"
                    End If
                End If
            End If
        End If
    Response.Write "</td>" & vbCrLf
    Response.Write "    </tr>" & vbCrLf
    Response.Write "    <tr class='tdbg'>" & vbCrLf
    Response.Write "      <td width='40%' align='right'><b>使用者：</b></td>" & vbCrLf
    Response.Write "      <td>" & rsCard("UserName") & "</td>" & vbCrLf
    Response.Write "    </tr>" & vbCrLf
    Response.Write "    <tr class='tdbg'>" & vbCrLf
    Response.Write "      <td width='40%' align='right'><b>充值时间：</b></td>" & vbCrLf
    Response.Write "      <td>" & rsCard("UseTime") & "</td>" & vbCrLf
    Response.Write "    </tr>" & vbCrLf
    Response.Write "    <tr class='tdbg'> " & vbCrLf
    Response.Write "      <td width='40%' align='right'><strong>代理商：</strong></td>" & vbCrLf
    Response.Write "      <td width='60%'>" & rsCard("AgentName") & "</td>" & vbCrLf
    Response.Write "    </tr>" & vbCrLf
    Response.Write "  </table>" & vbCrLf
    Set rsCard = Nothing
End Sub

Sub DoBatchAdd()
    Dim arrCardNum, arrPassword, CardNum, Password
    Dim ProductID, Nums, CardNumStr, PasswordStr, Money, ValidNum, ValidUnit, EndDate, AgentName
    arrCardNum = ""
    arrPassword = ""
    ProductID = PE_CLng(Trim(Request.Form("ProductID")))
    Nums = PE_CLng(Trim(Request.Form("Nums")))
    'CardNumPrefix = Trim(Request("CardNumPrefix"))
    CardNumStr = Trim(Request.Form("CardNumStr"))
    PasswordStr = Trim(Request.Form("PasswordStr"))
    Money = PE_CDbl(Trim(Request.Form("Money")))
    ValidUnit = PE_CLng(Trim(Request.Form("ValidUnit")))
    If ValidUnit = 5 Then
        ValidNum = PE_CLng(Trim(Request.Form("GroupList")))
    Else
        ValidNum = PE_CLng(Trim(Request.Form("ValidNum")))
    End If
    EndDate = Trim(Request.Form("EndDate"))
    AgentName = Trim(Request.Form("AgentName"))
    If Nums < 0 Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>请指定要生成的充值卡数量！</li>"
    End If
    If CardNumStr = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>请指定充值卡卡号规则！</li>"
    End If
    If PasswordStr = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>请指定充值卡密码规则！</li>"
    End If
    If Money <= 0 Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>请指定充值卡的面值！</li>"
    End If
    If ValidNum <= 0 Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>请指定充值卡的点数！</li>"
    End If
    If IsDate(EndDate) = False Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>请指定正确的充值截止日期！</li>"
    Else
        EndDate = CDate(EndDate)
        If EndDate <= Date Then
            FoundErr = True
            ErrMsg = ErrMsg & "<li>充值截止日期不能比当前日期还早</li>"
        End If
    End If
    If FoundErr = True Then Exit Sub
    
    Dim sqlCard, rsCard, i
    sqlCard = "select top 1 * from PE_Card"
    Set rsCard = Server.CreateObject("adodb.recordset")
    rsCard.Open sqlCard, Conn, 1, 3
    For i = 1 To Nums
        CardNum = GetRndCharAndNum(CardNumStr)
        Password = GetRndCharAndNum(PasswordStr)
        If arrCardNum = "" Then
            arrCardNum = CardNum
            arrPassword = Password
        Else
            arrCardNum = arrCardNum & "," & CardNum
            arrPassword = arrPassword & "," & Password
        End If
        rsCard.AddNew
        rsCard("CardType") = 0
        rsCard("ProductID") = ProductID
        rsCard("CardNum") = CardNum
        rsCard("Password") = Base64encode(Password)
        rsCard("Money") = Money
        rsCard("ValidNum") = ValidNum
        rsCard("ValidUnit") = ValidUnit
        rsCard("EndDate") = EndDate
        rsCard("AgentName") = AgentName
        rsCard("UserName") = ""
        rsCard("CreateTime") = Now()
        rsCard("OrderFormItemID") = 0
        rsCard.Update
    Next
    rsCard.Close
    Set rsCard = Nothing
    If ProductID > 0 Then
        Conn.Execute ("update PE_Product set Stocks=Stocks+" & Nums & " where ProductID=" & ProductID & "")
    End If
    
    arrCardNum = Split(arrCardNum, ",")
    arrPassword = Split(arrPassword, ",")
    
    Response.Write "  <br>" & vbCrLf
    Response.Write "  <table width='300'  border='0' align='center' cellpadding='2' cellspacing='1' class='border'>" & vbCrLf
    Response.Write "    <tr class='title'>" & vbCrLf
    Response.Write "      <td colspan='2' align='center'><strong>本次生成的点卡信息如下：</strong></td>" & vbCrLf
    Response.Write "    </tr>" & vbCrLf
    Response.Write "    <tr class='tdbg'>" & vbCrLf
    Response.Write "      <td width='100'>充值卡所属商品：</td>" & vbCrLf
    Response.Write "      <td>" & GetProductName(ProductID) & "</td>" & vbCrLf
    Response.Write "    </tr>" & vbCrLf
    Response.Write "    <tr class='tdbg'>" & vbCrLf
    Response.Write "      <td width='100'>充值卡数量：</td>" & vbCrLf
    Response.Write "      <td>" & Nums & "</td>" & vbCrLf
    Response.Write "    </tr>" & vbCrLf
    Response.Write "    <tr class='tdbg'>" & vbCrLf
    Response.Write "      <td width='100'>充值卡面值：</td>" & vbCrLf
    Response.Write "      <td>" & Money & " 元</td>" & vbCrLf
    Response.Write "    </tr>" & vbCrLf
    Response.Write "    <tr class='tdbg'>" & vbCrLf
    Response.Write "      <td width='100'>充值卡点数：</td>" & vbCrLf
    Response.Write "      <td>" & GetValidNum(ValidNum, ValidUnit) & arrCardUnit(ValidUnit) & "</td>" & vbCrLf
    Response.Write "    </tr>" & vbCrLf
    Response.Write "    <tr class='tdbg'>" & vbCrLf
    Response.Write "      <td width='100'>充值截止日期：</td>" & vbCrLf
    Response.Write "      <td>" & EndDate & "</td>" & vbCrLf
    Response.Write "    </tr>" & vbCrLf
    Response.Write "    <tr class='tdbg'>" & vbCrLf
    Response.Write "      <td width='100'>代理商：</td>" & vbCrLf
    Response.Write "      <td>" & AgentName & "</td>" & vbCrLf
    Response.Write "    </tr>" & vbCrLf
    Response.Write "</table><br>" & vbCrLf
    Response.Write "<table width='300' border='0' align='center' cellpadding='2' cellspacing='1' class='border'>" & vbCrLf
    Response.Write "  <tr align='center' class='title'>" & vbCrLf
    Response.Write "    <td  width=150 height='22'><strong> 卡 号 </strong></td>" & vbCrLf
    Response.Write "    <td  width=150 height='22'><strong> 密 码 </strong></td>" & vbCrLf
    Response.Write "  </tr>" & vbCrLf
    For i = 0 To Nums - 1
        Response.Write "  <tr align='center' class='tdbg' onmouseout=""this.className='tdbg'"" onmouseover=""this.className='tdbgmouseover'"">" & vbCrLf
        Response.Write "    <td>" & arrCardNum(i) & "</td>" & vbCrLf
        Response.Write "    <td>" & arrPassword(i) & "</td>" & vbCrLf
        Response.Write "  </tr>" & vbCrLf
    Next
    Response.Write "</table>" & vbCrLf
End Sub

'PE###?#*
'PE???###?#*
'每个?代表一个英文字母，
'#代表一个数字，
'*代表一个英文字母或数字(自定义符号必须是半角)
Function GetRndCharAndNum(str)
    Dim arrNum, arrChar, arrMix, strLen, strTemp, i, c
    arrNum = Array("0", "1", "2", "3", "4", "5", "6", "7", "8", "9")
    arrChar = Array("a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z", "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z")
    arrMix = Array("0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z", "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z")
    strLen = Len(str)
    strTemp = ""
    For i = 1 To strLen + 1
        c = Mid(str, i, 1)
     '   Randomize
        Select Case c
        Case "?"
            '10, 62
            strTemp = strTemp & arrChar(CInt(Rnd * 51))
        Case "#"
            '0, 10
            strTemp = strTemp & arrNum(CInt(Rnd * 9))
        Case "*"
            '62
            strTemp = strTemp & arrMix(CInt(Rnd * 61))
        Case Else
            strTemp = strTemp & c
        End Select
    Next
    GetRndCharAndNum = strTemp
End Function

Sub SaveAdd()
    Dim rsCard
    Dim ProductID, CardType
    Dim AddType
    Dim CardNum, Password, Money, ValidNum, ValidUnit, EndDate, AgentName
    Dim CardText, strSplit
    
    CardType = PE_CLng(Trim(Request.Form("CardType")))