asp 一些支付接口

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
复制代码代码如下:
<%
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 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）
    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（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

        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
%>

2.Alipay_Payto.asp

复制代码代码如下:
<！--#include file="Alipay_md5.asp"-->
<%

Class creatAlipayItemURL
    "获得最终的购买url

    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）
        Dim itemURL
        dim INTERFACE_URL,imgsrc,imgtitle
        "初始化各必要变量
        INTERFACE_URL    = t1    "支付接口
        imgsrc            = t4        "支付宝按钮图片
        imgtitle        = t5        "按钮悬停说明

    "Add by sunzhizhi 2006-5-10

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）

Count=ubound（mystr）

For i = Count TO 0 Step -1
minmax = mystr（ 0 ）
minmaxSlot = 0
For j = 1 To i
mark = （mystr（ j ） > minmax）
If mark Then
minmax = mystr（ j ）
minmaxSlot = j
End If
Next

If minmaxSlot <> i Then

temp = mystr（ minmaxSlot ）
mystr（ minmaxSlot ） = mystr（ i ）
mystr（ i ） = temp
End If
Next

For j = 0 To Count Step 1
value = SPLIT（mystr（ j ）, "="）

If value（1）<>"" then
If j=Count Then
md5str= md5str&mystr（ j ）
     Else
md5str= md5str&mystr（ j ）&"&"
     End If
End If
Next

md5str=md5str&key
     " response.write md5str

     sign=md5（md5str）

    itemURL    = itemURL&INTERFACE_URL

    For j = 0 To Count Step 1

     value = SPLIT（mystr（ j ）, "="）
        If value（1）<>"" then
        itemURL= itemURL&mystr（ j ）&"&"
        End If
Next
        itemURL    = itemURL&"sign="&sign&"&sign_type="&sign_type

        "response.write itemURL

    creatAlipayItemURL    = itemURL



    End Function

    Public Function get_AlipayButtonURL（itemURL,imgtitle,imgsrc）
        dim responseText1
        responseText1    =    responseText1 & "<a href="" & itemURL & "" href="" & itemURL & "" target="_blank">"        "购买网址
        responseText1    =    responseText1 & "<img alt="" & imgtitle & "" src=""                " src=""                "图片说明
        responseText1    =    responseText1 & imgsrc                                            "图片地址
        responseText1    =    responseText1 & "" align="absmiddle" border="0"/></a>"
        get_AlipayButtonURL=responseText1
    End Function

End Class
%>

3.send1.asp
复制代码代码如下:
<！--#include file="alipay_payto.asp"-->
<%

cid = request（"cid"）        """商户编号
response.write cid&"<br>"
meykey = request（"mykey"）        """商户密钥
response.write meykey&"<br>"

out_trade_no = request（"orderid"）        """订单编号
response.write out_trade_no&"<br>"

totalmoeny = request（"totalmoney"）        """订单金额
response.write totalmoeny&"<br>"

partnerid=request（"other1"）
response.write partnerid&"<br>"

"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" ""trade_create_by_buyer"
    agent = partnerid "合作厂商id
    partner            =    partnerid        "partner合作伙伴ID（必须填）
    sign_type = "MD5"
    subject            =    ""        "商品名称
    body            =    ""        "body            商品描述
    out_trade_no = Trim（Replace（out_trade_no,":",""）） "客户网站订单号，（现取系统时间，可改成网站自己的变量）
    price         =    totalmoeny                 "price商品单价            0.01～50000.00
discount = "0" "商品折扣
show_url = "" "商品展示地址（可以直接写网站首页网址）
quantity = "" "商品数量
payment_type = "1" "支付类型，（1代表商品购买）
logistics_type = "" "物流种类（快递）
logistics_fee = "" "物流费用
logistics_payment = "" "物流费用承担（卖家付）
    logistics_type_1 = ""
logistics_fee_1 = ""
logistics_payment_1 = "" "物流费用承担（买家付）
seller_email = cid "（必须填）
key = mykey "（必须填）
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
%>

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
%>