<% ' Comersus Shopping Cart ' Comersus Open Technologies ' United States ' Software License can be found at License.txt ' http://www.comersus.com ' Details: list items according to filtering %> <% ' Comersus Sophisticated Cart ' Comersus Open Technologies ' USA - 2006 ' http://www.comersus.com ' Details: main initial settings (other settings can be found in database) %> <% dim pDatabaseConnectionString, pSupportErrorEmailFrom, pSupportErrorSMTP, pSupportErrorEmailComponent, pSupportErrorShowDetails, pTrapDbErrors, pIdStore ' storeFront Version (don't change this constant) private const pStoreFrontVersion = "7.095" ' Options: Windows or unix/linux private const pServerOS = "windows" ' database (access, sqlserver, mysql) private const pDataBase = "access" ' input string filterin type (1-3 being 1 hard, 3 light) pFilteringLevel = 1 ' id # if you have several stores connected to the same database pIdStore = 1 ' Alternate connection strings (change only for SQl Server, mySQL or if you get errors with Access) ' SQL Server local or remote IP in SERVER= ' pDatabaseConnectionString = "Driver={SQL Server};UID=comersus;password=123456;DATABASE=comersus6;SERVER=127.0.0.1" ' mySQL Server 2.5 ' pDatabaseConnectionString = "Driver={mySQL};Server=localhost;database=comersus;Uid=Root;Pwd=" ' mySQL Server 3.51 local ' pDatabaseConnectionString = "Driver={MySQL ODBC 3.51 Driver};Server=localhost;database=comersus;user=root;password=;OPTION=3" ' DSN connection, you must define the DSN first in your server ' pDatabaseConnectionString = "DSN=comersus" ' DSN less connection pDatabaseConnectionString = "Driver={Microsoft Access Driver (*.mdb)};DBQ=" &server.MapPath("/comersus7F/database/comersus.mdb")&";" ' Email Settings for Support Error script (if there's a DB error, this data cannot be retrieved from the DB) pSupportErrorEmailFrom = "you@yourDomain.com" pSupportErrorSMTP = "smtp.yourDomain.com" pSupportErrorEmailComponent = "Jmail" ' options are Jmail, ServerObjectsASPMail1, ServerObjectsASPMail2, PersitsASPMail, CDONTS and BambooSMTP pSupportErrorShowDetails = -1 ' error debug level, trap common DB errors pTrapDbErrors=0 %> <% ' Comersus Sophisticated Cart ' Comersus Open Technologies ' USA - 2006 ' http://www.comersus.com ' Details: Get one setting key %> <% function getSettingKey(pSettingKey) dim rstempGetSetting mySQL="SELECT settingValue FROM settings WHERE settingKey='" &pSettingKey& "' AND idStore=" &pIdStore call getFromDatabase(mySQL, rstempGetSetting, "getSettingKey") if not rstempGetSetting.eof then getSettingKey=rstempGetSetting("settingValue") else getSettingKey="" end if end function %> <% ' Comersus Sophisticated Cart ' Comersus Open Technologies ' USA - 2006 ' http://www.comersus.com ' Details: all session functions %> <% ' Comersus Sophisticated Cart ' Comersus Open Technologies ' USA - 2006 ' http://www.comersus.com ' Details: date functions %> <% function MediumDate (str) Dim aDay, aMonth, aYear aDay = Day(str) aMonth = Monthname(Month(str),True) aYear = Year(str) MediumDate = aDay & "-" & aMonth & "-" & aYear end Function function formatDate(originalDate) if pDateSwitch="-1" then formatDate=mid(originalDate,4,2)&"/"&mid(originalDate,1,2)&"/"&right(originalDate,4) else formatDate=originalDate end if end function function fixDate(pNewFormat) pToken1 = inStr(pNewFormat, "/") pToken2 = inStr(mid(pNewFormat,pToken1+1, len(pNewFormat)) , "/" ) pPart1 = mid(pNewFormat,1,pToken1-1) pPart2 = mid(pNewFormat,pToken1+1,pToken2-1) pPart3 = mid(pNewFormat,pToken2+pToken1+1,len(pNewFormat)) if len(pPart1) = 1 then pPart1 = "0" & pPart1 end if if len(pPart2) = 1 then pPart2 = "0" & pPart2 end if if len(pPart3) = 2 then pPart3 = "20" & pPart3 end if pNewFormat = pPart1 & "/" & pPart2 & "/" & pPart3 fixDate = pNewFormat end function function getServerDateFormat() if datediff("d","01/11/2005","01/12/2005")=1 then getServerDateFormat="MM/DD/YYYY" else getServerDateFormat="DD/MM/YYYY" end if end function %> <% ' Comersus Sophisticated Cart ' Comersus Open Technologies ' USA - 2006 ' http://www.comersus.com ' Details: miscellaneous functions %> <% ' discount code Generator (65^n) function DiscountCodeGenerator(n) dim s randomize() s="1234567890AaBbCcDdEeFfGgHhIiJjKkLlMmNnOoPpQqRrSsTtUuVvWwXxYyZz" do a="" for i = 1 to n a = a + mid(s,cint(rnd()*len(s))+1,1) next ' search if the code is being used mySQL = "SELECT discountCode FROM discounts WHERE discountCode='" &a& "'" call getFromDatabase (mySql, rsTemp3, "miscFunctions") ' eof implies that the code is available loop until rstemp3.eof DiscountCodeGenerator = cstr(a) end function ' randomNumber function, generates a number between 1 and limit function randomNumber(limit) randomize randomNumber=int(rnd*limit)+1 end function ' min value function min(byval value1, byval value2) if value1>value2 then min = value2 else min = value1 end if end function function getMax(arrProducts) dim tempMax, k tempMax=0 for k=0 to uBound(arrProducts) if arrProducts(k,7)>tempMax then tempMax=arrProducts(k,7) next getMax=tempMax end function function getPopularity(currentPopularity, maxPopularity) ' to avoid errors if maxPopularity=0 then maxPopularity=1 getPopularity=int(currentPopularity*4/maxPopularity) end function function removePrefix(input,prefix) removePrefix="" if input<>"" and prefix<>"" then dim longPrefix longPrefix =len(prefix)+1 removePrefix =mid(input,longPrefix) end if end function function saveCookie() response.cookies("test")="-1" end function function readCookie() if request.cookies("test")<>"-1" then readCookie=0 else readCookie=-1 end if end function function writeLog(line, file) set FSO = Server.CreateObject("scripting.FileSystemObject") set myFile = fso.OpenTextFile(file, 8, true) myFile.WriteLine(line) myFile.Close end function sub parseShipmentMethod(pPlainString, pShipmentDesc, pShipmentPrice) pByPassShipping=getSettingKey("pByPassShipping") if pByPassShipping="0" then arrayShipment=split(pPlainString,"%%") pShipmentDesc =arrayShipment(0) pShipmentPrice =Cdbl(arrayShipment(1))+Cdbl(arrayShipment(2)) if pChangeDecimalPoint="-1" then pShipmentPrice=replace(pShipmentPrice,".",",") end if else pShipmentPrice =0 pShipmentDesc ="" end if end sub function getShipmentString(pShipmentIndex, pIdDbSession) dim rstemp3 pByPassShipping=getSettingKey("pByPassShipping") getShipmentString="" if pByPassShipping="0" then mySQL = "SELECT sessionData FROM dbSession WHERE idDbSession=" &pIdDbSession call getFromDatabase (mySql, rsTemp3, "getShipmentString") if not rstemp3.eof then pSessionData=rstemp3("sessionData") ' parse rows arrayRows=split(pSessionData,"||") ' retrieve index getShipmentString=arrayRows(pShipmentIndex) end if end if end function sub checkRentalAvailability(pIdProduct, pFrom, pUntil, pIsAvailable, pReason, pQuantity) pQuantity =datediff("d",pFrom,pUntil) if pQuantity<1 then pReason="Rental interval is not correct. Please check date format." pIsAvailable=0 end if ' get availability mySQL="SELECT * FROM rentals WHERE idProduct="&pIdProduct call getFromDatabase(mySQL, rstemp, "comersus_rentalListAvailability.asp") do while not rstemp.eof pLimitFF=datediff("d",pFrom,rstemp("fromDate")) pLimitFU=datediff("d",pFrom,rstemp("untilDate")) pLimitUF=datediff("d",pUntil,rstemp("fromDate")) pLimitUU=datediff("d",pUntil,rstemp("untilDate")) if pLimitFF<=0 and pLimitFU>=0 then pReason="From date reserved" pIsAvailable=0 end if if pLimitUF<=0 and pLimitUU>=0 then if pReason<>"" then pReason=pReason&" and " pReason="End date reserved" pIsAvailable=0 end if rstemp.movenext loop end sub function getStateName(pStateCode) dim rstempgSN mySQL="SELECT stateName FROM stateCodes WHERE stateCode='"&pStateCode&"'" call getFromDatabase(mySQL, rstempgSN, "getStateName()") if not rstempgSN.eof then getStateName=rstempgSN("stateName") else getStateName="-" end if end function function getCountryName(pCountryCode) dim rstempgSN mySQL="SELECT countryName FROM countryCodes WHERE countryCode='"&pCountryCode&"'" call getFromDatabase(mySQL, rstempgSN, "getCountryName()") if not rstempgSN.eof then getCountryName=rstempgSN("countryName") else getCountryName="-" end if end function function isDownloadFile(pFile) isDownloadFile=0 if instr(pFile,".zip")<>0 then isDownloadFile=-1 end if if instr(pFile,".exe")<>0 then isDownloadFile=-1 end if if instr(pFile,".mp3")<>0 then isDownloadFile=-1 end if end function function checkAvailability() dim rstempgSN checkAvailability=0 mySQL="SELECT MAX(idOrder) AS maxIdOrder FROM orders" call getFromDatabase(mySQL, rstempgSN, "orderVerification") if not rstempgSN.eof then if rstempgSN("maxIdOrder")>50 then checkAvailability=-1 end if end if end function function getBonusPoints(pIdCustomer) dim mysql, rstemp getBonusPoints=0 ' retrieve available Bonus Points if pIdCustomer<>0 then ' get current points mySQL="SELECT bonusPoints FROM customers WHERE idCustomer=" &pIdCustomer call getFromDatabase(mySQL, rstemp, "orderVerify") getBonusPoints=rstemp("bonusPoints") end if end function function affiliateValid(pIdAffiliate) dim mysql, rstemp affiliateValid = Cint(1) if pIdAffiliate<>1 then ' check if idAffiliate is valid mySQL="SELECT idAffiliate FROM affiliates WHERE idAffiliate=" &pIdAffiliate call getFromDatabase(mySQL, rsTemp, "affiliateIsValid") if rsTemp.eof then affiliateValid = 0 end If end if end function function restBonusPoints(pBonusPoints, pIdCustomer) dim mysql, rstemp pBonusPoints=replace(pBonusPoints,",",".") mySQL="UPDATE customers SET bonusPoints=bonusPoints-" &pBonusPoints& " WHERE idCustomer="&pIdCustomer call updateDatabase(mySQL, rsTemp, "restBonusPoints") end function %> <% function sessionInit() ' makes an init over all session variables used if session("idCustomer")="" or isNull(session("idCustomer")) then session("language") = pDefaultLanguage session("idAffiliate") = Cint(1) session("idCustomer") = Cint(0) session("idCustomerType") = Cint(1) session("cartItems") = Cint(0) session("cartSubTotal") = CDbl(0) session("idDbSession") = Cint(0) session("idDbSessionCart") = Cint(0) ' now check if the client browser supports session variables if session("idCustomer")<>0 then response.redirect "comersus_message.asp?message="&Server.Urlencode(getMsg(662,"It seems that your browser does not support Cookies. You need Cookies enabled to purchase in this store.")) end if sessionInit=-1 else sessionInit=0 end if end function function getSessionVariable(pSessionVariable, pDefault) ' try to get one session variable, if is empty, returns default value if session(pSessionVariable)="" or isNull(session(pSessionVariable)) then getSessionVariable=pDefault else getSessionVariable=session(pSessionVariable) end if end function function checkSessionData() pIdDbSession = getSessionVariable("idDbSession", 0) if Cdbl(pIdDbSession)=0 then ' dbSession not defined pRandomKey = randomNumber(99999999) pDbSessionDate = formatDate(Date()) mySQL="INSERT INTO dbSession (randomKey, sessionType, dbSessionDate) VALUES (" &pRandomKey& ",'web','" &pDbSessionDate& "')" call updateDatabase(mySQL, rsTemp, "sessionFunctions, checkSessionData") ' retrieve idDbSession mySQL="SELECT MAX(idDbSession) AS maxIdDbSession FROM dbSession WHERE randomKey=" &pRandomKey& " AND dbSessionDate='" &pDbSessionDate& "'" call getFromDatabase(mySQL, rsTemp, "sessionFunctions, checkSessionData") pIdDbSession=rstemp("maxIdDbSession") end if ' not NULL ' load in session session("idDbSession")=pIdDbSession checkSessionData = pIdDbSession end function function checkDbSessionCartOpen() dim pIdDbSession2 ' check if there is some cart open for current dbSession pIdDbSession2=getSessionVariable("idDbSession", 0) mySQL="SELECT idDbSessionCart FROM dbSessionCart WHERE idDbSession=" &pIdDbSession2& " AND cartOpen=-1 ORDER BY idDbSessionCart" call getFromDatabase(mySQL, rsTemp, "sessionFunctions") if rstemp.eof then checkDbSessionCartOpen = 0 else session("idDbSessionCart") = rstemp("idDbSessionCart") checkDbSessionCartOpen = rstemp("idDbSessionCart") end if end function function createNewDbSessionCart() pIdDbSession=getSessionVariable("idDbSession", 0) if pIdDbSession=0 then response.redirect "comersus_supportError.asp?error="&Server.UrlEncode("idDbSession was not defined while creating dbSessionCart. idDbSession:"&session("idDbSession")&" - Type:"&varType(session("idDbSession"))) end if mySQL="INSERT INTO dbSessionCart (idDbSession, cartOpen) VALUES (" &pIdDbSession& ",-1)" call updateDatabase(mySQL, rsTemp, "sessionFunctions, createNewDbSessionCart") ' retrieve idDbSession mySQL="SELECT MAX(idDbSessionCart) AS maxIdDbSessionCart FROM dbSessionCart WHERE idDbSession=" &pIdDbSession call getFromDatabase(mySQL, rsTemp, "sessionFunctions, createNewDbSessionCart") pIdDbSessionCart=rstemp("maxIdDbSessionCart") createNewDbSessionCart = pIdDbSessionCart end function function sessionLost() pIdDbSession = getSessionVariable("idDbSession", 0) if pIdDbSession=0 then sessionLost=-1 else sessionLost=0 end if end function %> <% ' Comersus Sophisticated Cart ' Comersus Open Technologies ' USA - 2006 ' http://www.comersus.com ' Details: functions to open and close db connection %> <% '-------------------------------------------------------------------- ' 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 %> <% sub openDb() if varType(connTemp)=0 or varType(connTemp)=1 then ' create the connection set connTemp = server.createObject("adodb.connection") connTemp.Open pDatabaseConnectionString if err.number <> 0 then response.redirect "comersus_supportError.asp?error="&Server.Urlencode("Error while opening DB read:"&Err.Description& "

