shopcheckout.asp

来自「ASP+SQL Server动态网站开发从基础到实践教程」· ASP 代码 · 共 383 行

<!-- #include file="shop$db.asp" -->
<%
'**************************************************************************
' we are now secure and in different session to need to reget info'
' after getting credit card details we update database with them
' unless the user has cancelled, in that case we delete order and items
' from the database
'
' April 8, 2000 2.3 rewrote to eliminae java script and to call
'                   direct debit routine 
' Calls ShopPayment.asp?oid=xxx 
' Shoppayment can return with Error= to reget information
'*************************************************************************
' 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)="Check"
OtherTypes(1)="Cash"
OtherTypes(2)="Phone Order"
othercount=3
Dim PaymentURL
PaymentURL=""        ' Not supported in nonregistered version
'

dim oid
dim dbc
Dim sRowColor
sRowColor="#C4CEE5"
dim rstemp
Dim strOcardtype
Dim strOcardno
Dim strOcardname
Dim strOcardexpires
Dim strOcardaddress
Dim strOOther
Dim StroMore
Dim StrOAuthorization
const cSelect="Select"
'
'
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><font size=4>支付信息<br>")
	Response.Write("<b>请选择信用卡支付或者其他支付方法</Font>")
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=2>")
        AddCreditCard
        AddOtherPayment 
	Response.Write("</table><p>")
        Response.Write("<input type=submit name=action value=""继续"">")
        response.write "<INPUT name=action type=submit value=""取消"">"
        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><td><b>信用卡支付</b></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=50 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=50 name=strOcardaddress value=" & Chr(34) & strOcardaddress & Chr(34) & "></td></tr>")
end if
end Sub
'
Sub AddOtherPayment
If AllowOtherPayment="Yes" Then
        Response.Write("<br><tr><td><b>其他支付方式</b></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=50 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 = ucase(left(request.form("action"),6))
if action = "CANCEL" Then
        DeleteOrders           ' delete order from database
        Response.Redirect "shoperror.asp?msg=" & Server.URLEncode ("Order Cancelled") 
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 Orderid=" & 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 OrderID = " & CInt(Session("oid"))
dbc.Execute "delete from Orders where OrderID = " & 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 & "日期格式应该为 in form 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 & "日期格式不合法<br>"
end if
end sub
%>