<!--#include file="../conn/conn2.asp"-->
<%
Set rs= Server.CreateObject("ADODB.RecordSet")
sql="select * from SL_config"
rs.open sql,conn,1,1
if not rs.eof then
C_alipay=rs("C_alipay")
C_alipaykey=rs("C_alipaykey")
C_alipayid=rs("C_alipayid")
end if
rs.close
set rs=nothing

partner         = C_alipayid
seller_email	= C_alipay
key   			= C_alipaykey

input_charset	= "utf-8"
sign_type       = "MD5"
Private Const BITS_TO_A_BYTE = 8
Private Const BYTES_TO_A_WORD = 4
Private Const BITS_TO_A_WORD = 32

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 str2bin(varstr) 
    Dim varasc
    Dim i
    Dim varchar
    Dim varlow
    Dim varhigh
    
	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_utf(varstr)
    Dim varchar, code, codearr, j, i
    str2bin_utf = ""
    For i=1 To Len(varstr)
        varchar = Mid(varstr,i,1)
        code = Server.UrlEncode(varchar)
		If(code="+") Then code="%20"
        If Len(code) = 1 Then
           str2bin_utf = str2bin_utf & chrB(AscB(code))
        Else
           codearr = Split(code,"%")
           For j = 1 to UBound(codearr)
              str2bin_utf = str2bin_utf & 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,input_charset)
	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
	
	If LCase(input_charset) = "utf-8" Then 
        x = ConvertToWordArray(str2bin_utf(sMessage))
	Else
        x = ConvertToWordArray(str2bin(sMessage))
	End If
	
	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

Function CreateLinkstring(sPara)
	nCount = ubound(sPara)
	Dim prestr
	For i = 0 To nCount
		If i = nCount Then
			prestr = prestr & sPara(i)
		Else
			prestr = prestr & sPara(i) & "&"
		End if
	Next
	
	CreateLinkstring = prestr
End Function


function CreateLinkStringUrlEncode(sPara)
	nCount = ubound(sPara)
	dim prestr
	for i = 0 to nCount
		'把sPara的数组里的元素格式：变量名=值，分割开来
		pos = Instr(sPara(i),"=")			'获得=字符的位置
		nLen = Len(sPara(i))				'获得字符串长度
		itemName = left(sPara(i),pos-1)	'获得变量名
		itemValue = right(sPara(i),nLen-pos)'获得变量的值
		
		if itemName <> "service" and itemName <> "_input_charset" then
			prestr = prestr & itemName &"=" & server.URLEncode(itemValue) & "&"
		else
			prestr = prestr & sPara(i) & "&"
		end if
	next
	
	CreateLinkStringUrlEncode = prestr
end function

''
' 除去数组中的空值和签名参数
' param sPara 签名参数组
' return 去掉空值与签名参数后的新签名参数组
Function FilterPara(sPara)
	Dim sParaFilter(),nCount,j
	nCount = ubound(sPara)
	j = 0
	For i = 0 To nCount
		'把sPara的数组里的元素格式：变量名=值，分割开来
		pos = Instr(sPara(i),"=")			'获得=字符的位置
		nLen = Len(sPara(i))				'获得字符串长度
		itemName = left(sPara(i),pos-1)	'获得变量名
		itemValue = right(sPara(i),nLen-pos)'获得变量的值
		
		If itemName <> "sign" And itemName <> "sign_type" And itemValue <> "" and isnull(itemValue) = false Then
			Redim Preserve sParaFilter(j)
			sParaFilter(j) = sPara(i)
			j = j + 1
		End If
	Next
	
	FilterPara = sParaFilter
End Function

