<%option explicit%>
<%
dim sAction
'*******************************************************************
' Prompt customer for gift details and add to cart
' VP-ASP 5.00
' Jan 2, 2003
'********************************************************************
if getconfig("xGiftCertificates")<>"Yes" then
shoperror getlang("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
shopwriteheader getlang("LangGiftEasy")
Response.Write(""
end sub
'
Sub AddTo
shopwriteheader getlang("LangGiftWho")
Response.Write(TableDef)
CreateCustRow "To Name(optional) ", "strgifttoname", strgifttoname,""
CreateCustRow "Email ", "strgifttoemail", strgifttoemail,"Yes"
Response.write tabledefend & " "
end sub
Sub AddFrom
shopwriteheader getlang("LangGiftFrom")
Response.Write(TableDef)
CreateCustRow "From Name (optional) ", "strgiftfromname", strgiftfromname,""
CreateCustRow "Email ", "strgiftfromemail", strgiftfromemail,"Yes"
Response.write tabledefend & " "
end sub
Sub AddAmount
dim caption, fieldname,fieldvalue
caption="Amount"
fieldname="CurGiftamount"
Fieldvalue=curgiftamount
shopwriteheader getlang("LangGiftToAmount")
Response.Write(TableDef)
response.write tablerow & tablecolumn &Caption & tablecolumnend & tablecolumn
%>
<%
response.write tablecolumnend & tablerowend
Response.write ""
end sub
Sub AddMessage
shopwriteheader getlang("LangGiftMessage")
Response.write ""
end sub
Sub AddAddresses
shopwriteheader getlang("LangGiftEmailPrompt")
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 & getlang("LangGiftTOAmount") & " "
Else
ValidateAmount
end if
If strGifttoemail = "" Then
sError = sError & getlang("LangGiftToemail") & " "
Else
validateemail strGifttoemail
End If
If strGiftfromemail = "" Then
sError = sError & getlang("LangGiftFromEmail") & " "
Else
validateemail strGiftfromemail
End If
If stremails <>"" Then
validateemails
End If
If len(strGiftmessage)> 255 Then
sError = sError & getlang("LangGiftMessageLimit") & len(strgiftMessage) & " "
End If
end sub
Sub WriteInfo
ShoppageHeader
If getsess("customeradmin")="" then
shopwriteheader getlang("LangMailListinfomsg")
else
shopwriteheader getlang("LangEdit03")
end if
ShopPageTrailer
End Sub
Sub DisplayErrors
if sError<> "" then
response.write errorfontstart & SError & errorfontend & " "
Serror=""
end if
end Sub
Sub ValidateAmount
Dim Numamount
dim numLimit
If not isnumeric(curGiftamount) then
Serror=Serror & getlang("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 & getlang("LangGiftLimit") & " " & getconfig("xgiftlimit") &" "
end if
end if
end sub
Sub UpdateGift
dim orderamount
GiftCount=GiftCount+1
SetSess "Giftamount", curGiftamount
If strGiftToname="" then
strGiftToName= getlang("LangGiftUnknown")
end if
SetSess "Gifttoname", strGifttoname
If strGiftFromname="" then
strGiftFromName= getlang("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 & getlang("LangInvalidEmail") & " " & stremail & " "
end if
End sub
%>