<%option explicit%>
<%
'============================
' Form for obtaining delivery address
' VP-ASP 6.50 March 26, 2004
'============================
dim saction
dim dbc
Dim Amount
Dim Quantity
Dim ProdAddress,ProdComment,ProdSignature
Dim Selection
Dim DeliveryTypes(5),deliverytype,deliveryCount
Dim Name, shippingcount,shippingmethods(50),shipmethodtype, shippingcost
dim DeliveryComment, Deliverysignature, shippingmethod
dim deliverymonth,deliveryyear, deliveryday,deliverytime
'Dim Deliveryarray
Dim Productname
Dim arrayid
'VP-ASP 6.50 - precautionary security fix
arrayid=request("id")
if not isnumeric(arrayid) then
shoperror "Array ID must be numeric"
end if
sAction=Request("Action")
if saction="" then
sAction=Request("Action.x")
end if
If sAction = "" Then
GetCurrentValues
DisplayForm()
Else
sError = ""
Validate
If sError = "" Then
UpdateCart
responseredirect "shopaddtocart.asp"
end if
DisplayForm
end if
'============================
' Sub DisplayForm
'============================
Sub DisplayForm
dim url
url="shopdeliveryedit.asp?id=" & arrayid
GetDeliveryTypes
GetShippingDatabase
shoppageheader
if getconfig("xbreadcrumbs") = "Yes" then
response.write "
" & vbCrLf
If sError<> "" then
shopwriteerror sError
Serror=""
End If
%>
"
ShopPageTrailer
End Sub
'
'============================
' Sub Updatecart
'============================
Sub UpdateCart
dim nameincart, i,deliveryarray
dim scartitem, arrCart
scartItem = GetSess("CartCount")
arrCart = GetSessA("CartArray")
If scartItem = getconfig("xMaxCartitems") and scartItem>0 then
shoperror getlang("Langerror02")
End If
i=arrayid
redim Deliveryarray(Deliveryattributes)
CreateDeliveryAddress deliveryarray
arrCart(cDelivery,i) = Deliveryarray
SetSessA "CartArray",arrcart
' for i = 1 to Deliveryattributes
' Debugwrite i & " =" & deliveryarray(i)
' next
end sub
Sub GetAddressFields
'VP-ASP 6.50 - precautionary security fix
strFirstname = cleanchars(Request.Form("strFirstname"))
strLastname = cleanchars(Request.Form("strLastname"))
strAddress = cleanchars(Request.Form("strAddress"))
strCity = cleanchars(Request.Form("strCity"))
strState = cleanchars(Request.Form("strState"))
strPostCode = cleanchars(Request.Form("strPostCode"))
stremail = cleanchars(Request.Form("strEmail"))
strCountry = cleanchars(Request.Form("strCountry"))
strCompany = cleanchars(Request.Form("strCompany"))
strPhone = cleanchars(Request.Form("strPhone"))
DeliveryComment=cleanchars(request("DeliveryComment"))
DeliverySignature=cleanchars(request("DeliverySignature"))
ShipMethodtype=cleanchars(request("ShipMethodType"))
Deliverymonth=cleanchars(request("Month"))
DeliveryYear=cleanchars(request("Year"))
DeliveryDay=cleanchars(Request("Day"))
DeliveryTime=cleanchars(request("Arrive"))
arrayid=cleanchars(request("id"))
Deliverytype=cleanchars(request("deliverytype"))
Dim scartItem, arrCart
scartItem = GetSess("CartCount")
arrCart = GetSessA("CartArray")
Productname=arrCart(cProductname,arrayid)
End Sub
Sub Validate
GetAddressFields
If DeliveryType<> getlang("LangCommonSelect") then
If Deliverytype<> getlang("LangDeliverySelf") then
validateaddress
end if
else
Serror=Serror & getlang("LangDeliveryType") &getlang("LangCustrequired")& " "
end if
ShippingMethod=""
If getconfig("xDeliveryShipping")="Yes" Then
If ShipMethodType<> getlang("LangCommonSelect") then
parseOption shipmethodtype,shippingmethod,shippingCost
else
Serror=Serror & getlang("LangShippingMethod") &getlang("LangCustrequired")& " "
end if
end if
If Deliverytime<>"ASAP" Then
Deliverytime=deliveryMonth & " " & DeliveryDay & " " & DeliveryYear
end if
end sub
sub ValidateAddress
If strFirstname = "" Then
sError = sError & getlang("LangCustFirstname") &getlang("LangCustrequired")& " "
End If
If strLastname = "" Then
sError = sError & getlang("LangCustLastname") & getlang("LangCustrequired")& " "
End If
If strAddress = "" Then
sError = sError & getlang("LangCustAddress") &getlang("LangCustrequired")& " "
End If
If strCity = "" Then
sError = sError & getlang("LangCustCity") &getlang("LangCustrequired")& " "
End If
If getconfig("xPromptForState")="Yes" then
If strState = "" or strState="??" Then
sError = sError & getlang("LangCustState") &getlang("LangCustrequired")& " "
End If
end if
If strPostCode = "" Then
sError = sError & getlang("LangCustPostCode") &getlang("LangCustrequired")& " "
End If
If strPhone = "" Then
sError = sError & getlang("LangCustPhone") &getlang("LangCustrequired")& " "
End If
If getconfig("xCountryRequired")="Yes" then
If strCountry="" or strCountry="??" then
sError = sError & getlang("LangCustCountry") &getlang("LangCustrequired")& " "
End If
end if
'VP-ASP 6.50 - validate email address
If Not InStr(strEmail, "@") > 1 Then
Serror=Serror & getlang("langInvalidEmail") & " "
end if
end sub
Sub GetCurrentValues
dim i
i=arrayid
Dim scartItem, arrCart, prodaddress, deliveryarray
scartItem = GetSess("CartCount")
arrCart = GetSessA("CartArray")
Deliveryarray=arrCart(cDelivery,i)
If isarray(DeliveryArray) then
SetupDeliveryFields DeliveryArray
end if
Productname=arrCart(cProductname,i)
end sub
Sub GetDeliveryTypes
DeliveryTypes(0)= getlang("LangDeliveryself")
Deliverytypes(1)= getlang("LangDeliveryAddress")
DeliveryCount=2
end sub
Sub GetShippingDatabase
'***************************************************
' Read database and store dat in shippingmethods array
'*************************************************
Dim rsship
Dim dbc
Dim TempOption
Dim TempPrice
dim prevMethod
shippingcount=0
prevmethod=""
ShopOpenDatabase dbc
Set rsship = Server.CreateObject ("ADODB.Recordset")
SQL="Select * from shipmethods order by shipmethod"
rsship.Open SQL, dbc, adOpenForwardOnly,adLockReadOnly, adCmdText
Do While Not rsship.EOF
TempOption = rsship("shipmethod")
TempPrice=rsship("smprice")
if TempPrice<>"" then
if TempPrice<>0 then
' TempOption= TempOption & " [" & formatnumber(TempPrice,xdecimalpoint) & "]"
end if
end if
if TempOption<>PrevMethod then
ShippingMethods(shippingcount)=TempOption
PrevMethod=TempOption
If ShippingCount=0 then
If GetSess("Shipmethodtype")<>"" then
shipmethodtype=Getsess("shipmethodtype")
else
ShipMethodType=ShippingMethods(0) ' set defaut method
end if
end if
shippingcount=shippingcount+1
end if
rsship.MoveNext
Loop
Closerecordset rsship
ShopCloseDatabase dbc
end sub
Sub AddDeliveryDates
Response.write "
" & tablecolumnend & tablerowend
response.write tabledefend
response.write ""
end sub
Sub GenerateMonth
dim i, month, name, selected
month=datepart("m",date())
for i =1 to 12
name=monthname(i)
if i = month then
Selected="selected=""selected"""
else
Selected=""
end if
Response.write ""
Next
end sub
Sub GenerateDays
dim i, day, name, selected
day=datepart("d",date())
for i =1 to 31
if i = day then
Selected="selected=""selected"""
else
Selected=""
end if
Response.write ""
Next
end sub
Sub GenerateYears
dim i, year, currentyear, selected
year=datepart("yyyy",date())
currentyear=year
for i =1 to 3
if currentyear=Year then
Selected="selected=""selected"""
else
Selected=""
end if
Response.write ""
Year=year+1
Next
end sub
%>