<% '*********************************************************************** ' Formats shopping cart during buying process ' Version 6.50 ' Sept 4, 2004 fix remove button formatting ' add image formatting ' Oct 24, 2004, tax after discount '********************************************************************* Dim CartRemove dim pricehide Dim Carttotal Dim Cartisubtotal Dim cartshipcost Dim cartDiscount Dim cartdualcost Dim DualTotal Dim Dualshipcost Dim Dualsubtotal Dim dualdiscount Dim DualHandling Dim Minamount, maxamount Dim columnspacing dim xxdecimalpoint dim cartallowdelete pricehide = false If getconfig("XDisplayPrices")<>"Yes" then pricehide = true end if if getconfig("xpriceloggedinonly") = "Yes" then if Getsess ("login") = "" then pricehide= true end if end if Sub CartFormat (AllowDelete) CartRemove="" CartallowDelete=AllowDelete xxdecimalpoint=getconfig("xdecimalpoint") columnspacing=0 If allowdelete="TRUE" then CartRemove=getlang("langProductRemove") columnspacing=columnspacing+1 If getconfig("xdeliveryAddress")="Yes"then columnspacing=columnspacing+1 end if 'VP-ASP 6.50 - allow customers to upload images If getconfig("xcustomerimages")="Yes"then columnspacing=columnspacing+1 end if end if 'VP-ASP 6.50 - add edit link to shopcreateorder.asp If lcase(right(request.ServerVariables("SCRIPT_NAME"), len(request.ServerVariables("SCRIPT_NAME")) - instrrev(request.ServerVariables("SCRIPT_NAME"), "/"))) ="shopcreateorder.asp" then columnspacing=columnspacing+1 end if If Cartremove<>"" then 'VP-ASP 6.50 - hide gift cert option if creating registry If getsess("REGISTRANTID")<>"" Then 'no free item else CartSpecialHandling end if end if CartShipCost=GetSess("smprice") DualShipcost=GetSess("DualShipCost") CartDiscount=GetSess("Custdiscount") CartFormatTitle CartFormatProducts CartFormatProductTotal If Cartremove="" then if pricehide <> true then CartFormatShipping CartFormatHandling CartFormatDiscount CartFormatCoupon CartFormatTax CartFormatGiftCertificate CartFormatTotal end if end if 'VP-ASP 6.50 - add scroller if content too wide 'cartresponsewrite "" cartresponsewrite "" CartShippingMessage CartUPSMessage 'VP-ASP 6.08a - comment out line below as it was unneeded 'cartresponsewrite "" end sub ' '********************************************************** ' put titles above each column '******************************************************** Sub CartFormatTitle 'VP-ASP 6.50 - add scroller if content too wide 'cartresponsewrite "
" & CartTable cartresponsewrite CartTable cartresponsewrite CartRow 'VP-ASP 6.50 - add edit link to shopcreateorder.asp if lcase(right(request.ServerVariables("SCRIPT_NAME"), len(request.ServerVariables("SCRIPT_NAME")) - instrrev(request.ServerVariables("SCRIPT_NAME"), "/"))) ="shopcreateorder.asp" then DisplayTitle "10%",getlang("langcommonedit") elseif cartremove<> "" then 'if cartremove<> "" then DisplayTitle "10%",CartRemove If getconfig("XDeliveryAddress")="Yes" then DisplayTitle "10%",getlang("langDeliveryPrompt") end if end if DisplayTitle "50%",getlang("langProductDescription") 'VP-ASP 6.50 - allow customers to upload images if cartremove <> "" then If getconfig("xcustomerimages")="Yes" then DisplayTitle "10%",getlang("langupload") end if end if DisplayTitle "10%",getlang("langProductQuantity") if pricehide <> true then DisplayTitle "10%",getlang("langProductUnitPrice") DisplayTitle "10%",getlang("langProductTotal") If getconfig("xDualPrice")="Yes" then DisplayTitle "10%",getlang("langDualPrice") DisplayTitle "10%",getlang("langDualTotal") end if end if cartresponsewrite "" End sub Sub DisplayTitle (percent, titlename) response.write CartTitleColumn & TitleName & CartTitleColumnEnd end sub '**************************************************************** ' go through cart array and format values '**************************************************************** ' Sub CartFormatProducts Dim scartItem, arrCart, displayprice,catalogid, otherinfo Dim i, CartFields, image scartItem = GetSess("CartCount") arrCart = GetSessA("CartArray") if getconfig("xLCID")<>"" then Session.LCID=getconfig("xLCID") ' set user supplied LCID end if cartisubtotal = 0 For i = 1 to scartItem cartresponsewrite CartRow ''VP-ASP 6.50 - add edit link to shopcreateorder.asp if lcase(right(request.ServerVariables("SCRIPT_NAME"), len(request.ServerVariables("SCRIPT_NAME")) - instrrev(request.ServerVariables("SCRIPT_NAME"), "/"))) ="shopcreateorder.asp" then response.write "" shopbutton Getconfig("xbuttonedit"),getlang("langcommonedit"),"editcart" response.write "" elseif cartremove<> "" then 'if cartremove<> "" then AddRemoveBox i If getconfig("xdeliveryAddress")="Yes" then AddEdit i, arrCart(cDelivery,i) end if end if 'end if cartfields=arrCart(cProductname,i) catalogid=arrCart(cProductid,i) CartCreateHyperlink cartfields, catalogid image=arrCart(cProductimage,i) GetDeliveryName cartfields, arrCart(cDelivery,i) if getconfig("xcartimage")="Yes" and image<>"" then CartAddimage "50%","left", image, cartfields else AddField "50%","left", CartFontDesc & CartFields & CartFontEnd end if 'VP-ASP 6.50 - allow customers to upload images if cartremove<>"" then If getconfig("xcustomerimages")="Yes" then AddUploadLink i, arrCart(cproductid,i) end if end if otherinfo=arrCart(cotherinfo,i) Minamount=arrCart(cMinimumQuantity,i) Maxamount=arrCart(cMaximumQuantity,i) If maxamount="" then maxamount=0 If lcase(otherinfo)="static" then maxamount=1 AddQuantity i, arrCart(cQuantity,i) if pricehide <> true then displayprice= CartFontUnitPrice & shopformatcurrency(arrCart(cUnitPrice,i),xxdecimalpoint) & CartFontEnd If getconfig("xDisplayOriginalPrice")="Yes" then If arrCart(cUnitPrice,i)<> arrCart(coriginalPrice,i) then DisplayPrice =DisplayPrice & CartOriginalprice & shopformatcurrency(arrCart(coriginalPrice,i),xxdecimalpoint) & cartoriginalpriceend end if end if AddField "10%","right", DisplayPrice AddField "10%","right", CartFontPriceTotal & shopformatcurrency(arrCart(cUnitPrice,i) * arrCart(cQuantity,i),xxdecimalpoint) & CartFontEnd if getconfig("xDualPrice")="Yes" then AddField "10%","right", CartFontDualPrice & ShopFormatDualCurrency(arrCart(cDualPrice,i),2) & CartFontEnd AddField "10%","right", cartFontDualTotal & ShopFormatDualCurrency(arrCart(cDualPrice,i) * arrCart(cQuantity,i),xxdecimalpoint) & cartfontEnd dualsubtotal=dualsubtotal +(arrCart(cDualPrice,i) * arrCart(cQuantity,i)) end if end if cartisubtotal = cartisubtotal + (arrCart(cUnitPrice,i) * arrCart(cQuantity,i)) cartresponsewrite "" next SetSess "OrderTotal",cartisubtotal SetSess "OrderProductTotal",cartisubtotal SetSess "DualTotal",dualsubtotal cartTotal=cartisubtotal dualtotal=dualsubtotal end sub Sub AddField (percent, alignment, fieldvalue) %> <%=fieldvalue%> <% end sub Sub AddQuantity (i, quantity) if cartremove<>"" Then If minamount<>"" then If Minamount>0 then if getconfig("xproductminimumquantity")<>"Yes" then GenerateMinQuantityList i, quantity exit sub end if end if end if If getconfig("xcartstaticquantity")="Yes" or maxamount=1 then response.write "" & Quantity response.write "" else response.write "" end if else response.write "" & quantity & "" end if end sub Sub addRemoveBox (i) dim image, url image=getconfig("xbuttonremove") If image<>"" Then response.write "" url="shopremoveitem.asp?cartid=" & i url=addwebsess(url) response.write "" exit sub end if if getconfig("xCartRemoveChecked")="Yes" then %> <% else %> <% end if end Sub Sub addEdit (i, deliveryaddress) dim prompt, promptimage, url prompt=getlang("langDeliveryAdd") promptimage=getconfig("xbuttonaddressadd") if isarray(DeliveryAddress) then prompt=getlang("langDeliveryChange") promptimage=getconfig("xbuttonaddresschange") end if ' cartresponsewrite "" url="shopdeliveryedit.asp?id=" & i url=addwebsess(url) If promptimage="" then response.write "" & prompt & "" else Response.write "" end if cartresponsewrite "" end Sub Sub AddColumnSpacing dim i If columnspacing=0 then exit sub for i = 0 to columnspacing-1 cartresponsewrite " " next end sub Sub CartFormatProductTotal if pricehide <> false then exit sub cartresponsewrite " " AddColumnSpacing Cartresponsewrite CartSubTotalRowLeft & getlang("langProductCost") & CartTotalRowLeftEnd CartResponsewrite CartSubTotalRowRight & shopformatcurrency(cartisubtotal,xxdecimalpoint) & CartTotalRowRightEnd If getconfig("xDualPrice")="Yes" Then CartResponsewrite " " Cartresponsewrite CartSubTotalRowRight & ShopFormatDualCurrency(dualsubtotal,2) & CartTotalRowRightEnd end if cartresponsewrite "" end sub Sub CartFormatTax 'VP-ASP 6.50 - add support for handling Canadian PST Dim Taxes, dualtaxes, PST, dualpst CalculateTax cartisubtotal, carttotal, cartshipcost, Taxes, pst SetSess "taxes",taxes SetSess "pst",pst if Taxes<>"" then If Taxes<>0 then If getconfig("xDualPrice")="Yes" then ConvertCurrency taxes, dualTaxes Setsess "dualtaxes",dualtaxes dualtotal=dualtotal+dualtaxes end if CartDisplayRow getlang("langProductTax"), taxes, dualtaxes If getconfig("xtaxincludedinprice")="Yes" then cartTotal=cartTotal else cartTotal=cartTotal+taxes end if end if If PST<>0 then If getconfig("xDualPrice")="Yes" then ConvertCurrency PST, dualPST Setsess "dualPST",dualPST dualtotal=dualtotal+dualPST end if CartDisplayRow "PST", pst, dualpst If getconfig("xtaxincludedinprice")="Yes" then cartTotal=cartTotal else cartTotal=cartTotal+pst end if end if end if end sub ' Sub CartFormatHandling Dim Handling CalculateHandling cartisubtotal, carttotal, cartshipcost, Handling SetSess "Handling",handling if Handling<>"" then If Handling<>0 then If getconfig("xDualPrice")="Yes" then ConvertCurrency handling, dualHandling Setsess "dualhandling",dualhandling dualtotal=dualtotal+dualhandling end if CartDisplayRow getlang("langProductHandling"), handling, dualhandling cartTotal=cartTotal+handling end if end if end sub Sub CartFormatDiscount 'VP-ASP 6.50 - don't apply discount to gift cert purchase if getsess("Giftamount") > "" then exit sub end if ' cart discount is coming from database Dim Discount discount="" SetSess "discount",discount SetSess "dualdiscount",discount CalculateDiscount cartisubtotal, carttotal, cartshipcost, cartDiscount, discount if discount<>"" then If Discount<>0 then If getconfig("xDualPrice")="Yes" then ConvertCurrency Discount, dualdiscount dualTotal=dualTotal-dualdiscount SetSess "dualdiscount",dualdiscount end if CartDisplayRow getlang("langProductDiscount"), -Discount, -dualdiscount cartTotal=cartTotal-discount cartisubtotal=cartisubtotal-discount 'sept 9 SetSess "discount",discount end if end if end sub ' Sub CartDisplayRow (msg, amount, dualamount) cartresponsewrite " " AddColumnSpacing CartResponsewrite CartSubTotalRowLeft & msg & carttotalrowleftend Cartresponsewrite CartSubTotalRowRight & shopformatcurrency(amount,xxdecimalpoint)& carttotalrowRightend If getconfig("xdualprice")="Yes" then cartResponsewrite " " cartresponsewrite CartSubTotalRowRight & ShopFormatDualCurrency(dualamount,2) &cartTotalrowrightend end if cartresponsewrite "" end Sub Sub CartFormatShipping if cartshipcost<>"" then If cartshipcost> 0 then ConvertCurrency cartshipcost, dualshipcost SetSess "Dualshipping",dualshipcost if getsess("ShipMethodType") = "UPS Real-Time" then CartDisplayRow "UPS Shipping", cartshipcost, dualshipcost else CartDisplayRow getlang("langProductShippingCost"), cartshipcost, dualshipcost end if cartTotal=cartTotal+cartshipcost dualTotal=dualTotal+dualshipcost end if end if end sub Sub CartFormatTotal %>   <%'VP-ASP 6.50 - add edit link to shopcreateorder.asp if lcase(right(request.ServerVariables("SCRIPT_NAME"), len(request.ServerVariables("SCRIPT_NAME")) - instrrev(request.ServerVariables("SCRIPT_NAME"), "/"))) ="shopcreateorder.asp" then%>   <%end if%> <%=CartTotalRowLeft%><%=getlang("langProductTotal")%> <%'VP-ASP 6.09 - If xprice0 in use and total is zero, don't display xprice0 value%> <% dim checkForZero dim newtotal if carttotal = 0 then newtotal = getconfig("XCurrencySymbol") & formatNumber (carttotal, getconfig("xdecimalpoint")) else newtotal = shopformatcurrency(carttotal,xxdecimalpoint) end if%> <%=CartTotalRowRight%><%= newtotal %> <%'End fix%> <% If getconfig("xdualprice")="Yes" then %>   <%=CartTotalRowRight%><%= ShopFormatDualCurrency(dualtotal,2) %> <% end if cartresponsewrite "" SetSess "OrderTotal",carttotal SetSess "DualTotal",dualtotal end sub ' Sub CartFormatCoupon ' cart discount is coming from database Dim Discount, coupondiscountdual, coupon Coupon=Getsess("Coupon") if coupon="" then exit sub ApplyCoupon discount=GetSess("coupondiscount") If discount="" then exit sub if Discount <>"" then If Discount<>0 then If getconfig("xDualPrice")="Yes" then ConvertCurrency Discount, coupondiscountdual end if CartDisplayRow getlang("langCouponDiscount"), -Discount, -coupondiscountdual cartTotal=cartTotal-discount cartisubtotal=cartisubtotal-discount SetSess "coupondiscountdual",coupondiscountdual dualtotal=dualtotal-coupondiscountdual end if end if end sub ' Sub CartFormatGiftCertificate ' cart discount is coming from database Dim Discount, discountdual discount="" discount=GetSess("giftamountmax") if Discount <>"" then If Discount<>0 then discount=csng(discount) If carttotal<= discount then discount=carttotal end if setsess "Giftamountused",discount If getconfig("xDualPrice")="Yes" then ConvertCurrency Discount, discountdual end if CartDisplayRow getlang("langGiftCertificate"), -Discount, -discountdual cartTotal=cartTotal-discount SetSess "GiftAmountuseddual",discountdual dualtotal=dualtotal-discountdual If dualtotal<0 then dualtotal=0 end if end if end sub Sub CartResponseWrite (msg) if cartallowdelete="TRUE" then response.write msg exit sub end if if getconfig("Xbypasscreateorderpage")="Yes" then exit sub response.write msg end sub Sub CartShippingMessage if Getsess("shipmessage")="" then exit sub if ucase(getconfig("xshippingcalc")) = "FIXED" then exit sub If Getconfig("xgiftregistry")="Yes" and getsess(REGISTRANTID)<>"" Then exit sub Response.write "

