ASP微信支付類

2017-2-24 更新
每周幾乎都能收到 通過QQ、郵箱、和評論反饋的網友 的問題,現在重新整理了個demo,代碼已經托管至 http://git.oschina.net/mqycn/WechatASP,安裝證書的教程已經重新更新,請參考:http://www.okfdzs1809.com/p/winhttpcertcfg-mmpay
‘=====================分割線===========================================

感謝 Frank 的反饋,2016-11-9日文章已經重新編輯(更新內容:1、在項目中使用的 OrderWeChat.asp,博文中有的地方沒有改正,現在已經統一都是 WeChatPay.asp 了;2、在底部增加了wxapi.asp的說明)
‘=====================分割線===========================================

現在微信支付越來越普及,傳統的 ASP的電商 網站卻無法被惠及。官方不提供 ASP的SDK、ASP無法實現證書問題,讓無數asp開發者最終選擇了 通過php中轉的方式去實現 微信支付。這種方案實在無法令人滿意,本人查閱了無數資料,最終實現了純asp的微信支付方案。注意:因為需要安裝證書,必須有服務器權限,虛擬主機無法實現的。

首先需要安裝證書:到微軟官方下載winhttpcertcfg.exe(下載地址:http://www.microsoft.com/en-us/download/details.aspx?id=19801,使用說明:https://msdn.microsoft.com/en-us/library/aa384088.aspx#_using)。

現在安裝后,執行以下命令,即可安裝證書成功


::導入證書
winhttpcertcfg -g -i "apiclient_cert.p12" -c LOCAL_MACHINE\My -a "Network Service" -p 微信商戶ID

::設置 Network Serivce 擁有證書使用權限
winhttpcertcfg -g -c LOCAL_MACHINE\My -s "MMPay" -a "Network Service"

::設置 Everyone 擁有證書使用權限
winhttpcertcfg -g -c LOCAL_MACHINE\My -s "MMPay" -a "EveryOne"

為了和業務分離,寫成了單獨的類,直接上代碼(WeChatPay.asp):


'================================================================
'=                  微信支付類 by MiaoQiyuan.cn                 =
'================================================================
'=   類庫名稱:WeChatPay                                        =
'=   實現功能:封裝 微信支付(模式2)                           =
'=   作者主頁:http://www.okfdzs1809.com/                        =
'=   聯系郵箱:mqycn@126.com;                                   =
'================================================================
'=   使用說明:http://www.okfdzs1809.com/p/asp-wechat-pay        =
'=   最新版本:https://gitee.com/mqycn/WechatASP/               =
'================================================================
 
class WeChatPay

    public AppID
    public AppSecret
    public MchID
    public MchKey

    public orderAPI

    public notifyUrl
    public callbackUrl
    public actionName

    private BITS_TO_A_BYTE
    private BYTES_TO_A_WORD
    private BITS_TO_A_WORD

    public sub Class_Initialize()

        AppID       = "AppID"
        AppSecret   = "App密碼"
        MchID       = "商戶ID"
        MchKey      = "商戶API密鑰" '在 微信支付后臺 \ 帳戶中心 \ API安全,設置 API密鑰 中設置

        orderAPI    = "https://api.mch.weixin.qq.com/pay/unifiedorder"
        actionName  = "action"

        signType    = "MD5"

        notifyUrl   = ""

        call Md5Initial()
    end sub

    public sub Class_Terminate()
    end sub

    public function Pay(byval out_trade_no, byval subject, byval body, byval total_fee)
        if notifyUrl = "" then
            currentUrl =  "http://" & Request.Servervariables("SERVER_NAME") 
            if Request.Servervariables("SERVER_PORT") <> 80 then currentUrl = currentUrl & ":" & Request.Servervariables("SERVER_PORT")
            notifyUrl = currentUrl & "/order/wxapi.asp"
        end if
        total_fee = total_fee * 100

        '支付類型
        trade_type = "NATIVE" 'PC
        userAgent = lcase(Request.Servervariables("HTTP_USER_AGENT"))

        nonce_str = CreateNonceStr()

        OrderArr = Array("body=" & subject, "total_fee=" & total_fee, "out_trade_no=" & out_trade_no, "notify_url=" & notifyUrl, "spbill_create_ip=" & Request.Servervariables("REMOTE_ADDR"), "trade_type=" & trade_type, "appid=" & AppID, "mch_id=" & MchID, "nonce_str=" & nonce_str)

        '拼接 XML 請求
        dim xmlInfo
        OrderArr = SortPara(OrderArr)
        xmlInfo = "<?xml version=""1.0"" encoding=""utf-8"" ?><xml>"
        for i = 0 to Ubound(OrderArr)
            if instr(OrderArr(i), "=") > 0 then
                xmlInfo = xmlInfo & paraToXML(OrderArr(i))
            end if
        next
        xmlInfo = xmlInfo & paraToXML("sign=" & Sign(OrderArr))
        xmlInfo = xmlInfo & "</xml>"

        if left(actionInfo, 1) = "&" then actionInfo = mid(actionInfo, 2)

        result = XMLRequest(orderAPI, xmlInfo)

        '分析 請求 結果
        resultPara = XMLToArr(result)

        if GetParaValue(resultPara, "return_code") <> "SUCCESS" and GetParaValue(resultPara, "return_msg") <> "OK" then
            resultInfo = GetParaValue(resultPara, "return_msg")
        else
            resultPara = sortPara(resultPara)
            if Sign(resultPara) = GetParaValue(resultPara, "sign") then
                resultInfo = GetParaValue(resultPara, "code_url")
            else
                resultInfo = "Sign Error," & GetParaValue(resultPara, "err_code_des")
            end if
        end if

        Pay = resultInfo
    end function

    public function GetNotify()

        '必須通過二進制獲取,這是一個大坑
        '二進制獲取,只能獲取一次
        '   如果需要讀取獲取的XML,在調用GetNotify之前增加 dim RESULT_XML
        '   然后通過 RESULT_XML 即可獲取 請求的XML
        Set xmldom = Server.CreateObject("MSXML2.DOMDocument") 
        xmldom.load Request.BinaryRead(Request.TotalBytes)
        RESULT_XML = xmldom.xml
        Set xmldom = Nothing

        resultPara = XMLToArr(RESULT_XML)

        if GetParaValue(resultPara, "return_code") <> "SUCCESS" and GetParaValue(resultPara, "return_msg") <> "OK" then
            set GetNotify = CreateResult(false, GetParaValue(resultPara, "return_msg"), "", "")
        else
            resultPara = sortPara(resultPara)
            if Sign(resultPara) = GetParaValue(resultPara, "sign") then
                set GetNotify = CreateResult(true, GetParaValue(resultPara, "transaction_id"), GetParaValue(resultPara, "total_fee"), GetParaValue(resultPara, "out_trade_no"))
            else
                set GetNotify = CreateResult(false, "Sign Error", "", "")
            end if
        end if
    end function

    '=====================================================================================
    '  私有方法
    '=====================================================================================

    '統一返回結果,和之前的 支付寶接口統一
    private function CreateResult(byval status, byval trade_no, byval total_fee, byval out_trade_no)
        set CreateResult = Server.CreateObject("Scripting.Dictionary")
        call CreateResult.add("status", status)
        if status = false then
            call CreateResult.add("message", trade_no)
        else
            call CreateResult.add("trade_no", trade_no)
            call CreateResult.add("out_trade_no", out_trade_no)
            call CreateResult.add("total_fee", cSng(total_fee))
        end if
    end function

    '簽名
    private function Sign(byval paraArr)
        dim signInfo
        for i = 0 to Ubound(paraArr)
            if instr(paraArr(i), "=") > 0 then
                if left(paraArr(i), 5) <> "sign=" then signInfo = signInfo & "&" & paraArr(i)
            end if
        next
        signInfo = signInfo & "&key=" & MchKey
        signInfo = mid(signInfo, 2)
        Sign = UCase(Md5(signInfo))
    end function

    '通過 【請求參數】獲取值
    private function GetParaValue(byval paraArr, byval paraName)
        GetParaValue = ""
        for i = 0 to Ubound(paraArr)
            if left(paraArr(i), len(paraName) + 1) = paraName & "=" then
                GetParaValue = mid(paraArr(i), len(paraName) + 2)
                exit function
            end if
        next
    end function

    '將XML轉換為 【請求參數】
    private function XMLToArr(byval xmlDoc)
        dim paraArr()
        Set objXml = Server.CreateObject("MSXML2.DOMDocument")
        objXml.loadxml xmlDoc
        set objParent = objXml.SelectNodes("//xml")
        if objParent.length > 0 then
            redim paraArr(objParent(0).childNodes.length - 1)
            for i = 0 to objParent(0).childNodes.length - 1
                paraArr(i) = objParent(0).childNodes(i).nodeName & "=" & objParent(0).childNodes(i).text
            next
        end if
        XMLToArr = paraArr
    end function

    '將  【請求參數】 轉換為 XML
    private function paraToXML(byval paraItem)
        if instr(paraItem, "=") > 0 then
            nodeName = mid(paraItem, 1, instr(paraItem, "=") - 1)
            nodeValue = mid(paraItem, instr(paraItem, "=") + 1)
            paraToXML = "<" & nodeName & "><![CDATA[" & nodeValue & "]]></" & nodeName & ">"
        else
            paraToXML = ""
        end if
    end function

    '將  【請求參數】 排序
    private function SortPara(byval sPara)
        Dim nCount
        nCount = ubound(sPara)
        For i = nCount To 0 Step -1
            minmax = sPara( 0 )
            minmaxSlot = 0
            For j = 1 To i
                mark = (sPara( j ) > minmax)
                If mark Then
                    minmax = sPara( j )
                    minmaxSlot = j
                End If
            Next
            If minmaxSlot <> i Then
                temp = sPara( minmaxSlot )
                sPara( minmaxSlot ) = sPara( i )
                sPara( i ) = temp
            End If
        Next
        SortPara = sPara
    end function

    '創建隨機字符串
    private function CreateNonceStr()
        chars = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"
        CreateNonceStr = ""
        for i = 0 to 16
            randomize
            index = cLng(rnd() * (len(chars) - 1)) + 1
            CreateNonceStr = CreateNonceStr & mid(chars, index, 1)
        next
    end function


    'XML請求,需要使用證書
    '正式說明:http://www.okfdzs1809.com/p/asp-wechat-pay 
    private function XMLRequest(byval sUrl, byval xmlBody)
        Dim xmlhttp
        Set xmlhttp = Server.CreateObject("WinHttp.WinHttpRequest.5.1")
        xmlhttp.Open "POST", sUrl, False
        xmlhttp.SetClientCertificate("LOCAL_MACHINE\My\MMPay")
        'xmlhttp.setRequestHeader "Content-Type", "text/xml; charset=GB2312"
        'xmlhttp.setRequestHeader "Content-Length", Len(xmlBody)
 
        xmlhttp.send(xmlBody)
        xmlget = bin2str(xmlhttp.responseBody)
        Set xmlhttp = Nothing
        XMLRequest = xmlget
    end function

    '二進制流轉換為 XML,這個也是抄的
    private function bin2str(byval binstr)
        Const adTypeBinary = 1
        Const adTypeText = 2
        Dim BytesStream,StringReturn
        Set BytesStream = Server.CreateObject("ADODB.Stream")
        With BytesStream
            .Type = adTypeText
            .Open
            .WriteText binstr
            .Position = 0
            .Charset = "UTF-8"
            .Position = 2
            StringReturn = .ReadText
            .close
        End With
        Set BytesStream = Nothing
        bin2str = StringReturn
    end function

    '=====================================================================================
    '  MD5,下邊都是抄的,不用看了
    '=====================================================================================

    private Sub Md5Initial()
        BITS_TO_A_BYTE = 8
        BYTES_TO_A_WORD = 4
        BITS_TO_A_WORD = 32
    End Sub

    Private m_lOnBits(30)  
    Private m_l2Power(30)  
    Private Function LShift(lValue, iShiftBits)  
        If iShiftBits = 0 Then 
            LShift = lValue  
            Exit Function 
        ElseIf iShiftBits = 31 Then 
            If lValue And 1 Then 
                LShift = &H80000000  
            Else 
                LShift = 0  
            End If 
            Exit Function 
        ElseIf iShiftBits < 0 Or iShiftBits > 31 Then 
            Err.Raise 6  
        End If 
        If (lValue And m_l2Power(31 - iShiftBits)) Then 
            LShift = ((lValue And m_lOnBits(31 - (iShiftBits + 1))) * m_l2Power(iShiftBits)) Or &H80000000  
        Else 
            LShift = ((lValue And m_lOnBits(31 - iShiftBits)) * m_l2Power(iShiftBits))  
        End If 
    End Function 
 
    Private Function str2binold(varstr)  
         str2bin="" 
         For i = 1 To Len(varstr)  
             varchar=mid(varstr,i,1)  
             varasc = Asc(varchar)  
             If varasc < 0 Then 
                varasc = varasc + 65535  
             End If 
             If varasc > 255 Then 
                varlow = Left(Hex(Asc(varchar)),2)  
                varhigh = right(Hex(Asc(varchar)),2)  
                str2bin = str2bin & chrB("&H" & varlow) & chrB("&H" & varhigh)  
             Else 
                str2bin = str2bin & chrB(AscB(varchar))  
             End If 
         Next 
    End Function 
    Private Function str2bin(varstr)  
        Dim varchar, code, codearr, j  
        str2bin = "" 
        For i=1 To Len(varstr)  
            varchar = Mid(varstr,i,1)  
            code = Server.UrlEncode(varchar)  
            If Len(code) = 1 Then 
               str2bin = str2bin & chrB(AscB(code))  
            Else 
               codearr = Split(code,"%")  
               For j = 1 to UBound(codearr)  
                  str2bin = str2bin & ChrB("&H" & codearr(j))  
               Next 
             End If 
        Next 
    End Function 
    Private Function RShift(lValue, iShiftBits)  
        If iShiftBits = 0 Then 
            RShift = lValue  
            Exit Function 
        ElseIf iShiftBits = 31 Then 
            If lValue And &H80000000 Then 
                RShift = 1  
            Else 
                RShift = 0  
            End If 
            Exit Function 
        ElseIf iShiftBits < 0 Or iShiftBits > 31 Then 
            Err.Raise 6  
        End If 
        RShift = (lValue And &H7FFFFFFE) \ m_l2Power(iShiftBits)  
        If (lValue And &H80000000) Then 
            RShift = (RShift Or (&H40000000 \ m_l2Power(iShiftBits - 1)))  
        End If 
    End Function 
    Private Function RotateLeft(lValue, iShiftBits)  
        RotateLeft = LShift(lValue, iShiftBits) Or RShift(lValue, (32 - iShiftBits))  
    End Function 
    Private Function AddUnsigned(lX, lY)  
        Dim lX4  
        Dim lY4  
        Dim lX8  
        Dim lY8  
        Dim lResult  
        lX8 = lX And &H80000000  
        lY8 = lY And &H80000000  
        lX4 = lX And &H40000000  
        lY4 = lY And &H40000000  
        lResult = (lX And &H3FFFFFFF) + (lY And &H3FFFFFFF)  
        If lX4 And lY4 Then 
            lResult = lResult Xor &H80000000 Xor lX8 Xor lY8  
        ElseIf lX4 Or lY4 Then 
            If lResult And &H40000000 Then 
                lResult = lResult Xor &HC0000000 Xor lX8 Xor lY8  
            Else 
                lResult = lResult Xor &H40000000 Xor lX8 Xor lY8  
            End If 
        Else 
            lResult = lResult Xor lX8 Xor lY8  
        End If 
        AddUnsigned = lResult  
    End Function 
    Private Function md5_F(x, y, z)  
        md5_F = (x And y) Or ((Not x) And z)  
    End Function 
    Private Function md5_G(x, y, z)  
        md5_G = (x And z) Or (y And (Not z))  
    End Function 
    Private Function md5_H(x, y, z)  
        md5_H = (x Xor y Xor z)  
    End Function 
    Private Function md5_I(x, y, z)  
        md5_I = (y Xor (x Or (Not z)))  
    End Function 
    Private Sub md5_FF(a, b, c, d, x, s, ac)  
        a = AddUnsigned(a, AddUnsigned(AddUnsigned(md5_F(b, c, d), x), ac))  
        a = RotateLeft(a, s)  
        a = AddUnsigned(a, b)  
    End Sub 
    Private Sub md5_GG(a, b, c, d, x, s, ac)  
        a = AddUnsigned(a, AddUnsigned(AddUnsigned(md5_G(b, c, d), x), ac))  
        a = RotateLeft(a, s)  
        a = AddUnsigned(a, b)  
    End Sub 
    Private Sub md5_HH(a, b, c, d, x, s, ac)  
        a = AddUnsigned(a, AddUnsigned(AddUnsigned(md5_H(b, c, d), x), ac))  
        a = RotateLeft(a, s)  
        a = AddUnsigned(a, b)  
    End Sub 
    Private Sub md5_II(a, b, c, d, x, s, ac)  
        a = AddUnsigned(a, AddUnsigned(AddUnsigned(md5_I(b, c, d), x), ac))  
        a = RotateLeft(a, s)  
        a = AddUnsigned(a, b)  
    End Sub 
    Private Function ConvertToWordArray(sMessage)  
        Dim lMessageLength  
        Dim lNumberOfWords  
        Dim lWordArray()  
        Dim lBytePosition  
        Dim lByteCount  
        Dim lWordCount  
        Const MODULUS_BITS = 512  
        Const CONGRUENT_BITS = 448  
        lMessageLength = LenB(sMessage)  
        lNumberOfWords = (((lMessageLength + ((MODULUS_BITS - CONGRUENT_BITS) \ BITS_TO_A_BYTE)) \ (MODULUS_BITS \ BITS_TO_A_BYTE)) + 1) * (MODULUS_BITS \ BITS_TO_A_WORD)  
        ReDim lWordArray(lNumberOfWords - 1)  
        lBytePosition = 0  
        lByteCount = 0  
        Do Until lByteCount >= lMessageLength  
            lWordCount = lByteCount \ BYTES_TO_A_WORD  
            lBytePosition = (lByteCount Mod BYTES_TO_A_WORD) * BITS_TO_A_BYTE  
            lWordArray(lWordCount) = lWordArray(lWordCount) Or LShift(AscB(MidB(sMessage, lByteCount + 1, 1)), lBytePosition)  
            lByteCount = lByteCount + 1  
        Loop 
        lWordCount = lByteCount \ BYTES_TO_A_WORD  
        lBytePosition = (lByteCount Mod BYTES_TO_A_WORD) * BITS_TO_A_BYTE  
        lWordArray(lWordCount) = lWordArray(lWordCount) Or LShift(&H80, lBytePosition)  
        lWordArray(lNumberOfWords - 2) = LShift(lMessageLength, 3)  
        lWordArray(lNumberOfWords - 1) = RShift(lMessageLength, 29)  
        ConvertToWordArray = lWordArray  
    End Function 
    Private Function WordToHex(lValue)  
        Dim lByte  
        Dim lCount  
        For lCount = 0 To 3  
            lByte = RShift(lValue, lCount * BITS_TO_A_BYTE) And m_lOnBits(BITS_TO_A_BYTE - 1)  
            WordToHex = WordToHex & Right("0" & Hex(lByte), 2)  
        Next 
    End Function 
    Public Function MD5(sMessage)  
        m_lOnBits(0) = CLng(1)  
        m_lOnBits(1) = CLng(3)  
        m_lOnBits(2) = CLng(7)  
        m_lOnBits(3) = CLng(15)  
        m_lOnBits(4) = CLng(31)  
        m_lOnBits(5) = CLng(63)  
        m_lOnBits(6) = CLng(127)  
        m_lOnBits(7) = CLng(255)  
        m_lOnBits(8) = CLng(511)  
        m_lOnBits(9) = CLng(1023)  
        m_lOnBits(10) = CLng(2047)  
        m_lOnBits(11) = CLng(4095)  
        m_lOnBits(12) = CLng(8191)  
        m_lOnBits(13) = CLng(16383)  
        m_lOnBits(14) = CLng(32767)  
        m_lOnBits(15) = CLng(65535)  
        m_lOnBits(16) = CLng(131071)  
        m_lOnBits(17) = CLng(262143)  
        m_lOnBits(18) = CLng(524287)  
        m_lOnBits(19) = CLng(1048575)  
        m_lOnBits(20) = CLng(2097151)  
        m_lOnBits(21) = CLng(4194303)  
        m_lOnBits(22) = CLng(8388607)  
        m_lOnBits(23) = CLng(16777215)  
        m_lOnBits(24) = CLng(33554431)  
        m_lOnBits(25) = CLng(67108863)  
        m_lOnBits(26) = CLng(134217727)  
        m_lOnBits(27) = CLng(268435455)  
        m_lOnBits(28) = CLng(536870911)  
        m_lOnBits(29) = CLng(1073741823)  
        m_lOnBits(30) = CLng(2147483647)  
        m_l2Power(0) = CLng(1)  
        m_l2Power(1) = CLng(2)  
        m_l2Power(2) = CLng(4)  
        m_l2Power(3) = CLng(8)  
        m_l2Power(4) = CLng(16)  
        m_l2Power(5) = CLng(32)  
        m_l2Power(6) = CLng(64)  
        m_l2Power(7) = CLng(128)  
        m_l2Power(8) = CLng(256)  
        m_l2Power(9) = CLng(512)  
        m_l2Power(10) = CLng(1024)  
        m_l2Power(11) = CLng(2048)  
        m_l2Power(12) = CLng(4096)  
        m_l2Power(13) = CLng(8192)  
        m_l2Power(14) = CLng(16384)  
        m_l2Power(15) = CLng(32768)  
        m_l2Power(16) = CLng(65536)  
        m_l2Power(17) = CLng(131072)  
        m_l2Power(18) = CLng(262144)  
        m_l2Power(19) = CLng(524288)  
        m_l2Power(20) = CLng(1048576)  
        m_l2Power(21) = CLng(2097152)  
        m_l2Power(22) = CLng(4194304)  
        m_l2Power(23) = CLng(8388608)  
        m_l2Power(24) = CLng(16777216)  
        m_l2Power(25) = CLng(33554432)  
        m_l2Power(26) = CLng(67108864)  
        m_l2Power(27) = CLng(134217728)  
        m_l2Power(28) = CLng(268435456)  
        m_l2Power(29) = CLng(536870912)  
        m_l2Power(30) = CLng(1073741824)  
        Dim x  
        Dim k  
        Dim AA  
        Dim BB  
        Dim CC  
        Dim DD  
        Dim a  
        Dim b  
        Dim c  
        Dim d  
        Const S11 = 7  
        Const S12 = 12  
        Const S13 = 17  
        Const S14 = 22  
        Const S21 = 5  
        Const S22 = 9  
        Const S23 = 14  
        Const S24 = 20  
        Const S31 = 4  
        Const S32 = 11  
        Const S33 = 16  
        Const S34 = 23  
        Const S41 = 6  
        Const S42 = 10  
        Const S43 = 15  
        Const S44 = 21  
        x = ConvertToWordArray(str2bin(sMessage))  
        a = &H67452301  
        b = &HEFCDAB89  
        c = &H98BADCFE  
        d = &H10325476  
        For k = 0 To UBound(x) Step 16  
            AA = a  
            BB = b  
            CC = c  
            DD = d  
            md5_FF a, b, c, d, x(k + 0), S11, &HD76AA478  
            md5_FF d, a, b, c, x(k + 1), S12, &HE8C7B756  
            md5_FF c, d, a, b, x(k + 2), S13, &H242070DB  
            md5_FF b, c, d, a, x(k + 3), S14, &HC1BDCEEE  
            md5_FF a, b, c, d, x(k + 4), S11, &HF57C0FAF  
            md5_FF d, a, b, c, x(k + 5), S12, &H4787C62A  
            md5_FF c, d, a, b, x(k + 6), S13, &HA8304613  
            md5_FF b, c, d, a, x(k + 7), S14, &HFD469501  
            md5_FF a, b, c, d, x(k + 8), S11, &H698098D8  
            md5_FF d, a, b, c, x(k + 9), S12, &H8B44F7AF  
            md5_FF c, d, a, b, x(k + 10), S13, &HFFFF5BB1  
            md5_FF b, c, d, a, x(k + 11), S14, &H895CD7BE  
            md5_FF a, b, c, d, x(k + 12), S11, &H6B901122  
            md5_FF d, a, b, c, x(k + 13), S12, &HFD987193  
            md5_FF c, d, a, b, x(k + 14), S13, &HA679438E  
            md5_FF b, c, d, a, x(k + 15), S14, &H49B40821  
            md5_GG a, b, c, d, x(k + 1), S21, &HF61E2562  
            md5_GG d, a, b, c, x(k + 6), S22, &HC040B340  
            md5_GG c, d, a, b, x(k + 11), S23, &H265E5A51  
            md5_GG b, c, d, a, x(k + 0), S24, &HE9B6C7AA  
            md5_GG a, b, c, d, x(k + 5), S21, &HD62F105D  
            md5_GG d, a, b, c, x(k + 10), S22, &H2441453  
            md5_GG c, d, a, b, x(k + 15), S23, &HD8A1E681  
            md5_GG b, c, d, a, x(k + 4), S24, &HE7D3FBC8  
            md5_GG a, b, c, d, x(k + 9), S21, &H21E1CDE6  
            md5_GG d, a, b, c, x(k + 14), S22, &HC33707D6  
            md5_GG c, d, a, b, x(k + 3), S23, &HF4D50D87  
            md5_GG b, c, d, a, x(k + 8), S24, &H455A14ED  
            md5_GG a, b, c, d, x(k + 13), S21, &HA9E3E905  
            md5_GG d, a, b, c, x(k + 2), S22, &HFCEFA3F8  
            md5_GG c, d, a, b, x(k + 7), S23, &H676F02D9  
            md5_GG b, c, d, a, x(k + 12), S24, &H8D2A4C8A  
            md5_HH a, b, c, d, x(k + 5), S31, &HFFFA3942  
            md5_HH d, a, b, c, x(k + 8), S32, &H8771F681  
            md5_HH c, d, a, b, x(k + 11), S33, &H6D9D6122  
            md5_HH b, c, d, a, x(k + 14), S34, &HFDE5380C  
            md5_HH a, b, c, d, x(k + 1), S31, &HA4BEEA44  
            md5_HH d, a, b, c, x(k + 4), S32, &H4BDECFA9  
            md5_HH c, d, a, b, x(k + 7), S33, &HF6BB4B60  
            md5_HH b, c, d, a, x(k + 10), S34, &HBEBFBC70  
            md5_HH a, b, c, d, x(k + 13), S31, &H289B7EC6  
            md5_HH d, a, b, c, x(k + 0), S32, &HEAA127FA  
            md5_HH c, d, a, b, x(k + 3), S33, &HD4EF3085  
            md5_HH b, c, d, a, x(k + 6), S34, &H4881D05  
            md5_HH a, b, c, d, x(k + 9), S31, &HD9D4D039  
            md5_HH d, a, b, c, x(k + 12), S32, &HE6DB99E5  
            md5_HH c, d, a, b, x(k + 15), S33, &H1FA27CF8  
            md5_HH b, c, d, a, x(k + 2), S34, &HC4AC5665  
            md5_II a, b, c, d, x(k + 0), S41, &HF4292244  
            md5_II d, a, b, c, x(k + 7), S42, &H432AFF97  
            md5_II c, d, a, b, x(k + 14), S43, &HAB9423A7  
            md5_II b, c, d, a, x(k + 5), S44, &HFC93A039  
            md5_II a, b, c, d, x(k + 12), S41, &H655B59C3  
            md5_II d, a, b, c, x(k + 3), S42, &H8F0CCC92  
            md5_II c, d, a, b, x(k + 10), S43, &HFFEFF47D  
            md5_II b, c, d, a, x(k + 1), S44, &H85845DD1  
            md5_II a, b, c, d, x(k + 8), S41, &H6FA87E4F  
            md5_II d, a, b, c, x(k + 15), S42, &HFE2CE6E0  
            md5_II c, d, a, b, x(k + 6), S43, &HA3014314  
            md5_II b, c, d, a, x(k + 13), S44, &H4E0811A1  
            md5_II a, b, c, d, x(k + 4), S41, &HF7537E82  
            md5_II d, a, b, c, x(k + 11), S42, &HBD3AF235  
            md5_II c, d, a, b, x(k + 2), S43, &H2AD7D2BB  
            md5_II b, c, d, a, x(k + 9), S44, &HEB86D391  
            a = AddUnsigned(a, AA)  
            b = AddUnsigned(b, BB)  
            c = AddUnsigned(c, CC)  
            d = AddUnsigned(d, DD)  
        Next 
        MD5 = LCase(WordToHex(a) & WordToHex(b) & WordToHex(c) & WordToHex(d))  
    End Function
end class




使用方法,調用的頁面必須是 UTF-8 編碼,可以通過 Ajax返回信息,創建掃碼的同時,通過 setInterval(function(){//ajax},5000) 來設置每個5秒檢測一次當前的訂單狀態,等待支付。

本頁面文件名:wxapi.asp

'include WeChatPay.asp
'   注意:本頁面必須是 UTF-8編碼
'   本頁面為偽代碼,代碼不全,僅是為了演示用法

set wechat = new WeChatPay()

out_trade_no = request("trade_no")

set rs.open "select * from order_list where o_status='未支付' and o_tradeno='" & out_trade_no & "'", conn, 3, 2

'創建支付
if request("action") = "ajax" then
	'創建訂單

	if rs.eof then
		result = wechat.Pay("訂單號", "產品名", "不需要傳值,此值暫時無用,為了與支付寶保持兼容", "支付金額,單位元")
		if left(result, 15) = "weixin://wxpay/" then
	 	   '支付成功,返回 支付鏈接,通過前臺 ajax 返回到前臺,通過 jQuery.qrcode 插件二維碼
	   		 response.write "{""status"":true, ""payUrl"":""" & result & """}"
		else
			'支付失敗,返回錯誤信息
			response.write "{""status"":false, ""errMsg"":""" & result & """}"
		end if
	else
		response.write "{""status"":false, ""errMsg"":""已經處理完畢""}"
	end if
else request("action") = "check" then
	'檢查支付狀態,【微信支付后臺通知(異步)】設為 完成后,返回成功
	
	'如果 當前訂單不是 未支付狀態了,說明已經支付
	if rs.eof then
		response.write "{""status"":true}""
	else
		response.write "{""status"":false}""
	end if
else
	
	'微信支付后臺通知(異步)
	set result = wechat.GetNotify()
	if result.item("status") = false then
		'校驗失敗
		response.write result.item("message")
	else
		'校驗成功,修改o_status為已支付
		if not rs.eof then
			rs("wx_tradeno") = trade_no
			rs("o_paytme") = now()
			rs("o_status") = "已支付"
			rs.update
		end if
		response.write "<return_code>SUCCESS</return_code><return_msg>OK</return_msg>"
	end if

end if

rs.close

Ajax前臺創建支付請求和刷新訂單狀態的方法

$(function(){
	$.ajax({
		url : "/wxapi.asp?action=ajax&trade_no=<% =trade_no %>",
		dataType : "json",
		type : "GET",
		success : function(result){
			if( result.status != true ){
				alert(result.errMsg);
			}else{
				jQuery('#qrcodeCanvas').html("").qrcode({
					text : result.payUrl
				});
				setTimeout(function(){
					jQuery('#qrcodeImage img').attr("src", $("#qrcodeCanvas canvas")[0].toDataURL("image/png"));
				}, 100);
				setInterval(function(){
					$.ajax({
						url : "/wxapi.asp?action=check&trade_no=<% =trade_no %>",
						dataType : "json",
						success : function(result){
							if( result.status === false ){
								alert("支付成功");
								location.href = "?action=info&trade_no=<% =trade_no %>";
							}
						}
					});
				}, 5000);
			}
		}
	});
})

后臺支付通知接收方法,已經合并到上邊的 wxapi.asp 中。

47 thoughts on “ASP微信支付類

  1. mqycn 文章作者

    文章底部:
    Ajax前臺創建支付請求和刷新訂單狀態的方法
    后臺支付通知接收方法

    按這個寫就可以了

  2. mqycn 文章作者

    wxapi.asp,只需要檢查數據庫中的訂單狀態就可以了。
    后臺收到支付通知通知,并設為支付狀態后, 跳轉到成功頁面

  3. frank

    證書問題已經解決了,之前是自己沒理解文檔操作不對。
    另外我發了一個郵件給你,關于兩個asp文件的,剛剛看到了你的詳細恢復,非常非常感謝,我是剛接觸微信開發,底子差,學起來很吃力??吹侥愕牟┛蜕嫌泻芏嗉夹g文章,收藏了。
    再次再次感謝你的幫助。

  4. frank

    嘗試了很多次,獲取到支付的url了,問題還有:wxapi.asp中,if left(result, 15) = “weixin://wxpay/” then后,返回的似乎是一個二維碼什么的?我在瀏覽器開發模式中看到類似這樣的url“weixin://wxpay/bizpayurl?pr=******” 在微信中可以進行支付,然后在支付后臺看到的支付方式是掃碼支付,如果要在公眾號支付,這里如何修改呢

  5. aliens

    和用戶“frank”碰到的問題一樣,一個證書導入報錯問題,和缺少wxapi.asp頁面。
    另外,我的asp基礎一般,微信支付已經研究了快一個月了,頭很大很蒙,基本看不懂,希望老師您能給我提供多一些幫助萬分感謝,(從網上找了很多asp的demo修修改改的都沒支付成功),您費心幫幫忙。

  6. mqycn 文章作者

    步驟都基本一樣,返回 weixin://wxpay/bizpayurl?pr= 的地方,還有一個 prepay_id,通過JSSDK 提交過去,就可以調用微信支付了。

  7. defent

    set wechat = new WeChatPay

    result = wechat.Pay(“2017191705947295”, “1”, “2”, “0.01”)
    if left(result, 15) = “weixin://wxpay/” then
    response.write “{“”status””:true, “”payUrl””:””” & result & “””}”
    else
    response.write “{“”status””:false, “”errMsg””:””” & result & “””}”
    end if

    你好,我直接調用返回了簽名錯誤,請教一下怎么辦

  8. Pingback引用通告: 微信支付ASP下證書安裝說明 | 啟源的部落格

  9. 凱凱

    前輩你好,我已經下載了demo,二維碼也不能顯示,是哪里配置不對嗎?

  10. mqycn 文章作者

    需要先安裝證書(http://www.okfdzs1809.com/p/winhttpcertcfg-mmpay),如果對路徑不了解,不要修改文件的路徑。
    證書安裝成功后,一般就沒有問題了。

  11. 王浩

    前輩你好,我也出現了二維碼也不能顯示,是哪里配置不對嗎?

  12. 先鋒圖文

    證書安裝成功,測試支付時,二維碼生成不了,總是在轉
    請問是怎么回事?

  13. 文科生

    如果 一臺服務器安裝多個 商戶的證書怎么處理啊
    xmlhttp.SetClientCertificate(“LOCAL_MACHINE\My\MMPay”) 這個地方 總是 第一個商戶的證書
    我再導入其他商戶的證書沒用了.

  14. mqycn 文章作者

    因為 微信導出的證書名稱 都是一樣的,而asp只能通過證書名稱的方式調用,所以 目前只能一個服務器部署一個。

  15. go

    電腦上已經測試成功;手機上微信內置瀏覽器中,怎么實現呢?長安二維碼識別已經不行了,因為電腦端已有支付寶,如果手機上不能用,那就沒多少意義了

  16. gogo

    測試了,掃碼支付完成了,但不跳轉,MDB數據庫中的訂單狀態也沒改變,大家測試也是這樣嗎

  17. 紅塵

    老師,下了DEMO,修改了基本參數,正確安裝的證書,可二維碼顯示不出來..可以幫一下嗎謝謝謝

  18. guiziwei

    支付已經成功,但是支付成功后不會跳轉,查看了數據庫o_status字段沒有也更新,不知道哪里出問題了。

  19. Mark.Lee

    hello, my name is mark from Korea.
    now i have project to china company.
    so i need asp-wechat-pay.
    and i find your site.
    now i test sample code and callback wxapi.asp “status:true”
    but i can’t see qrcode
    if you have time i want to your help ??

  20. 苗 啟源 文章作者

    由lbcity發表在《ASP微信支付類》

    請問微信支付退款通知解密asp怎么做?

    用的不多,我沒做這一塊

發表評論

電子郵件地址不會被公開。 必填項已用*標注

此站點使用Akismet來減少垃圾評論。了解我們如何處理您的評論數據。