<% 'Option Explicit %> <% ' Copyright (C) 1998-2005 Cyberstrong Internet Services, Inc. All Rights Reserved ' ' This file has been seeded with unique information at point of sale and ' is traceable to its purchaser. ' ' Your license agreement forbids the removal of this notice. ' ' Project Wide Customization Settings ' Dim cstRegNum, cstDatabaseName Dim gblVersionNo, cstBuildNum, cstServerType, Conn, TrialExpires Dim isTrialMode, TrialLockOk, BrowserIsMSIE, SessionPrefix, ConnectFailed Dim VBScriptVersion, ServerIsIIS4, eShopReturnValue, oRegExTest Dim FormURLFilter, ProductCodeFilter Dim User, Pass ' Version control ... gblVersionNo = CStr("5.1j") ' Free trial control ... TrialExpires = CStr("") ' TrialExpires = DateSerial(2004, 6, 30) TrialLockOk = False isTrialMode = CBool(TrialExpires <> "") ' CheckMandatoryComponents() - Check for existance of mandatory components... Public Sub CheckMandatoryComponents() On Error Resume Next Err.Clear Set oRegExTest = New RegExp If (Err) Then wl("

") wl(" safina eShop: RegEx Component Required: ") wl("You must install or activate the RegEx component on your server in order to use safina eShop. ") wl("Consult your server administrator or hosting company for assistance.") wl("

") Response.End Else Set oRegExTest = Nothing End If End Sub ' Check VBScript version on this machine ... VBScriptVersion = CDBl(ScriptEngineMajorVersion & "." & ScriptEngineMinorVersion) If (VbScriptVersion < 5.0) Then wl("

") wl(" safina eShop: VBScript Upgrade Needed: ") wl("safina eShop requires VBScript Version 5.0 or later to be installed on this server. " & _ "To obtain the most current version of VBScript visit") wl("the Microsoft Scripting Web site or ") wl("install Microsoft Internet Explorer 5.0 or later on this server.") wl(" You are currently running VBScript Version: " & ScriptEngineMajorVersion & "." & ScriptEngineMinorVersion) wl("

") Response.End End If ' Check for mandatory components ... Call CheckMandatoryComponents() ' Buffer responses to prevent "clicking" during page loads ... Response.Buffer = True ' Call user exit at start of page ... Call UserExit(usrStartPage, 0, 0, 0, 0, eShopReturnValue) ' Default server type is Microsoft Access cstServerType = CStr("MSAccess") ' Browser/Server type check ... BrowserIsMSIE = CBool(strContains(Request.ServerVariables("HTTP_USER_AGENT"), "MSIE")) ServerIsIIS4 = CBool(strContains(Request.ServerVariables("SERVER_SOFTWARE"), "IIS/4")) Server.ScriptTimeOut = 300 Session.TimeOut = 35 ' eShop Constants ... Const MaxShoppingCartItems = 100 Const ShoppingCartAttributes = 25 ' Disk access constants ... Const ForReading = 1 Const ForWriting = 2 Const ForAppending = 8 ' Constants for aryCart (index 1) ... Const cartProductID = 1 ' Product ID Const cartProductCode = 2 ' Product's code Const cartProductName = 3 ' Product's name Const cartProductDescription = 4 ' Short product description Const cartProductDescriptionLong = 5 ' Long product description Const cartItemQuantity = 6 ' How many ordered Const cartMinQuantity = 7 ' Min order qty allowed Const cartCategory = 8 ' Product in these categories Const cartUnitPrice = 9 ' Unit price Const cartTotalPrice = 10 ' Qty * UnitPrice Const cartOptions = 11 ' Selected options Const cartProductShipsFree = 12 ' Product ships free Const cartShippingUnits = 13 ' Weight of item Const cartItemType = 14 ' usr/dsc/cpn. Const cartDiscountName = 15 ' Discount name Const cartDownloadFileName = 16 ' For digital downloading Const cartDeleted = 17 ' Flag set to 'y' during delete Const cartAllowAmountEdit = 18 ' "Yes" if shopper can change unit price Const cartTaxOverride = 19 ' Tax override amount (%), may be zero Const cartCoupons = 20 ' Product qualifies for this coupon list Const cartNotes = 21 ' Administrator's product notes Const cartNSN = 22 ' Administrator's product notes Const cartPackaging = 23 ' Const cartSKU = 24 ' Const larryNotes = 25 ' ' Field type constants ... Const TypeInteger = 3 Const TypeDouble = 5 Const TypeCurrency = 6 Const TypeText = 200 Const TypeWText = 202 Const TypeMemo = 201 Const TypeWMemo = 203 Const TypeDate = 135 ' User exits (active) ... Const usrCalcTaxableTotal = 1 Const usrAdjustCart = 2 Const usrGetDBPath = 3 Const usrFormatOption = 4 Const usrDisplayCategoryDDB = 5 Const usrGetConnectString = 6 Const usrAdjustConfig = 7 Const usrOrderComplete = 8 Const usrShipMsgAdjust = 9 Const usrShipNotify = 10 Const usrPmtAuthorized = 11 Const usrStartPage = 12 Const usrGetAdminFolderName = 13 Const usrLinkToGiftReg = 14 ' User exits (discontinued) ... Const usrCalcTaxRate = 0 ' Payment gateway return codes ... Const pmtApproved = 1 ' Payment request was approved Const pmtDeclined = 2 ' Payment request was declined Const pmtFailed = 3 ' Payment request failed Const pmtPending = 4 ' Payment request pending (ie: PayPal) Const pmtCancelled = 5 ' Payment request cancelled (by user) Const pmtLink = 6 ' Payment gateway is HTML link style Const pmtDirect = 7 ' Payment gateway is direct style ' Constants for gateway Supports method ... Const pmtCardNumberPassing = 10 ' Supports CC number passing to gateway Const pmtNoRedirect = 11 ' Gateway callback cannot support redirects on callback ' CDOSYS constants ... Const cdoSendUsingMethod = "http://schemas.microsoft.com/cdo/configuration/sendusing" Const cdoSMTPConnectionTimeout = "http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout" Const cdoSMTPAuthenticate = "http://schemas.microsoft.com/cdo/configuration/smtpauthenticate" Const cdoSendUserName = "http://schemas.microsoft.com/cdo/configuration/sendusername" Const cdoSendPassword = "http://schemas.microsoft.com/cdo/configuration/sendpassword" Const cdoSMTPServer = "http://schemas.microsoft.com/cdo/configuration/smtpserver" Const cdoSMTPServerPort = "http://schemas.microsoft.com/cdo/configuration/smtpserverport" Const cdoBasic = 1 Const cdoAnonymous = 0 Const cdoSendUsingPort = 2 ' URL and form field filter ... FormURLFilter = "^[/ :0-9A-Za-z_\-\.]*$" ' Product code filter. Must be a proper subset of FormURLFilter ... ProductCodeFilter = "^[0-9A-Za-z_\-\.\/]*$" ' Shopping cart array ... Dim aryCart ReDim aryCart(ShoppingCartAttributes, MaxShoppingCartItems) ' Used during shopping cart Add operations ... Dim aryCartData ReDim aryCartData(ShoppingCartAttributes) ' eShop Paths. We use fully qualified paths internally in ASP, but relative ' paths in HTML code so that users cannot "view source" to see internal paths. Dim RootPath ' A fully qualified file path to the root folder of safina eShop Dim RootHTTPPath ' A fully qualified HTTP path to the root folder of safina eShop Dim ResourcePath ' A relative path to the root folder of safina eShop Dim AdminFolder ' The name of the admin folder Dim aryTemp ' Temporary variable Dim isInAdmin ' True when running inside the admin area RootPath = LCase(Replace(Server.MapPath("DummyFileName"), "\DummyFileName", "")) RootHTTPPath = Request.ServerVariables("SERVER_NAME") & Request.ServerVariables("SCRIPT_NAME") RootHTTPPath = Left(RootHTTPPath, InStrRev(RootHTTPPath, "/")) RootHTTPPath = IIF(LCase(Request.ServerVariables("HTTPS")) = "on", "https://", "http://") & RootHTTPPath ' Get admin folder name... AdminFolder = "admin" Call UserExit(usrGetAdminFolderName, 0, 0, 0, 0, AdminFolder) If (FileExists("10Browse.asp")) Then ' Running in cart area ... isInAdmin = False RootPath = RootPath & "\" ResourcePath = "" Else ' Running in admin area, remove admin folder name from path ... isInAdmin = True aryTemp = Split(RootPath, "\") RootPath = Left(RootPath, InStrRev(RootPath, "\")) RootHTTPPath = Replace(RootHTTPPath, aryTemp(UBound(aryTemp)) & "/", "") ResourcePath = "../" End If ' Feature registry ... Dim FeatureInstalled Set FeatureInstalled = CreateObject("Scripting.Dictionary") %> <% ' Session variable prefix, allows multile carts to run on a single domain. ' Here because this code depends upon config.asp running first. Dim sesInit, sesCartCreate, sesItemCount, sesShoppingCart, sesCustomerID, sesLoginOk SessionPrefix = cstCatalogName sesInit = SessionPrefix & "Init" sesCartCreate = SessionPrefix & "CartCreate" sesItemCount = SessionPrefix & "ItemCount" sesShoppingCart = SessionPrefix & "ShoppingCart" sesCustomerID = SessionPrefix & "CustomerID" sesLoginOk = SessionPrefix & "LoginOk" ' Our Session table, like Microsoft's but separates carts running on the same domain ... Dim OurSession Set OurSession = CreateObject("Scripting.Dictionary") If (IsObject(Session(SessionPrefix & "OurSession"))) Then Set OurSession = Session(SessionPrefix & "OurSession") End If %>