<%
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 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
if Trim(Request.Form("sessionid")) <> "" then thesessionid = replace(trim(Request.Form("sessionid")), "'", "") else thesessionid = Session.SessionID
if NOT isnumeric(thesessionid) then thesessionid=-1
function FormatMCCurrency(amount)
if overridecurrency=true then
if orcpreamount=true then
FormatMCCurrency = orcsymbol & FormatNumber(amount,orcdecplaces)
else
FormatMCCurrency = FormatNumber(amount,orcdecplaces) & orcsymbol
end if
else
if useEuro then
FormatMCCurrency = FormatNumber(amount,2) & " €"
else
FormatMCCurrency = FormatCurrency(amount)
end if
end if
end function
mcgndtot=0
mcpdtxt=""
totquant=0
shipping=0
discounts=0
if session("xscountrytax")<>"" then xscountrytax = cDbl(session("xscountrytax")) else xscountrytax=0
Set rs = Server.CreateObject("ADODB.RecordSet")
Set rs2 = Server.CreateObject("ADODB.RecordSet")
Set cnn=Server.CreateObject("ADODB.Connection")
cnn.open sDSN
if incfunctionsdefined=TRUE then
alreadygotadmin = getadminsettings()
else
sSQL = "SELECT countryLCID,countryCurrency,adminStoreURL FROM admin INNER JOIN countries ON admin.adminCountry=countries.countryID WHERE adminID=1"
rs.Open sSQL,cnn,0,1
if orlocale<>"" then
Session.LCID = orlocale
elseif rs("countryLCID")<>0 then
Session.LCID = rs("countryLCID")
end if
useEuro = (rs("countryCurrency")="EUR")
storeurl = rs("adminStoreURL")
if (left(LCase(storeurl),7) <> "http://") AND (left(LCase(storeurl),8) <> "https://") then storeurl = "http://" & storeurl
if Right(storeurl,1) <> "/" then storeurl = storeurl & "/"
rs.Close
end if
sSQL = "SELECT cartID,cartProdID,cartProdName,cartProdPrice,cartQuantity FROM cart WHERE cartCompleted=0 AND " & getsessionsql()
rs2.Open sSQL,cnn,0,1
do while NOT rs2.EOF
optPriceDiff=0
mcpdtxt = mcpdtxt & "
"
sSQL = "SELECT SUM(coPriceDiff) AS sumDiff FROM cartoptions WHERE coCartID="&rs2("cartID")
rs.Open sSQL,cnn,0,1
if NOT IsNull(rs("sumDiff")) then optPriceDiff=rs("sumDiff")
rs.Close
subtot = ((rs2("cartProdPrice")+optPriceDiff)*Int(rs2("cartQuantity")))
totquant = totquant + Int(rs2("cartQuantity"))
mcgndtot=mcgndtot+subtot
rs2.MoveNext
loop
rs2.Close
cnn.Close
set msrs = nothing
set msrs2 = nothing
set cnn = nothing
%>
<% response.write mcpdtxt
if mcpdtxt<>"" AND session("discounts")<>"" then
discounts = cDbl(session("discounts")) %>
<%=xxDscnts & " " & FormatMCCurrency(discounts)%>
<% end if
if mcpdtxt<>"" AND session("xsshipping")<>"" then
shipping = cDbl(session("xsshipping"))
if shipping=0 then showshipping=""&xxFree&"" else showshipping=FormatMCCurrency(shipping) %>
<%
'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
if digidownloadsecret="" then digidownloadsecret="this is some secret text"
Sub order_success(sorderid,sEmail,sendstoreemail)
call do_order_success(sorderid,sEmail,sendstoreemail,TRUE,TRUE,TRUE,TRUE)
End sub
Sub do_order_success(sorderid,sEmail,sendstoreemail,doshowhtml,sendcustemail,sendaffilemail,sendmanufemail)
Dim custEmail,ordAddInfo,affilID,dropShippers()
Redim dropShippers(2,10)
if htmlemails=true then emlNl = " " else emlNl=vbCrLf
affilID = ""
ordID = sorderid
hasdownload=FALSE
sSQL = "SELECT ordID,ordName,ordAddress,ordAddress2,ordCity,ordState,ordZip,ordCountry,ordEmail,ordPhone,ordShipName,ordShipAddress,ordShipAddress2,ordShipCity,ordShipState,ordShipZip,ordShipCountry,ordShipPhone,ordPayProvider,ordAuthNumber,ordTotal,ordDate,ordStateTax,ordCountryTax,ordHSTTax,ordHandling,ordShipping,ordAffiliate,ordShipType,ordDiscount,ordDiscountText,ordComLoc,ordExtra1,ordExtra2,ordShipExtra1,ordShipExtra2,ordCheckoutExtra1,ordCheckoutExtra2,ordSessionID,payProvID,ordAddInfo FROM orders INNER JOIN payprovider ON payprovider.payProvID=orders.ordPayProvider WHERE ordAuthNumber<>'' AND ordID="&replace(sorderid,"'","")
rs.Open sSQL,cnn,0,1
if NOT rs.EOF then
orderText = ""
saveHeader = ""
success=true
ordAuthNumber = rs("ordAuthNumber")
ordSessionID = rs("ordSessionID")
payprovid = rs("payProvID")
ordName = rs("ordName")
if emailheader<>"" then saveHeader = emailheader
execute("emailheader = emailheader" & payprovid)
if emailheader<>"" then saveHeader = saveHeader & emailheader
saveHeader = replace(saveHeader, "%ordername%", ordName)
orderText = orderText & xxOrdId & ": " & rs("ordID") & emlNl
if thereference<>"" then orderText = orderText & "Transaction Ref" & ": " & thereference & emlNl
orderText = orderText & xxCusDet & ": " & emlNl
if Trim(extraorderfield1)<>"" then orderText = orderText & extraorderfield1 & ": " & rs("ordExtra1") & emlNl
orderText = orderText & ordName & emlNl
orderText = orderText & rs("ordAddress") & emlNl
if trim(rs("ordAddress2"))<>"" then orderText = orderText & rs("ordAddress2") & emlNl
orderText = orderText & rs("ordCity") & ", " & rs("ordState") & emlNl
orderText = orderText & rs("ordZip") & emlNl
orderText = orderText & rs("ordCountry") & emlNl
orderText = orderText & xxEmail & ": " & rs("ordEmail") & emlNl
custEmail = rs("ordEmail")
orderText = orderText & xxPhone & ": " & rs("ordPhone") & emlNl
if Trim(extraorderfield2)<>"" then orderText = orderText & extraorderfield2 & ": " & rs("ordExtra2") & emlNl
if Trim(rs("ordShipName")) <> "" OR Trim(rs("ordShipAddress")) <> "" then
orderText = orderText & xxShpDet & ": " & emlNl
if Trim(extraorderfield1)<>"" AND trim(rs("ordShipExtra1")&"")<>"" then orderText = orderText & extraorderfield1 & ": " & rs("ordShipExtra1") & emlNl
orderText = orderText & rs("ordShipName") & emlNl
orderText = orderText & rs("ordShipAddress") & emlNl
if trim(rs("ordShipAddress2"))<>"" then orderText = orderText & rs("ordShipAddress2") & emlNl
orderText = orderText & rs("ordShipCity") & ", " & rs("ordShipState") & emlNl
orderText = orderText & rs("ordShipZip") & emlNl
orderText = orderText & rs("ordShipCountry") & emlNl
if trim(rs("ordShipPhone")&"")<>"" then orderText = orderText & xxPhone & ": " & rs("ordShipPhone") & emlNl
if Trim(extraorderfield2)<>"" AND trim(rs("ordShipExtra2")&"")<>"" then orderText = orderText & extraorderfield2 & ": " & rs("ordShipExtra2") & emlNl
end if
ordShipType = rs("ordShipType")
if ordShipType <> "" then
orderText = orderText & emlNl & xxShpMet & ": " & ordShipType
if (rs("ordComLoc") AND 2)=2 then orderText = orderText & xxWtIns
orderText = orderText & emlNl
if (rs("ordComLoc") AND 1)=1 then orderText = orderText & xxCerCLo & emlNl
if (rs("ordComLoc") AND 4)=4 then orderText = orderText & xxSatDeR & emlNl
end if
if Trim(extracheckoutfield1)<>"" AND trim(rs("ordCheckoutExtra1")&"")<>"" then orderText = orderText & extracheckoutfield1 & ": " & rs("ordCheckoutExtra1") & emlNl
if Trim(extracheckoutfield2)<>"" AND trim(rs("ordCheckoutExtra2")&"")<>"" then orderText = orderText & extracheckoutfield2 & ": " & rs("ordCheckoutExtra2") & emlNl
ordAddInfo = Trim(rs("ordAddInfo"))
if ordAddInfo <> "" then
orderText = orderText & emlNl & xxAddInf & ": " & emlNl
orderText = orderText & ordAddInfo & emlNl
end if
ordTotal = rs("ordTotal")
ordDate = rs("ordDate")
ordStateTax = rs("ordStateTax")
ordDiscount = rs("ordDiscount")
ordDiscountText = rs("ordDiscountText")
ordCountryTax = rs("ordCountryTax")
ordHSTTax = rs("ordHSTTax")
ordShipping = rs("ordShipping")
ordHandling = rs("ordHandling")
affilID = Trim(rs("ordAffiliate"))
else
orderText = "Cannot find customer details for order id " & sorderid & emlNl
end if
rs.Close
saveCustomerDetails=orderText
orderText = saveHeader & "%digidownloadplaceholder%" & orderText
sSQL = "SELECT cartProdId,cartProdName,cartProdPrice,cartQuantity,cartID,pDropship"&IIfVr(digidownloads=TRUE,",pDownload","")&" FROM cart INNER JOIN products ON cart.cartProdId=products.pID WHERE cartOrderID="&replace(sorderid,"'","")
rs.Open sSQL,cnn,0,1
if NOT rs.EOF then
do while not rs.EOF
localhasdownload=FALSE
if digidownloads=TRUE then
if trim(rs("pDownload")&"")<>"" then localhasdownload=TRUE
end if
saveCartItems = "--------------------------" & emlNl
saveCartItems = saveCartItems & xxPrId & ": " & rs("cartProdId") & emlNl
saveCartItems = saveCartItems & xxPrNm & ": " & rs("cartProdName") & emlNl
saveCartItems = saveCartItems & xxQuant & ": " & rs("cartQuantity") & emlNl
orderText = orderText & saveCartItems
theoptions = ""
theoptionspricediff=0
sSQL = "SELECT coOptGroup,coCartOption,coPriceDiff,optRegExp FROM cartoptions INNER JOIN options ON cartoptions.coOptID=options.optID WHERE coCartID="&rs("cartID") & " ORDER BY coID"
rs2.Open sSQL,cnn,0,1
do while NOT rs2.EOF
theoptionspricediff = theoptionspricediff + rs2("coPriceDiff")
optionline = IIfVr(htmlemails=true," > ","> > > ") & rs2("coOptGroup") & " : " & replace(rs2("coCartOption")&"", vbCrLf, emlNl)
theoptions = theoptions & optionline
saveCartItems = saveCartItems & optionline & emlNl
if rs2("coPriceDiff")=0 OR hideoptpricediffs=TRUE then
theoptions = theoptions & emlNl
else
theoptions = theoptions & " ("
if rs2("coPriceDiff") > 0 then theoptions = theoptions & "+"
theoptions = theoptions & FormatEmailEuroCurrency(rs2("coPriceDiff")) & ")" & emlNl
end if
if rs2("optRegExp") = "!!" then localhasdownload=FALSE
rs2.MoveNext
loop
rs2.Close
orderText = orderText & xxUnitPr & ": " & IIfVr(hideoptpricediffs=TRUE,FormatEmailEuroCurrency(rs("cartProdPrice")+theoptionspricediff),FormatEmailEuroCurrency(rs("cartProdPrice"))) & emlNl
orderText = orderText & theoptions
if rs("pDropship")<>0 then
index=0
do while TRUE
if index>=UBOUND(dropShippers,2) then Redim Preserve dropShippers(2,index+10)
if dropShippers(0, index)="" OR dropShippers(0, index)=rs("pDropship") then exit do
index=index+1
loop
dropShippers(0, index)=rs("pDropship")
dropShippers(1, index)=dropShippers(1, index) & saveCartItems
end if
if localhasdownload=TRUE then hasdownload=TRUE
rs.MoveNext
loop
orderText = orderText & "--------------------------" & emlNl
orderText = orderText & xxOrdTot & " : " & FormatEmailEuroCurrency(ordTotal) & emlNl
if combineshippinghandling=TRUE then
orderText = orderText & xxShipHa & " : " & FormatEmailEuroCurrency(ordShipping + ordHandling) & emlNl
else
if shipType<>0 then orderText = orderText & xxShippg & " : " & FormatEmailEuroCurrency(ordShipping) & emlNl
if cDbl(ordHandling)<>0.0 then orderText = orderText & xxHndlg & " : " & FormatEmailEuroCurrency(ordHandling) & emlNl
end if
if cDbl(ordDiscount)<>0.0 then orderText = orderText & xxDscnts & " : " & FormatEmailEuroCurrency(ordDiscount) & emlNl
if cDbl(ordStateTax)<>0.0 then orderText = orderText & xxStaTax & " : " & FormatEmailEuroCurrency(ordStateTax) & emlNl
if cDbl(ordCountryTax)<>0.0 then orderText = orderText & xxCntTax & " : " & FormatEmailEuroCurrency(ordCountryTax) & emlNl
if cDbl(ordHSTTax)<>0.0 then orderText = orderText & xxHST & " : " & FormatEmailEuroCurrency(ordHSTTax) & emlNl
ordGrandTotal = (ordTotal+ordStateTax+ordCountryTax+ordHSTTax+ordShipping+ordHandling)-ordDiscount
orderText = orderText & xxGndTot & " : " & FormatEmailEuroCurrency(ordGrandTotal) & emlNl
execute("emailheader = emailfooter" & payprovid)
if emailheader<>"" then orderText = orderText & emailheader
if emailfooter<>"" then orderText = orderText & emailfooter
else
orderText = orderText & "Cannot find order details for order id " & sorderid & emlNl
end if
rs.Close
if hasdownload=TRUE AND digidownloademail<>"" then
fingerprint = HMAC(digidownloadsecret, sorderid & ordAuthNumber & ordSessionID)
fingerprint = Left(fingerprint, 14)
digidownloademail = replace(digidownloademail,"%orderid%",ordID)
digidownloademail = replace(digidownloademail,"%password%",fingerprint)
digidownloademail = replace(digidownloademail,"%nl%",emlNl)
orderEmailText = replace(orderText,"%digidownloadplaceholder%",digidownloademail)
else
orderEmailText = replace(orderText,"%digidownloadplaceholder%","")
end if
orderText = replace(orderText,"%digidownloadplaceholder%","")
if sendstoreemail then
Call DoSendEmailEO(sEmail,sEmail,"",replace(xxOrdStr, "%orderid%", sorderid),orderEmailText,emailObject,themailhost,theuser,thepass)
end if
' And one for the customer
if sendcustemail then
Call DoSendEmailEO(custEmail,sEmail,"",replace(xxTnxOrd, "%ordername%", ordName),xxTouSoo & emlNl & emlNl & orderEmailText,emailObject,themailhost,theuser,thepass)
end if
' Drop Shippers / Manufacturers
if sendmanufemail then
for index=0 to UBOUND(dropShippers,2)
if dropShippers(0, index)="" then exit for
if dropshipsubject="" then dropshipsubject="We have received the following order"
sSQL = "SELECT dsEmail,dsAction FROM dropshipper WHERE dsID="&dropShippers(0, index)
rs.Open sSQL,cnn,0,1
if NOT rs.EOF then
if (rs("dsAction") AND 1)=1 OR sendmanufemail=2 then
saveHeader = ""
saveFooter = ""
if dropshipheader<>"" then saveHeader = dropshipheader
execute("emailheader = dropshipheader" & payprovid)
if emailheader<>"" then saveHeader = saveHeader & emailheader
execute("saveFooter = dropshipfooter" & payprovid)
if dropshipfooter<>"" then saveFooter = saveFooter & dropshipfooter
Call DoSendEmailEO(Trim(rs("dsEmail")),sEmail,"",dropshipsubject,saveHeader & saveCustomerDetails & dropShippers(1, index) & saveFooter,emailObject,themailhost,theuser,thepass)
end if
end if
rs.Close
next
end if
if sendaffilemail then
if affilID<>"" then
sSQL = "SELECT affilEmail,affilInform FROM affiliates WHERE affilID='"&replace(affilID,"'","")&"'"
rs.Open sSQL,cnn,0,1
if NOT rs.EOF then
if Int(rs("affilInform"))=1 then
affiltext = xxAff1 & " "&FormatEmailEuroCurrency(ordTotal-ordDiscount)&"."&emlNl&emlNl&xxAff2&emlNl&emlNl&xxThnks&emlNl
Call DoSendEmailEO(Trim(rs("affilEmail")),sEmail,"",xxAff3,affiltext,emailObject,themailhost,theuser,thepass)
end if
end if
rs.Close
end if
end if
if doshowhtml then
%>
<%=xxThkYou%>
<% if digidownloads<>true then %>
<%=Replace(orderText,vbCrLf," ")%>
<% if xxRecEml<>"" then response.write xxRecEml&"
"%>
<% end if %>
<%
end if
End sub
Sub DoSendEmail(seTo,seFrom,seSubject,seBody)
Set rsSE = Server.CreateObject("ADODB.RecordSet")
sSQL="SELECT emailObject,smtpserver,emailUser,emailPass FROM admin WHERE adminID=1"
rsSE.Open sSQL,cnn,0,1
emailObject = rsSE("emailObject")
themailhost = Trim(rsSE("smtpserver")&"")
theuser = Trim(rsSE("emailUser")&"")
thepass = Trim(rsSE("emailPass")&"")
rsSE.Close
Call DoSendEmailEO(seTo,seFrom,"",seSubject,seBody,emailObject,themailhost,theuser,thepass)
set rsSE = nothing
End Sub
Sub DoSendEmailEO(seTo,seFrom,seReplyTo,seSubject,seBody,emailObject,emailhost,username,password)
seReplyTo = Trim(seReplyTo)
on error resume next
if emailObject=0 then
Set EmailObj = Server.CreateObject("CDONTS.NewMail")
EmailObj.MailFormat = 0
if htmlemails=true then EmailObj.BodyFormat=0
EmailObj.To = seTo
EmailObj.From = seFrom
if seReplyTo<>"" then EmailObj.Value("Reply-To") = seReplyTo
EmailObj.Subject = seSubject
EmailObj.Body = seBody
EmailObj.Send
elseif emailObject=1 then
Set EmailObj = Server.CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
if NOT (emailhost = "your.mailserver.com" OR emailhost = "") then
Set Flds = iConf.Fields
Flds.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
Flds.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = emailhost
if username<>"" AND password<>"" then
Flds.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
Flds.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = username
Flds.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = password
end if
Flds.Update
EmailObj.Configuration = iConf
else
Set Flds = iConf.Fields
if username<>"" AND password<>"" then
Flds.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
Flds.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = username
Flds.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = password
end if
Flds.Update
EmailObj.Configuration = iConf
end if
EmailObj.From = Chr(34) & seFrom & Chr(34) & Chr(60) & seFrom & Chr(62)
if seReplyTo<>"" then
EmailObj.ReplyTo = Chr(34) & seReplyTo & Chr(34) & Chr(60) & seReplyTo & Chr(62)
else
EmailObj.ReplyTo = Chr(34) & seFrom & Chr(34) & Chr(60) & seFrom & Chr(62)
end if
EmailObj.Subject = seSubject
EmailObj.Fields.Update
if htmlemails=true then
EmailObj.HTMLBody = seBody
if emailencoding<> "iso-8859-1" then
EmailObj.HTMLBodyPart.Charset = emailencoding
EmailObj.TextBodyPart.Charset = emailencoding
EmailObj.BodyPart.Charset = emailencoding
end if
else
EmailObj.TextBody = seBody
if emailencoding<> "iso-8859-1" then
EmailObj.HTMLBodyPart.Charset = emailencoding
EmailObj.TextBodyPart.Charset = emailencoding
EmailObj.BodyPart.Charset = emailencoding
end if
end if
EmailObj.To = Chr(34) & seTo & Chr(34) & " <" & seTo & ">"
EmailObj.Send
elseif emailObject=2 then
Set EmailObj = Server.CreateObject("Persits.MailSender")
if username<>"" AND password<>"" then
EmailObj.Username = username
EmailObj.Password = password
end if
EmailObj.Host = emailhost
if htmlemails=true then EmailObj.IsHTML = true
EmailObj.AddAddress seTo
EmailObj.From = seFrom
EmailObj.FromName = seFrom
if seReplyTo<>"" then
EmailObj.AddReplyTo seReplyTo,seReplyTo
end if
EmailObj.Subject = seSubject
if emailencoding<> "iso-8859-1" then
EmailObj.Charset = emailencoding
end if
EmailObj.Body = seBody
if emailencoding<> "iso-8859-1" then
EmailObj.ContentTransferEncoding = "Quoted-Printable"
end if
EmailObj.Send
elseif emailObject=3 then
Set EmailObj = Server.CreateObject("SMTPsvg.Mailer")
if htmlemails=true then EmailObj.ContentType = "text/html"
EmailObj.RemoteHost = emailhost
EmailObj.AddRecipient seTo, seTo
EmailObj.FromAddress = seFrom
if seReplyTo<>"" then EmailObj.ReplyTo = seReplyTo
EmailObj.Subject = seSubject
EmailObj.BodyText = seBody
EmailObj.SendMail
elseif emailObject=4 then
Set EmailObj = Server.CreateObject("JMail.SMTPMail")
if htmlemails=true then EmailObj.ContentType = "text/html"
EmailObj.silent = true
EmailObj.Logging = true
EmailObj.ServerAddress = emailhost
EmailObj.AddRecipient seTo
EmailObj.Sender = seFrom
if seReplyTo<>"" then EmailObj.ReplyTo = seReplyTo
EmailObj.Subject = seSubject
EmailObj.Body = seBody
EmailObj.Execute
elseif emailObject=5 then
Set EmailObj = Server.CreateObject("SoftArtisans.SMTPMail")
if username<>"" AND password<>"" then
EmailObj.UserName = username
EmailObj.Password = password
end if
if htmlemails=true then EmailObj.ContentType = "text/html"
EmailObj.RemoteHost = emailhost
EmailObj.AddRecipient seTo , seTo
EmailObj.FromAddress = seFrom
if seReplyTo<>"" then EmailObj.ReplyTo = seReplyTo
EmailObj.Subject = seSubject
EmailObj.BodyText = seBody
if NOT EmailObj.SendMail then Response.write " " & EmailObj.Response
elseif emailObject=6 then
Set EmailObj = Server.CreateObject("JMail.Message")
if htmlemails=true then EmailObj.ContentType = "text/html"
EmailObj.silent = true
EmailObj.Logging = true
EmailObj.AddRecipient seTo
EmailObj.From = seFrom
if seReplyTo<>"" then EmailObj.ReplyTo = seReplyTo
EmailObj.Subject = seSubject
if htmlemails=true then EmailObj.HTMLBody = seBody else EmailObj.Body = seBody
EmailObj.Send(emailhost)
end if
Set EmailObj = nothing
on error goto 0
End Sub
%>
<%
'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 netnav, success
if request.totalbytes > 10000 then response.end
success = true
digidownloads=false
Set rs = Server.CreateObject("ADODB.RecordSet")
Set rs2 = Server.CreateObject("ADODB.RecordSet")
Set cnn=Server.CreateObject("ADODB.Connection")
cnn.open sDSN
alreadygotadmin = getadminsettings()
if Request.Form("posted")="1" then
email = Trim(Replace(Request.form("email"), "'", ""))
ordid = Trim(Replace(Request.form("ordid"), "'", ""))
if NOT IsNumeric(ordid) then
success = false
errormsg = xxStaEr1
elseif email<>"" AND ordid<>"" then
sSQL = "SELECT ordStatus,ordStatusDate,"&getlangid("statPublic",64)&",ordTrackNum,ordAuthNumber,ordStatusInfo FROM orders INNER JOIN orderstatus ON orders.ordStatus=orderstatus.statID WHERE ordID=" & ordid & " AND ordEmail='" & email & "'"
rs.Open sSQL,cnn,0,1
if NOT rs.EOF then
ordStatus = rs("ordStatus")
ordStatusDate = rs("ordStatusDate")
statPublic = rs(getlangid("statPublic",64))
ordAuthNumber = trim(rs("ordAuthNumber")&"")
ordStatusInfo = trim(rs("ordStatusInfo")&"")
ordTrackNum = trim(rs("ordTrackNum")&"")
if trackingnumtext = "" then trackingnumtext=xxTrackT
if ordTrackNum <> "" then trackingnum=replace(trackingnumtext, "%s", ordTrackNum) else trackingnum=""
trackingnum = replace(trackingnum, "%nl%", " ")
' if dateadjust<>"" then ordStatusDate = DateAdd("h",dateadjust,ordStatusDate)
else
success = false
errormsg = xxStaEr2
end if
rs.Close
else
success = false
errormsg = xxStaEnt
end if
end if
%>
Home - General Info - Financial Services - Store - Web Design - Office Design - Networking - Computers - Contact Us
