<%
If getconfig("xIncludeCountries")="Yes" Then
%>
<%
End if
If getconfig("xIncludeStates")="Yes" Then
%>
<%
End if
If getconfig("xvatnumber")="Yes" Then
%>
<%
End if
Sub ShopCustomerForm
'*******************************************************************
'
' Customer form used in many places
' CreateCustRow is in shop$colors.asp
' ShippingOtherfields
' Exclude fields
' add address2
'********************************************************************
If getconfig("xshippingundercustomer")<>"Yes" then
response.write "
"
end if
shopwriteheaderpic getlang("langformatcustomerinformation"),"images/icons/user.gif"
Response.Write("
")
CreateCustRow getlang("langCustFirstname"), "strfirstname", strfirstname,"Yes"
CreateCustRow getlang("langCustLastname"), "strlastname", strlastname,"Yes"
CreateCustRow getlang("langCustAddress"), "straddress", straddress,"Yes"
If getconfig("xcustomeraddress2")="Yes" then
CreateCustRow getlang("langCustAddress") & "2" , "straddress2", straddress2,"No"
end if
CreateCustRow getlang("langCustCity"), "strcity", strcity,"Yes"
If getconfig("xPromptForState")="Yes" then
If getconfig("xIncludeStates")="Yes" Then
Response.Write(tableRow & "
")
else
CreateCustRow getlang("langCustState"), "strstate", strstate,"Yes"
end if
end if
CreateCustRow getlang("langCustPostCode"), "strpostcode", strpostcode,"Yes"
CreateCustRow getlang("langCustPhone"),"strPhone", strPhone, "Yes"
CreateCustRow getlang("langCustEmail"), "strEmail", strEmail, "Yes"
If getconfig("xPromptForCountry")="Yes" then
if strcountry="" and getconfig("xdefaultcountry")<>"" then
strcountry=getconfig("xdefaultcountry")
end if
If getconfig("xIncludeCountries")="Yes" Then
If getconfig("xCountryRequired")="Yes" then
Response.Write(tableRow & "
" & "* " & getlang("langCustCountry") & "
" & "
")
Else
Response.Write(tableRow & "
" & getlang("langCustCountry") & "
" & "
")
End if
'VP-ASP 6.50 - extra parameter for shopcountries
ShopCountries "strcountry", strcountry,"no"
Response.Write("
")
else
If getconfig("xCountryRequired")="Yes" then
CreateCustRow getlang("langCustCountry"), "strcountry", strcountry,"Yes"
Else
CreateCustRow getlang("langCustCountry"), "strcountry", strcountry,"No"
End if
end if
end if
'VP-ASP 6.08a - Company Required wasn't accounted for
If getconfig("xcompanyrequired")="Yes" Then
CreateCustRow getlang("langCustCompany"), "strcompany", strcompany,"Yes"
Else
CreateCustRow getlang("langCustCompany"), "strcompany", strcompany,"No"
End If
If getconfig("xvatnumber")="Yes" then
CreateCustRow getlang("langVatnumber"),"vatnumber", strvatnumber,"No"
end if
AddOtherFields
AddPassword
'Response.Write(TableDefEnd)
AddCookieMessage
AddMaillIst
AddHowDidYouHear
'======================================
'VPASP 600
'Copy billing details to shipping fields
'22/07/2003
'======================================
if instr(lcase(request.ServerVariables("SCRIPT_NAME")), "shoploginforce.asp") = 0 then
if getconfig("xshippingform") = "Yes" then
If Getconfig("xgiftregistry")="Yes" and getsess("REGISTRANTID")<>"" Then
Response.Write("
")
exit sub
end if
if (instr(request.ServerVariables("SCRIPT_NAME"), "shopcustupdate.asp") = 0) then
if (instr(request.ServerVariables("SCRIPT_NAME"), "shopgift2.asp") = 0) then
if (instr(request.ServerVariables("SCRIPT_NAME"), "shopcustregister.asp") = 0) then
Response.Write tableRow & "
" & getlang("langcopydetails") & "
" & tablecolumn
response.write ""
Response.write Tablecolumnend & ""
end if
end if
end if
end if
end if
'======================================
Response.Write("
")
If getconfig("xshippingundercustomer")<>"Yes" then
response.write ""
end if
end sub
'
Sub AddPassword
if getconfig("xpassword")="Yes" then
If GetSess("Login")="" then
Response.Write("
")
AddPasswordForm "Yes"
end if
end if
end sub
Sub AddPasswordForm (yesno)
If Getconfig("Xcustomeruserid")="Yes" then
CreateCustRow getlang("langadminusername"), "strcustuserid", strcustuserid,Yesno
end if
CreateCustRowP getlang("langPassword"), "strpassword1", strpassword1,Yesno
CreateCustRowP getlang("langPassword"), "strpassword2", strpassword2,Yesno
end sub
Sub ShopShippingForm
'on error resume next
If getconfig("xshippingundercustomer")<>"Yes" then
response.write "
"
end if
shopwriteheaderpic getlang("langformatshippinginformation"),"images/icons/package.gif"
Response.Write("
")
If getconfig("xShippingDatabaseRecords")="Yes" then
If GetSess("Shipmethodtype")="" and getconfig("xDefaultShippingMethod")<>"Yes" then
shipmethodtype=getlang("langCommonSelect")
elseif GetSess("Shipmethodtype")="" Then
if request.form("shipmethodType") > "" then
'VP-ASP 6.50 - remember selected shipping method if there's an error
shipmethodtype=replace(request.form("shipmethodType"), "'","''")
else
'VP-ASP 6.50 - allow for default shipping methods
shipmethodtype=getconfig("xfixedshippingmethod")
end if
end if
Response.Write(tableRow & "
"
else
if getconfig("xfixedshippingmethod")<>"" then
ShipMethodType=getconfig("xfixedshippingmethod") ' user default method
SetSess "ShipMethod",getconfig("xfixedshippingmethod")
Response.Write(tableRow & "
" & getlang("langShippingMethod") & "
" & tablecolumn & getconfig("xfixedshippingmethod") )
Response.write ""
Response.write Tablecolumnend & ""
else
'VP-ASP 6.08 - Used to fix problem when xshippingdatabase set to No and no method is defined in xfixedshippingmethod, no shipping method was passed to shopcreateorder
response.write""
end if
end if
If getconfig("xshippingform")="Yes" then
CreateCustRow getlang("langShipName"),"shipname", strshipname,"No"
CreateCustRow getlang("langCustAddress"), "shipaddress", strshipaddress,"No"
if getconfig("xcustomeraddress2")="Yes" then
CreateCustRow getlang("langCustAddress") & "2" , "shipAddress2", strshipAddress2,"No"
end if
CreateCustRow getlang("langCustCity"), "shiptown", strshiptown ,"No"
If getconfig("xPromptForState")="Yes" then
If getconfig("xIncludeStates")="Yes" Then
Response.Write(tableRow & "
")
else
CreateCustRow getlang("langCustState"),"shipstate",strshipstate,"No"
end if
end if
CreateCustRow getlang("langCustPostCode"),"shipzip", strshipzip,"No"
If getconfig("xPromptForCountry")="Yes" then
If getconfig("xIncludeCountries")="Yes" Then
Response.Write(tableRow & "
" & getlang("langCustCountry") & "
" & "
")
'VP-ASP 6.50 - extra parameter for shopcountries
ShopCountries "shipcountry", strshipcountry, "no"
Response.Write("
")
else
CreateCustRow getlang("langCustCountry"), "shipcountry", strshipCountry,"No"
end if
end if
CreateCustRow getlang("langCustCompany"), "shipcompany", strshipcompany,"No"
ShippingAddOtherFields
Response.Write("
")
' end if shipping table
else
Response.Write("
")
end if
If getconfig("xshippingundercustomer")<>"Yes" then
response.write ""
end if
end sub
Sub AddMailList
If getconfig("XmailListCheckBox")<>"Yes" then exit sub
'Response.Write(TableDef)
Response.Write tablerow
Response.write "
"
Response.write TableColumn
'VP-ASP 6.50 - check user selection before writing checked checkbox
'If blnmaillist="" then
' blnmaillist=TRUE
'end if
if (request.form("blnmaillist") = "") AND (getsess("blnmaillist") = "") then
blnmaillist = FALSE
else
blnmaillist=TRUE
end if
If blnmaillist then%>
<%Else%>
<%
End if
response.write tablecolumnend & tablerowend' & tabledefend
end Sub
'*********************************************************************
' If there are customer other fields, then add them to the for
' with there value. Vakues are stored in session variables c_xxxxxx
'****************************************************************
Sub AddOtherFields
dim words,wordcount, captions, capcount,cfieldname, fieldvalue
dim exludefields, excludecount, rc
dim i
redim words(Getconfig("xCustomerMaxotherfields"))
redim captions(getconfig("xCustomerMaxotherfields"))
redim excludefields(getconfig("xCustomerMaxotherfields"))
if Getconfig("xCustomerOtherFields")<>"" then
Parserecord Getconfig("xcustomerOtherFields"), words, wordcount,","
Parserecord getconfig("xcustomerOtherCaptions"), captions, capcount,","
If getconfig("xcustomerotherbypass")<>"" then
Parserecord getconfig("xcustomerOtherbypass"), excludefields, excludecount,","
else
excludecount=0
end if
for i = 0 to wordcount-1
if excludecount> 0 then
CustomerExcludetest words(i), excludefields, excludecount, rc
else
rc=0
end if
if rc=0 then
Cfieldname = "c_" & words(i)
fieldvalue=getsess(Cfieldname)
CreateCustRow captions(i),words(i), fieldvalue,"No"
end if
next
end if
end sub
'
'*******************************************************************
' For each customer other field set session values c_fieldname=value
'*******************************************************************
Sub CustomerGetFields
dim words,wordcount,customervalues,i, cfieldname, fieldvalue
dim required, requiredcount, testfield, j
if getconfig("xCustomerOtherFields")="" then exit sub
redim words(Getconfig("xCustomerMaxotherfields"))
redim Required(getconfig("xCustomerMaxotherfields"))
Parserecord getconfig("xcustomerOtherFields"), words, wordcount,","
If getconfig("xCustomerOtherrequired")<>"" then
Parserecord getconfig("xcustomerOtherRequired"), required, requiredcount,","
else
requiredcount=0
end if
for i = 0 to wordcount-1
cfieldname="c_" & words(i)
fieldvalue=request(words(i))
If fieldvalue=getlang("langcommonselect") then
fieldvalue=""
end if
setsess cfieldname, fieldvalue
next
SetSess "customerFieldcount",wordcount
If requiredcount=0 then exit sub
for i = 0 to requiredcount-1
testfield=required(i)
cfieldname="c_" & testfield
If getsess(cfieldname)="" Then
sError = sError & required(i) & " " & getlang("langCustRequired") & " "
end if
next
End sub
Sub AddCookieMessage
If getconfig("XCookielogin")<>"Yes" then exit sub
'Response.Write(TableDef)
Response.Write tablerow
Response.write "
"
Response.write TableColumn
If blncookiequestion="" then
blncookiequestion=TRUE
end if
If blncookiequestion then%>
<%Else%>
<%
End if
response.write tablecolumnend & tablerowend '& tabledefend
end Sub
Sub ValidateCustomerFields
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("xIncludeStates")="Yes" and strstate="??" then
strstate=""
end if
If getconfig("xstaterequired")="Yes" then
If getconfig("xPromptForState")="Yes" then
If strstate = "" Then
sError = sError & getlang("langCustState") & getlang("langCustRequired") & " "
End If
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 strEmail = "" Then
sError = sError & getlang("langCustEmail") & getlang("langCustRequired") & " "
Else
CustomerValidateEmail stremail
end If
'VP-ASP 6.08a - Company required wasn't being accounted for
If getconfig("xcompanyrequired") = "Yes" and strcompany="" Then
sError = sError & getlang("langcustcompany") & getlang("langCustRequired") & " "
End If
If getconfig("xCountryRequired")="Yes" then
If strcountry="" or strcountry="??" then
sError = sError & getlang("langCustCountry") & getlang("langCustRequired") & " "
End If
end if
If getconfig("xvatnumber")="Yes" then
validatevat strcountry
end if
If strhearaboutus=getlang("langcommonselect") then
strhearaboutus=""
end if
If getconfig("xhearaboutusrequired")="Yes" and strhearaboutus="" then
sError = sError & getlang("langhearaboutus") & getlang("langCustRequired") & " "
end if
end sub
'
Sub CustomerValidateEmail (stremail)
If Not InStr(strEmail, "@") > 1 Then
Serror=Serror & getlang("langInvalidEmail") & " "
end if
End sub
'***************************************************************************
' If there are shipping other fields add form name
'**************************************************************************
Sub ShippingAddOtherFields
dim words,wordcount, captions, capcount,i, cfieldname, fieldvalue
redim words(Getconfig("xCustomerMaxotherfields"))
redim captions(getconfig("xCustomerMaxotherfields"))
if Getconfig("xShippingOtherFields")<>"" then
Parserecord Getconfig("xShippingOtherFields"), words, wordcount,","
Parserecord getconfig("xShippingOtherCaptions"), captions, capcount,","
for i = 0 to wordcount-1
Cfieldname = "s_" & words(i)
fieldvalue=getsess(Cfieldname)
CreateCustRow captions(i),words(i), fieldvalue,"No"
next
end if
end sub
'******************************************************************
' Get values from shipping form
'********************************************************************
Sub ShippingGetOtherFields
dim words,wordcount,i, shippingfieldcount
dim cfieldname, fieldvalue
dim required, requiredcount, testfield, j
if getconfig("xshippingOtherFields")="" then exit sub
redim words(Getconfig("xCustomerMaxotherfields"))
redim Required(getconfig("xcustomerMaxotherfields"))
shippingFieldcount=Getsess("shippingFieldcount")
Parserecord getconfig("xshippingOtherFields"), words, wordcount,","
If getconfig("xshippingOtherrequired")<>"" then
Parserecord getconfig("xshippingOtherRequired"), required, requiredcount,","
else
requiredcount=0
end if
for i = 0 to wordcount-1
cfieldname="s_" & words(i)
fieldvalue=request(words(i))
If fieldvalue=getlang("langcommonselect") then
fieldvalue=""
end if
setsess cfieldname, fieldvalue
next
SetSess "shippingFieldcount",wordcount
If requiredcount=0 then exit sub
for i = 0 to requiredcount-1
testfield=ucase(required(i))
cfieldname="s_" & testfield
If getsess(cfieldname)="" then
sError = sError & required(i) & " " & getlang("langCustRequired") & " "
end if
next
End sub
'*********************************************************************
' see if customerid alread exists by userid
'********************************************************************
Sub ValidateUsername (strcustuserid, serror, rc)
dim conn, sql, rs
If serror<>"" then exit sub
If getconfig("xcustomeruserid")<>"Yes" then exit sub
Opencustomerdb conn
sql="select * from customers where userid='" & replace(strcustuserid,"'","") & "'"
set rs=conn.execute(sql)
if not rs.eof then
rc=4
sError = sError & getlang("langCustomerExists") & " "
end if
closerecordset rs
shopclosedatabase conn
end sub
'******************************************************************************
' Use xhowdidyourhear and values'
'****************************************************************************
Sub AddHowDidYouHear
dim words(50), wordcount, hearvalues
If getconfig("xhearaboutus")<>"Yes" then exit sub
hearvalues=getconfig("xhearaboutusvalues")
if hearvalues="" then exit sub
parserecord hearvalues,words,wordcount,","
'Response.Write TableDef & tablerow & TableColumn
Response.Write tablerow & "
"
if getconfig("xhearaboutusrequired")="Yes" then
response.write "*"
end if
Response.write getlang("langHearaboutus")
Response.write "
"
response.write tablecolumnend & tablerowend' & tabledefend
end Sub
Sub CustomerExcludetest (fieldname, excludefields, excludecount, rc)
dim i, lfieldname
lfieldname=lcase(fieldname)
for i = 0 to excludecount-1
if lfieldname=lcase(excludefields(i)) then
rc=4
exit sub
end if
next
rc=0
end sub
%>