joekoe_pay.asp

打开目录ads文件夹 找到top_ads.js文件 用记事本打开后就可以看到: -------------------------------------- var head_ads_tx

<!--#include file="joekoe_pay_set.asp"-->
<%
dim pay_number,pay_signa,pay_back,pay_url
pay_number=pay_set_dim(2)
pay_signa=pay_set_dim(3)
pay_back=pay_set_dim(4)
const pay_currency="01"
pay_url=pay_set_dim(5)

function fm_price(pvar,pt)
  if not isnumeric(pvar) then
    fm_price=0
    exit function
  end if
  dim nvar,ni
  nvar=formatnumber(pvar)
  nvar=replace(nvar,",","")
  if left(nvar,1)="." then
    nvar="0"&nvar
  end if
  if pt=1 then
    fm_price=nvar
    exit function
  end if
  for ni=0 to 1
    if cstr(right(nvar,1))="0" then
      nvar=left(nvar,len(nvar)-1)
    else
      ni=1
    end if
  next
  if cstr(right(nvar,1))="." then
    nvar=left(nvar,len(nvar)-1)
  end if
  if not isnumeric(nvar) then nvar=0
  fm_price=csng(nvar)
end function

function pay_encrypt(pvar)
  pay_encrypt=jk_md5(pvar,"long")
end function

