以下為類文件:class.asp源代碼
----------------------------------------------
dim create_ip,nonce_str,timeStamp,xmlhttp,preCookies
preCookies = "WOS2329erewr4I3" 'Cookie前綴,同一個網站下,多個支付需要修改
create_ip = Request.ServerVariables("REMOTE_ADDR")
nonce_str = GetRnd(10)
timeStamp = ToUnixTime(now())
xmlhttp = "Msxml2.ServerXMLHTTP"'"Msxml2.ServerXMLHTTP.6.0"
'Microsoft.XMLHTTP
'Microsoft.XMLHTTP.1.0
'Msxml2.ServerXMLHTTP.6.0
'Msxml2.ServerXMLHTTP.5.0
'Msxml2.ServerXMLHTTP.4.0
'Msxml2.ServerXMLHTTP.3.0
'Msxml2.ServerXMLHTTP
'Msxml2.XMLHTTP.6.0
'Msxml2.XMLHTTP.5.0
'Msxml2.XMLHTTP.4.0
'Msxml2.XMLHTTP.3.0
'Msxml2.XMLHTTP
'microsoft.xmlhttp
'Msxml2.XMLHTTP
'WinHttp.WinHttpRequest.5.1
'MSXML2.SERVERXMLHTTP.3.0
'以上為候選參數
'Native支付1,返回固定鏈接
function get_Native_code_url()
dim postData,signValue,post_url,sign,returnXml,xml_dom
post_url= "https://api.mch.weixin.qq.com/pay/unifiedorder"
sign="appid="&getAppId&"&body="&body&"&mch_id="&getMCHID&"&nonce_str="&nonce_str&"¬ify_url="¬ify_url&"&out_trade_no="&out_trade_no&"&product_id="&product_id&"&spbill_create_ip="&create_ip&"&total_fee="&total_fee&"&trade_type=NATIVE&key="&getPartnerKey
signValue=UCase(MD5(sign,"UTF-8"))
postData="<xml>"&_
"<appid><![CDATA["&getAppId&"]]></appid>"&_
"<body><![CDATA["&body&"]]></body>"&_
"<mch_id><![CDATA["&getMCHID&"]]></mch_id>"&_
"<nonce_str><![CDATA["&nonce_str&"]]></nonce_str>"&_
"<notify_url><![CDATA["¬ify_url&"]]></notify_url>"&_
"<out_trade_no><![CDATA["&out_trade_no&"]]></out_trade_no>"&_
"<product_id><![CDATA["&product_id&"]]></product_id>"&_
"<spbill_create_ip><![CDATA["&create_ip&"]]></spbill_create_ip>"&_
"<total_fee><![CDATA["&total_fee&"]]></total_fee>"&_
"<trade_type><![CDATA[NATIVE]]></trade_type>"&_
"<sign><![CDATA["&signValue&"]]></sign>"&_
"</xml>"
returnXml=PostURL("http://www.xxasp.net/pay/?url="&post_url,postData)
set xml_dom=Server.CreateObject("MSXML2.DOMDocument")
xml_dom.loadXml(returnXml)
dim return_code,return_msg,result_code,err_code_des,prepay_id,code_url
return_code=xml_dom.getelementsbytagname("return_code").item(0).text
if return_code="FAIL" then
'協議級錯誤
return_msg=xml_dom.getelementsbytagname("return_msg").item(0).text
response.Write("協議級接口調用錯誤:"&return_msg)
response.End()
else
result_code=xml_dom.getelementsbytagname("result_code").item(0).text
if result_code="FAIL" then
'業務級錯誤
err_code_des=xml_dom.getelementsbytagname("err_code_des").item(0).text
response.Write("業務級支付錯誤:"&err_code_des)
response.End()
else
if return_code="SUCCESS" and result_code="SUCCESS" then
'數據正常
get_Native_code_url=xml_dom.getelementsbytagname("code_url").item(0).text
end if
end if
end if
end Function
'返回當前日期20140105024523
Function getStrNow()
dim strNow:strNow = Now()
strNow = Year(strNow) & Right(("00" & Month(strNow)),2) & Right(("00" & Day(strNow)),2) & Right(("00" & Hour(strNow)),2) & Right(("00" & Minute(strNow)),2) & Right(("00" & Second(strNow)),2)
getStrNow = strNow
End Function
'獲取隨機數,返回 [min,max]范圍的數
Function getRandNumber(max, min)
Randomize
getRandNumber = CInt((max-min+1)*Rnd()+min)
End Function
'獲取隨機數字的字符串,返回[min,max]范圍的數字字符串
Function getStrRandNumber(max, min)
dim randNumber:randNumber = getRandNumber(max, min)
getStrRandNumber = CStr(randNumber)
End Function
Function GetRnd(t0)
randomize
dim n1,n2,n3
do while len(getrnd)<t0 '隨機字符位數
n1=cstr(chrw((57-48)*rnd+48)) '0~9
n2=cstr(chrw((90-65)*rnd+65)) 'a~z
n3=cstr(chrw((122-97)*rnd+97)) 'a~z
getrnd=getrnd&n1&n2&n3
loop
End Function
'時間戳轉換成普通日期
Function FromUnixTime(intTime)
If IsEmpty(intTime) Or Not IsNumeric(intTime) Then
FromUnixTime = Now()
Exit Function
End If
FromUnixTime = DateAdd("s", intTime, "1970-1-1 0:0:0")
FromUnixTime = DateAdd("h", 8, FromUnixTime)
End Function
'普通日期轉換成時間戳
Function ToUnixTime(strTime)
If IsEmpty(strTime) or Not IsDate(strTime) Then strTime = Now
ToUnixTime = DateAdd("h",-8,strTime)
ToUnixTime = DateDiff("s","1970-1-1 0:0:0", ToUnixTime)
End Function
Dim sc4Json
Sub InitScriptControl
Set sc4Json = Server.CreateObject("MSScriptControl.ScriptControl")
sc4Json.Language = "JavaScript"
sc4Json.AddCode "var itemTemp=null;function getJSArray(arr, index){itemTemp=arr[index];}"
End Sub
Function getJSONObject(strJSON)
sc4Json.AddCode "var jsonObject = " & strJSON
Set getJSONObject = sc4Json.CodeObject.jsonObject
End Function
Sub getJSArrayItem(objDest,objJSArray,index)
On Error Resume Next
sc4Json.Run "getJSArray",objJSArray, index
Set objDest = sc4Json.CodeObject.itemTemp
If Err.number=0 Then Exit Sub
objDest = sc4Json.CodeObject.itemTemp
End Sub
Function PostURL(url,PostStr)
dim http
Set http = Server.CreateObject(xmlhttp)
With http
.Open "POST", url, false ,"" ,""
.setRequestHeader "Content-Type","application/x-www-form-urlencoded"
.Send(PostStr)
PostURL = .responsetext
End With
Set http = Nothing
End Function
Function GetURL(url)
dim http
set http=server.createobject(xmlhttp)
http.open "GET",url,false
http.setRequestHeader "If-Modified-Since","0"
http.send()
GetURL=http.responsetext
set http=nothing
End Function
Function IsInstall(byval t0)
err.clear
on error resume next
IsInstall=false
dim obj
set obj=server.createobject(t0)
if err.number=0 then IsInstall=true
set obj=nothing
err.clear()
End Function
''轉換HTML代碼,過濾代碼
Function enhtml(byval t0)
if isnull(t0) then enhtml="":exit function
if t0="<p> </p>" then enhtml="":exit function
t0=replace(t0,"&","&")
t0=replace(t0,"'","'")
t0=replace(t0,"""",""")
t0=replace(t0,"<","<")
t0=replace(t0,">",">")
enhtml=t0
End Function
sub OutPutTxt(str)
dim FilePath,Fso,fopen
filepath=server.mappath("wx.txt")
Set fso = Server.CreateObject("scripting.FileSystemObject")
set fopen=fso.OpenTextFile(filepath, 8 ,true)
fopen.writeline(str)
set fso=nothing
set fopen=Nothing
end sub