<%@ Language=VBScript %>
<%
'*************************************************************************
' DO NOT MODIFY THIS SCRIPT IF YOU WANT UPDATES TO WORK!
' Function : Get shipping info, payment info
' Product : CandyPress Store Frontend
' Version : 2.5
' Modified : February 2004
' Copyright: Copyright (C) 2004 CandyPress.Com
' See "license.txt" for this product for details regarding
' licensing, usage, disclaimers, distribution and general
' copyright requirements. If you don't have a copy of this
' file, you may request one at webmaster@candypress.com
'*************************************************************************
Option explicit
Response.Buffer = true
%>
<%
'Work fields
dim i, f 'Indexes
dim pCCTypeArr 'Array of Valid Credit Card Types
dim arrayErrors 'Array of errors on the form (if any)
dim shipDetails
dim shipError
dim paymentRequired
dim formID
'Customer
dim locState
dim locCountry
dim zip
dim city
dim shippingLocState
dim shippingLocCountry
dim shippingZip
dim shippingCity
'cartHead
dim subTotal
dim taxTotal
dim shipmentTotal
dim handlingFeeTotal
dim otherFeeTotal
dim Total
dim shipmentMethod
dim paymentType
dim cardType
dim cardNumber
dim cardExpMonth
dim cardExpYear
dim cardName
dim cardVerify
dim generalComments
dim storeCommentsPriv
dim parcelas
'shipRates
dim locShipZone
'Database
dim mySQL
dim conntemp
dim rstemp
dim rstemp2
'Session
dim idOrder
dim idCust
'*************************************************************************
'Open Database Connection
call openDb()
'Store Configuration
if loadConfig() = false then
call errorDB(langErrConfig,"")
end if
'Get/Set Cart/Order Session
idOrder = sessionCart()
'Get/Set Customer Session
idCust = sessionCust()
'Check if the session is still active
if isNull(idOrder) then
response.redirect "sysMsg.asp?errMsg=" & server.URLEncode(langErrCartEmpty)
end if
'Check if cart has any items
if cartQty(idOrder) = 0 then
response.redirect "sysMsg.asp?errMsg=" & server.URLEncode(langErrCartEmpty)
end if
'Check if minimum order amount has been met
if cartTotal(idOrder,0) < pMinCartAmount then
response.redirect "sysMsg.asp?errMsg=" & server.URLEncode(langErrMinPrice & pCurrencySign & moneyS(pMinCartAmount))
end if
'Double-check that the Customer is logged on
if isNull(idCust) then
response.redirect "sysMsg.asp?errMsg=" & server.URLEncode(langErrNotLoggedIn)
end if
'Get Form ID
formID = trim(Request.Form("formID"))
'Before we display the form for the first time, do some checks
if formID = "" then
'Retrieve all available fields from DB
mySQL="SELECT a.shipmentMethod,a.shipmentTotal,a.cardType," _
& " a.cardNumber,a.cardExpMonth,a.cardExpYear,a.cardName," _
& " a.cardVerify,a.generalComments,b.paymentType " _
& "FROM cartHead a, customer b " _
& "WHERE a.idOrder = " & validSQL(idOrder,"I") & " " _
& "AND b.idCust = " & validSQL(idCust,"I") & " "
set rsTemp = openRSexecute(mySQL)
if not rstemp.eof then
shipmentMethod = trim(rstemp("shipmentMethod")&"")
shipmentTotal = trim(rstemp("shipmentTotal")&"")
shipDetails = shipmentTotal & "|" & shipmentMethod
paymentType = trim(rstemp("paymentType")&"")
cardType = trim(rstemp("cardType")&"")
cardNumber = trim(EnDeCrypt(Hex2Ascii(rstemp("cardNumber")),rc4Key)&"")
cardExpMonth = trim(rstemp("cardExpMonth")&"")
cardExpYear = trim(rstemp("cardExpYear")&"")
cardName = trim(rstemp("cardName")&"")
cardVerify = trim(rstemp("cardVerify")&"")
generalComments = trim(rstemp("generalComments")&"")
else
'No cartHead Record on DB (which is highly unlikely because
'cartHead record has already been tested in sessionCart()
'at the beginning of this script).
response.redirect "sysMsg.asp?errMsg=" & server.URLEncode(langErrInvOrder)
end if
call closeRS(rsTemp)
end if
'Check if the Customer clicked the "Next" button
if formID = "02" then
'Get values from the calling form
shipDetails = validHTML(request.form("shipDetails"))
if inStr(shipDetails,"|") > 0 then
shipmentTotal = mid(shipDetails,1,instr(shipDetails,"|")-1)
shipmentMethod = mid(shipDetails,instr(shipDetails,"|")+1)
else
shipmentTotal = ""
shipmentMethod = ""
end if
handlingFeeTotal = validHTML(request.form("handlingFeeTotal"))
paymentRequired = validHTML(request.form("paymentRequired"))
paymentType = validHTML(request.form("paymentType"))
cardType = validHTML(request.form("cardType"))
cardNumber = validHTML(request.form("cardNumber"))
cardExpMonth = validHTML(request.form("cardExpMonth"))
cardExpYear = validHTML(request.form("cardExpYear"))
cardName = validHTML(request.form("cardName"))
cardVerify = validHTML(request.form("cardVerify"))
generalComments = validHTML(request.form("generalComments"))
parcelas = validHTML(request.form("parcelas"))
'Validate Shipping
if len(shipmentTotal) = 0 or not isNumeric(shipmentTotal) then
arrayErrors = arrayErrors & "|shipDetails"
end if
if len(shipmentMethod) = 0 then
arrayErrors = arrayErrors & "|shipDetails"
end if
'Validate Handling Fee
if len(handlingFeeTotal) = 0 or not isNumeric(handlingFeeTotal) then
arrayErrors = arrayErrors & "|handlingFeeTotal"
end if
'Validate Credit Card Info (if Required for this Order)
if lCase(paymentType) = "creditcard" and paymentRequired = "Y" then
'Card Type
if len(cardType) = 0 then
arrayErrors = arrayErrors & "|cardType"
end if
'Card Number
if not isCreditCard(cardNumber) then
arrayErrors = arrayErrors & "|cardNumber"
end if
'Card Month
if isEmpty(cardExpMonth) or not isNumeric(cardExpMonth) then
arrayErrors = arrayErrors & "|cardExpMonth"
end if
'Card Year
if isEmpty(cardExpYear)or not isNumeric(cardExpYear) then
arrayErrors = arrayErrors & "|cardExpYear"
end if
'Card Month + Year not expired
if not isDate(cardExpMonth & "/01/" & cardExpYear) then
arrayErrors = arrayErrors & "|cardExpMonth"
arrayErrors = arrayErrors & "|cardExpYear"
else
if date() > CCExpires(cardExpMonth,cardExpYear) then
arrayErrors = arrayErrors & "|cardExpMonth"
arrayErrors = arrayErrors & "|cardExpYear"
end if
end if
'Card Name
if len(cardName) = 0 then
arrayErrors = arrayErrors & "|cardName"
end if
'Número de Parcelas
if len(parcelas) = 0 then
arrayErrors = arrayErrors & "|parcelas"
end if
end if
'Validate Comments
if len(generalComments) > 250 then
arrayErrors = arrayErrors & "|generalComments"
end if
'There were no errors
if len(trim(arrayErrors)) = 0 then
'Update Shopping Cart on DB
mySQL = "UPDATE cartHead SET " _
& "shipmentMethod = '" & validSQL(shipmentMethod,"A") & "', " _
& "shipmentTotal = " & validSQL(shipmentTotal,"D") & ", " _
& "handlingFeeTotal = " & validSQL(handlingFeeTotal,"D") & ", " _
& "otherFeeTotal = " & validSQL(getPaymentFee(paymentType),"D") & ", " _
& "paymentType = '" & validSQL(paymentType,"A") & "', " _
& "cardType = '" & validSQL(cardType,"A") & "', " _
& "cardNumber = '" & validSQL(Ascii2Hex(EnDeCrypt(cardNumber,rc4Key)),"A") & "', " _
& "cardExpMonth = '" & validSQL(cardExpMonth,"A") & "', " _
& "cardExpYear = '" & validSQL(cardExpYear,"A") & "', " _
& "cardName = '" & validSQL(cardName,"A") & "', " _
& "cardVerify = '" & validSQL(cardVerify,"A") & "', " _
& "storeCommentsPriv = '" & validSQL(parcelas,"A") & "', " _
& "generalComments = '" & validSQL(generalComments,"A") & "' " _
& "WHERE idOrder = " & validSQL(idOrder,"I")
set rsTemp = openRSexecute(mySQL)
call closeRS(rsTemp)
'Onto next page
Response.Redirect "40_SubmitOrder.asp"
end if
end if
'If we get this far, it's either because this script was called by
'another script, or the script called itself but failed some checks.
'------------------------
' START - SHIPPING RATES
'------------------------
'Determine Shipping Destination
mySQL = "SELECT locState,locCountry,city,zip," _
& " shippingLocState,shippingLocCountry," _
& " shippingCity,shippingZip " _
& "FROM customer " _
& "WHERE idCust = " & validSQL(idCust,"I")
set rsTemp = openRSexecute(mySQL)
if not rsTemp.eof then
locCountry = trim(rsTemp("locCountry")&"")
locState = trim(rsTemp("locState")&"")
city = trim(rsTemp("city")&"")
zip = trim(rsTemp("zip")&"")
shippingLocCountry = trim(rsTemp("shippingLocCountry")&"")
shippingLocState = trim(rsTemp("shippingLocState")&"")
shippingCity = trim(rsTemp("shippingCity")&"")
shippingZip = trim(rsTemp("shippingZip")&"")
if len(shippingLocCountry & shippingLocState) = 0 then
shippingLocCountry = locCountry
shippingLocState = locState
shippingCity = City
shippingZip = zip
end if
else
response.redirect "sysMsg.asp?errMsg=" & server.URLEncode(langErrShipLoc)
end if
call closeRS(rsTemp)
'Determine Shipping Zone
locShipZone = getShipZone(shippingLocCountry,shippingLocState)
if locShipZone = null then
response.redirect "sysMsg.asp?errMsg=" & server.URLEncode(langErrShipZone)
end if
'Determine Totals to be used when calculating shipping rates
call calcShipTotals(idOrder)
'Free Shipping
if totalShipItems = 0 or totalShipWeight = 0 then
shipArray(0,0) = 0.00
shipArray(0,1) = langGenNoShipCharge
'Calculate shipping rates
else
'Initialize shipping error session variable
session(storeID & "shipError") = ""
'Calculate Store Rates
call calcStoreRates(totalShipPrice,totalShipWeight,locShipZone)
'Calculate Realtime Rates
call calcOnlineRates(totalShipWeight,shippingLocCountry,shippingLocState,shippingZip)
'Move error (if any) to local variable for later evaluation
if session(storeID & "shipError") <> "" then
shipError = session(storeID & "shipError")
end if
session(storeID & "shipError") = null
end if
'Execute Custom shipping rates user exit
%>
<%
'Check shipping rate array
if not(validShipArray()) then
if shipError = "" then
response.redirect "sysMsg.asp?errMsg=" & server.URLEncode(langErrNoShipRate & " (P" & totalShipPrice & " W" & totalShipWeight & " Z" & locShipZone & ")")
else
response.redirect "sysMsg.asp?errMsg=" & server.URLEncode(shipError & " (P" & totalShipPrice & " W" & totalShipWeight & " Z" & locShipZone & ")")
end if
end if
'For debug purposes, write shipping data as hidden HTML
Response.Write vbCrlf & "" & vbCrlf
'------------------------
' END - SHIPPING RATES
'------------------------
'Check if Payment is required for this Order
if (cartTotal(idOrder,0) + shipArray(0,0)) > 0 then
paymentRequired = "Y"
else
paymentRequired = "N"
end if
'Determine Handling Fee
if totalShipWeight > 0 then
handlingFeeTotal = handlingFeeAmt
else
handlingFeeTotal = 0.00
end if
%>
<%
'Close Database Connection
call closedb()
'*************************************************************************
'Main Shopping Cart Display Area
'*************************************************************************
sub cartMain()
'If there were errors, show message
if len(trim(arrayErrors)) > 0 then
arrayErrors = split(LCase(arrayErrors),"|")
Response.Write "" & langErrInvForm & "
"
else
arrayErrors = array("")
end if
%>
<%
end sub
'*************************************************************************
'Check Credit Card Number (Test Number - 4111111111111111)
'*************************************************************************
function isCreditCard(cardNo)
dim lCard, lC, cStat, temp, tempChar, i, d
cardNo = trim(cardNo)
cardNo = replace(cardNo," ","")
cardNo = replace(cardNo,"-","")
if isNumeric(cardNo) then
isCreditCard = false
lCard = len(cardNo)
lC = right(cardNo,1)
cStat = 0
for i=(lCard-1) to 1 step -1
tempChar = mid(cardNo,i,1)
d = CLng(tempChar)
if lcard mod 2 = 1 then
temp = d*(1+((i+1) mod 2))
else
temp = d*(1+(i mod 2))
end if
if temp < 10 then
cStat = cStat + temp
else
cStat = cStat + temp - 9
end if
next
cStat = (10-(cStat mod 10)) mod 10
if CLng(lC) = cStat then
isCreditCard = true
end if
end if
end function
'*************************************************************************
'Get Payment fee for a particular Payment Method
'*************************************************************************
function getPaymentFee(paymentType)
select case lCase(paymentType)
case "mailin"
getPaymentFee = feeMailIn
case "callin"
getPaymentFee = feeCallIn
case "faxin"
getPaymentFee = feeFaxIn
case "cod"
getPaymentFee = feeCOD
case "creditcard"
getPaymentFee = feeOffCC
case "paypal"
getPaymentFee = feePayPal
case "2checkout"
getPaymentFee = fee2CO
case "authorizenet"
getPaymentFee = feeAuthNet
case "custom"
getPaymentFee = feeCustom
case else
getPaymentFee = 0
end select
end function
%>