Common solutions

1. Check that you haven't change default database path and name
2. Check that your web server has Access 97 or 2000 ODBC installed
3. Check that you have read, modify and delete permissions over database folder and database file
4. Open your database with Access program and select Repair Database option
5. Select other connection method like other connection string or DSN") end if end if end sub sub getFromDatabase(mySQL, rsTemp, scriptName) call openDb() set rsTemp = server.createObject("adodb.recordset") ' set locktype rsTemp.lockType = adLockReadOnly ' set the cursor rsTemp.cursorType = adOpenForwardOnly rsTemp.open mySQL, connTemp if err.number <> 0 then response.redirect "comersus_supportError.asp?error="&Server.Urlencode("Error in " &scriptName& ", error: "&Err.Description& " - Err.Number:"&Err.number&" - SQL:"&mySQL) end if end sub sub getFromDatabasePerPage(mySQL, rsTemp, scriptName) call openDb() set rsTemp = server.createObject("adodb.recordset") rsTemp.cursorLocation = adUseClient rsTemp.cacheSize = pNumPerPage rsTemp.open mySQL, connTemp if err.number <> 0 then response.redirect "comersus_supportError.asp?error="&Server.Urlencode("Error in " &scriptName& ", error: "&Err.Description& " - Err.Number:"&Err.number&" - SQL:"&mySQL) end if end sub sub getFromDatabaseSeek(mySQL, rsTemp, scriptName) call openDb() set rsTemp = server.createObject("adodb.recordset") rsTemp.cursorType = 3 rsTemp.lockType = 3 rsTemp.Open mySQL, connTemp if err.number <> 0 then response.redirect "comersus_supportError.asp?error="&Server.Urlencode("Error in " &scriptName& ", error: "&Err.Description& " - Err.Number:"&Err.number&" - SQL:"&mySQL) end if end sub sub updateDatabase(mySQL, rsTemp, scriptName) call openDb() set rsTemp=connTemp.execute(mySQL) if err.number <> 0 then response.redirect "comersus_supportError.asp?error="&Server.Urlencode("Update Error in " &scriptName& ", error: "&Err.Description& " - Err.Number:"&Err.number&" - SQL:"&mySQL) end if end sub function closeDB() on error resume next rsTemp.close set rsTemp = nothing connTemp.close set connTemp = nothing end function %> <% ' Comersus Sophisticated Cart ' Comersus Open Technologies ' USA - 2006 ' http://www.comersus.com ' Details: get screen message from database %> <% function getMsg(pIdScreenMessage, pMem) ' check if the product is inside the cart mySQL="SELECT screenMessage FROM screenMessages WHERE idScreenMessage=" &pIdScreenMessage& " AND idStore=" &pIdStore call getFromDatabase(mySQL, rstempMsg, "screenMessages") if not rstempMsg.eof then getMsg=rstempMsg("screenMessage") else getMsg="" end if end function %> <% ' Comersus Sophisticated Cart ' Comersus Open Technologies ' USA - 2005 ' http://www.comersus.com ' Details: misc currency functions %> <% function money(number) dim pos, indexPoint, moneyLarge, decPart, g if isNull(number) then money="0.00" else if pMoneyDontRound="-1" then money = number else money = round(number,2) end if if pDecimalSign="," then ' replace . by , money = replace(money,".",",") else ' replace , by . money = replace(money,",",".") end if if pMoneyDontRound="-1" then Pos=inStr(money,pDecimalSign) if Pos<>0 then money=mid(money,1,Pos+2) end if end if ' locate dec division indexPoint = instr(money, pDecimalSign) ' for integer, add .00 if indexPoint=0 then money = Cstr(money)+pDecimalSign+"00" end if ' calculate if 0 or 00 moneyLarge = len(money) decPart = right(money,moneyLarge-indexPoint) ' add to original numbers for g=0 to (1- (moneyLarge-indexPoint)) money = Cstr(money)+"0" next ' money=separatorMil(money) end if ' not empty end function ' use this function to display numbers like 125,000,000 function SeparatorMil(number) ' locate pDecimalSign position pDecimalSignExist = instr(number, pDecimalSign) - 1 if pDecimalSignExist <= 0 then pDecimalSignExist = len(number) end if ' add separatorMil to integers pCountNumbers = 0 if pDecimalSignExist > 3 then for indexPoint = pDecimalSignExist to 1 step -1 pNumber = mid(number,indexPoint,1) if pNumber <> pDecimalSign then pCountNumbers = pCountNumbers + 1 pSeparatorMil = pNumber & pSeparatorMil end if if pCountNumbers = 3 and (indexPoint > 1) then pSeparatorMil = "," & pSeparatorMil pCountNumbers = 0 end if pNumber = "" next ' add decimals pSeparatorMil = pSeparatorMil & mid(number, pDecimalSignExist+1, Len(number)) SeparatorMil = pSeparatorMil else SeparatorMil = number end if end function %> <% function isRental(idProduct) dim rsTempRental mySQL="SELECT rental FROM products WHERE idProduct="& pIdProduct call getFromDatabase(mySQL, rsTempRental, "isRental") isRental=0 if not rsTempRental.eof then if rsTempRental("rental")=-1 then isRental=-1 end if end function function isDonation(idProduct) dim rsTempDon mySQL="SELECT isDonation FROM products WHERE idProduct="& pIdProduct call getFromDatabase(mySQL, rsTempDon, "isRental") isDonation=0 if not rsTempDon.eof then if rsTempDon("isDonation")=-1 then isDonation=-1 end if end function function itHasDiscountPerQty(idProduct) dim rsTempDPQ mySQL="SELECT idDiscountperquantity FROM discountsPerQuantity WHERE idProduct=" &pIdProduct call getFromDatabase (mySql, rsTempDPQ, "itHasDiscountPerQty") if not rsTempDPQ.eof then itHasDiscountPerQty=-1 else itHasDiscountPerQty=0 end if end function function getIdAuction(pIdProduct) ' check for auctions dim rsTempAuction getIdAuction=0 mySQL="SELECT idAuction FROM auctions WHERE active=-1 AND idProduct=" &pIdProduct call getFromDatabase (mySql, rsTempAuction, "ViewItem") if not rsTempAuction.eof then getIdAuction=rsTempAuction("idAuction") else getIdAuction=0 end if end function function isBundleMain(idProduct) dim rsTempIBM mySQL="SELECT isBundleMain FROM products WHERE idProduct=" &pIdProduct call getFromDatabase (mySql, rsTempIBM, "itHasDiscountPerQty") if not rsTempIBM.eof then isBundleMain=rsTempIBM("isBundleMain") else isBundleMain=0 end if end function function getRateReview(pIdProduct) dim mysql, rsTempRv mySQL="SELECT SUM(stars) AS sumStars, COUNT(*) AS countReviews FROM reviews WHERE idProduct=" &pIdProduct& " AND active=-1" call getFromDatabase (mySql, rsTempRv, "viewItem") if not rsTempRv.eof then if Cint(rsTempRv("countReviews"))<>0 then getRateReview = cSng(rsTempRv("sumStars"))/cInt(rsTempRv("countReviews")) else getRateReview = 0 end if else getRateReview = 0 end if end function Function getOptionsGroups(pIdProduct) dim pIdOptionGroup, htmlToPrint, rsTempGEO1, rsTempGEO2 htmlToPrint="" pProductPrice = getPrice(pIdProduct, pIdCustomerType, pIdCustomer) ' get optionsGroups assigned mySQL = "SELECT idOptionGroup FROM optionsGroups_products WHERE idProduct=" & pIdProduct call getFromDatabase (mySql, rsTempGEO1, "itemFunctions") ' iterate through optionsGroups do while not rsTempGEO1.eof pType="" pIdOptionGroup = rsTempGEO1("idOptionGroup") ' get options inside current optionGroup mySQL = "SELECT options.priceToAdd, options.percentageToAdd, options.optionDescrip, options.idOption, optionsGroups.optionGroupDesc, type, options.imageUrl FROM optionsGroups, options_optionsGroups, options WHERE optionsGroups.idOptionGroup=" & Cstr(pIdOptionGroup) & " AND optionsGroups.idOptionGroup=options_optionsGroups.idOptionGroup AND options.idOption=options_optionsGroups.idOption ORDER BY options.optionDescrip" call getFromDatabase (mySql, rsTempGEO2, "itemFunctions") if not rsTempGEO2.eof then pType =lcase(rsTempGEO2("type")) pOptionGroupDesc =rsTempGEO2("optionGroupDesc") htmlToPrint=htmlToPrint&"
"& pOptionGroupDesc&"
" end if if pType="d" then htmlToPrint = htmlToPrint & "" & vbCrLf end if ' drop down optionals do while not rsTempGEO2.eof pImageUrl =rsTempGEO2("imageUrl") if pType="d" or pType="m" then htmlToPrint=htmlToPrint &"" & vbCrLf end if if pImageUrl<>"" then htmlToPrint=htmlToPrint & "" end if if pType="r" or pType="c" then htmlToPrint=htmlToPrint &"
" & vbCrLf end if rsTempGEO2.movenext loop if pType="d" or pType="m" then htmlToPrint=htmlToPrint &vbCrLf & "" end if if pType<>"" then htmlToPrint=htmlToPrint &"
" end if rsTempGEO1.movenext loop getOptionsGroups=htmlToPrint End Function function getSupplierName(idSupplier) dim rsTempGS mySQL="SELECT supplierName FROM suppliers WHERE idSupplier="& pIdSupplier call getFromDatabase(mySQL, rsTempGS, "isRental") if not rsTempGS.eof then getSupplierName=rsTempGS("supplierName") else getSupplierName="-" end if end function function getStock(pIdProduct) dim rsTempGS getStock=0 mySQL="SELECT stock.stock FROM products, stock WHERE products.idStock=stock.idStock AND products.idProduct="& pIdProduct call getFromDatabase(mySQL, rsTempGS, "getStock") if not rsTempGS.eof then getStock=rsTempGS("stock") end if end function function getCompleteStock(pIdStore2) dim rsTempGS getCompleteStock=0 mySQL="SELECT SUM(stock.stock) AS sumStock FROM products, stock WHERE products.idStock=stock.idStock AND products.idStore="& pIdStore2 call getFromDatabase(mySQL, rsTempGS, "getStock") if not rsTempGS.eof then getCompleteStock=rsTempGS("sumStock") end if end function function getCompleteStockForSupplier(pIdStore2, pIdSupplier) dim rsTempGS getCompleteStockForSupplier=0 mySQL="SELECT SUM(stock.stock) AS sumStock FROM products, stock WHERE products.idStock=stock.idStock AND products.idStore="& pIdStore2& " AND products.idSupplier="&pIdSupplier call getFromDatabase(mySQL, rsTempGS, "getStock") if not rsTempGS.eof then getCompleteStockForSupplier=rsTempGS("sumStock") end if end function function updateStock(pIdProduct, pQuantity) dim rsTempGS, pIdStock pIdStock=0 ' get idStock mySQL="SELECT idStock FROM products WHERE idProduct="& pIdProduct call getFromDatabase(mySQL, rsTempGS, "getStock") if not rsTempGS.eof then pIdStock=rsTempGS("idStock") end if ' update mySQL="UPDATE stock SET stock=stock+ " &pQuantity& " WHERE idStock="& pIdStock call updateDatabase(mySQL, rsTempGS, "getStock") end function sub replaceStock(pIdProduct, pQuantity) dim rsTempGS, pIdStock pIdStock=0 ' get idStock mySQL="SELECT idStock FROM products WHERE idProduct="& pIdProduct call getFromDatabase(mySQL, rsTempGS, "getStock") if not rsTempGS.eof then pIdStock=rsTempGS("idStock") end if ' update mySQL="UPDATE stock SET stock=" &pQuantity& " WHERE idStock="& pIdStock call updateDatabase(mySQL, rsTempGS, "getStock") end sub sub createStock(pIdProduct, pStock) dim rstemp ' insert stock record mySQL="INSERT INTO stock (idProductMain, stock) VALUES (" &pIdProduct& "," &pStock& ")" call updateDatabase(mySQL, rstemp, "createStock") ' retrieve ID mySQL="SELECT MAX(idStock) AS maxIdStock FROM stock WHERE idProductMain=" &pIdProduct call getFromDatabase(mySQL, rstemp, "comersus_backoffice_addproductexec.asp") pIdStock = rstemp("maxIdStock") ' update product record mySQL="UPDATE products SET idStock=" &pIdStock&" WHERE idProduct="&pIdProduct call updateDatabase(mySQL, rstemp, "createStock") end sub sub assignStockId(pIdProduct, pIdProductStock) dim rstemp ' get stock ID mySQL="SELECT idStock FROM stock WHERE idProductMain=" &pIdProductStock call getFromDatabase(mySQL, rstemp, "comersus_backoffice_addproductexec.asp") pIdStock = rstemp("idStock") mySQL="UPDATE products SET idStock="&pIdStock&" WHERE idProduct="&pIdProduct call updateDatabase(mySQL, rstemp, "createStock") end sub sub getImage(pImageUrl, pImageUrl2, pImageUrl3, pImageUrl4, pImage) if pImageUrl<>"" then if pImage=1 then %> <%if pZoomItemImage="-1" then%>
<%=pDescription%>


