<%option explicit%>
<%
dim sAction
dim actiontype ' gift or checkout
dim actionselect ' radio button
dim radioarray(5), radiocount, radiovalues(5)
dim forwardurl
'*******************************************************************
' Prompt customer for gift details and add to cart
' VP-ASP 6.50
' Option=gift ' comes from shopgift.asp
' option=checkout ' comes from shopcustomer.asp
' November 11, 2006 hk make sure no other products in cart
'********************************************************************
'VP-ASP 6.50 - precautionary security fix
actiontype=cleanchars(request("option")) ' gift for purchase gift certtificate
' ' checkout when trying to checkout
actiontype=lcase(actiontype)
if getconfig("xGiftCertificates")<>"Yes" then
' shoperror getlang("LangCustNotAllowed")
end if
sAction=Request("Action")
if sAction="" then
sAction=Request("Action.x")
end if
If sAction = "" Then
ShopPageHeader
if getconfig("xbreadcrumbs") = "Yes" then
response.write "
" & vbCrLf
DisplayForm
ShopPageTrailer
Else
ValidateData()
if sError = "" Then
ProcessAction
If forwardurl<>"" then
Responseredirect forwardurl
end if
else
ShopPageHeader
if getconfig("xbreadcrumbs") = "Yes" then
response.write "
" & vbCrLf
DisplayForm
ShopPageTrailer
end if
end if
'******************************************************************************
' The form first put out message about the issue
' Then continues based on what customer wants to do
'*****************************************************************************
Sub DisplayForm()
Displayerrors
Displayinfo
Response.Write(""
end sub
Sub Displayinfo
select case actiontype
case "gift"
PerformPurchaseGift
case "checkout"
PerformCheckout
case else
shopwriteError "Unknown action type"
end select
end sub
Sub PerformPurchaseGift
shopwriteheader "Gift certificates cannot be purchased with other products"
shopwriteheader "Select from the following options:"
radiocount=0
addtoradio getlang("langgiftdeleteproducts"),"deleteproducts"
addtoradio getlang("langgiftcheckout"),"checkout"
end sub
Sub addtoradio (message, value)
radioarray(radiocount)=message
radiovalues(radiocount)=value
radiocount=radiocount+1
end sub
Sub PerformCheckout
shopwriteheader Getlang("langgifterror")
shopwriteheader getlang("langactionrequired")
radiocount=0
addtoradio getlang("langgiftdeleteproductscheckout"),"deleteproductscheckout"
addtoradio getlang("langgiftdeletegiftcheckout"),"deletegiftcheckout"
end sub
Sub DisplayErrors
if sError<> "" then
response.write errorfontstart & SError & errorfontend & " "
Serror=""
end if
end Sub
Sub CreateHiddenField(fieldname, fieldvalue)
response.write "" & vbcrlf
end sub
Sub Displayradiobuttons
dim currentvalue, selectname, firstfield
selectname="actionselect"
currentvalue=""
firstfield=""
Createradiolist selectname,currentvalue,radiovalues, radiocount, radioarray
end sub
'********************************************************************************
' the following function provided by hk programming
'********************************************************************************
function CreateRadioList (fieldname, fieldvalue, listarray, listcount, captions)
dim i, selected
dim radiovalue, radiotext, caption
%>
<%
for i =0 to listcount-1
radiovalue=listarray(i)
caption=captions(i)
if fieldvalue<>"" and radiovalue=fieldvalue then
selected=" checked=""checked"""
else
selected=""
end if
%>
<%
response.write ""
%>
<%=caption%>
<%
next
response.write ("
")
end function
Sub validatedata
serror=""
'VP-ASP 6.50 - precautionary security fix
actionselect=cleanchars(request.form("actionselect"))
if actionselect="" then
serror=serror & getlang("langactionrequired") & " "
else
actionselect=lcase(actionselect)
end if
end sub
Sub Processaction
select case actionselect
case "deleteproducts"
PerformDeleteproducts
case "checkout"
Performcheckoutselect
case "deleteproductscheckout"
PerformDeleteproductscheckout
case "deletegiftcheckout"
PerformDeletegiftcheckout
case else
shopwriteerror "unknown action select " & actionselect
end select
end sub
'****************************************************************************
' trying to buy a gift certificate with products
' empty cart and continue with gift purchase
'****************************************************************************
Sub PerformDeleteProducts
forwardurl="shopgift.asp" ' where we continue
setsess "cartcount",0 ' no more products
end sub
'****************************************************************************
' forget about gifts and just checkout
'****************************************************************************
Sub PerformCheckoutselect
forwardurl="shopcustomer.asp" ' where we continue
end sub
'****************************************************************************
' delete all products and leave gift certificate
' continue with shopcustomer.asp
'***************************************************************************
Sub PerformDeleteproductscheckout
dim cartattributes, maxcartitems, i, j, newcount, newcart
dim giftid, arrcart, scartitem, productid, x
giftid=getconfig("xGiftProductId")
giftid=clng(giftid)
forwardurl="shopgift2.asp"
cartattributes=cMaxCartAttributes
maxcartitems=getconfig("xmaxcartitems")
newcount=0
arrCart = GetSessA("CartArray")
scartItem = GetSess("CartCount")
ReDim newcart(cartAttributes,maxCartItems)
For i = 1 to scartItem
productid=arrCart(cProductid,i)
if clng(productid)=giftid then
newcount=newcount+1
for x = 1 to cartAttributes
NewCart(x, newcount) = arrCart(x,i)
next
SetSess "CartCount", newcount
SetSessA "CartArray", Newcart
exit sub
end if
Next
SetSess "CartCount", newcount
SetSessA "CartArray", Newcart
end sub
'****************************************************************************
' delete gift certificate leave products
' continue with shopcustomer.asp
'***************************************************************************
Sub PerformDeleteGiftcheckout
dim cartattributes, maxcartitems, i, j, newcount, newcart
dim giftid, arrcart, scartitem, productid, x
giftid=getconfig("xGiftProductId")
giftid=clng(giftid)
forwardurl="shopcustomer.asp"
cartattributes=cMaxCartAttributes
maxcartitems=getconfig("xmaxcartitems")
newcount=0
arrCart = GetSessA("CartArray")
scartItem = GetSess("CartCount")
ReDim newcart(cartAttributes,maxCartItems)
For i = 1 to scartItem
productid=arrCart(cProductid,i)
if clng(productid)<>giftid then
newcount=newcount+1
for x = 1 to cartAttributes
NewCart(x, newcount) = arrCart(x,i)
next
end if
Next
setsess "Giftamount",""
setsess "Gifttoname",""
setsess "Giftfromname",""
setsess "Gifttoemail", ""
setsess "Giftfromemail",""
setsess "Giftmessage",""
setsess "GiftOtheremails",""
setsess "GiftCount",""
SetSess "CartCount", newcount
SetSessA "CartArray", Newcart
end sub
%>