<%option explicit%>
<%
Dim dbc, oid
Dim ssl
dim slash, action, tmpstr, rc
'*******************************************************************
' Version 6.50 July 5, 2005
' 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
'********************************************************************
'VP-ASP 6.50 - get checkout value from shop$config.asp rather than config table
if xssl <> "" then
ssl=xssl
else
ssl=Getconfig("xssl")
end if
'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
shoperror getlang("langError01")
end if
'VP-ASP 6.09 - If invalid shipping method for this country has been chosen, show error
if getsess("shipselectionerror") > "" then
dim theshiperror
theshiperror = getsess("shipselectionerror")
setsess "shipselectionerror", ""
if theshiperror = "country" then
shoperror getlang("langinvalidshipforcountry")
else
shoperror "The selected shipping method does not have a price range for the " & theshiperror & " of products in your cart. Please select a different shipping method or contact the merchant."
end if
end if
if GetSess("AffID")="" and getconfig("xaffiliateUseCookies")="Yes" then
tmpStr=Request.Cookies("affid")
If tmpStr<>"" then
SetSess "AffID", tmpStr
ShopOpenOtherDB dbc, getconfig("xAffiliateDB")
UpdateAffiliatelog tmpstr,"",1,dbc
shopclosedatabase dbc
end if
end if
action = request("Cancel")
if action="" then
action=request("cancel.x")
end if
If action<>"" then
ShopCancelOrder
shoperror getlang("langCheckoutCancelled")
end if
'VP-ASP 6.50 - edit customer button
action = request("EditCustomer")
if action="" then
action=request("editcustomer.x")
end if
If action<>"" then
responseredirect "shopcustomer.asp"
end if
'VP-ASP 6.50 - edit cart button
action = request("EditCart")
if action="" then
action=request("editcart.x")
end if
If action<>"" then
responseredirect "shopaddtocart.asp"
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
if getconfig("xbreadcrumbs") = "Yes" then
response.write ""
end if
Response.write "" & getlang("langorderdetails") & "
"
DisplayForm
ShopPageTrailer
end if
else
SaveThisOrder
end if
Sub SaveThisOrder
ShopAddOrder ' add order to database
oid=GetSess( "orderId")
HandleGiftRegistry
HandleGiftPurchase
'====================================
'VP-ASP 600 - gift certificate processed at shopthanks.asp
'12/10/2005
'====================================
' Handlertificate
CheckGiftCertificate
'====================================
if Getsess("ordertotal")= 0 then
updatepaymentinfo getlang("langpaymentNone")
responseredirect "shopthanks.asp"
end if
if getconfig("xframes")="Yes" and getconfig("xframessl")<>"" then
responseredirect getconfig("xframeSSL")
end if
'VP-ASP 6.50 - get checkout value from shop$config.asp rather than config table
dim checkoutpage
if xcheckout <> "" then
checkoutpage=xcheckout
else
checkoutpage=Getconfig("xcheckout")
end if
If getconfig("xIncludeOidOnLink")="Yes" then
responseredirect ssl & checkoutpage & "?oid=" & oid
else
responseredirect ssl & checkoutpage
end if
end sub
'
Sub DisplayForm
dim url
If Getconfig("xgiftregistry")="Yes" and getsess(REGISTRANTID)<>"" Then
DisplayGiftregForm
exit sub
end if
if getconfig("xFrames")="Yes" then
response.write ""
end if
shopwriteheader getlang("LangCreate01")
shopwriteheader getlang("LangCreate02")
'VP-ASP 6.50 - get checkout value from shop$config.asp rather than config table
dim tempssl
if xssl <> "" then
tempssl=xssl
else
tempssl=Getconfig("xssl")
end if
If tempssl<>"" Then
shopwriteheader getLang("langCreate03")
end if
response.write ""
'VP-ASP 6.50 - show all order data on this page - no need for review page
'if getconfig("xAllowOrderReview")="Yes" Then
' url="shopmailform.asp"
' url=addwebsess(url)
' response.write "
" & getlang("langCreate05") & ""
'End if
if getconfig("xAllowSaveCart")="Yes" Then
response.write ""
url="shopsavecart.asp"
url=addwebsess(url)
response.write "
" & getlang("langSaveCart") & ""
End if
if getconfig("xWishlist")="Yes" Then
url="shopsaveperm.asp"
url=addwebsess(url)
Response.write "
" & "" & getlang("langwishlist") & "" & "
"
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
'====================================
'VP-ASP 600 - gift certificate now processed at shopthanks.asp
'12/10/2005
'====================================
Sub HandleGiftCertificate_OLD
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 getlang("langgiftcertificate")
responseredirect "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
responseredirect "shopthanks.asp"
Else
'VP-ASP 6.50 - registry purchase processed in shopthanks.asp
If GetSess(REGISTRY) <> "" Then
' debugwrite "updating registry"
' UpdateRegistry oid 'in shopgiftregsubs
End If
end if
end sub
'
Sub DisplayGiftRegForm
Response.write Largeinfofont
%>
"
end sub
'====================================
'VP-ASP 600 - Check gift certificate / is processed at shopthanks.asp
'28/11/2005
'====================================
Sub CheckGiftCertificate
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
CheckGiftAmountUsed certificate,amountused,msg
If msg<>"" then
Shoperror msg
end if
end if
end sub
Sub CheckGiftAmountUsed(certificate,amountused, msg)
Dim myconn, customerid
dim strSql
msg=""
dim giftnumber, giftusedamount, amount, giftusedtrace, giftusedcount
Dim orderid, giftrace
Giftnumber=certificate
GiftUsedamount=amountused
customerid=getsess("Customerid")
orderid=getsess("oid")
Shopopendatabase myconn
strSQL = "select * FROM gifts where giftnumber='" & Giftnumber & "'"
Set objRS = Server.CreateObject("ADODB.Recordset")
objRS.open strsql, myconn, adOpenKeyset, adLockOptimistic, adCmdText
If Not objrs.eof then
amount=objrs("giftamountremaining")
giftrace=objrs("giftusedtrace")
giftusedcount=objrs("giftusedcount")
amountused=csng(amountused)
If amount>= amountused then
'do nothing
else
msg= getlang("LangGiftPartlyUsed")
msg=msg & " " & shopformatcurrency(amount,getconfig("xdecimalpoint"))
end if
else
msg= getlang("LangGiftNotFound")
end if
objrs.close
set objrs=nothing
Shopclosedatabase myconn
End sub
'VP-ASP 6.50 - show more info on shopcreateorder.asp
Sub FormatSessionOrder
'VP-ASP 6.50 - add edit link to shopcreateorder.asp
'response.write ""
response.write "
"
Response.write FOrderTable
DoHeader getlang("LangFormatCustomerInformation")
Dofield getlang("LangCustFirstName"), strFirstName
DoField getlang("LangCustLastName"), strLastName
DoField getlang("LangCustAddress") ,strAddress
DoField getlang("LangCustAddress")& "2" ,strAddress2
DoField getlang("LangCustCity"), strCity
DoField getlang("LangCustState") , strState
DoField getlang("LangCustPostCode"),strPostCode
DoField getlang("LangCustCountry"),strcountry
DoField getlang("LangCustEmail"),stremail
DoField getlang("LangCustPhone"),strphone
DoField getlang("LangCustFax"),strfax
DoField getlang("LangCustCompany"),strcompany
Response.write ""
If getconfig("xShippingForm")="Yes" then
'VP-ASP 6.50 - add edit link to shopcreateorder.asp
'response.write ""
response.write "
"
Response.write FOrderTable
Doheader getlang("LangFormatShippingInformation")
DoField getlang("LangShippingMethod"),GetSess("shipmethod")
DoField getlang("LangShipName"),GetSess("shipname")
Dofield getlang("LangShipAddress"),GetSess("shipaddress")
Dofield getlang("LangShipAddress")& "2",GetSess("shipaddress2")
DoField getlang("LangShipCity"),GetSess("Shiptown")
DoField getlang("LangShipState"),GetSess("Shipstate")
Dofield getlang("LangShipPostcode"),GetSess("shipzip")
Dofield getlang("LangShipCompany"),GetSess("Shipcompany")
DoField getlang("LangShipCountry"),GetSess("Shipcountry")
DoField getlang("LangDeliverydate"),getsess("deliverydate")
DoField getlang("LangDeliverytime"),getsess("deliverytime")
Response.write ""
end if
end sub
'
Sub DoField (fieldname,fieldvalue)
if fieldvalue="" or isNull(fieldvalue) then
exit sub
end if
Response.write ForderFieldRow
Response.write ForderFieldLeft & fieldname & ForderFieldLeftEnd
Response.write FOrderFieldRight & fieldvalue & ForderfieldRightEnd
end sub
Sub DoHeader (mytext)
Response.write FOrderRow
Response.write FOrderHeaderColumnNoSpan & mytext & ForderHeaderColumnEnd
Response.write FOrderHeaderColumnNoSpan & ""
shopbutton Getconfig("xbuttonedit"),getlang("langcommonedit"),"editcustomer"
response.write " "
Response.write ForderRowEnd
end sub
Sub GetCompanyInfo
dim dbc
OpenOrderDB dbc ' Open the database
Dim rsus
Set rsus = Server.CreateObject ("ADODB.Recordset")
rsus.Open "mycompany", dbc, adOpenForwardOnly,adLockReadOnly, adCmdTable
if rsus.eof then
rsus.close
set rsus=nothing
shopclosedatabase dbc
exit sub
end if
response.write "
" & rsus("companyname") & "
"
response.write rsus("address")& "
"
response.write rsus("city") & " " & rsus("state") & " " & rsus("postalcode") & "
"
Response.write rsus("country") & "
"
response.write getlang("LangCustPhone") & ": " & rsus("phonenumber") & "
"
Response.write getlang("LangCustFax") & ": " & rsus("faxnumber") & "
"
response.write getlang("LangCustEmail") & ": " & rsus("myemail") & "
"
'VP-ASP 6.50 - show extra information
if rsus("other1") > "" then
response.write rsus("other1") & "
"
end if
if rsus("other2") > "" then
response.write rsus("other2") & "
"
end if
if rsus("other3") > "" then
response.write rsus("other3") & "
"
end if
if rsus("other4") > "" then
response.write rsus("other4") & "
"
end if
response.write "
"
rsus.close
set rsus=nothing
ShopCloseDatabase dbc ' Close the database
End Sub
%>