<%else%> <%=pDescription%> <%end if%> <% end if if pImage=2 then %> <%if pZoomItemImage="-1" then%>
<%=pDescription%>


<%else%> <%=pDescription%> <%end if%> <% end if if pImage=3 then %> <%if pZoomItemImage="-1" then%>
<%=pDescription%>


<%else%> <%=pDescription%> <%end if%> <% end if if pImage=4 then %> <%if pZoomItemImage="-1" then%>
<%=pDescription%>


<%else%> <%=pDescription%> <%end if%> <% end if if pImageUrl2<>"" then %>

<%=getMsg(672,"switch")%> 1 2<% end if if pImageUrl3<>"" then %> 3<% end if if pImageUrl4<>"" then %> 4<% end if else %><% end if end sub function getCategoryLevel(idCategory, level) dim mySql2, rstempLevel ' get parent mySql2="SELECT idParentCategory FROM categories WHERE idCategory=" &idCategory call getFromDatabase (mySql2, rstempLevel, "getCategoryLevel") if rstempLevel("idParentCategory")>1 then level=level+1 call getCategoryLevel(rstempLevel("idParentCategory"), level) else level=level+1 end if getCategoryLevel=level end function function itHasNoItemsInside(pIdCategory) dim mySql2, rstemp2 itHasNoItemsInside=0 mySql2="SELECT * FROM categories_products WHERE idCategory=" &pIdCategory call getFromDatabase (mySql2, rsTemp2, "itHasNoItemsInside") if rstemp2.eof then itHasNoItemsInside=-1 end if end function function getCategoryId(pCategoryDesc) dim mySql2, rstemp2 mySql2="SELECT idCategory FROM categories WHERE categoryDesc='" &pCategoryDesc&"'" call getFromDatabase (mySql2, rsTemp2, "itHasNoItemsInside") if not rstemp2.eof then getCategoryId=rstemp2("idCategory") else getCategoryId=0 end if end function function getCategoryPath(pIdCategory, pCategoryString) dim rsTemp1 mySQL="SELECT c2.idCategory, c2.categoryDesc FROM categories c1, categories c2 WHERE c1.idParentCategory=c2.idCategory AND c1.idCategory="&pIdCategory&" AND c2.idCategory>1" call getFromDatabase(mySQL, rsTemp1, "itemFunctions.asp") if not rsTemp1.eof then pCategoryString=pCategoryString &"|"& rstemp1("categoryDesc") if rstemp1("idCategory")>1 then call getCategoryPath(rstemp1("idCategory"),pCategoryString) end if end if end function function isCategoryLeaf(idCategory) isCategoryLeaf=0 mySQL="SELECT idCategory FROM categories WHERE idParentCategory="&idCategory call getFromDatabase(mySQL, rsTemp1, "comersus_backoffice_addproductform.asp") if rsTemp1.eof then isCategoryLeaf=1 end if end function sub addVariations(pOptionGroupDescrip, pOptionDescrip, pPriceToAdd, pPercentageToAdd, pIdProduct) dim rstemp, pIndex if pOptionGroupDescrip<>"" then arrayOptions =split(pOptionDescrip,",") arrayPrices =split(pPriceToAdd,",") arrayPercentage =split(pPercentageToAdd,",") ' verification if arrayOptions(0)="" then response.redirect "comersus_backoffice_message.asp?message="& Server.Urlencode("If you need variations please fill every variation in order") end if ' add option group mySQL="INSERT INTO optionsGroups (optionGroupDesc, type) VALUES ('" &pOptionGroupDescrip & "','D')" call updateDatabase(mySQL, rstemp, "itemFunctions.asp") ' retrieve optionGroupId mySQL="SELECT MAX(idOptionGroup) AS maxIdOptionGroup FROM optionsGroups WHERE optionGroupDesc='" & pOptionGroupDescrip& "'" call getFromDatabase(mySQL, rstemp, "itemFunctions.asp") if rstemp.eof then response.redirect "comersus_backoffice_message.asp?message="& Server.Urlencode("Cannot get option group ID") end if pIdOptionGroup=rstemp("maxIdOptionGroup") ' add options for f=0 to 2 if arrayOptions(f)<>"" and (arrayPrices(f) <> "" or arrayPercentage(f) <> "") then mySQL="INSERT INTO options (optionDescrip, priceToAdd, percentageToAdd) VALUES ('" & arrayOptions(f) & "'," & arrayPrices(f)& "," & arrayPercentage(f) & ")" call updateDatabase(mySQL, rstemp, "itemFunctions.asp") ' get idOption mySQL="SELECT MAX(idOption) AS maxIdOption FROM options WHERE optionDescrip='" & arrayOptions(f) & "'" call getFromDatabase(mySQL, rstemp, "itemFunctions.asp") if rstemp.eof then response.redirect "comersus_backoffice_message.asp?message="& Server.Urlencode("Cannot get option ID") end if pIdOption=rstemp("maxIdOption") ' assign to group mySQL="INSERT INTO options_optionsGroups (idOption, idOptionGroup) VALUES (" & pIdOption & "," & pIdOptionGroup & ")" call updateDatabase(mySQL, rstemp, "itemFunctions.asp") end if next ' assign group to product mySQL="INSERT INTO optionsGroups_products (idOptionGroup, idProduct) VALUES (" & pIdOptionGroup & "," & pIdProduct & ")" call updateDatabase(mySQL, rstemp, "itemFunctions.asp") end if ' filled end sub sub loadProductVariations(pIdProduct, arrayOptions1, arrayOptions2, pHiddenIdOptions, pOptionDescrip1, pOptionDescrip2, pIdOptionGroup1, pIdOptionGroup2) dim rstemp ' retrieve option groups mySQL="SELECT optionsGroups.idOptionGroup, optionGroupDesc FROM optionsGroups_products, optionsGroups WHERE optionsGroups.idOptionGroup=optionsGroups_products.idOptionGroup AND idProduct=" &pIdProduct call getFromDatabase(mySQL, rstemp, "getOptions") pIdOptionGroup1=0 pIdOptionGroup2=0 do while not rstemp.eof if pIdOptionGroup1=0 then pOptionDescrip1=rstemp("optionGroupDesc") pIdOptionGroup1=rstemp("idOptionGroup") else pOptionDescrip2=rstemp("optionGroupDesc") pIdOptionGroup2=rstemp("idOptionGroup") end if rstemp.movenext loop ' fill option arrays with default values for f=0 to 2 arrayOptions1(0,f)="" arrayOptions1(1,f)=0 arrayOptions1(2,f)=0 arrayOptions2(0,f)="" arrayOptions2(1,f)=0 arrayOptions2(2,f)=0 next ' retrieve options pHiddenIdOptions="" if pIdOptionGroup1<>0 then mySQL="SELECT optionDescrip, priceToAdd, percentageToAdd, options.idOption FROM options, options_optionsGroups WHERE idOptionGroup=" & pIdOptionGroup1 & " AND options.idOption=options_optionsGroups.idOption" call getFromDatabase(mySQL, rstemp, "getOptions") f=0 do while not rstemp.eof arrayOptions1(0,f) = trim(rstemp("optionDescrip")) arrayOptions1(1,f) = rstemp("priceToAdd") arrayOptions1(2,f) = rstemp("percentageToAdd") pHiddenIdOptions = pHiddenIdOptions & rstemp("idOption") &"," f=f+1 rstemp.movenext loop end if if pIdOptionGroup2<>0 then mySQL="SELECT optionDescrip, priceToAdd, percentageToAdd, options.idOption FROM options, options_optionsGroups WHERE idOptionGroup=" & pIdOptionGroup2 & " AND options.idOption=options_optionsGroups.idOption" call getFromDatabase(mySQL, rstemp, "getOptions") f=0 do while not rstemp.eof arrayOptions2(0,f) = trim(rstemp("optionDescrip")) arrayOptions2(1,f) = rstemp("priceToAdd") arrayOptions2(2,f) = rstemp("percentageToAdd") pHiddenIdOptions = pHiddenIdOptions & rstemp("idOption") &"," f=f+1 rstemp.movenext loop end if end sub sub removeVariations(pIdProduct, pIdOptionGroup1, pIdOptionGroup2, arrayIdOptions) dim rstemp mySQL = "DELETE FROM optionsGroups_products WHERE idProduct=" &pIdProduct call updateDatabase(mySQL, rstemp, "ItemFunctions, modify variations") mySQL = "DELETE FROM options_optionsGroups WHERE idOptionGroup=" & pIdOptionGroup1 &" OR idOptionGroup=" & pIdOptionGroup2 call updateDatabase(mySQL, rstemp, "ItemFunctions, modify variations") mySQL = "DELETE FROM optionsGroups WHERE idOptionGroup=" & pIdOptionGroup1 &" OR idOptionGroup=" & pIdOptionGroup2 call updateDatabase(mySQL, rstemp, "ItemFunctions, modify variations") mySQL = "DELETE FROM options WHERE idOption=99999999" for f=0 to uBound(arrayIdOptions) if arrayIdOptions(f)<>"" then mySQL=mySQL & " OR idOption=" & arrayIdOptions(f) end if next call updateDatabase(mySQL, rstemp, "ItemFunctions, modify variations") end sub function getCategoryStart(pIdStore) dim mysql, rsTempGC ' get category start from stores mySQL="SELECT idCategoryStart FROM stores WHERE idStore=" &pIdStore call getFromDatabase (mySql, rsTempGC, "itemFunctions") if not rsTempGC.eof then getCategoryStart=rsTempGC("idCategoryStart") else getCategoryStart=1 end if end function function getCategoryDescription(pIdCategory) dim mysql, rsTempGC ' get category start from stores mySQL="SELECT categoryDesc FROM categories WHERE idCategory=" &pIdCategory call getFromDatabase (mySql, rsTempGC, "itemFunctions") if not rsTempGC.eof then getCategoryDescription=rsTempGC("categoryDesc") else getCategoryDescription="N/A" end if end function function getPrice(pIdProduct, pIdCustomerType, pIdCustomer) dim pPrice, pBtoBPrice pPrice=0 pBtoBPrice=0 ' get price mySQL="SELECT price, bToBPrice FROM products WHERE idProduct=" &pIdProduct call getFromDatabase(mySQL, rstempSPrice, "specialPrices") if not rstempSPrice.eof then pPrice =rstempSPrice("price") pBtoBPrice =rstempSPrice("bToBPrice") end if if pIdCustomer<>0 then ' check if the customer has a special price for that product mySQL="SELECT specialPrice FROM customer_specialPrices WHERE idProduct=" &pIdProduct& " AND idCustomer="&pIdCustomer call getFromDatabase(mySQL, rstempSPrice, "specialPrices") if not rstempSPrice.eof then pPrice =rstempSPrice("specialPrice") pBtoBPrice =rstempSPrice("specialPrice") end if end if if pIdCustomerType=1 then getPrice=pPrice else getPrice=pBtoBPrice end if end function function getPriceByQty(pIdProduct, pIdCustomerType, pIdCustomer, quantity) dim pPrice, pBtoBPrice pPrice=0 pBtoBPrice=0 ' get price mySQL="SELECT price, bToBPrice FROM products WHERE idProduct=" &pIdProduct call getFromDatabase(mySQL, rstempSPrice, "specialPrices") if not rstempSPrice.eof then pPrice =rstempSPrice("price") pBtoBPrice =rstempSPrice("bToBPrice") end if ' discount per qty mySQL="SELECT discountPerUnit FROM discountsPerQuantity WHERE idProduct=" &pIdProduct& " AND quantityFrom<=" &quantity& " AND quantityUntil>=" &quantity call getFromDatabase(mySQL, rsTempDPQ, "cartRecalculate") if not rsTempDPQ.eof then pDiscountPerUnit = rsTempDPQ("discountPerUnit") pPrice = pPrice-pDiscountPerUnit pBtoBPrice = pBtoBPrice-pDiscountPerUnit else pDiscountPerUnit = 0 end if ' special price if pIdCustomer<>0 then ' check if the customer has a special price for that product mySQL="SELECT specialPrice FROM customer_specialPrices WHERE idProduct=" &pIdProduct& " AND idCustomer="&pIdCustomer call getFromDatabase(mySQL, rstempSPrice, "specialPrices") if not rstempSPrice.eof then pPrice =rstempSPrice("specialPrice") pBtoBPrice =rstempSPrice("specialPrice") end if end if if pIdCustomerType=1 then getPriceByQty=pPrice else getPriceByQty=pBtoBPrice end if end function %> <% ' Comersus Sophisticated Cart ' Comersus Open Technologies ' USA - 2006 ' http://www.comersus.com ' Details: string functions %> <% function getLoginField(input,stringLength) ' to filter login fields dim regEx Set regEx = New RegExp getLoginField = left(trim(input),stringLength) regEx.Pattern = "([^-_A-Za-z0-9@.])" regEx.IgnoreCase = True regEx.Global = True getLoginField = regEx.Replace(getLoginField, "") Set regEx = nothing end function function getScreenMessage(input,stringLength) ' to filter screenMessage dim regEx Set regEx = New RegExp getScreenMessage = left(trim(input),stringLength) regEx.Pattern = "([^-_A-Za-z0-9@., ])" regEx.IgnoreCase = True regEx.Global = True getScreenMessage = regEx.Replace(getScreenMessage, "") Set regEx = nothing end function function getUserInput(input, stringLength) dim newString, regEx Set regEx = New RegExp ' only specified length newString = left(trim(input),stringLength) if pFilteringLevel=1 then regEx.Pattern = "([^A-Za-z0-9@=:/*|' _-]+.%)" regEx.IgnoreCase = True regEx.Global = True newString = regEx.Replace(newString, "") Set regEx = nothing newString = replace(newString,"--","") newString = replace(newString,";","") newString = replace(newString,"'","'") newString = replace(newString," <%if pTitle<>"" then%> <%=pCompany%> :: <%=pTitle%> <%else%> <%=pCompany%> :: OnLine Store <%end if%> <%if pMetaDescription="" then%> <%else%> <%end if%> <%if pSearchKeywords="" or isNull(pSearchKeywords) then%> <%else%> <%end if%>
 
