<%
DIM sDSN
' For help setting your database connection, please go to the following URL
' http://www.ecommercetemplates.com/help/ecommplus/faq.asp#faq8
' IMPORTANT ! ! After setting your database connection you MUST MAKE SURE THE DATABASE CANNOT BE DOWNLOADED
' Failure to do this will mean someone could get hold of your site admin username and password.
' More details about this are available here http://www.ecommercetemplates.com/help/checklist.asp#asp
'sDSN = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath("/fpdb/vsproducts.mdb") ' Microsoft Access 2000 using mapped path
sDSN = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=i:\customerwebs\coyotegraphics\dds\fpdb\vsproducts.mdb;" ' Microsoft Access 2000
' Please note, for SQL Server you must have an SQL Server database available. Most people will want to use the Access database provided.
'sDSN = "driver={SQL Server};server=SERVERNAME;uid=USERNAME;pwd=PASSWORD;database=DATABASENAME" ' SQL Server
%>
<%
' For a description of these parameters and their useage, please open the following URL in your browser
' http://www.ecommercetemplates.com/help/ecommplus/parameters.asp
sortBy = 1
'pathtossl = "http://www.dynamicdentalsolutions.net"
taxShipping=0
pagebarattop=0
productcolumns=2
useproductbodyformat=1
usesearchbodyformat=1
usedetailbodyformat=1
usecategoryformat=1
useemailfriend=true
nobuyorcheckout=false
noprice=false
expireaffiliate=30
sqlserver=false
usecategoryformat=3
allproductsimage=""
nogiftcertificate=false
showtaxinclusive=false
upspickuptype="03"
overridecurrency=false
orcsymbol="AU$ "
orcemailsymbol="AU$ "
orcdecplaces=2
orcpreamount=true
encryptmethod="none"
commercialloc=true
showcategories=true
termsandconditions=false
showquantonproduct=false
showquantondetail=false
addshippinginsurance=0
noshipaddress=false
pricezeromessage=""
showproductid=false
currencyseparator=" "
noproductoptions=false
invoiceheader=""
invoiceaddress=""
invoicefooter=""
dumpccnumber=false
actionaftercart=1
dateadjust=0
emailorderstatus=3
htmlemails=false
categorycolumns=4
noshowdiscounts=false
catseparator=" "
willpickuptext=""
willpickupcost=0
extraorderfield1=""
extraorderfield1required=false
extraorderfield2=""
extraorderfield2required=false
htmleditor="tinymce"
enableclientlogin=true
allowclientregistration=true
pagebarattop=1
crosssellaction="alsobought,bestsellers"
' ===================================================================
' Please do not edit anything below this line
' ===================================================================
maintablebg=""
innertablebg=""
maintablewidth="98%"
innertablewidth="100%"
maintablespacing="0"
innertablespacing="0"
maintablepadding="1"
innertablepadding="6"
headeralign="left"
Session.LCID = 1033
const maxprodopts=15
const helpbaseurl="http://www.ecommercetemplates.com/help/ecommplus/"
Function Max(a,b)
if a > b then
Max=a
else
Max=b
end if
End function
Function Min(a,b)
if a < b then
Min=a
else
Min=b
end if
End function
%>
<% ' Please make sure this line is the first line in this file.
xxDeAdd="Delete Address"
xxPlWtFw="Please wait while we forward you to view your cart contents."
xxCrNwAc="Create Account"
xxExNoMa="Existing password does not match"
xxOldPwd="Old Password"
xxNewPwd="New Password"
xxRptPwd="Repeat New Password"
xxPwdChg="Enter your old password and new password below only if you wish to change your password."
xxPwdMat="Password fields do not match"
xxCancel="Cancel"
xxReset="Reset"
xxAccDet="Account Details"
xxChaAcc="To change account details or password please"
xxNevDiv="(We will never divulge your email to a 3rd party)"
xxAlPrEm="Allow Promotional Emails"
xxAltCar="Or select an alternate shipping carrier to compare rates."
xxCpnNoF="Coupon Not Found!"
xxAppCpn="Apply Coupon"
xxMusLog="You must be logged in to access your customer account."
xxCusAcc="Customer Account"
xxLogout="Logout"
xxEntEm="Please enter the email address associated with this account and click ""Submit""."
xxSenPw="Your login details have been sent as requested to your email address."
xxSorPw="Sorry. We could not find that email address in our system."
xxLosPw1="We received a request to resend your password for your account at "
xxLosPw2="Your details are as follows."
xxLosPw3="If you received this email in error you need take no action."
xxForPas="Forgot Password?"
xxNoOrd="No matching orders."
xxNoAdd="No registered addresses."
xxDelAdd="Are you sure you want to delete this address?"
xxMisc="Miscellaneous"
xxShpAdd="Shipping Address"
xxBilAdd="Billing Address"
xxSamAs="Same as billing address"
xxEmExi="The email address you entered already exists."
xxBfChk="Before proceeding with checkout, you must"
xxOrdMan="Order Management"
xxAddMan="Address Management"
xxPCAdd="To add a new address, please"
xxUpdSuc="Update Successful!"
xxEdAdd="Edit Address"
xxNoLogD="Could not find login details."
xxNewAcc="New Account"
xxRemLog="Remember login on this computer?"
xxCrAc="create an account"
xxToCrAc="to create an account"
xxOr="or"
xxNotLI="You are not currently logged in."
xxTLIP="To log in please"
xxTLOP="To logout please"
xxLiDets="Login Details"
xxYes="Yes"
xxNo="No"
xxGooCo="Use the new, secure Google Checkout service."
xxPrint="Printable Version"
xxTrackT="%s"
xxTraNum="Tracking Number"
xxAddToC="Add to cart"
xxOpSkTx=" (%s)"
xxShipHa="Shipping and Handling"
xxPlsSta="Please select your ship state"
xxPlsZip="Please enter your zip code"
xxInStoc="In Stock"
xxInsuff="Insufficient Stock Warning"
xxOnlyAd="Only %s of the item you requested are available in stock and these have been added to your cart."
xxWanRem="If you wish to remove this item from your cart please click below."
xxGo="Go"
xxPPPend="Thank you for your order!
Your order has been approved by PayPal with a status of "Pending". We will be in touch as soon as the funds have cleared."
xxInsDe2="Inside Delivery"
xxInsDel="Please click here if your freight shipment requires an inside delivery"
xxSigRe2="Signature Release"
xxSigRel="Have Signature Release Authorization Number. (Please enter Authorization Number Below in Additional Info.)"
xxCerCLo="Customer certifies shipping is to a commercial location."
xxShiInI="Shipping insurance included."
xxSatDeR="Saturday delivery required."
xxSatDe2="Saturday Delivery"
xxSatDel="Please check this box to have your products delivered on a Saturday."
xxPPPBlu="Or Checkout with PayPal Express Save time and use your PayPal account information to checkout with PayPal."
xxShpEst="Shipping Estimate"
xxMCShpE="Shipping Est"
xxShpIns="Shipping Insurance"
xxAddress2="Address Line 2"
xxNoCnf="Sorry, we have not yet received payment confirmation. Please wait 5 minutes then refresh this browser window."
xxCOTxt="Checkout"
xxDlPros="Download Products"
xxDlPro="Download Product"
xxDownl="Download"
xxGuar="Delivery"
xxMainWn="See main window"
xxWrnChQ="If you change quantities then you have to have to click the ""Update Totals"" link for them to take effect. Please press ""OK"" to update totals or ""Cancel"" to continue without updating."
xxDays="days"
xxDay="day"
xxCCName="Name (as it appears on card)"
xxNoJS="Javascript seems to be currently disabled in your browser."
xxNoCk="Cookies seem to be currently disabled in your browser."
xxSecWar="This could mean that this shopping site will not function correctly. If you experience problems, please check that your browsers security settings are not set to too high a level and that you don't have a firewall blocking cookies or javascript."
xxCommis="Commission"
xxCCDets="Credit Card Details"
xxOptOOS="I'm sorry, that particular option is currently out of stock"
xxHST="HST"
xxPrOpts="Options"
xxValEm="Please enter a valid email address."
xxLIDis="Discounts applicable to login: "
xxMLLIS="Login Status"
xxMLLIA="Logged in as "
xxMLNLI="Not logged in"
xxAutFo="You will now be forwarded automatically."
xxLOSuc="You have logged out successfully!"
xxLISuc="Login Successful!"
xxNoLog="Sorry, your username and password were not found. Please try again."
xxPlEnt="Please enter your username and password."
xxSubmt="Submit"
xxWrCk="Please click here to write a cookie to remember your username and password."
xxLogin="Login"
xxFulNam="This message will not be shown again.\nPlease be sure to enter your first and last name in the field"
xxCntryTxt2=""
xxCLoc="Commercial Loc"
xxWtIns=" (With Insurance)"
xxStaVw="View Order Status"
xxStaCur="This is the current status for your order number"
xxStatus="Status"
xxStaErr="The following error occurred"
xxStaEr1="Please enter a valid order id."
xxStaEr2="Sorry, we could not find an order matching that order id and email address. Please try again."
xxStaEnt="Please enter your order id and the email address used on the order."
xxDate="Date"
xxTime="Time"
xxEFRec=" recommends this site"
xxEFThk="Thank you, your recommendation has been sent."
xxClkClo="Please click below to close this window."
xxSend="Send"
xxWantIns="Please click here to include shipping insurance."
xxPlsProc="Please proceed only if you are in acceptance of our terms and conditions.\nYou must signal your acceptance by checking the box."
xxTermsCo="Please click here if you are in acceptance of our terms and conditions. To review our terms and conditions, please click here."
xxComLoc="Please click here if your shipping destination is a commercial location."
xxValCC="Please enter a valid credit card number."
xxCCMon="Please select your credit card expiry month."
xxCCYear="Please select your credit card expiry year."
xxDot=""
xxEFYF1="Your friend "
xxEFYF2=" has recommended this site to you"
xxEFYF3=", and sends you the following message:"
ssIncTax="(%s Inc. Tax)"
xxMCCO="Checkout"
xxMCSC="Shopping cart"
xxMCIIC="Product(s) in cart"
xxHndlg="Handling"
xxFree="Free"
xxDscnts="Discounts"
xxDsProd="The following discounts apply to all these products."
xxDsCat="The following discounts apply in all these categories."
xxDsApp="Discounts Apply !"
xxAppDs="Applicable Discounts"
xxTotDs="Total Discounts"
xxSubTot="Sub Total"
xxGifCer="Coupon Number"
xxGifNum="Coupon or Discount Number"
xxGifEnt="If you have a coupon or discount number, please enter it here."
xxNoGfCr="The discount number you entered (%s) was not found, has expired or is not applicable. Please click here if you wish to go back and try again."
xxListPrice="List Price:%s"
xxHomeURL="categories.asp"
xxHome="Home"
xxOutStok="Out of Stock"
xxOutState="Outside USA"
xxState="State (US)"
xxAllSta="State"
xxNonState="State (Non US)"
xxCntryTxt="United States of America"
xxPlsSel="Please Select..."
xxAddOrd="has been added to your order."
xxPlsWait="Please wait while we forward you to view the contents of your cart or "
xxClkHere="click here"
xxSrryItm="Sorry, the item"
xxIsCntly="is currently"
xxOutStck="out of stock."
xxTemprly="temporarily"
xxNotChOu=""Temporarily" means that the product has been added to someones shopping cart, but they have not checked out. If they do not complete the purchase, the product will be free in"
xxChkBack=", so please check back."
xxShrtWhl="a short while"
xxPlease="Please"
xxToRetrn="to return to the products page."
xxPlsEntr="Please enter a value in the field"
xxAlphaNu="Please enter only alphanumeric characters with no spaces in the field"
xxShpDtls="If you set the shipping address, please complete all shipping details."
xxShpDiff="Shipping Details. (If different from above)."
xxNoMeth="There are no methods available for your shipping destination."
xxPlsSlct="Please select a"
xxName="Full Name"
xxEmail="Email"
xxAddress="Address"
xxCity="City"
xxZip="Zip"
xxPhone="Phone"
xxCountry="Country"
xxWntRem="Do you want us to remember your customer details for the next time you visit?\n\nOk=Yes, Cancel=No."
xxCstDtl="Please enter your customer details."
xxAddInf="Additional Information"
xxRemMe="Remember me."
xxOpCook="Use this option to write a cookie to allow us to prepopulate this form the next time you visit."
xxNoPay="No Payment Methods Configured."
xxClkCmp="Please click below to complete your transaction."
xxPlsChz="Payment method"
xxShpOpt="Please select a shipping option from those below."
xxSryErr="Sorry, there was an error processing your request."
xxChkCmp="Check totals and proceed to process payment."
xxTotGds="Total Goods"
xxShippg="Shipping"
xxStaTax="State Tax"
xxCntTax="Country Tax"
xxGndTot="Grand Total"
xxCrdNum="Card Number"
xxExpEnd="Expires End"
xxMonth="Month"
xxYear="Year"
xx34code="3 or 4 digit code from back of card"
xxIfPres="(if present)"
xxMstClk="You must click below to complete the checkout process."
xxTrnRes="Transaction Result"
xxOrdNum="Order Number"
xxAutCod="Authorization Code"
xxSorTrn="I'm sorry, there was a problem with your transaction."
xxGoBack="Go Back and Try Again"
xxNoStok="One or more of your update requests could not be completed as there is not sufficient stock."
xxCODets="Details"
xxCOName="Name"
xxCOUPri="Unit Price"
xxCOSel="Select"
xxQuant="Quantity"
xxTotal="Total"
xxDelete="Delete"
xxCntShp="Continue Shopping"
xxUpdTot="Update Totals"
xxSryEmp="Sorry, your shopping cart is empty"
xxPrsChk="Press checkout to enter your customer and shipping information."
xxNoCats="This category is not currently available."
xxClkCat="Please click on a category to view sub categories."
xxAlProd="All Products"
xxAlPrCa="View all products in all categories."
xxNoPrds="No products are currently available in this category."
xxClkPrd="Please click on a category to view products."
xxPrdEnt="Please enter a value where indicated."
xxPrdChs="Please choose from the available product options."
xxPrd255="Please enter a maximum of 255 chars in the field indicated."
xxPrice="Price"
xxPrDets="Details"
xxEmFrnd="Email Friend"
xxCusDet="Customer Details"
xxShpDet="Shipping Details"
xxShpMet="Shipping Method"
xxPrId="Product ID"
xxPrNm="Product Name"
xxUnitPr="Unit Price"
xxOrdTot="Order Total"
xxOrdStr="Order at your store"
xxTnxOrd="Thank you for your order"
xxTouSoo="We will be in touch as soon as possible about your order. Please note that the appropriate state sales tax will be added to your order, the details of which are as follows:"
xxAff1="Your affiliate link has just generated a sale totalling"
xxAff2="Please note that this is for information only as commission is only paid on cleared funds."
xxAff3="Affiliate partner sale"
xxThnks="Thank You."
xxThkYou=" Thank you for your purchase !
We will be in contact as soon as possible.
"
xxThkErr=" Sorry, there seemed to be an error !
If you need any help with your purchase, then please be sure to contact us.
"
xxRecEml="You will receive a copy of this receipt by email."
xxPrev="Previous"
xxNext="Next"
xxSrchPr="Search Products"
xxSrchFr="Search For"
xxSrchMx="Max Price"
xxSrchTp="Search Type"
xxSrchAl="All words"
xxSrchAn="Any word"
xxSrchEx="Exact Phrase "
xxSrchCt="In Category"
xxSrchAC="All Categories"
xxSrchNM="Sorry, no products matched your search."
xxAffPrg="Affiliate Partners Program."
xxWelcom="Welcome"
xxAffLog="Your login is correct. Please wait while we forward you to view your account details."
xxAffDts="Please enter your affiliate details."
xxAffUse="I'm sorry, that affiliate ID is already in use. Please choose another."
xxForAut="If you are not forwarded automatically, please"
xxInform="Please note. By checking the "inform me" option, you will receive an email notification every time your affiliate link generates a sale."
xxInfMe="Inform me"
xxAffLI="Login to your affiliate account"
xxAffID="Affiliate ID"
xxBack="Back to Account Details"
xxNewAct="Open new affiliate account"
xxGotAct="For those who already have an affiliate account."
xxAffNo="Sorry, we could not find your affiliate login / password."
xxPwd="Password"
xxTotTod="Total so far today"
xxTotYes="Total yesterday"
xxTotMTD="Total month to date"
xxTotLM="Total last month"
xxEdtAff="Edit Affiliate Details"
xxAffLI1="To set up your affiliate link, use any page with a .asp extension, for instance"
xxAffLI2="Please note that these totals are only provisional. Commission will only be paid on cleared funds, and sometimes sales are "charged back"."
xxAffLI3="The above totals are for sales generated, not commission due."
xxEFNam="Your Name"
xxEFEm="Your Email"
xxEFFEm="Your Friends Email"
xxEFCmt="Your Comments"
xxClsWin="Close Window"
xxEFBlr="Let your friends know all about the great deals that are on offer at this site. Just fill in the details below and click "Send"."
xxSearch="Search"
xxOrdId="Order ID"
xxInAssc="In Association with"
xxTnkStr="Thank You For Shopping at Our Store"
xxTnkWit="Thank you for shopping with"
xxMerRef="Merchant's Reference"
xxPlsNt1="Please take note of the above information, and quote the"
xxPlsNt2="if you need to contact our store for any reason."
xxOrdNIs="Your order number is"
xxClkBck="Please Click Here to Head Back to Our Store"
' Please make sure this line is the last line in this file %>
<%
'This code is copyright (c) Internet Business Solutions SL, all rights reserved.
'The contents of this file are protect under law as the intellectual property
'of Internet Business Solutions SL. Any use, reproduction, disclosure or copying
'of any kind without the express and written permission of Internet Business
'Solutions SL is forbidden.
'Author: Vince Reid, vince@virtualred.net
Dim gasaReferer,gasaThisSite,datedelim
Dim splitUSZones,countryCurrency,useEuro,storeurl,stockManage,handling,adminCanPostUser,packtogether,origZip,shipType,adminIntShipping,saveLCID,delccafter,adminTweaks,currRate1,currSymbol1,currRate2,currSymbol2,currRate3,currSymbol3,upsUser,upsPw
Dim origCountry,origCountryCode,uspsUser,uspsPw,upsAccess,fedexaccount,fedexmeter,adminUnits,adminlanguages,adminlangsettings,useStockManagement,adminProdsPerPage,countryTax,countryTaxRate,currLastUpdate,currConvUser,currConvPw,emailAddr,sendEmail,emailObject,themailhost,theuser,thepass
incfunctionsdefined=true
function ip2long(ip2lip)
ipret = -1
iparr = split(ip2lip, ".")
if isarray(iparr) then
if UBOUND(iparr)=3 then
if isnumeric(iparr(0)) AND isnumeric(iparr(1)) AND isnumeric(iparr(2)) AND isnumeric(iparr(3)) then
ipret = (iparr(0) * 16777216) + (iparr(1) * 65536) + (iparr(2) * 256) + (iparr(3))
end if
end if
end if
ip2long = ipret
end function
if Trim(request.querystring("PARTNER"))<>"" OR Trim(request.querystring("REFERER"))<>"" then
if expireaffiliate = "" then expireaffiliate=30
if Trim(request.querystring("PARTNER"))<>"" then thereferer=Trim(request.querystring("PARTNER")) else thereferer=Trim(request.querystring("REFERER"))
response.write ""
end if
if mysqlserver=true then sqlserver=true
if sqlserver=true then datedelim = "'" else datedelim = "#"
codestr="2952710692840328509902143349209039553396765"
if emailencoding="" then emailencoding="iso-8859-1"
if adminencoding="" then adminencoding="iso-8859-1"
if Session("languageid") <> "" then languageid=Session("languageid")
function getadminsettings()
if NOT alreadygotadmin then
if saveadmininapplication AND Application("getadminsettings")<>"" then
splitUSZones = Application("splitUSZones")
if orlocale<>"" then saveLCID = orlocale else saveLCID = Application("saveLCID")
Session.LCID = saveLCID
countryCurrency = Application("countryCurrency")
useEuro = Application("useEuro")
storeurl = Application("storeurl")
stockManage = Application("adminStockManage")
useStockManagement = Application("useStockManagement")
adminProdsPerPage = Application("adminProdsPerPage")
countryTax = Application("countryTax")
countryTaxRate = Application("countryTax")
delccafter = Application("delccafter")
handling = Application("handling")
adminCanPostUser = Application("adminCanPostUser")
packtogether = Application("packtogether")
origZip = Application("origZip")
shipType = Application("shipType")
adminIntShipping = Application("adminIntShipping")
origCountry = Application("origCountry")
origCountryCode = Application("origCountryCode")
uspsUser = Application("uspsUser")
uspsPw = Application("uspsPw")
upsUser = Application("upsUser")
upsPw = Application("upsPw")
upsAccess = Application("upsAccess")
fedexaccount = Application("fedexaccount")
fedexmeter = Application("fedexmeter")
adminUnits = Application("adminUnits")
emailObject = Application("emailObject")
themailhost = Application("themailhost")
theuser = Application("theuser")
thepass = Application("thepass")
emailAddr = Application("emailAddr")
sendEmail = Application("sendEmail")
adminTweaks = Application("adminTweaks")
adminlanguages = Application("adminlanguages")
adminlangsettings = Application("adminlangsettings")
currRate1 = Application("currRate1")
currSymbol1 = Application("currSymbol1")
currRate2 = Application("currRate2")
currSymbol2 = Application("currSymbol2")
currRate3 = Application("currRate3")
currSymbol3 = Application("currSymbol3")
currConvUser = Application("currConvUser")
currConvPw = Application("currConvPw")
currLastUpdate = Application("currLastUpdate")
else
sSQL = "SELECT adminEmail,emailObject,smtpserver,emailUser,emailPass,adminEmailConfirm,adminTweaks,adminProdsPerPage,adminStoreURL,adminHandling,adminPacking,adminDelCC,adminUSZones,adminStockManage,adminShipping,adminIntShipping,adminCanPostUser,adminZipCode,adminUnits,adminUSPSUser,adminUSPSpw,adminUPSUser,adminUPSpw,adminUPSAccess,FedexAccountNo,FedexMeter,adminlanguages,adminlangsettings,currRate1,currSymbol1,currRate2,currSymbol2,currRate3,currSymbol3,currConvUser,currConvPw,currLastUpdate,countryLCID,countryCurrency,countryName,countryCode,countryTax FROM admin INNER JOIN countries ON admin.adminCountry=countries.countryID WHERE adminID=1"
rs.Open sSQL,cnn,0,1
splitUSZones = (Int(rs("adminUSZones"))=1)
if orlocale<>"" then
Session.LCID = orlocale
elseif rs("countryLCID")<>0 then
Session.LCID = rs("countryLCID")
end if
saveLCID = Session.LCID
countryCurrency = rs("countryCurrency")
if orcurrencyisosymbol<>"" then countryCurrency=orcurrencyisosymbol
useEuro = (countryCurrency="EUR")
storeurl = rs("adminStoreURL")
stockManage = rs("adminStockManage")
useStockManagement = (rs("adminStockManage")<>0)
adminProdsPerPage = rs("adminProdsPerPage")
countryTax=cDbl(rs("countryTax"))
countryTaxRate=cDbl(rs("countryTax"))
delccafter = Int(rs("adminDelCC"))
handling = cDbl(rs("adminHandling"))
adminCanPostUser = trim(rs("adminCanPostUser"))
packtogether = Int(rs("adminPacking"))=1
origZip = rs("adminZipCode")
shipType = Int(rs("adminShipping"))
adminIntShipping = Int(rs("adminIntShipping"))
origCountry = rs("countryName")
origCountryCode = rs("countryCode")
uspsUser = rs("adminUSPSUser")
uspsPw = rs("adminUSPSpw")
upsUser = upsdecode(rs("adminUPSUser"), "")
upsPw = upsdecode(rs("adminUPSpw"), "")
upsAccess = rs("adminUPSAccess")
fedexaccount = rs("FedexAccountNo")
fedexmeter = rs("FedexMeter")
adminUnits=Int(rs("adminUnits"))
emailObject = rs("emailObject")
themailhost = Trim(rs("smtpserver")&"")
theuser = Trim(rs("emailUser")&"")
thepass = Trim(rs("emailPass")&"")
emailAddr = rs("adminEmail")
sendEmail = Int(rs("adminEmailConfirm"))=1
adminTweaks = Int(rs("adminTweaks"))
adminlanguages = Int(rs("adminlanguages"))
adminlangsettings = Int(rs("adminlangsettings"))
currRate1=cDbl(rs("currRate1"))
currSymbol1=trim(rs("currSymbol1")&"")
currRate2=cDbl(rs("currRate2"))
currSymbol2=trim(rs("currSymbol2")&"")
currRate3=cDbl(rs("currRate3"))
currSymbol3=trim(rs("currSymbol3")&"")
currConvUser=rs("currConvUser")
currConvPw=rs("currConvPw")
currLastUpdate=rs("currLastUpdate")
rs.Close
if saveadmininapplication=TRUE then
Application.Lock()
Application("splitUSZones") = splitUSZones
Application("saveLCID") = saveLCID
Application("countryCurrency") = countryCurrency
Application("useEuro") = useEuro
Application("storeurl") = storeurl
Application("adminStockManage") = stockManage
Application("useStockManagement") = useStockManagement
Application("adminProdsPerPage") = adminProdsPerPage
Application("countryTax") = countryTax
Application("delccafter") = delccafter
Application("handling") = handling
Application("adminCanPostUser") = adminCanPostUser
Application("packtogether") = packtogether
Application("origZip") = origZip
Application("shipType") = shipType
Application("adminIntShipping") = adminIntShipping
Application("origCountry") = origCountry
Application("origCountryCode") = origCountryCode
Application("uspsUser") = uspsUser
Application("uspsPw") = uspsPw
Application("upsUser") = upsUser
Application("upsPw") = upsPw
Application("upsAccess") = upsAccess
Application("fedexaccount") = fedexaccount
Application("fedexmeter") = fedexmeter
Application("adminUnits") = adminUnits
Application("emailObject") = emailObject
Application("themailhost") = themailhost
Application("theuser") = theuser
Application("thepass") = thepass
Application("emailAddr") = emailAddr
Application("sendEmail") = sendEmail
Application("adminTweaks") = adminTweaks
Application("adminlanguages") = adminlanguages
Application("adminlangsettings") = adminlangsettings
Application("currRate1") = currRate1
Application("currSymbol1") = currSymbol1
Application("currRate2") = currRate2
Application("currSymbol2") = currSymbol2
Application("currRate3") = currRate3
Application("currSymbol3") = currSymbol3
Application("currConvUser") = currConvUser
Application("currConvPw") = currConvPw
Application("currLastUpdate") = currLastUpdate
Application("getadminsettings")=TRUE
Application.UnLock()
end if
end if
end if
' Overrides
if orstoreurl<>"" then storeurl=orstoreurl
if (left(LCase(storeurl),7) <> "http://") AND (left(LCase(storeurl),8) <> "https://") then storeurl = "http://" & storeurl
if Right(storeurl,1) <> "/" then storeurl = storeurl & "/"
if oremailaddr<>"" then emailAddr=oremailaddr
if adminIntShipping="" then adminIntShipping=0 ' failsafe
getadminsettings = TRUE
end function
function strip_tags2(mistr)
Set toregexp = new RegExp
toregexp.pattern = "<[^>]+>"
toregexp.ignorecase = TRUE
toregexp.global = TRUE
mistr = toregexp.replace(mistr, "")
Set toregexp = Nothing
strip_tags2 = replace(mistr, """", """)
end function
function cleanforurl(surl)
if isempty(urlfillerchar) then urlfillerchar="_"
Set toregexp = new RegExp
toregexp.pattern = "<[^>]+>"
toregexp.ignorecase = TRUE
toregexp.global = TRUE
surl = replace(lcase(toregexp.replace(surl, ""))," ",urlfillerchar)
toregexp.pattern = "[^a-z\"&urlfillerchar&"0-9]"
cleanforurl = toregexp.replace(surl, "")
end function
function vrxmlencode(xmlstr)
xmlstr = replace(xmlstr, "&", "&")
xmlstr = replace(xmlstr, "<", "<")
xmlstr = replace(xmlstr, ">", ">")
xmlstr = replace(xmlstr, "'", "'")
vrxmlencode = replace(xmlstr, """", """)
end function
function xmlencodecharref(xmlstr)
xmlstr = replace(xmlstr, "®", "")
xmlstr = replace(xmlstr, "&", "&")
xmlstr = replace(xmlstr, "<", "<")
xmlstr = replace(xmlstr, "®", "")
xmlstr = replace(xmlstr, ">", ">")
tmp_str=""
for i=1 to len(xmlstr)
ch_code=Asc(Mid(xmlstr,i,1))
if ch_code<=130 then tmp_str=tmp_str & Mid(xmlstr,i,1)
next
xmlencodecharref = tmp_str
end function
function getlangid(col, bfield)
if languageid="" or languageid=1 then
getlangid = col
else
if (adminlangsettings AND bfield)<>bfield then getlangid = col else getlangid = col & languageid
end if
end function
function upsencode(thestr, propcodestr)
if propcodestr="" then localcodestr=codestr else localcodestr=propcodestr
newstr=""
for index=1 to Len(localcodestr)
thechar = Mid(localcodestr,index,1)
if NOT IsNumeric(thechar) then
thechar = asc(thechar) MOD 10
end if
newstr = newstr & thechar
next
localcodestr = newstr
do while Len(localcodestr) < 40
localcodestr = localcodestr & localcodestr
loop
newstr=""
for index=1 to Len(thestr)
thechar = Mid(thestr,index,1)
newstr=newstr & Chr(asc(thechar)+Int(Mid(localcodestr,index,1)))
next
upsencode=newstr
end function
function upsdecode(thestr, propcodestr)
if propcodestr="" then localcodestr=codestr else localcodestr=propcodestr
newstr=""
for index=1 to Len(localcodestr)
thechar = Mid(localcodestr,index,1)
if NOT IsNumeric(thechar) then
thechar = asc(thechar) MOD 10
end if
newstr = newstr & thechar
next
localcodestr = newstr
do while Len(localcodestr) < 40
localcodestr = localcodestr & localcodestr
loop
if IsNull(thestr) then
upsdecode=""
else
newstr=""
for index=1 to Len(thestr)
thechar = Mid(thestr,index,1)
newstr=newstr & Chr(asc(thechar)-Int(Mid(localcodestr,index,1)))
next
upsdecode=newstr
end if
end function
function VSUSDate(thedate)
if mysqlserver=true then
VSUSDate = DatePart("yyyy",thedate) & "-" & DatePart("m",thedate) & "-" & DatePart("d",thedate)
elseif sqlserver=true then
VSUSDate = right(DatePart("yyyy",thedate),2) & IIfVr(DatePart("m",thedate)<10,"0","") & DatePart("m",thedate) & IIfVr(DatePart("d",thedate)<10,"0","") & DatePart("d",thedate)
else
VSUSDate = DatePart("m",thedate) & "/" & DatePart("d",thedate) & "/" & DatePart("yyyy",thedate)
end if
end function
function VSUSDateTime(thedate)
if mysqlserver=true then
VSUSDateTime = DatePart("yyyy",thedate) & "-" & DatePart("m",thedate) & "-" & DatePart("d",thedate) & " " & DatePart("h",thedate) & ":" & DatePart("n",thedate) & ":" & DatePart("s",thedate)
elseif sqlserver=true then
VSUSDateTime = right(DatePart("yyyy",thedate),2) & IIfVr(DatePart("m",thedate)<10,"0","") & DatePart("m",thedate) & IIfVr(DatePart("d",thedate)<10,"0","") & DatePart("d",thedate) & " " & DatePart("h",thedate) & ":" & DatePart("n",thedate) & ":" & DatePart("s",thedate)
else
VSUSDateTime = DatePart("m",thedate) & "/" & DatePart("d",thedate) & "/" & DatePart("yyyy",thedate) & " " & DatePart("h",thedate) & ":" & DatePart("n",thedate) & ":" & DatePart("s",thedate)
end if
end function
function FormatEuroCurrency(amount)
if overridecurrency=true then
if orcpreamount=true then FormatEuroCurrency = orcsymbol & FormatNumber(amount,orcdecplaces) else FormatEuroCurrency = FormatNumber(amount,orcdecplaces) & orcsymbol
else
if useEuro then FormatEuroCurrency = FormatNumber(amount,2) & " €" else FormatEuroCurrency = FormatCurrency(amount,-1,-2,0,-2)
end if
end function
function FormatEmailEuroCurrency(amount)
if overridecurrency=true then
if orcpreamount=true then FormatEmailEuroCurrency = orcemailsymbol & FormatNumber(amount,orcdecplaces) else FormatEmailEuroCurrency = FormatNumber(amount,orcdecplaces) & orcemailsymbol
else
if useEuro then FormatEmailEuroCurrency = FormatNumber(amount,2) & " Euro" else FormatEmailEuroCurrency = FormatCurrency(amount,-1,-2,0,-2)
end if
end function
Sub do_stock_management(smOrdId)
smOrdId = Trim(smOrdId)
If NOT IsNumeric(smOrdId) OR smOrdId="" then smOrdId=0
Set rsl = Server.CreateObject("ADODB.RecordSet")
if stockManage <> 0 then
sSQL="SELECT cartID,cartProdID,cartQuantity,pStockByOpts FROM cart INNER JOIN products ON cart.cartProdID=products.pID WHERE (cartCompleted=0 OR cartCompleted=2) AND cartOrderID=" & smOrdId
rsl.Open sSQL,cnn,0,1
do while NOT rsl.EOF
if cint(rsl("pStockByOpts")) <> 0 then
sSQL = "SELECT coOptID FROM cartoptions INNER JOIN (options INNER JOIN optiongroup ON options.optGroup=optiongroup.optGrpID) ON cartoptions.coOptID=options.optID WHERE optType IN (-2,-1,1,2) AND coCartID=" & rsl("cartID")
rs.Open sSQL,cnn,0,1
do while NOT rs.EOF
sSQL = "UPDATE options SET optStock=optStock-"&rsl("cartQuantity")&" WHERE optID="&rs("coOptID")
cnn.Execute(sSQL)
rs.MoveNext
loop
rs.Close
else
sSQL = "UPDATE products SET pInStock=pInStock-"&rsl("cartQuantity")&" WHERE pID='"&rsl("cartProdID")&"'"
cnn.Execute(sSQL)
end if
rsl.MoveNext
loop
rsl.Close
end if
set rsl = nothing
End Sub
Sub productdisplayscript(doaddprodoptions)
if currSymbol1<>"" AND currFormat1="" then currFormat1="%s " & currSymbol1 & ""
if currSymbol2<>"" AND currFormat2="" then currFormat2="%s " & currSymbol2 & ""
if currSymbol3<>"" AND currFormat3="" then currFormat3="%s " & currSymbol3 & ""
%>
<%
End Sub
Sub updatepricescript(doaddprodoptions,thetax) %>
<%
End Sub
function checkDPs(currcode)
if currcode="JPY" then checkDPs=0 else checkDPs=2
end function
Sub checkCurrencyRates(currConvUser,currConvPw,currLastUpdate,byRef currRate1,currSymbol1,byRef currRate2,currSymbol2,byRef currRate3,currSymbol3)
ccsuccess = true
if currConvUser<>"" AND currConvPw<>"" AND currLastUpdate < Now()-1 then
sstr = ""
if currSymbol1<>"" then sstr = sstr & "&curr=" & currSymbol1
if currSymbol2<>"" then sstr = sstr & "&curr=" & currSymbol2
if currSymbol3<>"" then sstr = sstr & "&curr=" & currSymbol3
if sstr="" then
cnn.Execute("UPDATE admin SET currLastUpdate="&datedelim&VSUSDate(Now())&datedelim)
Application.Lock()
Application("getadminsettings")=""
Application.UnLock()
exit sub
end if
sstr = "?source=" & countryCurrency & "&user=" & currConvUser & "&pw=" & currConvPw & sstr
set objHttp = Server.CreateObject("Msxml2.ServerXMLHTTP")
objHttp.open "POST", "http://www.ecommercetemplates.com/currencyxml.asp" & sstr, false
objHttp.Send "X"
if (objHttp.status <> 200 ) then
' HTTP error handling
else
Set xmlDoc = objHttp.responseXML
Set t2 = xmlDoc.getElementsByTagName("currencyRates").Item(0)
for j = 0 to t2.childNodes.length - 1
Set n = t2.childNodes.Item(j)
if n.nodename="currError" then
response.write n.firstChild.nodeValue
ccsuccess = false
elseif n.nodename="selectedCurrency" then
currRate = 0
for i = 0 To n.childNodes.length - 1
Set e = n.childNodes.Item(i)
if e.nodeName="currSymbol" then
currSymbol = e.firstChild.nodeValue
elseif e.nodeName="currRate" then
currRate = e.firstChild.nodeValue
end if
next
saveLCID = Session.LCID
Session.LCID = 1033
if currSymbol1 = currSymbol then
currRate1 = cDbl(currRate)
cnn.Execute("UPDATE admin SET currRate1="&currRate&" WHERE adminID=1")
end if
if currSymbol2 = currSymbol then
currRate2 = cDbl(currRate)
cnn.Execute("UPDATE admin SET currRate2="&currRate&" WHERE adminID=1")
end if
if currSymbol3 = currSymbol then
currRate3 = cDbl(currRate)
cnn.Execute("UPDATE admin SET currRate3="&currRate&" WHERE adminID=1")
end if
Session.LCID = saveLCID
end if
next
if ccsuccess then cnn.Execute("UPDATE admin SET currLastUpdate="&datedelim&VSUSDate(Now())&datedelim)
Application.Lock()
Application("getadminsettings")=""
Application.UnLock()
end if
set objHttp = nothing
end if
End Sub
function IIfVr(theExp,theTrue,theFalse)
if theExp then IIfVr=theTrue else IIfVr=theFalse
end function
function getsectionids(thesecid, delsections)
secarr = split(thesecid, ",")
secid = "" : addcomma = ""
for each sect in secarr
if isnumeric(trim(sect)) then secid = secid & addcomma & sect : addcomma = ","
next
if secid="" then secid="0"
iterations = 0
iteratemore = true
if Session("clientLoginLevel")<>"" then minloglevel=Session("clientLoginLevel") else minloglevel=0
if delsections then nodel = "" else nodel = "sectionDisabled<="&minloglevel&" AND "
do while iteratemore AND iterations<10
sSQL2 = "SELECT DISTINCT sectionID,rootSection FROM sections WHERE " & nodel & "(topSection IN ("&secid&") OR (sectionID IN ("&secid&") AND rootSection=1))"
secid = ""
iteratemore = false
rs2.Open sSQL2,cnn,0,1
addcomma = ""
do while NOT rs2.EOF
if rs2("rootSection")=0 then iteratemore = true
secid = secid & addcomma & rs2("sectionID")
addcomma = ","
rs2.MoveNext
loop
rs2.Close
iterations = iterations + 1
loop
if secid="" then getsectionids = "0" else getsectionids = secid
end function
function callxmlfunction(cfurl, cfxml, byref res, cfcert, cxfobj, byref cferr, settimeouts)
set objHttp = Server.CreateObject(cxfobj)
if settimeouts then objHttp.setTimeouts 30000, 30000, 0, 0
objHttp.open "POST", cfurl, false
objHttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
' if cfcert<>"" then objHttp.setOption 3, "LOCAL_MACHINE\My\" & cfcert
if cfcert<>"" then objHttp.SetClientCertificate("LOCAL_MACHINE\My\" & cfcert)
' response.write Replace(Replace(cfxml,"<")&""
err.number=0
objHttp.Send cfxml
errnum=err.number
errdesc=err.description
If errnum <> 0 OR objHttp.status <> 200 Then
cferr = "Error, couldn't connect to server (" & errnum & ", " & objHttp.status & "). " & errdesc
callxmlfunction = FALSE
Else
res = objHttp.responseText
callxmlfunction = TRUE
' response.write Replace(Replace(objHttp.responseText,"<")&""
End If
set objHttp = nothing
end function
function getpayprovdetails(ppid,ppdata1,ppdata2,ppdata3,ppdemo,ppmethod)
sSQL = "SELECT payProvData1,payProvData2,payProvData3,payProvDemo,payProvMethod FROM payprovider WHERE payProvEnabled=1 AND payProvID=" & replace(ppid, "'", "")
rs.Open sSQL,cnn,0,1
if NOT rs.EOF then
ppdata1 = trim(rs("payProvData1")&"")
ppdata2 = trim(rs("payProvData2")&"")
ppdata3 = trim(rs("payProvData3")&"")
ppdemo=(cint(rs("payProvDemo"))=1)
ppmethod=Int(rs("payProvMethod"))
getpayprovdetails = TRUE
else
getpayprovdetails = FALSE
end if
rs.Close
end function
sub writehiddenvar(hvname,hvval)
response.write "" & vbCrLf
end sub
function ppsoapheader(username, password, threetokenhash)
ppsoapheader = "<" & "?xml version=""1.0"" encoding=""utf-8""?>" & username & "" & password & "" & IIfVr(threetokenhash<>"",""&threetokenhash&"","") & ""
end function
function displayproductoptions(grpnmstyle,grpnmstyleend, byRef optpricediff)
optionshtml = ""
optpricediff = 0
pricediff = 0
for rowcounter=0 to UBOUND(prodoptions,2)
opthasstock = false
sSQL="SELECT optID,"&getlangid("optName",32)&","&getlangid("optGrpName",16)&","&OWSP&"optPriceDiff,optType,optGrpSelect,optFlags,optStock,optPriceDiff AS optDims,optDefault FROM options INNER JOIN optiongroup ON options.optGroup=optiongroup.optGrpID WHERE optGroup="&prodoptions(0,rowcounter)&" ORDER BY optID"
rs2.Open sSQL,cnn,0,1
if NOT rs2.EOF then
if abs(int(rs2("optType")))=3 then
opthasstock=true
fieldHeight = cInt((cDbl(rs2("optDims"))-Int(rs2("optDims")))*100.0)
optionshtml = optionshtml & "
"
do while not rs2.EOF
optionshtml = optionshtml & """) OR noprice=true,"dummyfunc","updateprice"&Count)&"();"" name=""optn"&rowcounter&""" "
if cint(rs2("optDefault"))<>0 then optionshtml = optionshtml & "checked "
optionshtml = optionshtml & "value='"&rs2("optID")&"' />0 AND rs2("optStock") <= 0 then optionshtml = optionshtml & " class=""oostock"" " else opthasstock=true
optionshtml = optionshtml & ">"&rs2(getlangid("optName",32))
if hideoptpricediffs<>true AND cDbl(rs2("optPriceDiff"))<>0 then
optionshtml = optionshtml & " ("
if cDbl(rs2("optPriceDiff")) > 0 then optionshtml = optionshtml & "+"
if (rs2("optFlags") AND 1) = 1 then pricediff = (rs("pPrice")*rs2("optPriceDiff"))/100.0 else pricediff = rs2("optPriceDiff")
optionshtml = optionshtml & FormatEuroCurrency(pricediff)&")"
if rs2("optDefault")<>0 then optpricediff = optpricediff + pricediff
end if
if useStockManagement AND showinstock=TRUE AND noshowoptionsinstock<>TRUE AND cint(rs("pStockByOpts"))<>0 then optionshtml = optionshtml & replace(xxOpSkTx, "%s", rs2("optStock"))
optionshtml = optionshtml & ""
if (rs2("optFlags") AND 4) <> 4 then optionshtml = optionshtml & " "&vbCrLf
rs2.MoveNext
loop
optionshtml = optionshtml & "
"
end if
end if
rs2.Close
optionshavestock = (optionshavestock AND opthasstock)
next
displayproductoptions = optionshtml
end function
if enableclientlogin=TRUE OR forceclientlogin=TRUE then
if Session("clientID")<>"" then
elseif trim(request.form("checktmplogin"))<>"" AND isnumeric(trim(request.form("sessionid"))) then
Set clientRS = Server.CreateObject("ADODB.RecordSet")
Set clientCnn=Server.CreateObject("ADODB.Connection")
clientCnn.open sDSN
sSQL = "SELECT tmploginname FROM tmplogin WHERE tmploginid=" & replace(trim(request.form("sessionid")),"'","") & " AND tmploginchk=" & replace(trim(request.form("checktmplogin")),"'","")
clientRS.Open sSQL,clientCnn,0,1
if NOT clientRS.EOF then
Session("clientID")=replace(clientRS("tmploginname"),"'","")
clientRS.Close
' clientCnn.Execute("DELETE FROM tmplogin WHERE tmploginid=" & request.form("sessionid"))
sSQL = "SELECT clUserName,clActions,clLoginLevel,clPercentDiscount FROM customerlogin WHERE clID="&session("clientID")
clientRS.Open sSQL,clientCnn,0,1
if NOT clientRS.EOF then
Session("clientUser")=clientRS("clUserName")
Session("clientActions")=clientRS("clActions")
Session("clientLoginLevel")=clientRS("clLoginLevel")
Session("clientPercentDiscount")=(100.0-cDbl(clientRS("clPercentDiscount")))/100.0
end if
end if
clientRS.Close
clientCnn.Close
set clientRS = nothing
set clientCnn = nothing
elseif Request.Cookies("WRITECLL")<>"" then
Set clientRS = Server.CreateObject("ADODB.RecordSet")
Set clientCnn=Server.CreateObject("ADODB.Connection")
clientCnn.open sDSN
clientEmail = replace(Request.Cookies("WRITECLL"),"'","")
clientPW = replace(Request.Cookies("WRITECLP"),"'","")
sSQL = "SELECT clID,clUserName,clActions,clLoginLevel,clPercentDiscount FROM customerlogin WHERE (clEmail<>'' AND clEmail='"&clientEmail&"' AND clPW='"&clientPW&"') OR (clEmail='' AND clUserName='"&clientEmail&"' AND clPW='"&clientPW&"')"
clientRS.Open sSQL,clientCnn,0,1
if NOT clientRS.EOF then
Session("clientID")=clientRS("clID")
Session("clientUser")=clientRS("clUsername")
Session("clientActions")=clientRS("clActions")
Session("clientLoginLevel")=clientRS("clLoginLevel")
Session("clientPercentDiscount")=(100.0-cDbl(clientRS("clPercentDiscount")))/100.0
end if
clientRS.Close
clientCnn.Close
set clientRS = nothing
set clientCnn = nothing
end if
if requiredloginlevel<>"" then
if Session("clientLoginLevel")Session("clientLoginLevel") then Response.redirect "cart.asp?mode=login&refurl=" & server.urlencode(request.servervariables("URL") & IIfVr(request.servervariables("QUERY_STRING")<>"" ,"?"&request.servervariables("QUERY_STRING"), ""))
end if
end if
end if
function urldecode(encodedstring)
strIn = encodedstring : strOut = "" : intPos = Instr(strIn, "+")
do While intPos
strLeft = "" : strRight = ""
if intPos > 1 then strLeft = Left(strIn, intPos - 1)
if intPos < len(strIn) then strRight = Mid(strIn, intPos + 1)
strIn = strLeft & " " & strRight
intPos = InStr(strIn, "+")
intLoop = intLoop + 1
Loop
intPos = InStr(strIn, "%")
do while intPos AND Len(strIn)-intPos > 2
if intPos > 1 then strOut = strOut & Left(strIn, intPos - 1)
strOut = strOut & Chr(CInt("&H" & mid(strIn, intPos + 1, 2)))
if intPos > (len(strIn) - 3) then strIn = "" else strIn = Mid(strIn, intPos + 3)
intPos = InStr(strIn, "%")
Loop
urldecode = strOut & strIn
end function
function vrmax(a,b)
if a > b then vrmax=a else vrmax=b
end function
function vrmin(a,b)
if a < b then vrmin=a else vrmin=b
end function
function getsessionsql()
getsessionsql = IIfVr(session("clientID")<>"", "cartClientID="&replace(session("clientID"),"'",""), "(cartClientID=0 AND cartSessionID="&replace(thesessionid,"'","")&")")
end function
function getordersessionsql()
getordersessionsql = IIfVr(session("clientID")<>"", "ordClientID="&replace(session("clientID"),"'",""), "(ordClientID=0 AND ordSessionID="&replace(thesessionid,"'","")&")")
end function
function trimoldcartitems(cartitemsdel)
if dateadjust="" then dateadjust=0
thetocdate = DateAdd("h",dateadjust,Now())
sSQL = "SELECT adminDelUncompleted,adminClearCart FROM admin WHERE adminID=1"
rs.Open sSQL,cnn,0,1
delAfter=rs("adminDelUncompleted")
delSavedCartAfter=rs("adminClearCart")
rs.Close
sSQL = "SELECT cartID FROM cart WHERE cartCompleted=0 AND "
sSQL = sSQL & "((cartOrderID=0 AND cartClientID=0 AND cartDateAdded<"&datedelim & VSUSDateTime(cartitemsdel) & datedelim & ") "
if delAfter<>0 then sSQL = sSQL & "OR (cartClientID=0 AND cartDateAdded<"&datedelim & VSUSDate(thetocdate-delAfter) & datedelim & ") "
if delSavedCartAfter<>0 then sSQL = sSQL & "OR (cartDateAdded<"&datedelim & VSUSDate(thetocdate-delSavedCartAfter) & datedelim & ") "
sSQL = sSQL & ")"
rs.Open sSQL,cnn,0,1
if NOT rs.EOF then
delOptions=""
do while NOT rs.EOF
delOptions = delOptions & addcomma & rs("cartID")
addcomma = ","
rs.MoveNext
loop
cnn.Execute("DELETE FROM cartoptions WHERE coCartID IN ("&delOptions&")")
cnn.Execute("DELETE FROM cart WHERE cartID IN ("&delOptions&")")
end if
rs.Close
if delAfter<>0 then cnn.Execute("DELETE FROM orders WHERE ordAuthNumber='' AND ordDate<" & datedelim & VSUSDate(thetocdate-delAfter) & datedelim & " AND ordStatus=2")
end function
function htmlspecials(thestr)
htmlspecials = replace(replace(replace(thestr,">",">"),"<","<"),"""",""")
end function
%>
<%
'This code is copyright (c) Internet Business Solutions SL, all rights reserved.
'The contents of this file are protected under law as the intellectual property
'of Internet Business Solutions SL. Any use, reproduction, disclosure or copying
'of any kind without the express and written permission of Internet Business
'Solutions SL is forbidden.
'Author: Vince Reid, vince@virtualred.net
Dim sSQL,rs,alldata,quantity,grandtotal,netnav,bExists,cartID,cartEmpty,index,index2,rowcounter,objItem,totShipOptions,cpnmessage,totaldiscounts,numhomecountries,nonhomecountries,blockmultipurchase,multipurchaseblockmessage
Dim demomode,data1,data2,success,errormsg,shipping,totalgoods,orderid,sXML,destZip,allzones,stateTax,stateTaxRate,countryID,somethingToShip,taxfreegoods,uspsmethods,freeshipamnt,pzFSA
Dim iTotItems,international,checkIntOptions,shipMethod,shipArr,shipcountry,intShipping(5,20),stockrelarr(4,10),havematch,dHighest(10),dHighWeight,dTotalWeight,dTotalWeightOz,thePQuantity,thePWeight
shiphomecountry = FALSE : stockwarning = FALSE : cartEmpty=FALSE
isInStock=true
outofstockreason=0
if dateadjust="" then dateadjust=0
WSP = "" : OWSP = ""
nodiscounts=false
success=True : usehst=false : checkIntOptions=False : alldata = "" : shipMethod = "" : shipping = 0
iTotItems = 0 : iWeight = 0 : stateTaxRate=0 : countryTax=0 : stateTax=0
appliedcouponname="" : ordAVS="" : ordCVV="" : stateAbbrev="" : international = "" : thePQuantity = 0 : thePWeight = 0
appliedcouponamount = 0 : totalquantity = 0 : statetaxfree = 0 : countrytaxfree = 0 : shipfreegoods = 0 : totalgoods = 0
somethingToShip = false : freeshippingapplied = false : freeshipamnt = 0 : rowcounter = 0
gotcpncode=false : isstandardship = false : numshipoptions=0 : homecountry = false : totalshipitems = 0 : stockrelitems = 0
if cartisincluded<>TRUE then
if request.totalbytes > 100000 then response.end
cpncode = trim(replace(request("cpncode"),"'",""))
payerid = request.form("payerid")
token = request("token")
if trim(Request.form("sessionid"))<>"" then thesessionid=replace(trim(Request.form("sessionid")),"'","") else thesessionid=Session.SessionID
if NOT isnumeric(thesessionid) then thesessionid=-1
theid = Replace(trim(Request.Form("id")),"'","")
checkoutmode=request.form("mode")
shippingpost=trim(request.form("shipping"))
commerciallocpost = Request.Form("commercialloc")
wantinsurancepost = trim(request.form("wantinsurance"))
payproviderpost = trim(request.form("payprovider"))
end if
paypalexpress=FALSE
ppexpresscancel=FALSE
Set rs = Server.CreateObject("ADODB.RecordSet")
Set rs2 = Server.CreateObject("ADODB.RecordSet")
Set rs3 = Server.CreateObject("ADODB.RecordSet")
Set cnn=Server.CreateObject("ADODB.Connection")
cnn.open sDSN
alreadygotadmin = getadminsettings()
countryTax=0 ' At present both countryTaxRate and countryTax are set in incfunctions
origShipType=shipType
if cartisincluded<>TRUE then
if (alternateratesups<>"" OR alternateratesusps<>"" OR alternateratesweightbased<>"" OR alternateratescanadapost<>"" OR alternateratesfedex<>"") then alternaterates = TRUE else alternaterates = FALSE
if request.form("altrates")<>"" then
altrate=int(request.form("altrates"))
if alternateratesups<>"" AND altrate=4 then shipType=4
if alternateratesusps<>"" AND altrate=3 then shipType=3
if alternateratesweightbased<>"" AND altrate=2 then shipType=2
if alternateratescanadapost<>"" AND altrate=6 then shipType=6
if alternateratesfedex<>"" AND altrate=7 then shipType=7
end if
ordPayProvider = replace(replace(payproviderpost,"'",""),"-","")
end if
if ordPayProvider<>"" then execute("handling = handling + handlingcharge" & ordPayProvider & " : handlingchargepercent = handlingchargepercent" & ordPayProvider)
sub get_wholesaleprice_sql()
if Session("clientUser")<>"" then
if (Session("clientActions") AND 8) = 8 then
WSP = "pWholesalePrice AS "
if wholesaleoptionpricediff=TRUE then OWSP = "optWholesalePriceDiff AS "
if nowholesalediscounts=true then nodiscounts=true
end if
if (Session("clientActions") AND 16) = 16 then
Session.LCID = 1033
WSP = Session("clientPercentDiscount") & "*pPrice AS "
if wholesaleoptionpricediff=TRUE then OWSP = Session("clientPercentDiscount") & "*optPriceDiff AS "
if nowholesalediscounts=true then nodiscounts=true
Session.LCID = saveLCID
end if
end if
end sub
get_wholesaleprice_sql()
if Session("couponapply")<>"" then
cnn.Execute("UPDATE coupons SET cpnNumAvail=cpnNumAvail+1 WHERE cpnID IN (0" & Session("couponapply")&")")
Session("couponapply")=""
end if
Function show_states(tstate)
Dim foundmatch
foundmatch=false
if xxOutState<>"" then response.write ""
if IsArray(allstates) then
for rowcounter=0 to UBOUND(allstates,2)
response.write ""&vbCrLf
next
end if
show_states=foundmatch
End Function
Sub show_countries(tcountry)
if IsArray(allcountries) then
for rowcounter=0 to UBOUND(allcountries,2)
response.write ""&vbCrLf
next
end if
End Sub
function checkuserblock(thepayprov)
multipurchaseblocked=FALSE
if multipurchaseblockmessage="" then multipurchaseblockmessage="I'm sorry. We are experiencing temporary difficulties at the moment. Please try your purchase again later."
if thepayprov<>"7" AND thepayprov <> "13" then
theip = trim(replace(left(request.servervariables("REMOTE_ADDR"), 48), "'", ""))
if theip = "" then theip = "none"
if blockmultipurchase<>"" then
cnn.Execute("DELETE FROM multibuyblock WHERE lastaccess<" & datedelim & VSUSDateTime(Now()-1) & datedelim)
sSQL = "SELECT ssdenyid,sstimesaccess FROM multibuyblock WHERE ssdenyip = '" & theip & "'"
rs.Open sSQL,cnn,0,1
if NOT rs.EOF then
cnn.Execute("UPDATE multibuyblock SET sstimesaccess=sstimesaccess+1,lastaccess=" & datedelim & VSUSDateTime(Now()) & datedelim & " WHERE ssdenyid=" & rs("ssdenyid"))
if rs("sstimesaccess") >= blockmultipurchase then multipurchaseblocked=TRUE
else
cnn.Execute("INSERT INTO multibuyblock (ssdenyip,lastaccess) VALUES ('" & theip & "'," & datedelim & VSUSDateTime(Now()) & datedelim & ")")
end if
rs.Close
end if
if theip = "none" then
sSQL = "SELECT "&IIfVr(mysqlserver<>true,"TOP 1","")&" dcid FROM ipblocking"&IIfVr(mysqlserver=true," LIMIT 0,1","")
else
sSQL = "SELECT dcid FROM ipblocking WHERE (dcip1=" & ip2long(theip) & " AND dcip2=0) OR (dcip1 <= " & ip2long(theip) & " AND " & ip2long(theip) & " <= dcip2 AND dcip2 <> 0)"
end if
rs.Open sSQL,cnn,0,1
if NOT rs.EOF then multipurchaseblocked = TRUE
rs.Close
end if
checkuserblock = multipurchaseblocked
end function
sub checkpricebreaks(cpbpid,origprice)
newprice=""
sSQL = "SELECT SUM(cartQuantity) AS totquant FROM cart WHERE cartCompleted=0 AND " & getsessionsql() & " AND cartProdID='"&replace(cpbpid,"'","''")&"'"
rs2.Open sSQL,cnn,0,1
if IsNull(rs2("totquant")) then thetotquant=0 else thetotquant = rs2("totquant")
rs2.Close
sSQL="SELECT "&WSP&"pPrice FROM pricebreaks WHERE "&thetotquant&">=pbQuantity AND pbProdID='"&replace(cpbpid,"'","''")&"' ORDER BY " & IIfVr(WSP="","pPrice",replace(WSP," AS ",""))
rs2.Open sSQL,cnn,0,1
if rs2.EOF then thepricebreak = origprice else thepricebreak = rs2("pPrice")
rs2.Close
Session.LCID = 1033
sSQL = "UPDATE cart SET cartProdPrice="&FormatNumber(thepricebreak,4,-1,0,0)&" WHERE cartCompleted=0 AND " & getsessionsql() & " AND cartProdID='"&replace(cpbpid,"'","''")&"'"
Session.LCID = saveLCID
cnn.Execute(sSQL)
end sub
function multShipWeight(theweight, themul)
multShipWeight = (theweight*themul)/100.0
end function
sub subtaxesfordiscounts(theExemptions, discAmount)
if (theExemptions AND 1)=1 then statetaxfree = statetaxfree - discAmount
if (theExemptions AND 2)=2 then countrytaxfree = countrytaxfree - discAmount
if (theExemptions AND 4)=4 then shipfreegoods = shipfreegoods - discAmount
end sub
sub addadiscount(resset, groupdiscount, dscamount, subcpns, cdcpncode, statetaxhandback, countrytaxhandback, theexemptions, thetax)
totaldiscounts = totaldiscounts + dscamount
if groupdiscount then
statetaxfree = statetaxfree - (dscamount * statetaxhandback)
countrytaxfree = countrytaxfree - (dscamount * countrytaxhandback)
else
call subtaxesfordiscounts(theexemptions, dscamount)
if perproducttaxrate then countryTax = countryTax - ((dscamount * thetax) / 100.0)
end if
if InStr(cpnmessage," " & resset("cpnName") & " ")=0 then cpnmessage = cpnmessage & resset("cpnName") & " "
if subcpns then
Set theres = cnn.Execute("SELECT cpnID FROM coupons WHERE cpnNumAvail>0 AND cpnNumAvail<30000000 AND cpnID=" & resset("cpnID"))
if NOT theres.EOF then Session("couponapply") = Session("couponapply") & "," & resset("cpnID")
cnn.Execute("UPDATE coupons SET cpnNumAvail=cpnNumAvail-1 WHERE cpnNumAvail>0 AND cpnNumAvail<30000000 AND cpnID=" & resset("cpnID"))
end if
if cdcpncode<>"" AND LCase(trim(resset("cpnNumber")))=LCase(cdcpncode) then gotcpncode=true : appliedcouponname = resset("cpnName") : appliedcouponamount = dscamount
end sub
function timesapply(taquant,tathresh,tamaxquant,tamaxthresh,taquantrepeat,tathreshrepeat)
if taquantrepeat=0 AND tathreshrepeat=0 then
tatimesapply = 1.0
elseif tamaxquant=0 then
tatimesapply = Int((tathresh-tamaxthresh) / tathreshrepeat)+1
elseif tamaxthresh=0 then
tatimesapply = Int((taquant-tamaxquant) / taquantrepeat)+1
else
ta1 = Int((taquant-tamaxquant) / taquantrepeat)+1
ta2 = Int((tathresh-tamaxthresh) / tathreshrepeat)+1
if ta2 < ta1 then tatimesapply = ta2 else tatimesapply = ta1
end if
timesapply = tatimesapply
end function
sub calculatediscounts(cdgndtot, subcpns, cdcpncode)
totaldiscounts = 0
cpnmessage = " "
cdtotquant = 0
if cdgndtot=0 then
statetaxhandback = 0.0
countrytaxhandback = 0.0
else
statetaxhandback = 1.0 - ((cdgndtot - statetaxfree) / cdgndtot)
countrytaxhandback = 1.0 - ((cdgndtot - countrytaxfree) / cdgndtot)
end if
if NOT nodiscounts then
Session.LCID = 1033
cdalldata = ""
sSQL = "SELECT cartProdID,SUM(cartProdPrice*cartQuantity),SUM(cartQuantity),pSection,COUNT(cartProdID),pExemptions,pTax FROM products INNER JOIN cart ON cart.cartProdID=products.pID WHERE cartCompleted=0 AND " & getsessionsql() & " GROUP BY cartProdID,pSection,pExemptions,pTax"
rs2.Open sSQL,cnn,0,1
if NOT (rs2.EOF OR rs2.BOF) then cdalldata=rs2.getrows
rs2.Close
if IsArray(cdalldata) then
For index=0 to UBOUND(cdalldata,2)
sSQL = "SELECT SUM(coPriceDiff*cartQuantity) AS totOpts FROM cart LEFT OUTER JOIN cartoptions ON cart.cartID=cartoptions.coCartID WHERE cartCompleted=0 AND " & getsessionsql() & " AND cartProdID='" & replace(cdalldata(0,index), "'", "''") & "'"
rs2.Open sSQL,cnn,0,1
if NOT IsNull(rs2("totOpts")) then cdalldata(1,index) = cdalldata(1,index) + rs2("totOpts")
rs2.Close
cdtotquant = cdtotquant + cdalldata(2,index)
topcpnids = cdalldata(3,index)
thetopts = cdalldata(3,index)
if isnull(cdalldata(6,index)) then cdalldata(6,index) = countryTaxRate
if NOT IsNull(thetopts) then
for cpnindex=0 to 10
if thetopts=0 then
exit for
else
sSQL = "SELECT topSection FROM sections WHERE sectionID=" & thetopts
rs.Open sSQL,cnn,0,1
if NOT rs.EOF then
thetopts = rs("topSection")
topcpnids = topcpnids & "," & thetopts
else
rs.Close
exit for
end if
rs.Close
end if
next
end if
tdt = Date()
sSQL = "SELECT DISTINCT cpnID,cpnDiscount,cpnType,cpnNumber,cpnName,cpnThreshold,cpnQuantity,cpnThresholdRepeat,cpnQuantityRepeat FROM coupons LEFT OUTER JOIN cpnassign ON coupons.cpnID=cpnassign.cpaCpnID WHERE cpnNumAvail>0 AND cpnEndDate>="&datedelim&VSUSDate(tdt)&datedelim&" AND (cpnIsCoupon=0"
if cdcpncode<>"" then sSQL = sSQL & " OR (cpnIsCoupon=1 AND cpnNumber='"&cdcpncode&"')"
sSQL = sSQL & ") AND cpnThreshold<="&cdalldata(1,index)&" AND (cpnThresholdMax>"&cdalldata(1,index)&" OR cpnThresholdMax=0) AND cpnQuantity<="&cdalldata(2,index)&" AND (cpnQuantityMax>"&cdalldata(2,index)&" OR cpnQuantityMax=0) AND (cpnSitewide=0 OR cpnSitewide=2) AND "
sSQL = sSQL & "(cpnSitewide=2 OR (cpaType=2 AND cpaAssignment='"&cdalldata(0,index)&"') "
sSQL = sSQL & "OR (cpaType=1 AND cpaAssignment IN ('"&Replace(topcpnids,",","','")&"')))"
rs2.Open sSQL,cnn,0,1
do while NOT rs2.EOF
if rs2("cpnType")=1 then ' Flat Rate Discount
thedisc = cDbl(rs2("cpnDiscount")) * timesapply(cdalldata(2,index),cdalldata(1,index),rs2("cpnQuantity"),rs2("cpnThreshold"),rs2("cpnQuantityRepeat"),rs2("cpnThresholdRepeat"))
if cdalldata(1,index) < thedisc then thedisc = cdalldata(1,index)
call addadiscount(rs2, false, thedisc, subcpns, cdcpncode, statetaxhandback, countrytaxhandback, cdalldata(5,index), cdalldata(6,index))
elseif rs2("cpnType")=2 then ' Percentage Discount
call addadiscount(rs2, false, ((cDbl(rs2("cpnDiscount")) * cDbl(cdalldata(1,index))) / 100.0), subcpns, cdcpncode, statetaxhandback, countrytaxhandback, cdalldata(5,index), cdalldata(6,index))
end if
rs2.MoveNext
loop
rs2.Close
Next
end if
tdt = Date()
sSQL = "SELECT DISTINCT cpnID,cpnDiscount,cpnType,cpnNumber,cpnName,cpnSitewide,cpnThreshold,cpnThresholdMax,cpnQuantity,cpnQuantityMax,cpnThresholdRepeat,cpnQuantityRepeat FROM coupons WHERE cpnNumAvail>0 AND cpnEndDate>="&datedelim&VSUSDate(tdt)&datedelim&" AND (cpnIsCoupon=0"
if cdcpncode<>"" then sSQL = sSQL & " OR (cpnIsCoupon=1 AND cpnNumber='"&cdcpncode&"')"
sSQL = sSQL & ") AND cpnThreshold<="&cdgndtot&" AND cpnQuantity<="&cdtotquant&" AND (cpnSitewide=1 OR cpnSitewide=3) AND (cpnType=1 OR cpnType=2)"
rs.Open sSQL,cnn,0,1
do while NOT rs.EOF
totquant = 0
totprice = 0
if rs("cpnSitewide")=3 then
sSQL = "SELECT cpaAssignment FROM cpnassign WHERE cpaType=1 AND cpacpnID=" & rs("cpnID")
rs2.Open sSQL,cnn,0,1
secids = ""
addcomma = ""
do while NOT rs2.EOF
secids = secids & addcomma & rs2("cpaAssignment")
addcomma = ","
rs2.MoveNext
loop
rs2.Close
if NOT (secids = "") then
secids = getsectionids(secids, false)
sSQL = "SELECT SUM(cartProdPrice*cartQuantity) AS totPrice,SUM(cartQuantity) AS totQuant FROM products INNER JOIN cart ON cart.cartProdID=products.pID WHERE cartCompleted=0 AND " & getsessionsql() & " AND products.pSection IN (" & secids & ")"
rs2.Open sSQL,cnn,0,1
if IsNull(rs2("totPrice")) then totprice = 0 else totprice = rs2("totPrice")
if IsNull(rs2("totQuant")) then totquant = 0 else totquant = rs2("totQuant")
rs2.Close
if mysqlserver=true then
sSQL = "SELECT SUM(coPriceDiff*cartQuantity) AS optPrDiff FROM products INNER JOIN cart ON cart.cartProdID=products.pID LEFT OUTER JOIN cartoptions ON cart.cartID=cartoptions.coCartID WHERE cartCompleted=0 AND " & getsessionsql() & " AND products.pSection IN (" & secids & ")"
else
sSQL = "SELECT SUM(coPriceDiff*cartQuantity) AS optPrDiff FROM products INNER JOIN (cart LEFT OUTER JOIN cartoptions ON cart.cartID=cartoptions.coCartID) ON cart.cartProdID=products.pID WHERE cartCompleted=0 AND " & getsessionsql() & " AND products.pSection IN (" & secids & ")"
end if
rs2.Open sSQL,cnn,0,1
if NOT IsNull(rs2("optPrDiff")) then totprice = totprice + rs2("optPrDiff")
rs2.Close
end if
else
totquant = cdtotquant
totprice = cdgndtot
end if
if totquant > 0 AND rs("cpnThreshold") <= totprice AND (rs("cpnThresholdMax") > totprice OR rs("cpnThresholdMax")=0) AND rs("cpnQuantity") <= totquant AND (rs("cpnQuantityMax") > totquant OR rs("cpnQuantityMax")=0) then
if rs("cpnType")=1 then ' Flat Rate Discount
thedisc = cDbl(rs("cpnDiscount")) * timesapply(totquant,totprice,rs("cpnQuantity"),rs("cpnThreshold"),rs("cpnQuantityRepeat"),rs("cpnThresholdRepeat"))
if totprice < thedisc then thedisc = totprice
elseif rs("cpnType")=2 then ' Percentage Discount
thedisc = ((cDbl(rs("cpnDiscount")) * cDbl(totprice)) / 100.0)
end if
call addadiscount(rs, true, thedisc, subcpns, cdcpncode, statetaxhandback, countrytaxhandback, 3, 0)
if perproducttaxrate AND cdgndtot > 0 then
if IsArray(cdalldata) then
for index=0 to UBOUND(cdalldata,2)
if rs("cpnType")=1 then ' Flat Rate Discount
applicdisc = thedisc / (cdtotquant / cdalldata(2,index))
elseif rs("cpnType")=2 then ' Percentage Discount
applicdisc = thedisc / (cdgndtot / cdalldata(1,index))
end if
if (cdalldata(5,index) AND 2)<>2 then countryTax = countryTax - ((applicdisc * cdalldata(6,index)) / 100.0)
next
end if
end if
end if
rs.MoveNext
loop
rs.Close
Session.LCID = saveLCID
end if
if statetaxfree < 0 then statetaxfree = 0
if countrytaxfree < 0 then countrytaxfree = 0
totaldiscounts = vsround(totaldiscounts, 2)
end sub
sub calculateshippingdiscounts(subcpns)
freeshipamnt = 0
if NOT nodiscounts then
Session.LCID = 1033
tdt = Date()
sSQL = "SELECT cpnID,cpnName,cpnNumber,cpnDiscount,cpnThreshold,cpnCntry FROM coupons WHERE cpnType=0 AND cpnSitewide=1 AND cpnNumAvail>0 AND cpnThreshold<="&totalgoods&" AND (cpnThresholdMax>"&totalgoods&" OR cpnThresholdMax=0) AND cpnQuantity<="&totalquantity&" AND (cpnQuantityMax>"&totalquantity&" OR cpnQuantityMax=0) AND cpnEndDate>="&datedelim&VSUSDate(tdt)&datedelim&" AND (cpnIsCoupon=0 OR (cpnIsCoupon=1 AND cpnNumber='"&cpncode&"'))"
rs.Open sSQL,cnn,0,1
do while NOT rs.EOF
if freeshipapplies OR Int(rs("cpnCntry"))=0 then
if cpncode<>"" AND LCase(trim(rs("cpnNumber")))=LCase(cpncode) then gotcpncode=true : appliedcouponname = rs("cpnName")
if isstandardship then
if InStr(cpnmessage," " & rs("cpnName") & " ")=0 then cpnmessage = cpnmessage & rs("cpnName") & " "
freeshipamnt = shipping
if subcpns then
Set theres = cnn.Execute("SELECT cpnID FROM coupons WHERE cpnNumAvail>0 AND cpnNumAvail<30000000 AND cpnID=" & rs("cpnID"))
if NOT theres.EOF then Session("couponapply") = Session("couponapply") & "," & rs("cpnID")
cnn.Execute("UPDATE coupons SET cpnNumAvail=cpnNumAvail-1 WHERE cpnNumAvail>0 AND cpnNumAvail<30000000 AND cpnID=" & rs("cpnID"))
end if
end if
freeshippingapplied = true
end if
rs.MoveNext
loop
rs.Close
Session.LCID = saveLCID
end if
if freeshipamnt > shipping then freeshipamnt = shipping
end sub
sub initshippingmethods()
for i=0 to UBOUND(intShipping,2)
intShipping(0,i)="" ' Name
intShipping(1,i)="" ' Delivery
intShipping(2,i)=0 ' Cost
intShipping(3,i)=false ' Used
intShipping(4,i)=0 ' FSA
intShipping(5,i)="" ' Name to match (USPS)
next
if shipcountry <> origCountry then
international = "Intl"
willpickuptext = ""
if adminIntShipping<>0 then
if cartisincluded=TRUE then
shipType=adminIntShipping
elseif request.form("altrates")="" then
shipType=adminIntShipping
end if
end if
end if
if shipType=2 OR shipType=5 then ' Weight / Price based shipping
allzones=""
zoneid=0
if splitUSZones AND shiphomecountry then
sSQL = "SELECT pzID,pzMultiShipping,pzFSA,pzMethodName1,pzMethodName2,pzMethodName3,pzMethodName4,pzMethodName5 FROM states INNER JOIN postalzones ON postalzones.pzID=states.stateZone WHERE stateName='"&Replace(shipstate,"'","''")&"' OR stateAbbrev='"&Replace(shipstate,"'","''")&"'"
else
sSQL = "SELECT pzID,pzMultiShipping,pzFSA,pzMethodName1,pzMethodName2,pzMethodName3,pzMethodName4,pzMethodName5 FROM countries INNER JOIN postalzones ON postalzones.pzID=countries.countryZone WHERE countryName='"&Replace(shipcountry,"'","''")&"'"
end if
rs.Open sSQL,cnn,0,1
if NOT (rs.EOF OR rs.BOF) then
zoneid=rs("pzID")
numshipoptions=rs("pzMultiShipping")
pzFSA = rs("pzFSA")
for index3=0 to numshipoptions
intShipping(0,index3)=rs("pzMethodName"&(index3+1))
intShipping(2,index3)=0
intShipping(3,index3)=TRUE
intShipping(4,index3)=IIfVr((rs("pzFSA") AND (2 ^ index3))<>0, 1, 0)
next
else
success=false
if splitUSZones AND shiphomecountry AND shipstate="" then errormsg = xxPlsSta else errormsg = "Country / state shipping zone is unassigned."
end if
rs.Close
sSQL = "SELECT zcWeight,zcRate,zcRate2,zcRate3,zcRate4,zcRate5,zcRatePC,zcRatePC2,zcRatePC3,zcRatePC4,zcRatePC5 FROM zonecharges WHERE zcZone="&zoneid&" ORDER BY zcWeight"
rs.Open sSQL,cnn,0,1
if NOT (rs.EOF OR rs.BOF) then allzones=rs.getrows
rs.Close
elseif shipType=3 OR shipType=4 OR shipType=6 OR shipType=7 then ' USPS / UPS / Canada Post / Fedex
if shipType=3 then
sSQL = "SELECT uspsMethod,uspsFSA,uspsShowAs FROM uspsmethods WHERE uspsID<100 AND uspsUseMethod=1 AND uspsLocal="
if international="" then sSQL=sSQL&"1" else sSQL=sSQL&"0"
elseif shipType=4 then
shipinsuranceamt=""
sSQL = "SELECT uspsMethod,uspsFSA,uspsShowAs FROM uspsmethods WHERE uspsID>100 AND uspsID<200 AND uspsUseMethod=1"
elseif shipType=6 then
sSQL = "SELECT uspsMethod,uspsFSA,uspsShowAs FROM uspsmethods WHERE uspsID>200 AND uspsID<300 AND uspsUseMethod=1"
elseif shipType=7 then
sSQL = "SELECT uspsMethod,uspsFSA,uspsShowAs,uspsLocal FROM uspsmethods WHERE uspsID>300 AND uspsID<400 AND uspsUseMethod=1"
if international="" AND commerciallocpost="Y" then sSQL = sSQL & " AND uspsMethod<>'GROUNDHOMEDELIVERY'"
end if
rs.Open sSQL,cnn,0,1
if NOT rs.EOF then
uspsmethods=rs.GetRows()
else
success=false
errormsg = "Admin Error: " & xxNoMeth
end if
rs.Close
end if
if shipType=3 then
sXML = "<"&international&"RateRequest USERID="""&uspsUser&""" PASSWORD="""&uspsPw&""">"
elseif shipType=4 then
if shipCountryCode="US" AND shipStateAbbrev="VI" then shipCountryCode="VI"
sXML = "<" & "?xml version=""1.0""?>"&upsAccess&""&upsUser&""&upsPw&"<" & "?xml version=""1.0""?>"
sXML = sXML & "Rating and Service1.0001"
sXML = sXML & "Rateshop"
if upspickuptype<>"" then sXML = sXML & ""&upspickuptype&""
sXML = sXML & ""&origZip&""&origCountryCode&""
sXML = sXML & ""&destZip&""&shipCountryCode&"" & IIfVr(commerciallocpost<>"Y", "", "") & ""
'sXML = sXML & "11"
elseif shipType=6 then
sXML = " <" & "?xml version=""1.0"" ?> en "&adminCanPostUser&" "&origZip&" "
elseif shipType=7 then ' FedEx
if packaging<>"" then packaging="FEDEX" & UCase(packaging) else packaging="YOURPACKAGING"
sXML = "<" & "?xml version=""1.0"" encoding=""UTF-8"" ?>" & _
"" & _
"ecommerceplusrate"&fedexaccount&""&fedexmeter&"" & _
"REGULARPICKUP"&packaging&"" & _
""&IIfVr((adminUnits AND 1)=1,"LBS","KGS")&""
if origCountryCode="US" OR origCountryCode="CA" then sXML = sXML & ""&originstatecode&""
sXML = sXML & ""&origZip&""&origCountryCode&""
if shipCountryCode="US" OR shipCountryCode="CA" then sXML = sXML & ""&shipStateAbbrev&""
sXML = sXML & ""&destZip&""&shipCountryCode&"" & _
"SENDER"
sXML = sXML & "" & IIfVr(commerciallocpost="Y","false","true") & ""
if saturdaydelivery="Y" then sXML = sXML & "true"
if saturdaypickup=TRUE then sXML = sXML & "true"
if insidedelivery="Y" then sXML = sXML & "true"
if insidepickup=TRUE then sXML = sXML & "true"
if payproviderpost<>"" then
if int(payproviderpost)=codpaymentprovider then sXML = sXML & "XXXFILLCODAMTHEREYYYANY"
end if
if signaturerelease="Y" AND allowsignaturerelease=TRUE then
elseif signatureoption="indirect" then
sXML = sXML & "INDIRECT"
elseif signatureoption="direct" then
sXML = sXML & "DIRECT"
elseif signatureoption="adult" then
sXML = sXML & "ADULT"
elseif signatureoption="none" then
sXML = sXML & "NONE"
end if
sXML = sXML & ""
if homedelivery<>"" then sXML = sXML & ""&homedelivery&""
end if
end sub
totalpackdims = Array(0,0,0,0) ' len : wid : hei : vol used
sub addpackagedimensions(dimens)
Session.LCID = 1033
if (adminUnits AND 12)<>0 then
origdimens = totalpackdims
' response.write "adding package dimensions " & dimens & " "
proddims = split(dimens&"", "x")
if UBOUND(proddims)>=0 then if proddims(0)<>"" then thelength = cDbl(proddims(0))
if UBOUND(proddims)>=1 then if proddims(1)<>"" then thewidth = cDbl(proddims(1))
if UBOUND(proddims)>=2 then if proddims(2)<>"" then theheight = cDbl(proddims(2))
if thelength<>"" AND thewidth<>"" AND theheight<>"" then
objvol = thelength * thewidth * theheight
if thelength > totalpackdims(0) then totalpackdims(0) = thelength
if thewidth > totalpackdims(1) then totalpackdims(1) = thewidth
if theheight > totalpackdims(2) then totalpackdims(2) = theheight
if objvol + totalpackdims(3) > totalpackdims(0) * totalpackdims(1) * totalpackdims(2) then totalpackdims(2) = totalpackdims(2) + IIfVr(origdimens(2) > 0 AND origdimens(2) < theheight, origdimens(2),theheight)
if objvol + totalpackdims(3) > totalpackdims(0) * totalpackdims(1) * totalpackdims(2) then totalpackdims(1) = totalpackdims(1) + IIfVr(origdimens(1) > 0 AND origdimens(1) < thewidth, origdimens(1),thewidth)
if objvol + totalpackdims(3) > totalpackdims(0) * totalpackdims(1) * totalpackdims(2) then totalpackdims(0) = totalpackdims(0) + IIfVr(origdimens(0) > 0 AND origdimens(0) < thelength, origdimens(0),thelength)
totalpackdims(3) = totalpackdims(3) + objvol
if totalpackdims(2) > totalpackdims(1) then apdtemp = totalpackdims(1) : totalpackdims(1) = totalpackdims(2) : totalpackdims(2) = apdtemp
if totalpackdims(1) > totalpackdims(0) then apdtemp = totalpackdims(0) : totalpackdims(0) = totalpackdims(1) : totalpackdims(1) = apdtemp
if totalpackdims(2) > totalpackdims(1) then apdtemp = totalpackdims(1) : totalpackdims(1) = totalpackdims(2) : totalpackdims(2) = apdtemp
end if
end if
' response.write "Bin is : " & totalpackdims(0)&":"& totalpackdims(1)&":"& totalpackdims(2)&" = " & (totalpackdims(0)*totalpackdims(1)*totalpackdims(2)) & " "
Session.LCID = saveLCID
end sub
sub addproducttoshipping(apsrs, prodindex)
call addpackagedimensions(apsrs(11,prodindex))
if packtogether then iTotItems = 1 else iTotItems = iTotItems + 1
shipThisProd=true
if (apsrs(8,prodindex) AND 4)=4 then ' No Shipping on this product
if NOT packtogether then iTotItems = iTotItems - Int(apsrs(4,prodindex))
shipThisProd=false
end if
if shipType=1 then ' Flat rate shipping
if shipThisProd then shipping = shipping + apsrs(6,prodindex) + (apsrs(7,prodindex) * (apsrs(4,prodindex)-1))
elseif (shipType=2 OR shipType=5) AND shippingpost="" then ' Weight / Price based shipping
havematch=false
for index3=0 to numshipoptions
dHighest(index3)=0
next
if IsArray(allzones) then
if shipThisProd then
somethingToShip=true
if shipType=2 then tmpweight = cDbl(apsrs(5,prodindex)) else tmpweight = cDbl(apsrs(3,prodindex))
if packtogether then
thePWeight = thePWeight + (cDbl(apsrs(4,prodindex))*tmpweight)
thePQuantity = 1
else
thePWeight = tmpweight
thePQuantity = cDbl(apsrs(4,prodindex))
end if
end if
if ((NOT packtogether AND shipThisProd) OR (packtogether AND prodindex=UBOUND(apsrs,2))) AND somethingToShip then ' Only calculate pack together when we have the total
for index2=0 to UBOUND(allzones,2)
if allzones(0,index2)>=thePWeight then
havematch=true
for index3=0 to numshipoptions
if cint(allzones(6+index3,index2))<>0 then ' by percentage
intShipping(2,index3)=intShipping(2,index3)+((cDbl(allzones(1+index3,index2))*thePQuantity*thePWeight)/100.0)
else
intShipping(2,index3)=intShipping(2,index3)+(cDbl(allzones(1+index3,index2))*thePQuantity)
end if
if cDbl(allzones(1+index3,index2))=-99999.0 then intShipping(3,index3)=FALSE
next
exit for
end if
dHighWeight=allzones(0,index2)
for index3=0 to numshipoptions
if cint(allzones(6+index3,index2))<>0 then ' by percentage
dHighest(index3)=(allzones(1+index3,index2)*dHighWeight)/100.0
else
dHighest(index3)=allzones(1+index3,index2)
end if
next
next
if NOT havematch then
for index3=0 to numshipoptions
intShipping(2,index3) = intShipping(2,index3) + dHighest(index3)
if dHighest(index3)=-99999.0 then intShipping(3,index3)=FALSE
next
if allzones(0,0) < 0 then
dHighWeight = thePWeight - dHighWeight
do while dHighWeight > 0
for index3=0 to numshipoptions
intShipping(2,index3) = intShipping(2,index3) + (cDbl(allzones(1+index3,0))*thePQuantity)
next
dHighWeight = vsround(dHighWeight + allzones(0,0),4)
loop
end if
end if
for index3=numshipoptions to 0 step-1
if intShipping(3,index3)=FALSE then
for index4=index3+1 to numshipoptions
intShipping(0,index4-1)=intShipping(0,index4)
intShipping(2,index4-1)=intShipping(2,index4)
intShipping(3,index4-1)=intShipping(3,index4)
next
numshipoptions = numshipoptions-1
end if
next
end if
end if
elseif shipType=3 AND shippingpost="" then ' USPS Shipping
if packtogether then
if shipThisProd then
somethingToShip=true
iWeight = iWeight + (cDbl(apsrs(5,prodindex)) * Int(apsrs(4,prodindex)))
end if
if prodindex = UBOUND(apsrs,2) AND somethingToShip then
numpacks=1
if splitpackat<>"" then
if iWeight > splitpackat then numpacks=-Int(-(iWeight/splitpackat))
end if
if numpacks > 1 then
if international <> "" then
sXML = sXML & addUSPSInternational(rowcounter,splitpackat,numpacks-1,"Package",shipcountry)
else
sXML = sXML & addUSPSDomestic(rowcounter,"Parcel",origZip,destZip,splitpackat,numpacks-1,"None","REGULAR","True")
end if
iTotItems = iTotItems + 1
iWeight = iWeight - (splitpackat*(numpacks-1))
rowcounter = rowcounter + 1
end if
if international <> "" then
sXML = sXML & addUSPSInternational(rowcounter,iWeight,1,"Package",shipcountry)
else
sXML = sXML & addUSPSDomestic(rowcounter,"Parcel",origZip,destZip,iWeight,1,"None","REGULAR","True")
end if
rowcounter = rowcounter + 1
end if
else
if shipThisProd then
somethingToShip=true
iWeight=apsrs(5,prodindex)
numpacks=1
if splitpackat<>"" then
if iWeight > splitpackat then numpacks=-Int(-(iWeight/splitpackat))
end if
if numpacks > 1 then
if international <> "" then
sXML = sXML & addUSPSInternational(rowcounter,splitpackat,apsrs(4,prodindex)*(numpacks-1),"Package",shipcountry)
else
sXML = sXML & addUSPSDomestic(rowcounter,"Parcel",origZip,destZip,splitpackat,apsrs(4,prodindex)*(numpacks-1),"None","REGULAR","True")
end if
iTotItems = iTotItems + 1
iWeight = iWeight - (splitpackat*(numpacks-1))
rowcounter = rowcounter + 1
end if
if international <> "" then
sXML = sXML & addUSPSInternational(rowcounter,iWeight,apsrs(4,prodindex),"Package",shipcountry)
else
sXML = sXML & addUSPSDomestic(rowcounter,"Parcel",origZip,destZip,iWeight,apsrs(4,prodindex),"None","REGULAR","True")
end if
rowcounter = rowcounter + 1
end if
end if
elseif (shipType=4 OR shipType=6) AND shippingpost="" then ' UPS Shipping OR Canada Post
Session.LCID = 1033
if packaging<>"" then
if packaging="envelope" then packaging="01"
if packaging="pak" then packaging="04"
if packaging="box" then packaging="21"
if packaging="tube" then packaging="03"
if packaging="10kgbox" then packaging="25"
if packaging="25kgbox" then packaging="24"
elseif upspacktype<>"" then
packaging=upspacktype
else
packaging="02"
end if
if packtogether then
if shipThisProd then
somethingToShip=true
iWeight = iWeight + (cDbl(apsrs(5,prodindex)) * Int(apsrs(4,prodindex)))
end if
if prodindex = UBOUND(apsrs,2) AND somethingToShip then
numpacks=1
if splitpackat<>"" then
if iWeight > splitpackat then numpacks=-Int(-(iWeight/splitpackat))
end if
for index3 = 1 to numpacks
if shipType=4 then
sXML = sXML & addUPSInternational(iWeight / numpacks,adminUnits,packaging,shipCountryCode,totalgoods-shipfreegoods,totalpackdims)
else
sXML = sXML & addCanadaPostPackage(iWeight / numpacks,adminUnits,packaging,shipCountryCode,totalgoods-shipfreegoods,totalpackdims)
end if
next
end if
else
if shipThisProd then
somethingToShip=true
iWeight=apsrs(5,prodindex)
numpacks=1
if splitpackat<>"" then
if iWeight > splitpackat then numpacks=-Int(-(iWeight/splitpackat))
end if
for index2=0 to Int(apsrs(4,prodindex))-1
for index3 = 1 to numpacks
if shipType=4 then
sXML = sXML & addUPSInternational(iWeight / numpacks,adminUnits,packaging,shipCountryCode,apsrs(3,prodindex),totalpackdims)
else
sXML = sXML & addCanadaPostPackage(iWeight / numpacks,adminUnits,packaging,shipCountryCode,apsrs(3,prodindex),totalpackdims)
end if
next
next
end if
end if
Session.LCID = saveLCID
elseif shipType=7 AND shippingpost="" then ' FedEx
Session.LCID = 1033
if packtogether then
totalshipitems=1
if shipThisProd then
somethingToShip=true
iWeight = iWeight + (cDbl(apsrs(5,prodindex)) * Int(apsrs(4,prodindex)))
end if
else
if shipThisProd then
somethingToShip=true
iWeight = iWeight + (cDbl(apsrs(5,prodindex)) * Int(apsrs(4,prodindex)))
if splitpackat<>"" then
if cDbl(apsrs(5,prodindex)) > splitpackat then totalshipitems=totalshipitems + (-Int(-(cDbl(apsrs(5,prodindex))/splitpackat)) * Int(apsrs(4,prodindex))) else totalshipitems=totalshipitems + Int(apsrs(4,prodindex))
else
totalshipitems=totalshipitems + Int(apsrs(4,prodindex))
end if
end if
end if
if prodindex = UBOUND(apsrs,2) AND somethingToShip then
if packtogether AND splitpackat<>"" then
if iWeight > splitpackat then totalshipitems = (-Int(-(iWeight/splitpackat)))
end if
sXML = sXML & addFedexPackage(iWeight,totalshipitems,totalgoods-shipfreegoods,totalpackdims)
end if
Session.LCID = saveLCID
end if
end sub
function calculateshipping()
if shipType=1 then
isstandardship = true
elseif (shipType=2 OR shipType=5) AND (somethingToShip OR willpickuptext<>"") then
checkIntOptions = (shippingpost="")
if IsArray(allzones) AND numshipoptions>=0 then
shipping = intShipping(2,0)
shipMethod = intShipping(0,0)
isstandardship = ((pzFSA AND 1) = 1)
if numshipoptions = 0 AND willpickuptext="" then checkIntOptions = FALSE
else
if willpickuptext<>"" then
if willpickupcost<>"" then shipping = willpickupcost
shipMethod = willpickuptext
else
success = FALSE
errormsg=xxNoMeth
checkIntOptions = false
end if
end if
elseif shipType=3 AND somethingToShip then
checkIntOptions = (shippingpost="")
if shippingpost="" then
sXML = sXML & ""
success = USPSCalculate(sXML,international,shipping, errormsg, intShipping)
if left(errormsg, 30)="Warning - Bound Printed Matter" then success=true
if success AND checkIntOptions then ' Look for a single valid shipping option
totShipOptions = 0
for index=0 to UBOUND(intShipping,2)
if iTotItems=intShipping(3,index) then
for index2=0 to UBOUND(uspsmethods,2)
if replace(lcase(intShipping(0,index)),"-"," ") = replace(lcase(uspsmethods(0,index2)),"-"," ") then
if totShipOptions=0 then
shipping = intShipping(2,index)
shipMethod = trim(uspsmethods(2,index2))
isstandardship = Int(uspsmethods(1,index2))
end if
intShipping(5,index)=uspsmethods(2,index2)
totShipOptions = totShipOptions + 1
end if
next
end if
next
if totShipOptions=1 then
checkIntOptions=False
elseif totShipOptions=0 AND willpickuptext="" then
checkIntOptions=False
success=False
errormsg=xxNoMeth
end if
if willpickuptext<>"" then checkIntOptions = True
end if
end if
elseif shipType=4 AND somethingToShip then
checkIntOptions = (shippingpost="")
if shippingpost="" then
sXML = sXML & "" & IIfVr(saturdaydelivery="Y","","") & IIfVr(saturdaypickup=TRUE,"","") & ""
if trim(upsUser)<>"" AND trim(upsPw)<>"" then
success = UPSCalculate(sXML,international,shipping, errormsg, intShipping)
else
success = false
errormsg = "You must register with UPS by logging on to your online admin section and clicking the "Register with UPS" link before you can use the UPS OnLine® Shipping Rates and Services Selection"
end if
end if
elseif shipType=6 AND somethingToShip then
checkIntOptions = (shippingpost="")
if shippingpost="" then
sXML = sXML & " "
if shipstate<>"" then
sXML = sXML & " "&shipstate&" "
else
if shipCountryCode="US" OR shipCountryCode="CA" then
thestate = IIfVr(trim(Request.form("sname")) <> "" OR trim(Request.form("saddress")) <> "", trim(request.form("sstate2")), trim(request.form("state2")))
if thestate="" then thestate=IIfVr(shipCountryCode="US","CA","QC")
sXML = sXML & " "&thestate&" "
else
sXML = sXML & ""
end if
end if
sXML = sXML & ""&shipCountryCode&""&destZip&""
success = CanadaPostCalculate(sXML,international,shipping, errormsg, intShipping)
end if
elseif shipType=7 AND somethingToShip then
checkIntOptions = (shippingpost="")
if shippingpost="" then
sXML = sXML & ""
success = fedexcalculate(sXML,international, errormsg, intShipping)
end if
end if
if success AND shippingpost="" AND somethingToShip AND (shipType=4 OR shipType=6 OR shipType=7) then
totShipOptions = 0
for index=0 to UBOUND(intShipping,2)
if intShipping(3,index)=true then
totShipOptions = totShipOptions + 1
if index=0 then
shipping = intShipping(2,index)
shipMethod = intShipping(0,index)
isstandardship = intShipping(4,index)
end if
end if
next
if totShipOptions=1 then
checkIntOptions=False
elseif totShipOptions=0 AND willpickuptext="" then
checkIntOptions=False
success=False
errormsg=xxNoMeth
end if
if willpickuptext<>"" then checkIntOptions = True
end if
calculateshipping = success
end function
sub insuranceandtaxaddedtoshipping()
if IsNumeric(shipinsuranceamt) AND shippingpost="" AND somethingToShip then
if (wantinsurance="Y" AND addshippinginsurance=2) OR addshippinginsurance=1 then
for index3=0 to UBOUND(intShipping,2)
intShipping(2,index3) = intShipping(2,index3) + ((cDbl(totalgoods)*cDbl(shipinsuranceamt))/100.0)
next
shipping = shipping + ((cDbl(totalgoods)*cDbl(shipinsuranceamt))/100.0)
elseif (wantinsurance="Y" AND addshippinginsurance=-2) OR addshippinginsurance=-1 then
for index3=0 to UBOUND(intShipping,2)
intShipping(2,index3) = intShipping(2,index3) + shipinsuranceamt
next
shipping = shipping + shipinsuranceamt
end if
end if
if taxShipping=1 AND shippingpost="" then
for index3=0 to UBOUND(intShipping,2)
intShipping(2,index3) = intShipping(2,index3) + (cDbl(intShipping(2,index3))*(cDbl(stateTaxRate)+cDbl(countryTaxRate)))/100.0
next
shipping = shipping + (cDbl(shipping)*(cDbl(stateTaxRate)+cDbl(countryTaxRate)))/100.0
end if
end sub
sub calculatetaxandhandling()
if handlingchargepercent<>"" then handling = handling + (((totalgoods + shipping + handling) - (totaldiscounts + freeshipamnt)) * handlingchargepercent / 100.0)
if taxHandling=1 then handling = handling + (cDbl(handling)*(cDbl(stateTaxRate)+cDbl(countryTaxRate)))/100.0
if canadataxsystem=true AND shipCountryID=2 AND (shipStateAbbrev="NB" OR shipStateAbbrev="NF" OR shipStateAbbrev="NS") then usehst=true else usehst=false
if canadataxsystem=true AND shipCountryID=2 AND (shipStateAbbrev="PE" OR shipStateAbbrev="QC") then
statetaxable = 0
countrytaxable = 0
if taxShipping=2 AND (shipping - freeshipamnt > 0) then
if proratashippingtax=TRUE then
if totalgoods > 0 then statetaxable = statetaxable + (((cDbl(totalgoods)-(cDbl(totaldiscounts)+cDbl(statetaxfree))) / totalgoods) * (cDbl(shipping)-cDbl(freeshipamnt)))
else
statetaxable = statetaxable + (cDbl(shipping)-cDbl(freeshipamnt))
end if
countrytaxable = countrytaxable + (cDbl(shipping)-cDbl(freeshipamnt))
end if
if taxHandling=2 then
statetaxable = statetaxable + cDbl(handling)
countrytaxable = countrytaxable + cDbl(handling)
end if
if totalgoods>0 then
statetaxable = statetaxable + (cDbl(totalgoods)-(cDbl(totaldiscounts)+cDbl(statetaxfree)))
countrytaxable = countrytaxable + (cDbl(totalgoods)-(cDbl(totaldiscounts)+cDbl(countrytaxfree)))
end if
countryTax = countrytaxable*cDbl(countryTaxRate)/100.0
stateTax = (statetaxable+cDbl(countryTax))*cDbl(stateTaxRate)/100.0
else
if totalgoods>0 then
stateTax = ((cDbl(totalgoods)-(cDbl(totaldiscounts)+cDbl(statetaxfree)))*cDbl(stateTaxRate)/100.0)
if perproducttaxrate<>TRUE then countryTax = ((cDbl(totalgoods)-(cDbl(totaldiscounts)+cDbl(countrytaxfree)))*cDbl(countryTaxRate)/100.0)
end if
if taxShipping=2 AND (shipping - freeshipamnt > 0) then
if proratashippingtax=TRUE then
if totalgoods>0 then stateTax = stateTax + (((cDbl(totalgoods)-(cDbl(totaldiscounts)+cDbl(statetaxfree))) / totalgoods) * (cDbl(shipping)-cDbl(freeshipamnt))*(cDbl(stateTaxRate)/100.0))
else
stateTax = stateTax + (cDbl(shipping)-cDbl(freeshipamnt))*(cDbl(stateTaxRate)/100.0)
end if
countryTax = countryTax + (cDbl(shipping)-cDbl(freeshipamnt))*(cDbl(countryTaxRate)/100.0)
end if
if taxHandling=2 then
stateTax = stateTax + cDbl(handling)*(cDbl(stateTaxRate)/100.0)
countryTax = countryTax + cDbl(handling)*(cDbl(countryTaxRate)/100.0)
end if
end if
if stateTax < 0 then stateTax = 0
if countryTax < 0 then countryTax = 0
end sub
if request.querystring("token") <> "" then
call getpayprovdetails(19,username,data2pwd,data2hash,demomode,ppmethod)
sXML = ppsoapheader(username, data2pwd, data2hash) & _
"1.00" & _
" " & request.querystring("token") & "" & _
""
if demomode then sandbox = ".sandbox" else sandbox = ""
if callxmlfunction("https://api-aa" & IIfVr(sandbox="" AND data2hash<>"", "-3t", "") & sandbox & ".paypal.com/2.0/", sXML, res, IIfVr(data2hash<>"","",username), "WinHTTP.WinHTTPRequest.5.1", errormsg, FALSE) then
countryid=0
success = FALSE
ordPayProvider = "19"
ordEmail = "" : insidedelivery = "" : commercialloc = "" : wantinsurance = "" : saturdaydelivery = "" : signaturerelease = ""
ordComLoc = 0
gotaddress = FALSE
token = request.querystring("token")
if abs(addshippinginsurance)=1 then ordComLoc = ordComLoc + 2
set xmlDoc = Server.CreateObject("MSXML2.DOMDocument")
xmlDoc.validateOnParse = False
xmlDoc.loadXML (res)
Set nodeList = xmlDoc.getElementsByTagName("SOAP-ENV:Body")
Set n = nodeList.Item(0)
for j = 0 to n.childNodes.length - 1
Set e = n.childNodes.Item(i)
if e.nodeName = "GetExpressCheckoutDetailsResponse" then
for k = 0 To e.childNodes.length - 1
Set t = e.childNodes.Item(k)
if t.nodeName = "Ack" then
if t.firstChild.nodeValue = "Success" OR t.firstChild.nodeValue = "SuccessWithWarning" then success=TRUE
elseif t.nodeName = "GetExpressCheckoutDetailsResponseDetails" then
set ff = t.childNodes
for kk = 0 to ff.length - 1
set gg = ff.item(kk)
if gg.nodeName = "PayerInfo" then
set hh = gg.childNodes
for ll = 0 to hh.length - 1
set ii = hh.item(ll)
if ii.nodeName = "Payer" then
if ii.hasChildNodes then ordEmail = ii.firstChild.nodeValue
elseif ii.nodeName = "PayerID" then
if ii.hasChildNodes then payerid = ii.firstChild.nodeValue
elseif ii.nodeName = "PayerStatus" then
if ii.hasChildNodes then
ordCVV = "U"
payer_status = lcase(ii.firstChild.nodeValue)
if payer_status="verified" then ordCVV = "Y"
if payer_status="unverified" then ordCVV = "N"
end if
elseif ii.nodeName = "PayerName" then
set jj = ii.childNodes
for mm = 0 to jj.length - 1
set jjj = jj.item(mm)
if jjj.nodeName = "FirstName" then
if jjj.hasChildNodes then ordName = jjj.firstChild.nodeValue & IIfVr(ordName<>"", " " & ordName, ordName)
elseif jjj.nodeName = "LastName" then
if jjj.hasChildNodes then ordName = IIfVr(ordName<>"", ordName&" ",ordName) & jjj.firstChild.nodeValue
end if
next
elseif ii.nodeName = "Address" then
set jj = ii.childNodes
for mm = 0 to jj.length - 1
set jjj = jj.item(mm)
if jjj.nodeName = "Street1" then
if jjj.hasChildNodes then ordAddress = jjj.firstChild.nodeValue
elseif jjj.nodeName = "Street2" then
if jjj.hasChildNodes then ordAddress2 = jjj.firstChild.nodeValue
elseif jjj.nodeName = "CityName" then
if jjj.hasChildNodes then ordCity = jjj.firstChild.nodeValue
elseif jjj.nodeName = "StateOrProvince" then
if jjj.hasChildNodes then ordState = jjj.firstChild.nodeValue
elseif jjj.nodeName = "Country" then
if jjj.hasChildNodes then
tmpcntry = replace(jjj.firstChild.nodeValue, "'", "")
sSQL = "SELECT countryName,countryID FROM countries WHERE "
if tmpcntry="GB" then
sSQL = sSQL & "countryID=201"
elseif tmpcntry="FR" then
sSQL = sSQL & "countryID=65"
elseif tmpcntry="PT" then
sSQL = sSQL & "countryID=153"
elseif tmpcntry="ES" then
sSQL = sSQL & "countryID=175"
else
sSQL = sSQL & "countryCode='"&tmpcntry&"'"
end if
rs.Open sSQL,cnn,0,1
ordCountry = rs("countryName")
countryid = rs("countryID")
rs.Close
end if
elseif jjj.nodeName = "PostalCode" then
if jjj.hasChildNodes then ordZip = jjj.firstChild.nodeValue
elseif jjj.nodeName = "AddressStatus" then
if jjj.hasChildNodes then
ordAVS = "U"
address_status = lcase(jjj.firstChild.nodeValue)
gotaddress = (address_status<>"none")
if address_status="confirmed" then ordAVS = "Y"
if address_status="unconfirmed" then ordAVS = "N"
end if
end if
next
end if
next
elseif gg.nodeName = "Custom" then
customarr = split(gg.firstChild.nodeValue, ":")
thesessionid = customarr(0)
ordAffiliate = customarr(1)
if left(thesessionid,3)="cid" then
session("clientID")=replace(right(thesessionid, len(thesessionid)-3),"'","")
sSQL = "SELECT clID,clUserName,clActions,clLoginLevel,clPercentDiscount FROM customerlogin WHERE clID="&replace(session("clientID"),"'","")
rs.Open sSQL,cnn,0,1
if NOT rs.EOF then
Session("clientUser")=rs("clUsername")
Session("clientActions")=rs("clActions")
Session("clientLoginLevel")=rs("clLoginLevel")
Session("clientPercentDiscount")=(100.0-cDbl(rs("clPercentDiscount")))/100.0
end if
rs.Close
else
thesessionid = replace(right(thesessionid, len(thesessionid)-3),"'","")
end if
elseif gg.nodeName = "ContactPhone" then
if gg.hasChildNodes then ordPhone = gg.firstChild.nodeValue
end if
next
elseif t.nodeName = "Errors" then
set ff = t.childNodes
for kk = 0 to ff.length - 1
set gg = ff.item(kk)
if gg.nodeName = "ShortMessage" then
errormsg = gg.firstChild.nodeValue & " " & errormsg
elseif gg.nodeName = "LongMessage" then
errormsg= errormsg & gg.firstChild.nodeValue
elseif gg.nodeName = "ErrorCode" then
errcode = gg.firstChild.nodeValue
end if
next
end if
next
end if
next
if NOT gotaddress then
ppexpresscancel=TRUE
elseif success then
paypalexpress=TRUE
if (countryid=1 OR countryid=2) AND usestateabbrev<>TRUE then
sSQL = "SELECT stateName FROM states WHERE stateAbbrev='" & replace(ordState,"'","''") & "'"
rs.Open sSQL,cnn,0,1
if NOT rs.EOF then ordState = rs("stateName")
rs.Close
end if
else
response.write "PayPal Payment Pro error: " & errormsg
end if
else
response.write "PayPal Payment Pro error: " & errormsg
end if
elseif checkoutmode="paypalexpress1" then
success = FALSE
call getpayprovdetails(19,username,data2pwd,data2hash,demomode,ppmethod)
if demomode then sandbox = ".sandbox" else sandbox = ""
if pathtossl<>"" then
if Right(pathtossl,1) <> "/" then storeurl = pathtossl & "/" else storeurl = pathtossl
end if
sXML = ppsoapheader(username, data2pwd, data2hash) & _
"1.00" & _
" " & _
" " & request.form("estimate") & "" & _
" " & storeurl & "cart.asp" & storeurl & "cart.asp" & _
" " & IIfVr(session("clientID")<>"", "cid"&session("clientID"), "sid"&thesessionid) & ":" & strip_tags2(trim(request.form("PARTNER"))) & "" & _
" " & IIfVr(ppmethod=1, "Authorization", "Sale") & "" & _
" " & _
""
if username="" then
response.redirect "http://altfarm.mediaplex.com/ad/ck/3484-23890-3840-61"
response.write "
"
elseif callxmlfunction("https://api-aa" & IIfVr(sandbox="" AND data2hash<>"", "-3t", "") & sandbox & ".paypal.com/2.0/", sXML, res, IIfVr(data2hash<>"","",username), "WinHTTP.WinHTTPRequest.5.1", errormsg, FALSE) then
set xmlDoc = Server.CreateObject("MSXML2.DOMDocument")
xmlDoc.validateOnParse = False
xmlDoc.loadXML (res)
Set nodeList = xmlDoc.getElementsByTagName("SOAP-ENV:Body")
Set n = nodeList.Item(0)
for j = 0 to n.childNodes.length - 1
Set e = n.childNodes.Item(i)
if e.nodeName = "SetExpressCheckoutResponse" then
for k = 0 To e.childNodes.length - 1
Set t = e.childNodes.Item(k)
if t.nodeName = "Ack" then
if t.firstChild.nodeValue = "Success" OR t.firstChild.nodeValue = "SuccessWithWarning" then success=TRUE
elseif t.nodeName = "Token" then
token = t.firstChild.nodeValue
elseif t.nodeName = "Errors" then
set ff = t.childNodes
for kk = 0 to ff.length - 1
set gg = ff.item(kk)
if gg.nodeName = "ShortMessage" then
errormsg = gg.firstChild.nodeValue & " " & errormsg
elseif gg.nodeName = "LongMessage" then
errormsg= errormsg & gg.firstChild.nodeValue
elseif gg.nodeName = "ErrorCode" then
errcode = gg.firstChild.nodeValue
end if
next
end if
next
end if
next
if success then
response.redirect "https://www" & sandbox & ".paypal.com/webscr?cmd=_express-checkout&token=" & token
response.write "
"
else
response.write "PayPal Payment Pro error: " & errormsg
end if
else
response.write "PayPal Payment Pro error: " & errormsg
end if
elseif checkoutmode="update" then
if stockManage<>0 then trimoldcartitems(DateAdd("h",dateadjust-stockManage,now()))
if estimateshipping=TRUE then session("xsshipping")=empty
if NOT IsEmpty(session("discounts")) then session("discounts")=empty
if NOT IsEmpty(session("xscountrytax")) then session("xscountrytax")=empty
cnn.Execute("UPDATE orders SET ordTotal=0,ordShipping=0,ordStateTax=0,ordCountryTax=0,ordHSTTax=0,ordHandling=0,ordDiscount=0,ordDiscountText='' WHERE ordAuthNumber='' AND " & getordersessionsql())
for each objItem In Request.Form
thequant = trim(Request.form(objItem))
if NOT IsNumeric(thequant) then thequant=0 else thequant=abs(int(thequant))
if Left(objItem,5)="quant" AND thequant<>"" then
thecartid = int(Right(objItem, Len(objItem)-5))
if thequant=0 then
sSQL="DELETE FROM cartoptions WHERE coCartID="&thecartid
cnn.Execute(sSQL)
sSQL="DELETE FROM cart WHERE cartID="&thecartid
cnn.Execute(sSQL)
else
totQuant = 0
pPrice = 0
pID = ""
sSQL="SELECT cartQuantity,pInStock,pID,pStockByOpts,"&WSP&"pPrice FROM cart INNER JOIN products ON cart.cartProdId=products.pID WHERE cartID="&thecartid
rs.Open sSQL,cnn,0,1
if NOT rs.EOF then
pID = rs("pID")
pInStock = int(rs("pInStock"))
pStockByOpts = cint(rs("pStockByOpts"))
pPrice = rs("pPrice")
cartQuantity = int(rs("cartQuantity"))
rs.Close
sSQL = "SELECT SUM(cartQuantity) AS cartQuant FROM cart WHERE cartCompleted=0 AND cartProdID='"&trim(pID)&"'"
rs.Open sSQL,cnn,0,1
if NOT rs.EOF then
if NOT IsNull(rs("cartQuant")) then totQuant = Int(rs("cartQuant"))
end if
end if
rs.Close
if pID<>"" then
if stockManage<>0 then
quantavailable = thequant
if pStockByOpts <> 0 then
hasalloptions=true
sSQL = "SELECT coID,optStock,cartQuantity,coOptID FROM cart INNER JOIN (cartoptions INNER JOIN (options INNER JOIN optiongroup ON options.optGroup=optiongroup.optGrpID) ON cartoptions.coOptID=options.optID) ON cart.cartID=cartoptions.coCartID WHERE optType IN (-2,-1,1,2) AND cartID="&thecartid
rs.Open sSQL,cnn,0,1
if NOT rs.EOF then
do while NOT rs.EOF
pInStock = Int(rs("optStock"))
totQuant = 0
cartQuantity = Int(rs("cartQuantity"))
sSQL = "SELECT SUM(cartQuantity) AS cartQuant FROM cart INNER JOIN cartoptions ON cart.cartID=cartoptions.coCartID WHERE cartCompleted=0 AND coOptID="&rs("coOptID")
rs2.Open sSQL,cnn,0,1
if NOT rs2.EOF then
if NOT IsNull(rs2("cartQuant")) then totQuant = Int(rs2("cartQuant"))
end if
rs2.Close
if Int(pInStock - totQuant + cartQuantity) < quantavailable then quantavailable = (pInStock - totQuant + cartQuantity)
if (pInStock - totQuant + cartQuantity - thequant) < 0 then hasalloptions=false
rs.MoveNext
loop
cnn.Execute("UPDATE cart SET cartQuantity="&quantavailable&" WHERE cartCompleted=0 AND cartID="&thecartid)
if NOT hasalloptions then isInStock = false
end if
rs.Close
else
if (pInStock - totQuant + cartQuantity - thequant) < 0 then
quantavailable = (pInStock - totQuant + cartQuantity)
if quantavailable < 0 then quantavailable=0
isInStock = false
end if
cnn.Execute("UPDATE cart SET cartQuantity="&quantavailable&" WHERE cartCompleted=0 AND cartID="&thecartid)
end if
else
cnn.Execute("UPDATE cart SET cartQuantity="&thequant&" WHERE cartCompleted=0 AND cartID="&thecartid)
end if
call checkpricebreaks(pID,pPrice)
end if
end if
elseif Left(objItem,5)="delet" then
rs.Open "SELECT cartID FROM cart WHERE cartCompleted=0 AND cartID="&int(Right(objItem, Len(objItem)-5)),cnn,0,1
if NOT rs.EOF then
cnn.Execute("DELETE FROM cart WHERE cartID="&int(Right(objItem, Len(objItem)-5)))
cnn.Execute("DELETE FROM cartoptions WHERE coCartID="&int(Right(objItem, Len(objItem)-5)))
end if
rs.Close
end if
next
end if
if checkoutmode="add" then
if stockManage<>0 then trimoldcartitems(DateAdd("h",dateadjust-stockManage,now()))
if estimateshipping=TRUE then session("xsshipping")=empty
if NOT IsEmpty(session("discounts")) then session("discounts")=empty
if NOT IsEmpty(session("xscountrytax")) then session("xscountrytax")=empty
cnn.Execute("UPDATE orders SET ordTotal=0,ordShipping=0,ordStateTax=0,ordCountryTax=0,ordHSTTax=0,ordHandling=0,ordDiscount=0,ordDiscountText='' WHERE ordAuthNumber='' AND " & getordersessionsql())
Session.LCID = 1033
if trim(Request.Form("frompage"))<>"" then Session("frompage")=Request.Form("frompage") else Session("frompage")=empty
if Request.Form("quant")="" OR NOT IsNumeric(Request.Form("quant")) then quantity=1 else quantity=abs(int(trim(Request.Form("quant"))))
origquantity = quantity
for jj = 1 to Request.Form.Count
for each objElem in Request.Form
if Request.Form(objElem) is Request.Form(jj) then objForm = objElem
next
if Left(objForm,4)="optn" AND trim(Request.Form(objForm))<>"" AND IsNumeric(trim(Request.Form(objForm))) then
sSQL="SELECT optRegExp FROM options WHERE optID="&replace(Request.Form(objForm),"'","")
rs2.Open sSQL,cnn,0,1
if rs2.EOF then theexp="" else theexp = trim(rs2("optRegExp")&"")
if theexp<>"" AND Left(theexp,1)<>"!" then
theexp = replace(theexp, "%s", theid)
if InStr(theexp, " ") > 0 then ' Search and replace
exparr = split(theexp, " ", 2)
theid = replace(theid, exparr(0), exparr(1), 1, 1)
else
theid = theexp
end if
end if
rs2.Close
end if
next
bExists=False
sSQL = "SELECT cartID FROM cart WHERE cartCompleted=0 AND " & getsessionsql() & " AND cartProdID='"&theid&"'"
rs.Open sSQL,cnn,0,1
do while (NOT rs.EOF) AND (NOT bExists)
bExists=True
cartID=rs("cartID")
for each objForm in Request.Form ' We have the product. Check we have all the same options
if Left(objForm,4)="optn" then
if trim(Request.Form("v"&objForm))<>"" then
sSQL="SELECT coID FROM cartoptions WHERE coCartID="&cartID&" AND coOptID="&replace(Request.Form(objForm),"'","")&" AND coCartOption='"&replace(trim(Request.Form("v"&objForm)),"'","''")&"'"
rs2.Open sSQL,cnn,0,1
if rs2.EOF then bExists=false
rs2.Close
elseif isnumeric(Request.Form(objForm)) then
sSQL="SELECT coID FROM cartoptions WHERE coCartID="&cartID&" AND coOptID="&replace(Request.Form(objForm),"'","")
rs2.Open sSQL,cnn,0,1
if rs2.EOF then bExists=false
rs2.Close
end if
end if
if NOT bExists then exit for
next
rs.MoveNext
loop
rs.Close
sSQL = "SELECT "&getlangid("pName",1)&","&WSP&"pPrice,pInStock,pWeight,pStockByOpts FROM products WHERE pSell<>0 AND pID='"&theid&"'"
rs.Open sSQL,cnn,0,1
if NOT rs.EOF then
alldata=rs.getrows
else
redim alldata(1,1)
alldata(0,0)=theid
stockManage=0
isInStock=false
outofstockreason=2
end if
rs.Close
sub push_stock_item()
stockrelarr(0,stockrelitems)=rs("cartID")
stockrelarr(1,stockrelitems)=rs("cartQuantity")
stockrelarr(2,stockrelitems)=rs("cartDateAdded")
stockrelarr(3,stockrelitems)=rs("cartClientID")
stockrelarr(4,stockrelitems)=rs("cartSessionID")
stockrelitems=stockrelitems+1
if stockrelitems >= UBOUND(stockrelarr, 2) then redim preserve stockrelarr(4, UBOUND(stockrelitems, 2) + 10)
end sub
bestDate = DateAdd("m",-2,now())
if stockManage<>0 then
stockRelDate = DateAdd("h",dateadjust-stockManage,now()) ' For saved cart items
outofstockreason=1
if int(alldata(4,0)) <> 0 then
for each objForm in Request.Form
totQuant = 0
if Left(objForm,4)="optn" AND trim(Request.Form(objForm))<>"" then
sSQL="SELECT optStock FROM options INNER JOIN optiongroup ON options.optGroup=optiongroup.optGrpID WHERE optType IN (-2,-1,1,2) AND optID="&replace(Request.Form(objForm),"'","")
rs.Open sSQL,cnn,0,1
if NOT rs.EOF then stockQuant = rs("optStock") else stockQuant = origquantity
rs.Close
sSQL = "SELECT cartID,cartQuantity,cartDateAdded,cartOrderID,cartClientID,cartSessionID FROM cart INNER JOIN (cartoptions INNER JOIN (options INNER JOIN optiongroup ON options.optGroup=optiongroup.optGrpID) ON cartoptions.coOptID=options.optID) ON cart.cartID=cartoptions.coCartID WHERE optType IN (-2,-1,1,2) AND cartCompleted=0 AND coOptID="&replace(Request.Form(objForm),"'","")&" ORDER BY cartDateAdded DESC"
rs.Open sSQL,cnn,0,1
do while NOT rs.EOF
totQuant=totQuant+rs("cartQuantity")
if Int(rs("cartOrderID"))=0 then
if rs("cartDateAdded") > bestDate AND totQuant+stockQuant >= origquantity then bestDate = rs("cartDateAdded")
if rs("cartDateAdded") < stockRelDate then push_stock_item()
end if
rs.MoveNext
loop
rs.Close
if stockQuant-totQuant < quantity then quantity = stockQuant-totQuant
if (stockQuant+totQuant) < origquantity then outofstockreason=0
end if
next
else
totQuant = 0
stockQuant = alldata(2,0)
sSQL = "SELECT cartID,cartQuantity,cartDateAdded,cartOrderID,cartClientID,cartSessionID FROM cart WHERE cartCompleted=0 AND cartProdID='"&theid&"' ORDER BY cartDateAdded DESC"
rs.Open sSQL,cnn,0,1
do while NOT rs.EOF
totQuant=totQuant+rs("cartQuantity")
if Int(rs("cartOrderID"))=0 then
if rs("cartDateAdded") > bestDate AND totQuant+stockQuant >= origquantity then bestDate = rs("cartDateAdded")
if rs("cartDateAdded") < stockRelDate then push_stock_item()
end if
rs.MoveNext
loop
rs.Close
if stockQuant-totQuant < quantity then quantity = stockQuant-totQuant
if (stockQuant+totQuant) < origquantity then outofstockreason=0
end if
do while quantity < origquantity AND stockrelitems > 0
stockrelitems=stockrelitems-1
if session("clientID")<>"" then
if stockrelarr(3,stockrelitems)<>session("clientID") then
cnn.Execute("DELETE FROM cart WHERE cartID=" & stockrelarr(0,stockrelitems))
quantity=quantity+stockrelarr(1,stockrelitems)
end if
else
if stockrelarr(4,stockrelitems)<>thesessionid then
cnn.Execute("DELETE FROM cart WHERE cartID=" & stockrelarr(0,stockrelitems))
quantity=quantity+stockrelarr(1,stockrelitems)
end if
end if
loop
if quantity > 0 then isInStock = TRUE else isInStock = FALSE
if quantity > origquantity then quantity = origquantity
end if
if isInStock then
if bExists then
sSQL = "UPDATE cart SET cartQuantity=cartQuantity+"&quantity&" WHERE cartCompleted=0 AND cartID="&cartID
cnn.Execute(sSQL)
else
rs.Open "cart",cnn,1,3,&H0002
rs.AddNew
rs.Fields("cartSessionID") = thesessionid
if Session("clientID")<>"" then rs.Fields("cartClientID") = Session("clientID") else rs.Fields("cartClientID") = 0
rs.Fields("cartProdID") = theid
rs.Fields("cartQuantity") = quantity
rs.Fields("cartCompleted") = 0
rs.Fields("cartProdName") = strip_tags2(alldata(0,0))
rs.Fields("cartProdPrice") = alldata(1,0)
rs.Fields("cartDateAdded") = DateAdd("h",dateadjust,Now())
rs.Update
if mysqlserver=true then
rs.Close
rs.Open "SELECT LAST_INSERT_ID() AS lstIns",cnn,0,1
cartID = rs("lstIns")
else
cartID = rs.Fields("cartID")
end if
rs.Close
for jj = 1 to Request.Form.Count
for each objElem in Request.Form
if Request.Form(objElem) is Request.Form(jj) then objForm = objElem
next
if Left(objForm,4)="optn" then
if trim(Request.Form("v"&objForm))="" then
if isnumeric(Request.Form(objForm)) then
sSQL="SELECT optID,"&getlangid("optGrpName",16)&","&getlangid("optName",32)&","&OWSP&"optPriceDiff,optWeightDiff,optType,optFlags FROM options INNER JOIN optiongroup ON options.optGroup=optiongroup.optGrpID WHERE optID="&Replace(Request.Form(objForm),"'","")
rs.Open sSQL,cnn,0,1
if abs(rs("optType"))<> 3 then
sSQL = "INSERT INTO cartoptions (coCartID,coOptID,coOptGroup,coCartOption,coPriceDiff,coWeightDiff) VALUES ("&cartID&","&rs("optID")&",'"&Replace(rs(getlangid("optGrpName",16))&"","'","''")&"','"&Replace(rs(getlangid("optName",32))&"","'","''")&"',"
if (rs("optFlags") AND 1) = 0 then sSQL = sSQL & rs("optPriceDiff") & "," else sSQL = sSQL & vsround((rs("optPriceDiff")*alldata(1,0))/100.0, 2) & ","
if (rs("optFlags") AND 2) = 0 then sSQL = sSQL & rs("optWeightDiff") & ")" else sSQL = sSQL & multShipWeight(alldata(3,0),rs("optWeightDiff")) & ")"
else
sSQL = "INSERT INTO cartoptions (coCartID,coOptID,coOptGroup,coCartOption,coPriceDiff,coWeightDiff) VALUES ("&cartID&","&rs("optID")&",'"&Replace(rs(getlangid("optGrpName",16))&"","'","''")&"','',0,0)"
end if
rs.Close
cnn.Execute(sSQL)
end if
else
sSQL="SELECT optID,"&getlangid("optGrpName",16)&","&getlangid("optName",32)&" FROM options INNER JOIN optiongroup ON options.optGroup=optiongroup.optGrpID WHERE optID="&replace(Request.Form(objForm),"'","")
rs.Open sSQL,cnn,0,1
sSQL = "INSERT INTO cartoptions (coCartID,coOptID,coOptGroup,coCartOption,coPriceDiff,coWeightDiff) VALUES ("&cartID&","&rs("optID")&",'"&Replace(rs(getlangid("optGrpName",16))&"","'","''")&"','"&replace(trim(Request.Form("v"&objForm)),"'","''")&"',0,0)"
cnn.Execute(sSQL)
rs.Close
end if
end if
next
end if
call checkpricebreaks(theid, alldata(1,0))
%>
<% if quantity < origquantity then
response.write "
"&xxInsuff&"
"&replace(xxOnlyAd,"%s",quantity)&"
"&xxWanRem&"
"
response.write ""
else
if cartrefreshseconds="" then cartrefreshseconds=3
if trim(Request.Form("frompage"))<>"" AND actionaftercart=3 then
if cartrefreshseconds=0 then
response.redirect trim(Request.Form("frompage"))
else
response.write ""
end if
elseif actionaftercart=4 OR cartrefreshseconds=0 then
response.redirect "cart.asp"&IIfVr(request.form("PARTNER")<>"","?PARTNER="&strip_tags2(trim(request.form("partner"))),"")
else
response.write ""","?PARTNER="&strip_tags2(trim(request.form("partner"))),"")&""">"
end if
response.write "
<% totMins = DateDiff("n",DateAdd("h",dateadjust,Now()),DateAdd("h",stockManage,bestDate))
if (totMins>600 OR totMins<=0) AND outofstockreason=1 then outofstockreason=0
response.write "
" & xxSrryItm & " " & server.htmlencode(alldata(0,0))&" " & xxIsCntly
if outofstockreason=1 then response.write " " & xxTemprly
if outofstockreason=2 then response.write " not available in our product database." else response.write " " & xxOutStck & "
"
if outofstockreason=1 then
response.write "
" & xxNotChOu & " "
if totMins > 300 then
response.write xxShrtWhl
else
if totMins >= 60 then response.write Int(totMins / 60) & " hour"
if totMins >= 120 then response.write "s"
totMins = totMins - (Int(totMins / 60) * 60)
if totMins > 0 then response.write " " & totMins & " minute"
if totMins > 1 then response.write "s"
end if
response.write xxChkBack & "
<%
end if
elseif checkoutmode="checkout" OR ppexpresscancel then
Dim ordName,ordAddress,ordAddress2,ordCity,ordState,ordZip,ordCountry,ordEmail,ordPhone,ordShipName,ordShipAddress,ordShipAddress2,ordShipCity,ordShipState,ordShipZip,ordShipCountry,ordAddInfo
Dim remember,allstates,havestate,allcountries
allstates=""
allcountries=""
remember=False
if trim(request.form("checktmplogin"))<>"" AND isnumeric(trim(request.form("sessionid"))) then
sSQL = "SELECT tmploginname FROM tmplogin WHERE tmploginid=" & replace(trim(request.form("sessionid")),"'","") & " AND tmploginchk=" & replace(trim(request.form("checktmplogin")),"'","")
rs.Open sSQL,cnn,0,1
if NOT rs.EOF then
Session("clientID")=rs("tmploginname")
rs.Close
' cnn.Execute("DELETE FROM tmplogin WHERE tmploginid=" & replace(trim(request.form("sessionid")),"'",""))
sSQL = "SELECT clUserName,clActions,clLoginLevel,clPercentDiscount,clEmail,clPW FROM customerlogin WHERE clID="&replace(trim(session("clientID")),"'","")
rs.Open sSQL,cnn,0,1
if NOT rs.EOF then
Session("clientUser")=rs("clUserName")
Session("clientActions")=rs("clActions")
Session("clientLoginLevel")=rs("clLoginLevel")
Session("clientPercentDiscount")=(100.0-cDbl(rs("clPercentDiscount")))/100.0
get_wholesaleprice_sql()
if rs("clEmail")<>request.cookies("WRITECLL") OR rs("clPW")<>request.cookies("WRITECLP") then response.write ""
end if
end if
rs.Close
end if
if request.cookies("id1")<>"" AND request.cookies("id2")<>"" AND IsNumeric(request.cookies("id1")) AND IsNumeric(request.cookies("id2")) then
sSQL = "SELECT ordName,ordAddress,ordAddress2,ordCity,ordState,ordZip,ordCountry,ordEmail,ordPhone,ordShipName,ordShipAddress,ordShipAddress2,ordShipCity,ordShipState,ordShipZip,ordShipCountry,ordShipPhone,ordPayProvider,ordComLoc,ordExtra1,ordExtra2,ordShipExtra1,ordShipExtra2,ordCheckoutExtra1,ordCheckoutExtra2,ordAddInfo FROM orders WHERE ordID="&request.cookies("id1")&" AND ordSessionID="&request.cookies("id2")
rs.Open sSQL,cnn,0,1
if NOT rs.EOF then
ordName = rs("ordName")
ordAddress = rs("ordAddress")
ordAddress2 = rs("ordAddress2")
ordCity = rs("ordCity")
ordState = rs("ordState")
ordZip = rs("ordZip")
ordCountry = rs("ordCountry")
ordEmail = rs("ordEmail")
ordPhone = rs("ordPhone")
ordShipName = rs("ordShipName")
ordShipAddress = rs("ordShipAddress")
ordShipAddress2 = rs("ordShipAddress2")
ordShipCity = rs("ordShipCity")
ordShipState = rs("ordShipState")
ordShipZip = rs("ordShipZip")
ordShipCountry = rs("ordShipCountry")
ordShipPhone = rs("ordShipPhone")
ordPayProvider = rs("ordPayProvider")
ordComLoc = rs("ordComLoc")
ordExtra1 = rs("ordExtra1")
ordExtra2 = rs("ordExtra2")
ordShipExtra1 = rs("ordShipExtra1")
ordShipExtra2 = rs("ordShipExtra2")
ordCheckoutExtra1 = rs("ordCheckoutExtra1")
ordCheckoutExtra2 = rs("ordCheckoutExtra2")
ordAddInfo = rs("ordAddInfo")
remember=True
end if
rs.Close
end if
sSQL = "SELECT stateName,stateAbbrev FROM states WHERE stateEnabled=1 ORDER BY stateName"
rs.Open sSQL,cnn,0,1
if NOT rs.EOF then allstates=rs.getrows
rs.Close
numhomecountries = 0
nonhomecountries = 0
sSQL = "SELECT countryName,countryOrder,"&getlangid("countryName",8)&" AS cnameshow FROM countries WHERE countryEnabled=1 ORDER BY countryOrder DESC,"&getlangid("countryName",8)
rs.Open sSQL,cnn,0,1
if NOT rs.EOF then allcountries=rs.getrows
rs.Close
if IsArray(allcountries) then
for rowcounter=0 to UBOUND(allcountries,2)
if allcountries(1,rowcounter)=2 then numhomecountries = numhomecountries + 1 else nonhomecountries = nonhomecountries + 1
next
end if
%>
<% alladdresses=""
if enableclientlogin=TRUE AND Session("clientID")<>"" then
sSQL = "SELECT addID,addIsDefault,addName,addAddress,addAddress2,addState,addCity,addZip,addPhone,addCountry FROM address WHERE addCustID=" & Session("clientID") & " ORDER BY addIsDefault"
rs.Open sSQL,cnn,0,1
if NOT rs.EOF then alladdresses=rs.GetRows
rs.Close
end if %>
<%
elseif checkoutmode="go" OR paypalexpress then
%>
<%
'This code is copyright (c) Internet Business Solutions SL, all rights reserved.
'The contents of this file are protect under law as the intellectual property
'of Internet Business Solutions SL. Any use, reproduction, disclosure or copying
'of any kind without the express and written permission of Internet Business
'Solutions SL is forbidden.
'Author: Vince Reid, vince@virtualred.net
sub sortshippingarray()
for ssaindex2=0 to UBOUND(intShipping,2)
intShipping(2,ssaindex2) = cDbl(intShipping(2,ssaindex2))
for ssaindex=1 to UBOUND(intShipping,2)
if intShipping(3,ssaindex) AND cDbl(intShipping(2,ssaindex))"
' next
end sub
Function ParseUSPSXMLOutput(sXML, international, byRef totalCost, byRef errormsg, byRef intShipping)
Dim noError, nodeList, packCost, xmlDoc, e, i, j, k, l, n, t, t2, s2
noError = True
totalCost = 0
packCost = 0
errormsg = ""
gotxml=false
on error resume next
err.number=0
set xmlDoc = Server.CreateObject("MSXML2.DOMDocument")
if err.number=0 then gotxml=true
if NOT gotxml then
err.number=0
set xmlDoc = Server.CreateObject("MSXML.DOMDocument")
if err.number=0 then gotxml=true
end if
on error goto 0
xmlDoc.validateOnParse = False
xmlDoc.loadXML (sXML)
If xmlDoc.documentElement.nodeName = "Error" then 'Top-level Error
noError = False
Set nodeList = xmlDoc.getElementsByTagName("Error")
Set n = nodeList.Item(0)
For i = 0 To n.childNodes.length - 1
Set e = n.childNodes.Item(i)
Select Case e.nodeName
Case "Source"
Case "Number"
Case "Description"
errormsg = e.firstChild.nodeValue
Case "HelpFile"
Case "HelpContext"
End Select
Next
Else 'no Top-level Error
Set nodeList = xmlDoc.getElementsByTagName("Package")
For i = 0 To nodeList.length - 1
Set n = nodeList.Item(i)
tmpArr = Split(n.getAttribute("ID"),"x")
quantity = Int(tmpArr(1))
For j = 0 To n.childNodes.length - 1
Set e = n.childNodes.Item(j)
If e.nodeName = "Error" Then 'Lower-level error
For k = 0 To e.childNodes.length - 1
Set t = e.childNodes.Item(k)
Select Case t.nodeName
Case "Description"
if debugmode=TRUE then response.write "USPS warning: " & t.firstChild.nodeValue & " "
End Select
Next
else
Select Case e.nodeName
Case "Postage"
if international = "" then
l = 0
do while (intShipping(0, l) <> thisService AND intShipping(0, l) <> "")
l = l + 1
loop
intShipping(0, l) = thisService
if thisService="PARCEL" then
intShipping(1, l) = "2-7 " & xxDays
elseif thisService="EXPRESS" then
intShipping(1, l) = "Overnight to most areas"
elseif thisService="PRIORITY" then
intShipping(1, l) = "1-2 " & xxDays
elseif thisService="BPM" then
intShipping(1, l) = "2-7 " & xxDays
elseif thisService="Media" then
intShipping(1, l) = "2-7 " & xxDays
elseif thisService="FIRST CLASS" then
intShipping(1, l) = "1-3 " & xxDays
end if
intShipping(2, l) = intShipping(2, l) + (e.firstChild.nodeValue * quantity)
intShipping(3, l) = intShipping(3, l) + 1
end if
Case "Service"
if international <> "" then
Set t2 = e.getElementsByTagName("SvcDescription")
Set s2 = t2.Item(0)
l = 0
do while (intShipping(0, l) <> s2.firstChild.nodeValue AND intShipping(0, l) <> "")
l = l + 1
loop
intShipping(0, l) = s2.firstChild.nodeValue
Set t2 = e.getElementsByTagName("SvcCommitments")
Set s2 = t2.Item(0)
intShipping(1, l) = s2.firstChild.nodeValue
Set t2 = e.getElementsByTagName("Postage")
Set s2 = t2.Item(0)
intShipping(2, l) = intShipping(2, l) + (s2.firstChild.nodeValue * quantity)
intShipping(3, l) = intShipping(3, l) + 1
else
thisService = e.firstChild.nodeValue
end if
End Select
End If
Next
totalCost = totalCost + packCost
packCost = 0
Next
End If
set xmlDoc = nothing
ParseUSPSXMLOutput = noError
end Function
Function checkUPSShippingMeth(method, byRef discountsApply, byRef showAs)
retval = false
for xx=0 to UBOUND(uspsmethods,2)
if method=uspsmethods(0,xx) then
retval=true
discountsApply = uspsmethods(1,xx)
showAs = uspsmethods(2,xx)
exit for
end if
next
checkUPSShippingMeth = retval
End Function
Function ParseUPSXMLOutput(xmlDoc, international, byRef totalCost, byRef errormsg, byRef errorcode, byRef intShipping)
Dim noError, nodeList, e, i, j, k, l, n, t, t2, indexus
noError = True
totalCost = 0
indexus = 0
l = 0
errormsg = ""
Set t2 = xmlDoc.getElementsByTagName("RatingServiceSelectionResponse").Item(0)
for j = 0 to t2.childNodes.length - 1
Set n = t2.childNodes.Item(j)
if n.nodename="Response" then
For i = 0 To n.childNodes.length - 1
Set e = n.childNodes.Item(i)
if e.nodeName="ResponseStatusCode" then
noError = Int(e.firstChild.nodeValue)=1
end if
if e.nodeName="Error" then
errormsg = ""
For k = 0 To e.childNodes.length - 1
Set t = e.childNodes.Item(k)
Select Case t.nodeName
Case "ErrorCode"
errorcode = t.firstChild.nodeValue
Case "ErrorSeverity"
if t.firstChild.nodeValue="Transient" then errormsg = "This is a temporary error. Please wait a few moments then refresh this page. " & errormsg
Case "ErrorDescription"
errormsg = errormsg & t.firstChild.nodeValue
End Select
Next
end if
' response.write "The Nodename is : " & e.nodeName & ":" & e.firstChild.nodeValue & " "
Next
elseif n.nodename="RatedShipment" then
wantthismethod=true
For i = 0 To n.childNodes.length - 1
Set e = n.childNodes.Item(i)
Select Case e.nodeName
Case "Service"
For k = 0 To e.childNodes.length - 1
Set t = e.childNodes.Item(k)
if t.nodeName = "Code" then
Select Case cStr(t.firstChild.nodeValue)
Case "01"
intShipping(0, l) = "UPS Next Day Air®"
Case "02"
intShipping(0, l) = "UPS 2nd Day Air®"
Case "03"
intShipping(0, l) = "UPS Ground"
Case "07"
intShipping(0, l) = "UPS Worldwide Express"
Case "08"
intShipping(0, l) = "UPS Worldwide Expedited"
Case "11"
intShipping(0, l) = "UPS Standard"
Case "12"
intShipping(0, l) = "UPS 3 Day Select®"
Case "13"
intShipping(0, l) = "UPS Next Day Air Saver®"
Case "14"
intShipping(0, l) = "UPS Next Day Air® Early A.M.®"
Case "54"
intShipping(0, l) = "UPS Worldwide Express Plus"
Case "59"
intShipping(0, l) = "UPS 2nd Day Air A.M.®"
Case "65"
intShipping(0, l) = "UPS Express Saver"
End Select
wantthismethod = checkUPSShippingMeth(t.firstChild.nodeValue, discntsApp, notUsed)
intShipping(4, l) = discntsApp
end if
Next
Case "TotalCharges"
For k = 0 To e.childNodes.length - 1
Set t = e.childNodes.Item(k)
if t.nodeName = "MonetaryValue" then intShipping(2, l) = cDbl(t.firstChild.nodeValue)
Next
Case "GuaranteedDaysToDelivery"
if e.childNodes.length > 0 then
if e.firstChild.nodeValue="1" then
intShipping(1, l) = "1 " & xxDay & intShipping(1, l)
else
intShipping(1, l) = e.firstChild.nodeValue & " " & xxDays & intShipping(1, l)
end if
end if
Case "ScheduledDeliveryTime"
if e.childNodes.length > 0 then intShipping(1, l) = intShipping(1, l) & " by " & e.firstChild.nodeValue
End select
Next
if wantthismethod=true then
intShipping(3, l) = true
l = l + 1
else
intShipping(1, l) = ""
end if
wantthismethod=true
' response.write "The RatedShipment is : " & n.nodeName & ":" & n.firstChild.nodeValue & " "
end if
Next
ParseUPSXMLOutput = noError
end Function
Function ParseCanadaPostXMLOutput(xmlDoc, international, byRef totalCost, byRef errormsg, byRef errorcode, byRef intShipping)
Dim noError, nodeList, e, i, j, k, l, n, t, t2, indexus
noError = True
totalCost = 0
indexus = 0
l = 0
cphandlingcharge = 0
errormsg = ""
Set t2 = xmlDoc.getElementsByTagName("eparcel").Item(0)
for j = 0 to t2.childNodes.length - 1
Set n = t2.childNodes.Item(j)
if n.nodename="error" then
noError = false
For i = 0 To n.childNodes.length - 1
Set e = n.childNodes.Item(i)
if e.nodeName="statusMessage" then
errormsg = errormsg & e.firstChild.nodeValue
elseif e.nodeName="statusCode" then
errorcode = e.firstChild.nodeValue
end if
Next
elseif n.nodename="ratesAndServicesResponse" then
for i = 0 To n.childNodes.length - 1
Set e = n.childNodes.Item(i)
if e.nodeName="handling" then
if e.hasChildNodes then cphandlingcharge = e.firstChild.nodeValue
end if
next
For i = 0 To n.childNodes.length - 1
Set e = n.childNodes.Item(i)
if e.nodeName="product" then
wantthismethod = checkUPSShippingMeth(e.getAttribute("id"), discntsApp, notUsed)
intShipping(4, l) = discntsApp
wantthismethod=true
For k = 0 To e.childNodes.length - 1
Set t = e.childNodes.Item(k)
Select Case t.nodeName
Case "name"
intShipping(0, l) = t.firstChild.nodeValue
Case "rate"
intShipping(2, l) = cDbl(t.firstChild.nodeValue) + cDbl(cphandlingcharge)
Case "deliveryDate"
if IsDate(t.firstChild.nodeValue) then
numdays = DateValue(t.firstChild.nodeValue) - Date()
intShipping(1, l) = numdays & " " & IIfVr(numdays<2,xxDay,xxDays) & intShipping(1, l)
else
intShipping(1, l) = t.firstChild.nodeValue & intShipping(1, l)
end if
Case "nextDayAM"
if t.firstChild.nodeValue="true" then intShipping(1, l) = intShipping(1, l) & " AM"
End select
Next
if wantthismethod=true then
intShipping(3, l) = true
l = l + 1
else
intShipping(1, l) = ""
end if
wantthismethod=true
end if
next
end if
Next
ParseCanadaPostXMLOutput = noError
end Function
function addUSPSDomestic(id,service,orig,dest,iWeight,quantity,container,size,machinable)
Dim sXML
sXML = ""
pounds = Int(iWeight)
ounces = round((iWeight-pounds)*16)
if pounds=0 AND ounces=0 then ounces=1
if IsArray(uspsmethods) then
for indexus=0 TO UBOUND(uspsmethods,2)
sXML = sXML & ""
sXML = sXML & ""&uspsmethods(0,indexus)&""
sXML = sXML & ""&orig&""&left(dest, 5)&""
sXML = sXML & ""£s&""&ounces&""
sXML = sXML & ""&container&""&size&""
sXML = sXML & ""&machinable&""
next
end if
addUSPSDomestic = sXML
end function
function addUSPSInternational(id,iWeight,quantity,mailtype,country)
Dim sXML
pounds = Int(iWeight)
ounces = round((iWeight-pounds)*16)
if pounds=0 AND ounces=0 then ounces=1
sXML = ""£s&""&ounces&""&mailtype&""&country&""
addUSPSInternational = sXML & ""
end function
function addUPSInternational(iWeight,adminUnits,packTypeCode,country,packcost,dimens)
Dim sXML
if iWeight < 0.1 then iWeight=0.1
sXML = ""&packTypeCode&"Package"
if oversize<>0 then sXML = sXML & "" & oversize & ""
oversize = 0
if dimens(0) > 0 AND dimens(1) > 0 AND dimens(2) > 0 then sXML = sXML & "" & vsround(dimens(0),0) & "" & vsround(dimens(1),0) & "" & vsround(dimens(2),0) & ""&IIfVr((adminUnits AND 12)=4,"IN","CM")&""
dimens(0)=0 : dimens(1)=0 : dimens(2)=0 : dimens(3)=0
sXML = sXML & "Rate Shopping"&IIfVr((adminUnits AND 1)=1,"LBS","KGS")&""&iWeight&""
if abs(addshippinginsurance)=1 OR (abs(addshippinginsurance)=2 AND wantinsurancepost="Y") then
if packcost > 50000 then packcost=50000
sXML = sXML & "" & countryCurrency & "" & FormatNumber(packcost,2,-1,0,0) & ""
end if
if payproviderpost<>"" then
if int(payproviderpost)=codpaymentprovider then sXML = sXML & "03"&countryCurrency&"" & FormatNumber(packcost,2,-1,0,0) & ""
end if
if signatureoption="indirect" then
sXML = sXML & "1"
elseif signatureoption="direct" then
sXML = sXML & "2"
elseif signatureoption="adult" then
sXML = sXML & "3"
end if
addUPSInternational = sXML & ""
end function
function addCanadaPostPackage(iWeight,adminUnits,packTypeCode,country,packcost,dimens)
if iWeight < 0.1 then iWeight=0.1
if packtogether then thesize = 1 else thesize = 19
if dimens(0)=0 then dimens(0) = thesize
if dimens(1)=0 then dimens(1) = thesize
if dimens(2)=0 then dimens(2) = thesize
tmpXML = " 1 "&iWeight&" "&dimens(0)&" "&dimens(1)&" "&dimens(2)&" Goods for shipping rates selection "
dimens(0)=0 : dimens(1)=0 : dimens(2)=0 : dimens(3)=0
addCanadaPostPackage = tmpXML
end function
function addFedexPackage(iWeight,packages,packcost,dimens)
Session.LCID = 1033
tmpXML = ""
if iWeight < 0.1 then iWeight=0.1
if dimens(0) > 0 AND dimens(1) > 0 AND dimens(2) > 0 then tmpXML = "" & vsround(dimens(0),0) & "" & vsround(dimens(1),0) & "" & vsround(dimens(2),0) & ""&IIfVr((adminUnits AND 12)=4,"IN","CM")&""
dimens(0)=0 : dimens(1)=0 : dimens(2)=0 : dimens(3)=0
addFedexPackage = tmpXML & "" & packcost & ""&packages&""&formatnumber(iWeight,1,-1,0,0)&""
Session.LCID = saveLCID
end function
function USPSCalculate(sXML,international,byRef totalCost, byRef errormsg, byRef intShipping)
Dim objHttp, i
if destZip="" then
errormsg=xxPlsZip
USPSCalculate=FALSE
else
set objHttp = Server.CreateObject("Msxml2.ServerXMLHTTP")
objHttp.open "POST", "http://production.shippingapis.com/ShippingAPI.dll", false
err.number=0
objHttp.Send "API="&international&"Rate&XML=" & Server.URLEncode(sXML)
If err.number <> 0 OR objHttp.status <> 200 Then
errormsg = "Error, couldn't connect to USPS server"
USPSCalculate = false
Else
saveLCID = Session.LCID
Session.LCID = 1033
USPSCalculate = ParseUSPSXMLOutput(objHttp.responseText, international, totalCost, errormsg, intShipping)
sortshippingarray()
Session.LCID = saveLCID
End If
set objHttp = nothing
end if
end function
function UPSCalculate(sXML,international,byRef totalCost, byRef errormsg, byRef intShipping)
Dim objHttp, i
if destZip="" then
errormsg=xxPlsZip
UPSCalculate=FALSE
else
set objHttp = Server.CreateObject("Msxml2.ServerXMLHTTP")
objHttp.open "POST", "https://www.ups.com/ups.app/xml/Rate", false
objHttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
err.number=0
objHttp.Send sXML
If err.number <> 0 OR objHttp.status <> 200 Then
errormsg = "Error, couldn't connect to UPS server"
UPSCalculate = false
Else
saveLCID = Session.LCID
Session.LCID = 1033
UPSCalculate = ParseUPSXMLOutput(objHttp.responseXML, international, totalCost, errormsg, errorcode, intShipping)
sortshippingarray()
if errorcode = 111210 then errormsg = "The destination zip / postal code is invalid."
if errorcode = 110971 then errormsg = "" ' May differ from published rates.
if errorcode = 119070 then errormsg = "" ' Large package surcharge.
Session.LCID = saveLCID
End If
set objHttp = nothing
end if
end function
function CanadaPostCalculate(sXML,international,byRef totalCost, byRef errormsg, byRef intShipping)
Dim objHttp, i
if destZip="" then
errormsg=xxPlsZip
CanadaPostCalculate=FALSE
else
set objHttp = Server.CreateObject("Msxml2.ServerXMLHTTP")
objHttp.open "POST", "http://sellonline.canadapost.ca:30000", false
objHttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
err.number=0
objHttp.Send sXML
If err.number <> 0 OR objHttp.status <> 200 Then
errormsg = "Error, couldn't connect to CanadaPost server"
CanadaPostCalculate = false
Else
saveLCID = Session.LCID
Session.LCID = 1033
' response.write Replace(Replace(objHttp.responseText,"<")&""
CanadaPostCalculate = ParseCanadaPostXMLOutput(objHttp.responseXML, international, totalCost, errormsg, errorcode, intShipping)
sortshippingarray()
Session.LCID = saveLCID
End If
set objHttp = nothing
end if
end function
Function parsefedexXMLoutput(sXML, international, byRef errormsg, byRef errorcode, byRef intShipping)
noError = True
errormsg = ""
l = 0
set xmlDoc = Server.CreateObject("MSXML2.DOMDocument")
xmlDoc.validateOnParse = False
xmlDoc.loadXML (sXML)
Set t2 = xmlDoc.getElementsByTagName("FDXRateAvailableServicesReply").Item(0)
for j = 0 to t2.childNodes.length - 1
Set n = t2.childNodes.Item(j)
if n.nodename="Error" then
noError = false
For i = 0 To n.childNodes.length - 1
Set e = n.childNodes.Item(i)
if e.nodeName="Message" then
errormsg = errormsg & e.firstChild.nodeValue
elseif e.nodeName="Code" then
errorcode = e.firstChild.nodeValue
end if
Next
elseif n.nodename="Entry" then
wantthismethod=FALSE
entryweight = 0
set objweight = n.getElementsByTagName("BilledWeight")
if objweight.length > 0 then
entryweight = objweight.item(0).firstChild.nodeValue
end if
For i = 0 To n.childNodes.length - 1
Set e = n.childNodes.Item(i)
if e.nodeName="Service" then
wantthismethod = checkUPSShippingMeth(e.firstChild.nodeValue, discntsApp, showAs)
if e.firstChild.nodeValue="FEDEXGROUND" AND commerciallocpost<>"Y" AND entryweight<=70.0 then wantthismethod=FALSE
if wantthismethod then
intShipping(0, l) = showAs
intShipping(4, l) = discntsApp
end if
elseif e.nodeName="EstimatedCharges" then
For k9 = 0 To e.childNodes.length - 1
Set f9 = e.childNodes.Item(k9)
if f9.nodeName="DiscountedCharges" then
intShipping(2, l) = 0
For m = 0 To f9.childNodes.length - 1
Set g9 = f9.childNodes.Item(m)
if g9.nodeName="NetCharge" then
intShipping(2, l) = intShipping(2, l) + cDbl(g9.firstChild.nodeValue)
elseif g9.nodeName="TotalDiscount" then
if uselistshippingrates=TRUE then intShipping(2, l) = intShipping(2, l) + cDbl(g9.firstChild.nodeValue)
end if
next
end if
next
elseif e.nodeName="DeliveryDate" then
numdays = DateValue(e.firstChild.nodeValue) - Date()
if numdays < 1 then numdays = 1
intShipping(1, l) = numdays & " " & IIfVr(numdays<2,xxDay,xxDays)
end if
next
if wantthismethod then
intShipping(3, l) = TRUE
l = l + 1
end if
end if
Next
parsefedexXMLoutput = noError
end Function
function fedexcalculate(sXML,international, byRef errormsg, byRef intShipping)
if destZip="" then
errormsg=xxPlsZip
fedexcalculate=FALSE
else
Session.LCID = 1033
if payproviderpost<>"" then
if int(payproviderpost)=codpaymentprovider then sXML = replace(sXML, "XXXFILLCODAMTHEREYYY", FormatNumber(totalgoods,2,-1,0,0), 1)
end if
' response.write Replace(Replace(sXML,"<")&""
success = callxmlfunction("https://gateway.fedex.com:443/GatewayDC", sXML, xmlres, "", "Msxml2.ServerXMLHTTP", errormsg, FALSE)
' response.write Replace(Replace(xmlres,"<")&""
if success then
success = parsefedexXMLoutput(xmlres, international, errormsg, errorcode, intShipping)
end if
if success then sortshippingarray()
fedexcalculate = success
Session.LCID = saveLCID
end if
end function
%>
<%
if NOT paypalexpress then
if enableclientlogin AND Session("clientID")<>"" then
sSQL = "SELECT clEmail FROM customerlogin WHERE clEmail<>'' AND clID=" & replace(session("clientID"),"'","")
rs.Open sSQL,cnn,0,1
if NOT rs.EOF then ordEmail = trim(rs("clEmail")&"") else ordEmail = trim(request.form("email"))
rs.Close
else
ordEmail = trim(request.form("email"))
end if
if request.form("allowemail")="ON" then
on error resume next
cnn.Execute("INSERT INTO mailinglist (email) VALUES ('" & lcase(replace(strip_tags2(ordEmail), "'", "''")) & "')")
on error goto 0
end if
if enableclientlogin AND request.form("addressid")<>"" AND request.form("addaddress")="" AND Session("clientID")<>"" then
sSQL = "SELECT addName,addAddress,addAddress2,addCity,addState,addZip,addCountry,addPhone,addExtra1,addExtra2 FROM address WHERE addCustID="&replace(Session("clientID"),"'","")&" AND addID="&replace(request.form("addressid"),"'","")
rs.Open sSQL,cnn,0,1
if NOT rs.EOF then
ordName = rs("addName")
ordAddress = rs("addAddress")
ordAddress2 = rs("addAddress2")
ordCity = rs("addCity")
ordState = rs("addState")
ordZip = rs("addZip")
ordCountry = rs("addCountry")
ordPhone = rs("addPhone")
ordExtra1 = rs("addExtra1")
ordExtra2 = rs("addExtra2")
end if
rs.Close
else
ordName = trim(request.form("name"))
ordAddress = trim(request.form("address"))
ordAddress2 = trim(request.form("address2"))
ordCity = trim(request.form("city"))
ordState = trim(request.form("state2"))
if trim(request.form("state")) <> "" then ordState = trim(request.form("state"))
ordZip = trim(request.form("zip"))
ordCountry = trim(request.form("country"))
ordPhone = trim(request.form("phone"))
ordExtra1 = trim(request.form("ordextra1"))
ordExtra2 = trim(request.form("ordextra2"))
end if
if enableclientlogin AND request.form("saddressid")<>"" AND request.form("saddaddress")="" AND Session("clientID")<>"" then
sSQL = "SELECT addName,addAddress,addAddress2,addCity,addState,addZip,addCountry,addPhone,addExtra1,addExtra2 FROM address WHERE addCustID="&replace(Session("clientID"),"'","")&" AND addID="&replace(request.form("saddressid"),"'","")
rs.Open sSQL,cnn,0,1
if NOT rs.EOF then
ordShipName = rs("addName")
ordShipAddress = rs("addAddress")
ordShipAddress2 = rs("addAddress2")
ordShipCity = rs("addCity")
ordShipState = rs("addState")
ordShipZip = rs("addZip")
ordShipCountry = rs("addCountry")
ordShipPhone = rs("addPhone")
ordShipExtra1 = rs("addExtra1")
ordShipExtra2 = rs("addExtra2")
end if
rs.Close
else
ordShipName = trim(request.form("sname"))
ordShipAddress = trim(request.form("saddress"))
ordShipAddress2 = trim(request.form("saddress2"))
ordShipCity = trim(request.form("scity"))
ordShipState = trim(request.form("sstate2"))
if trim(request.form("sstate")) <> "" then ordShipState = trim(request.form("sstate"))
ordShipZip = trim(request.form("szip"))
ordShipCountry = trim(request.form("scountry"))
ordShipPhone = trim(request.form("sphone"))
ordShipExtra1 = trim(request.form("ordshipextra1"))
ordShipExtra2 = trim(request.form("ordshipextra2"))
end if
if Session("clientID")<>"" then
if request.form("addaddress")="add" then
sSQL = "INSERT INTO address (addCustID,addIsDefault,addName,addAddress,addAddress2,addCity,addState,addZip,addCountry,addPhone,addExtra1,addExtra2) VALUES ("&Session("clientID")&",0,'"&replace(ordName,"'","''")&"','"&replace(ordAddress,"'","''")&"','"&replace(ordAddress2,"'","''")&"','"&replace(ordCity,"'","''")&"','"&replace(ordState,"'","''")&"','"&replace(ordZip,"'","''")&"','"&replace(ordCountry,"'","''")&"','"&replace(ordPhone,"'","''")&"','"&replace(ordExtra1,"'","''")&"','"&replace(ordExtra2,"'","''")&"')"
cnn.Execute(sSQL)
elseif request.form("addaddress")="edit" then
sSQL = "UPDATE address SET addName='"&replace(ordName,"'","''")&"',addAddress='"&replace(ordAddress,"'","''")&"',addAddress2='"&replace(ordAddress2,"'","''")&"',addCity='"&replace(ordCity,"'","''")&"',addState='"&replace(ordState,"'","''")&"',addZip='"&replace(ordZip,"'","''")&"',addCountry='"&replace(ordCountry,"'","''")&"',addPhone='"&replace(ordPhone,"'","''")&"',addExtra1='"&replace(ordExtra1,"'","''")&"',addExtra2='"&replace(ordExtra2,"'","''")&"' WHERE addCustID="&Session("clientID")&" AND addID=" & replace(request.form("addressid"), "'", "")
cnn.Execute(sSQL)
end if
if ordShipName<>"" AND ordShipAddress<>"" AND ordShipCity<>"" then
if request.form("saddaddress")="add" then
sSQL = "INSERT INTO address (addCustID,addIsDefault,addName,addAddress,addAddress2,addCity,addState,addZip,addCountry,addPhone,addExtra1,addExtra2) VALUES ("&Session("clientID")&",0,'"&replace(ordShipName,"'","''")&"','"&replace(ordShipAddress,"'","''")&"','"&replace(ordShipAddress2,"'","''")&"','"&replace(ordShipCity,"'","''")&"','"&replace(ordShipState,"'","''")&"','"&replace(ordShipZip,"'","''")&"','"&replace(ordShipCountry,"'","''")&"','"&replace(ordShipPhone,"'","''")&"','"&replace(ordShipExtra1,"'","''")&"','"&replace(ordShipExtra2,"'","''")&"')"
cnn.Execute(sSQL)
elseif request.form("saddaddress")="edit" then
sSQL = "UPDATE address SET addName='"&replace(ordShipName,"'","''")&"',addAddress='"&replace(ordShipAddress,"'","''")&"',addAddress2='"&replace(ordShipAddress2,"'","''")&"',addCity='"&replace(ordShipCity,"'","''")&"',addState='"&replace(ordShipState,"'","''")&"',addZip='"&replace(ordShipZip,"'","''")&"',addCountry='"&replace(ordShipCountry,"'","''")&"',addPhone='"&replace(ordShipPhone,"'","''")&"',addExtra1='"&replace(ordShipExtra1,"'","''")&"',addExtra2='"&replace(ordShipExtra2,"'","''")&"' WHERE addCustID="&Session("clientID")&" AND addID=" & replace(request.form("saddressid"), "'", "")
cnn.Execute(sSQL)
end if
end if
end if
ordAVS = trim(request.form("ppexp1"))
ordCVV = trim(request.form("ppexp2"))
ordAddInfo = trim(request.form("ordAddInfo"))
commercialloc = trim(commerciallocpost)
wantinsurance = trim(request.form("wantinsurance"))
saturdaydelivery = trim(request.form("saturdaydelivery"))
signaturerelease = trim(request.form("signaturerelease"))
insidedelivery = trim(request.form("insidedelivery"))
if commercialloc="Y" then ordComLoc = 1 else ordComLoc = 0
if wantinsurance="Y" OR abs(addshippinginsurance)=1 then ordComLoc = ordComLoc + 2
if saturdaydelivery="Y" then ordComLoc = ordComLoc + 4
if signaturerelease="Y" then ordComLoc = ordComLoc + 8
if insidedelivery="Y" then ordComLoc = ordComLoc + 16
ordAffiliate = strip_tags2(trim(request.form("PARTNER")))
ordCheckoutExtra1 = trim(request.form("ordcheckoutextra1"))
ordCheckoutExtra2 = trim(request.form("ordcheckoutextra2"))
end if
if ordShipAddress<>"" then
shipcountry = ordShipCountry
shipstate = ordShipState
destZip = ordShipZip
else
shipcountry = ordCountry
shipstate = ordState
destZip = ordZip
end if
sSQL = "SELECT countryID,countryCode,countryOrder FROM countries WHERE countryName='"&replace(ordCountry,"'","''")&"'"
rs.Open sSQL,cnn,0,1
countryID = rs("countryID")
countryCode = rs("countryCode")
homecountry = (rs("countryOrder")=2)
rs.Close
if NOT homecountry then perproducttaxrate=FALSE
sSQL = "SELECT countryID,countryTax,countryCode,countryFreeShip,countryOrder FROM countries WHERE countryName='"&replace(shipcountry,"'","''")&"'"
rs.Open sSQL,cnn,0,1
countryTaxRate = rs("countryTax")
shipCountryID = rs("countryID")
shipCountryCode = rs("countryCode")
freeshipapplies = (rs("countryFreeShip")=1)
shiphomecountry = (rs("countryOrder")=2)
rs.Close
if homecountry then
sSQL = "SELECT stateAbbrev FROM states WHERE "&IIfVr(usestateabbrev=TRUE,"stateAbbrev","stateName")&"='"&replace(ordState,"'","''")&"'"
rs.Open sSQL,cnn,0,1
if NOT rs.EOF then stateAbbrev=rs("stateAbbrev")
rs.Close
end if
if shiphomecountry then
sSQL = "SELECT stateTax,stateAbbrev,stateFreeShip FROM states WHERE "&IIfVr(usestateabbrev=TRUE,"stateAbbrev","stateName")&"='"&replace(shipstate,"'","''")&"'"
rs.Open sSQL,cnn,0,1
if NOT rs.EOF then
stateTaxRate=rs("stateTax")
shipStateAbbrev=rs("stateAbbrev")
freeshipapplies=(freeshipapplies AND (rs("stateFreeShip")=1))
end if
rs.Close
end if
if trim(Session("clientUser")) <> "" then
if (Session("clientActions") AND 1)=1 then stateTaxRate=0
if (Session("clientActions") AND 2)=2 then countryTaxRate=0
end if
initshippingmethods()
if mysqlserver=true then
sSQL = "SELECT cartID,cartProdID,cartProdName,cartProdPrice,cartQuantity,pWeight,pShipping,pShipping2,pExemptions,pSection,topSection,pDims,pTax FROM cart LEFT JOIN products ON cart.cartProdID=products.pId LEFT OUTER JOIN sections ON products.pSection=sections.sectionID WHERE cartCompleted=0 AND " & getsessionsql()
else
sSQL = "SELECT cartID,cartProdID,cartProdName,cartProdPrice,cartQuantity,pWeight,pShipping,pShipping2,pExemptions,pSection,topSection,pDims,pTax FROM cart INNER JOIN (products LEFT OUTER JOIN sections ON products.pSection=sections.sectionID) ON cart.cartProdID=products.pID WHERE cartCompleted=0 AND " & getsessionsql()
end if
rs.Open sSQL,cnn,0,1
if NOT (rs.EOF OR rs.BOF) then alldata=rs.getrows
rs.Close
if success AND IsArray(alldata) then
rowcounter = 0
for index=0 to UBOUND(alldata,2)
sSQL = "SELECT SUM(coPriceDiff) AS coPrDff FROM cartoptions WHERE coCartID="&alldata(0,index)
rs.Open sSQL,cnn,0,1
if NOT rs.EOF then
if NOT IsNull(rs("coPrDff")) then alldata(3,index)=cDbl(alldata(3,index))+cDbl(rs("coPrDff"))
end if
rs.Close
sSQL = "SELECT SUM(coWeightDiff) AS coWghtDff FROM cartoptions WHERE coCartID="&alldata(0,index)
rs.Open sSQL,cnn,0,1
if NOT rs.EOF then
if NOT IsNull(rs("coWghtDff")) then alldata(5,index)=cDbl(alldata(5,index))+cDbl(rs("coWghtDff"))
end if
rs.Close
runTot=(alldata(3,index)*Int(alldata(4,index)))
totalquantity = totalquantity + alldata(4,index)
totalgoods=totalgoods+runTot
thistopcat=0
if trim(Session("clientUser"))<>"" then alldata(8,index) = (alldata(8,index) OR Session("clientActions"))
if (shipType=2 OR shipType=3 OR shipType=4 OR shipType=6 OR shipType=7) AND cDbl(alldata(5,index))<=0.0 then alldata(8,index) = (alldata(8,index) OR 4)
if (alldata(8,index) AND 1)=1 then statetaxfree = statetaxfree + runTot
if perproducttaxrate=TRUE then
if isnull(alldata(12,index)) then alldata(12,index)=countryTaxRate
if (alldata(8,index) AND 2)<>2 then countryTax = countryTax + ((alldata(12,index) * runTot) / 100.0)
else
if (alldata(8,index) AND 2)=2 then countrytaxfree = countrytaxfree + runTot
end if
if (alldata(8,index) AND 4)=4 then shipfreegoods = shipfreegoods + runTot
call addproducttoshipping(alldata, index)
next
call calculatediscounts(vsround(totalgoods,2), true, cpncode)
if shippingpost<>"" then
shipArr = split(shippingpost,"|")
shipping = cDbl(shipArr(0))
isstandardship = Int(shipArr(1))=1
shipMethod = shipArr(2)
else
calculateshipping()
end if
if shippingpost="" AND alternaterates AND somethingToShip then checkIntOptions = True
insuranceandtaxaddedtoshipping()
if NOT checkIntOptions then
call calculateshippingdiscounts(true)
if Session("clientUser")<>"" AND Session("clientActions")<>0 then cpnmessage = cpnmessage & xxLIDis & Session("clientUser") & " "
cpnmessage = Right(cpnmessage,Len(cpnmessage)-6)
if totaldiscounts > totalgoods then totaldiscounts = totalgoods
calculatetaxandhandling()
totalgoods = vsround(totalgoods,2)
shipping = vsround(shipping,2)
stateTax = vsround(stateTax,2)
countryTax = vsround(countryTax,2)
handling = vsround(handling,2)
if addshippingtodiscounts=TRUE then totaldiscounts = totaldiscounts + freeshipamnt : freeshipamnt = 0
freeshipamnt = vsround(freeshipamnt, 2)
totaldiscounts = vsround(totaldiscounts, 2)
grandtotal = vsround((totalgoods + shipping + stateTax + countryTax + handling) - (totaldiscounts + freeshipamnt), 2)
if grandtotal < 0 then grandtotal = 0
sSQL = "SELECT ordID FROM orders WHERE ordAuthNumber='' AND " & getordersessionsql()
rs.Open sSQL,cnn,0,1
if NOT rs.EOF then orderid=rs("ordID") else orderid=""
rs.Close
if orderid="" then
rs.Open "orders",cnn,1,3,&H0002
rs.AddNew
else
if mysqlserver then rs.CursorLocation = 3
rs.Open "SELECT * FROM orders WHERE ordID="&orderid,cnn,1,3,&H0001
end if
if ordShipName="" AND ordShipAddress="" AND ordShipAddress2="" AND ordShipCity="" then ordShipCountry=""
rs.Fields("ordSessionID") = thesessionid
if Session("clientID")<>"" then rs.Fields("ordClientID")=Session("clientID") else rs.Fields("ordClientID")=0
rs.Fields("ordName") = ordName
rs.Fields("ordAddress") = ordAddress
rs.Fields("ordAddress2") = ordAddress2
rs.Fields("ordCity") = ordCity
rs.Fields("ordState") = ordState
rs.Fields("ordZip") = ordZip
rs.Fields("ordCountry") = ordCountry
rs.Fields("ordEmail") = ordEmail
rs.Fields("ordPhone") = ordPhone
rs.Fields("ordShipName") = ordShipName
rs.Fields("ordShipAddress") = ordShipAddress
rs.Fields("ordShipAddress2")= ordShipAddress2
rs.Fields("ordShipCity") = ordShipCity
rs.Fields("ordShipState") = ordShipState
rs.Fields("ordShipZip") = ordShipZip
rs.Fields("ordShipCountry") = ordShipCountry
rs.Fields("ordShipPhone") = ordShipPhone
rs.Fields("ordPayProvider") = ordPayProvider
rs.Fields("ordAuthNumber") = "" ' Not yet authorized
rs.Fields("ordShipping") = shipping - freeshipamnt
if usehst=true then
rs.Fields("ordHSTTax") = stateTax + countryTax
rs.Fields("ordStateTax") = 0
rs.Fields("ordCountryTax") = 0
else
rs.Fields("ordHSTTax") = 0
rs.Fields("ordStateTax") = stateTax
rs.Fields("ordCountryTax") = countryTax
end if
rs.Fields("ordHandling") = handling
rs.Fields("ordShipType") = shipMethod
rs.Fields("ordShipCarrier") = shipType
rs.Fields("ordTotal") = totalgoods
rs.Fields("ordDate") = DateAdd("h",dateadjust,Now())
rs.Fields("ordStatus") = 2
rs.Fields("ordStatusDate") = DateAdd("h",dateadjust,Now())
rs.Fields("ordIP") = left(request.servervariables("REMOTE_ADDR"), 48)
rs.Fields("ordComLoc") = ordComLoc
rs.Fields("ordAffiliate") = ordAffiliate
rs.Fields("ordAddInfo") = ordAddInfo
rs.Fields("ordDiscount") = totaldiscounts
rs.Fields("ordDiscountText")= Left(cpnmessage,255)
rs.Fields("ordExtra1") = ordExtra1
rs.Fields("ordExtra2") = ordExtra2
rs.Fields("ordShipExtra1") = ordShipExtra1
rs.Fields("ordShipExtra2") = ordShipExtra2
rs.Fields("ordCheckoutExtra1") = ordCheckoutExtra1
rs.Fields("ordCheckoutExtra2") = ordCheckoutExtra2
rs.Fields("ordAVS") = ordAVS
rs.Fields("ordCVV") = ordCVV
rs.Update
if mysqlserver=true then
if orderid="" then
rs.Close
rs.Open "SELECT LAST_INSERT_ID() AS lstIns",cnn,0,1
orderid = rs("lstIns")
end if
else
orderid = rs.Fields("ordID")
end if
rs.Close
sSQL="UPDATE cart SET cartOrderID="&orderid&" WHERE cartCompleted=0 AND " & getsessionsql()
cnn.Execute(sSQL)
descstr=""
addcomma = ""
sSQL="SELECT cartQuantity,cartProdName FROM cart WHERE cartOrderID="&orderid&" AND cartCompleted=0"
rs.Open sSQL,cnn,0,1
do while NOT rs.EOF
descstr=descstr&addcomma&rs("cartQuantity")&" "&rs("cartProdName")
addcomma = ", "
rs.MoveNext
loop
rs.Close
descstr=Replace(descstr,"""","")
if request.form("remember")="1" then
response.write ""
end if
end if
else
success=False
end if
if checkIntOptions AND success OR (alternaterates AND NOT success) then
hassuccess = success
success = False ' So not to print the order totals.
%>
<% elseif NOT success then %>
<%=xxSryErr%>
<%=" "&errormsg%>
<% elseif ordPayProvider<>"" then
blockuser=checkuserblock(ordPayProvider)
if blockuser then
orderid = 0
thesessionid = 0
xxMstClk = multipurchaseblockmessage
else
call getpayprovdetails(ordPayProvider,data1,data2,data3,demomode,ppmethod)
end if
origstoreurl = storeurl
if pathtossl<>"" then
if Right(pathtossl,1) <> "/" then pathtossl = pathtossl & "/"
storeurl = pathtossl
end if
if grandtotal > 0 AND ordPayProvider="1" then ' PayPal
%>
<%
end if ' success
elseif checkoutmode="authorize" then
blockuser=checkuserblock("")
ordID = replace(Request.Form("ordernumber"), "'", "")
gobackplaces=1
call getpayprovdetails(Request.Form("method"),data1,data2,data3,demomode,ppmethod)
if Request.Form("method")="7" then ' PayFlow Pro
vsdetails = Split(data1, "&")
if UBOUND(vsdetails) > 0 then
vs1=vsdetails(0)
vs2=vsdetails(1)
vs3=vsdetails(2)
vs4=vsdetails(3)
end if
sSQL = "SELECT ordZip,ordShipping,ordStateTax,ordCountryTax,ordHandling,ordTotal,ordDiscount,ordAddress,ordAddress2,ordAuthNumber FROM orders WHERE ordID="&ordID
rs.Open sSQL,cnn,0,1
vsAUTHCODE = (rs("ordAuthNumber")&"")
theaddress = rs("ordAddress") & IIfVr(trim(rs("ordAddress2")&"")<>"", ", " & trim(rs("ordAddress2")), "")
parmList = "TRXTYPE=" & IIfVr(ppmethod=1,"A","S") & "&TENDER=C&ZIP["&Len(rs("ordZip"))&"]="&rs("ordZip") & "&STREET["&len(theaddress)&"]="&theaddress
parmList = parmList & "&NAME["&Len(Request.Form("cardname"))&"]="&Request.Form("cardname")
parmList = parmList & "&COMMENT1="&ordID & "&ACCT=" & replace(request.form("ACCT")," ", "") & "&CUSTIP=" & request.servervariables("REMOTE_ADDR")
parmList = parmList & "&PWD=" & vs4 & "&USER=" & vs1 & "&VENDOR=" & vs2 & "&PARTNER=" & vs3 & "&CVV2=" & trim(request.form("CVV2"))
parmList = parmList & "&EXPDATE=" & request.form("EXMON") & Right(request.form("EXYEAR"),2)
parmList = parmList & "&AMT=" & FormatNumber((rs("ordShipping")+rs("ordStateTax")+rs("ordCountryTax")+rs("ordTotal")+rs("ordHandling"))-rs("ordDiscount"),2,-1,0,0)
if trim(request.form("IssNum"))<>"" then
if len(trim(request.form("IssNum")))=2 then parmList = parmList & "&CARDISSUE=" & trim(request.form("IssNum")) else parmList = parmList & "&CARDSTART=" & trim(request.form("IssNum"))
end if
rs.Close
if vsAUTHCODE="" then
success=true
if blockuser then
success=FALSE
vsRESPMSG = multipurchaseblockmessage
else
Set client = Server.CreateObject("PFProCOMControl.PFProCOMControl.1")
if vs3="VSA" then
theurl = "payflow.verisign.com.au"
if demomode then theurl = "payflow-test.verisign.com.au"
else
theurl = "payflow.verisign.com"
if demomode then theurl = "test-payflow.verisign.com"
end if
Ctx1 = client.CreateContext(theurl, 443, 30, "", 0, "", "")
curString = client.SubmitTransaction(Ctx1, parmList, Len(parmList))
client.DestroyContext (Ctx1)
Do while Len(curString) <> 0
'get the next name value pair
if InStr(curString,"&") Then
varString = Left(curString, InStr(curString , "&" ) -1)
else
varString = curString
end if
'get the name part of the name/value pair
name = Left(varString, InStr(varString, "=" ) -1)
value = Right(varString, Len(varString) - (Len(name)+1))
if name="RESULT" then
vsRESULT=value
elseif name="PNREF" then
vsPNREF=value
elseif name="RESPMSG" then
vsRESPMSG=value
elseif name="AUTHCODE" then
vsAUTHCODE=value
elseif name="AVSADDR" then
vsAVSADDR=value
elseif name="AVSZIP" then
vsAVSZIP=value
elseif name="IAVS" then
vsIAVS=value
elseif name="CVV2MATCH" then
vsCVV2=value
end if
'skip over the &
if Len(curString) <> Len(varString) then curString = Right(curString, Len(curString) - (Len(varString)+1)) else curString = ""
Loop
end if
if success then
if vsRESULT="0" OR vsRESULT="126" then
if vsRESULT="126" then underreview="Fraud Review: " : vsRESPMSG="Approved" else underreview=""
do_stock_management(ordID)
cnn.Execute("UPDATE cart SET cartCompleted=1 WHERE cartOrderID="&ordID)
cnn.Execute("UPDATE orders SET ordStatus=3,ordAVS='"&replace(vsAVSADDR&vsAVSZIP, "'", "")&"',ordCVV='"&replace(vsCVV2, "'", "")&"',ordAuthNumber='"&replace(underreview&vsAUTHCODE, "'", "")&"' WHERE ordID="&ordID)
vsRESULT="0"
end if
end if
set client = nothing
else
vsRESULT="0"
vsRESPMSG="Approved"
end if
elseif Request.Form("method")="13" then ' Auth.net AIM
if secretword<>"" then
data1 = upsdecode(data1, secretword)
data2 = upsdecode(data2, secretword)
end if
sSQL = "SELECT ordID,ordName,ordCity,ordState,ordCountry,ordPhone,ordHandling,ordZip,ordEmail,ordShipping,ordStateTax,ordCountryTax,ordTotal,ordDiscount,ordAddress,ordAddress2,ordIP,ordAuthNumber,ordShipName,ordShipAddress,ordShipAddress2,ordShipCity,ordShipState,ordShipCountry,ordShipZip FROM orders WHERE ordID="&ordID
rs.Open sSQL,cnn,0,1
vsAUTHCODE = trim(rs("ordAuthNumber")&"")
parmList = "x_version=3.1&x_delim_data=True&x_relay_response=False&x_delim_char=|&x_duplicate_window=15"
parmList = parmList & "&x_login="&data1&"&x_tran_key="&data2&"&x_cust_id="&rs("ordID")&"&x_Invoice_Num="&rs("ordID")
parmList = parmList & "&x_amount="&FormatNumber((rs("ordShipping")+rs("ordStateTax")+rs("ordCountryTax")+rs("ordTotal")+rs("ordHandling"))-rs("ordDiscount"),2,-1,0,0)
parmList = parmList & "&x_currency_code="&countryCurrency&"&x_Description=" & left(server.urlencode(request.form("description")),254)
if trim(request.form("accountnum"))<>"" then
parmList = parmList & "&x_method=ECHECK&x_echeck_type=WEB&x_recurring_billing=NO"
parmList = parmList & "&x_bank_acct_name=" & server.urlencode(trim(request.form("accountname"))) & "&x_bank_acct_num=" & server.urlencode(trim(request.form("accountnum")))
parmList = parmList & "&x_bank_name=" & server.urlencode(trim(request.form("bankname"))) & "&x_bank_aba_code=" & server.urlencode(trim(request.form("routenumber")))
parmList = parmList & "&x_bank_acct_type=" & server.urlencode(trim(request.form("accounttype"))) & "&x_type=AUTH_CAPTURE"
if wellsfargo=true then
parmList = parmList & "&x_customer_organization_type=" & trim(request.form("orgtype"))
if trim(request.form("taxid"))<>"" then
parmList = parmList & "&x_customer_tax_id=" & server.urlencode(trim(request.form("taxid")))
else
parmList = parmList & "&x_drivers_license_num=" & server.urlencode(trim(request.form("licensenumber"))) & "&x_drivers_license_state=" & server.urlencode(trim(request.form("licensestate"))) & "&x_drivers_license_dob=" & server.urlencode(trim(request.form("dldobyear")) & "/" & trim(request.form("dldobmon")) & "/" & trim(request.form("dldobday")))
end if
end if
else
parmList = parmList & "&x_method=CC&x_card_num=" & server.urlencode(trim(request.form("ACCT"))) & "&x_exp_date=" & request.form("EXMON") & Right(request.form("EXYEAR"),2)
if trim(request.form("CVV2"))<>"" then parmList = parmList & "&x_card_code=" & server.urlencode(trim(request.form("CVV2")))
if ppmethod=1 then parmList = parmList & "&x_type=AUTH_ONLY" else parmList = parmList & "&x_type=AUTH_CAPTURE"
end if
thename = trim(trim(request.form("cardname")))
if thename<>"" then
if InStr(thename," ") > 0 then
namearr = Split(thename," ",2)
parmList = parmList & "&x_first_name=" & server.urlencode(namearr(0)) & "&x_last_name=" & server.urlencode(namearr(1))
else
parmList = parmList & "&x_last_name=" & server.urlencode(thename)
end if
end if
parmList = parmList & "&x_address="&server.urlencode(rs("ordAddress"))
if trim(rs("ordAddress2")&"")<>"" then parmList = parmList & server.urlencode(", "&rs("ordAddress2"))
parmList = parmList & "&x_city="&server.urlencode(rs("ordCity")) & "&x_state="&server.urlencode(rs("ordState")) & "&x_zip="&server.urlencode(rs("ordZip")) & "&x_country="&server.urlencode(rs("ordCountry")) & "&x_phone="&server.urlencode(rs("ordPhone")) & "&x_email="&server.urlencode(rs("ordEmail"))
thename = trim(rs("ordShipName"))
if thename<>"" OR rs("ordShipAddress")<>"" then
if thename<>"" then
if InStr(thename," ") > 0 then
namearr = Split(thename," ",2)
parmList = parmList & "&x_ship_to_first_name=" & server.urlencode(namearr(0)) & "&x_ship_to_last_name=" & server.urlencode(namearr(1))
else
parmList = parmList & "&x_ship_to_last_name=" & server.urlencode(thename)
end if
end if
parmList = parmList & "&x_ship_to_address="&server.urlencode(rs("ordShipAddress"))
if trim(rs("ordShipAddress2")&"")<>"" then parmList = parmList & server.urlencode(", "&rs("ordShipAddress2"))
parmList = parmList & "&x_ship_to_city="&server.urlencode(rs("ordShipCity")) & "&x_ship_to_state="&server.urlencode(rs("ordShipState")) & "&x_ship_to_zip="&server.urlencode(rs("ordShipZip")) & "&x_ship_to_country="&server.urlencode(rs("ordShipCountry"))
end if
if trim(rs("ordIP"))<>"" then parmList = parmList & "&x_customer_ip="&server.urlencode(trim(rs("ordIP")))
if demomode then parmList = parmList & "&x_test_request=TRUE"
rs.Close
if vsAUTHCODE="" then
success=true
if blockuser then
success=FALSE
vsRESPMSG = multipurchaseblockmessage
else
set objHttp = Server.CreateObject("Msxml2.ServerXMLHTTP")
objHttp.open "POST", "https://secure.authorize.net/gateway/transact.dll", false
objHttp.Send parmList
If err.number <> 0 OR objHttp.status <> 200 Then
errormsg = "Error, couldn't connect to Authorize.net server"
Else
varString = Split(objHttp.responseText, "|")
vsRESULT=varString(0)
vsERRCODE=varString(2)
vsRESPMSG=varString(3)
if vsERRCODE <> "1" AND demomode then vsRESPMSG = vsERRCODE & " - " & vsRESPMSG
vsAUTHCODE=varString(4)
vsAVSADDR=varString(5)
vsTRANSID=varString(6)
vsCVV2=varString(38)
if Int(vsRESULT)=1 then
vsRESULT="0" ' Keep in sync with Payflow Pro
do_stock_management(ordID)
cnn.Execute("UPDATE cart SET cartCompleted=1 WHERE cartOrderID="&ordID)
cnn.Execute("UPDATE orders SET ordStatus=3,ordAVS='"&vsAVSADDR&"',ordCVV='"&vsCVV2&"',ordAuthNumber='"&vsAUTHCODE&"',ordTransID='"&vsTRANSID&"' WHERE ordID="&ordID)
elseif Int(vsRESULT)=27 then
gobackplaces=IIfVr(request.form("vrshippingoptions")="1", 3, 2)
end if
End If
set objHttp = nothing
end if
else
vsRESULT="0"
vsRESPMSG="This transaction has been approved."
if InStr(vsAUTHCODE,"-") > 0 then vsAUTHCODE = Right(vsAUTHCODE,Len(vsAUTHCODE)-InStr(vsAUTHCODE,"-"))
end if
elseif Request.Form("method")="18" then ' PayPal Pro
on error resume next
Server.ScriptTimeout = 120
on error goto 0
sSQL = "SELECT ordID,ordName,ordCity,ordState,ordCountry,ordPhone,ordHandling,ordZip,ordEmail,ordShipping,ordStateTax,ordCountryTax,ordTotal,ordDiscount,ordAddress,ordAddress2,ordIP,ordAuthNumber,ordShipName,ordShipAddress,ordShipAddress2,ordShipCity,ordShipState,ordShipCountry,ordShipZip FROM orders WHERE ordID=" & ordID
rs.Open sSQL,cnn,0,1
ordState = rs("ordState")
ordShipState = rs("ordShipState")
sSQL = "SELECT countryCode FROM countries WHERE countryName='" & replace(rs("ordCountry"),"'","''") & "'"
rs2.Open sSQL,cnn,0,1
countryCode = rs2("countryCode")
rs2.Close
sSQL = "SELECT countryCode FROM countries WHERE countryName='" & replace(rs("ordShipCountry"),"'","''") & "'"
rs2.Open sSQL,cnn,0,1
if NOT rs2.EOF then shipCountryCode = rs2("countryCode")
rs2.Close
if countryCode = "US" OR countryCode = "CA" then
sSQL = "SELECT stateAbbrev FROM states WHERE stateName='" & replace(ordState,"'","''") & "'"
rs2.Open sSQL,cnn,0,1
if NOT rs2.EOF then ordState=rs2("stateAbbrev")
rs2.Close
end if
if shipCountryCode="US" OR shipCountryCode="CA" then
sSQL = "SELECT stateAbbrev FROM states WHERE stateName='" & replace(ordShipState,"'","''") & "'"
rs2.Open sSQL,cnn,0,1
if NOT rs2.EOF then ordShipState=rs2("stateAbbrev")
rs2.Close
end if
vsAUTHCODE = trim(rs("ordAuthNumber")&"")
thename = trim(request.form("cardname"))
if thename<>"" then
if InStr(thename," ") > 0 then
namearr = Split(thename," ",2)
firstname = namearr(0)
lastname = namearr(1)
else
firstname = ""
lastname = thename
end if
end if
cardnum = replace(trim(request.form("ACCT")), " ", "")
cartype = "Visa"
if left(cardnum, 1)="5" then
cartype="MasterCard"
elseif left(cardnum, 1)="6" then
cartype="Discover"
elseif left(cardnum, 1)="3" then
cartype="Amex"
end if
data2hash = data3
sXML = ppsoapheader(data1, data2, data2hash) & _
" " & _
" 1.00" & _
" " & _
" " & IIfVr(ppmethod=1, "Authorization", "Sale") & "" & _
" " & _
" " & FormatNumber((rs("ordShipping")+rs("ordStateTax")+rs("ordCountryTax")+rs("ordTotal")+rs("ordHandling"))-rs("ordDiscount"),2,-1,0,0) & "" & _
" ecommercetemplates_Cart_DP_US"
if trim(rs("ordShipAddress"))<>"" then
sXML = sXML & "" & vrxmlencode(rs("ordShipName")) & "" & vrxmlencode(rs("ordShipAddress")) & "" & vrxmlencode(rs("ordShipAddress2")) & "" & rs("ordShipCity") & "" & ordShipState & "" & shipCountryCode & "" & rs("ordShipZip") & ""
else
sXML = sXML & "" & vrxmlencode(rs("ordName")) & "" & vrxmlencode(rs("ordAddress")) & "" & vrxmlencode(rs("ordAddress2")) & "" & rs("ordCity") & "" & ordState & "" & countryCode & "" & rs("ordZip") & ">"
end if
sXML = sXML & "" & _
" " & _
" " & cartype & "" & vrxmlencode(cardnum) & "" & _
" " & request.form("EXMON") & "" & request.form("EXYEAR") & "" & _
" " & _
" " & vrxmlencode(rs("ordEmail")) & "" & _
" " & firstname & "" & lastname & "" & _
" " & countryCode & "" & _
" " & vrxmlencode(rs("ordAddress")) & "" & vrxmlencode(rs("ordAddress2")) & "" & rs("ordCity") & "" & ordState & "" & countryCode & "" & rs("ordZip") & "" & _
" " & _
" " & trim(request.form("CVV2")) & "" & _
" " & _
" " & trim(rs("ordIP")) & "" & rs("ordID") & "" & _
" " & _
" "
rs.Close
if demomode then sandbox = ".sandbox" else sandbox = ""
vsRESULT="-1"
if vsAUTHCODE="" then
if blockuser then
success=FALSE
vsRESPMSG = multipurchaseblockmessage
else
success = callxmlfunction("https://api-aa" & IIfVr(sandbox="" AND data2hash<>"", "-3t", "") & sandbox & ".paypal.com/2.0/", sXML, res, IIfVr(data2hash<>"","",data1), "WinHTTP.WinHTTPRequest.5.1", vsRESPMSG, TRUE)
end if
if success then
vsAUTHCODE="":vsERRCODE="":vsRESPMSG="":vsAVSADDR="":vsTRANSID="":vsCVV2=""
set xmlDoc = Server.CreateObject("MSXML2.DOMDocument")
xmlDoc.validateOnParse = False
xmlDoc.loadXML (res)
Set nodeList = xmlDoc.getElementsByTagName("SOAP-ENV:Body")
Set n = nodeList.Item(0)
for j = 0 to n.childNodes.length - 1
Set e = n.childNodes.Item(i)
if e.nodeName = "DoDirectPaymentResponse" then
for k9 = 0 To e.childNodes.length - 1
Set t = e.childNodes.Item(k9)
if t.nodeName = "Ack" then
if t.firstChild.nodeValue = "Success" OR t.firstChild.nodeValue = "SuccessWithWarning" then
vsRESULT = 1
vsRESPMSG = "Success"
end if
elseif t.nodeName = "TransactionID" then
vsAUTHCODE = t.firstChild.nodeValue
elseif t.nodeName = "AVSCode" then
if t.hasChildNodes then vsAVSADDR = t.firstChild.nodeValue
elseif t.nodeName = "CVV2Code" then
if t.hasChildNodes then vsCVV2 = t.firstChild.nodeValue
elseif t.nodeName = "Errors" then
themsg=""
thecode=""
iswarning=FALSE
set ff = t.childNodes
for kk = 0 to ff.length - 1
set gg = ff.item(kk)
if gg.nodeName = "ShortMessage" then
' vsRESPMSG = gg.firstChild.nodeValue & " " & errormsg
elseif gg.nodeName = "LongMessage" then
themsg = gg.firstChild.nodeValue
elseif gg.nodeName = "ErrorCode" then
thecode = gg.firstChild.nodeValue
elseif gg.nodeName = "SeverityCode" then
if gg.hasChildNodes then iswarning = (gg.firstChild.nodeValue="Warning")
end if
next
if NOT iswarning then
vsRESPMSG = themsg & " " & vsRESPMSG
vsERRCODE = thecode
end if
end if
next
end if
next
if int(vsRESULT)=1 then
vsRESULT="0" ' Keep in sync with Payflow Pro
do_stock_management(ordID)
cnn.Execute("UPDATE cart SET cartCompleted=1 WHERE cartOrderID="&ordID)
cnn.Execute("UPDATE orders SET ordStatus=3,ordAVS='"&vsAVSADDR&"',ordCVV='"&vsCVV2&"',ordAuthNumber='"&vsAUTHCODE&"',ordTransID='"&vsTRANSID&"' WHERE ordID="&ordID)
elseif vsERRCODE<>"" then
vsERRCODE = int(vsERRCODE)
if vsERRCODE=10505 OR (vsERRCODE>=10701 AND vsERRCODE<=10751) then
gobackplaces=IIfVr(request.form("vrshippingoptions")="1", 3, 2)
end if
end if
end if
else
vsRESULT="0"
vsRESPMSG="This transaction has been approved."
if InStr(vsAUTHCODE,"-") > 0 then vsAUTHCODE = Right(vsAUTHCODE,Len(vsAUTHCODE)-InStr(vsAUTHCODE,"-"))
end if
end if
%>
<%
elseif request.querystring("token") = "" AND checkoutmode <> "paypalexpress1" AND cartisincluded<>TRUE then
Dim gshipmethods()
redim gshipmethods(10)
gnumshipmethods=0
sub writeuniquegoogleshipmethod(theshipmethod)
if googledefaultshipping="" then googledefaultshipping="999.99"
gotshipmethod=false
for index4=0 to gnumshipmethods
if gshipmethods(index4)=theshipmethod then gotshipmethod=true
next
if NOT gotshipmethod then
gshipmethods(gnumshipmethods)=theshipmethod
sXML = sXML & ""&googledefaultshipping&""
gnumshipmethods = gnumshipmethods + 1
end if
if gnumshipmethods >= UBOUND(gshipmethods) then redim preserve gshipmethods(UBOUND(gshipmethods) + 10)
end sub
sub generatemerchantcalcshiptypes(theshiptype)
if theshiptype=1 OR NOT somethingToShip then
writeuniquegoogleshipmethod(xmlencodecharref(xxShipHa))
elseif theshiptype=2 OR theshiptype=5 then
for index3=1 to 5
sSQL = "SELECT DISTINCT pzMethodName"&index3&" FROM postalzones WHERE pzName<>'' AND pzMethodName"&index3&"<>''"
if NOT splitUSZones then sSQL = sSQL & " AND pzID < 100"
rs.Open sSQL,cnn,0,1
do while NOT rs.EOF
writeuniquegoogleshipmethod(trim(xmlencodecharref(rs("pzMethodName"&index3)&"")))
rs.MoveNext
loop
rs.Close
next
elseif theshiptype=3 OR theshiptype=4 OR theshiptype=6 OR theshiptype=7 then
if theshiptype=3 then startid=0
if theshiptype=4 then startid=1
if theshiptype=6 then startid=2
if theshiptype=7 then startid=3
sSQL = "SELECT DISTINCT uspsShowAs,uspsFSA FROM uspsmethods WHERE (uspsID>"&(startid*100)&" AND uspsID<"&((startid+1)*100)&") AND uspsUseMethod=1 ORDER BY uspsFSA DESC,uspsShowAs"
rs.Open sSQL,cnn,0,1
do while NOT rs.EOF
writeuniquegoogleshipmethod(xmlencodecharref(rs("uspsShowAs")&""))
rs.MoveNext
loop
rs.Close
end if
end sub
function writegoogleparams(data1, data2, demomode)
sSQL = "SELECT cpnID FROM coupons WHERE cpnIsCoupon=1 AND cpnNumAvail>0 AND cpnEndDate>="&datedelim&VSUSDate(Date())&datedelim
rs.Open sSQL,cnn,0,1
if rs.EOF then acoupondefined="false" else acoupondefined="true"
rs.Close
b64pad="="
sXML = "<" & "?xml version=""1.0"" encoding=""UTF-8""?>"
sXML = sXML & "" & googlelineitems & ""
sXML = sXML & ""&IIfVr(session("clientID")<>"", "cid"&session("clientID"), "sid"&thesessionid)&""&IIfVr(trim(request.querystring("PARTNER"))<>"",strip_tags2(trim(request.querystring("PARTNER"))),strip_tags2(trim(request.cookies("PARTNER"))))&""
sXML = sXML & "236638029623651"
sXML = sXML & ""&storeurl&"cart.asp"&storeurl&"categories.asp"
sXML = sXML & ""
generatemerchantcalcshiptypes(shipType)
if adminIntShipping<>0 AND adminIntShipping<>shipType then generatemerchantcalcshiptypes(adminIntShipping)
if willpickuptext<>"" then
if willpickupcost="" then willpickupcost=0
sXML = sXML & "" & willpickupcost & ""
end if
sXML = sXML & ""
sXML = sXML & "true"
sXML = sXML & ""&gcallbackpath&""&acoupondefined&"false"
sXML = sXML & ""
' response.write Replace(Replace(sxml,"<")&""
thecart = vrbase64_encrypt(sXML)
thesignature = b64_hmac_sha1(data2,sXML)
theurl = "https://"&IIfVr(demomode, "sandbox", "checkout")&".google.com"&IIfVr(demomode, "/checkout", "")&"/cws/v2/Merchant/"&data1&"/checkout" ' & "/diagnose"
call writehiddenvar("cart", thecart)
call writehiddenvar("signature", thesignature)
writegoogleparams = theurl
end function
requiressl = false
if pathtossl="" then
sSQL = "SELECT payProvID FROM payprovider WHERE payProvEnabled=1 AND (payProvID IN (7,10,12,13,18) OR (payProvID=16 AND payProvData2='1'))" ' All the ones that require SSL
rs.Open sSQL,cnn,0,1
if NOT rs.EOF then requiressl = true
rs.Close
end if
if googlecallbackscript="" then googlecallbackscript="vsadmin/gcallback.asp"
if requiressl OR pathtossl<>"" then
if pathtossl<>"" then
if Right(pathtossl,1) <> "/" then pathtossl = pathtossl & "/"
cartpath = pathtossl & "cart.asp"
gcallbackpath = pathtossl & googlecallbackscript
else
cartpath = Replace(storeurl,"http:","https:") & "cart.asp"
gcallbackpath = Replace(storeurl,"http:","https:") & googlecallbackscript
end if
else
cartpath="cart.asp"
gcallbackpath = storeurl & googlecallbackscript
end if
loginerror=""
if request.querystring("mode")="logout" then
Session("clientID")=empty
Session("clientUser")=empty
Session("clientActions")=empty
Session("clientLoginLevel")=empty
Session("clientPercentDiscount")=empty
xxSryEmp=xxLOSuc
response.write ""
end if
loginsuccess=FALSE
if checkoutmode="dologin" OR (checkoutmode="donewaccount" AND allowclientregistration=TRUE) then
loginsuccess=TRUE
clientEmail = trim(request.form("email"))
clientPW = trim(replace(request.form("pass"),"'",""))
if checkoutmode="donewaccount" then
sSQL = "SELECT clID,clUserName,clActions,clLoginLevel,clPercentDiscount FROM customerlogin WHERE clEmail='"&clientEmail&"'"
rs.Open sSQL,cnn,0,1
if NOT rs.EOF then
loginsuccess=FALSE
loginerror=xxEmExi
end if
rs.Close
if loginsuccess then
sSQL = "INSERT INTO customerlogin (clUserName,clEmail,clPw,clDateCreated) VALUES ('"&replace(request.form("name"),"'","''")&"','"&replace(clientEmail,"'","''")&"','"&clientPW&"'," & datedelim & vsusdate(DateAdd("h",dateadjust,Now())) & datedelim & ")"
cnn.Execute(sSQL)
if request.form("allowemail")="ON" then
on error resume next
cnn.Execute("INSERT INTO mailinglist (email) VALUES ('" & lcase(replace(clientEmail,"'","''")) & "')")
on error goto 0
end if
end if
end if
if loginsuccess then
sSQL = "SELECT clID,clUserName,clActions,clLoginLevel,clPercentDiscount FROM customerlogin WHERE (clEmail<>'' AND clEmail='"&replace(clientEmail,"'","''")&"' AND clPW='"&clientPW&"') OR (clEmail='' AND clUserName='"&replace(clientEmail,"'","''")&"' AND clPW='"&clientPW&"')"
rs.Open sSQL,cnn,0,1
loginsuccess=FALSE
if NOT rs.EOF then
Session("clientID")=rs("clID")
Session("clientUser")=rs("clUserName")
Session("clientActions")=rs("clActions")
Session("clientLoginLevel")=rs("clLoginLevel")
Session("clientPercentDiscount")=(100.0-cDbl(rs("clPercentDiscount")))/100.0
get_wholesaleprice_sql()
response.write ""
loginsuccess=TRUE
else
loginerror=xxNoLogD
end if
rs.Close
end if
if loginsuccess then
sSQL = "SELECT cartID,cartProdID FROM cart WHERE cartCompleted=0 AND cartClientID="&Session("clientID")
rs.Open sSQL,cnn,0,1
if NOT rs.EOF then cartarr=rs.getRows else cartarr=""
rs.Close
if isarray(cartarr) then
for index=0 to UBOUND(cartarr, 2)
hasoptions=TRUE
sSQL = "SELECT cartID,cartQuantity FROM cart WHERE cartClientID=0 AND cartCompleted=0 AND cartSessionID="&replace(thesessionid,"'","")&" AND cartProdID='" & replace(cartarr(1,index),"'","''") & "'"
rs.Open sSQL,cnn,0,1
if NOT rs.EOF then thecartid=rs("cartID") : thequant=rs("cartQuantity") else thecartid=""
rs.Close
if thecartid<>"" then ' check options
sSQL = "SELECT coOptID,coCartOption FROM cartoptions WHERE coCartID=" & cartarr(0, index)
rs.Open sSQL,cnn,0,1
if NOT rs.EOF then optarr1=rs.getRows else optarr1=""
rs.Close
sSQL = "SELECT coOptID,coCartOption FROM cartoptions WHERE coCartID=" & thecartid
rs.Open sSQL,cnn,0,1
if NOT rs.EOF then optarr2=rs.getRows else optarr2=""
rs.Close
if (isarray(optarr1) AND NOT isarray(optarr2)) OR (NOT isarray(optarr1) AND isarray(optarr2)) then hasoptions=FALSE
if isarray(optarr1) AND isarray(optarr2) then
if UBOUND(optarr1,2)<>UBOUND(optarr2,2) then hasoptions=FALSE
if hasoptions then
for index2=0 to UBOUND(optarr1,2)
hasthisoption=FALSE
for index3=0 to UBOUND(optarr2,2)
if optarr1(0,index2)=optarr2(0,index3) AND optarr1(1,index2)=optarr2(1,index3) then hasthisoption=TRUE
next
if NOT hasthisoption then hasoptions=FALSE
next
end if
end if
end if
if thecartid<>"" AND hasoptions then
sSQL = "UPDATE cart SET cartQuantity=cartQuantity+" & thequant & " WHERE cartID=" & cartarr(0,index)
cnn.Execute(sSQL)
sSQL = "DELETE FROM cart WHERE cartID=" & thecartid
cnn.Execute(sSQL)
end if
next
end if
sSQL = "UPDATE cart SET cartClientID="&replace(session("clientID"),"'","")&" WHERE cartClientID=0 AND cartCompleted=0 AND cartSessionID="&replace(thesessionid,"'","")
cnn.Execute(sSQL)
sSQL = "SELECT cartID,cartProdID,"&WSP&"pPrice FROM cart INNER JOIN products ON cart.cartProdId=products.pID WHERE cartClientID="&replace(session("clientID"),"'","")&" AND cartCompleted=0"
rs.Open sSQL,cnn,0,1
do while NOT rs.EOF
call checkpricebreaks(rs("cartProdID"),rs("pPrice")) ' recalculate wholesale price plus quant discounts
rs.MoveNext
loop
rs.Close
execute("theref = clientloginref" & Session("clientLoginLevel"))
if theref<>"" then clientloginref = theref
if clientloginref="referer" OR clientloginref="" then
if Trim(request.form("refurl"))<>"" then refURL = Trim(request.form("refurl")) else refURL = "cart.asp"
else
refURL = clientloginref
end if
response.write ""
end if
end if
addextrarows=0
wantstateselector=FALSE
wantcountryselector=FALSE
wantzipselector=FALSE
if estimateshipping=TRUE then
addextrarows=1
if shipType=2 OR shipType=5 then ' weight / price based
wantcountryselector=TRUE
if splitUSZones then
addextrarows=3
wantstateselector=TRUE
else
addextrarows=2
end if
elseif shipType=3 OR shipType=4 OR shipType=6 OR shipType=7 then
addextrarows=3
wantzipselector=TRUE
wantcountryselector=TRUE
end if
shiphomecountry=TRUE
if cartisincluded<>TRUE then
if request.form("state")<>"" then
shipstate = request.form("state")
session("state") = request.form("state")
elseif session("state")<>"" then
shipstate = session("state")
else
shipstate = defaultshipstate
end if
if request.form("zip")<>"" then
destZip = trim(request.form("zip"))
session("zip") = trim(request.form("zip"))
elseif session("zip")<>"" then
destZip = session("zip")
else
if NOT (nodefaultzip=TRUE) then destZip = origZip
end if
if request.form("country")<>"" then
shipcountry = request.form("country")
session("country") = request.form("country")
if trim(request.form("state"))="" then shipstate=""
elseif session("country")<>"" then
shipcountry = session("country")
else
shipCountryCode = origCountryCode
shipcountry = origCountry
end if
end if
sSQL = "SELECT countryID,countryTax,countryCode,countryFreeShip,countryOrder FROM countries WHERE countryName='"&replace(shipcountry,"'","''")&"'"
rs.Open sSQL,cnn,0,1
if NOT rs.EOF then
if trim(Session("clientUser")) <> "" AND (Session("clientActions") AND 2)=2 then countryTaxRate=0 else countryTaxRate = rs("countryTax")
shipCountryID = rs("countryID")
shipCountryCode = rs("countryCode")
freeshipapplies = (rs("countryFreeShip")=1)
shiphomecountry = (rs("countryOrder")=2)
end if
rs.Close
if session("xsshipping")="" then initshippingmethods()
end if
if showtaxinclusive then addextrarows=addextrarows+1
alldata=""
if mysqlserver=true then
sSQL = "SELECT cartID,cartProdID,cartProdName,cartProdPrice,cartQuantity,pWeight,pShipping,pShipping2,pExemptions,pSection,topSection,pDims,pTax,"&getlangid("pDescription",2)&" FROM cart INNER JOIN products ON cart.cartProdID=products.pID LEFT OUTER JOIN sections ON products.pSection=sections.sectionID WHERE cartCompleted=0 AND " & getsessionsql()
else
sSQL = "SELECT cartID,cartProdID,cartProdName,cartProdPrice,cartQuantity,pWeight,pShipping,pShipping2,pExemptions,pSection,topSection,pDims,pTax,"&getlangid("pDescription",2)&" FROM cart INNER JOIN (products LEFT OUTER JOIN sections ON products.pSection=sections.sectionID) ON cart.cartProdID=products.pID WHERE cartCompleted=0 AND " & getsessionsql()
end if
rs.Open sSQL,cnn,0,1
if NOT (rs.EOF OR rs.BOF) then alldata=rs.getrows
rs.Close
%>
<%
end if
if cartisincluded<>TRUE then
cnn.Close
set rs = nothing
set rs2 = nothing
set cnn = nothing
end if
%>
The knowledgeable, courteous staff at Dynamic Dental Solutions encourages you to
contact us with all your important questions by phone or e-mail.
We look forward to assisting you create "Uncommon Practices".
Home - General Info - Financial Services - Store - Web Design - Office Design - Networking - Computers - Contact Us
