<% '*************************************************** ' Version 5.00 May 17, 2003 ' This routine is used to obtain features and display them ' Analyze features customer has selected ' add a product to the internal shopping Cart ' This routine consist of three separate parts ' CartAddItem used to add aproduct to the shopping cart ' FormatProductOptions Generates the form fields for product features ' GetProductFeatures Process the user selected features '************************************************* ' dim prodindex dim FeatureMultiSelection dim Sfeature Dim NameInCart Dim fcount Dim sSelect Dim PrevOptionNum Dim tempOption dim maxOptionNum dim strDualPrice Dim ProductPrice Dim DiscountPrice Dim OriginalPrice Dim userselectedstring dim fprefix Dim sxRequiredList, sXRequiredValue dim lngFeatureid dim featurevaluecount Dim ProductSku, Featureconn Dim requiredlist dim userselectedcount, userselected(100) dim featurequantity, strfeaturedefault '*************************************************** ' add a product to the cart. Common routine ' handles feature analysis and discounts' '***************************************************** Sub CartAddItem(id, rc) ' Return 0 if added, 4 if product does not exist ' Get from datbase and add to instorage array dim scartitem Dim arrCart Dim TotalOptionPrice dim TotaloptionDualPrice Dim Optionname Dim CartFields, ArtFieldcount ' ProductPrice=CurCPrice ' original price featurequantity="" If GetSess ("NewProductPrice")<>"" then ProductPrice=GetSess("NewProductPrice") ' created by features end if DiscountPrice=ProductPrice ' DiscountPrice OriginalPrice=ProductPrice LocateInArray id,rc ' see if we already have some if rc=0 then ' already found exit sub end if ' old method, now uses cartfields in shop$colors ' NameinCart=strcName & "
" & memCDescription ' description arrCart = GetSessA("CartArray") scartItem = GetSess("CartCount") scartitem=scartitem+1 If scartItem > clng(getconfig("xMaxCartitems") )then ResponseRedirect "shoperror.asp?msg=" & Server.URLEncode ( getlang("Langerror02")) End If arrCart(cProductid,scartItem) = lngcatalogID arrCart(cCategory,scartItem) = lngCcategory arrCart(cProductCode,scartItem) = strccode arrCart(cGroupDiscount,scartItem) = strgroupfordiscount AddCartOptions TotalOptionPrice, TotalOptionDualPrice If featurequantity<>"" then quantity=featurequantity end if CorrectMinimumquantity quantity,strminimumquantity Correctmaximumquantity quantity,strmaximumquantity CheckStockLevel quantity, lngcatalogid CalculateUserPrice ProductPrice, Quantity, DiscountPrice, arrCart, scartitem ProductPrice=DiscountPrice AddUserText ' text within product record If not IsNull(StrSpecialOffer) then NameIncart = NameInCart & "
" & strSpecialOffer end if arrCart(cProductname,scartItem) = NameInCart arrCart(cQuantity,scartItem) = quantity arrCart(cOriginalPrice,scartItem) = OriginalPrice + TotalOptionPrice arrCart(cUnitPrice,scartItem) = ProductPrice + TotaloptionPrice arrCart(cProductFeatures,scartItem) = UserSelectedString if getconfig("XdualPrice")="Yes" then If strcdualprice="" then Convertcurrency ProductPrice, strDualPrice else strdualprice=strcdualprice ' get from product end if ConvertCurrency TotaloptionPrice, TotalOptionDualPrice arrCart(cDualPrice,scartItem) = strDualprice + TotaloptionDualPrice else arrCart(cDualPrice,scartItem) = 0 end if arrCart(cMinimumQuantity,scartItem) = strminimumquantity arrCart(cSupplierid,scartItem) = strsupplierid arrCart(cDelivery,scartItem) = "" if isnull(lngcstock) then lngcstock="" end if If GetSess ("NewProductPrice")="" then arrCart(cmaximumQuantity,scartItem) = strmaximumquantity else arrCart(cmaximumQuantity,scartItem) = 1 end if arrCart(cStockLevel,scartItem) = lngcstock arrCart(cProductimage,scartItem) = strcimageurl arrCart(cProductweight,scartItem) = strweight arrCart(cProductassociated,scartItem) = "" arrCart(cProductmininame,scartItem) = strcname SetSess "CartCount",scartitem SetSessA "CartArray",arrCart rc=0 end sub ' ' If we find it then just add new quantity Sub LocateInArray(id,rc) Dim i dim lngid dim scartitem dim arrcart lngid=clng(id) rc=4 ' not found ' Anything with features needs to be added new If strFeatures<>"" then CheckFeaturesStockLevel quantity, lngcatalogid exit sub end if If memUserText<>"" then exit sub end if scartItem = GetSess("CartCount") If scartitem=0 then exit sub end if arrCart = GetSessA("CartArray") dim newquantity For i = 1 to scartItem If lngid = arrCart(cProductid,i) then newquantity=arrCart(cQuantity,i)+clng(quantity) validatequantity newquantity CheckStockLevel newquantity, lngcatalogid arrCart(cQuantity,i) = newquantity CalculateUserPrice arrCart(cOriginalPrice,i), arrCart(cQuantity,i), DiscountPrice, arrcart, i arrCart(cUnitPrice,i)=DiscountPrice rc=0 SetSessA "CartArray",arrCart exit sub end if Next End Sub Sub GenerateMinQuantityList (i, quantity) dim lngquantity Dim PArray(100),PArrayCount dim amount, sSelect, j lngquantity=clng(quantity) ' Fix Oct 19 parraycount=getconfig("xproductminimumlist") if parraycount="" then parraycount=6 end if parraycount=clng(parraycount) for j = 1 to parraycount amount=j*minamount parray(j)=amount next sSelect = sSelect & "" for j = 1 to parraycount If parray(j)=lngquantity then sSelect = sSelect & "" & Parray(j) & "" else sSelect = sSelect & "" & Parray(j) & "" end if next sSelect= sSelect & "" %> <%=sSelect%> <% end sub ' Sub CheckStockLevel (quantity, catalogid) dim lquantity, lstock If getconfig("XCheckStockLevel")<>"Yes" then exit sub lquantity=clng(quantity) if isnull(lngcstock) then exit sub lstock=clng(lngcstock) If lquantity>lstock then shoperror getlang("LangStockLevel") & "(" & lngcstock & ") - " & strcname end if end sub Sub AddCartOptions (totalOptionPrice, TotalOptionDualPrice) '********************************************************************** ' Features have been stored in the feature array ' feature count has the number of features stored '********************************************************************** Dim sPrice Dim OPrice Dim optionName Dim sFeature, featureother Dim MaxFeatures, msg, tempselect TotalOptionPrice=0 TotaloptionDualPrice=0 sFeature="" Productsku="" sPrice="" Maxfeatures=Featurecount If maxfeatures=0 then exit sub 'Debugwrite "featurecount=" & featurecount sFeature="" dim percent, percentamount for i = 0 to MaxFeatures strfeaturename= Featurearray(cfeaturevalue,i) oprice=Featurearray(cfeatureprice,i) featureother=Featurearray(cfeatureother,i) strfeaturecaption=Featurearray(cfeaturecaption,i) strfeaturepercent=Featurearray(cfeaturepercent,i) percentamount=0 If strfeaturepercent<>"" then If strfeaturepercent<1 then strfeaturepercent=strfeaturepercent*100 end if percentamount=(strfeaturepercent/100*curcprice) Percent = strfeaturepercent & "%" end if if sFeature="" Then If curcprice>0 then sFeature= FeatureBasePriceFont & getlang("LangproductBasePrice") & shopformatcurrency(curCPrice,getconfig("xdecimalpoint")) & FeatureBasePriceEnd sFeature= sFeature & "
" & FeatureHeaderFont & getlang("LangProductFeaturesOptions") & FeatureHeaderFontEnd end if end if sFeature=sfeature & "
" & CartFeatureCaption & strfeaturecaption & CartFeatureCaptionEnd & " " sFeature= sFeature & FeatureFont & strfeaturename & FeatureFontEnd if getconfig("xcurrencysymbol")<>"" and oprice<>"" then oprice=replace(oprice,getconfig("xcurrencysymbol"),"") end if If oprice="" then oprice=0 end if if OPrice<>0 then TotalOptionPrice=TotaloptionPrice+OPrice If Oprice > 0 then sFeature = SFeature & FeaturePriceFont & getlang("LangFeatureAdd") & shopformatcurrency(OPrice,getconfig("xdecimalpoint")) & FeaturePriceEnd else sFeature = SFeature & FeaturePriceFont & getlang("LangFeatureSubtract") & shopformatcurrency(OPrice,getconfig("xdecimalpoint")) & FeaturePriceEnd end if end if if percentamount<>0 then TotalOptionPrice=TotaloptionPrice+percentamount If percentamount > 0 then sFeature = SFeature & FeaturePriceFont & getlang("LangFeatureAdd") & percent & FeaturePriceEnd else sFeature = SFeature & FeaturePriceFont & getlang("LangFeatureSubtract") & percent & FeaturePriceEnd end if end if Createsku productsku, featureother next NameInCart=NameIncart & sFeature If Productsku<>"" and getconfig("xgeneratesku")="Yes" then NameinCart= "Sku: " & Productsku & "
" & NameinCart end if end sub ' ' ' Sub CreateSku (productsku, strfeatureother) If isnull(strfeatureOther) then exit sub If strfeatureother="" then exit sub If ProductSku="" then Productsku=strccode end if Productsku=Productsku & "-" & strfeatureother end sub ' ' Sub VerifyRequired (msg) dim requiredlist msg="" ' SxRequirelistvalue ha the list of features that are required Requiredlist=split(sxrequiredvalue,",") For i = 0 to ubound(Requiredlist) FindSelected RequiredList(i), msg next end sub ' Sub FindSelected (feature, msg) ' Find this required feature in the list of selected features dim j, tempmsg, fsql, featurecaption, rs 'debugwrite "selectedcount=" & userselectedcount If featurecount>0 then for j =0 to featurecount ' Debugwrite "feature=" & feature & "selected=" & Userselected(j) if clng(feature)=clng(Featurearray(cfeaturenum,j)) then exit sub end if next end if Fsql="select * from prodfeatures where featurenum=" & feature set rs=Featureconn.execute(fsql) featurecaption=rs("featurecaption") rs.close set rs=nothing tempmsg= getlang("LangFeatureMissing") & strcname & " - " & featurecaption & "
" msg=msg & tempmsg end sub ' Sub CheckFeaturesStockLevel (quantity, catalogid) dim lstock dim totquantity Dim i dim lngid dim scartitem dim arrcart If getconfig("XCheckStockLevel")<>"Yes" then exit sub if isnull(lngcstock) then exit sub lstock=clng(lngcstock) lngid=clng(catalogid) totquantity=clng(quantity) scartItem = GetSess("CartCount") If scartitem=0 then exit sub end if arrCart = GetSessA("CartArray") For i = 1 to scartItem If lngid = arrCart(cProductid,i) then Totquantity=arrCart(cQuantity,i) +totquantity end if Next If totquantity>lstock then shoperror getlang("LangStockLevel") & "(" & lngcstock & ") - " & strcname end if end sub ' '********************************************************* ' make sure quantity matches minimum '******************************************************** Sub CorrectminimumQuantity (quantity, minquantity) dim tempmin if getconfig("xproductminimumquantity")<>"Yes" then exit sub if not isnumeric (minquantity) then exit sub tempmin=clng(minquantity) if tempmin= 0 then exit sub if clng(quantity)>= tempmin then exit sub quantity=tempmin end sub ' '********************************************************* ' make sure quantity matches minimum '******************************************************** Sub CorrectMaximumQuantity (quantity, maxquantity) dim tempmin if getconfig("xproductmaximumquantity")<>"Yes" then exit sub if not isnumeric (maxquantity) then exit sub tempmin=clng(maxquantity) if tempmin= 0 then exit sub if clng(quantity)<= tempmin then exit sub quantity=tempmin end sub %>