ASP微信支付类

2017-2-24 更新
每周几乎都能收到 通过QQ、邮箱、和评论反馈的网友 的问题,现在重新整理了个demo,代码已经托管至 http://git.oschina.net/mqycn/WechatASP,安装证书的教程已经重新更新,请参考:http://www.miaoqiyuan.cn/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.miaoqiyuan.cn/index.html              =
	'=   联系邮箱:mqycn@126.com;                                   =
	'================================================================
	'=   使用说明:http://www.miaoqiyuan.cn/p/asp-wechat-pay?l.html =
	'=   最新版本:http://www.miaoqiyuan.cn/products/wechat/asp.rar =
	'================================================================
	
	class WeChatPay
		
		private AppID
		private AppSecret
		private MchID
		private MchKey
		
		private 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		= "商户密码"
			
			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")
				if notifyUrl = "" then notifyUrl = currentUrl & "/order/wxapi.asp"
			end if
			total_fee = total_fee * 100
			
			'支付类型
			trade_type = "NATIVE" 'PC
			userAgent = lcase(Request.Servervariables("HTTP_USER_AGENT"))
			if instr(userAgent, "android") > 0 or instr(userAgent, "iphone") > 0 then
				'trade_type = "JSAPI" '手机可以设置为使用JSAPI支付
			end if
			
			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"
				end if
			end if
			
			Pay = resultInfo
		end function
		
		public function GetNotify()
			
			'必须通过二进制获取,这是一个大坑
			Set xmldom = Server.CreateObject("MSXML2.DOMDocument") 
			xmldom.load Request.BinaryRead(Request.TotalBytes)
			
			result = xmldom.xml
			
			resultPara = XMLToArr(result)
			
			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.miaoqiyuan.cn/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 中。

ASP微信支付类》上有33条评论

  1. mqycn 文章作者

    文章底部:
    Ajax前台创建支付请求和刷新订单状态的方法
    后台支付通知接收方法

    按这个写就可以了

  2. mqycn 文章作者

    wxapi.asp,只需要检查数据库中的订单状态就可以了。
    后台收到支付通知通知,并设为支付状态后, 跳转到成功页面

  3. frank

    证书问题已经解决了,之前是自己没理解文档操作不对。
    另外我发了一个邮件给你,关于两个asp文件的,刚刚看到了你的详细恢复,非常非常感谢,我是刚接触微信开发,底子差,学起来很吃力。看到你的博客上有很多技术文章,收藏了。
    再次再次感谢你的帮助。

  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. mqycn 文章作者

    需要先安装证书(http://www.miaoqiyuan.cn/p/winhttpcertcfg-mmpay),如果对路径不了解,不要修改文件的路径。
    证书安装成功后,一般就没有问题了。

  10. 先锋图文

    证书安装成功,测试支付时,二维码生成不了,总是在转
    请问是怎么回事?

  11. 文科生

    如果 一台服务器安装多个 商户的证书怎么处理啊
    xmlhttp.SetClientCertificate(“LOCAL_MACHINE\My\MMPay”) 这个地方 总是 第一个商户的证书
    我再导入其他商户的证书没用了.

  12. mqycn 文章作者

    因为 微信导出的证书名称 都是一样的,而asp只能通过证书名称的方式调用,所以 目前只能一个服务器部署一个。

  13. go

    电脑上已经测试成功;手机上微信内置浏览器中,怎么实现呢?长安二维码识别已经不行了,因为电脑端已有支付宝,如果手机上不能用,那就没多少意义了

发表评论

电子邮件地址不会被公开。 必填项已用*标注