''
' 对数组排序
' param sPara 排序前的数组
' return 排序后的数组
Function SortPara(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

''
' MD5签名
' param prestr 需要签名的字符串
' param key 私钥
' param input_charset 编码格式
' return 签名结果
Function Md5Sign(prestr, key, input_charset)
	Dim mysign
	
	'把拼接后的字符串再与安全校验码直接连接起来
	prestr = prestr & key
	
	mysign = md5(prestr,input_charset)
	
	Md5Sign = mysign
End Function

Function Md5Verify(prestr, sign, key, input_charset)
	Dim mysign
	
	'把拼接后的字符串再与安全校验码直接连接起来
	prestr = prestr & key
	
	mysign = md5(prestr,input_charset)
	
	'比较获得的sign签名结果是否与生成的mysign签名结果相等
	If mysign = sign Then
		Md5Verify = true
	Else
		Md5Verify = false
	End If
End Function

''
' 写日志，方便测试（看网站需求，也可以改成存入数据库）
' param sWord 要写入日志里的文本内容
Function LogResult(sWord)
	Randomize
	Set fs= createobject("scripting.filesystemobject")
	Set ts=fs.createtextfile(server.MapPath("log/"&GetDateTime()&INT((1000+1)*RND)&".txt"),true)
	ts.writeline(sWord)
	ts.close
	Set ts=Nothing
	Set fs=Nothing
End Function

''
' 获取当前时间
' 格式：年[4位]-月[2位]-日[2位] 小时[2位 24小时制]:分[2位]:秒[2位]，如：2007-10-01 13:13:13
' return 时间格式化结果
Function GetDateTimeFormat()
	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)
	GetDateTimeFormat = sResult
End Function

''
' 获取当前时间
' 格式：年[4位]月[2位]日[2位]小时[2位 24小时制]分[2位]秒[2位]，如：20071001131313
' return 时间格式化结果
Function GetDateTime()
	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

''
' 过滤特殊字符
' param Str 要被过滤的字符串
' return 已被过滤掉的新字符串
Function DelStr(Str)
	If IsNull(Str) Or IsEmpty(Str) Then
		Str	= ""
	End If
	DelStr	= Replace(Str,";","")
	DelStr	= Replace(DelStr,"'","")
	DelStr	= Replace(DelStr,"&","")
	DelStr	= Replace(DelStr," ","")
	DelStr	= Replace(DelStr,"　","")
	DelStr	= Replace(DelStr,"%20","")
	DelStr	= Replace(DelStr,"--","")
	DelStr	= Replace(DelStr,"==","")
	DelStr	= Replace(DelStr,"<","")
	DelStr	= Replace(DelStr,">","")
	DelStr	= Replace(DelStr,"%","")
End Function


GATEWAY_NEW = "https://mapi.alipay.com/gateway.do?"