Bay Lobsters Lobsters and Seafood
Home About Us Products Ordering Info Recipes Contact Us Log In
Home Contact Ordering Info
24 hour fresh seafood
 
 Product Search
  


 Lucky Bucks

<%=getMsg(63,"Items listing")%> (<%=getMsg(64,"Search crit")%>: <%if pHotDeal<>"" then%> <%=getMsg(65,"Clearance")%> <%end if%> <%if pLastChance<>"" then%> <%=getMsg(147,"LC")%> <%end if%> <%if pOrderBy="sales" then%> <%=getMsg(66,"Top sel")%> <%end if%> <%if pIdSupplier<>"" then%> <%=getMsg(67,"Supplier list")%> <%end if%> <%if pIdCategory<>"" then%> <%=getMsg(284,"Category")%>  <%=getCategoryDescription(pIdCategory)%> <%end if%> <%if pStrSearch<>"" then%> <%=getMsg(68,"Kword")%> '<%=pStrSearch%>' <%end if%> <%if pUser1<>"" then%> <%=pProductCustomField1%> <%=pUser1%> <%end if%> <%if pUser2<>"" then%> <%=pProductCustomField2%> <%=pUser2%> <%end if%> <%if pUser3<>"" then%> <%=pProductCustomField3%> <%=pUser3%> <%end if%>  <%=getMsg(69,"ordered by")%>: <% select case pOrderBy case "descr" response.write getMsg(70,"desc") case "sku" response.write getMsg(71,"sku") case "visits" response.write getMsg(72,"popul") case "sales" response.write getMsg(73,"sales") case "recently" response.write getMsg(74,"rece added") case "" response.write getMsg(75,"no order") end select %> )

