shopchannel.asp

网络上经典的图片程序

					Founderr = True
				End If
			End If
			Session("GetCode") = ""
			
			Select Case PayMode
			Case 0
				strPayMode = "银行汇款"
			Case 1
				strPayMode = "网上支付"
			Case 2
				strPayMode = "站内支付"
				If userid > 0 Then
					Set Rs = Newasp.Execute("SELECT userid,BuyCode,usermoney FROM NC_User WHERE UserName='"& UserName &"' And UserGrade="& UserGrade &" And userid=" & userid)
					If Rs.BOF And Rs.EOF Then
						ErrorMsg ="非法操作！！！"
						Founderr = True
					Else
						
						BuyCode = vmd.md5(Trim(Request.Form("BuyCode")), False)
						'--检验用户余额
						If Rs("usermoney") < ActualMoney Then
							ErrorMsg ="对不起！你的帐户余额不足，请使用其它方式支付。"
							Founderr = True
						Else	'--检验用户站内支付密码
							If Trim(Rs("BuyCode")) <> BuyCode And Trim(Rs("BuyCode")) <> "" Then
								ErrorMsg ="对不起！站内支付密码错误，请返回重新刷新页面再试。"
								Founderr = True
							Else
								PayDone = 1
								Newasp.Execute ("UPDATE NC_User SET usermoney=usermoney-" & ActualMoney & ",prepaid=prepaid+" & ActualMoney & " WHERE userid=" & Rs("userid"))
							End If
						End If
					End If
					Set Rs = Nothing
				Else
					ErrorMsg ="你不是会员，不能使用站内支付！！！"
					Founderr = True
				End If
			Case 3
				strPayMode = "邮局汇款"
			Case Else
				strPayMode = "其它汇款"
			End Select
			
			strProductID = Newasp.CheckRequest(Request.Cookies("ProductIDList")("ProductID"),0)
			If Len(strProductID) = 0 Then
				ErrorMsg ="处理订单错误，找不到相关订单信息！！！"
				Founderr = True
			End If
			Set Rs = Newasp.Execute("SELECT id FROM NC_OrderForm WHERE OrderID='"& OrderForm &"'")
			If Not (Rs.BOF And Rs.EOF) Then
				ErrorMsg ="您已经提交了表单，请不要重复提交！！！"
				Founderr = True
			End If
			Set Rs = Nothing
			
			If FoundErr = False Then
				Set Rs = CreateObject("ADODB.Recordset")
				SQL = "SELECT * FROM NC_OrderForm WHERE (id is null)"
				Rs.Open SQL,Conn,1,3
				Rs.AddNew
					If userid > 0 Then
						Rs("userid") = userid
						Rs("username") = username
					Else
						Rs("userid") = 0
						Rs("username") = "匿名用户"
					End If
					Rs("ProductID") = Newasp.CheckStr(strProductID)
					Rs("OrderID") = Newasp.CheckStr(OrderForm)
					Rs("Surcharge") = Surcharge
					Rs("totalmoney") = ActualMoney
					Rs("Consignee") = Consignee
					Rs("Company") = Company
					Rs("Address") = Address
					Rs("postcode") = postcode
					Rs("phone") = phone
					Rs("Email") = Email
					Rs("oicq") = oicq
					Rs("Readme") = Readme
					Rs("Paymode") = strPayMode
					Rs("addTime") = Now()
					Rs("invoice") = Newasp.ChkNumeric(Request.Form("invoice"))
					Rs("finish") = 0
					Rs("Cancel") = 0
					Rs("PayDone") = PayDone
				Rs.Update
				Rs.Close:Set Rs = Nothing
				
				Set Rs = CreateObject("ADODB.Recordset")
				Rs.Open "SELECT id FROM NC_OrderForm WHERE OrderID='"& OrderForm &"' ORDER BY id DESC", Conn, 1, 1
				Call AddBuyProduct(Rs("id"))
				Rs.Close:Set Rs = Nothing
				
				Dim wp,arrChinaeBank
				Dim strPlatform,SubmitCode
				strPlatform = ""
				'--是否打开在线支付
				If CInt(Newasp.StopBankPay) > 0 And PayMode <> 2 Then
					arrChinaeBank = Split(Newasp.ChinaeBank, "|||")
					SubmitCode = Newasp.HtmlSetting(15)
					
					Set wp = New WebPayment_Cls
					wp.PayPlatform = CInt(Newasp.StopBankPay)
					wp.submitvalue = SubmitCode
					wp.Paymentid = Trim(arrChinaeBank(0))
					wp.Paymentkey = Trim(arrChinaeBank(1))
					wp.Percent = Newasp.CheckNumeric(arrChinaeBank(2))
					If LCase(Left(ChannelRootDir,7)) = "http://" Then
						wp.Returnurl = ChannelRootDir & "receive.asp"
					Else
						wp.Returnurl = Newasp.GetSiteUrl & ChannelRootDir &"receive.asp"
					End If
					wp.Orderid = OrderForm
					wp.Paymoney = ActualMoney
					If Trim(Readme) = "" Then
						wp.Comment = "网上购物"
					Else
						wp.Comment = Readme
					End If
					wp.Consignee = Consignee
					wp.Consigner = Consignee
					wp.Address = Address
					wp.Postcode = Postcode
					wp.Email = Email
					wp.Telephone = Phone
					strPlatform = wp.ShowPayment
					Set wp = Nothing
				End If
				strContent = Newasp.HtmlSetting(12)
				strContent = Replace(strContent, "{$Surcharge}", FormatNumber(Surcharge,2,-1))
				strContent = Replace(strContent, "{$ActualMoney}", FormatNumber(ActualMoney,2,-1))
				strContent = Replace(strContent, "{$TotalMoney}", FormatNumber(TotalMoney,2,-1))
				strContent = Replace(strContent, "{$Rebate}", strRebate)
				strContent = Replace(strContent, "{$OrderID}", OrderForm)
				strContent = Replace(strContent, "{$ChineseMoney}", ChineseMoney)
				strContent = Replace(strContent, "{$WebPlatform}", strPlatform)
				If PayMode = 2 Then
					strContent = Replace(strContent, "{$SitePayInfo}", "恭喜您！站内支付成功，本次交易已完成。")
				Else
					strContent = Replace(strContent, "{$SitePayInfo}", "订单提交完成，只有付款成功后，本次交易才能完成。您可选择在线实时支付，或其它付款方式。")
				End If
				Response.Cookies("ProductIDList") = ""
			Else
				strContent = Newasp.HtmlSetting(14)
				strContent = Replace(strContent, "{$ErrorMsg}", ErrorMsg)
			End If
		Case Else
			'--提交订单
			HtmlContent = Replace(HtmlContent, "{$PageTitle}", "订单提交")
			If Newasp.memberid > 0 Then
				Set Rs = Newasp.Execute("SELECT userid,UserName,TrueName,usermail,phone,oicq,postcode,address FROM NC_User WHERE UserName='"& UserName &"' And userid=" & userid)
				If Not (Rs.BOF And Rs.EOF) Then
					Consignee = Rs("TrueName")
					Address = Rs("address")
					Phone = Rs("phone")
					Postcode = Rs("postcode")
					Email = Rs("usermail")
					Oicq = Rs("oicq")
				End If
				Set Rs = Nothing
			End If
			If FoundErr = False Then
				Randomize
				sRnd = Int(9000 * Rnd) + 1000
				curdate=now()                                               
				OrderForm = Year(curdate) & Month(curdate) & Day(curdate) &"-"& sRnd &"-"& Hour(curdate) & Minute(curdate) & Second(curdate)

				strContent = Newasp.HtmlSetting(9)
				strContent = strContent & Newasp.HtmlSetting(10)
				strContent = Replace(strContent, "{$Consignee}", Consignee)
				strContent = Replace(strContent, "{$Address}", Address)
				strContent = Replace(strContent, "{$Phone}", Phone)
				strContent = Replace(strContent, "{$Postcode}", Postcode)
				strContent = Replace(strContent, "{$Email}", Email)
				strContent = Replace(strContent, "{$Oicq}", Oicq)
				strContent = Replace(strContent, "{$OrderID}", OrderForm)
			Else
				strContent = Newasp.HtmlSetting(14)
				strContent = Replace(strContent, "{$ErrorMsg}", ErrorMsg)
				strContent = Replace(strContent, "{$DateTime}", Now())
			End If
		End Select
		
		HtmlContent = Replace(HtmlContent, "{$PublicContent}", strContent)
		ReplaceString
		Response.Write HtmlContent
	End Sub
	'=================================================
	'过程名：AddBuyProduct
	'作  用：添加购买商品
	'=================================================
	Private Sub AddBuyProduct(sid)
		Dim strProductID,QuantityID
		Dim Quantity,UnitPrice,TotalPrice
		
		On Error Resume Next
		sid = CLng(sid)
		strProductID = Newasp.CheckRequest(Request.Cookies("ProductIDList")("ProductID"),0)
		If strProductID = "" Then Exit Sub
		If Founderr = True Then Exit Sub
		SQL = "SELECT shopid,TradeName,NowPrice FROM [NC_ShopList] WHERE ChannelID=" & ChannelID & " And isAccept > 0 And shopid in (" & strProductID & ")"
		Set Rs = Newasp.Execute(SQL)
		If Not (Rs.BOF And Rs.EOF) Then
			Do While Not Rs.EOF
				QuantityID = "Quantity_" & Rs("shopid")
				Quantity = Newasp.ChkNumeric(Request.Cookies("ProductIDList")(QuantityID))

				If Quantity = 0 Then Quantity = 1
				
				UnitPrice = Rs("NowPrice")
				TotalPrice = UnitPrice * Quantity
				SQL = "INSERT INTO NC_buy (orderid,userid,shopid,TradeName,Amount,Price,totalmoney) VALUES ("& sid &","& Newasp.memberid &","& Rs("shopid") &",'"& Newasp.CheckStr(Rs("TradeName")) &"',"& Quantity &","& UnitPrice &","& TotalPrice &")"
				Newasp.Execute(SQL)
				Rs.MoveNext
			Loop
		End If
		Set Rs = Nothing
	End Sub
	'=================================================
	'函数名：CountTotalMoney
	'作  用：统计总金额
	'=================================================
	Public Function CountTotalMoney()
		Dim strProductID,QuantityID
		Dim Quantity,UnitPrice,TotalPrice
		CountTotalMoney = 0
		On Error Resume Next
		
		strProductID = Newasp.CheckRequest(Request.Cookies("ProductIDList")("ProductID"),0)
		
		If Len(strProductID) = 0 Then
			Exit Function
		Else
			SQL = "SELECT shopid,NowPrice FROM [NC_ShopList] WHERE ChannelID=" & ChannelID & " And isAccept > 0 And shopid in (" & strProductID & ")"
			Set Rs = Newasp.Execute(SQL)
			
			If Rs.BOF And Rs.EOF Then
				Set Rs = Nothing
				Exit Function
			Else
				TotalPrice = 0
				Do While Not Rs.EOF
					QuantityID = "Quantity_" & Rs("shopid")
					Quantity = Newasp.ChkNumeric(Request.Cookies("ProductIDList")(QuantityID))
					If Quantity = 0 Then Quantity = 1
					
					UnitPrice = Rs("NowPrice") * Quantity
					TotalPrice = TotalPrice + UnitPrice
					Rs.MoveNext
				Loop
			End If
			Set Rs = Nothing
		End If
		
		CountTotalMoney = CCur(TotalPrice )
	End Function
	'=================================================
	'函数名：CheckEmail
	'作  用：判断EMAIL
	'=================================================
	Public Function CheckEmail(Byval email)
		Dim names, ename, i, c
		CheckEmail = True
		email = Trim(email)
		names = Split(email, "@")
		If UBound(names) <> 1 Then
			CheckEmail = False
			Exit Function
		End If
		For Each ename in names
			If Len(ename) <= 0 Then
				CheckEmail = False
				Exit Function
			End If
			For i = 1 To Len(ename)
				c = LCase(Mid(ename, i, 1))
				If InStr("abcdefghijklmnopqrstuvwxyz_-.", c) <= 0 And Not IsNumeric(c) Then
					CheckEmail = False
					Exit Function
				End If
			Next
			If Left(ename, 1) = "." Or Right(ename, 1) = "." Then
				CheckEmail = False
				Exit Function
			End If
		Next
		If InStr(names(1), ".") <= 0 Then
			CheckEmail = False
			Exit Function
		End If
		i = Len(names(1)) - InStrRev(names(1), ".")
		If i <> 2 And i <> 3 Then
			CheckEmail = False
			Exit Function
		End If
		If InStr(email, "..") > 0 Then
			CheckEmail = False
		End If
	End Function
	'///---订单提交过程结束
	'-------------------------------------------------
	'///---在线支付返回过程开始
	'=================================================
	'过程名：BuildReceive
	'作  用：在线支付返回页面
	'=================================================
	Public Sub BuildReceive()
		Dim strContent,errcode
		Dim wp,arrChinaeBank,ErrorMsg
		Dim OrderForm,PaymentMoney
		Dim ServiceCharge,BuyMoney
		Dim Consignee,Readme
		Dim userid,UserName

		On Error Resume Next
		
		userid = Clng(Newasp.memberid)
		UserName = Newasp.CheckRequest(Newasp.membername,45)
		skinid = CLng(Newasp.ChannelSkin)
		Newasp.LoadTemplates ChannelID, 6, skinid

		'--购物权限设置
		If CInt(Newasp.GroupSetting(30)) = 0 Then
			Call OutAlertScript(Newasp.CheckStr(Newasp.HtmlSetting(8)))
			Exit Sub
		End If