在线测试支付效果(微信扫码测试公众号支付效果)
接口对接服务热线：180-687-28630 QQ:120094883
'获取客户端IP
Function GetIP()
Dim strIPAddr
If Request.ServerVariables("HTTP_X_FORWARDED_FOR") = "" Or InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), "unknown") > 0 Then
strIPAddr = Request.ServerVariables("REMOTE_ADDR")
ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",") > 0 Then
strIPAddr = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",")-1)
ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";") > 0 Then
strIPAddr = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";")-1)
Else
strIPAddr = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
End If
getIP = Checkstr(Trim(Mid(strIPAddr, 1, 30)))
End Function
'生成支付单号
Function GetOrderId()
dim wxa,wxb
randomize
wxa=int(900*rnd)+100
wxb=now()
GetOrderId=year(wxb)&right("0"&month(wxb),2)&right("0"&day(wxb),2)&right("0"&hour(wxb),2)&right("0"&minute(wxb),2)&right("0"&second(wxb),2)&wxa
End function
'过滤字符
Function Checkstr(Str)
If Isnull(Str) Then
CheckStr = ""
Exit Function
End If
Str = Replace(Str,Chr(0),"")
CheckStr = Replace(Str,"'","''")
End Function
'返回当前日期
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)
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
'POST过程
Function Get_code_url(url,xml)
Dim code_url,data
data =Response_Data(xml,url,1)
code_url = PostURL(md5url,data)
Get_code_url = code_url
End Function
'整合POST数据
Function Response_Data(xml,url,cert)
dim domain:domain=Request.ServerVariables("HTTP_HOST")
If cert=1 Then
Response_Data = "xml="&xml&"&url="&url&"&domain="&domain&"&cert=1"
Else
Response_Data = "xml="&xml&"&url="&url&"&domain="&domain&"&cert=0"
End If
End Function
'获取POST返回数据
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
'获取GET返回数据
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
'XML请求
Function HttpSendSSL(byval sUrl, byval xmlBody)
On Error Resume Next
Dim xmlhttp,xmlget
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)
If Err.Number <> 0 Then
HttpSendSSL = Err.Description
Exit Function
End If
xmlget = bin2str(xmlhttp.responseBody)
Set xmlhttp = Nothing
HttpSendSSL = xmlget
End Function
'二进制流转换
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
'截取JSON数据
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
