<%@ Language=VBScript %> <% Response.Buffer = True %> <% '@BEGINVERSIONINFO '@APPVERSION: 5.3001.0.1 '@FILENAME: db.conn.open.asp ' '@DESCRIPTION: Opens Database Connection '@STARTCOPYRIGHT 'The contents of this file is protected under the United States 'copyright laws as an unpublished work, and is confidential and proprietary to 'LaGarde, Incorporated. Its use or disclosure in whole or in part without the 'expressed written permission of LaGarde, Incorporated is expressly prohibited. ' '(c) Copyright 2000 by LaGarde, Incorporated. All rights reserved. '@ENDCOPYRIGHT '@ENDVERSIONINFO ' Variable Declarations Dim cnn, DSN_Name ' Object Creation Set cnn=Server.CreateObject("ADODB.Connection") DSN_Name = Session("DSN_Name") cnn.open DSN_Name '------------------------------------------------------------------- ' Function that releases an object '------------------------------------------------------------------- Sub closeObj(objItem) On Error Resume Next objItem.Close Set objItem=nothing On Error GoTo 0 End Sub %> <% '-------------------------------------------------------------------- ' Microsoft ADO ' ' (c) 1996 Microsoft Corporation. All Rights Reserved. ' ' ' ' ADO constants include file for VBScript ' '-------------------------------------------------------------------- '---- CursorTypeEnum Values ---- Const adOpenForwardOnly = 0 Const adOpenKeyset = 1 Const adOpenDynamic = 2 Const adOpenStatic = 3 '---- CursorOptionEnum Values ---- Const adHoldRecords = &H00000100 Const adMovePrevious = &H00000200 Const adAddNew = &H01000400 Const adDelete = &H01000800 Const adUpdate = &H01008000 Const adBookmark = &H00002000 Const adApproxPosition = &H00004000 Const adUpdateBatch = &H00010000 Const adResync = &H00020000 Const adNotify = &H00040000 '---- LockTypeEnum Values ---- Const adLockReadOnly = 1 Const adLockPessimistic = 2 Const adLockOptimistic = 3 Const adLockBatchOptimistic = 4 '---- ExecuteOptionEnum Values ---- Const adRunAsync = &H00000010 '---- ObjectStateEnum Values ---- Const adStateClosed = &H00000000 Const adStateOpen = &H00000001 Const adStateConnecting = &H00000002 Const adStateExecuting = &H00000004 '---- CursorLocationEnum Values ---- Const adUseServer = 2 Const adUseClient = 3 '---- DataTypeEnum Values ---- Const adEmpty = 0 Const adTinyInt = 16 Const adSmallInt = 2 Const adInteger = 3 Const adBigInt = 20 Const adUnsignedTinyInt = 17 Const adUnsignedSmallInt = 18 Const adUnsignedInt = 19 Const adUnsignedBigInt = 21 Const adSingle = 4 Const adDouble = 5 Const adCurrency = 6 Const adDecimal = 14 Const adNumeric = 131 Const adBoolean = 11 Const adError = 10 Const adUserDefined = 132 Const adVariant = 12 Const adIDispatch = 9 Const adIUnknown = 13 Const adGUID = 72 Const adDate = 7 Const adDBDate = 133 Const adDBTime = 134 Const adDBTimeStamp = 135 Const adBSTR = 8 Const adChar = 129 Const adVarChar = 200 Const adLongVarChar = 201 Const adWChar = 130 Const adVarWChar = 202 Const adLongVarWChar = 203 Const adBinary = 128 Const adVarBinary = 204 Const adLongVarBinary = 205 '---- FieldAttributeEnum Values ---- Const adFldMayDefer = &H00000002 Const adFldUpdatable = &H00000004 Const adFldUnknownUpdatable = &H00000008 Const adFldFixed = &H00000010 Const adFldIsNullable = &H00000020 Const adFldMayBeNull = &H00000040 Const adFldLong = &H00000080 Const adFldRowID = &H00000100 Const adFldRowVersion = &H00000200 Const adFldCacheDeferred = &H00001000 '---- EditModeEnum Values ---- Const adEditNone = &H0000 Const adEditInProgress = &H0001 Const adEditAdd = &H0002 Const adEditDelete = &H0004 '---- RecordStatusEnum Values ---- Const adRecOK = &H0000000 Const adRecNew = &H0000001 Const adRecModified = &H0000002 Const adRecDeleted = &H0000004 Const adRecUnmodified = &H0000008 Const adRecInvalid = &H0000010 Const adRecMultipleChanges = &H0000040 Const adRecPendingChanges = &H0000080 Const adRecCanceled = &H0000100 Const adRecCantRelease = &H0000400 Const adRecConcurrencyViolation = &H0000800 Const adRecIntegrityViolation = &H0001000 Const adRecMaxChangesExceeded = &H0002000 Const adRecObjectOpen = &H0004000 Const adRecOutOfMemory = &H0008000 Const adRecPermissionDenied = &H0010000 Const adRecSchemaViolation = &H0020000 Const adRecDBDeleted = &H0040000 '---- GetRowsOptionEnum Values ---- Const adGetRowsRest = -1 '---- PositionEnum Values ---- Const adPosUnknown = -1 Const adPosBOF = -2 Const adPosEOF = -3 '---- enum Values ---- Const adBookmarkCurrent = 0 Const adBookmarkFirst = 1 Const adBookmarkLast = 2 '---- MarshalOptionsEnum Values ---- Const adMarshalAll = 0 Const adMarshalModifiedOnly = 1 '---- AffectEnum Values ---- Const adAffectCurrent = 1 Const adAffectGroup = 2 Const adAffectAll = 3 '---- FilterGroupEnum Values ---- Const adFilterNone = 0 Const adFilterPendingRecords = 1 Const adFilterAffectedRecords = 2 Const adFilterFetchedRecords = 3 Const adFilterPredicate = 4 '---- SearchDirection Values ---- Const adSearchForward = 1 Const adSearchBackward = -1 '---- ConnectPromptEnum Values ---- Const adPromptAlways = 1 Const adPromptComplete = 2 Const adPromptCompleteRequired = 3 Const adPromptNever = 4 '---- ConnectModeEnum Values ---- Const adModeUnknown = 0 Const adModeRead = 1 Const adModeWrite = 2 Const adModeReadWrite = 3 Const adModeShareDenyRead = 4 Const adModeShareDenyWrite = 8 Const adModeShareExclusive = &Hc Const adModeShareDenyNone = &H10 '---- IsolationLevelEnum Values ---- Const adXactUnspecified = &Hffffffff Const adXactChaos = &H00000010 Const adXactReadUncommitted = &H00000100 Const adXactBrowse = &H00000100 Const adXactCursorStability = &H00001000 Const adXactReadCommitted = &H00001000 Const adXactRepeatableRead = &H00010000 Const adXactSerializable = &H00100000 Const adXactIsolated = &H00100000 '---- XactAttributeEnum Values ---- Const adXactCommitRetaining = &H00020000 Const adXactAbortRetaining = &H00040000 '---- PropertyAttributesEnum Values ---- Const adPropNotSupported = &H0000 Const adPropRequired = &H0001 Const adPropOptional = &H0002 Const adPropRead = &H0200 Const adPropWrite = &H0400 '---- ErrorValueEnum Values ---- Const adErrInvalidArgument = &Hbb9 Const adErrNoCurrentRecord = &Hbcd Const adErrIllegalOperation = &Hc93 Const adErrInTransaction = &Hcae Const adErrFeatureNotAvailable = &Hcb3 Const adErrItemNotFound = &Hcc1 Const adErrObjectInCollection = &Hd27 Const adErrObjectNotSet = &Hd5c Const adErrDataConversion = &Hd5d Const adErrObjectClosed = &He78 Const adErrObjectOpen = &He79 Const adErrProviderNotFound = &He7a Const adErrBoundToCommand = &He7b Const adErrInvalidParamInfo = &He7c Const adErrInvalidConnection = &He7d Const adErrStillExecuting = &He7f Const adErrStillConnecting = &He81 '---- ParameterAttributesEnum Values ---- Const adParamSigned = &H0010 Const adParamNullable = &H0040 Const adParamLong = &H0080 '---- ParameterDirectionEnum Values ---- Const adParamUnknown = &H0000 Const adParamInput = &H0001 Const adParamOutput = &H0002 Const adParamInputOutput = &H0003 Const adParamReturnValue = &H0004 '---- CommandTypeEnum Values ---- Const adCmdUnknown = &H0008 Const adCmdText = &H0001 Const adCmdTable = &H0002 Const adCmdStoredProc = &H0004 '---- SchemaEnum Values ---- Const adSchemaProviderSpecific = -1 Const adSchemaAsserts = 0 Const adSchemaCatalogs = 1 Const adSchemaCharacterSets = 2 Const adSchemaCollations = 3 Const adSchemaColumns = 4 Const adSchemaCheckConstraints = 5 Const adSchemaConstraintColumnUsage = 6 Const adSchemaConstraintTableUsage = 7 Const adSchemaKeyColumnUsage = 8 Const adSchemaReferentialContraints = 9 Const adSchemaTableConstraints = 10 Const adSchemaColumnsDomainUsage = 11 Const adSchemaIndexes = 12 Const adSchemaColumnPrivileges = 13 Const adSchemaTablePrivileges = 14 Const adSchemaUsagePrivileges = 15 Const adSchemaProcedures = 16 Const adSchemaSchemata = 17 Const adSchemaSQLLanguages = 18 Const adSchemaStatistics = 19 Const adSchemaTables = 20 Const adSchemaTranslations = 21 Const adSchemaProviderTypes = 22 Const adSchemaViews = 23 Const adSchemaViewColumnUsage = 24 Const adSchemaViewTableUsage = 25 Const adSchemaProcedureParameters = 26 Const adSchemaForeignKeys = 27 Const adSchemaPrimaryKeys = 28 Const adSchemaProcedureColumns = 29 ''''CDO CONST Const cdoSendUsingMethod ="http://schemas.microsoft.com/cdo/configuration/sendusing" Const cdoSMTPServerPort ="http://schemas.microsoft.com/cdo/configuration/smtpserverportcdoSendUsingPort" Const cdoSMTPServer ="http://schemas.microsoft.com/cdo/configuration/smtpserver" Const cdoSendUsingPort =2 Const cdoSMTPConnectionTimeout =5 Const cdoSMTPAuthenticate ="http://schemas.microsoft.com/cdo/configuration/smtpauthenticate" Const cdoURLProxyServer ="http://schemas.microsoft.com/cdo/configuration/urlproxyserver" Const cdoURLProxyBypass ="http://schemas.microsoft.com/cdo/configuration/urlproxybypass" Const cdoURLGetLatestVersion ="http://schemas.microsoft.com/cdo/configuration/urlgetlatestversion" Const cdoSendUserName ="http://schemas.microsoft.com/cdo/configuration/sendusername" Const cdoSendPassword ="http://schemas.microsoft.com/cdo/configuration/sendpassword" '''''''''''''''''''' %> <% '@BEGINVERSIONINFO '@APPVERSION: 5.10.00 '@FILENAME: incGeneral.asp '@FILEVERSION: 1.0.0 '@VERSIONDATETIME: 1/26/01 '@DESCRIPTION: multple functions used in the web application '@STARTCOPYRIGHT 'The contents of this file is protected under the United States 'copyright laws as an unpublished work, and is confidential and proprietary to 'LaGarde, Incorporated. Its use or disclosure in whole or in part without the 'expressed written permission of LaGarde, Incorporated is expressly prohibited. ' '(c) Copyright 2000 by LaGarde, Incorporated. All rights reserved. '@ENDCOPYRIGHT '@ENDVERSIONINFO Dim rsAdminGen, C_STORENAME, C_HomePath, C_SecurePath,iConverion,sUserName,iEzeeHelp,sEzeeHelp,iSaveCartActive,iEmailActive,iBrandActive,sAffID,sLCID Set rsAdminGen = Server.CreateObject("ADODB.Recordset") rsAdminGen.Open "SELECT adminStoreName, adminDomainName, adminSSLPath, adminOandaID, adminActivateOanda,adminEzeeLogin,adminEzeeActive,adminSaveCartActive,adminEmailActive,adminSFActive,adminSFID,adminLCID FROM sfAdmin", cnn, adOpenForwardOnly, adLockReadOnly, adCmdText C_STORENAME = trim(rsAdminGen.Fields("adminStoreName")) C_HomePath = trim(rsAdminGen.Fields("adminDomainName")) C_SecurePath = trim(rsAdminGen.Fields("adminSSLPath")) iConverion = trim(rsAdminGen.Fields("adminActivateOanda")) sUserName = trim(rsAdminGen.Fields("adminOandaID")) sEzeeHelp = trim(rsAdminGen.Fields("adminEzeeLogin")) iEzeeHelp = trim(rsAdminGen.Fields("adminEzeeActive")) iSaveCartActive = trim(rsAdminGen.Fields("adminSaveCartActive")) iEmailActive = trim(rsAdminGen.Fields("adminEmailActive")) iBrandActive = trim(rsAdminGen.Fields("adminSFActive")) sAffID = trim(rsAdminGen.Fields("adminSFID")) sLCID = trim(rsAdminGen.Fields("adminLCID")) closeObj(rsAdminGen) If Session("LCID") <> "" Then Session.LCID = Session("LCID") Else Session.LCID = sLCID Session("LCID") = sLCID End If If Mid(C_HomePath, Len(C_HomePath), 1) <> "/" Then C_HomePath = C_HomePath & "/" End If '-------------------------------------------------------- ' MakeUSDate converts all date inputs to US date format '-------------------------------------------------------- Function MakeUSDate(InDate) If Not IsDate(InDate) Then Exit Function MakeUSDate = Month(InDate)&"/"&Day(InDate)&"/"&Right(Year(InDate),2) End Function '---------------------------------------- ' getShippingSaleText '---------------------------------------- Function getShippingSaleText(sShipping) Dim rsShippingAdmin, sText sText = "" Set rsShippingAdmin = Server.CreateObject("ADODB.RecordSet") rsShippingAdmin.Open "sfAdmin", cnn, adOpenForwardOnly, adLockReadOnly, adCmdTable If Trim(rsShippingAdmin.Fields("adminFreeShippingIsActive")) = "1" Then If sShipping = 0 Then sText = "Free Shipping on orders over " & FormatCurrency(rsShippingAdmin.Fields("adminFreeShippingAmount")) & "!" End If End If rsShippingAdmin.Close Set rsShippingAdmin = nothing getShippingSaleText = sText End Function '------------------------------------------------------------------ 'These two functions handle Global Sales '------------------------------------------------------------------ Function getGlobalSaleText() Dim rsGlobalAdmin, sGlobalActive, sText sText = "" Set rsGlobalAdmin = Server.CreateObject("ADODB.RecordSet") rsGlobalAdmin.open "sfAdmin", cnn, adOpenForwardOnly, adLockReadOnly, adCmdTable sGlobalActive = Trim(rsGlobalAdmin.Fields("adminGlobalSaleIsActive")) If sGlobalActive = "1" Then sText = "All items discounted " & cDbl(rsGlobalAdmin.Fields("adminGlobalSaleAmt")) * 100 & "%! " End If rsGlobalAdmin.Close Set rsGlobalAdmin = nothing getGlobalSaleText = sText End Function function getGlobalSalePrice(subtotal) Dim rsGlobalAdmin, sGlobalActive Set rsGlobalAdmin = Server.CreateObject("ADODB.RecordSet") rsGlobalAdmin.open "sfAdmin", cnn, adOpenForwardOnly, adLockReadOnly, adCmdTable sGlobalActive = Trim(rsGlobalAdmin.Fields("adminGlobalSaleIsActive")) If sGlobalActive = "1" Then getGlobalSalePrice = formatNumber(cDbl(subtotal)-(cDbl(subtotal)*cDbl(rsGlobalAdmin.Fields("adminGlobalSaleAmt"))), 2) Else getGlobalSalePrice = subTotal End If rsGlobalAdmin.Close Set rsGlobalAdmin = nothing End Function '--------------------------------------------------------------------- ' Purpose: Deletes recordset from TmpOrders and associated child relations '--------------------------------------------------------------------- Sub setDeleteOrder(sPrefix,iOrderDetailId) Dim rsDelete, sLocalSQL, rsDelete2, sLocalSQL2 Select Case sPrefix Case "odrdttmp" sLocalSQL = "DELETE FROM sfTmpOrderDetails WHERE odrdttmpID = " & iOrderDetailId sLocalSQL2 = "DELETE FROM sfTmpOrderAttributes WHERE odrattrtmpOrderDetailId = " & iOrderDetailId Case "odrdtsvd" sLocalSQL = "DELETE FROM sfSavedOrderDetails WHERE odrdtsvdID = " & iOrderDetailId sLocalSQL2 = "DELETE FROM sfSavedOrderAttributes WHERE odrattrsvdOrderDetailId = " & iOrderDetailId End Select If vDebug = 1 Then Response.Write "
DeleteTmp SQL : " & sLocalSQL & "
SQL2: " & sLocalSQL2 Set rsDelete2 = cnn.Execute(sLocalSQL2) Set rsDelete = cnn.Execute(sLocalSQL) closeObj(rsDelete) closeObj(rsDelete2) End Sub Function getTax(choice, sShipping, sTotalPrice, sProdID) Dim sState, sCountry, SQL, rsTax, iTax, rsAdmin, iTaxAmt, rsProd Set rsProd = Server.CreateObject("ADODB.Recordset") Set rsTax = Server.CreateObject("ADODB.RecordSet") Set rsAdmin = Server.CreateObject("ADODB.RecordSet") SQL = "SELECT prodCountryTaxIsActive, prodStateTaxIsActive FROM sfProducts WHERE prodID = '" & sProdID & "'" rsProd.Open SQL, cnn, adOpenForwardOnly, adLockReadOnly, adCmdText SQL = "SELECT adminTaxShipIsActive FROM sfAdmin" If vDebug = 1 Then Response.Write SQL & "

" rsAdmin.Open SQL, cnn, adOpenForwardOnly, adLockReadOnly, adCmdText Select Case choice Case "State" If Request.Form("ShipState") <> "" Then sState = Request.Form("ShipState") ElseIf Request.Form("State") <> "" Then sState = Request.Form("State") ElseIf Request.QueryString("sShipCustState") <> "" Then sState = Request.QueryString("sShipCustState") End if SQL = "SELECT loclstTax FROM sfLocalesState WHERE loclstAbbreviation = '" & sState & "' AND loclstLocaleIsActive = 1" If vDebug = 1 Then Response.Write SQL & "

" rsTax.Open SQL, cnn, adOpenForwardOnly, adLockReadOnly, adCmdText If Not rsTax.EOF Then If trim(rsProd.Fields("prodStateTaxIsActive")) = "1" Then If rsAdmin.Fields("adminTaxShipIsActive") = 1 Then iTaxAmt = CDbl(sShipping) + CDbl(sTotalPrice) Else iTaxAmt = CDbl(sTotalPrice) End If End If iTax = iTaxAmt * CDbl(rsTax.Fields("loclstTax")) Else iTax = 0 End If Case "Country" If Request.Form("ShipCountry") <> "" Then sCountry = Request.Form("ShipCountry") Elseif Request.Form("Country") <> "" Then sCountry = Request.Form("Country") Elseif Request.QueryString("sShipCustCountry") <> "" Then sCountry = trim(Request.QueryString("sShipCustCountry")) End if SQL = "SELECT loclctryTax FROM sfLocalesCountry WHERE loclctryAbbreviation = '" & sCountry & "' AND loclctryLocalIsActive = 1" If vDebug = 1 Then Response.Write SQL & "

" rsTax.Open SQL, cnn, adOpenForwardOnly, adLockReadOnly, adCmdText If Not rsTax.EOF Then If trim(rsProd.Fields("prodCountryTaxIsActive")) = "1" Then If rsAdmin.Fields("adminTaxShipIsActive") = 1 Then iTaxAmt = CDbl(sShipping) + CDbl(sTotalPrice) Else iTaxAmt = CDbl(sTotalPrice) End If iTax = iTaxAmt * CDbl(rsTax.Fields("loclctryTax")) End If Else iTax = 0 End If End Select closeObj(rsAdmin) closeObj(rsTax) getTax = formatNumber(iTax, 2) End Function '--------------------------------------------------------------------- ' Collect Attribute IDs '--------------------------------------------------------------------- Function getProdAttr(sPrefix,sOrderID,iProdAttrNum) Dim sLocalSQL, rsAttrID, iCounter, aLocalArray Select Case sPrefix Case "odrattrtmp" sLocalSQL = "SELECT odrattrtmpAttrID FROM sfTmpOrderAttributes WHERE odrattrtmpOrderDetailId = " & sOrderID Case "odrattrsvd" sLocalSQL = "SELECT odrattrsvdAttrID FROM sfSavedOrderAttributes WHERE odrattrsvdOrderDetailId = " & sOrderID Case "odr" sLocalSQL = "SELECT odrattrID FROM sfOrderAttributes WHERE odrattrOrderDetailId = " & sOrderID End Select Set rsAttrID = Server.CreateObject("ADODB.RecordSet") rsAttrID.Open sLocalSQL, cnn, adOpenDynamic, adLockOptimistic, adCmdText If vDebug = 1 Then Response.Write "

getProdAttr SQL : " & sLocalSQL ' Check if this record exists through prodID and price matches If rsAttrID.EOF or rsAttrID.BOF Then If vDebug = 1 Then Response.Write "

Empty Recordset in rsAttrID" Else Redim aLocalArray(iProdAttrNum) For iCounter = 0 to iProdAttrNum - 1 aLocalArray(iCounter) = rsAttrID.Fields(sPrefix & "AttrID") If vDebug = 1 Then Response.Write "
AttrID: " & aLocalArray(iCounter) rsAttrID.MoveNext Next ' End RecordSet If End If closeObj(rsAttrID) getProdAttr = aLocalArray End Function '--------------------------------------------------------------------- ' This function checks whether a product exists and retrieves an array of info '--------------------------------------------------------------------- Function getProduct(sProdID) Dim sLocalSQL, aLocalProdArray(3), rsSelectProd sLocalSQL = "SELECT prodName, prodNamePlural, prodPrice, prodAttrNum,prodSaleIsActive,prodSalePrice FROM sfProducts WHERE prodEnabledIsActive=1 AND prodID = '"& sProdID & "'" Set rsSelectProd = Server.CreateObject("ADODB.RecordSet") rsSelectProd.Open sLocalSQL, cnn, adOpenDynamic, adLockOptimistic, adCmdText If vDebug = 1 Then Response.Write "

getProdValues SQL : " & sLocalSQL ' Check if this record exists through prodID and price matches If rsSelectProd.EOF or rsSelectProd.BOF Then If vDebug = 1 Then Response.Write "

Empty Recordset in rsSelectProd. Product " & sProdID & " possibly not activated." Else aLocalProdArray(0) = rsSelectProd.Fields("prodName") ' Check if sale price is active If rsSelectProd.Fields("prodSaleIsActive") = 1 Then aLocalProdArray(1) = rsSelectProd.Fields("prodSalePrice") Else aLocalProdArray(1) = rsSelectProd.Fields("prodPrice") End If aLocalProdArray(2) = rsSelectProd.Fields("prodAttrNum") ' End RecordSet If End If closeObj(rsSelectProd) getProduct = aLocalProdArray End Function '------------------------------------------------------- ' Update saved cart customers' info in sfCustomers '------------------------------------------------------- Sub setUpdateCustomer(sNewEmail,sFirstName,sMiddleInitial,sLastName,sCompany,sAddress1,sAddress2,sCity,sState,sZip,sCountry,sPhone,sFax,bSubscribed) Dim sLocalSQl, rsUpdate, iOldNum sLocalSQL = "Select custFirstName, custMiddleInitial, custLastName, custCompany, custAddr1, custAddr2, custCity, custState, custZip, custCountry, "_ & "custPhone, custFax, custTimesAccessed, custLastAccess, custEmail, custIsSubscribed FROM sfCustomers WHERE custID = " & Trim(Request.Cookies("sfCustomer")("custID")) Set rsUpdate = SErver.CreateObject("ADODB.RecordSet") rsUpdate.Open sLocalSQL,cnn,adOpenDynamic,adLockOptimistic,adCmdText If Not rsUpdate.EOF Then iOldNum = (rsUpdate.Fields("custTimesAccessed")) If iOldNum = "" Then iOldNum = 1 Else iOldNum = cInt(iOldNum) End If rsUpdate.Fields("custFirstName") = sFirstName rsUpdate.Fields("custMiddleInitial") = sMiddleInitial rsUpdate.Fields("custLastName") = sLastName rsUpdate.Fields("custCompany") = sCompany rsUpdate.Fields("custAddr1") = sAddress1 rsUpdate.Fields("custAddr2") = sAddress2 rsUpdate.Fields("custCity") = sCity rsUpdate.Fields("custState") = sState rsUpdate.Fields("custZip") = sZip rsUpdate.Fields("custCountry") = sCountry rsUpdate.Fields("custPhone") = sPhone rsUpdate.Fields("custFax") = sFax rsUpdate.Fields("custTimesAccessed") = iOldNum + 1 rsUpdate.Fields("custLastAccess") = Date() If sNewEmail <> "" Then rsUpdate.Fields("custEmail") = sNewEmail End If If bSubscribed = "" Then rsUpdate.Fields("custIsSubscribed") = 0 Else rsUpdate.Fields("custIsSubscribed") = 1 End If rsUpdate.Update End If closeObj(rsUpdate) End Sub '--------------------------------------------------------------------- ' This function returns one specific value associated with a single id ' Used for lookup of VendorID, ManufacturerID, CategoryID, etc '--------------------------------------------------------------------- Function getNameWithID(sLocalTableName,sLocalFindKey,sLocalFindKeyLabel,sLocalSearchName,bStringOrNot) Dim sLocalSQL, rsGetNameFromID, sLocalGetResult ' build SQL string based on whether the key is a string or not If (bStringOrNot = 0) Then sLocalSQL = "SELECT " & sLocalSearchName & " FROM " & sLocalTableName & " WHERE " & sLocalFindKeyLabel & "= " & Trim(sLocalFindKey) ElseIf (bstringOrNot = 1) Then sLocalSQL = "SELECT " & sLocalSearchName & " FROM " & sLocalTableName & " WHERE " & sLocalFindKeyLabel & "= '" & Trim(sLocalFindKey) & "'" Else Response.Write("The boolean parameter is not valid. Please input either 1 for true or 0 for false") Exit Function End If If vDebug = 1 Then Response.Write "
" & sLocalSQL Set rsGetNameFromID = Server.CreateObject("ADODB.RecordSet") rsGetNameFromID.Open sLocalSQL, cnn If rsGetNameFromID.EOF Or rsGetNameFromID.BOF Then 'If vDebug = 1 Then Response.Write "Either the recordset doesn't exit or the field name is not typed correctly :
" & sLocalSQL Else sLocalGetResult = rsGetNameFromID.Fields("" &sLocalSearchName& "") End If closeObj(rsGetNameFromID) getNameWithID = sLocalGetResult End Function '--------------------------------------------------------------------- ' Enters record svdOrders, returns the ID of the SvdOrder '--------------------------------------------------------------------- Function getSavedTable(aProdAttr,sProdID,iNewQuantity,iCustID,sReferer) Dim rsCopy, sLocalSQL, rsSvdCart, rsSvdCartAttr, iKeyID, sDateTime,sTmpAttrName, sTmpAttrID, aTmpOrderArray, bookMark ' Write to svd cart Set rsSvdCart = Server.CreateObject("ADODB.RecordSet") rsSvdCart.CursorLocation = adUseClient rsSvdCart.Open "sfSavedOrderDetails Order By odrdtsvdID", cnn, adOpenDynamic, adLockOptimistic rsSvdCart.AddNew rsSvdCart.Fields("odrdtsvdCustID") = iCustID rsSvdCart.Fields("odrdtsvdQuantity") = iNewQuantity rsSvdCart.Fields("odrdtsvdProductID") = sProdID rsSvdCart.Fields("odrdtsvdDate") = FormatDateTime(Now) rsSvdCart.Fields("odrdtsvdSessionID") = Session("SessionID") rsSvdCart.Fields("odrdtsvdHttpReferer") = sReferer rsSvdCart.Update bookMark = rsSvdCart.AbsolutePosition rsSvdCart.Requery rsSvdCart.AbsolutePosition = bookMark iKeyID = rsSvdCart.Fields("odrdtsvdID") If vDebug = 1 Then Response.Write "

SvdCart Key ID = " & iKeyID & "" ' Copy Attributes iCounter = 0 ' Collect Attribute Info from sfTmpOrderAttributes If IsArray(aProdAttr) Then Do While NOT aProdAttr(iCounter) = "" sTmpAttrID = aProdAttr(iCounter) If vDebug = 1 Then Response.Write "

sTmpAttrID = " & sTmpAttrID Set rsSvdCartAttr = Server.CreateObject("ADODB.RecordSet") rsSvdCartAttr.Open "sfSavedOrderAttributes", cnn, adOpenDynamic, adLockOptimistic rsSvdCartAttr.AddNew rsSvdCartAttr.Fields("odrattrsvdOrderDetailId") = iKeyID rsSvdCartAttr.Fields("odrattrsvdAttrID") = sTmpAttrID rsSvdCartAttr.Update iCounter = iCounter + 1 Loop ' End IsArray If End If If vDebug = 1 Then Response.Write "

Copied Record To SavedOrder" closeObj(rsCopy) closeObj(rsSvdCart) closeobj(rsSvdCartAttr) getSavedTable = iKeyId End Function '--------------------------------------------------------------------- ' Enters record TmpOrders, returns the ID of the TmpOrder '--------------------------------------------------------------------- Function getTmpTable(aProdAttr,sProdID,iNewQuantity,sReferer,iShip) Dim sLocalSQL, rsTmpCart, rsTmpCartAttr, iKeyID, sTmpAttrName, sTmpAttrID, aTmpOrderArray, bookMark ' Write to tmp cart Set rsTmpCart = Server.CreateObject("ADODB.RecordSet") rsTmpCart.CursorLocation = adUseClient rsTmpCart.Open "sfTmpOrderDetails Order By odrdttmpID", cnn, adOpenDynamic, adLockOptimistic, adCmdTable rsTmpCart.AddNew rsTmpCart.Fields("odrdttmpQuantity") = iNewQuantity rsTmpCart.Fields("odrdttmpProductID") = sProdID rsTmpCart.Fields("odrdttmpSessionID") = Session("SessionID") If sReferer <> "" and NOT isNull(sReferer) Then rsTmpCart.Fields("odrdttmpHttpReferer") = sReferer End If rsTmpCart.Fields("odrdttmpShipping") = iShip rsTmpCart.Update bookMark = rsTmpCart.AbsolutePosition rsTmpCart.Requery rsTmpCart.AbsolutePosition = bookMark iKeyID = rsTmpCart.Fields("odrdttmpID") If vDebug = 1 Then Response.Write "

TmpCart Key ID = " & iKeyID & "" ' Copy Attributes iCounter = 0 ' Collect Attribute Info from sfTmpOrderAttributes If IsArray(aProdAttr) Then Do While NOT aProdAttr(iCounter) = "" sTmpAttrID = aProdAttr(iCounter) If vDebug = 1 Then Response.Write "

sTmpAttrID = " & sTmpAttrID Set rsTmpCartAttr = Server.CreateObject("ADODB.RecordSet") rsTmpCartAttr.Open "sfTmpOrderAttributes", cnn, adOpenDynamic, adLockOptimistic, adCmdTable rsTmpCartAttr.AddNew rsTmpCartAttr.Fields("odrattrtmpOrderDetailId") = iKeyID rsTmpCartAttr.Fields("odrattrtmpAttrID") = sTmpAttrID rsTmpCartAttr.Update iCounter = iCounter + 1 Loop ' End IsArray If End If If vDebug = 1 Then Response.Write "

Copied Record To TmpOrder" closeObj(rsTmpCart) closeobj(rsTmpCartAttr) getTmpTable = iKeyId End Function '--------------------------------------------------------------------- ' Purpose: Updates the Quantity field with associated prodId and CartID '--------------------------------------------------------------------- Sub setUpdateQuantity(sPrefix,iQuantity,iTmpOrderID) Dim rsUpdate, sLocalSQL, iOldQuantity, iNewQuantity, rsGetQuantity Select Case sPrefix Case "odrdttmp" sLocalSQL = "SELECT odrdttmpQuantity FROM sfTmpOrderDetails WHERE odrdttmpID=" &iTmpOrderID & " AND odrdttmpSessionID=" & Session("SessionID") If vDebug = 1 Then Response.Write "
setUpdateQuantity SQL : " & sLocalSQL Case "odrdtsvd" sLocalSQL = "SELECT odrdtsvdQuantity FROM sfSavedOrderDetails WHERE odrdtsvdID=" & iTmpOrderID & " AND odrdtsvdCustID=" & Request.Cookies("sfCustomer")("custID") End Select Set rsGetQuantity = Server.CreateObject("ADODB.RecordSet") rsGetQuantity.Open sLocalSQL, cnn If rsGetQuantity.EOF And rsGetQuantity.BOF Then Response.Redirect "abandon.asp" ' Get Old Quantity iOldQuantity = rsGetQuantity.Fields(sPrefix & "Quantity") rsGetQuantity.Close iNewQuantity = cInt(iOldQuantity) + cInt(iQuantity) ' Now Update Set rsUpdate = Server.CreateObject("ADODB.RecordSet") rsUpdate.Open sLocalSQL, cnn, adOpenDynamic, adLockOptimistic, adCmdText rsUpdate.Fields(sPrefix & "Quantity") = iNewQuantity rsUpdate.Update closeObj(rsGetQuantity) closeObj(rsUpdate) End Sub '--------------------------------------------------------------------- ' Purpose: Updates the Quantity field with associated prodId and CartID '--------------------------------------------------------------------- Sub setReplaceQuantity(sPrefix,iQuantity,iTmpOrderID) Dim rsUpdate, sLocalSQL Select Case sPrefix Case "odrdttmp" sLocalSQL = "SELECT odrdttmpQuantity FROM sfTmpOrderDetails WHERE odrdttmpID=" &iTmpOrderID & " AND odrdttmpSessionID=" & Session("SessionID") If vDebug = 1 Then Response.Write "
setUpdateQuantity SQL : " & sLocalSQL Case "odrdtsvd" sLocalSQL = "SELECT odrdtsvdQuantity FROM sfSavedOrderDetails WHERE odrdtsvdID=" & iTmpOrderID & " AND odrdtsvdCustID=" & Request.Cookies("sfCustomer")("custID") If vDebug = 1 Then Response.Write "
setSvdUpdateQuantity SQL : " & sLocalSQL End Select ' Now Update Set rsUpdate = Server.CreateObject("ADODB.RecordSet") rsUpdate.Open sLocalSQL, cnn, adOpenDynamic, adLockOptimistic If rsUpdate.EOF And rsUpdate.BOF Then Response.Redirect "abandon.asp" rsUpdate.Fields(sPrefix & "Quantity") = iQuantity rsUpdate.Update If rsUpdate.EOF Or rsUpdate.BOF Then Response.Write "
Empty Recordset in rsUpdate" Else If vDebug = 1 Then Response.Write "

Successful update of Quantity to: " & iQuantity & "" End If closeObj(rsUpdate) End Sub '--------------------------------------------------------------------- ' Checks for existence of same product and attributes (if any) ' Returns the OrderDetail ID or -1 if record DNE '--------------------------------------------------------------------- Function getOrderID(sPrefix,sAttrPrefix,sProdID,aProdAttr,iProdAttrNum) Dim sTmpVar, bHasAttributes, iLocalResult, rsSelectProd, sTmpPrefixID, sTmpAttrName, sTmpAttr Dim sLocal, sSQL, sLocalSQL, sAttrName, bMatch, iUpperBound iLocalResult = -1 bHasAttributes = (iProdAttrNum > 0) bMatch = 0 ' SQL select Select Case sPrefix Case "odrdttmp" If bHasAttributes Then sLocalSQL = "SELECT odrdttmpID, odrattrtmpAttrID FROM sfTmpOrderAttributes INNER JOIN sfTmpOrderDetails ON sfTmpOrderAttributes.odrattrtmpOrderDetailId = sfTmpOrderDetails.odrdttmpID" _ & " WHERE odrdttmpSessionID = " & Session("SessionID") & " AND odrdttmpProductID = '" & sProdID & "'" Else sLocalSQL = "SELECT odrdttmpID FROM sfTmpOrderDetails WHERE odrdttmpSessionID = " & Session("SessionID") & " AND odrdttmpProductID = '" & sProdID & "'" End If Case "odrdtsvd" If bHasAttributes Then sLocalSQL = "SELECT odrdtsvdID, odrattrsvdAttrID FROM sfSavedOrderDetails INNER JOIN sfSavedOrderAttributes ON sfSavedOrderDetails.odrdtsvdID = sfSavedOrderAttributes.odrattrsvdOrderDetailId " _ & " WHERE odrdtsvdCustID=" & Request.Cookies("sfCustomer")("custID") & " AND odrdtsvdProductID = '" & sProdID & "'" Else sLocalSQL = "SELECT odrdtsvdID FROM sfSavedOrderDetails WHERE odrdtsvdCustID=" & Request.Cookies("sfCustomer")("custID") & " AND odrdtsvdProductID = '" & sProdID & "'" End If End Select Set rsSelectProd = Server.CreateObject("ADODB.RecordSet") rsSelectProd.Open sLocalSQL, cnn, adOpenKeyset, adLockOptimistic, adCmdText ' Check if this record exists through prodID and price matches If (rsSelectProd.BOF And rsSelectProd.EOF) Then 'No Records Matching, return -1 iLocalResult = -1 Else If bHasAttributes Then ' -- Debug Use -- Look what has been collected If vDebug = 1 Then Do While Not rsSelectProd.EOF Response.Write "

ID : " & rsSelectProd.Fields(sPrefix & "Id") & " AttrID :" & rsSelectProd.Fields(sAttrPrefix & "AttrID") rsSelectProd.MoveNext Loop End If rsSelectProd.MoveFirst iUpperBound = UBound(aProdAttr) ' Check that there are at least as many product attributes as there are rows If rsSelectProd.RecordCount < cInt(iProdAttrNum) Then getOrderID = -1 Else ' Start comparison of product attributes Do While Not rsSelectProd.EOF For iCounter = 0 to iUpperBound-1 sTmpAttr = aProdAttr(iCounter) ' If sTmpAttr is empty, the attribute specified is no longer available in the db If sTmpAttr = "" or rsSelectProd.EOF Then getOrderID = "" Exit Function Else If cStr(sTmpAttr) = cStr(rsSelectProd.Fields(sAttrPrefix & "AttrID")) Then bMatch = bMatch + 1 End If If vDebug = 1 Then Response.Write "

" & sTmpAttr & " VS " & rsSelectProd.Fields(sAttrPrefix & "AttrID") If vDebug = 1 Then Response.Write "
bMatch = " & bMatch If bMatch = cInt(iProdAttrNum) Then ' Return the Found Record getOrderID = rsSelectProd.Fields(sPrefix & "ID") Exit Function End If ' End sTmpAttr Empty If End If rsSelectProd.MoveNext Next ' Reset Match at end of Recordset bMatch = 0 ' Loop through recordset Loop ' End iProdAttrNum if End If ' Matched Product with No attributes Else getOrderID = rsSelectProd.Fields(sPrefix & "ID") Exit Function ' End Has Attributes If End If ' End RecordSet If End If closeObj(rsSelectProd) getOrderID = -1 End Function '--------------------------------------------------------------------- ' Returns the name, price, and type associated with the attribute ID '--------------------------------------------------------------------- Function getAttrDetails(iAttrID) Dim sLocalSQL, rsFindAttr, aLocalAttr sLocalSQL = "SELECT attrName, attrdtName, attrdtPrice, attrdtType FROM sfAttributeDetail INNER JOIN sfAttributes ON sfAttributes.attrID = sfAttributeDetail.attrdtAttributeId WHERE attrdtID = " & iAttrID Set rsFindAttr = Server.CreateObject("ADODB.RecordSet") rsFindAttr.Open sLocalSQL, cnn, adOpenDynamic, adLockOptimistic, adCmdText If rsFindAttr.BOF Or rsFindAttr.EOF Then If vDebug = 1 Then Response.Write "
Empty Recordset in getAttrNames" Else Redim aLocalAttr(4) aLocalAttr(0) = rsFindAttr.Fields("attrdtName") aLocalAttr(1) = rsFindAttr.Fields("attrdtPrice") aLocalAttr(2) = rsFindAttr.Fields("attrdtType") aLocalAttr(3) = rsFindAttr.Fields("attrName") End If closeObj(rsFindAttr) getAttrDetails = aLocalAttr End Function '--------------------------------------------------------------------- ' Returns the name, price, and type associated with the attribute ID of Old Order '--------------------------------------------------------------------- Function getAttrDetailsRetriveOrder(iAttrID) Dim sLocalSQL, rsFindAttr, aLocalAttr sLocalSQL = "SELECT odrattrAttribute, odrattrName, odrattrPrice, odrattrType FROM sfOrderAttributes WHERE odrattrID = " & iAttrID Set rsFindAttr = Server.CreateObject("ADODB.RecordSet") rsFindAttr.Open sLocalSQL, cnn, adOpenDynamic, adLockOptimistic, adCmdText If rsFindAttr.BOF Or rsFindAttr.EOF Then If vDebug = 1 Then Response.Write "
Empty Recordset in getAttrNames" Else Redim aLocalAttr(4) aLocalAttr(0) = rsFindAttr.Fields("odrattrAttribute") aLocalAttr(1) = rsFindAttr.Fields("odrattrPrice") aLocalAttr(2) = rsFindAttr.Fields("odrattrType") aLocalAttr(3) = rsFindAttr.Fields("odrattrName") End If closeObj(rsFindAttr) getAttrDetailsRetriveOrder = aLocalAttr End Function '--------------------------------------------------------------------- ' This function calculates the subtotal for attributes '--------------------------------------------------------------------- Function getAttrUnitPrice (dAttrTotal,sAttrPrice,iAttrType) ' Recalculate Price If iAttrType = 1 Then dAttrTotal = dAttrTotal + cDbl(sAttrPrice) ElseIf iAttrType = 2 Then dAttrTotal = dAttrTotal + cDbl(sAttrPrice)*(-1) End If getAttrUnitPrice = dAttrTotal End Function '------------------------------------------------------------------- ' Returns the recordset corresponding to a custId identifier '------------------------------------------------------------------- Function getRow(sTableName,sIdName,iID,cnn) Dim sLocalSQL, rsSet sLocalSQL = "SELECT * FROM " & sTableName & " WHERE " & sIdName & " = " & iID ' Object Creation Set rsSet = Server.CreateObject("ADODB.RecordSet") rsSet.Open sLocalSQL, cnn, adOpenForwardOnly, adLockOptimistic, adCmdText Set getRow = rsSet End Function '------------------------------------------------------------------- ' Gets records for tables with multiple records for one customer ID ' Returns the recordset '------------------------------------------------------------------- Function getRowActive(sTableName,sIdName,sActiveName,iID,cnn) Dim sLocalSQL, rsSet sLocalSQL = "SELECT * FROM " & sTableName & " WHERE " & sIdName & " = " & iID & " AND " & sActiveName & " = 1" ' Object Creation Set rsSet = Server.CreateObject("ADODB.RecordSet") rsSet.Open sLocalSQL, cnn, adOpenForwardOnly, adLockOptimistic, adCmdText Set getRowActive = rsSet End Function '-------------------------------------------------------------------- ' Function : getCreditCardList ' This returns the credit list in HTML format for dropdown box. '-------------------------------------------------------------------- Function getCreditCardList() Dim rsCCList, sLocalSQL, sCCList, iCounter sLocalSQL = "Select transID, transName From sfTransactionTypes WHERE transType = 'Credit Card' AND transIsActive = 1" Set rsCCList = Server.CreateObject("ADODB.RecordSet") rsCCList.Open sLocalSQL, cnn, adOpenKeyset, adLockOptimistic, adCmdText sCCList = "" For iCounter = 1 to rsCCList.RecordCount sCCList = sCCList & "" rsCCList.MoveNext Next getCreditCardList = sCCList closeObj(rsCCList) End Function '------------------------------------------------------- ' Compares email and password, then returns the ID of the customer ' Returns -1 for failed authentication '------------------------------------------------------- Function customerAuth(sEmail,sPassword,sType) Dim sLocalSQL, iCustID, rsGetID Select Case sType Case "strict" sLocalSQL = "SELECT custID FROM sfCustomers WHERE custEmail = '" & sEmail & "' AND custPasswd = '" & sPassword & "' AND custID = " & Session("custID") Case "loose" sLocalSQL = "SELECT custID FROM sfCustomers WHERE custEmail = '" & sEmail & "' AND custPasswd = '" & sPassword & "'" Case "loosest" sLocalSQL = "SELECT custID FROM sfCustomers WHERE custEmail = '" & sEmail & "'" Case else sLocalSQL = "SELECT custID FROM sfCustomers WHERE custEmail = '" & sEmail & "'" End Select If sEmail = "" Or sPassword = "" Then iCustID = -1 Else Set rsGetID = Server.CreateObject("ADODB.RecordSet") rsGetID.Open sLocalSQL,cnn,adOpenForwardOnly,adLockReadOnly,adCmdText If rsGetID.BOF Or rsGetID.EOF Or sEmail = "" Or sPassword = "" Then iCustID = -1 Else iCustID = rsGetID.Fields("custID") End If End If customerAuth = iCustID closeobj(rsGetID) End Function '------------------------------------------------------------------ ' Gets the InternetCash Merchant ID '------------------------------------------------------------------ Function getICashMercID() Dim sLocalSQL, rsICash, iID sLocalSQL = "SELECT trnsmthdLogin FROM sfTransactionMethods WHERE trnsmthdName = 'InternetCash'" Set rsICash = Server.CreateObject("ADODB.RecordSet") rsICash.Open sLocalSQL, cnn, adOpenForwardOnly, adLockReadOnly, adCmdText If rsICash.EOF or rsICash.BOF Then Response.Write "Error: No merchant ID set for Internet Cash in table sfTransactionMethods" Else iID = trim(rsICash.Fields("trnsmthdLogin")) End If closeobj(rsICash) getICashMercID = iID End Function '------------------------------------------------------------------ ' Gets shipping types '------------------------------------------------------------------ Function getShipped(sProdID) Dim rsProdShipped, SQL SQL = "SELECT prodShipIsActive FROM sfProducts WHERE prodID = '" & sProdID & "'" Set rsProdShipped = Server.CreateObject("ADODB.Recordset") rsProdShipped.Open SQL, cnn, adOpenForwardOnly, adLockReadOnly, adCmdText getShipped = rsProdShipped(0) closeObj(rsProdShipped) End Function '--------------------------------------------------------------- ' To see if it is a saved cart customer ' Returns a boolean value '--------------------------------------------------------------- Function CheckSavedCartCustomer(iCustID) Dim sSQL, rsTmp, bTruth sSQL = "SELECT custFirstName FROM sfCustomers WHERE custID=" & iCustID bTruth = false Set rsTmp = Server.CreateObject("ADODB.RecordSet") rsTmp.Open sSQL,cnn,adOpenDynamic,adLockOptimistic,adCmdText If NOT rsTmp.EOF Then If trim(rsTmp.Fields("custFirstName")) = "Saved Cart Customer" Then bTruth = true Else bTruth = false End If End If closeobj(rsTmp) CheckSavedCartCustomer = bTruth End Function '-------------------------------------------------------- ' Checks if Customer exists in customer table '-------------------------------------------------------- Function CheckCustomerExists(iCustID) Dim sSQL, rsCust, bExists sSQL = "SELECT custID FROM sfCustomers WHERE custID = " & iCustID Set rsCust = Server.CreateObject("ADODB.RecordSet") rsCust.Open sSQL, cnn, adOpenDynamic, adLockOptimistic, adCmdText If NOT rsCust.EOF Then If cInt(rsCust.Fields("custID")) > 0 Then bExists = true Else bExists = false End If Else bExists = false End If CheckCustomerExists = bExists End Function Function getCurrencyISO(slcid) Dim rsSelect dim sSql ,strLcid set rsSelect = server.CreateObject ("ADODB.Recordset") sSql = "Select slctvalLCID,slctvalCurrencyISO From sfSelectValues Where slctvalLCID = " & "'" & slcid & "'" rsSelect.Open sSql ,cnn,adOpenForwardOnly ,adLockReadOnly,adcmdtext getCurrencyISO = trim(rsSelect.Fields("slctvalCurrencyISO")) 'Response.Write getCurrencyISO & "what the" rsSelect.Close set rsSelect = nothing End Function %> <% '-------------------------------------------------------------------- ' StoreFront ' ' (c) 2000 LaGarde, Inc. All Rights Reserved. ' ' Design constants used for StoreFront '-------------------------------------------------------------------- '---- General Design Settings ---- Const C_BGCOLOR = "#FFFFFF" Const C_BKGRND = "" Const C_LINK = "#0000FF" Const C_VLINK = "#800080" Const C_ALINK = "#FF0000" Const C_BNRBKGRND = "but/banner_checkout.jpg" Const C_BNRBGCOLOR = "" Const C_WIDTH = "600" Const C_BORDERCOLOR1 = "" Const C_FORMDESIGN = "" '---- Top Banner ---- Const C_BGCOLOR1 = "#000000" Const C_BKGRND1 = "" Const C_FONTCOLOR1 = "#FFFFFF" Const C_FONTSIZE1 = "2" Const C_FONTFACE1 = "Arial" '---- Middle Top Banner ---- Const C_BGCOLOR2 = "#800000" Const C_BKGRND2 = "" Const C_FONTCOLOR2 = "#FFFFFF" Const C_FONTSIZE2 = "2" Const C_FONTFACE2 = "Arial" '---- Bottom Top Banner ---- Const C_BGCOLOR3 = "#FFFFFF" Const C_BKGRND3 = "" Const C_FONTCOLOR3 = "#000000" Const C_FONTSIZE3 = "2" Const C_FONTFACE3 = "Arial" '---- Content ---- Const C_BGCOLOR4 = "#FFFFFF" Const C_BKGRND4 = "" Const C_FONTCOLOR4 = "#000000" Const C_FONTSIZE4 = "2" Const C_FONTFACE4 = "Arial" '---- Content Bar ---- Const C_BGCOLOR5 = "#FFFFFF" Const C_BKGRND5 = "" Const C_FONTCOLOR5 = "#000000" Const C_FONTSIZE5 = "2" Const C_FONTFACE5 = "Arial" '---- Content Alternating Colors ---- Const C_ALTBGCOLOR1 = "#FFFFFF" Const C_ALTBKGRND1 = "" Const C_ALTFONTCOLOR1 = "#000000" Const C_ALTFONTSIZE1 = "2" Const C_ALTFONTFACE1 = "Arial" Const C_ALTBGCOLOR2 = "#FFFFFF" Const C_ALTBKGRND2 = "" Const C_ALTFONTCOLOR2 = "#000000" Const C_ALTFONTSIZE2 = "2" Const C_ALTFONTFACE2 = "Arial" '---- Footer ---- Const C_BGCOLOR7 = "#FFFFFF" Const C_BKGRND7 = "" Const C_FONTCOLOR7 = "#000000" Const C_FONTSIZE7 = "2" Const C_FONTFACE7 = "Arial" '---- Button Design Images ---- Const C_BTN01 = "but/go.gif" '--- Go Const C_BTN02 = "but/save_to_cart.gif" '--- Save to Cart Const C_BTN03 = "but/add_to_cart.gif" '--- Add to Cart Const C_BTN04 = "but/continue_shopping.gif" '--- Continue Search Const C_BTN05 = "but/checkout.gif" '--- Checkout Const C_BTN06 = "but/delete.gif" '--- Delete Const C_BTN07 = "but/save.gif" '--- Save Const C_BTN08 = "but/view_saved_order.gif" '--- View Saved Cart Const C_BTN09 = "but/continue_shopping.gif" '--- Return to Shop Const C_BTN10 = "but/shopping_cart.gif" '--- Shopping Cart (Order) Const C_BTN11 = "but/change_order.gif" '--- Change Cart Const C_BTN12 = "but/signup.gif" '--- Sign Up Const C_BTN13 = "but/shopping_cart.gif" '--- Shopping Cart Const C_BTN14 = "but/recalculate.gif" '--- Recalculate Const C_BTN15 = "but/help.gif" '--- Help Const C_BTN16 = "but/login.gif" '--- Login Const C_BTN17 = "but/forgot_password.gif" '--- Forgot Password Const C_BTN18 = "but/submit.gif" '--- Submit Const C_BTN19 = "but/new_account.gif" '--- New Account Const C_BTN20 = "but/continue.gif" '--- Verify Const C_BTN21 = "but/search.gif" '--- Search Const C_BTN22 = "but/add_to_cart.gif" '--- Add to Cart (Small) Const C_BTN23 = "but/clear_shipping_fields.gif" '--- Clear Shipping Info Const C_BTN24 = "but/e_mail_friend.gif" '--- Email A Friend %> <% '-------------------------------------------------------------------- ' StoreFront ' ' (c) 2000 LaGarde, Inc. All Rights Reserved. ' ' Design constants used for StoreFront Search Engine '-------------------------------------------------------------------- Const C_CategoryNameS = "Category" Const C_CategoryNameP = "Categories" Const C_ManufacturerNameS = "Manufacturer" Const C_ManufacturerNameP = "Manufacturers" Const C_VendorNameS = "Vendor" Const C_VendorNameP = "Vendors" Const C_ProductID = "Product ID" Const C_Description = "Description" Const C_Price = "Retail" Const C_QUANTITY = "Quantity" Const C_SPrice = "Sale Price" Const C_YSave = "Savings" Const C_DesignType = "3" Const C_CategoryIsActive = 1 Const C_VendorIsActive = 0 Const C_MFGIsActive = 0 Const C_AddedIsActive = 1 Const C_PriceIsActive = 1 Const C_SaleIsActive = 1 %> <% '@BEGINVERSIONINFO '@APPVERSION: 5.3001.0.2 '@FILENAME: product.asp ' '@DESCRIPTION: Include File for Product Page '@STARTCOPYRIGHT 'The contents of this file is protected under the United States 'copyright laws as an unpublished work, and is confidential and proprietary to 'LaGarde, Incorporated. Its use or disclosure in whole or in part without the 'expressed written permission of LaGarde, Incorporated is expressly prohibited. ' '(c) Copyright 2000 by LaGarde, Incorporated. All rights reserved. '@ENDCOPYRIGHT '@ENDVERSIONINFO Set rsAdmin = Server.CreateObject("ADODB.Recordset") SQL = "SELECT adminOandaID,adminActivateOanda FROM sfAdmin" rsAdmin.Open SQL, cnn,3,3 , 1 sUserName = rsAdmin("adminOandaID") iConverion = rsAdmin("adminActivateOanda") If iConverion = 1 Then Response.Write "" closeObj(rsAdmin) Function getProductInfo(sProdID, sCase) Dim SQL, rsProd, iAEcatID SQL = "SELECT * FROM sfProducts WHERE prodID = '" & sProdID & "'" Set rsProd = Server.CreateObject("ADODB.Recordset") rsProd.Open SQL, cnn, adOpenForwardOnly, adLockReadOnly, adCmdText If Not (rsProd.BOF and rsProd.EOF) Then Select Case sCase Case 1 getProductInfo = sProdID Case 2 getProductInfo = rsProd("prodName") Case 3 getProductInfo = rsProd("prodShortDescription") Case 4 getProductInfo = rsProd("prodDescription") Case 5 getProductInfo = rsProd("prodImageSmallPath") Case 6 getProductInfo = rsProd("prodImageLargePath") Case 7 getProductInfo = rsProd("prodLink") Case 8 getProductInfo = rsProd("prodPrice") Case 9 getProductInfo = rsProd("prodSalePrice") Case 10 Set rs = Server.CreateObject("ADODB.Recordset") If Application("AppName")="StoreFrontAE" then SQL = "SELECT subcatCategoryId FROM sfSubCatDetail WHERE prodID = '" & rsProd("prodId") & "'" rs.Open SQL, cnn, adOpenForwardOnly, adLockReadOnly, adCmdText iAEcatID = rs("subcatCategoryId") rs.close SQL = "SELECT CatHierarchy FROM sfSub_Categories WHERE subcatID = " & iAEcatID rs.Open SQL, cnn, adOpenForwardOnly, adLockReadOnly, adCmdText getProductInfo = GetFullPath(rs("CatHierarchy"),2) Else SQL = "SELECT catName FROM sfCategories WHERE catID = " & rsProd("prodCategoryId") rs.Open SQL, cnn, adOpenForwardOnly, adLockReadOnly, adCmdText getProductInfo = rs(0) end if rs.Close Set rs = Nothing Case 11 Set rs = Server.CreateObject("ADODB.Recordset") SQL = "SELECT mfgName FROM sfManufacturers WHERE mfgID = " & rsProd("prodManufacturerId") rs.Open SQL, cnn, adOpenForwardOnly, adLockReadOnly, adCmdText getProductInfo = rs(0) rs.Close Set rs = Nothing Case 12 Set rs = Server.CreateObject("ADODB.Recordset") SQL = "SELECT vendName FROM sfVendors WHERE vendID = " & rsProd("prodVendorId") rs.Open SQL, cnn, adOpenForwardOnly, adLockReadOnly, adCmdText getProductInfo = rs(0) rs.Close Set rs = Nothing Case 15 getProductInfo = rsProd("prodSaleIsActive") Case Else Set rs = Server.CreateObject("ADODB.Recordset") SQL = "SELECT * FROM sfAttributes WHERE attrProdId = '" & sProdID & "'" rs.Open SQL, cnn, adOpenForwardOnly, adLockReadOnly, adCmdText sDetails = "" If Not (rs.EOF And rs.BOF) Then iCounter = 1 While Not rs.EOF sDetails = sDetails & "
" & rs("attrName") & "
" & getAttributeDetails(rs("attrID"), iCounter, sCase) rs.MoveNext iCounter = iCounter + 1 Wend End If getProductInfo = sDetails End Select Else Response.Write "Product Could Not Be Found" End If closeObj(rsProd) End Function Function getAttributeDetails(attrID, iCounter, sCase) Set rs = Server.CreateObject("ADODB.Recordset") SQL = "SELECT * FROM sfAttributeDetail WHERE attrdtAttributeId = " & attrID & " ORDER BY attrdtOrder" rs.Open SQL, cnn, adOpenForwardOnly, adLockReadOnly, adCmdText If sCase = 14 Then sTemp = "" & rs("attrdtName") & sAmount & "
" End If rs.MoveNext sChecked = "" Wend If sCase = 14 Then sTemp = sTemp & "" End If closeObj(rs) getAttributeDetails = sTemp End Function '--------------------------------AE CODE BELOW -------------------------------' Sub ShowGiftWrap(sProdID) dim gwprice gwprice = GetGiftWrapPrice(sProdID) if gwprice <> "X" then Response.Write "
" Response.Write "Gift wrap (add " & formatcurrency(gwprice) & " per item)" End if End Sub Sub ShowMTPricesLink(sProdId) Dim sql Dim rst Dim i sql = "Select * FROM sfMTPrices WHERE mtprodid= '" & sProdID & "' ORDER By mtIndex ASC" Set rst = Server.CreateObject("ADODB.RecordSet") rst.Open sql, cnn, adOpenStatic, adLockReadOnly, adCmdText If rst.recordcount > 0 then Dim spath,stype,jsvar sType = 0 sPath = "MTPrices.asp?sProdId=" & sProdID jsvar = "javascript:show_page(" & "'" & sPath & "')" %>
Check Volume Discounts <% End if CloseObj (rst) End Sub Function CheckShowStatus(strProductID) Dim sql, rst sql = "Select * FROM sfInventoryInfo WHERE invenProdID= '" & strProductID & "'" Set rst = Server.CreateObject("ADODB.RecordSet") rst.Open sql, cnn, adOpenStatic, adLockReadOnly, adCmdText If rst.recordcount <= 0 then CheckShowStatus = 0 exit function End If If rst("invenbStatus") = 1 then CheckShowStatus = 1 Else CheckShowStatus = 0 End If CloseObj (rst) End Function Function CheckInStock(strProductID) Dim sql, rst sql = "Select Sum(invenInstock) as instock FROM sfInventory WHERE invenProdID= '" & strProductID & "'" Set rst = Server.CreateObject("ADODB.RecordSet") rst.Open sql, cnn, adOpenStatic, adLockReadOnly, adCmdText If rst.recordcount <= 0 then CheckInStock = "X" 'error else CheckInStock= rst("Instock") End if CloseObj (rst) End Function Function CheckBackOrder(strProductID) Dim sql, rst sql = "Select * FROM sfInventoryInfo WHERE invenProdID= '" & strProductID & "'" Set rst = Server.CreateObject("ADODB.RecordSet") rst.Open sql, cnn, adOpenStatic, adLockReadOnly, adCmdText If rst.recordcount <= 0 then CheckBackOrder = 0 exit function End If IF rst("invenbBackOrder") <> 1 then CheckBackOrder = 0 Else CheckBackOrder = 1 End If If rst("invenbTracked") <> 1 then 'if inventory not tracked then no backorder either CheckBackOrder = 0 End If CloseObj(rst) End Function Sub ShowProductInventory (strProduct,sType) Dim ret ,instock, sPath,jsvar ret = CheckInventoryTracked (strProduct) If ret = 1 then If CheckShowStatus(strProduct) <> 1 then exit sub Instock = CheckInStock(strProduct) Select case instock case "X" 'inventory not tracked for this product case 0 'inventory tracked If sType = "Dynamic" Then Response.Write "
Out of Stock!" If checkbackorder(strProduct) = 1 then %>
Click "Add to Cart" to BackOrder!<% End If End If case else sPath = "StockInfo.asp?sProdId=" & strProduct jsvar = "javascript:show_page(" & "'" & sPath & "')" If sType ="Dynamic" then %>
In Stock!<% eLse %>
Stock Information<% end If End Select end if End sub Function CheckInventoryTracked(strProductID) Dim sql, rst sql = "Select * FROM sfInventoryInfo WHERE invenProdID= '" & strProductID & "'" Set rst = Server.CreateObject("ADODB.RecordSet") rst.Open sql, cnn, adOpenStatic, adLockReadOnly, adCmdText If rst.recordcount <= 0 then CheckInventoryTracked = 0 exit function End If If rst("invenbTracked") = 1 then CheckInventoryTracked = 1 Else CheckInventoryTracked = 0 End If CloseObj (rst) End Function Function GetGiftWrapPrice (strProductID) Dim rst,sql sql = "Select * FROM sfgiftwraps WHERE gwProdID= '" & strProductID & "'" Set rst = Server.CreateObject("ADODB.RecordSet") rst.Open sql, cnn, adOpenStatic, adLockReadOnly, adCmdText if rst.recordcount <= 0 then GetGiftWrapPrice = "X" CloseObj (rst) exit function end if if rst("gwActivate") = 0 then GetGiftWrapPrice = "X" CloseObj (rst) exit function end if GetGiftWrapPrice = rst("gwPrice") CloseObj (rst) End Function Private Function GetFullPath(Vdata,justMain) Dim sSql ,X Dim iCatId Dim sFirst Dim rsCat,rsSubCat Dim arrTemp ,bMain bMain = false if left(vData,4)= "none" then bMain = True arrTemp = split(vdata,"-") vdata = arrtemp(1) elseif vData = "" then GetFullPath = "" exit function elseif instr(Vdata,"-") = 0 then vData = vData end if arrTemp = split(vData,"-") Set rsCat = Server.CreateObject("ADODB.RecordSet") Set rsSubCat = Server.CreateObject("ADODB.RecordSet") rsSubCat.Open "sfSub_Categories",cnn,adOpenStatic,adLockReadOnly ,adcmdtable For X = 0 To UBound(arrTemp) rsSubCat.Requery if arrTemp(X)<> "" then rsSubCat.Find "SubCatId = " & CInt(arrTemp(X)) GetFullPath = GetFullPath & rsSubCat("SubCatName") & "-" end if Next sSql = "Select catName From sfCategories Where catId =" & rsSubCat("subcatCategoryId") rsCat.Open sSql,cnn,adOpenStatic,adLockReadOnly ,adcmdText if justmain = 1 then GetFullPath = rsCat("catName") else if bMain = True Then GetFullPath = rsCat("catName") else GetFullPath = rsCat("catName") & "-" & Left(GetFullPath, Len(GetFullPath) - 1) end if end if Set rsCat = Nothing Set rsSubCat = Nothing Exit Function End Function %> ToneSmith Electric Guitars 510 deluxe






 

ELECTRIC GUITARS - MODEL 510 DELUXE details



 

Body wood and finish:

  • Semi hollow Walnut, Cherry, Mahogany or Aspen body with figured Maple back (or choice)

  • Figured Maple top (or choice) available with bursts or semi-transparent color top and back
    (fully hollow X cavity routs on 320)

Neck:

  • Figured Maple with Ebony, Brazilian, Rosewood Cocobolo or Figured Maple fret board

  • Bound with Pearloid, Ivroid, Tortoise or your choice

  • Matching headstock

  • Pearloid or Tortoise overlay

  • Matching pick guard and binding

  • Burst or semi transparent gloss finish on back of neck

  • Diamond wing inlays with ToneSmith wings on the 12th fret

  • Tusq White graphite Nut.

Pickups and electronics:

  • ToneSmith/Lace Sensor mini hummers in the bridge and neck position with Lipstick Tube pickup in the middle

  • 6 way rotary pickup switch

Hardware:

  • Chrome or Gold Stop tail piece with roller bridge or Bigsby with roller bridge

/addproduct.asp" onSubmit="this.QUANTITY.quantityBox=true;return sfCheck(this);" name="1017">


<%=C_Price%>: <%= FormatCurrency(getProductInfo("1017", 8))%>
<%= getProductInfo("1017", 14)%>

Quantity:



Email a Friend

 

home  |  about us  |  electric guitars  |  bass guitars  |  our shop  |  artists  |  what's new
accessories   |   portfolio  |   in stock   |   dealer page  |  contact us

Copyright © 2002 ToneSmith Guitars

also see custom banjos at
www.nechville.com