class joekoe_pay
  public back_url,pay_sort,pay_ordernum,pay_amount,pay_username,pay_address,pay_post,pay_phone,pay_email,pay_carry,pay_remark,frm_target,frm_js,val_num
  
  private sub class_initialize()
    back_url=""
    frm_target=true
    frm_js=true
    val_num=0
  end sub
  
  public function sort_type(ts)
    dim temp1
    ts=replace(ts,"'","")
    ts=replace(ts,"""","")
    ts=replace(ts,"*","")
    ts=replace(ts,"#","")
    ts=replace(ts,"$","")
    ts=replace(ts,"%","")
    ts=replace(ts," ","")
    select case ts
    case "emoney"
      temp1=ts
    case "shop"
      temp1=ts
    case else
      temp1=ts
    end select
    sort_type=temp1
  end function
  
  public sub pay_return()
    dim re_number,re_safety,var_tmp
    re_number=trim(request.form("re_number"))
    pay_sort=trim(request.form("re_sort"))
    pay_ordernum=trim(request.form("re_ordernum"))
    pay_amount=trim(request.form("re_amount"))
    pay_username=trim(request.form("re_username"))
    re_safety=trim(request.form("re_safety"))
    if pay_sort="" or pay_ordernum="" or pay_amount="" or pay_username="" then
      val_num=1
      exit sub
    end if
    var_tmp=pay_encrypt(cstr(pay_signa)&cstr(pay_number)&cstr(pay_sort)&cstr(pay_ordernum)&cstr(fm_price(pay_amount,1))&cstr(pay_username))
    if re_safety<>var_tmp then
      val_num=2
      exit sub
    end if
  end sub
  
  public sub pay_frm(ftype)
    dim temp1
    pay_amount=fm_price(pay_amount,1)
    dim var_tmp,pay_safety
    pay_sort=sort_type(pay_sort)
    var_tmp=cstr(pay_number)&cstr(pay_signa)&cstr(pay_sort)&cstr(pay_ordernum)&cstr(fm_price(pay_amount,1))&cstr(pay_username)
    pay_safety=pay_encrypt(var_tmp)
    if back_url="" then back_url=pay_back
    temp1=vbcrlf&"<form name=joekoe_pay_frm action='"&pay_url&"' method=post"
    if frm_target then temp1=temp1&" target=pay_win"
    temp1=temp1&">" & _
	  vbcrlf&"<input type=hidden name=pay_number value='"&pay_number&"'>" & _
	  vbcrlf&"<input type=hidden name=pay_sort value='"&pay_sort&"'>" & _
	  vbcrlf&"<input type=hidden name=pay_ordernum value='"&pay_ordernum&"'>" & _
	  vbcrlf&"<input type=hidden name=pay_amount value='"&pay_amount&"'>" & _
	  vbcrlf&"<input type=hidden name=pay_username value='"&pay_username&"'>" & _
	  vbcrlf&"<input type=hidden name=pay_address value='"&pay_address&"'>" & _
	  vbcrlf&"<input type=hidden name=pay_post value='"&pay_post&"'>" & _
	  vbcrlf&"<input type=hidden name=pay_phone value='"&pay_phone&"'>" & _
	  vbcrlf&"<input type=hidden name=pay_email value='"&pay_email&"'>" & _
	  vbcrlf&"<input type=hidden name=pay_carry value='"&pay_carry&"'>" & _
	  vbcrlf&"<input type=hidden name=pay_remark value='"&pay_remark&"'>" & _
	  vbcrlf&"<input type=hidden name=pay_currency value='"&pay_currency&"'>" & _
	  vbcrlf&"<input type=hidden name=pay_back_url value='"&back_url&"'>" & _
	  vbcrlf&"<input type=hidden name=pay_safety value='"&pay_safety&"'>" & _
	  vbcrlf&"</form>"
    if frm_js then
      temp1=temp1&vbcrlf&"<script language=javascript>" & _
	    vbcrlf&"<!--"
    end if
    temp1=temp1&vbcrlf&"function joekoe_online_pay()" & _
	  vbcrlf&"{"
    if frm_target then temp1=temp1&vbcrlf&"  window.open('about:blank','pay_win');"
    temp1=temp1&vbcrlf&"  document.joekoe_pay_frm.submit();" & _
	  vbcrlf&"}"
    if ftype=1 then temp1=temp1&vbcrlf&"joekoe_online_pay();"
    if frm_js then
      temp1=temp1&vbcrlf&"-->" & _
	    vbcrlf&"</script>"
    end if
    response.write temp1
  end sub
end class


'支付宝
'generateShopPaytoURL(s1,s2,s3,s4,s8,s9,s10,s11,s12,s13,s14,s15,s16)
	's1：支付宝认证Email(seller)
	's2：安全校验码,在支付宝网站“商家工具”那里可以获得
	's3：命令编号，默认为0001(cmd)
	's4：订单编号(order_no)
	's5：商品名称(subject)
	's6：商品展示连接(url)
	's7：商品描述(body)
	's8：商品价格(price)
	's9：购买数量(number)
	's10：支付类型(type)1：商品购买   2：服务购买  3：网络拍卖  4：捐赠
	's11：平邮费用(ordinary_fee)
	's12：快递费用(express_fee)
	's13：发货方式(transport)1：平邮  2：快递  3：虚拟物品
	's14：交易信息是否只读(readonly)true或false  默认值为false
	's15：买家姓名(buyer_name)
	's16：买家Email(buyer)
	's17：买家地址(buyer_address)
	's18：买家邮编(buyer_zipcode)
	's19：买家电话号码(buyer_tel)
	's20：买家手机号码(buyer_mobile)
	's21：买家给卖家的留言(buyer_msg)

class yjcity_alipay

	Public sellerEmail,securityCode,Cmd,frm_target,frm_js,ordinaryFee,expressFee,md5Obj,alipayNotifyURL
	
	Public REQUEST_PAYTO_URL		'payto连接地址
	Public DEFAULT_ENCODING			'默认编码

	'构造函数,初始化各必要变量
	Public Sub myAlipay_Initialize()
		sellerEmail			= pay_set_dim(6)
		securityCode		= pay_set_dim(7)
		Cmd					= "0001"	'命令编号
		ordinaryFee			= pay_set_dim(0)	'平邮费用
		expressFee			= pay_set_dim(1)	'快递费用
		REQUEST_PAYTO_URL			= "https://www.alipay.com/payto:"
		alipayNotifyURL		= "http://notify.alipay.com/trade/notify_query.do?"
		DEFAULT_ENCODING			= "GBK"
	    frm_target=true
	    frm_js=true
		Set md5Obj					= New MD5
		md5Obj.MD5_Initialize()
	End Sub

	
	'生成交易Form
	Public sub generateShopPaytoURL(s1,s2,s3,s4,s5,s7,s8,s9,s10,s11,s12,s13,s15,s16,s17,s18,ftype)
	    dim temp1,md5Str
	    md5Str=	"cmd"			& s3 & _
	    		"subject"		& s5 & _
	    		"body"			& s7 & _
	    		"order_no"		& s4 & _
	    		"price"			& s8 & _
	    		"type"			& s10 & _
	    		"number"		& s9 & _
	    		"transport"		& s13 & _
	    		"ordinary_fee"	& s11 & _
	    		"express_fee"	& s12 & _
	    		"seller"&s1 & _
	    		"buyer"			& s16 & _
	    		"buyer_name"	& s15 & _
	    		"buyer_address" & s17 & _
	    		"buyer_zipcode"	& s18 & _
	    		s2
	    temp1=vbcrlf&"<form name=joekoe_pay_frm action='"&REQUEST_PAYTO_URL & s1&"' method=get"
	    if frm_target then temp1=temp1&" target=pay_win"
	    temp1=temp1&">" & _
		  vbcrlf&"<input type=hidden name=cmd value='"&s3&"'>" & _
		  vbcrlf&"<input type=hidden name=subject value='"&s5&"'>" & _
		  vbcrlf&"<input type=hidden name=body value='"&s7&"'>" & _
		  vbcrlf&"<input type=hidden name=order_no value='"&s4&"'>" & _
		  vbcrlf&"<input type=hidden name=price value='"&s8&"'>" & _
		  vbcrlf&"<input type=hidden name=type value='"&s10&"'>" & _
		  vbcrlf&"<input type=hidden name=number value='"&s9&"'>" & _
		  vbcrlf&"<input type=hidden name=transport value='"&s13&"'>" & _
		  vbcrlf&"<input type=hidden name=ordinary_fee value='"&s11&"'>" & _
		  vbcrlf&"<input type=hidden name=express_fee value='"&s12&"'>" & _
		  vbcrlf&"<input type=hidden name=buyer value='"&s16&"'>" & _
		  vbcrlf&"<input type=hidden name=buyer_name value='"&s15&"'>" & _
		  vbcrlf&"<input type=hidden name=buyer_address value='"&s17&"'>" & _
		  vbcrlf&"<input type=hidden name=buyer_zipcode value='"&s18&"'>" & _
		  vbcrlf&"<input type=hidden name=ac value='"&generatePaytoMD5(md5Str,0)&"'>" & _
		  vbcrlf&"</form>"
	    if frm_js then
	      temp1=temp1&vbcrlf&"<script language=javascript>" & _
		    vbcrlf&"<!--"
	    end if
	    temp1=temp1&vbcrlf&"function joekoe_online_alipay()" & _
		  vbcrlf&"{"
	    if frm_target then temp1=temp1&vbcrlf&"  window.open('about:blank','pay_win');"
	    temp1=temp1&vbcrlf&"  document.joekoe_pay_frm.submit();" & _
		  vbcrlf&"}"
	    if ftype=1 then temp1=temp1&vbcrlf&"joekoe_online_alipay();"
	    if frm_js then
	      temp1=temp1&vbcrlf&"-->" & _
		    vbcrlf&"</script>"
	    end if
	    response.write temp1
	End sub
	

	'取得payto交易的MD5加密串
	Public Function generatePaytoMD5(strTemp,ty)
		generatePaytoMD5	= md5Obj.md5(strTemp)
		if ty=1 then set md5Obj=nothing
	End Function
	
	'检查返回信息是否来自支付宝,如果 Cstr(ReturnState) 不是 "true" 和 "false" ,就是错误信息
	Public Function ReturnState(msg_id,order_no)
		dim Retrieval,strURL
		Set Retrieval  = Server.CreateObject("Microsoft.XMLHTTP") 
        
        strURL = "http://notify.alipay.com/trade/notify_query.do?msg_id=" & msg_id
        strURL = strURL & "&email=" & sellerEmail & "&order_no=" & order_no
        
        Retrieval.open "GET", strURL, False, "", "" 
        Retrieval.send()
        
        ReturnState = Retrieval.ResponseText
		Set Retrieval = Nothing
	End Function
	'私有接口,取得请求后返回的html
	Public Function getHTTPURL(strPath)
        Dim strTemp
		strTemp			= GetBody(strPath)
        getHTTPURL		= BytesToBstr(strTemp,"GB2312")
	End function

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

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

Class MD5

	Private BITS_TO_A_BYTE
	Private BYTES_TO_A_WORD
	Private BITS_TO_A_WORD

	Private m_lOnBits(30)
	Private m_l2Power(30)

	'初始化变量
	Public Sub MD5_Initialize()
		BITS_TO_A_BYTE		= 8
		BYTES_TO_A_WORD		= 4
		BITS_TO_A_WORD		= 32
	End Sub
	 
	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