<% '**************************************************************************** ' Version 6.50 Coupon Handling ' all Subroutines related to coupon handling ' locatecoupon coupoun,rc ' Updatecoupon ' applyCoupon ' July 5, 2005 Coupon affiliates ' Nov 24, 2006 hk allow categories to be any category in prodcategories table '**************************************************************************** ' Dim Couponid Dim Couponname Dim Couponpercent Dim Couponamount Dim Couponstartdate dim couponenddate Dim Couponlimit Dim Couponcomment Dim Couponother Dim Couponcategories Dim Couponproducts Dim Couponusedcount Dim Couponlastuseddate dim couponminimum dim couponcustomers dim couponaffid ' '*********************************************************************** ' see if coupon is in table, that it has not expired and meets the ' start date '********************************************************************** Sub LocateCoupon (Coupon, rc, msg) dim rs, dbc,pos Pos=instr(coupon,"'") if pos>0 then msg= getlang("LangCouponNotFound") &"
" rc=4 exit sub end if ShopOpenDatabase dbc sql="select * from coupons where couponname='" & coupon & "'" set rs=dbc.execute(sql) if rs.eof then msg= getlang("LangCouponNotFound") &"
" ' closerecordset rs ' hk fix 23/11/06 rc=4 else GetCouponFields rs ValidateCoupon rc, msg end if closerecordset rs shopclosedatabase dbc end sub '****************************************************************** ' take coupon fields from recordset to local variables '***************************************************************** Sub GetCouponFields (objRS) couponid = objrs("couponid") couponname = objrs("couponname") couponpercent = objrs("couponpercent") couponamount = objrs("couponamount") couponenddate = objrs("couponenddate") couponstartdate = objrs("couponstartdate") couponlimit = objrs("couponlimit") couponcomment = objrs("couponcomment") couponother = objrs("couponother") couponcategories = objrs("couponcategories") couponproducts = objrs("couponproducts") couponusedcount = objrs("couponusedcount") couponlastuseddate = objrs("couponlastuseddate") couponminimum = objrs("couponminimum") If isnull(couponminimum) then couponminimum=0 end if couponcustomers = objrs("couponcustomers") if isnull(couponcustomers) then couponcustomers="" couponaffid=objrs("couponaffid") if isnull(couponaffid) then couponaffid="" end sub '************************************************************************* ' validate coupon ' check limit (number of times used ' check expiration date ' check start date '*********************************************************************** Sub ValidateCoupon (rc, msg) dim today, expirydate, startdate rc=0 setsess "couponaffid","" If couponlimit=0 then else If Couponusedcount>=couponlimit then msg= getlang("LangCouponUsedCount") rc=4 exit sub end if end if today=datedelimit(date()) If not isnull(couponenddate) then expirydate=datedelimit(couponenddate) If today>expirydate then msg= getlang("LangCouponExpired") & " " & couponenddate rc=4 exit sub end if end if If not isnull(couponstartdate) then startdate=datedelimit(couponstartdate) If today"" then setsess "affid",couponaffid end if end sub '************************************************************************ ' coupon may be specific to a category. A product can belong to many categories ' Unless using simple category mopde, use the prodcategories table to match ' the categories for the coupon '************************************************************************ Sub ApplyTocategories (applied) If isnull(couponcategories) then exit sub applied=true dim inarray(100), i, rc, count parserecord couponcategories, inarray, count, "," dim arrCart, scartitem Dim ProdQuantity, ProdPrice dim conn, catalogid scartItem = GetSess("CartCount") arrCart = GetSessA("CartArray") ' go through all products '*************************************************************************** ' see if this product matches any of the ones in is prodcategory table '*************************************************************************** shopopendatabase conn For i = 1 to scartItem category=arrCart(ccategory,i) ' main category Prodquantity=arrCart(cQuantity,i) ProdPrice=arrCart(cUnitPrice, i) catalogid=arrCart(cProductid,i) ' catalogid If getconfig("xcategoriessimple")<>"Yes" then ' use prod categories table Matchsubcategories conn, catalogid, inarray, count, rc else ' use ccategory for simple mode Match category, inarray, count, rc end if ' rc=0 means found if rc=0 then ApplyDiscount prodquantity, prodprice end if Next shopclosedatabase conn end sub '************************************************************************ ' see if category matches the list of categories in coupon record '*********************************************************************** Sub Match (value,inarray, count, rc) dim i for i = 0 to count-1 If clng(value)=clng(inarray(i)) then rc=0 exit sub end if next rc=4 end sub Sub ApplyToProducts (applied) dim inarray(100), i, rc, count If isnull(couponproducts) then exit sub applied=true dim arrCart, scartitem, catalogid Dim ProdQuantity, ProdPrice scartItem = GetSess("CartCount") arrCart = GetSessA("CartArray") parserecord couponproducts, inarray, count, "," ' go through all products For i = 1 to scartItem catalogid=arrCart(cProductId,i) Prodquantity=arrCart(cQuantity,i) ProdPrice=arrCart(cUnitPrice, i) match catalogid, inarray, count, rc if rc=0 then ApplyDiscount prodquantity, prodprice end if Next end sub Sub ApplyGeneral(applied) dim discount, totalamount If couponamount>0 then applied=true Discount=couponamount If discount> GetSess("ordertotal") then discount=GetSess("ordertotal") end if else If not isnull(couponpercent) then applied=true Totalamount=GetSess("ordertotal") discount=Totalamount*couponPercent If discount>totalamount then discount=totalamount end if end if end if Setsess "coupondiscount", discount end sub '******************************************************************** ' try to apply coupon based on product, category or other '******************************************************************* ' Sub ApplyDiscount (prodquantity, prodprice) dim discount, coupondiscount, totalprice CouponDiscount=GetSess("couponDiscount") If isnull(couponpercent) then couponpercent=0 end if If couponpercent<>0 then Totalprice=ProdPrice*ProdQuantity Discount=TotalPrice*couponpercent else If isnull(couponamount) then couponamount=0 end if If couponamount>prodprice then couponamount=prodprice end if Discount=couponamount*prodQuantity If discount> GetSess("ordertotal") then discount=GetSess("ordertotal") end if end if Coupondiscount=couponDiscount+discount Setsess "coupondiscount", coupondiscount end sub '********************************************************************** ' check minimum order and customer specific coupons '******************************************************************* Sub CouponValidateSpecial (coupon,msg) dim ordertotal, customerids(50),count dim customerid, total msg="" if couponminimum>0 then ordertotal=GetProductorderTotal if ordertotal