Class AlipaySubmit

	''
	' 生成签名结果
	' param sParaSort 待签名的数组
	' return 签名结果字符串
	Private Function BuildRequestMysign(sParaSort)
			
		'把数组所有元素，按照“参数=参数值”的模式用“&”字符拼接成字符串
		prestr = CreateLinkstring(sParaSort)
		
		'获得签名结果
		 Select Case sign_type
		 	Case "MD5" BuildRequestMysign = Md5Sign(prestr,key,input_charset)
			Case Else BuildRequestMysign = ""
		 End Select
	End Function

	''
	' 生成要请求给支付宝的参数数组
	' param sParaTemp 请求前的参数数组
	' return 要请求的参数数组
	Private Function BuildRequestPara(sParaTemp)
		Dim mysign
		'过滤签名参数数组
		sPara = FilterPara(sParaTemp)
		
		'对请求参数数组排序
		sParaSort = SortPara(sPara)
		
		'获得签名结果
		mysign = BuildRequestMysign(sParaSort)
		
		'签名结果与签名方式加入请求提交参数组中
		nCount = ubound(sParaSort)
		Redim Preserve sParaSort(nCount+1)
		sParaSort(nCount+1) = "sign="&mysign
		Redim Preserve sParaSort(nCount+2)
		sParaSort(nCount+2) = "sign_type="&sign_type

		BuildRequestPara = sParaSort
	End Function
	
	''
	' 生成要请求给支付宝的参数数组字符串
	' param sParaTemp 请求前的参数数组
	' return 要请求的参数数组字符串
	Private Function BuildRequestParaToString(sParaTemp)
		Dim sRequestData
		'待签名请求参数数组
		sPara = BuildRequestPara(sParaTemp)
		'把参数组中所有元素，按照“参数=参数值”的模式用“&”字符拼接成字符串，并且对其做urlencode编码处理
		sRequestData = CreateLinkStringUrlEncode(sPara)
		
		BuildRequestParaToString = sRequestData
	End Function

	''
	' 建立请求，以表单HTML形式构造（默认）
	' param sParaTemp 请求前的参数数组
	' param sMethod 提交方式。两个值可选：post、get
	' param sButtonValue 确认按钮显示文字
	' return 提交表单HTML文本
	Public Function BuildRequestForm(sParaTemp, sMethod, sButtonValue)
		Dim sHtml, nCount
		'待请求参数数组
		sPara = BuildRequestPara(sParaTemp)
		
		sHtml = "<form id='alipaysubmit' name='alipaysubmit' action='"& GATEWAY_NEW &"_input_charset="&input_charset&"' method='"&sMethod&"'>"
		
		nCount = ubound(sPara)
		For i = 0 To nCount
			'把sPara的数组里的元素格式：变量名=值，分割开来
			iPos = Instr(sPara(i),"=")			'获得=字符的位置
			nLen = Len(sPara(i))				'获得字符串长度
			sItemName = left(sPara(i),iPos-1)	'获得变量名
			sItemValue = right(sPara(i),nLen-iPos)'获得变量的值
		
			sHtml = sHtml & "<input type='hidden' name='"& sItemName &"' value='"& sItemValue &"'/>"
		next

		'submit按钮控件请不要含有name属性
		'submit按钮默认设置为不显示
		sHtml = sHtml & "<input type='submit' value='"&sButtonValue&"' style='display:none;'></form>"
		
		sHtml = sHtml & "<script>document.forms['alipaysubmit'].submit();</script>"
		
		BuildRequestForm = sHtml
	End Function
	
	''
	' 建立请求，以模拟远程HTTP的GET请求方式构造并获取支付宝XML类型处理结果
	' param sParaTemp 请求前的参数数组
	' param sParaNode 要输出的XML节点名
	' return 支付宝返回XML指定节点内容
	Public Function BuildRequestHttpXml(sParaTemp, sParaNode)
		Dim sUrl, objHttp, objXml, nCount, sParaXml()
		nCount = ubound(sParaNode)
		
		'待请求参数数组字符串
		sRequestData = BuildRequestParaToString(sParaTemp)
		'构造请求地址
		sUrl = GATEWAY_NEW & sRequestData

		'获取远程数据
		Set objHttp=Server.CreateObject("Microsoft.XMLHTTP")
		'如果Microsoft.XMLHTTP不行，那么请替换下面的两行行代码尝试
		'Set objHttp = Server.CreateObject("Msxml2.ServerXMLHTTP.3.0")
		'objHttp.setOption 2, 13056
		objHttp.open "GET", sUrl, False, "", ""
		objHttp.send()
		Set objXml=Server.CreateObject("Microsoft.XMLDOM")
		objXml.Async=true
		objXml.ValidateOnParse=False
		objXml.Load(objHttp.ResponseXML)
		Set objHttp = Nothing
		
		set objXmlData = objXml.getElementsByTagName("alipay").item(0)
		If Isnull(objXmlData.selectSingleNode("alipay")) Then
			Redim Preserve sParaXml(1)
			sParaXml(0) = "错误：非法XML格式数据"
		Else
			If objXmlData.selectSingleNode("is_success").text = "T" Then
				For i = 0 To nCount
					Redim Preserve sParaXml(i+1)
					sParaXml(i) = objXmlData.selectSingleNode(sParaNode(i)).text
				Next
			Else
				Redim Preserve sParaXml(1)
				sParaXml(0) = "错误："&objXmlData.selectSingleNode("error").text
			End If
		End If
		
		BuildRequestHttpXml = sParaXml
	End Function
	
	''
	' 建立请求，以模拟远程HTTP的GET请求方式构造并获取支付宝纯文字类型处理结果
	' param sParaTemp 请求前的参数数组
	' return 支付宝处理结果
	Public Function BuildRequestHttpWord(sParaTemp)
		Dim sUrl, objHttp, sResponseTxt
		
		'待请求参数数组字符串
		sRequestData = BuildRequestParaToString(sParaTemp)
		'构造请求地址
		sUrl = GATEWAY_NEW & sRequestData

		'获取远程数据
		Set objHttp=Server.CreateObject("Microsoft.XMLHTTP")
		'如果Microsoft.XMLHTTP不行，那么请替换下面的两行行代码尝试
		'Set objHttp = Server.CreateObject("Msxml2.ServerXMLHTTP.3.0")
		'objHttp.setOption 2, 13056
		objHttp.open "GET", sUrl, False, "", ""
		objHttp.send()
		sResponseTxt = objHttp.ResponseText
		Set objHttp = Nothing
		
		BuildRequestHttpWord = sResponseTxt
	End Function

	''
	' 用于防钓鱼，调用支付宝防钓鱼接口(query_timestamp)来获取时间戳的处理函数
	' 注意：远程解析XML出错，与IIS服务器配置有关
	' return 时间戳字符串
	Public Function Query_timestamp()
		Dim sUrl, encrypt_key
		sUrl = GATEWAY_NEW &"service=query_timestamp&partner="&partner&"&_input_charset="&input_charset
		encrypt_key = ""
		
		Dim objHttp, objXml
		Set objHttp=Server.CreateObject("Microsoft.XMLHTTP")
		'如果Microsoft.XMLHTTP不行，那么请替换下面的两行行代码尝试
		'Set objHttp = Server.CreateObject("Msxml2.ServerXMLHTTP.3.0")
		'objHttp.setOption 2, 13056
		objHttp.open "GET", sUrl, False, "", ""
		objHttp.send()
		Set objXml=Server.CreateObject("Microsoft.XMLDOM")
		objXml.Async=true
		objXml.ValidateOnParse=False
		objXml.Load(objHttp.ResponseXML)
		Set objHttp = Nothing
		
		Set objXmlData = objXml.getElementsByTagName("encrypt_key")  '节点的名称
		If Isnull(objXml.getElementsByTagName("encrypt_key")) Then
			encrypt_key = ""
		Else
			encrypt_key = objXmlData.item(0).childnodes(0).text
		End If

		Query_timestamp = encrypt_key
	End Function

