<!--#include file="wxpay.config.asp" -->
<!--#include file="php_MD5.asp" -->
<%
'==================================
'=类 名 称:WxPayApi
'=功    能:微信支付 For ASP
'=作    者:㊣FireFox㊣
'=Q      Q: 63572063
'=日    期:2015-09-05
'==================================
'转载时请保留以上内容！！
Class WxPayApi
	Private ApiUrl
	Private parameters
	
    Private Sub Class_Initialize 
		ApiUrl = CURL_URL
		Set parameters = Server.CreateObject("Scripting.Dictionary")
		parameters.RemoveAll
		setParameter "appid",APPID
		setParameter "mch_id",MCHID
		setParameter "nonce_str",MakeRandStr(32) 
    End Sub
	
	'设置参数值
	Public Sub setParameter(parameter, parameterValue)
	    If parameterValue<>"" Then
		   If parameters.Exists(parameter) = True Then
			  parameters.Remove(parameter)
		   End If
		   parameters.Add parameter, parameterValue
		End If	
	End Sub

	Public Function GetIP()
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
          if Request.ServerVariables("HTTP_X_FORWARDED_FOR")=empty then
                    ip=Request.ServerVariables("REMOTE_ADDR")
          else
                    ip=Request.ServerVariables("HTTP_X_FORWARDED_FOR")
         end if
            GetIP=ip
    End Function
	

	Public Function MakeArray()
	    Dim Str
		Dim k
		For Each k In parameters
			Str = Str & k & "=" & parameters(k) & "&" 
		Next
		Str = Left(Str, Len(Str)-1)
		MakeArray = split(Str,"&")
		
	End Function
	
	Public Function MakeRandNum()
		Randomize
		Dim width : width = 6 '随机数长度,默认6位
		width = 10 ^ (width - 1)
		MakeRandNum = Int((width*10 - width) * Rnd() + width)
	End Function
	
	Public Function MakeRandStr(intLength) 
        Dim strSeed, seedLength, pos, Str, i 
            strSeed = "abcdefghijklmnopqrstuvwxyz123456789" 
            seedLength = Len(strSeed) 
            Str = "" 
            Randomize 
            For i = 1 To intLength 
                Str = Str + Mid(strSeed, Int(seedLength * Rnd) + 1, 1) 
            Next 
            MakeRandStr = Str 
     End Function 
	
	Public Function GetDateTime()
	      Dim sTime,sResult
	      sTime=now()
	      sResult = year(sTime)&right("0" & month(sTime),2)&right("0" & day(sTime),2)&right("0" & hour(sTime),2)&right("0" & minute(sTime),2)&right("0" & second(sTime),2)
	      GetDateTime = sResult
    End Function
	
	Public Function get_Parameters()
	    Dim Str,Arr,Sign,afterData,timestamp,nonceStr
		timestamp = Datediff("s","1970-01-01 08:00:00",now)
		nonceStr = MakeRandStr(32)
		package = Get_prepay_id
		Arr = Array("appId="&APPID,"package=prepay_id@"&package,"timeStamp="&timestamp,"nonceStr="&nonceStr,"signType=MD5")
		Arr = kSort(Arr)
		Str = ToUrlParams(Arr)
		Str = replace(Str,"@","=")
		Str =Str&"&key="&KEY
		Sign = Ucase(MD5(Str,"utf-8"))
	    afterData = Array("appId="&APPID,"package=prepay_id@"&package,"timeStamp="&timestamp,"nonceStr="&nonceStr,"signType=MD5","paySign="&Sign)
		get_Parameters = replace(ToJson(afterData),"@","=")
	End Function
	
	Public Function Get_prepay_id()
	       Dim url,xml,data,prepay_id
           url = "https://api.mch.weixin.qq.com/pay/unifiedorder"
           xml= Create_Post_Xml
		   data = Response_Data(xml,url,0)
           prepay_id = RequestUrl_post(data)
		   'Die prepay_id
		   If Get_Xml_Text(prepay_id,"//result_code") = "SUCCESS" Then
		       Get_prepay_id = Get_Xml_Text(prepay_id,"//prepay_id")
		   Else
		       Die Get_Xml_Text(prepay_id,"//err_code_des")
           End If
	End Function
	
	Public Function Get_code_url()
	       Dim url,xml,data,code_url
           url = "https://api.mch.weixin.qq.com/pay/unifiedorder"
           xml= Create_Post_Xml
		   data = Response_Data(xml,url,0)
           code_url = RequestUrl_post(data)
		   code_url = Get_Xml_Text(code_url,"//code_url")
	     If Instr(code_url,"weixin://wxpay/bizpayurl") = 0 Then
	           Die code_url
	     End If
		   Get_code_url = code_url
	End Function
	
	Public Function Get_orderquery()
	       Dim url,xml,data
           url = "https://api.mch.weixin.qq.com/pay/orderquery"
           xml= Create_Post_Xml
		   data = Response_Data(xml,url,0)
		   Get_orderquery = RequestUrl_post(data)
	End Function
	
	Public Function Get_refund()
	       Dim url,xml,data
           url = "https://api.mch.weixin.qq.com/secapi/pay/refund"
           xml= Create_Post_Xml
		   data = Response_Data(xml,url,1)
		   Get_refund = RequestUrl_post(data)
	End Function
	
	Public Function Get_refundquery()
	       Dim url,xml,data
           url = "https://api.mch.weixin.qq.com/pay/refundquery"
           xml= Create_Post_Xml
		   data = Response_Data(xml,url,0)
		   Get_refundquery = RequestUrl_post(data)
	End Function
	
	Public Function Get_reverse()
	       Dim url,xml,data
           url = "https://api.mch.weixin.qq.com/secapi/pay/reverse"
           xml= Create_Post_Xml
		   data = Response_Data(xml,url,1)
		   Get_reverse = RequestUrl_post(data)
	End Function
	
	Public Function Get_downloadbill()
	       Dim url,xml,data
           url = "https://api.mch.weixin.qq.com/pay/downloadbill"
           xml= Create_Post_Xml
		   data = Response_Data(xml,url,0)
		   Get_downloadbill = RequestUrl_post(data)
	End Function
	
	Public Function Get_micropay()
	       Dim url,xml,data
           url = "https://api.mch.weixin.qq.com/pay/micropay"
           xml= Create_Post_Xml
		   data = Response_Data(xml,url,0)
		   Get_micropay = RequestUrl_post(data)
	End Function

	Public Function Response_Data(xml,url,cert)
           If cert=1 Then
		      Response_Data = "post_data="&xml&"&curl_url="&url&"&keys="&KEY&"&cert=1"
		   Else
		      Response_Data = "post_data="&xml&"&curl_url="&url&"&keys="&KEY&"&cert=0"
		   End If
	End Function
	'Post方法请求url,获取请求内容
	Public Function RequestUrl_post(data)

        Set XmlObj = Server.CreateObject("Msxml2.XMLHTTP.6.0")'MSXML2.XMLHTTP,Microsoft.XMLHTTP
		    XmlObj.open "POST", ApiUrl, False
            XmlObj.SetRequestHeader "Accept","*/*"
            XmlObj.SetRequestHeader "Accept-Language","zh-cn"
            XmlObj.setRequestHeader "Content-Type ","application/x-www-form-urlencoded;charset=utf-8"			
            XmlObj.SetRequestHeader "User-Agent", Request.ServerVariables("HTTP_USER_AGENT")
            XmlObj.SetRequestHeader "Content-Length",Len(data)
            XmlObj.setRequestHeader "Connection","Close" 
            XmlObj.setRequestHeader "Cache-Control","no-cache"
            XmlObj.send(data)

		RequestUrl_post = XmlObj.ResponseText
		
		Set XmlObj = nothing
	End Function
	
	Public Function ToXml(values)
    	Dim xml,key,val,i
		   If Not isArray(values) Then
		      Die("错误:数据有误！")
		   End If
    	xml = "<xml>"&Vbcrlf
    	For i = 0 To Ubound(values)
		    key = split(values(i),"=")(0)
			val = split(values(i),"=")(1)
			If isnumeric(val) then
			   xml = xml & "<"&key&">"&val&"</"&key&">"&Vbcrlf
			Else
			   xml = xml & "<"&key&"><![CDATA["&val&"]]></"&key&">"&Vbcrlf
			End If
        Next
        xml = xml &"</xml>"
        ToXml = xml
	End Function
	
		Public Function ToJson(values)
    	Dim Json_Str,key,val,i
		   If Not isArray(values) Then
		      Die("错误:数据有误！")
		   End If
    	Json_Str = "{"
    	For i = 0 To Ubound(values)
		    key = split(values(i),"=")(0)
			val = split(values(i),"=")(1)
			If i = Ubound(values) then
			   Json_Str = Json_Str & """"&key&""":"""&val&""""
			Else
			   Json_Str = Json_Str & """"&key&""":"""&val&""","
			End If
        Next
        Json_Str = Json_Str &"}"
        ToJson = Json_Str
	End Function
	
	
	Public Function Create_Post_Xml()
	  Dim arr,sign,xml
	    arr = MakeArray()
	    arr = kSort(arr)
		sign = MakeSign(arr)
	    ReDim Preserve arr(Ubound(arr)+1)
	    arr(Ubound(arr))="sign="&sign
	    xml = ToXml(arr)
	    Create_Post_Xml = xml

	End Function
	
	
	Public Function Get_Xml_Text(xml,sParaTemp)
        Set objXml=Server.CreateObject("Microsoft.XMLDOM")
		    objXml.Async=true
		    objXml.ValidateOnParse=False
		    objXml.Loadxml(xml)
			If objXml.selectSingleNode("//return_code").text = "SUCCESS" Then
			   Get_Xml_Text = objXml.selectSingleNode(sParaTemp).text
			Else
			   Die objXml.selectSingleNode("//return_msg").text
			End If
		Set objXml = Nothing
	End Function
	
	Public Sub Die(values)
	     Response.Write(values)
		 Response.End
	End Sub
	
	Public Function Self_Post_Xml(values)
	  Dim arr,sign,xml
	    If Not isArray(values) Then
		   Die("错误:数据有误！")
		End If
	    arr = kSort(values)
		sign = MakeSign(arr)
	    ReDim Preserve arr(Ubound(arr)+1)
	    arr(Ubound(arr))="sign="&sign
	    xml = ToXml(arr)
	    Self_Post_Xml = xml

	End Function
	
	Public Function MakeSign(values)
	    Dim str
		str = ToUrlParams(values)
		str = str & "&key="&KEY
		'str = toUTF8(str)
		Str = MD5(Str,"utf-8")
		MakeSign = Ucase(Str)
	End Function
	
	Public Function ToUrlParams(values)
	    Dim Str,i
	    If Not isArray(values) Then
		   Die("错误:数据有误！")
		End If
		Str= ""
		For i = 0 To Ubound(values)
		    If Str = "" then
			   Str = values(i)
			Else
		       Str = Str &"&"&values(i)
		    End If
		Next
		ToUrlParams = Str
	End Function
	
	Public Function CheckSign(values,sign)
	    CheckSign = False
		Dim Arr,mSign,data
			data = "post_data="&values&"&curl_url=123&action=checksign&keys="&KEY&"&cert=0"
		    mSign = RequestUrl_post(data)
	    If mSign = sign Then
		   CheckSign = True
		End If
	End Function
	
	
	Public Function Xml2Array(xml)
    Dim objXml
    Set objXml=Server.CreateObject("Microsoft.XMLDOM")
		    objXml.Async=true
		    objXml.ValidateOnParse=False
		    objXml.Loadxml(xml)
			Dim objNodeList
	Dim Counters
	set objNodeList = objXml.selectSingleNode("//xml").childNodes
	For i = 0 To (objNodeList.length - 1)
	  If objNodeList.Item(i).nodename<>"sign"Then
	    'ReDim Preserve Counters(Ubound(Counters)+1)
		 Counters=Counters&objNodeList.Item(i).nodename&"="&objNodeList.Item(i).text&"&"
	  End If
	Next
	Set objXml = Nothing 
	    Counters = Left(Counters,len(Counters)-1)
	    Xml2Array = split(Counters,"&")
    End Function

    Public Function kSort(ary) 
       Dim KeepChecking,I,FirstValue,SecondValue 
           KeepChecking = TRUE 
         Do Until KeepChecking = FALSE 
           KeepChecking = FALSE 
              For I = 0 to UBound(ary) 
                 If I = UBound(ary) Then Exit For 
                     If ary(I) > ary(I+1) Then 
                        FirstValue = ary(I) 
                        SecondValue = ary(I+1) 
                        ary(I) = SecondValue 
                        ary(I+1) = FirstValue 
                        KeepChecking = TRUE 
                     End If 
              Next 
           Loop 
          kSort = ary 
      End Function 
	
    Public Function GetEditAddressParameters()
	    Dim Str,Arr,addrSign,afterData,timestamp,nonceStr
		timestamp = Datediff("s","1970-01-01 08:00:00",now)
		nonceStr = MakeRandStr(16)
		url = "http://"&request.ServerVariables("HTTP_HOST")&request.ServerVariables("URL")
		If request.QueryString<>"" Then
		   url = url & "?" &request.QueryString
		End If
		Arr = Array("appid="&APPID,"url="&url,"timestamp="&timestamp,"noncestr="&nonceStr,"accesstoken="&Request.Cookies("access_token"))
		Arr = kSort(Arr)
		Str = ToUrlParams(Arr)
		'Die Str
		addrSign = SHA1(Str)
	    afterData = Array("addrSign="&addrSign,"signType=sha1","scope=jsapi_address","appId="&APPID,"timeStamp="&timestamp,"nonceStr="&nonceStr)
		afterData = kSort(afterData)
		GetEditAddressParameters = ToJson(afterData)
	End Function
 
End Class

 %>