<%option explicit%>
<%
Dim dbc, oid
Dim ssl
dim slash, action, tmpstr, rc
'*******************************************************************
' Version 4.50 May 3, 2002 allow bypass to work
' this is the final chance to cancel before order is created
' uses xssl and xshopchecout to determine where to go. Fix slash problem Septe 21
'********************************************************************
ssl=getconfig("xssl")
if ssl<>"" then
slash=right(ssl,1)
if slash="/" or slash="\" then
else
ssl=ssl & "/"
end if
end if
if GetSess("CartCount")=0 or GetSess("CartCount")="" then
Response.Redirect "shoperror.asp?msg=" & Server.URLEncode (LangError01)
end if
if GetSess("AffID")="" and getconfig("xaffiliateUseCookies")="Yes" then
tmpStr=Request.Cookies("affid")
If tmpStr<>"" then
SetSess "AffID", tmpStr
end if
end if
action = request("Cancel")
if action="" then
action=request("cancel.x")
end if
If action<>"" then
ShopCancelOrder
Response.Redirect "shoperror.asp?msg=" & Server.URLEncode (LangCheckoutCancelled)
end if
action = request.form("action")
if action="" then
action = request.form("action.x")
end if
' no action so display final form in this session
SetSess "CurrentURL","shopcreateorder.asp"
if Action="" then
if getconfig("Xbypasscreateorderpage")="Yes" then
dim remove
remove="NO"
CartFormat remove
Savethisorder
else
ShopPageHeader
DisplayForm
ShopPageTrailer
end if
else
SaveThisOrder
end if
Sub SaveThisOrder
ShopAddOrder ' add order to database
oid=GetSess( "orderId")
HandleGiftRegistry
HandleGiftPurchase
HandleGiftCertificate
if Getsess("ordertotal")= 0 then
updatepaymentinfo LangpaymentNone
response.redirect "shopthanks.asp"
end if
if getconfig("xframes")="Yes" and getconfig("xframessl")<>"" then
response.redirect getconfig("xframeSSL")
end if
If getconfig("xIncludeOidOnLink")="Yes" then
Response.Redirect ssl & getconfig("xcheckout") & "?oid=" & oid
else
Response.Redirect ssl & getconfig("xcheckout")
end if
end sub
'
Sub DisplayForm
If Getconfig("xgiftregistry")="Yes" and getsess(REGISTRANTID)<>"" Then
DisplayGiftregForm
exit sub
end if
if getconfig("xFrames")="Yes" then
response.write ""
end if
response.write ""
Response.write getconfig("xfont") & LangCreate01 & "
"
Response.write LangCreate02 & "
"
If getconfig("xssl")<>"" Then
Response.write LangCreate03
end if
response.write "
"
response.write ""
response.write ""
if getconfig("xAllowOrderReview")="Yes" Then
%>
<%=LangCreate05%>
<%
End if
if getconfig("xAllowSaveCart")="Yes" Then
%>
<%=LangSaveCart%>
<%
End if
End Sub
'
Sub UpdatepaymentInfo (paymenttype)
Dim rstemp
OpenOrderDB dbc
Dim sqltemp
sqltemp="update orders set ocardtype='" & paymenttype &"'" & " where orderid=" & getsess("oid")
dbc.execute(sqltemp)
ShopcloseDatabase dbc
end sub
Sub HandleGiftCertificate
dim certificate, amountused, msg
if getconfig("xGiftCertificates")<>"Yes" then exit sub
Certificate=Getsess("Giftcertificate")
If certificate="" then exit sub
amountused=Getsess("giftamountused")
msg=""
If amountUsed<>"" then
GiftDecrementAmountUsed certificate,amountused,msg
If msg<>"" then
Shoperror msg
end if
end if
if Getsess("ordertotal")= 0 then
UpdatepaymentInfo langgiftcertificate
response.redirect "shopthanks.asp"
end if
end sub
Sub HandleGiftPurchase
' has someone purchased a gift certificate
if getconfig("xGiftCertificates")<>"Yes" then exit sub
If Getsess("Giftcount")="" then exit sub
GiftAddtoDatabase ' add to Gift table
oid=GetSess("orderId")
SetSess "Giftid",oid
end sub
Sub HandleGiftRegistry
If getconfig("xgiftregistry")<>"Yes" then exit sub
If GetSess(REGISTRANTID) <> "" then
ProcessGiftRegistry oid 'in shopgiftregsubs
Setsess "ordertotal",0
response.redirect "shopthanks.asp"
Else
If GetSess(REGISTRY) <> "" Then
debugwrite "updating registry"
UpdateRegistry oid 'in shopgiftregsubs
End If
end if
end sub
'
Sub DisplayGiftRegForm
Response.write getconfig("xfont")
Response.write ""
%>