%@ Language=VBScript %>
<%
'*************************************************************************
' DO NOT MODIFY THIS SCRIPT IF YOU WANT UPDATES TO WORK!
' Function : This script handles all the shopping cart functions namely...
' : - Add item to cart
' : - Delete item from shopping cart
' : - Recalculate shopping cart totals
' : - View shopping cart
' 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 action 'What type of action the script must take
dim errorMsg 'Error message when adding, deleting, updating
dim errorMsgDisc 'Error message when updating order discount
dim f, i 'Indexes
dim newQuantity 'New item quantity (used when updating qty)
dim oldQuantity 'Old Item quantity (used when updating qty)
dim cartMsg 'Message that will be display on the cart
'cartHead
dim discCode
dim discPerc
dim discTotal
'cartRows
dim IDCartRow
dim IDProduct
dim SKU
dim quantity
dim unitPrice
dim unitWeight
dim description
dim taxExempt
dim discAmt
'cartRowsOptions
dim idOption
dim optionPrice
dim optionWeight
dim optionDescrip
dim optionTaxExempt
'products
dim stock
'optionsGroups
dim optionType
'options
dim priceToAdd
dim percToAdd
'DiscOrder
dim idDiscOrder
dim discFromAmt
dim discToAmt
'DiscProd
dim idDiscProd
dim discFromQty
dim discToQty
'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()
'Determine Action to be taken
action = lCase(Request.Form("action"))
if len(action) = 0 then
action = lCase(Request.QueryString("action"))
end if
'Add item to cart
if action = "additem" then
addItem()
else
'Check that the session is still active
if isNull(idOrder) then
errorMsg = langErrCartEmpty
else
'Delete item from cart
if action = "delitem" then
delItem()
end if
'Recalculate cart totals
if action = "recalc" then
reCalc()
end if
end if
end if
'Check for errors after updates
if len(trim(errorMsg)) <> 0 then
response.redirect "sysMsg.asp?errMsg=" & server.URLEncode(errorMsg)
end if
'Check that the cart still has at least 1 item after updates
if cartQty(idOrder) = 0 then
response.redirect "sysMsg.asp?errMsg=" & server.URLEncode(langErrCartEmpty)
end if
'If any updates were made to the order, re-check and re-calculate
'the Order Discount.
if action = "additem" or action = "delitem" or action = "recalc" then
orderDisc()
end if
'Redirect back to product page immediately after add...
'if action = "additem" then
' Response.Redirect "prodView.asp?idProduct=" & idProduct
'end if
%>
<%
'Close Database Connection
call closeDb()
'*************************************************************************
' Add item to cart
'*************************************************************************
sub addItem()
'Declare variables local to this subroutine
dim reqOptSel 'Used when checking for "required" options
dim arrOptions 'Array - Options from FORM - ID
dim arrOptionsTXT 'Array - Options from FORM - Text Input
dim arrOptionsDB 'Array - Options in DB - ID
dim arrOptionsDBTXT 'Array - Options in DB - Description
'Validate Product ID
IDProduct = Request.Form("idProduct")
if len(IDProduct) = 0 then
IDProduct = Request.QueryString("idProduct")
end if
if not isNumeric(IDProduct) then
errorMsg = langErrInvProdID
exit sub
end if
'Get Product info from the database
mySQL = "SELECT description,price,sku,stock,weight,taxExempt " _
& "FROM products " _
& "WHERE idProduct = " & validSQL(IDProduct,"I") & " " _
& "AND active = -1"
set rsTemp = openRSexecute(mySQL)
if rstemp.eof then
errorMsg = langErrInvProdID
exit sub
else
Description = rstemp("description")
unitPrice = rstemp("price")
SKU = rstemp("sku")
stock = rstemp("stock")
unitWeight = rstemp("weight")
taxExempt = UCase(trim(rstemp("taxExempt")))
end if
call closeRS(rsTemp)
'Validate Quantity
Quantity = Request.Form("quantity")
if len(Quantity) = 0 then
Quantity = 1
end if
if not quantityValid(quantity,stock,idProduct) then
exit sub
end if
'Check if new qty plus existing qty exceeds max for cart
if Quantity + cartQty(idOrder) > pMaxCartQty then
errorMsg = langErrMaxOrdQty
exit sub
end if
'Check that mandatory options were selected
for each f in Request.Form
if lCase(left(f,11)) = "reqidoption" then
if Request.Form(f) = "Y" then
optionType = Request.Form("TYP" & mid(f,4))
if (optionType = "S" and Request.Form("OPT" & mid(f,4)) = "") _
or (optionType = "R" and Request.Form("OPT" & mid(f,4)) = "") _
or (optionType = "T" and Request.Form("TXT" & mid(f,4)) = "") then
errorMsg = langErrReqOpt & "'" & Request.Form("DES" & mid(f,4)) & "'."
exit sub
end if
end if
end if
next
'Get selected options and place them in arrays for later use
arrOptions = ""
arrOptionsTXT = ""
for each f in Request.Form
if lCase(left(f,11)) = "optidoption" then
'Create an array of selected option ID's and another array of user entered text
optionType = Request.Form("TYP" & mid(f,4))
if isNumeric(Request.Form(f)) _
and (optionType = "S" _
or optionType = "R" _
or (optionType = "T" and Request.Form("TXT" & mid(f,4)) <> "")) then
'Append delimiter to array string
if len(arrOptions) > 0 then
arrOptions = arrOptions & "*,*"
arrOptionsTXT = arrOptionsTXT & "*,*"
end if
'Append values to array string.
arrOptions = arrOptions & Request.Form(f)
if len(trim(Request.Form("TXT" & mid(f,4)))) = 0 then
arrOptionsTXT = arrOptionsTXT & " " 'Prevent empty array
else
arrOptionsTXT = arrOptionsTXT & validHTML(Request.Form("DES" & mid(f,4))) & " : " & validHTML(Request.Form("TXT" & mid(f,4)))
end if
end if
end if
next
arrOptions = split(arrOptions ,"*,*")
arrOptionsTXT = split(arrOptionsTXT,"*,*")
'Notes :
'1. To allow the use of BeginTrans and CommitTrans, the cursor
' location must be on the client (adUseClient).
'2. To retrieve the @@identity (AutoNumber) value of the inserted
' record, the cursor location must be on the server.
'Set CursorLocation of the Connection Object to Client
connTemp.CursorLocation = adUseClient
'BEGIN Transaction
connTemp.BeginTrans
'If no cart exists, create new cart and session.
if isNull(idOrder) then
set rsTemp = openRSopen("cartHead",adUseServer,adOpenKeySet,adLockOptimistic,adCmdTable,0)
rsTemp.AddNew
'Update standard fields
rsTemp("idCust") = 0
rsTemp("orderDate") = currDateTime("DT",timeOffSet)
rsTemp("orderDateInt") = dateInt(currDateTime("DT",timeOffSet))
rsTemp("orderStatus") = "U"
rsTemp("auditInfo") = Request.ServerVariables("REMOTE_ADDR") & "|" & Request.ServerVariables("REMOTE_USER")
'Update Private Comments field
if trim(session(storeID & "privateComments")) <> "" then
rsTemp("privateComments")= trim(session(storeID & "privateComments")&"") & chr(10)
end if
'Update Affiliate fields
if isNumeric(session(storeID & "idAffiliate")) _
and isNumeric(session(storeID & "commPerc")) _
and trim(session(storeID & "idAffiliate")) <> "" _
and trim(session(storeID & "commPerc")) <> "" then
rsTemp("idAffiliate") = CInt(session(storeID & "idAffiliate"))
rsTemp("commPerc") = CDbl(session(storeID & "commPerc"))
end if
rsTemp.Update
'Put order ID into session object
session(storeID & "idOrder") = rsTemp("idOrder") '@@identity
idOrder = rsTemp("idOrder")
call closeRS(rsTemp)
end if
'Check if item is already in the cart
IDCartRow = 0
mySQL = "SELECT idCartRow,Quantity " _
& "FROM cartRows " _
& "WHERE idOrder = " & validSQL(idOrder,"I") & " " _
& "AND idProduct = " & validSQL(idProduct,"I")
set rsTemp = openRSexecute(mySQL)
do while not rstemp.eof
'Get current options and create DB option arrays.
mySQL = "SELECT idOption,optionDescrip " _
& "FROM cartRowsOptions " _
& "WHERE idCartRow = " & rstemp("idCartRow")
set rsTemp2 = openRSexecute(mySQL)
arrOptionsDB = ""
arrOptionsDBTXT = ""
do while not rstemp2.eof
if len(arrOptionsDB) = 0 then
arrOptionsDB = rstemp2("idOption")
arrOptionsDBTXT = rstemp2("optionDescrip")
else
arrOptionsDB = arrOptionsDB & "*,*" & rstemp2("idOption")
arrOptionsDBTXT = arrOptionsDBTXT & "*,*" & rstemp2("optionDescrip")
end if
rstemp2.movenext
loop
call closeRS(rsTemp2)
arrOptionsDB = split(arrOptionsDB,"*,*")
arrOptionsDBTXT = split(arrOptionsDBTXT,"*,*")
'Check if Form option arrays and DB option arrays are a match.
if UBound(arrOptions) = UBound(arrOptionsDB) then
for i = 0 to Ubound(arrOptions)
if checkArrayMatch(arrOptions(i),arrOptionsDB) then
if len(trim(arrOptionsTXT(i))) > 0 then
if not checkArrayMatch(arrOptionsTXT(i),arrOptionsDBTXT) then
exit for 'NO MATCH - Text
end if
end if
else
exit for 'NO MATCH - ID
end if
next
if UBound(arrOptions) = i-1 then 'MATCHED
oldQuantity = rstemp("quantity")
IDCartRow = rstemp("idCartRow")
exit do
end if
end if
'Get next Row
rsTemp.movenext
loop
call closeRS(rsTemp)
'INSERT new row
if IDCartRow = 0 then
'Check if item qualifies for discount
call getItemDiscount(idProduct,Quantity,unitPrice)
'INSERT CartRows
set rsTemp = openRSopen("cartRows",adUseServer,adOpenKeySet,adLockOptimistic,adCmdTable,0)
rsTemp.AddNew
rsTemp("idOrder") = idOrder
rsTemp("idProduct") = IDProduct
rsTemp("sku") = SKU
rsTemp("quantity") = Quantity
rsTemp("unitPrice") = unitPrice
rsTemp("unitWeight") = unitWeight
rsTemp("description")= Description
rsTemp("taxExempt") = taxExempt
rsTemp("idDiscProd") = idDiscProd
rsTemp("discAmt") = discAmt
rsTemp.Update
IDCartRow = rsTemp("idCartRow") 'Return @@identity
call closeRS(rsTemp)
'INSERT CartRowsOptions
for f = LBound(arrOptions) to UBound(arrOptions)
'If the user entered any text for an option, we assign
'the user's text input to the option description, else
'we assign the option description located in the database.
if len(trim(arrOptionsTXT(f))) > 0 then
optionDescrip = "'" & left(validSQL(arrOptionsTXT(f),"A"),250) & "'"
else
optionDescrip = "optionDescrip"
end if
'Get Option Price and Percentage
mySQL="SELECT priceToAdd, percToAdd " _
& "FROM options " _
& "WHERE idOption = " & validSQL(arrOptions(f),"I")
set rsTemp = openRSexecute(mySQL)
if not rsTemp.eof then
priceToAdd = getOptionPrice(rsTemp("priceToAdd"),rsTemp("percToAdd"),unitPrice)
else
priceToAdd = 0
end if
call closeRS(rsTemp)
'Update cartRowsOptions
mySQL = "INSERT INTO cartRowsOptions (" _
& "idOrder,idCartRow,idOption,optionPrice," _
& "optionDescrip,optionWeight,taxExempt) " _
& "SELECT " & validSQL(idOrder,"I") & "," _
& validSQL(idCartRow,"I") & "," _
& validSQL(arrOptions(f),"I") & "," _
& validSQL(priceToAdd,"D") & "," _
& optionDescrip & "," _
& "weightToAdd," _
& "taxExempt " _
& "FROM options " _
& "WHERE idOption = " & validSQL(arrOptions(f),"I")
set rsTemp = openRSexecute(mySQL)
call closeRS(rsTemp)
next
'UPDATE existing row
else
'Calculate new quantity
newQuantity = oldQuantity + Quantity
'Check if item qualifies for discount
call getItemDiscount(idProduct,newQuantity,unitPrice)
'Adjust Discount ID for the SQL statement
if isNull(idDiscProd) then
idDiscProd = "NULL"
end if
'Validate quantity again
if not quantityValid(newQuantity,stock,idProduct) then
connTemp.RollBackTrans
exit sub
end if
'UPDATE cartRows
mySQL = "UPDATE cartRows " _
& "SET quantity = " & validSQL(newQuantity,"I") & ", " _
& " discAmt = " & validSQL(discAmt,"D") & ", " _
& " idDiscProd = " & validSQL(idDiscProd,"I") & " " _
& "WHERE idCartRow = " & validSQL(idCartRow,"I")
set rsTemp = openRSexecute(mySQL)
call closeRS(rsTemp)
end if
'END Transaction
connTemp.CommitTrans
'Set CursorLocation of the Connection Object back to Server
connTemp.CursorLocation = adUseServer
end sub
'*************************************************************************
' Remove item from cart
'*************************************************************************
sub delItem()
'Get cart row to delete
IDCartRow = Request.QueryString("idCartRow")
'CartRow was not specified or invalid
if len(IDCartRow) = 0 or not isNumeric(IDCartRow) then
errorMsg = langErrItemDelete
exit sub
end if
'Set CursorLocation of the Connection Object to Client
connTemp.CursorLocation = adUseClient
'BEGIN Transaction
connTemp.BeginTrans
'Remove from cartRowsOptions
mySQL = "DELETE FROM cartRowsOptions " _
& "WHERE idCartRow = " & validSQL(idCartRow,"I") & " " _
& "AND idOrder = " & validSQL(idOrder,"I")
set rsTemp = openRSexecute(mySQL)
call closeRS(rsTemp)
'Remove from cartRows
mySQL = "DELETE FROM cartRows " _
& "WHERE idCartRow = " & validSQL(idCartRow,"I") & " " _
& "AND idOrder = " & validSQL(idOrder,"I")
set rsTemp = openRSexecute(mySQL)
call closeRS(rsTemp)
'END Transaction
connTemp.CommitTrans
'Set CursorLocation of the Connection Object back to Server
connTemp.CursorLocation = adUseServer
end sub
'*************************************************************************
' Update item quantity
' Update item discounts
' Update order discount code
'*************************************************************************
sub reCalc()
'Check if cart has items
if cartQty(idOrder) = 0 then
errorMsg = langErrCartEmpty
exit sub
end if
'Check if new qty plus existing qty exceeds max for cart
for each f in Request.Form
if lcase(left(f,4)) = "iqty" and isNumeric(Request.Form(f)) then
newQuantity = newQuantity + CLng(Request.Form(f))
end if
next
if newQuantity > pMaxCartQty then
errorMsg = langErrMaxOrdQty
exit sub
end if
'Set CursorLocation of the Connection Object to Client
connTemp.CursorLocation = adUseClient
'BEGIN Transaction
connTemp.BeginTrans
'Check the cart in order to identify wich rows have new quantity
mySQL = "SELECT idCartRow,idProduct,quantity,unitPrice " _
& "FROM cartRows " _
& "WHERE idOrder = " & validSQL(idOrder,"I")
set rsTemp = openRSexecute(mySQL)
do while not rstemp.eof
'Identify which row to update
if Request.Form("iQty" & rstemp("idCartRow")) <> rstemp("quantity") then
IDCartRow = rstemp("idCartRow")
IDProduct = rstemp("idProduct")
newQuantity = Request.Form("iQty" & rstemp("idCartRow"))
unitPrice = rsTemp("unitPrice")
'Validate Quantity
if not quantityValid(newQuantity,stock,idProduct) then
connTemp.RollBackTrans
exit sub
end if
'Check if item qualifies for discount
call getItemDiscount(idProduct,newQuantity,unitPrice)
'Adjust Discount ID for the SQL statement
if isNull(idDiscProd) then
idDiscProd = "NULL"
end if
'Update cart quantity and discount info
mySQL = "UPDATE cartRows " _
& "SET quantity = " & validSQL(newQuantity,"I") & ", " _
& " discAmt = " & validSQL(discAmt,"D") & ", " _
& " idDiscProd = " & validSQL(idDiscProd,"I") & " " _
& "WHERE idCartRow = " & validSQL(idCartRow,"I")
set rsTemp2 = openRSexecute(mySQL)
call closeRS(rsTemp2)
end if
rstemp.movenext
loop
call closeRS(rsTemp)
'Update the discount code with whatever was entered on the form,
'and reset the discPerc to null or 0. The validity of the
'discount code in relation to this particular order is checked
'later via a common routine that is called every time ANY type
'of update to the order is made.
'Get Discount Code from Form
discCode = validHTML(Request.Form("discCode"))
'Update cartHead
if len(discCode)=0 or isNull(discCode) then
call updateOrderDisc(idOrder,"","")
else
call updateOrderDisc(idOrder,discCode,0)
end if
'END Transaction
connTemp.CommitTrans
'Set CursorLocation of the Connection Object back to Server
connTemp.CursorLocation = adUseServer
end sub
'*************************************************************************
' Validate Discount Code
' Update as required
'*************************************************************************
sub orderDisc()
'Declare variables local to this subroutine
dim discDateInt 'Date in internal integer format
dim discTotal 'Order discount total amount
dim Total 'Order total minus order discount
'Retrieve discount code from cart header
mySQL = "SELECT discCode " _
& "FROM cartHead " _
& "WHERE idOrder = " & validSQL(idOrder,"I")
set rsTemp = openRSexecute(mySQL)
if rsTemp.EOF then
errorMsgDisc = langErrInvOrder
exit sub
else
if isNull(rsTemp("discCode")) then
discCode = ""
else
discCode = rsTemp("discCode")
end if
end if
call closeRS(rsTemp)
'If no discount code is available, update discount info to
'nulls just to be safe, and exit this routine.
if discCode = "" then
call updateOrderDisc(idOrder,"","")
exit sub
end if
'Get current date in internal integer format so we can compare
'it to the date range on the order discount file.
dim tmpNow
tmpNow = currDateTime("DT",timeOffSet)
discDateInt = "" _
& year(tmpNow) _
& left("00",2-len(datePart("m",tmpNow))) & datePart("m",tmpNow) _
& left("00",2-len(datePart("d",tmpNow))) & datePart("d",tmpNow)
'Check if discount code is valid, and still active
mySQL="SELECT discCode,discPerc,discAmt,discFromAmt,discToAmt " _
& "FROM discOrder " _
& "WHERE discCode = '" & validSQL(discCode,"A") & "' " _
& "AND discStatus = 'A' " _
& "AND discValidFrom <= '" & validSQL(discDateInt,"A") & "' " _
& "AND discValidTo >= '" & validSQL(discDateInt,"A") & "' " _
& "ORDER BY idDiscOrder "
set rsTemp = openRSexecute(mySQL)
if rsTemp.EOF then
errorMsgDisc = langErrInvDiscCode
call updateOrderDisc(idOrder,discCode,0)
exit sub
else
discPerc = rsTemp("discPerc")
discAmt = rsTemp("discAmt")
discFromAmt = rsTemp("discFromAmt")
discToAmt = rsTemp("discToAmt")
end if
call closeRS(rsTemp)
'Calculate order total (minus the order discount)
Total = cartTotalExDisc(idOrder,0)
'Compare order total to order total range on order discount file
if Total < discFromAmt or Total > discToAmt then
errorMsgDisc = langErrInvDiscAmt1 _
& pCurrencySign & moneyS(discFromAmt) & " - " _
& pCurrencySign & moneyS(discToAmt) '& langErrInvDiscAmt2
call updateOrderDisc(idOrder,discCode,0)
exit sub
end if
'If the order discount is NOT based on a percentage, but a fixed
'amount, calculate the fixed amount as a percentage of the order.
if not isNull(discAmt) then
discPerc = (discAmt / Total) * 100
end if
'Just in case the percentages are out of bounds after calculations
if discPerc < 0 then
discPerc = 0
end if
if discPerc > 100 then
discPerc = 100
end if
'If we made it this far everything is OK, so we update the cart
'header with the discount percentage for the discount code. Note
'that the order discount total (discTotal) is not updated here,
'but later during the checkout process along with all the other
'totals.
call updateOrderDisc(idOrder,discCode,discPerc)
end sub
'**********************************************************************
'Main Shopping Cart Display Area
'**********************************************************************
sub cartMain()
'Declare variables local to this subroutine
dim discTotal 'Order discount amount
dim optTotal 'Total for item's options (per item)
dim itemTotal 'Total per item including options and item discounts
dim Total 'Total for order
%>
<%=langGenShoppingCart%>
<% 'Continue Shopping Button
idProduct = Request("idProduct")
if len(idProduct) > 0 and isNumeric(idProduct) then %>
<% else %>
<% end if %>
<%
'Show cart message from database
mySQL = "SELECT configValLong " _
& "FROM storeAdmin " _
& "WHERE configVar='cartMsg' " _
& "AND adminType='T'"
set rsTemp = openRSexecute(mySQL)
if not rstemp.eof then
%>
<%=trim(rsTemp("configValLong"))%>
<%
end if
call closeRS(rsTemp)
end sub
'*************************************************************************
'Scan Array for possible match
'*************************************************************************
function checkArrayMatch(tempStr, array1)
dim i
checkArrayMatch = false
tempStr = Lcase(CStr(tempStr))
for i = 0 to Ubound(array1)
if LCase(CStr(array1(i))) = tempStr then
checkArrayMatch = true
exit for
end if
next
end function
'*************************************************************************
'Get item's discount ID and amount.
'Assign the ID and amount to variables with page level scope so
'that they can be used outside the function.
'*************************************************************************
function getItemDiscount(idProduct,itemQty,itemPrice)
dim rsTemp
'Initialize External variables
idDiscProd = null
discAmt = 0.00
'Check Parameters
if not isNumeric(idProduct) _
or not isNumeric(itemQty) _
or not isNumeric(itemPrice) then
exit function
end if
'Check database for possible discount
mySQL = "SELECT idDiscProd,discAmt,discPerc " _
& "FROM DiscProd " _
& "WHERE idProduct = " & validSQL(idProduct,"I") & " " _
& "AND " & validSQL(itemQty,"D") & " >= discFromQty " _
& "AND " & validSQL(itemQty,"D") & " <= discToQty "
set rsTemp = openRSexecute(mySQL)
if not rsTemp.EOF then
idDiscProd = rsTemp("idDiscProd")
'If the product discount is a fixed amount, we simply apply
'the amount, otherwise we calculate the discount based on a
'percentage and move the result to the discount amount field.
if isNull(rsTemp("discPerc")) then
discAmt = rsTemp("discAmt")
else
discAmt = Round(((itemPrice * rsTemp("discPerc")) / 100),2)
end if
end if
call closeRS(rsTemp)
end function
'*************************************************************************
'Update order discount information on cartHead
'Note : Order discount total (discTotal) is updated later along with
' : all the other order totals.
'*************************************************************************
function updateOrderDisc(idOrder,discCode,discPerc)
dim rsTemp
'Check Order ID
if len(idOrder)=0 or not isNumeric(idOrder) then
exit function
end if
'Check parameters and update accordingly
if (len(discCode) = 0 or isNull(discCode)) _
or (len(discPerc) = 0 or not isNumeric(discPerc)) then
mySQL = "UPDATE cartHead " _
& "SET discCode = null, " _
& " discPerc = null, " _
& " discTotal = null " _
& "WHERE idOrder = " & validSQL(idOrder,"I")
else
mySQL = "UPDATE cartHead " _
& "SET discCode = '" & validSQL(discCode,"A") & "', " _
& " discPerc = " & validSQL(discPerc,"D") & ", " _
& " discTotal = null " _
& "WHERE idOrder = " & validSQL(idOrder,"I")
end if
'Update Order Discount info on cartHead
set rsTemp = openRSexecute(mySQL)
call closeRS(rsTemp)
end function
'*************************************************************************
'Validate item quantity
'*************************************************************************
function quantityValid(quantity,stock,idProduct)
dim rsTemp
'Initialize
quantityValid = false
'Check for numeric
if not IsNumeric(Quantity) then
errorMsg = langErrInvQty
exit function
end if
'Check > 0
if CLng(Quantity) <= 0 then
errorMsg = langErrInvQty
exit function
end if
'Check max quantity per product
if CLng(Quantity) > pMaxItemQty then
errorMsg = langErrMaxItemQty & pMaxItemQty & "."
exit function
end if
'Check quantity against available stock if stock level checking
'is enabled.
if pHideAddStockLevel <> -1 then
if isNumeric(stock) and not(isEmpty(stock) or isNull(stock)) then
if CLng(Quantity) > CLng(Stock) then
errorMsg = langErrNoStock
exit function
end if
else
if isNumeric(idProduct) and not(isEmpty(idProduct) or isNull(idProduct)) then
mySQL = "SELECT stock " _
& "FROM products " _
& "WHERE idProduct = " & validSQL(idProduct,"I")
set rsTemp = openRSexecute(mySQL)
if CLng(Quantity) > CLng(rsTemp("stock")) then
errorMsg = langErrNoStock
exit function
end if
call closeRS(rsTemp)
end if
end if
end if
'Return
quantityValid = true
end function
'*************************************************************************
'Determine number of available Order Discounts
'*************************************************************************
function numOrdDisc()
dim rsTemp
mySQL = "SELECT COUNT(*) AS numOrdDisc " _
& "FROM discOrder " _
& "WHERE discStatus = 'A' "
set rsTemp = openRSexecute(mySQL)
numOrdDisc = rsTemp("numOrdDisc")
call closeRS(rsTemp)
end function
%>