End Class

%>
<html>
<head>
	<META http-equiv=Content-Type content="text/html; charset=utf-8">
<title>支付宝即时到账交易接口</title>
</head>
<body>
正在跳转到付款页面，请稍后...


<%

O_id=request.QueryString("O_id")

Set rs= Server.CreateObject("ADODB.RecordSet")
sql="select * from SL_orders,SL_product,SL_member where O_pid=P_id and O_member=M_id and O_id="&O_id
rs.open sql,conn,1,1
if not rs.eof then
P_title=rs("P_title")
O_all=rs("O_price")*rs("O_num")
end if
rs.close
set rs=nothing
O_all=FormatNumber(O_all,2,-1)

D_domain=split(split("http://"&Request.ServerVariables("HTTP_HOST")&Request.ServerVariables("URL"),"http://")(1),"/alipay")(0)

        '支付类型
        payment_type = "1"
        '必填，不能修改
        '服务器异步通知页面路径
        notify_url = "http://"&D_domain&"/alipay/notify_url.asp"
        '需http://格式的完整路径，不能加?id=123这类自定义参数

        '页面跳转同步通知页面路径
        return_url = "http://"&D_domain&"/alipay/return_url.asp"
        '需http://格式的完整路径，不能加?id=123这类自定义参数，不能写成http://localhost/

        '商户订单号
        out_trade_no = year(now())&month(now())&day(now())&"_"&O_id
        '商户网站订单系统中唯一订单号，必填

        '订单名称
        subject = P_title
        '必填

        '付款金额
        total_fee = O_all
        '必填

        '订单描述

        body = O_id
        '商品展示地址
        show_url = "http://"&D_domain
        '需以http://开头的完整路径，例如：http://www.商户网址.com/myorder.html

        '防钓鱼时间戳
        anti_phishing_key = ""
        '若要使用请调用类文件submit中的query_timestamp函数

        '客户端的IP地址
        exter_invoke_ip = ""
        '非局域网的外网IP地址，如：221.0.0.1

'/////////////////////请求参数/////////////////////

'构造请求参数数组
sParaTemp = Array("service=create_direct_pay_by_user","partner="&partner,"seller_email="&seller_email,"_input_charset="&input_charset ,"payment_type="&payment_type ,"notify_url="&notify_url,"return_url="&return_url   ,"out_trade_no="&out_trade_no   ,"subject="&subject   ,"total_fee="&total_fee   ,"body="&body   ,"show_url="&show_url   ,"anti_phishing_key="&anti_phishing_key   ,"exter_invoke_ip="&exter_invoke_ip)

'建立请求
Set objSubmit = New AlipaySubmit
sHtml = objSubmit.BuildRequestForm(sParaTemp, "get", "确认")
response.Write sHtml


%>
</body>
</html>
