<%
'****************************************
'Country DropDown list
'****************************************
Function getCountryDropDown(fieldname, fieldvalue)
Dim sCounryData
Dim varItem
Dim sSelected
if fieldvalue="" then
if fieldname = "Shipping Country" then
fieldvalue = Request.Form(fieldname)
else
fieldvalue = "208" 'Request.Form(fieldname)
end if
sCounryData = "Choose one"
end if
For GENERIC_VARIABLE=1 to UBound(Application("COUNTRY_LIST"))
varItem = Application("COUNTRY_LIST")(GENERIC_VARIABLE)
'varItem(1) = COUNTRY_CODE, varItem(2) = COUNTRY_NAME, varItem(3) = COUNTRY_CODE
sSelected = ""
IF trim(varItem(1)) = trim(fieldvalue) THEN sSelected = " SELECTED"
sCounryData = sCounryData & " " & trim(varItem(2))
Next
getCountryDropDown = sCounryData
End Function
'****************************************
'Country ID based on code
'****************************************
Function getCountryID (countrycode)
Dim varItem
Dim returnvalue
For GENERIC_VARIABLE=1 to UBound(Application("COUNTRY_LIST"))
varItem = Application("COUNTRY_LIST")(GENERIC_VARIABLE)
if UCASE(varItem(2)) = UCASE(countrycode) then
returnvalue = varItem(1)
Exit For
end if
Next
getCountryID = returnvalue
End Function
'****************************************
'Country Code based on Country ID
'****************************************
Function getCountryDesc (countryid)
Dim varItem
Dim returnvalue
For GENERIC_VARIABLE=1 to UBound(Application("COUNTRY_LIST"))
varItem = Application("COUNTRY_LIST")(GENERIC_VARIABLE)
if trim(varItem(1)) = trim(countryid) then
returnvalue = varItem(2)
Exit For
end if
Next
getCountryDesc = returnvalue
End Function
Function getCountryCode (countryid)
Dim varItem
Dim returnvalue
For GENERIC_VARIABLE=1 to UBound(Application("COUNTRY_LIST"))
varItem = Application("COUNTRY_LIST")(GENERIC_VARIABLE)
if trim(varItem(1)) = trim(countryid) then
returnvalue = varItem(3)
Exit For
end if
Next
getCountryCode = returnvalue
End Function
'****************************************
'State DropDown list
'****************************************
Function getStateDropDown(fieldname, fieldvalue)
Dim sStateData
Dim varItem
Dim sSelected
Dim stateID
if fieldvalue="" then
fieldvalue = Request.Form(fieldname)
sStateData = " Choose one"
end if
For GENERIC_VARIABLE=1 to UBound(Application("STATE_LIST"))
varItem = Application("STATE_LIST")(GENERIC_VARIABLE)
'varItem(1) = COUNTRY_CODE, varItem(2) = COUNTRY_NAME
sSelected = ""
stateID = trim(varItem(1))
IF stateID = trim(fieldvalue) THEN sSelected = " SELECTED"
If left(trim(varItem(2)),1) = "-" then
stateID = ""
end if
sStateData = sStateData & " " & trim(varItem(2))
Next
getStateDropDown = sStateData
End Function
'****************************************
'State ID based on code
'****************************************
Function getStateID (statecode)
Dim varItem
Dim returnvalue
For GENERIC_VARIABLE=1 to UBound(Application("STATE_LIST"))
varItem = Application("STATE_LIST")(GENERIC_VARIABLE)
if UCASE(varItem(3)) = UCASE(statecode) then
returnvalue = varItem(1)
Exit For
end if
Next
getStateID = returnvalue
End Function
'****************************************
'State Code based on state ID
'****************************************
Function getStateCode (stateid)
Dim varItem
Dim returnvalue
For GENERIC_VARIABLE=1 to UBound(Application("STATE_LIST"))
varItem = Application("STATE_LIST")(GENERIC_VARIABLE)
if trim(varItem(1)) = trim(stateid) then
returnvalue = varItem(3)
Exit For
end if
Next
getStateCode = returnvalue
End Function
'****************************************
'shipping method list
'****************************************
Function getShippingMethodDropDown(fieldname, fieldvalue,lCountryId )
Dim sShipData
Dim varItem
Dim sSelected
Dim isForeign
isForeign = "1"
'Response.Write("what is the countryid=" & iCountryId)
if lCountryId = "40" or lCountryId = "208" or lCountryId = "2223" then
isForeign = "0"
end if
if fieldvalue="" then
'fieldvalue = Request.Form(fieldname)
'sShipData = " Choose one"
isForeign = "0"
end if
For GENERIC_VARIABLE=1 to UBound(Application("SHIPPING_METHOD_LIST"))
varItem = Application("SHIPPING_METHOD_LIST")(GENERIC_VARIABLE)
'varItem(1) shipID, varItem(2) description
'SHIPPING_METHOD_ID,SHIPPING_METHOD_NAME,SHIPPING_METHOD_DESC,SHIPPING_METHOD_COST,SHIPPING_METHOD_CODE
sSelected = ""
if fieldvalue="0" then
fieldvalue = varItem(1)
end if
if trim(varItem(6)) = isForeign then
IF trim(varItem(1)) = trim(fieldvalue) THEN sSelected = " SELECTED"
end if
sShipData = sShipData & " " & trim(varItem(2))
Next
getShippingMethodDropDown = sShipData
End Function
'****************************************
'Shipping method based on ship method ID
'****************************************
Function getShippingMethodDesc (shipid)
Dim varItem
Dim returnvalue
For GENERIC_VARIABLE=1 to UBound(Application("SHIPPING_METHOD_LIST"))
varItem = Application("SHIPPING_METHOD_LIST")(GENERIC_VARIABLE)
if trim(varItem(1)) = trim(shipid) then
returnvalue = varItem(2)
Exit For
end if
Next
getShippingMethodDesc = returnvalue
End Function
'****************************************
'Shipping method code based on ship method ID
'****************************************
Function getShippingMethodCode (shipid)
Dim varItem
Dim returnvalue
For GENERIC_VARIABLE=1 to UBound(Application("SHIPPING_METHOD_LIST"))
varItem = Application("SHIPPING_METHOD_LIST")(GENERIC_VARIABLE)
if trim(varItem(1)) = trim(shipid) then
returnvalue = varItem(5)
Exit For
end if
Next
getShippingMethodCode = returnvalue
End Function
'****************************************
'CC type list
'****************************************
Function getCCDropDown(fieldname, fieldvalue)
Dim sCCData
Dim varItem
Dim sSelected
if fieldvalue="" then fieldvalue = Request.Form(fieldname)
if fieldvalue="" then
'sCCData = " Choose one"
end if
For GENERIC_VARIABLE=1 to UBound(Application("CC_LIST"))
varItem = Application("CC_LIST")(GENERIC_VARIABLE)
'varItem(1) = CC_CODE, varItem(2) = CC_NAME
sSelected = ""
'if fieldvalue="" then
' fieldvalue = varItem(1)
'end if
IF trim(varItem(1)) = trim(fieldvalue) THEN sSelected = " SELECTED"
sCCData = sCCData & " " & trim(varItem(2))
Next
sCCData = sCCData & " Gift Certificate only"
getCCDropDown = sCCData
End Function
'****************************************
'CC year
'****************************************
Function getCCYearDropDown(fieldname, fieldvalue)
Dim sCCYearData
Dim varItem
Dim sSelected
'if fieldvalue="" then
'fieldvalue = Request.Form(fieldname)
sCCYearData = " Select a Year"
'end if
For GENERIC_VARIABLE=year(now) to (year(now)+7)
sSelected = ""
IF trim(GENERIC_VARIABLE) = trim(fieldvalue) THEN sSelected = " SELECTED"
sCCYearData = sCCYearData & " " & trim(GENERIC_VARIABLE)
Next
getCCYearDropDown = sCCYearData
End Function
'****************************************
'CC Month
'****************************************
Function getCCMonthDropDown(fieldname, fieldvalue)
Dim sCCMonthData
Dim varItem
Dim sSelected
'if fieldvalue="" then
'fieldvalue = Request.Form(fieldname)
sCCMonthData = " Select a Month"
'end if
For GENERIC_VARIABLE=1 to 12
sSelected = ""
IF trim(GENERIC_VARIABLE) = trim(fieldvalue) THEN sSelected = " SELECTED"
sCCMonthData = sCCMonthData & " " & trim(GENERIC_VARIABLE)
Next
getCCMonthDropDown = sCCMonthData
End Function
'****************************************
'builds year/month/days drop down
'flag values are m,y,d
'****************************************
function getdropdown(flag)
dim yr
dim dd
dim mm
dim iFrom
dim iTo
dim iCurrent
dim i
yr = year(now)
dd = day(now)
mm = month(now)
if flag = "m" then
iFrom = 1
iTo=12
iCurrent = Request.QueryString("month")
if iCurrent="" then iCurrent = mm
elseif flag = "d" then
iFrom = 1
iTo=31
iCurrent = Request.QueryString("day")
if iCurrent="" then iCurrent = dd
elseif flag = "y" then
iFrom = yr
iTo=yr+1
iCurrent = Request.QueryString("year")
if iCurrent="" then iCurrent = yr
end if
for i=iFrom to iTo
if i=iCurrent then
Response.Write " " & i
else
Response.Write " " & i
end if
next
end function
'****************************************
'builds year drop down for admin
'****************************************
function getadminyeardropdown()
dim yr
dim iFrom
dim iTo
dim iCurrent
dim i
yr = year(now)
iFrom = yr-3
iTo=yr+1
iCurrent = Request.QueryString("year")
if iCurrent="" then iCurrent = yr
for i=iFrom to iTo
if i=iCurrent then
Response.Write " " & i
else
Response.Write " " & i
end if
next
end function
'****************************************
'to get order status values
'****************************************
function getOrderStatusDropdown(selval)
dim adminlsql
Dim varItems
dim radmins
dim sSelected
adminlsql = "SELECT ORDER_STATUS_ID,STATUS_DESC FROM WP_ORDER_STATUS WHERE ORDER_STATUS_ID>1"
radmins = getRecordSetList(adminlsql)
For GENERIC_VARIABLE=1 to UBound(radmins)
varItems = radmins(GENERIC_VARIABLE)
if varItems(1) = selval then sSelected = " selected "
Response.Write " " & varItems(2)
NEXT
end function
'****************************************
'validate Form Fields..
'types are "EMAIL"
'****************************************
Function validateForm(fieldType, isRequired, Byref ERROR_MESSAGE, value, fieldname )
on error resume next
Dim newstr
Dim newi
Dim btruefalse
Dim ccmonth
Dim ccyear
value = trim(value)
newstr = value
if isRequired = true and trim(value)="" then
ERROR_MESSAGE = ERROR_MESSAGE & "" & fieldname & " is required."
elseif isRequired = false and trim(value)="" then
elseif fieldType = "EMAIL" then
if Instr(1, value, "@") <=0 or Instr(1, value, ".")<=0 then
ERROR_MESSAGE = ERROR_MESSAGE & " Invalid Email Format."
end if
elseif fieldType = "PASSWORD" then
if len(value)<4 then
ERROR_MESSAGE = ERROR_MESSAGE & " Passowrd must be more than 4 characters."
end if
elseif fieldType = "USPHONE" or fieldType = "CANPHONE" then
newstr = replace(newstr, "-", "")
newstr = replace(newstr, ".", "")
newstr = replace(newstr, "(", "")
newstr = replace(newstr, ")", "")
newstr = replace(newstr, " ", "")
newstr = cdbl(newstr)
if err.number > 0 or len(newstr)<10 then
ERROR_MESSAGE = ERROR_MESSAGE & " " & fieldname & " - Invalid Phone Number."
end if
elseif fieldType = "USZIP" then
'US format should be like '55555' or '88888-5555'
btruefalse = False
newi = InStr(1, newstr, "-")
If newi > 0 Then
newstr = Mid(Value, 1, newi - 1)
End If
'first 5 digits
If Len(newstr) = 5 Then btruefalse = True
If CDbl(newstr) >= 0 And btruefalse = True Then
If Err.Number > 0 Then btruefalse = False
End If
'check for the last 4 digit if entered
If newi > 0 And btruefalse = True Then
btruefalse = False
If Len(Mid(Value, newi + 1)) = 4 Then
btruefalse = True
End If
If CDbl(Mid(Value, newi + 1)) >= 0 And btruefalse = True Then
If Err.Number > 0 Then btruefalse = False
End If
End If
if btruefalse=false then
ERROR_MESSAGE = ERROR_MESSAGE & " " & fieldname & " - Invalid Zip."
end if
elseif fieldType = "CANZIP" then
btruefalse = False
'candian format should be like 'X9X9X'
If Len(newstr) = 5 Then btruefalse = True
Dim ischar
newstr = UCase(newstr)
ischar = True
For newi = 1 To 5
If ischar = True Then
If Asc(Mid(newstr, newi, 1)) > 60 And Asc(Mid(newstr, newi, 1)) < 92 Then
btruefalse = True
Else
btruefalse = False
End If
ischar = False
Else
If CInt(Mid(newstr, newi, 1)) >= 0 Then
If Err.Number > 0 Then btruefalse = False
End If
ischar = True
End If
If btruefalse = False Then Exit For
Next
elseif fieldType = "CCNUMBER" then
validateCCNumber newstr, ERROR_MESSAGE
elseif fieldType = "CCEXPIRATION_MONTH" then
ccyear = trim(Request.Form("Card Expiration year"))
ccmonth = trim(Request.Form("Card Expiration Month"))
if cint(ccmonth)Invalid Credit Card Expiration Month."
end if
elseif fieldType = "CCEXPIRATION_MONTH" or fieldType = "CCEXPIRATION_YEAR" then
ccyear = trim(Request.Form("Card Expiration year"))
if cint(ccyear)Invalid Credit Card Expiration Year."
end if
elseif fieldType = "GC" then
'need to validate GC by sending a transaction if ecomtery is enabled
if ECOMETRY_ENABLED=true then
if value <> "" then
Dim GCReturn
GCReturn = call_trans00063(value, "", "")
If GCReturn = "F" then 'error
ERROR_MESSAGE = ERROR_MESSAGE & "" & value & " is an invalid Gift Certficate number."
end if
end if
end if
end if
validateForm = value
end function
'****************************************
'validate CC card
'****************************************
Sub validateCCNumber(newstr, Byref ERROR_MESSAGE)
on error resume next
Dim tmpnewstr
Dim sNumbersOnly
Dim iFirstDig
Dim iSecondDig
Dim sCardType
sCardType = trim(Request.Form("Credit Card Type"))
newstr = replace(newstr, "-", "")
newstr = replace(newstr, ".", "")
newstr = replace(newstr, " ", "")
tmpnewstr = cdbl(newstr)
if err.number > 0 then
ERROR_MESSAGE = ERROR_MESSAGE & " Please recheck the credit card information you have entered."
else
sNumbersOnly=newstr
iFirstDig = cint(left(sNumbersOnly,1))
iSecondDig = cint(mid(sNumbersOnly,2,1))
if sCardType = "VI" then
if (len(sNumbersOnly) <> 16 and len(sNumbersOnly <> 13)) or iFirstDig <> 4 then
ERROR_MESSAGE = ERROR_MESSAGE & " Please recheck the credit card information you have entered."
end if
elseif sCardType = "MC" then
if len(sNumbersOnly) <> 16 or iFirstDig <> 5 or iSecondDig < 1 or iSecondDig > 5 then
'ERROR_MESSAGE = ERROR_MESSAGE & " sNumbersOnly=" & sNumbersOnly & "==iFirstDig=" & iFirstDig & "==iSecondDig=" & iSecondDig
ERROR_MESSAGE = ERROR_MESSAGE & " Please recheck the credit card information you have entered..."
end if
elseif sCardType = "AX" then
if len(sNumbersOnly) <> 15 or iFirstDig <> 3 then
ERROR_MESSAGE = ERROR_MESSAGE & " Please recheck the credit card information you have entered."
end if
elseif sCardType = "DI" then 'Discover
if len(sNumbersOnly) <> 16 or iFirstDig <> 6 or iSecondDig <> 0 then
ERROR_MESSAGE = ERROR_MESSAGE & " Please recheck the credit card information you have entered."
end if
elseif sCardType = "DS" then 'Diner's Club
if len(sNumbersOnly) <> 14 or iFirstDig <> 3 or iSecondDig <> 0 then
ERROR_MESSAGE = ERROR_MESSAGE & " Please recheck the credit card information you have entered."
end if
elseif sCardType = "JCB" then 'Diner's Club
if len(sNumbersOnly) <> 16 or iFirstDig <> 3 then
ERROR_MESSAGE = ERROR_MESSAGE & " Please recheck the credit card information you have entered."
end if
end if
' -- Calculate check sum --
Dim sMask
Dim iCheckSum
Dim itmp
Dim iResult
sMask = "2121212121212121"
sMask = Mid(sMask, len(sMask)-len(sNumbersOnly),len(sMask))
iCheckSum = 0
For itmp=1 to len(sNumbersOnly)
iResult = mid(sNumbersOnly, i,(i+1)) * mid(sMask, i,(i+1))
if iResult > 9 then
iResult = iResult - 9
end if
iCheckSum = iCheckSum + iResult
Next
iCheckSum = iCheckSum mod 10
if iCheckSum <> 0 then
ERROR_MESSAGE = ERROR_MESSAGE & " Please recheck the credit card information you have entered."
end if
end if
End sub
'********************************************************************************
'to validate Gift Certificate
'********************************************************************************
Function call_trans00063(certificateNo , MACSUSERID, ByRef certificateAmt)
Dim icount
Dim trans0063
Dim webresponse
Dim sReturn
set trans0063 = server.CreateObject(webcom & "trans0063")
trans0063.Company = MACS_COMPANY
trans0063.Division = MACS_DIVISION
trans0063.Host = HOST_NAME
trans0063.Port = WEBREQST
trans0063.CartID=MACSUSERID
trans0063.SetGCNo certificateNo, 1
trans0063.SetGCAmt "000000", 1
webresponse = Trim(trans0063.GetValue("SuccessFlag",0))
if webresponse = "N" or webresponse = "n" then
sReturn = "F"
else
'For icount=1 to 18
icount=1
if Trim(trans0063.GetValue("BadNumber",icount)) = certificateNo then
'set trans0063=nothing
sReturn = "F"
end if
if Trim(trans0063.GetValue("GoodNumber",icount)) = certificateNo then
'set trans0063=nothing
sReturn = "S"
certificateAmt = Trim(trans0063.GetValue("GoodAmount",icount))
end if
'next
end if
'Response.Write certificateNo & webresponse & "