alipay_fun.asp

电子商城代码

<%
'/***************************************************************************************************************
	'* Author:		yeaome(小叶/叶老四)
	'* Version:		Ver 2.0.0
'****************************************************************************************************************/

Class myAlipay

	Public REQUEST_URL				'支付宝交易处理地址
	Public GENERATE_BUTTON_CODE_URL	'生成支付宝交易处理地址的链接
	Public REQUEST_PAYTO_URL		'payto连接地址
	Public DEFAULT_ENCODING			'默认编码

	Private alipayVer				'版本编号
	Private md5Obj					'MD5加密算法对象(私有)


	'构造函数,初始化各必要变量
	Public Sub myAlipay_Initialize()
		REQUEST_URL					= "https://www.alipay.com/trade/i_buy.do?"
		GENERATE_BUTTON_CODE_URL	= "https://www.alipay.com/trade/i_link.do?"
		REQUEST_PAYTO_URL			= "https://www.alipay.com/payto:"
		DEFAULT_ENCODING			= "UTF-8"
		Call getDateVersion()
		
		'创建md5Obj实例,方便在generateTradeMD5接口中使用
		Set md5Obj					= New Alipay_MD5
		md5Obj.MD5_Initialize()
	End Sub

	'请求生成支付宝交易处理地址的链接,返回生成“支付宝交易URL”(需要请求支付宝i_link地址)
	Public Function getTradeButtonURL(s1,s2,s3,s4,s5,s6)
		Dim strTemp,strURL,xmlObject
		strTemp				= GENERATE_BUTTON_CODE_URL & "goodsBid=" & s1
		strTemp				= strTemp & "&ordinaryFee=" & s2
		strTemp				= strTemp & "&expressFee=" & s3
		strTemp				= strTemp & "&sellerEmail=" & s4
		strTemp				= strTemp & "&goodsTitle=" & s5
		strTemp				= strTemp & "&securityCode=" & s6
		getTradeButtonURL	= getHTTPURL(strTemp)
	End Function


	'通过MD5算法等自动组合生成“支付宝交易URL”(不需要请求支付宝i_link地址)
	Public Function generateTradeButtonURL(s1,s2,s3,s4,s5,s6)
		Dim strTemp,strURL
		strTemp					= REQUEST_URL & "a=" & s1
		strTemp					= strTemp & "&b=" & s2
		strTemp					= strTemp & "&c=" & s3
		strTemp					= strTemp & "&d=" & s4
		strTemp					= strTemp & "&e=" & s5
		strTemp					= strTemp & "&v=" & alipayVer
		strTemp					= strTemp & "&f=" & generateTradeMD5(s5,s1,s2,s3,s4,s6)
		generateTradeButtonURL	= strTemp
	End Function

	

	'通过MD5算法等自动组合生成“支付宝payto交易URL”(最新payto接口，强烈建议使用本接口开发，同时它支持返回通知)
	Public Function generatePaytoURL(s1,s2,s3,s4,s5,s6,s7,s8,s9,s10,s11)
		Dim strTemp,strURL
		strTemp					= REQUEST_PAYTO_URL & s4 & "?"
		strTemp					= strTemp & "&cmd=" & s7
		strTemp					= strTemp & "&subject=" & server.urlencode(s8)
		strTemp					= strTemp & "&body=" & server.urlencode(s9)
		strTemp					= strTemp & "&order_no=" & s5
		strTemp					= strTemp & "&price=" & s1
		strTemp					= strTemp & "&ordinary_fee=" & s2
		strTemp					= strTemp & "&express_fee=" & s3
		strTemp					= strTemp & "&ac=" & generatePaytoMD5(s1,s2,s3,s4,s5,s6,s7,s8,s9,s10)
		strTemp					= strTemp & "&partner=" & s10
		strTemp					= strTemp & "&order_number=" & s11
		generatePaytoURL		= strTemp
	End Function

	'获取时间形式的版本号
	Public Sub getDateVersion()
		alipayVer		= "1.0_" & Year(Date()) & Right(("0" & Month(Date())),2) & Right(("0" & Day(Date())),2)
	End Sub

	'取得交易的MD5加密串,已经解决中文加密问题
	Public Function generateTradeMD5(s1,s2,s3,s4,s5,s6)
		Dim strTemp
		strTemp		= "goodsTitle" & s1 & "goodsBid" & s2 & "ordinaryFee" & s3 & "expressFee" & s4 & "sellerEmail" & s5 & s6
		generateTradeMD5	= md5Obj.md5(strTemp)
	End Function

	'取得payto交易的MD5加密串,已经解决中文加密问题
	Public Function generatePaytoMD5(s1,s2,s3,s4,s5,s6,s7,s8,s9,s10)
		Dim strTemp
		strTemp		= "cmd" & s7 & "subject" & s8 & "body" & s9 & "order_no" & s5 & "price" & s1 & "ordinary_fee" & s2 & "express_fee" & s3 & "seller" & s4 & "partner" & s10 & s6
		generatePaytoMD5	= md5Obj.md5(strTemp)
	End Function

	'私有接口,取得请求后返回的html
	Public Function getHTTPURL(strPath)
        Dim strTemp
		strTemp			= GetBody(strPath)
        'getHTTPURL		= BytesToBstr(strTemp,"UTF-8")
        getHTTPURL		= strTemp
	End function

	'私有接口,取得请求后返回的html Stream
	Private Function GetBody(strURL)
		'On Error Resume Next
        Set Retrieval		= CreateObject("Microsoft.XMLHTTP") 
        With Retrieval 
			.Open "GET", strURL, False, "", "" 
			.Send 
			GetBody	= .ResponseBody
        End With 
        Set Retrieval		= Nothing
	End Function

	'私有接口,转换Stream-->String
	Private Function BytesToBstr(strBody,strCharset)
        Dim streamObj
        set streamObj		= Server.CreateObject("ADODB.Stream")
        streamObj.Type		= 1
        streamObj.Mode		= 3
        streamObj.Open
        streamObj.Write strBody
        streamObj.Position	= 0
        streamObj.Type		= 2
        streamObj.Charset	= strCharset
        BytesToBstr			= streamObj.ReadText 
        streamObj.Close
        Set streamObj		= Nothing
	End Function



