<%Option explicit%>
[an error occurred while processing this directive]
<%
'*******************************************************
' Version 5.00 Coupon Handling
' Feb 21, 2004 Update coupon mysql
' all Subroutines related to coupon handling
' locatecoupon coupoun,rc
' Updatecoupon
' applyCoupon
'*********************************************************
'
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
'
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") &"
"
rc=4
else
GetCouponFields rs
ValidateCoupon rc, msg
end if
rs.close
set rs=nothing
shopclosedatabase dbc
end sub
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")
end sub
Sub ValidateCoupon (rc, msg)
dim today, expirydate, startdate
rc=0
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 today0 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
'
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
%>
<%
'*******************************************************
' Version 5.00 Coupon Validation
' Jan 5, 2003
'*******************************************************
dim sAction, Coupon
ShopPageHeader
Saction=Request("Action")
if sAction="" then
Saction=Request("Action.x")
end if
If saction="" then
AddCouponForm
else
HandleAction
If Serror="" then
WriteInfoMessage
else
addCouponForm
end if
end if
ShopPageTrailer
'
Sub AddCouponForm
if sError<> "" then
shopwriteerror sError
Serror=""
end if
coupon=Getsess("Coupon")
%>
<%
shopwriteheader getlang("LangCustCouponPrompt")
response.write "
"
Response.Write("")
end sub
Sub HandleAction
dim rc
coupon=request("coupon")
if coupon="" then
Serror= getlang("LangCouponMissing")
exit sub
end if
LocateCoupon coupon, rc, serror
if Serror="" then
SetSess "coupon",coupon
end if
end sub
Sub WriteInfoMessage
Response.write largeinfofont & getlang("LangCouponAccepted") & largeinfoend & "
"
end sub
%>