We are still testing our online ordering, however feel free to browse our products to see our selction of fresh fish. You have the option to email us your order at cindy@baylobsters.com or give us a call at (330) 486.0713

1 LB. Minimum per order - Due to the cost of fuel, we are currently charging a $2.50 fuel charge per delivery.

<% pCounter= 0 pColumnCounter=1 do while not rsTemp2.eof and pCounter< pNumPerPage pIdProduct = rsTemp2("idProduct") pSku = rsTemp2("sku") pDescription = rsTemp2("description") pListPrice = rsTemp2("listPrice") pSmallImageUrl = rsTemp2("smallImageUrl") pStock = getStock(pIdProduct) pIsBundleMain = rsTemp2("isBundleMain") pRental = rsTemp2("rental") pVisits = rsTemp2("visits") pDateAdded = rsTemp2("dateAdded") pMapPrice = rstemp2("map") pFreeShipping = rstemp2("freeShipping") pEmailText = rstemp2("emailText") pPrice = getPrice(pIdProduct, pIdCustomerType, pIdCustomer) %> <%if pColumnCounter=1 then%> <%end if%> <%if pColumnCounter=3 then%> <%end if%> <% pCounter= pCounter+ 1 pColumnCounter = pColumnCounter+1 if pColumnCounter=4 then pColumnCounter=1 end if rsTemp2.moveNext loop %> <%if pColumnCounter=2 then%> <%end if%> <%if pColumnCounter=3 then%> <%end if%>

