<%option explicit%>
<%
dim sAction
Dim GIftfont, giftfontend
giftfont=xtablerowfont
giftfontend=xtablerowfontend
'*******************************************************************
' Prompt customer for gift details and add to cart
' VP-ASP 4.50
' May 2, 2002
'********************************************************************
if getconfig("xGiftCertificates")<>"Yes" then
shoperror LangCustNotAllowed
end if
Shopinit
GiftCount=0
sAction=Request("Action")
if sAction="" then
sAction=Request("Action.x")
end if
If sAction = "" Then
ShopPageHeader
DisplayForm
ShopPageTrailer
Else
ValidateData()
if sError = "" Then
UpdateGift
Response.redirect "shopgift2.asp"
else
ShopPageHeader
DisplayForm
ShopPageTrailer
end if
end if
Sub DisplayForm()
Displayerrors
response.write " " & getconfig("Xfont") & LangGiftEasy & ""
Response.Write(""
end sub
'
Sub AddTo
Response.write GiftFont & LangGiftWho & GiftFontEnd
Response.Write(TableDef)
CreateCustRow "To Name(optional) ", "strgifttoname", strgifttoname,""
CreateCustRow "Email ", "strgifttoemail", strgifttoemail,"Yes"
Response.write " "
end sub
Sub AddFrom
Response.write GiftFont & LangGiftFrom & GiftFontEnd
Response.Write(TableDef)
CreateCustRow "From Name (optional) ", "strgiftfromname", strgiftfromname,""
CreateCustRow "Email ", "strgiftfromemail", strgiftfromemail,"Yes"
Response.write " "
end sub
Sub AddAmount
dim caption, fieldname,fieldvalue
caption="Amount"
fieldname="CurGiftamount"
Fieldvalue=curgiftamount
Response.write GiftFont & LangGiftToAmount & GiftFontEnd
Response.Write(TableDef)
%>
>
<%=xTableRowFont%><%=Caption%>
<%
Response.write ""
end sub
Sub AddMessage
Response.write "
"
end sub
Sub ValidateData
curGiftamount = Request.Form("curGiftamount")
strGifttoname = Request.Form("strGifttoname")
strGifttoemail = Request.Form("strGifttoemail")
strGiftfromname = Request.Form("strGiftfromname")
strGiftfromemail = Request.Form("strGiftfromemail")
strGiftmessage = Request.Form("strGiftmessage")
stremails=request("stremails")
If curGiftamount = "" Then
sError = sError & LangGiftTOAmount & " "
Else
ValidateAmount
end if
If strGifttoemail = "" Then
sError = sError & LangGiftToemail & " "
Else
validateemail strGifttoemail
End If
If strGiftfromemail = "" Then
sError = sError & LangGiftFromEmail & " "
Else
validateemail strGiftfromemail
End If
If stremails <>"" Then
validateemails
End If
If len(strGiftmessage)> 255 Then
sError = sError & LangGiftMessageLimit & len(strgiftMessage) & " "
End If
end sub
Sub WriteInfo
ShoppageHeader
If getsess("customeradmin")="" then
response.write getconfig("xfont") & LangMailListinfomsg & " "
else
response.write getconfig("xfont") & "Details updated " & " "
end if
ShopPageTrailer
End Sub
Sub DisplayErrors
if sError<> "" then
response.write "" & getconfig("Xfont") & SError & ""
Serror=""
end if
end Sub
Sub ValidateAmount
Dim Numamount
dim numLimit
If not isnumeric(curGiftamount) then
Serror=Serror & LangUserPriceError & " " & curgiftamount &" "
exit sub
end if
If curgiftamount<0 then
curgiftamount=abs(curgiftamount)
end if
If getconfig("Xgiftlimit")<> "" then
numamount=csng(curGiftamount)
numLimit=csng(getconfig("xgiftlimit"))
If Numamount>numlimit then
Serror=Serror & LangGiftLimit & " " & getconfig("xgiftlimit") &" "
end if
end if
end sub
Sub UpdateGift
dim orderamount
GiftCount=GiftCount+1
SetSess "Giftamount", curGiftamount
If strGiftToname="" then
strGiftToName=LangGiftUnknown
end if
SetSess "Gifttoname", strGifttoname
If strGiftFromname="" then
strGiftFromName=LangGiftunknown
end if
SetSess "Giftfromname", strGiftfromname
SetSess "Gifttoemail", strGiftToemail
SetSess "Giftfromemail", strGiftfromemail
SetSess "Giftmessage", strGiftmessage
SetSess "GiftOtheremails",stremails
SetSess "GiftCount",GiftCount
Orderamount=curgiftamount
orderamount=Orderamount*giftcount
SetSess "Ordertotal",orderamount
SetSess "OrderProducttotal",orderamount
GiftAddToCart ' in shopgiftdb.asp
end sub
Sub ValidateEmails
dim words(20),wordcount, delimiter,i
delimiter=","
ParseRecord stremails,words,wordcount,delimiter
For i = 0 to wordcount-1
validateemail words(i)
next
GiftCount=GiftCount+WordCount
end sub
Sub ValidateEmail (stremail)
If Not InStr(strEmail, "@") > 1 Then
Serror=Serror & LangInvalidEmail & " " & stremail & " "
end if
End sub
%>