payonline.asp

个人网站比较简短

        </tr>
      </table></td>
  </tr>
  <tr>
    <td class=main_shadow></td>
  </tr>
</table>
</form>
<%
End Sub


Sub Step2()
    Dim vMoney
    Dim v_amount, v_mid, v_url, v_oid, v_moneytype, v_orderstatus, key_key, md5string
    Dim v_ymd, v_hms
    Dim v_ShowResultUrl
    v_ymd = Year(Date) & Right("0" & Month(Date), 2) & Right("0" & Day(Date), 2)
    v_hms = Right("0" & Hour(Time), 2) & Right("0" & Minute(Time), 2) & Right("0" & Second(Time), 2)
    vMoney = Trim(Request.Form("vMoney"))

    PlatformID = Trim(Request("PlatformID"))
    If PlatformID = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>请指定在线支付平台ID</li>"
    Else
        PlatformID = PE_CLng(PlatformID)
    End If

    If FoundErr = True Then Exit Sub

    Dim rsPayPlatform
    Set rsPayPlatform = Conn.Execute("select * from PE_PayPlatform where PlatformID=" & PlatformID & "")
    If rsPayPlatform.BOF And rsPayPlatform.EOF Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>找不到指定的在线支付平台！</li>"
    Else
        PlatformName = rsPayPlatform("ShowName")
        AccountsID = rsPayPlatform("AccountsID")
        MD5Key = rsPayPlatform("MD5Key")
        Rate = rsPayPlatform("Rate")
        PlusPoundage = rsPayPlatform("PlusPoundage")
    End If
    Set rsPayPlatform = Nothing
    
    If OrderFormID > 0 Then
        vMoney = FormatNumber(dblMoneyNeedPay, 2, vbTrue, vbFalse, vbTrue)
         'vMoney=dblMoneyTotal
    Else
        vMoney = Trim(Request("vMoney"))
    End If
    If vMoney = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>请输入划款金额！</li>"
    Else
        vMoney = Abs(PE_CDbl(vMoney))
        If vMoney < 0.01 Then
            FoundErr = True
            ErrMsg = ErrMsg & "<li>每次划款金额不能低于0.01元！</li>"
        Else
            If PlatformID = 11 Then
                If PlusPoundage = True Then
                    v_amount = Round(vMoney + vMoney * (Rate / 100), 1) '手续费
                Else
                    v_amount = vMoney
                End If
                Dim intMoney
                intMoney = Int(v_amount)
                If intMoney < v_amount Then
                    v_amount = intMoney + 1
                Else
                    v_amount = intMoney    '快钱神州行支付金额为整数值
                End If
            Else
                vMoney = Round(vMoney, 2)
                If PlusPoundage = True Then
                    v_amount = Round(vMoney + vMoney * (Rate / 100), 2) '手续费
                Else
                    v_amount = vMoney
                End If
            End If
        End If
    End If

    If FoundErr = True Then Exit Sub


    '得到PaymentID
    Dim PaymentID, PaymentNum
    Dim rsPayment, sqlPayment
    Dim trs, strHiddenField
    
    PaymentNum = Prefix_PaymentNum & v_ymd & v_hms
    
    PaymentID = GetNewID("PE_Payment", "PaymentID")
    sqlPayment = "select top 1 * from PE_Payment"
    Set rsPayment = Server.CreateObject("adodb.recordset")
    rsPayment.Open sqlPayment, Conn, 1, 3
    rsPayment.AddNew
    rsPayment("PaymentID") = PaymentID
    rsPayment("UserName") = UserName
    rsPayment("OrderFormID") = OrderFormID
    rsPayment("PaymentNum") = PaymentNum
    rsPayment("eBankID") = PlatformID
    rsPayment("MoneyPay") = vMoney
    rsPayment("MoneyTrue") = v_amount
    rsPayment("PayTime") = Now()
    rsPayment("Status") = 1
    rsPayment("eBankInfo") = ""
    rsPayment("Remark") = ""
    rsPayment.Update
    rsPayment.Close
    Set rsPayment = Nothing
    

    v_mid = AccountsID
    v_moneytype = "0"               '0为rmb 1为dollor
    v_orderstatus = "1"             '0未配齐 1为配齐
    v_url = "http://" & Trim(Request.ServerVariables("HTTP_HOST")) & Trim(Request.ServerVariables("SCRIPT_NAME"))
    v_ShowResultUrl = Left(v_url, InStrRev(v_url, "/")) & "ShowResult.asp"
    v_url = Left(v_url, InStrRev(v_url, "/")) & "PayResult" & PlatformID & ".asp"

    v_oid = PaymentNum
    v_amount = FormatNumber(v_amount, 2, vbTrue, vbFalse, vbFalse)

    Select Case PlatformID
    Case 1 '网银在线
        PayGateUrl = "https://pay3.chinabank.com.cn/PayGate"
        v_oid = PaymentNum
        md5string = UCase(Trim(MD5(v_amount & v_moneytype & v_oid & v_mid & v_url & MD5Key, 32)))
        strHiddenField = strHiddenField & "<input type='hidden' name='v_md5info' value='" & md5string & "'>" & vbCrLf
        strHiddenField = strHiddenField & "<input type='hidden' name='v_mid' value='" & v_mid & "'>" & vbCrLf
        strHiddenField = strHiddenField & "<input type='hidden' name='v_oid' value='" & v_oid & "'>" & vbCrLf
        strHiddenField = strHiddenField & "<input type='hidden' name='v_amount' value='" & v_amount & "'>" & vbCrLf
        strHiddenField = strHiddenField & "<input type='hidden' name='v_moneytype'  value='" & v_moneytype & "'>" & vbCrLf
        strHiddenField = strHiddenField & "<input type='hidden' name='v_url' value='" & v_url & "'>" & vbCrLf
    Case 2  '中国在线支付网
        PayGateUrl = "http://www.ipay.cn/4.0/bank.shtml"
        v_oid = v_ymd & v_hms
        md5string = LCase(MD5(v_mid & v_oid & v_amount & "[e-mail]13800138000" & MD5Key, 32))
        strHiddenField = strHiddenField & "<input type='hidden' name='v_mid' value='" & v_mid & "'>" & vbCrLf
        strHiddenField = strHiddenField & "<input type='hidden' name='v_oid' value='" & v_oid & "'>" & vbCrLf
        strHiddenField = strHiddenField & "<input type='hidden' name='v_amount' value='" & v_amount & "'>" & vbCrLf
        strHiddenField = strHiddenField & "<input type='hidden' name='v_email' value='[e-mail]'>" & vbCrLf
        strHiddenField = strHiddenField & "<input type='hidden' name='v_mobile' value='13800138000'>" & vbCrLf
        strHiddenField = strHiddenField & "<input type='hidden' name='v_md5'    value='" & md5string & "'>" & vbCrLf
        strHiddenField = strHiddenField & "<input type='hidden' name='v_url' value='" & v_url & "'>" & vbCrLf
    Case 3  '上海环迅
        PayGateUrl = "http://pay.ips.com.cn/ipayment.aspx"   '正式接口
        'PayGateUrl = "http://pay.ips.net.cn/ipayment.aspx"   '测试接口
        md5string = LCase(MD5(v_oid & v_amount & v_ymd & "RMB" & MD5Key, 32))
        strHiddenField = strHiddenField & "<input type='hidden' name='mer_code' value='" & v_mid & "'>"
        strHiddenField = strHiddenField & "<input type='hidden' name='billNo' value='" & v_oid & "'>"
        strHiddenField = strHiddenField & "<input type='hidden' name='amount' value='" & v_amount & "'>"
        strHiddenField = strHiddenField & "<input type='hidden' name='date' value='" & v_ymd & "'>"
        strHiddenField = strHiddenField & "<input type='hidden' name='lang' value='GB'>"
        strHiddenField = strHiddenField & "<input type='hidden' name='Gateway_type' value='01'>"
        strHiddenField = strHiddenField & "<input type='hidden' name='Currency_Type' value='RMB'>"
        strHiddenField = strHiddenField & "<input type='hidden' name='Merchanturl' value='" & v_url & "'>"
        strHiddenField = strHiddenField & "<input type='hidden' name='OrderEncodeType' value='2'>"
        strHiddenField = strHiddenField & "<input type='hidden' name='RetEncodeType' value='12'>"
        strHiddenField = strHiddenField & "<input type='hidden' name='RetType' value='0'>"
        strHiddenField = strHiddenField & "<input type='hidden' name='SignMD5' value='" & md5string & "'>"
        strHiddenField = strHiddenField & "<input type='hidden' name='ServerUrl' value=''>"
    Case 4  '中国银联广州分公司
        PayGateUrl = "http://218.19.140.170/Bin/Scripts/OpenVendor/Gnete/V34/GetOvOrder.asp"

        Dim RcvCertPath, SendCertPath, SendCertPWD, MerId, OrderNo, OrderAmount, CurrCode, CallBackUrl, ResultMode
        Dim Reserved01, Reserved02, SourceText, obj, EncryptedMsg, SignedMsg, bolRet, nPayStat
        
        MerId = v_mid                           '商户ID参数
        OrderNo = v_oid            '商户订单号
        OrderAmount = v_amount    '订单金额，格式：元.角分
        CurrCode = "CNY"          '货币代码，值为：CNY
        CallBackUrl = v_url    '支付结果接收URL
        ResultMode = "0"                '支付结果返回方式(0-成功和失败支付结果均返回；1-仅返回成功支付结果)
        Reserved01 = ""                 '保留域1
        Reserved02 = ""                 '保留域2
        
        SendCertPath = "c:\certs\MERCHANT.pfx"          '发送方证书路径(商户证书)
        RcvCertPath = "c:\certs\GNETEWEB-TEST.cer"          '接收方证书路径(银联证书)
        SendCertPWD = "12345678"      '发送方证书密码(商户证书)
        
        '组合成订单原始数据
        SourceText = "MerId=" & MerId & "&" & _
                  "OrderNo=" & OrderNo & "&" & _
                  "OrderAmount=" & OrderAmount & "&" & _
                  "CurrCode=" & CurrCode & "&" & _
                  "CallBackUrl=" & CallBackUrl & "&" & _
                  "ResultMode=" & ResultMode & "&" & _
                  "Reserved01=" & Reserved01 & "&" & _
                  "Reserved02=" & Reserved02
        
        Set obj = Server.CreateObject("OpenVendorV34.NetTran")
    
        '使用接收方证书对订单原始数据进行加密
        If obj.EncryptMsg(SourceText, RcvCertPath) = 0 Then
            EncryptedMsg = obj.LastResult
        Else
            Response.Write obj.LastErrMsg
            Exit Sub
        End If
        
        '使用发送方证书对订单原始数据进行签名
        If obj.SignMsg(SourceText, SendCertPath, SendCertPWD) = 0 Then
            SignedMsg = obj.LastResult
        Else
            Response.Write obj.LastErrMsg