服务器之家：专注于服务器技术及软件下载分享
分类导航

PHP教程|ASP.NET教程|Java教程|ASP教程|编程技术|正则表达式|C/C++|IOS|C#|Swift|Android|JavaScript|易语言|

服务器之家 - 编程语言 - ASP教程 - asp 一些支付接口

asp 一些支付接口

2019-09-07 15:10服务器之家 ASP教程

asp 支付接口，包括99bill,支付宝，腾讯拍拍，chinabank，yeepay的支付接口。

99bill: 

1.md5.asp 
复制代码代码如下:

<% 
''''''''' 
' @Description: 快钱网关接口范例 
' @Copyright (c) 上海快钱信息服务有限公司 
' @version 2.0 
''''''''' 
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 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 = Len(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(Asc(Mid(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) 
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 

x = ConvertToWordArray(sMessage) 

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))    '32byte 
'MD5 = LCase(WordToHex(b) & WordToHex(c)) 'I crop this to fit 16byte database password :D 
End Function 
%> 


2.send.asp 
复制代码代码如下:

<!--#include file="md5.asp"--> 
<% 
''''''''' 
' @Description: 快钱网关接口范例 
' @Copyright (c) 上海快钱信息服务有限公司 
' @version 2.0 
''''''''' 
merchant_id = request("cid")        '''商户编号 
merchant_key = request("mykey")        '''商户密钥 
orderid = request("orderid")        '''订单编号 
amount = request("totalmoney")        '''订单金额 
curr = "1"        '''货币类型,1为人民币 
isSupportDES = "2"        '''是否安全校验,2为必校验,推荐 

merchant_url = ""        '''支付结果返回地址 
pname = request("pname")        '''支付人姓名 
commodity_info = ""        '''商品信息 
merchant_param = ""        '''商户私有参数 

pemail=""        '''传递email到快钱网关页面 
pid=""        '''代理/合作伙伴商户编号 

'''生成加密串,注意顺序 
ScrtStr="merchant_id=" & merchant_id & "&orderid=" & orderid & "&amount=" & amount & "&merchant_url=" & merchant_url & "&merchant_key=" & merchant_key 
mac=ucase(md5(ScrtStr)) 

%> 

<!doctype html public "-//w3c//dtd html 4.0 transitional//en" > 
<html> 
    <head> 
        <title>快钱99bill</title> 
        <meta http-equiv="content-type" content="text/html; charset=gb2312" > 
    </head> 

<BODY onLoad="javascript:document.frm.submit()"> 


        <form name="frm" method="post" action="https://www.99bill.com/webapp/receiveMerchantInfoAction.do"> 
            <input name="merchant_id" type="hidden" value="<%=merchant_id%>"> 
            <input name="orderid" type="hidden" value="<%=orderid%>"> 
            <input name="amount" type="hidden" value="<%=amount%>"> 
            <input name="currency" type="hidden" value="<%=curr%>"> 
            <input name="isSupportDES" type="hidden" value="<%=isSupportDES%>"> 
            <input name="mac" type="hidden" value="<%=mac%>"> 

            <input name="merchant_url" type="hidden" value="<%=merchant_url%>"> 
            <input name="pname" type="hidden" value="<%=pname%>"> 
            <input name="commodity_info" type="hidden" value="<%=commodity_info%>"> 
            <input name="merchant_param" type="hidden" value="<%=merchant_param%>"> 

            <input name="pemail" type="hidden" value="<%=pemail%>"> 
            <input name="pid" type="hidden" value="<%=pid%>"> 

        </form> 

</BODY> 
</HTML> 


alipay 

1.Alipay_md5.asp 

  1. <%  
  2. Private Const BITS_TO_A_BYTE = 8  
  3. Private Const BYTES_TO_A_WORD = 4  
  4. Private Const BITS_TO_A_WORD = 32  
  5.  
  6. Private m_lOnBits(30)  
  7. Private m_l2Power(30)  
  8.  
  9. Private Function LShift(lValue, iShiftBits)  
  10.     If iShiftBits = 0 Then  
  11.         LShift = lValue  
  12.         Exit Function  
  13.     ElseIf iShiftBits = 31 Then  
  14.         If lValue And 1 Then  
  15.             LShift = &H80000000  
  16.         Else  
  17.             LShift = 0  
  18.         End If  
  19.         Exit Function  
  20.     ElseIf iShiftBits < 0 Or iShiftBits > 31 Then  
  21.         Err.Raise 6  
  22.     End If  
  23.  
  24.     If (lValue And m_l2Power(31 - iShiftBits)) Then  
  25.         LShift = ((lValue And m_lOnBits(31 - (iShiftBits + 1))) * m_l2Power(iShiftBits)) Or &H80000000  
  26.     Else  
  27.         LShift = ((lValue And m_lOnBits(31 - iShiftBits)) * m_l2Power(iShiftBits))  
  28.     End If  
  29. End Function  
  30.  
  31. Private Function str2bin(varstr)  
  32. Dim varasc  
  33. Dim i  
  34. Dim varchar  
  35. Dim varlow  
  36. Dim varhigh  
  37.  
  38.     str2bin=""  
  39. For i=1 To Len(varstr)  
  40. varchar=mid(varstr,i,1)  
  41. varasc = Asc(varchar)  
  42.  
  43. If varasc<0 Then  
  44. varasc = varasc + 65535  
  45. End If  
  46.  
  47. If varasc>255 Then  
  48. varlow = Left(Hex(Asc(varchar)),2)  
  49. varhigh = right(Hex(Asc(varchar)),2)  
  50. str2bin = str2bin & chrB("&H" & varlow) & chrB("&H" & varhigh)  
  51. Else  
  52. str2bin = str2bin & chrB(AscB(varchar))  
  53. End If  
  54. Next  
  55. End Function  
  56.  
  57. Private Function RShift(lValue, iShiftBits)  
  58.     If iShiftBits = 0 Then  
  59.         RShift = lValue  
  60.         Exit Function  
  61.     ElseIf iShiftBits = 31 Then  
  62.         If lValue And &H80000000 Then  
  63.             RShift = 1  
  64.         Else  
  65.             RShift = 0  
  66.         End If  
  67.         Exit Function  
  68.     ElseIf iShiftBits < 0 Or iShiftBits > 31 Then  
  69.         Err.Raise 6  
  70.     End If  
  71.  
  72.     RShift = (lValue And &H7FFFFFFE) m_l2Power(iShiftBits)  
  73.  
  74.     If (lValue And &H80000000) Then  
  75.         RShift = (RShift Or (&H40000000 m_l2Power(iShiftBits - 1)))  
  76.     End If  
  77. End Function  
  78.  
  79. Private Function RotateLeft(lValue, iShiftBits)  
  80.     RotateLeft = LShift(lValue, iShiftBits) Or RShift(lValue, (32 - iShiftBits))  
  81. End Function  
  82.  
  83. Private Function AddUnsigned(lX, lY)  
  84.     Dim lX4  
  85.     Dim lY4  
  86.     Dim lX8  
  87.     Dim lY8  
  88.     Dim lResult  
  89.  
  90.     lX8 = lX And &H80000000  
  91.     lY8 = lY And &H80000000  
  92.     lX4 = lX And &H40000000  
  93.     lY4 = lY And &H40000000  
  94.  
  95.     lResult = (lX And &H3FFFFFFF) + (lY And &H3FFFFFFF)  
  96.  
  97.     If lX4 And lY4 Then  
  98.         lResult = lResult Xor &H80000000 Xor lX8 Xor lY8  
  99.     ElseIf lX4 Or lY4 Then  
  100.         If lResult And &H40000000 Then  
  101.             lResult = lResult Xor &HC0000000 Xor lX8 Xor lY8  
  102.         Else  
  103.             lResult = lResult Xor &H40000000 Xor lX8 Xor lY8  
  104.         End If  
  105.     Else  
  106.         lResult = lResult Xor lX8 Xor lY8  
  107.     End If  
  108.  
  109.     AddUnsigned = lResult  
  110. End Function  
  111.  
  112. Private Function md5_F(x, y, z)  
  113.     md5_F = (x And y) Or ((Not x) And z)  
  114. End Function  
  115.  
  116. Private Function md5_G(x, y, z)  
  117.     md5_G = (x And z) Or (y And (Not z))  
  118. End Function  
  119.  
  120. Private Function md5_H(x, y, z)  
  121.     md5_H = (x Xor y Xor z)  
  122. End Function  
  123.  
  124. Private Function md5_I(x, y, z)  
  125.     md5_I = (y Xor (x Or (Not z)))  
  126. End Function  
  127.  
  128. Private Sub md5_FF(a, b, c, d, x, s, ac)  
  129.     a = AddUnsigned(a, AddUnsigned(AddUnsigned(md5_F(b, c, d), x), ac))  
  130.     a = RotateLeft(a, s)  
  131.     a = AddUnsigned(a, b)  
  132. End Sub  
  133.  
  134. Private Sub md5_GG(a, b, c, d, x, s, ac)  
  135.     a = AddUnsigned(a, AddUnsigned(AddUnsigned(md5_G(b, c, d), x), ac))  
  136.     a = RotateLeft(a, s)  
  137.     a = AddUnsigned(a, b)  
  138. End Sub  
  139.  
  140. Private Sub md5_HH(a, b, c, d, x, s, ac)  
  141.     a = AddUnsigned(a, AddUnsigned(AddUnsigned(md5_H(b, c, d), x), ac))  
  142.     a = RotateLeft(a, s)  
  143.     a = AddUnsigned(a, b)  
  144. End Sub  
  145.  
  146. Private Sub md5_II(a, b, c, d, x, s, ac)  
  147.     a = AddUnsigned(a, AddUnsigned(AddUnsigned(md5_I(b, c, d), x), ac))  
  148.     a = RotateLeft(a, s)  
  149.     a = AddUnsigned(a, b)  
  150. End Sub  
  151.  
  152. Private Function ConvertToWordArray(sMessage)  
  153.     Dim lMessageLength  
  154.     Dim lNumberOfWords  
  155.     Dim lWordArray()  
  156.     Dim lBytePosition  
  157.     Dim lByteCount  
  158.     Dim lWordCount  
  159.  
  160.     Const MODULUS_BITS = 512  
  161.     Const CONGRUENT_BITS = 448  
  162.  
  163.     lMessageLength = LenB(sMessage)  
  164.  
  165.     lNumberOfWords = (((lMessageLength + ((MODULUS_BITS - CONGRUENT_BITS) BITS_TO_A_BYTE)) (MODULUS_BITS BITS_TO_A_BYTE)) + 1) * (MODULUS_BITS BITS_TO_A_WORD)  
  166.     ReDim lWordArray(lNumberOfWords - 1)  
  167.  
  168.     lBytePosition = 0  
  169. lByteCount = 0  
  170.     Do Until lByteCount >= lMessageLength  
  171.         lWordCount = lByteCount BYTES_TO_A_WORD  
  172.         lBytePosition = (lByteCount Mod BYTES_TO_A_WORD) * BITS_TO_A_BYTE  
  173.         lWordArray(lWordCount) = lWordArray(lWordCount) Or LShift(AscB(MidB(sMessage, lByteCount + 1, 1)), lBytePosition)  
  174.         lByteCount = lByteCount + 1  
  175.     Loop  
  176.  
  177.     lWordCount = lByteCount BYTES_TO_A_WORD  
  178.     lBytePosition = (lByteCount Mod BYTES_TO_A_WORD) * BITS_TO_A_BYTE  
  179.  
  180.     lWordArray(lWordCount) = lWordArray(lWordCount) Or LShift(&H80, lBytePosition)  
  181.  
  182.     lWordArray(lNumberOfWords - 2) = LShift(lMessageLength, 3)  
  183.     lWordArray(lNumberOfWords - 1) = RShift(lMessageLength, 29)  
  184.  
  185.     ConvertToWordArray = lWordArray  
  186. End Function  
  187.  
  188. Private Function WordToHex(lValue)  
  189.     Dim lByte  
  190.     Dim lCount  
  191.  
  192.     For lCount = 0 To 3  
  193.         lByte = RShift(lValue, lCount * BITS_TO_A_BYTE) And m_lOnBits(BITS_TO_A_BYTE - 1)  
  194.         WordToHex = WordToHex & Right("0" & Hex(lByte), 2)  
  195.     Next  
  196. End Function  
  197.  
  198. Public Function MD5(sMessage)  
  199.     m_lOnBits(0) = CLng(1)  
  200.     m_lOnBits(1) = CLng(3)  
  201.     m_lOnBits(2) = CLng(7)  
  202.     m_lOnBits(3) = CLng(15)  
  203.     m_lOnBits(4) = CLng(31)  
  204.     m_lOnBits(5) = CLng(63)  
  205.     m_lOnBits(6) = CLng(127)  
  206.     m_lOnBits(7) = CLng(255)  
  207.     m_lOnBits(8) = CLng(511)  
  208.     m_lOnBits(9) = CLng(1023)  
  209.     m_lOnBits(10) = CLng(2047)  
  210.     m_lOnBits(11) = CLng(4095)  
  211.     m_lOnBits(12) = CLng(8191)  
  212.     m_lOnBits(13) = CLng(16383)  
  213.     m_lOnBits(14) = CLng(32767)  
  214.     m_lOnBits(15) = CLng(65535)  
  215.     m_lOnBits(16) = CLng(131071)  
  216.     m_lOnBits(17) = CLng(262143)  
  217.     m_lOnBits(18) = CLng(524287)  
  218.     m_lOnBits(19) = CLng(1048575)  
  219.     m_lOnBits(20) = CLng(2097151)  
  220.     m_lOnBits(21) = CLng(4194303)  
  221.     m_lOnBits(22) = CLng(8388607)  
  222.     m_lOnBits(23) = CLng(16777215)  
  223.     m_lOnBits(24) = CLng(33554431)  
  224.     m_lOnBits(25) = CLng(67108863)  
  225.     m_lOnBits(26) = CLng(134217727)  
  226.     m_lOnBits(27) = CLng(268435455)  
  227.     m_lOnBits(28) = CLng(536870911)  
  228.     m_lOnBits(29) = CLng(1073741823)  
  229.     m_lOnBits(30) = CLng(2147483647)  
  230.  
  231.     m_l2Power(0) = CLng(1)  
  232.     m_l2Power(1) = CLng(2)  
  233.     m_l2Power(2) = CLng(4)  
  234.     m_l2Power(3) = CLng(8)  
  235.     m_l2Power(4) = CLng(16)  
  236.     m_l2Power(5) = CLng(32)  
  237.     m_l2Power(6) = CLng(64)  
  238.     m_l2Power(7) = CLng(128)  
  239.     m_l2Power(8) = CLng(256)  
  240.     m_l2Power(9) = CLng(512)  
  241.     m_l2Power(10) = CLng(1024)  
  242.     m_l2Power(11) = CLng(2048)  
  243.     m_l2Power(12) = CLng(4096)  
  244.     m_l2Power(13) = CLng(8192)  
  245.     m_l2Power(14) = CLng(16384)  
  246.     m_l2Power(15) = CLng(32768)  
  247.     m_l2Power(16) = CLng(65536)  
  248.     m_l2Power(17) = CLng(131072)  
  249.     m_l2Power(18) = CLng(262144)  
  250.     m_l2Power(19) = CLng(524288)  
  251.     m_l2Power(20) = CLng(1048576)  
  252.     m_l2Power(21) = CLng(2097152)  
  253.     m_l2Power(22) = CLng(4194304)  
  254.     m_l2Power(23) = CLng(8388608)  
  255.     m_l2Power(24) = CLng(16777216)  
  256.     m_l2Power(25) = CLng(33554432)  
  257.     m_l2Power(26) = CLng(67108864)  
  258.     m_l2Power(27) = CLng(134217728)  
  259.     m_l2Power(28) = CLng(268435456)  
  260.     m_l2Power(29) = CLng(536870912)  
  261.     m_l2Power(30) = CLng(1073741824)  
  262.  
  263.       
  264.     Dim x  
  265.     Dim k  
  266.     Dim AA  
  267.     Dim BB  
  268.     Dim CC  
  269.     Dim DD  
  270.     Dim a  
  271.     Dim b  
  272.     Dim c  
  273.     Dim d  
  274.  
  275.     Const S11 = 7  
  276.     Const S12 = 12  
  277.     Const S13 = 17  
  278.     Const S14 = 22  
  279.     Const S21 = 5  
  280.     Const S22 = 9  
  281.     Const S23 = 14  
  282.     Const S24 = 20  
  283.     Const S31 = 4  
  284.     Const S32 = 11  
  285.     Const S33 = 16  
  286.     Const S34 = 23  
  287.     Const S41 = 6  
  288.     Const S42 = 10  
  289.     Const S43 = 15  
  290.     Const S44 = 21  
  291.  
  292.     x = ConvertToWordArray(str2bin(sMessage))  
  293.  
  294.     a = &H67452301  
  295.     b = &HEFCDAB89  
  296.     c = &H98BADCFE  
  297.     d = &H10325476  
  298.  
  299.     For k = 0 To UBound(x) Step 16  
  300.         AA = a  
  301.         BB = b  
  302.         CC = c  
  303.         DD = d  
  304.  
  305.         md5_FF a, b, c, d, x(k + 0), S11, &HD76AA478  
  306.         md5_FF d, a, b, c, x(k + 1), S12, &HE8C7B756  
  307.         md5_FF c, d, a, b, x(k + 2), S13, &H242070DB  
  308.         md5_FF b, c, d, a, x(k + 3), S14, &HC1BDCEEE  
  309.         md5_FF a, b, c, d, x(k + 4), S11, &HF57C0FAF  
  310.         md5_FF d, a, b, c, x(k + 5), S12, &H4787C62A  
  311.         md5_FF c, d, a, b, x(k + 6), S13, &HA8304613  
  312.         md5_FF b, c, d, a, x(k + 7), S14, &HFD469501  
  313.         md5_FF a, b, c, d, x(k + 8), S11, &H698098D8  
  314.         md5_FF d, a, b, c, x(k + 9), S12, &H8B44F7AF  
  315.         md5_FF c, d, a, b, x(k + 10), S13, &HFFFF5BB1  
  316.         md5_FF b, c, d, a, x(k + 11), S14, &H895CD7BE  
  317.         md5_FF a, b, c, d, x(k + 12), S11, &H6B901122  
  318.         md5_FF d, a, b, c, x(k + 13), S12, &HFD987193  
  319.         md5_FF c, d, a, b, x(k + 14), S13, &HA679438E  
  320.         md5_FF b, c, d, a, x(k + 15), S14, &H49B40821  
  321.  
  322.         md5_GG a, b, c, d, x(k + 1), S21, &HF61E2562  
  323.         md5_GG d, a, b, c, x(k + 6), S22, &HC040B340  
  324.         md5_GG c, d, a, b, x(k + 11), S23, &H265E5A51  
  325.         md5_GG b, c, d, a, x(k + 0), S24, &HE9B6C7AA  
  326.         md5_GG a, b, c, d, x(k + 5), S21, &HD62F105D  
  327.         md5_GG d, a, b, c, x(k + 10), S22, &H2441453  
  328.         md5_GG c, d, a, b, x(k + 15), S23, &HD8A1E681  
  329.         md5_GG b, c, d, a, x(k + 4), S24, &HE7D3FBC8  
  330.         md5_GG a, b, c, d, x(k + 9), S21, &H21E1CDE6  
  331.         md5_GG d, a, b, c, x(k + 14), S22, &HC33707D6  
  332.         md5_GG c, d, a, b, x(k + 3), S23, &HF4D50D87  
  333.         md5_GG b, c, d, a, x(k + 8), S24, &H455A14ED  
  334.         md5_GG a, b, c, d, x(k + 13), S21, &HA9E3E905  
  335.         md5_GG d, a, b, c, x(k + 2), S22, &HFCEFA3F8  
  336.         md5_GG c, d, a, b, x(k + 7), S23, &H676F02D9  
  337.         md5_GG b, c, d, a, x(k + 12), S24, &H8D2A4C8A  
  338.  
  339.         md5_HH a, b, c, d, x(k + 5), S31, &HFFFA3942  
  340.         md5_HH d, a, b, c, x(k + 8), S32, &H8771F681  
  341.         md5_HH c, d, a, b, x(k + 11), S33, &H6D9D6122  
  342.         md5_HH b, c, d, a, x(k + 14), S34, &HFDE5380C  
  343.         md5_HH a, b, c, d, x(k + 1), S31, &HA4BEEA44  
  344.         md5_HH d, a, b, c, x(k + 4), S32, &H4BDECFA9  
  345.         md5_HH c, d, a, b, x(k + 7), S33, &HF6BB4B60  
  346.         md5_HH b, c, d, a, x(k + 10), S34, &HBEBFBC70  
  347.         md5_HH a, b, c, d, x(k + 13), S31, &H289B7EC6  
  348.         md5_HH d, a, b, c, x(k + 0), S32, &HEAA127FA  
  349.         md5_HH c, d, a, b, x(k + 3), S33, &HD4EF3085  
  350.         md5_HH b, c, d, a, x(k + 6), S34, &H4881D05  
  351.         md5_HH a, b, c, d, x(k + 9), S31, &HD9D4D039  
  352.         md5_HH d, a, b, c, x(k + 12), S32, &HE6DB99E5  
  353.         md5_HH c, d, a, b, x(k + 15), S33, &H1FA27CF8  
  354.         md5_HH b, c, d, a, x(k + 2), S34, &HC4AC5665  
  355.  
  356.         md5_II a, b, c, d, x(k + 0), S41, &HF4292244  
  357.         md5_II d, a, b, c, x(k + 7), S42, &H432AFF97  
  358.         md5_II c, d, a, b, x(k + 14), S43, &HAB9423A7  
  359.         md5_II b, c, d, a, x(k + 5), S44, &HFC93A039  
  360.         md5_II a, b, c, d, x(k + 12), S41, &H655B59C3  
  361.         md5_II d, a, b, c, x(k + 3), S42, &H8F0CCC92  
  362.         md5_II c, d, a, b, x(k + 10), S43, &HFFEFF47D  
  363.         md5_II b, c, d, a, x(k + 1), S44, &H85845DD1  
  364.         md5_II a, b, c, d, x(k + 8), S41, &H6FA87E4F  
  365.         md5_II d, a, b, c, x(k + 15), S42, &HFE2CE6E0  
  366.         md5_II c, d, a, b, x(k + 6), S43, &HA3014314  
  367.         md5_II b, c, d, a, x(k + 13), S44, &H4E0811A1  
  368.         md5_II a, b, c, d, x(k + 4), S41, &HF7537E82  
  369.         md5_II d, a, b, c, x(k + 11), S42, &HBD3AF235  
  370.         md5_II c, d, a, b, x(k + 2), S43, &H2AD7D2BB  
  371.         md5_II b, c, d, a, x(k + 9), S44, &HEB86D391  
  372.  
  373.         a = AddUnsigned(a, AA)  
  374.         b = AddUnsigned(b, BB)  
  375.         c = AddUnsigned(c, CC)  
  376.         d = AddUnsigned(d, DD)  
  377.     Next  
  378.  
  379.     MD5 = LCase(WordToHex(a) & WordToHex(b) & WordToHex(c) & WordToHex(d))  
  380. End Function  
  381. %>  



2.Alipay_Payto.asp 

  1. <!--#include file="Alipay_md5.asp"-->  
  2. <%  
  3.  
  4. Class creatAlipayItemURL  
  5.     '获得最终的购买url  
  6.  
  7.     Public Function creatAlipayItemURL(t1,t4,t5,service,agent,partner,sign_type,subject,body,out_trade_no,price,discount,show_url,quantity,payment_type,logistics_type,logistics_fee,logistics_payment,logistics_type_1,logistics_fee_1,logistics_payment_1,seller_email,notify_url,return_url,key)  
  8.         Dim itemURL  
  9.         dim INTERFACE_URL,imgsrc,imgtitle  
  10.         '初始化各必要变量  
  11.         INTERFACE_URL    = t1    '支付接口  
  12.         imgsrc            = t4        '支付宝按钮图片  
  13.         imgtitle        = t5        '按钮悬停说明  
  14.  
  15.     'Add by sunzhizhi 2006-5-10  
  16.  
  17. mystr = Array("service="&service,"agent="&agent,"partner="&partner,"subject="&subject,"body="&body,"out_trade_no="&out_trade_no,"price="&price,"discount="&discount,"show_url="&show_url,"quantity="&quantity,"payment_type="&payment_type,"logistics_type="&logistics_type,"logistics_fee="&logistics_fee,"logistics_payment="&logistics_payment,"logistics_type_1="&logistics_type_1,"logistics_fee_1="&logistics_fee_1,"logistics_payment_1="&logistics_payment_1,"seller_email="&seller_email,"notify_url="¬ify_url,"return_url="&return_url)  
  18.  
  19. Count=ubound(mystr)  
  20.  
  21.  
  22. For i = Count TO 0 Step -1  
  23. minmax = mystr( 0 )  
  24. minmaxSlot = 0  
  25. For j = 1 To i  
  26. mark = (mystr( j ) > minmax)  
  27. If mark Then  
  28. minmax = mystr( j )  
  29. minmaxSlot = j  
  30. End If  
  31. Next  
  32.  
  33. If minmaxSlot <> i Then  
  34.  
  35. temp = mystr( minmaxSlot )  
  36. mystr( minmaxSlot ) = mystr( i )  
  37. mystr( i ) = temp  
  38. End If  
  39. Next  
  40.  
  41.  
  42.  
  43.  
  44. For j = 0 To Count Step 1  
  45. value = SPLIT(mystr( j ), "=")  
  46.  
  47. If value(1)<>"" then  
  48. If j=Count Then  
  49. md5str= md5str&mystr( j )  
  50.      Else  
  51. md5str= md5str&mystr( j )&"&"  
  52.      End If  
  53. End If  
  54. Next  
  55.  
  56. md5str=md5str&key  
  57.      ' response.write md5str  
  58.  
  59.      sign=md5(md5str)  
  60.  
  61.  
  62.     itemURL    = itemURL&INTERFACE_URL  
  63.  
  64.  
  65.  
  66.     For j = 0 To Count Step 1  
  67.  
  68.      value = SPLIT(mystr( j ), "=")  
  69.         If value(1)<>"" then  
  70.         itemURL= itemURL&mystr( j )&"&"  
  71.         End If       
  72. Next  
  73.         itemURL    = itemURL&"sign="&sign&"&sign_type="&sign_type  
  74.  
  75.         'response.write itemURL  
  76.  
  77.     creatAlipayItemURL    = itemURL      
  78.  
  79.                   
  80.  
  81.     End Function  
  82.  
  83.  
  84.  
  85.     Public Function get_AlipayButtonURL(itemURL,imgtitle,imgsrc)  
  86.         dim responseText1  
  87.         responseText1    =    responseText1 & "<a href="" & itemURL & "" href="" & itemURL & "" target='_blank'>"        '购买网址  
  88.         responseText1    =    responseText1 & "<img alt='" & imgtitle & "' src=""                " src=""                "图片说明  
  89.         responseText1    =    responseText1 & imgsrc                                            '图片地址  
  90.         responseText1    =    responseText1 & "' align='absmiddle' border='0'/></a>"  
  91.         get_AlipayButtonURL=responseText1  
  92.     End Function  
  93.  
  94. End Class  
  95. %>  

3.send1.asp 

  1. <!--#include file="alipay_payto.asp"-->  
  2. <%  
  3.  
  4. cid = request("cid")        '''商户编号  
  5. response.write cid&"<br>"  
  6. meykey = request("mykey")        '''商户密钥  
  7. response.write meykey&"<br>"  
  8.  
  9. out_trade_no = request("orderid")        '''订单编号  
  10. response.write out_trade_no&"<br>"  
  11.  
  12. totalmoeny = request("totalmoney")        '''订单金额  
  13. response.write totalmoeny&"<br>"  
  14.  
  15. partnerid=request("other1")  
  16. response.write partnerid&"<br>"  
  17.  
  18. 'response.end  
  19. dim service,agent,partner,sign_type,subject,body,out_trade_no,price,discount,show_url,quantity,payment_type,logistics_type,logistics_fee,logistics_payment,logistics_type_1,logistics_fee_1,logistics_payment_1,seller_email,notify_url,return_url  
  20. dim t1,t4,t5,key  
  21. dim AlipayObj,itemUrl  
  22.     t1                =    "https://www.alipay.com/cooperate/gateway.do?"    '支付接口  
  23.     t4                =    "images/alipay_bwrx.gif"        '支付宝按钮图片  
  24.     t5                =    "推荐使用支付宝付款"                        '按钮悬停说明  
  25.  
  26.     service = "trade_create_by_buyer" '"trade_create_by_buyer"  
  27.     agent = partnerid '合作厂商id  
  28.     partner            =    partnerid        'partner合作伙伴ID(必须填)  
  29.     sign_type = "MD5"  
  30.     subject            =    ""        '商品名称  
  31.     body            =    ""        'body            商品描述  
  32.     out_trade_no = Trim(Replace(out_trade_no,":","")) '客户网站订单号，（现取系统时间，可改成网站自己的变量）  
  33.     price         =    totalmoeny                 'price商品单价            0.01～50000.00  
  34. discount = "0" '商品折扣  
  35. show_url = "" '商品展示地址（可以直接写网站首页网址）  
  36. quantity = "" '商品数量  
  37. payment_type = "1" '支付类型，（1代表商品购买）  
  38. logistics_type = "" '物流种类（快递）  
  39. logistics_fee = "" '物流费用  
  40. logistics_payment = "" '物流费用承担(卖家付)  
  41.     logistics_type_1 = ""  
  42. logistics_fee_1 = ""  
  43. logistics_payment_1 = "" '物流费用承担(买家付)  
  44. seller_email = cid '(必须填)  
  45. key = mykey '(必须填)  
  46. notify_url= "" '服务器通知url（不使用，请不要注释或者删除此参数，不用传递给支付宝系统，Alipay_Notify.asp文件所在路经）  
  47. return_url= "" '服务器通知url（不使用，请不要注释或者删除此参数，不用传递给支付宝系统，Alipay_Notify.asp文件所在路经）  
  48.  
  49.     Set AlipayObj    = New creatAlipayItemURL  
  50.     itemUrl=AlipayObj.creatAlipayItemURL(t1,t4,t5,service,agent,partner,sign_type,subject,body,out_trade_no,price,discount,show_url,quantity,payment_type,logistics_type,logistics_fee,logistics_payment,logistics_type_1,logistics_fee_1,logistics_payment_1,seller_email,notify_url,return_url,key)  
  51.  
  52. response.redirect itemUrl  
  53. response.end  
  54. %>  



4.send.asp 

复制代码代码如下:

<!--#include file="alipay_payto.asp"--> 
<% 

cid = request("cid")        '''商户编号 
response.write cid&"<br>" 
meykey = request("mykey")        '''商户密钥 
response.write meykey&"<br>" 

orderid = request("orderid")        '''订单编号 
response.write orderid &"<br>" 

totalmoeny = request("totalmoney")        '''订单金额 
response.write totalmoeny&"<br>" 

partnerid=request("other1") 
response.write partnerid&"<br>" 

other2=request("other2") 
other3=request("other3") 

'response.end 
dim service,agent,partner,sign_type,subject,body,out_trade_no,price,discount,show_url,quantity,payment_type,logistics_type,logistics_fee,logistics_payment,logistics_type_1,logistics_fee_1,logistics_payment_1,seller_email,notify_url,return_url 
dim t1,t4,t5,key 
dim AlipayObj,itemUrl 
    t1                =    "https://www.alipay.com/cooperate/gateway.do?"    '支付接口 
    t4                =    "images/alipay_bwrx.gif"        '支付宝按钮图片 
    t5                =    "推荐使用支付宝付款"                        '按钮悬停说明 

    service = "trade_create_by_buyer" 
    agent = partnerid '合作厂商id 
    partner            =    partnerid        'partner合作伙伴ID(必须填) 
    sign_type = "MD5" 
    subject            =    "商品"        '商品名称 
    body            =    ""        'body            商品描述 
    out_trade_no = orderid '客户网站订单号，（现取系统时间，可改成网站自己的变量） 
    price         =    totalmoeny                 'price商品单价            0.01～50000.00 
discount = "0" '商品折扣 
show_url = "" '商品展示地址（可以直接写网站首页网址） 
quantity = "1" '商品数量 
payment_type = "1" '支付类型，（1代表商品购买） 
logistics_type = "EXPRESS" '物流种类（快递） 
logistics_fee = other3 '物流费用 
logistics_payment = other2 '物流费用承担(卖家付) 
    logistics_type_1 = "" 
logistics_fee_1 = "" 
logistics_payment_1 = "" '物流费用承担(买家付) 
seller_email = cid '(必须填) 
key = meykey '(必须填) 
notify_url= "" '服务器通知url（不使用，请不要注释或者删除此参数，不用传递给支付宝系统，Alipay_Notify.asp文件所在路经） 
return_url= "" '服务器通知url（不使用，请不要注释或者删除此参数，不用传递给支付宝系统，Alipay_Notify.asp文件所在路经） 

    Set AlipayObj    = New creatAlipayItemURL 
    itemUrl=AlipayObj.creatAlipayItemURL(t1,t4,t5,service,agent,partner,sign_type,subject,body,out_trade_no,price,discount,show_url,quantity,payment_type,logistics_type,logistics_fee,logistics_payment,logistics_type_1,logistics_fee_1,logistics_payment_1,seller_email,notify_url,return_url,key) 

response.redirect itemUrl 
response.end 
%> 


chinabank 

1.MD5.asp 

复制代码代码如下:

<% 
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 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 = Len(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(Asc(Mid(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) 
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 

x = ConvertToWordArray(sMessage) 

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))    '32byte 
'MD5 = LCase(WordToHex(b) & WordToHex(c)) 'I crop this to fit 16byte database password :D 
End Function 
%> 


2.Send.asp 
复制代码代码如下:

<!-- 
* ==================================================================== 
* 
* Send.asp 由网银在线技术支持提供 
* 
* 本页面接收来自上页所有订单信息,并提交支付订单到网线在线支付平台.... 
* 
* 
* ==================================================================== 
--> 

<!--#include file="MD5.asp"--> 

<% 
'****************************************     
    v_mid = request("cid")                     ' 商户号,这里为测试商户号20000400，替换为自己的商户号即可 
    v_url = "" ' 商户自定义返回接收支付结果的页面 Receive.asp 为接收页面 

                                                     ' MD5密钥要跟订单提交页相同，如Send.asp里的 key = "test" ,修改""号内 test 为您的密钥 
    key = request("mykey")                                 ' 如果您还没有设置MD5密钥请登陆我们为您提供商户后台，地址：https://merchant3.chinabank.com.cn/ 
                                                     ' 登陆后在上面的导航栏里可能找到“资料管理”，在资料管理的二级导航栏里有“MD5密钥设置” 
                                                     ' 建议您设置一个16位以上的密钥或更高，密钥最多64位，但设置16位已经足够了 
'****************************************%> 


<% 
if request("orderid")<>"" then                                '判断是否有传递订单号 

         v_oid = request("orderid") 

     else 

         curdate = now()                                        ' 根据系统时间产生订单，格式：YYYYMMDD-v_mid-HMMSS 
         ymd = year(curdate)&month(curdate)&day(curdate)        ' 年月日 
         hms = hour(curdate)&minute(curdate)&second(curdate)    ' 分秒时 

         v_oid = ymd&"-"&v_mid&"-"&hms                            ' 推荐订单号构成格式为 年月日-商户号-小时分钟秒 

    end if 

    v_amount = request("totalmoney")        ' 订单金额 

    v_moneytype = "CNY"                    ' 币种 

    text = v_amount&v_moneytype&v_oid&v_mid&v_url&key    ' 拼凑加密串 

    v_md5info=Ucase(trim(md5(text)))                    ' 网银支付平台对MD5值只认大写字符串，所以小写的MD5值得转换为大写 

'**********以下几项为可选信息,如果发送网银在线会保存此信息,使用和不使用都不影响支付！************** 

     v_rcvname = request("v_rcvname")            ' 收货人 
     v_rcvaddr = request("v_rcvaddr")            ' 收货地址 
        v_rcvtel = request("v_rcvtel")            ' 收货人电话 
     v_rcvpost = request("v_rcvpost")            ' 收货人邮编 
     v_rcvemail = request("v_rcvemail")        ' 收货人邮件 
     v_rcvmobile = request("v_rcvmobile")        ' 收货人手机号 

     v_ordername = request("v_ordername")        ' 订货人姓名 
     v_orderaddr = request("v_orderaddr")        ' 订货人地址 
     v_ordertel = request("v_ordertel")        ' 订货人电话 
     v_orderpost = request("v_orderpost")        ' 订货人邮编 
    v_orderemail = request("v_orderemail")        ' 订货人邮件 
    v_ordermobile = request("v_ordermobile")    ' 订货人手机号 

         remark1 = request("remark1")            ' 备注字段1 
         remark2 = request("remark2")            ' 备注字段2 

%> 

<!--以下信息为标准的 HTML 格式 + ASP 语言 拼凑而成的 网银在线 支付接口标准演示页面 --> 

<html> 

<body onLoad="javascript:document.E_FORM.submit()"> 
<form action="https://pay3.chinabank.com.cn/PayGate" method="POST" name="E_FORM"> 

<!--以下几项为网上支付重要信息，信息必须正确无误，信息会影响支付进行！--> 

<input type="hidden" name="v_md5info" value="<%=v_md5info%>" size="100"> 
<input type="hidden" name="v_mid" value="<%=v_mid%>"> 
<input type="hidden" name="v_oid" value="<%=v_oid%>"> 
<input type="hidden" name="v_amount" value="<%=v_amount%>"> 
<input type="hidden" name="v_moneytype" value="<%=v_moneytype%>"> 
<input type="hidden" name="v_url" value="<%=v_url%>"> 


<!--以下几项项为网上支付完成后，随支付反馈信息一同传给信息接收页，在传输过程中内容不会改变,如：Receive.asp --> 

<input type="hidden" name="remark1" value="<%=remark1%>"> 
<input type="hidden" name="remark2" value="<%=remark2%>"> 

<!--以下几项与网上支付货款无关，只是用来记录客户信息，可以不用，使用和不使用都不影响支付 --> 

    <input type="hidden" name="v_rcvname" value="<%=v_rcvname%>"> 
    <input type="hidden" name="v_rcvaddr" value="<%=v_rcvaddr%>"> 
    <input type="hidden" name="v_rcvtel" value="<%=v_rcvtel%>"> 
    <input type="hidden" name="v_rcvpost" value="<%=v_rcvpost%>"> 
    <input type="hidden" name="v_rcvemail" value="<%=v_rcvemail%>"> 
    <input type="hidden" name="v_rcvmobile" value="<%=v_rcvmobile%>"> 

    <input type="hidden" name="v_ordername" value="<%=v_ordername%>"> 
    <input type="hidden" name="v_orderaddr" value="<%=v_orderaddr%>"> 
    <input type="hidden" name="v_ordertel" value="<%=v_ordertel%>"> 
    <input type="hidden" name="v_orderpost" value="<%=v_orderpost%>"> 
    <input type="hidden" name="v_orderemail" value="<%=v_orderemail%>"> 
    <input type="hidden" name="v_ordermobile" value="<%=v_ordermobile%>"> 

</form> 

</body> 
</html> 


tenpay 

1.asp_md5.asp 

复制代码代码如下:

<% 

    Private Const ASP_BITS_TO_A_BYTE = 8 
    Private Const ASP_BYTES_TO_A_WORD = 4 
    Private Const ASP_BITS_TO_A_WORD = 32 

    Private ASP_m_lOnBits(30) 
    Private ASP_m_l2Power(30) 

    Private Function ASP_LShift(lValue, iShiftBits) 
        If iShiftBits = 0 Then 
            ASP_LShift = lValue 
            Exit Function 
        ElseIf iShiftBits = 31 Then 
            If lValue And 1 Then 
                ASP_LShift = &H80000000 
            Else 
                ASP_LShift = 0 
            End If 
            Exit Function 
        ElseIf iShiftBits < 0 Or iShiftBits > 31 Then 
            Err.Raise 6 
        End If 

        If (lValue And ASP_m_l2Power(31 - iShiftBits)) Then 
            ASP_LShift = ((lValue And ASP_m_lOnBits(31 - (iShiftBits + 1))) * ASP_m_l2Power(iShiftBits)) Or &H80000000 
        Else 
            ASP_LShift = ((lValue And ASP_m_lOnBits(31 - iShiftBits)) * ASP_m_l2Power(iShiftBits)) 
        End If 
    End Function 

    Private Function ASP_Str2binold(varstr) 
        ASP_Str2binold="" 
         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) 
                ASP_Str2binold = ASP_Str2binold & chrB("&H" & varlow) & chrB("&H" & varhigh) 
             Else 
                ASP_Str2binold = ASP_Str2binold & chrB(AscB(varchar)) 
             End If 
         Next 
    End Function 
    Private Function ASP_Str2bin(varstr) 
        ASP_Str2bin="" 
         For i=1 To Len(varstr) 
             varchar=mid(varstr,i,1) 
             code = Server.UrlEncode(varchar) 
             if len(code) = 1 then 
             ASP_Str2bin = ASP_Str2bin & chrB(AscB(code)) 
             else 
                codearr = split(code,"%") 
                for j=1 to ubound(codearr) 
                 ASP_Str2bin = ASP_Str2bin & chrB("&H" & codearr(j)) 
                next 

             End If 
         Next 
    End Function 
    Private Function ASP_RShift(lValue, iShiftBits) 
        If iShiftBits = 0 Then 
            ASP_RShift = lValue 
            Exit Function 
        ElseIf iShiftBits = 31 Then 
            If lValue And &H80000000 Then 
                ASP_RShift = 1 
            Else 
                ASP_RShift = 0 
            End If 
            Exit Function 
        ElseIf iShiftBits < 0 Or iShiftBits > 31 Then 
            Err.Raise 6 
        End If 

        ASP_RShift = (lValue And &H7FFFFFFE) ASP_m_l2Power(iShiftBits) 

        If (lValue And &H80000000) Then 
            ASP_RShift = (ASP_RShift Or (&H40000000 ASP_m_l2Power(iShiftBits - 1))) 
        End If 
    End Function 

    Private Function ASP_RotateLeft(lValue, iShiftBits) 
        ASP_RotateLeft = ASP_LShift(lValue, iShiftBits) Or ASP_RShift(lValue, (32 - iShiftBits)) 
    End Function 

    Private Function ASP_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 

        ASP_AddUnsigned = lResult 
    End Function 

    Private Function ASP_md5_F(x, y, z) 
        ASP_md5_F = (x And y) Or ((Not x) And z) 
    End Function 

    Private Function ASP_md5_G(x, y, z) 
        ASP_md5_G = (x And z) Or (y And (Not z)) 
    End Function 

    Private Function ASP_md5_H(x, y, z) 
        ASP_md5_H = (x Xor y Xor z) 
    End Function 

    Private Function ASP_md5_I(x, y, z) 
        ASP_md5_I = (y Xor (x Or (Not z))) 
    End Function 

    Private Sub ASP_md5_FF(a, b, c, d, x, s, ac) 
        a = ASP_AddUnsigned(a, ASP_AddUnsigned(ASP_AddUnsigned(ASP_md5_F(b, c, d), x), ac)) 
        a = ASP_RotateLeft(a, s) 
        a = ASP_AddUnsigned(a, b) 
    End Sub 

    Private Sub ASP_md5_GG(a, b, c, d, x, s, ac) 
        a = ASP_AddUnsigned(a, ASP_AddUnsigned(ASP_AddUnsigned(ASP_md5_G(b, c, d), x), ac)) 
        a = ASP_RotateLeft(a, s) 
        a = ASP_AddUnsigned(a, b) 
    End Sub 

    Private Sub ASP_md5_HH(a, b, c, d, x, s, ac) 
        a = ASP_AddUnsigned(a, ASP_AddUnsigned(ASP_AddUnsigned(ASP_md5_H(b, c, d), x), ac)) 
        a = ASP_RotateLeft(a, s) 
        a = ASP_AddUnsigned(a, b) 
    End Sub 

    Private Sub ASP_md5_II(a, b, c, d, x, s, ac) 
        a = ASP_AddUnsigned(a, ASP_AddUnsigned(ASP_AddUnsigned(ASP_md5_I(b, c, d), x), ac)) 
        a = ASP_RotateLeft(a, s) 
        a = ASP_AddUnsigned(a, b) 
    End Sub 

    Private Function ASP_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) ASP_BITS_TO_A_BYTE)) (MODULUS_BITS ASP_BITS_TO_A_BYTE)) + 1) * (MODULUS_BITS ASP_BITS_TO_A_WORD) 
        ReDim lWordArray(lNumberOfWords - 1) 

        lBytePosition = 0 
        lByteCount = 0 
        Do Until lByteCount >= lMessageLength 
            lWordCount = lByteCount ASP_BYTES_TO_A_WORD 
            lBytePosition = (lByteCount Mod ASP_BYTES_TO_A_WORD) * ASP_BITS_TO_A_BYTE 
            lWordArray(lWordCount) = lWordArray(lWordCount) Or ASP_LShift(AscB(MidB(sMessage, lByteCount + 1, 1)), lBytePosition) 
            lByteCount = lByteCount + 1 
        Loop 

        lWordCount = lByteCount ASP_BYTES_TO_A_WORD 
        lBytePosition = (lByteCount Mod ASP_BYTES_TO_A_WORD) * ASP_BITS_TO_A_BYTE 

        lWordArray(lWordCount) = lWordArray(lWordCount) Or ASP_LShift(&H80, lBytePosition) 

        lWordArray(lNumberOfWords - 2) = ASP_LShift(lMessageLength, 3) 
        lWordArray(lNumberOfWords - 1) = ASP_RShift(lMessageLength, 29) 

        ASP_ConvertToWordArray = lWordArray 
    End Function 

    Private Function ASP_WordToHex(lValue) 
        Dim lByte 
        Dim lCount 

        For lCount = 0 To 3 
            lByte = ASP_RShift(lValue, lCount * ASP_BITS_TO_A_BYTE) And ASP_m_lOnBits(ASP_BITS_TO_A_BYTE - 1) 
            ASP_WordToHex = ASP_WordToHex & Right("0" & Hex(lByte), 2) 
        Next 
    End Function 

    Public Function ASP_MD5(sMessage) 
        ASP_m_lOnBits(0) = CLng(1) 
        ASP_m_lOnBits(1) = CLng(3) 
        ASP_m_lOnBits(2) = CLng(7) 
        ASP_m_lOnBits(3) = CLng(15) 
        ASP_m_lOnBits(4) = CLng(31) 
        ASP_m_lOnBits(5) = CLng(63) 
        ASP_m_lOnBits(6) = CLng(127) 
        ASP_m_lOnBits(7) = CLng(255) 
        ASP_m_lOnBits(8) = CLng(511) 
        ASP_m_lOnBits(9) = CLng(1023) 
        ASP_m_lOnBits(10) = CLng(2047) 
        ASP_m_lOnBits(11) = CLng(4095) 
        ASP_m_lOnBits(12) = CLng(8191) 
        ASP_m_lOnBits(13) = CLng(16383) 
        ASP_m_lOnBits(14) = CLng(32767) 
        ASP_m_lOnBits(15) = CLng(65535) 
        ASP_m_lOnBits(16) = CLng(131071) 
        ASP_m_lOnBits(17) = CLng(262143) 
        ASP_m_lOnBits(18) = CLng(524287) 
        ASP_m_lOnBits(19) = CLng(1048575) 
        ASP_m_lOnBits(20) = CLng(2097151) 
        ASP_m_lOnBits(21) = CLng(4194303) 
        ASP_m_lOnBits(22) = CLng(8388607) 
        ASP_m_lOnBits(23) = CLng(16777215) 
        ASP_m_lOnBits(24) = CLng(33554431) 
        ASP_m_lOnBits(25) = CLng(67108863) 
        ASP_m_lOnBits(26) = CLng(134217727) 
        ASP_m_lOnBits(27) = CLng(268435455) 
        ASP_m_lOnBits(28) = CLng(536870911) 
        ASP_m_lOnBits(29) = CLng(1073741823) 
        ASP_m_lOnBits(30) = CLng(2147483647) 

        ASP_m_l2Power(0) = CLng(1) 
        ASP_m_l2Power(1) = CLng(2) 
        ASP_m_l2Power(2) = CLng(4) 
        ASP_m_l2Power(3) = CLng(8) 
        ASP_m_l2Power(4) = CLng(16) 
        ASP_m_l2Power(5) = CLng(32) 
        ASP_m_l2Power(6) = CLng(64) 
        ASP_m_l2Power(7) = CLng(128) 
        ASP_m_l2Power(8) = CLng(256) 
        ASP_m_l2Power(9) = CLng(512) 
        ASP_m_l2Power(10) = CLng(1024) 
        ASP_m_l2Power(11) = CLng(2048) 
        ASP_m_l2Power(12) = CLng(4096) 
        ASP_m_l2Power(13) = CLng(8192) 
        ASP_m_l2Power(14) = CLng(16384) 
        ASP_m_l2Power(15) = CLng(32768) 
        ASP_m_l2Power(16) = CLng(65536) 
        ASP_m_l2Power(17) = CLng(131072) 
        ASP_m_l2Power(18) = CLng(262144) 
        ASP_m_l2Power(19) = CLng(524288) 
        ASP_m_l2Power(20) = CLng(1048576) 
        ASP_m_l2Power(21) = CLng(2097152) 
        ASP_m_l2Power(22) = CLng(4194304) 
        ASP_m_l2Power(23) = CLng(8388608) 
        ASP_m_l2Power(24) = CLng(16777216) 
        ASP_m_l2Power(25) = CLng(33554432) 
        ASP_m_l2Power(26) = CLng(67108864) 
        ASP_m_l2Power(27) = CLng(134217728) 
        ASP_m_l2Power(28) = CLng(268435456) 
        ASP_m_l2Power(29) = CLng(536870912) 
        ASP_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 

        x = ASP_ConvertToWordArray(ASP_Str2bin(sMessage)) 

        a = &H67452301 
        b = &HEFCDAB89 
        c = &H98BADCFE 
        d = &H10325476 

        For k = 0 To UBound(x) Step 16 
            AA = a 
            BB = b 
            CC = c 
            DD = d 

            ASP_md5_FF a, b, c, d, x(k + 0), S11, &HD76AA478 
            ASP_md5_FF d, a, b, c, x(k + 1), S12, &HE8C7B756 
            ASP_md5_FF c, d, a, b, x(k + 2), S13, &H242070DB 
            ASP_md5_FF b, c, d, a, x(k + 3), S14, &HC1BDCEEE 
            ASP_md5_FF a, b, c, d, x(k + 4), S11, &HF57C0FAF 
            ASP_md5_FF d, a, b, c, x(k + 5), S12, &H4787C62A 
            ASP_md5_FF c, d, a, b, x(k + 6), S13, &HA8304613 
            ASP_md5_FF b, c, d, a, x(k + 7), S14, &HFD469501 
            ASP_md5_FF a, b, c, d, x(k + 8), S11, &H698098D8 
            ASP_md5_FF d, a, b, c, x(k + 9), S12, &H8B44F7AF 
            ASP_md5_FF c, d, a, b, x(k + 10), S13, &HFFFF5BB1 
            ASP_md5_FF b, c, d, a, x(k + 11), S14, &H895CD7BE 
            ASP_md5_FF a, b, c, d, x(k + 12), S11, &H6B901122 
            ASP_md5_FF d, a, b, c, x(k + 13), S12, &HFD987193 
            ASP_md5_FF c, d, a, b, x(k + 14), S13, &HA679438E 
            ASP_md5_FF b, c, d, a, x(k + 15), S14, &H49B40821 

            ASP_md5_GG a, b, c, d, x(k + 1), S21, &HF61E2562 
            ASP_md5_GG d, a, b, c, x(k + 6), S22, &HC040B340 
            ASP_md5_GG c, d, a, b, x(k + 11), S23, &H265E5A51 
            ASP_md5_GG b, c, d, a, x(k + 0), S24, &HE9B6C7AA 
            ASP_md5_GG a, b, c, d, x(k + 5), S21, &HD62F105D 
            ASP_md5_GG d, a, b, c, x(k + 10), S22, &H2441453 
            ASP_md5_GG c, d, a, b, x(k + 15), S23, &HD8A1E681 
            ASP_md5_GG b, c, d, a, x(k + 4), S24, &HE7D3FBC8 
            ASP_md5_GG a, b, c, d, x(k + 9), S21, &H21E1CDE6 
            ASP_md5_GG d, a, b, c, x(k + 14), S22, &HC33707D6 
            ASP_md5_GG c, d, a, b, x(k + 3), S23, &HF4D50D87 
            ASP_md5_GG b, c, d, a, x(k + 8), S24, &H455A14ED 
            ASP_md5_GG a, b, c, d, x(k + 13), S21, &HA9E3E905 
            ASP_md5_GG d, a, b, c, x(k + 2), S22, &HFCEFA3F8 
            ASP_md5_GG c, d, a, b, x(k + 7), S23, &H676F02D9 
            ASP_md5_GG b, c, d, a, x(k + 12), S24, &H8D2A4C8A 

            ASP_md5_HH a, b, c, d, x(k + 5), S31, &HFFFA3942 
            ASP_md5_HH d, a, b, c, x(k + 8), S32, &H8771F681 
            ASP_md5_HH c, d, a, b, x(k + 11), S33, &H6D9D6122 
            ASP_md5_HH b, c, d, a, x(k + 14), S34, &HFDE5380C 
            ASP_md5_HH a, b, c, d, x(k + 1), S31, &HA4BEEA44 
            ASP_md5_HH d, a, b, c, x(k + 4), S32, &H4BDECFA9 
            ASP_md5_HH c, d, a, b, x(k + 7), S33, &HF6BB4B60 
            ASP_md5_HH b, c, d, a, x(k + 10), S34, &HBEBFBC70 
            ASP_md5_HH a, b, c, d, x(k + 13), S31, &H289B7EC6 
            ASP_md5_HH d, a, b, c, x(k + 0), S32, &HEAA127FA 
            ASP_md5_HH c, d, a, b, x(k + 3), S33, &HD4EF3085 
            ASP_md5_HH b, c, d, a, x(k + 6), S34, &H4881D05 
            ASP_md5_HH a, b, c, d, x(k + 9), S31, &HD9D4D039 
            ASP_md5_HH d, a, b, c, x(k + 12), S32, &HE6DB99E5 
            ASP_md5_HH c, d, a, b, x(k + 15), S33, &H1FA27CF8 
            ASP_md5_HH b, c, d, a, x(k + 2), S34, &HC4AC5665 

            ASP_md5_II a, b, c, d, x(k + 0), S41, &HF4292244 
            ASP_md5_II d, a, b, c, x(k + 7), S42, &H432AFF97 
            ASP_md5_II c, d, a, b, x(k + 14), S43, &HAB9423A7 
            ASP_md5_II b, c, d, a, x(k + 5), S44, &HFC93A039 
            ASP_md5_II a, b, c, d, x(k + 12), S41, &H655B59C3 
            ASP_md5_II d, a, b, c, x(k + 3), S42, &H8F0CCC92 
            ASP_md5_II c, d, a, b, x(k + 10), S43, &HFFEFF47D 
            ASP_md5_II b, c, d, a, x(k + 1), S44, &H85845DD1 
            ASP_md5_II a, b, c, d, x(k + 8), S41, &H6FA87E4F 
            ASP_md5_II d, a, b, c, x(k + 15), S42, &HFE2CE6E0 
            ASP_md5_II c, d, a, b, x(k + 6), S43, &HA3014314 
            ASP_md5_II b, c, d, a, x(k + 13), S44, &H4E0811A1 
            ASP_md5_II a, b, c, d, x(k + 4), S41, &HF7537E82 
            ASP_md5_II d, a, b, c, x(k + 11), S42, &HBD3AF235 
            ASP_md5_II c, d, a, b, x(k + 2), S43, &H2AD7D2BB 
            ASP_md5_II b, c, d, a, x(k + 9), S44, &HEB86D391 

            a = ASP_AddUnsigned(a, AA) 
            b = ASP_AddUnsigned(b, BB) 
            c = ASP_AddUnsigned(c, CC) 
            d = ASP_AddUnsigned(d, DD) 
        Next 

        ASP_MD5 = LCase(ASP_WordToHex(a) & ASP_WordToHex(b) & ASP_WordToHex(c) & ASP_WordToHex(d)) 
    End Function 


'使用方法是 md5 ("字符串") 下面是使用示范 
'Response.Write "ASP_MD5('a')的加密结果为[" & ASP_MD5 ("a") & "]<br>" 
'Response.Write "ASP_MD5('b')的加密结果为[" & ASP_MD5 ("b") & "]" 

%> 

2.send.asp 
复制代码代码如下:

<!-- #include file="asp_md5.asp" --> 
<% 
    Dim merchantId 
    Dim keyValue 

merchantId = request("cid")        '''商户编号 
keyValue = request("mykey")        '''商户密钥 
orderid = request("orderid")        '''订单编号 
amount = request("totalmoney")        '''订单金额 
%> 
<html> 
<title>财付通支付</title> 
<meta http-equiv="Cache-Control" content="no-cache"/> 
<body onLoad="javascript:document.frm.submit()"> 
    <% Response.Charset="GB2312" %> 
<% 
    ' 获取服务器日期，格式YYYYMMDD 
    Function CFTGetServerDate 
        Dim strTmp, iYear,iMonth,iDate 
        iYear = Year(Date) 
        iMonth = Month(Date) 
        iDate = Day(Date) 

        strTmp = CStr(iYear) 
        If iMonth < 10 Then 
            strTmp = strTmp & "0" & Cstr(iMonth) 
        Else 
            strTmp = strTmp & Cstr(iMonth) 
        End If 
        If iDate < 10 Then 
            strTmp = strTmp & "0" & Cstr(iDate) 
        Else 
            strTmp = strTmp & Cstr(iDate) 
        End If 
        CFTGetServerDate = strTmp 
    End Function 

    Dim md5_sign 

    spid        = merchantId         ' 这里替换为您的实际商户号 
    sp_key    = keyValue    ' sp_key是32位商户密钥, 请替换为您的实际密钥 

    ' 下面是请求参数 
    cmdno        = "1"                ' 财付通支付为"1" (当前只支持 cmdno=1)     
    bill_date    = CFTGetServerDate    ' 交易日期 (yyyymmdd)     
    bank_type    = "0"                ' 银行类型:    0        财付通 
                                    '            1001    招商银行 
                                    '            1002    中国工商银行 
                                    '            1003    中国建设银行 
                                    '            1004    上海浦东发展银行 
                                    '            1005    中国农业银行 
                                    '            1006    中国民生银行 
                                    '            1008    深圳发展银行 
                                    '            1009    兴业银行 

    desc        = ""        ' 商品名称 
    purchaser_id = ""                ' 用户财付通帐号，如果没有可以置空 
    bargainor_id = spid                ' 商户号 
    sp_billno     = orderid        ' 商户生成的订单号(最多32位)     

    ' 重要: 
    ' 交易单号(28位): 商户号(10位) + 日期(8位) + 流水号(10位), 必须按此格式生成, 且不能重复 
    ' 如果sp_billno超过10位, 则截取其中的流水号部分加到transaction_id后部(不足10位左补0) 
    ' 如果sp_billno不足10位, 则左补0, 加到transaction_id后部 
    transaction_id = spid & bill_date & "0000" & right(sp_billno,6) 

    total_fee     = amount*100                ' 总金额, 分为单位 
    fee_type     = "1"                ' 货币类型: 1 – RMB(人民币) 2 - USD(美元) 3 - HKD(港币) 
    return_url     = "" ' 财付通回调页面地址, (最长255个字符) 
    attach         = ""    ' 商户私有数据, 请求回调页面时原样返回 

    ' 生成MD5签名 
    sign_text = "cmdno=" & cmdno & "&date=" & bill_date & "&bargainor_id=" & bargainor_id &_ 
"&transaction_id=" & transaction_id & "&sp_billno=" & sp_billno &_ 
"&total_fee=" & total_fee & "&fee_type=" & fee_type & "&return_url=" & return_url &_ 
"&attach=" & attach & "&key=" & sp_key 

    md5_sign = UCase(ASP_MD5(sign_text)) ' 转换为大写 
%> 

<form name="frm" action="https://www.tenpay.com/cgi-bin/v1.0/pay_gate.cgi"> 
<input type=hidden name="cmdno"                value="<%=cmdno%>"> 
<input type=hidden name="date"             value="<%=bill_date%>"> 
<input type=hidden name="bank_type"            value="<%=bank_type%>"> 
<input type=hidden name="desc"                value="<%=desc%>"> 
<input type=hidden name="purchaser_id"        value="<%=purchaser_id%>"> 
<input type=hidden name="bargainor_id"        value="<%=bargainor_id%>"> 
<input type=hidden name="transaction_id"    value="<%=transaction_id%>"> 
<input type=hidden name="sp_billno"            value="<%=sp_billno%>"> 
<input type=hidden name="total_fee"            value="<%=total_fee%>"> 
<input type=hidden name="fee_type"            value="<%=fee_type%>"> 
<input type=hidden name="return_url"        value="<%=return_url%>"> 
<input type=hidden name="attach"            value="<%=attach%>"> 
<input type=hidden name="sign"                value="<%=md5_sign%>"> 

</form> 
</body> 

</html> 

yeepay 

1.hmac-md5.asp 

复制代码代码如下:

<% 
' MD5 code: 
' "Derived from the RSA Data Security, Inc. MD5 Message-Digest Algorithm, 
' as set out in the memo RFC1321." 
' 
' Heavily modified from http://www.frez.co.uk/ 
' 
' HMAC code: 
' Modified from Authorizenet sample scripts 
%> 
<% 
' 
' Constants used in this script 
' 
Const BITS_TO_A_BYTE = 8 
Const BYTES_TO_A_WORD = 4 
Const BITS_TO_A_WORD = 32 

Dim m_lOnBits(30) 
Dim m_l2Power(30) 

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) 

' 
' The main HMAC function 
' 
Function HMAC(text,key) 
Dim hkey 
Dim ipad(63) 
Dim opad(63) 
Dim odata(79) 
Dim idata() 
ReDim idata(64 + Len(text) - 1) 

If Len(key)>64 Then 
hkey = calcMD5(key) 
Else 
hkey = key 
End If 

Dim x 

For x=0 To 63 
idata(x) = &h36 
odata(x) = &h5C 
ipad(x) = &h36 
opad(x) = &h5C 

Next 

For x=0 To Len(hkey)-1 
ipad(x) = ipad(x) Xor Asc(CStr(Mid(hkey,x+1,1))) 
opad(x) = opad(x) Xor Asc(CStr(Mid(hkey,x+1,1))) 
idata(x) = ipad(x) And &hFF 
odata(x) = opad(x) And &hFF 
Next 

For x=0 To Len(text)-1 
idata(64+x) = Asc(CStr(Mid(text,x+1,1))) And &hFF 
Next 

Dim innerhashout 
innerhashout = binl2byt(b_calcMD5(idata)) 

For x=0 To 15 
odata(64+x) = innerhashout(x) 
Next 

HMAC = binl2hex(b_calcMD5(odata)) 

End Function 
' 
' The main MD5 function 
' 
Function MD5(sMessage) 
Dim x, r 

x = ConvertToWordArray(sMessage) 
r = coreMD5(x) 

MD5 = LCase(r(0) + r(1) + r(2) + r(3)) 
End Function 

' 
' main auxilliary functions 
' 
Function calcMD5(str) 
calcMD5 = binl2hex(coreMD5(str2binl(str))) 
End Function 

Function b_calcMD5(barray) 
b_calcMD5 = coreMD5(bytarray2binl(barray)) 
End Function 

Function coreMD5(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 

a = &H67452301 
b = &HEFCDAB89 
c = &H98BADCFE 
d = &H10325476 

For k = 0 To UBound(x)-1 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 

coreMD5 = Array(a,b,c,d) 
End Function 

' 
' screwball MD5 functions 
' 
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 

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 

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 

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 

Function MD5_F(x, y, z) 
MD5_F = (x And y) Or ((Not x) And z) 
End Function 

Function MD5_G(x, y, z) 
MD5_G = (x And z) Or (y And (Not z)) 
End Function 

Function MD5_H(x, y, z) 
MD5_H = (x Xor y Xor z) 
End Function 

Function MD5_I(x, y, z) 
MD5_I = (y Xor (x Or (Not z))) 
End Function 

' 
' utility functions 
' 
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 

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 

Function RotateLeft(lValue, iShiftBits) 
RotateLeft = LShift(lValue, iShiftBits) Or RShift(lValue, (32 - iShiftBits)) 
End Function 

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 

Function ConvertToWordArray(sMessage) 
Dim lMessageLength 
Dim lNumberOfWords 
Dim lWordArray() 
Dim lBytePosition 
Dim lByteCount 
Dim lWordCount 

Const MODULUS_BITS = 512 
Const CONGRUENT_BITS = 448 

lMessageLength = Len(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(Asc(Mid(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 

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 

Function str2binl(str) 
Dim nblk 
nblk = ( RShift((Len(str) + 8), 6) ) + 1 ' number of 16-word blocks 
Dim blks() 
ReDim blks(nblk*16 - 1) 

Dim x 
For x=0 To nblk * 16 - 1 
blks(x) = 0 
Next 

Dim arIdx 
For x = 0 To Len(str)-1 
arIdx = RShift(x,2) 
blks(arIdx) = blks(arIdx) Or LShift(Asc(CStr(Mid(str,x+1,1))) And &hFF, ((x Mod 4) * 8)) 
Next 

blks(RShift(x,2)) = blks(RShift(x,2)) Or LShift(&h80, ((x Mod 4) * 8)) 
blks(nblk*16-2) = Len(str) * 8 
str2binl = blks 
End Function 

Function bytarray2binl(barray) 
Dim nblk 
nblk = RShift((UBound(barray) + 8), 6) + 1 ' number of 16-word blocks 

Dim blks() 
Redim blks(nblk*16 - 1) 

Dim x 
For x = 0 To nblk*16 - 1 
blks(x) = 0 
Next 

Dim arIdx 
For x = 0 To UBound(barray) 
arIdx = RShift(x,2) 
blks(arIdx) = blks(arIdx) Or LShift( barray(x) And &hFF, (x Mod 4) * 8) 
Next 

blks(RShift(x,2)) = blks(RShift(x,2)) Or LShift(&h80, ((x Mod 4) * 8)) 
blks(nblk*16-2) = (UBound(barray)+1) * 8 
bytarray2binl = blks 
End Function 

Function binl2byt(binarray) 
Dim bytarray() 
ReDim bytarray(((UBound(binarray)+1) * 4) - 1) 
Dim str 
str = "" 

Dim x 
For x = 0 To ((UBound(binarray)+1) * 4) -1 
bytarray(x) = _ 
LShift(( RShift( binarray(RShift(x,2)), ((x Mod 4)*8+4) ) And &hF ), 4) _ 
Or _ 
(RShift(binarray(RShift(x,2)),((x Mod 4)*8))) And &hF 
Next 
binl2byt = bytarray 
End Function 

Function binl2hex(binarray) 
Dim hex_tab 
hex_tab = "0123456789abcdef" 
Dim str 
str = "" 

Dim x 

For x=0 To ((UBound(binarray)+1) * 4) - 1 
str = str + Mid(hex_tab,( RShift(binarray(RShift(x,2)), ((x Mod 4)*8+4)) And &hF )+1, 1) + _ 
Mid(hex_tab,( RShift(binarray(RShift(x,2)), ((x Mod 4)*8)) And &hF )+1, 1) 
Next 

binl2hex = str 
End Function 

%> 

2.send.asp 
复制代码代码如下:

<!-- #include file="hmac-md5.asp" --> 
<% 
    Dim merchantId 
    Dim keyValue 

merchantId = request("cid")        '''商户编号 
keyValue = request("mykey")        '''商户密钥 
orderid = request("orderid")        '''订单编号 
amount = request("totalmoney")        '''订单金额 
%> 

<% 

    Dim merchantCallbackURL 
    '设定秘钥，其中正式的merchantID以及秘钥value 需要从YeePay易宝提供给商家的商家自助服务系统获得 
    merchantId = merchantId            '测试使用 merchant ID = "1001001" 
    keyValue = keyValue                 '测试使用 keyValue = "Key" 
    merchantCallbackURL = ""    '用户完成交易完成后, 控制应用返回到商家自己的URL 

%> 
<!-- #include file="yeepayCommon.asp" --> 

<% 
    Dim orderId 
    Dim productDesc 
    Dim productCat 
    Dim productId 
    Dim    cur 
    Dim sMctProperties 
    Dim sNewString 
    Dim frpId 

    '商家设置用户购买商品的支付信息 
    orderId=orderid                     '商家的交易定单号此参数可选，但不能有重复（如果不输入YeePay会自动帮助商家生成一个订单号） 
    productId = "0"        '商品ID(尽量清楚填写，方便以后统计订单)     
    amount=amount     '购买金额(必须) 
    cur="CNY"                    '货币单位(固定不需要修改，现在一般只会支持人民币交易) 
    productDesc = ""            '商品描述(可保持为空) 
    productCat = ""                '商品种类(可保持为空) 

     
    '商家可以把一些辅助信息放在mp列表中，当从YeePay易宝平台返回时，还可以原样取出商家设定的一些信息。可以提供商家临时保存信息的功能 
    sMctProperties = ""            '(可保持为空) 

    '如果直接到YeePay网关设定为空即可，而在商家端选择银行的情况下请参见银行列表 
    frpId=""                    '(可选) 

    '调用签名函数生成签名串 
    sNewString = getReqHmacString(orderId,amount,cur,productId,productCat,productDesc,merchantCallbackURL,sMctProperties,frpId) 

%> 
<html> 
<head> 
<title>易宝支付</title> 
</head> 
<body onLoad="document.yeepay.submit()"> 
    <form name="yeepay" action="<%=nodeAuthorizationURL%>" method="post"> 
        <input type="hidden" name="p0_Cmd" value="<%=messageType%>"> 
        <input type="hidden" name="p1_MerId" value="<%=merchantId%>"> 
        <input type="hidden" name="p2_Order" value="<%=orderId%>"> 
        <input type="hidden" name="p3_Amt" value="<%=amount%>"> 
        <input type="hidden" name="p4_Cur" value="<%=cur%>"> 
        <input type="hidden" name="p5_Pid" value="<%=productId%>"> 
        <input type="hidden" name="p6_Pcat" value="<%=productCat%>"> 
        <input type="hidden" name="p7_Pdesc" value="<%=productDesc%>"> 
        <input type="hidden" name="p8_Url" value="<%=merchantCallbackURL%>"> 
        <input type="hidden" name="p9_SAF" value="<%=addressFlag%>"> 
        <input type="hidden" name="pa_MP" value="<%=sMctProperties%>"> 
        <input type="hidden" name="pd_FrpId" value="<%=frpId%>">         
        <input type="hidden" name="hmac" value="<%=sNewString%>"> 
    </form> 
</body> 
</html> 


3.yeepayCommon.asp 
复制代码代码如下:

<% 
    Dim mctSDK 
    Dim nodeAuthorizationURL 
    Dim messageType 
    Dim addressFlag 
    nodeAuthorizationURL = "https://www.yeepay.com/app-merchant-proxy/node"    '扣款请求URL 无需更改 
    messageType="Buy"            '消息类型 
    addressFlag="0"                '需要填写送货信息 0：不需要 1:需要 

     
Function getReqHmacString(orderId,amount,cur,productId,productCat,productDesc,merchantCallbackURL,sMctProperties,frpId) 
    Dim sbOld 
    '进行加密串处理，一定按照下列顺序进行 
    sbOld="" 
    sbOld = sbOld + messageType 
    sbOld = sbOld + merchantId 
    sbOld = sbOld + orderId 
    sbOld = sbOld + CStr(amount)         
    sbOld = sbOld + cur                     
    sbOld = sbOld + productId 
    sbOld = sbOld + productCat 
    sbOld = sbOld + productDesc 
    sbOld = sbOld + merchantCallbackURL 
    sbOld = sbOld + addressFlag 
    sbOld = sbOld + sMctProperties 
    sbOld = sbOld + frpId 

    getReqHmacString = HMAC(sbOld,keyValue) 

End Function 

Function getCallbackHmacString(sCmd,sErrorCode,sTrxId,orderId,amount,productId,userId,MP,bType) 
    Dim sbOld 
    '取得加密前的字符串 
    sbOld = "" 
    sbOld = sbOld + CStr(merchantId) 
    sbOld = sbOld + sCmd 
    sbOld = sbOld + sErrorCode 
    sbOld = sbOld + sTrxId 
    sbOld = sbOld + amount 
    sbOld = sbOld + cur 
    sbOld = sbOld + productId 
    sbOld = sbOld + orderId 
    sbOld = sbOld + userId 
    sbOld = sbOld + MP 
    sbOld = sbOld + bType 

    getCallbackHmacString = HMAC(sbOld,keyValue) 

End Function 

Function CheckHmac(sCmd,sErrorCode,sTrxId,orderId,amount,productId,userId,MP,bType,hmac) 
    if(hmac=getCallbackHmacString(sCmd,sErrorCode,sTrxId,orderId,amount,productId,userId,MP,bType)) Then 
        CheckHmac = True 
    ELSE 
        CheckHmac = Flase 
    END IF 
End Function 

'取得返回串中的所有参数 
Sub getCallBackValue(ByRef sCmd,ByRef sErrorCode,ByRef sTrxId,ByRef amount,ByRef cur,ByRef productId,ByRef orderId,ByRef userId,ByRef MP,ByRef bType,ByRef svrHmac) 
    sCmd = Request.QueryString("r0_Cmd") 
    sErrorCode = Request.QueryString("r1_Code") 
    sTrxId = Request.QueryString("r2_TrxId") 
    amount = Request.QueryString("r3_Amt") 
    cur = Request.QueryString("r4_Cur") 
    productId = Request.QueryString("r5_Pid") 
    orderId = Request.QueryString("r6_Order") 
    userId = Request.QueryString("r7_Uid") 
    MP = Request.QueryString("r8_MP") 
    bType = Request.QueryString("r9_BType")      
    svrHmac = Request.QueryString("hmac") 
End Sub 

%> 
  • 支付接口
  • asp

    • 延伸 · 阅读

    精彩推荐
    最近更新
    编辑推荐
    阅读排行
    热门标签
    800c0019 　 Rs.Open 　 Conn.Execute 　 Webform 　 内置对象 　 Session 　 Application 　 ViewState 　 ABP 　 日志管理 　 设置管理 　 WebService 　 问题 　 广告 　 vbs 　 FormatDate 　 日期格式化 　 完整路径 　 HTMLEncode 　 连接符 　 Vista 　 动态 　 ASP开发 　 网页 　 在线压缩 　 错误捕获 　 Weekday 　 asp代码 　 信息提示 　 返回 　
    © 2019-2021 服务器之家(www.zzvips.com) 版权所有关于我们联系我们版权申明网站地图