" response.write FOrderComment & Getsess("shipmessage") & "
" & Fordercommentend response.write "

" end sub '**************************************************************** ' if an image is to be displayed we need to create a small table ' within the cell '***************************************************************** Sub CartAddimage (percent, alignment, image, cartfields) %>
<% Response.write CartFields %>
<% end sub 'VP-ASP 6.50 - allow customers to upload images Sub AddUploadLink (i, productid) dim prompt, promptimage, url if isnull(arrCart(cuploadimagerequired,i)) then arrCart(cuploadimagerequired,i)="" dim comparevalue if ucase(xdatabasetype) = "MYSQL" OR ucase(xdatabasetype) = "MYSQL351" then comparevalue = "1" else comparevalue = "true" end if if lcase(arrCart(cuploadimagerequired,i))<>comparevalue then prompt="" else if arrCart(cgraphicname1,i)<>"" then prompt=getlang("languploadchange") else prompt=getlang("langupload") end if end if promptimage="" cartresponsewrite "" url="shopcartitemfeatures.asp?productid=" & productid & "&cartid=" & i url=addwebsess(url) response.write "" & prompt & "" cartresponsewrite "" End sub '********************************************************************* ' add Hyperlink back to product Sub CartCreateHyperlink (name, catalogid) dim strmessage, strurl If getconfig("xcarthyperlink")<>"Yes" then exit sub 'VP-ASP 6.5.1 - link to parent product instead of child dim hyperdbc, hyperrs shopopendatabasep hyperdbc set hyperrs = hyperdbc.execute("select highercatalogid from products where catalogid = " & catalogid) if not hyperrs.eof then if (NOT isnull(hyperrs("highercatalogid")) OR (hyperrs("highercatalogid") > "")) then catalogid = hyperrs("highercatalogid") end if end if closerecordset hyperrs shopclosedatabase hyperdbc strurl="shopquery.asp?catalogid=" & catalogid strurl=addwebsess(strurl) strMessage="" & name & "" name=strmessage end sub Sub CartUPSMessage if getsess("ShipMethodType") = "UPS Real-Time" then %>
UPS NOTE: These fees do not necessarily represent UPS published rates and may include charges levied by the store owner.

UPS, UPS brandmark, and the Color Brown are trademarks of United Parcel Service of America, Inc. All Rights Reserved.
<% end if end sub %>