End Class

function chinese2unicode(Str) 
        for i=1 to len(Str) 
                Str_one=Mid(Str,i,1) 
                Str_unicode=Str_unicode&chr(38) 
                Str_unicode=Str_unicode&chr(35) 
                Str_unicode=Str_unicode&chr(120) 
                Str_unicode=Str_unicode& Hex(ascw(Str_one)) 
                Str_unicode=Str_unicode&chr(59) 
        next 
        chinese2unicode = Str_unicode 
end function 

function UTF2GB(UTFStr)
        for Dig=1 to len(UTFStr)
                if mid(UTFStr,Dig,1)="%" then
                        if len(UTFStr) >= Dig+8 then
                                GBStr=GBStr & ConvChinese(mid(UTFStr,Dig,9))
                                Dig=Dig+8
                        else
                                GBStr=GBStr & mid(UTFStr,Dig,1)
                        end if
                else
                        GBStr=GBStr & mid(UTFStr,Dig,1)
                end if
        next
        UTF2GB=GBStr
end function 


function ConvChinese(x) 
        A=split(mid(x,2),"%")
        i=0
        j=0

        for i=0 to ubound(A) 
                A(i)=c16to2(A(i))
        next

        for i=0 to ubound(A)-1
                DigS=instr(A(i),"0")
                 Unicode=""
                for j=1 to DigS-1
                        if j=1 then 
                                A(i)=right(A(i),len(A(i))-DigS)
                                Unicode=Unicode & A(i)
                        else
                                 i=i+1
                                A(i)=right(A(i),len(A(i))-2)
                                Unicode=Unicode & A(i) 
                        end if 
                next

                if len(c2to16(Unicode))=4 then
                        ConvChinese=ConvChinese & chrw(int("&H" & c2to16(Unicode)))
                else
                        ConvChinese=ConvChinese & chr(int("&H" & c2to16(Unicode)))
                end if
        next
end function

function c2to16(x)
        i=1
        for i=1 to len(x) step 4 
                c2to16=c2to16 & hex(c2to10(mid(x,i,4))) 
        next
end function 

function c2to10(x)
        c2to10=0
        if x="0" then exit function
        i=0
        for i= 0 to len(x) -1
                 if mid(x,len(x)-i,1)="1" then c2to10=c2to10+2^(i)
        next 
end function

function c16to2(x)
        i=0
        for i=1 to len(trim(x)) 
                tempstr= c10to2(cint(int("&h" & mid(x,i,1))))
                do while len(tempstr)<4
                        tempstr="0" & tempstr
                loop
                c16to2=c16to2 & tempstr
        next
end function

function c10to2(x)
        mysign=sgn(x)
        x=abs(x)
        DigS=1
        do 
                if x<2^DigS then
                        exit do
                else
                        DigS=DigS+1
                end if
        loop
        tempnum=x

        i=0
        for i=DigS to 1 step-1
                if tempnum>=2^(i-1) then
                        tempnum=tempnum-2^(i-1)
                        c10to2=c10to2 & "1" 
                else
                        c10to2=c10to2 & "0"
                end if
        next
        if mysign=-1 then c10to2="-" & c10to2
end function

%>