<%if pSmallImageUrl<>"" then%> <%else%> <%end if%>
<%=pDescription%>
<%=getMsg(60,"visits")%>: <%=pVisits%> <%if pShowStockView="-1" then%> <%end if%> <%if pMapPrice = "-1" then%>
<%=getMsg(2,"price")%>: [<%=getMsg(745,"add to cart to find out")%>]
<%else%>
<%=getMsg(2,"price")%>: <%=pCurrencySign & money(pPrice)%>
<%end if%> <%if pCompareProducts="-1" then%> <%=getMsg(14,"> <%end if%> <%=getMsg(664,"> <%if pFreeShipping=-1 and (pRealTimeShipping="none" or pRealTimeShipping="ups") then%> <%=getMsg(32,"> <%end if%> <%if instr(pEmailText,".zip")<>0 then%> <%=getMsg(753,"> <%end if%>
  
 

<%if pOrderBy<>"sales" then%> <%=getMsg(10,"page")%> <%=pCurrentPage%> <%=getMsg(11,"of")%> <%=pTotalPages%> <%if pCurrentPage > 1 then%> <%end if%> <%if CInt(pCurrentPage) <> CInt(pTotalPages) then%> <%end if%> <%end if%> <%' show order-by only if is not last chance listing and top sellers%> <%if pLastChance="" and pOrderBy<>"sales" then%>  <%=getMsg(82,"Order by")%> <%=getMsg(83,"Desc")%> - <%=getMsg(84,"Sku")%> - <%=getMsg(85,"Pop")%> - <%=getMsg(86,"")%> <%end if%>
<% pPayPalExpressCheckout = getSettingKey("pPayPalExpressCheckout") pGoogleCheckoutLevel1 = getSettingKey("pGoogleCheckoutLevel1") %>
  <%if pIdCustomer=0 then%>
<%if pStoreFrontDemoMode="-1" then%>   <%else%>   <%end if%>

 
<%else%> Welcome back <%=session("customerName")%>

   Your Account
   Logout
<%end if%>
 
 
  <% ' Comersus Shopping Cart ' Comersus Open Technologies ' United States ' Software License can be found at License.txt ' http://www.comersus.com ' Details: get root categories %> <% pShowCategories = getSettingKey("pShowCategories") if pShowCategories="-1" then %> <% pIdCategoryStart=getCategoryStart(pIdStore) dim pCountCategories pCountCategories=0 ' get categories mySQL="SELECT idCategory, categoryDesc FROM categories WHERE idParentCategory=" &pIdCategoryStart& " AND active=-1 AND idCategory<>1 ORDER BY categoryDesc" call getFromDatabase (mySql, rsTempRoot, "getRootCategories") do while not rsTempRoot.eof and pCountCategories<8%> <% pCountCategories=pCountCategories+1 rsTempRoot.movenext loop %> <% end if%>
 
 
 
 
 
 
<%if pShowSearchBox="-1" then%> <%end if%>
 
 
 
 
 
 
 
 
 
  Get your Free Shopping Cart
 
Homeabout usproductsordering inforecipescontact usRegister 
 testimonialsprivacy policy <%'if pAuctions="-1" then%> <%'end if%> <%'if pNewsLetter="-1" then%> <%'end if%>
<%'if pAllowNewCustomer="-1" then%> <%'end if%> <%'if pSuppliersList="-1" then%> <%'end if%> <%'if pRssFeedServer="-1" then%> <%'end if%> <%'if pAffiliatesStoreFront="-1" then%> <%'end if%> <%'if pRssFeedServer="-1" then%> <%'end if%>
Copyright © 2008 BayLobsters. All rights reserved.
 
<%call closeDb()%>