<% @Language=VBScript %>
<%
'==============================================================
' This file contains the database configuration. It also opens
' a connection object (Conn) using OpenCnx.
' The file also contains some common function.
'==============================================================
'Global scope variables:
Dim conn 'Connection object
Dim dbPassword 'Database password
'===========================================================
' Sub: OpenCnx
' Desc: 'Opens connection conn if it is not already open.
' >>> Please, modify configuration with correct values <<<
'===========================================================
Sub OpenCnx (ByRef conn)
If NOT IsObject(conn) Then
On Error Resume Next
Dim ConnStr 'Connection string
Dim dbPassword 'Database password
Set conn = Server.CreateObject("ADODB.Connection")
dbPassword = "QS2003p" ' <<<< Change any new Access database password here.
'-------------------------------------------------------
'Pick ONE of the following configurations and comment the others
'For additional tech. info see
' - http://www.able-consulting.com/ADO_Conn.htm
'-------------------------------------------------------
'1. Configuration for System DSN
'ConnStr = "DSN=DSN_Name;uid=;pwd=" & dbPassword
'2. Configuration for file DSN (DSN-Less)
'ConnStr = "DBQ=d:\inetpub\quadcomm.com\db\store.mdb;Driver={Microsoft Access Driver (*.mdb)};uid=;pwd=" & dbPassword
'3. Configuration for OLEDB drivers (more efficient)
'a) Example of OLEDB connection with OLEDB 3.51 (if you have to use this one you may want to
'consider installing a newer version of MDAC
'ConnStr = "Provider=Microsoft.Jet.OLEDB.3.51; Data Source=C:\web\quadcomm\db\store.mdb; Jet OLEDB:Database Password=" & dbPassword
'b)Example of OLEDB connection on Windows 2000 server (version 4.0)
'ConnStr = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=C:\web\quadcomm\db\store.mdb; Jet OLEDB:Database Password=" & dbPassword
ConnStr = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=C:\Web\starquestpublishing\db\store2K.mdb; Jet OLEDB:Database Password=" & dbPassword
'c)Example of OLEDB connection on Windows 2000 server (version 4.0) and MS SQL Server 7.0/2000
'ConnStr = "Provider=SQLOLEDB; Data Source=(local); Initial Catalog=QShopDB; User ID=qshop_usr; Password=" & dbPassword
'ConnStr = "Provider=SQLOLEDB; Data Source=(local); Initial Catalog=Q-Shop; User ID=sa; Password="
'-------------------------------------------------------
conn.open ConnStr 'Open connection object
'-------------------------------------------------------
'When the site is working we recommend you to comment
'Option 1 and uncomment option 2
'-------------------------------------------------------
If conn.errors.count > 0 then
Dim counter
For counter = 0 to conn.errors.count-1
If int(conn.errors(counter).number) <> 0 Then
' Option 1
response.write "Error # : " & conn.errors(counter).number & ""
response.write "Error desc. : " & conn.errors(counter).description & "
"
If conn.errors(counter).number = -2147467259 Then
response.write "Suggestion: Check the connection string ConnStr in conx.asp and make sure that only one option is not commented using '.
"
End If
set conn = nothing
Response.End
'Option 2
'Redirect user to an error page if there is a connetion error.
set conn = nothing
Response.Redirect("connerror.htm")
Response.End
End If
next
conn.errors.Clear
End If
'If you leave the following line commented, all errors will be by-passed unless there is
'a line like this somewhere in the code.
On Error Goto 0
End If
End Sub
'===========================================================
' Sub: CloseCnx
' Desc: Closes and destroys connection object "conn".
'===========================================================
Sub CloseCnx (ByRef conn)
If IsObject(conn) Then
conn.close
set conn = nothing
End If
End Sub
'========================================================================
' Basic Currency Functions
'===========================================================
' Function: FormatPrice
' Desc: Returns a price formatted including taxes when tax
' model is EU and Show_VAT is enabled.
'===========================================================
Function FormatPrice (ByVal nCost, ByVal nTax, ByVal nTaxable)
If IsNumeric(nCost) Then
If Tax_ShowVAT = 1 AND Tax_Model = "EU" AND nTaxable = 1 Then
FormatPrice = FormatNumber(nCost * (1+nTax/100.0),2)
Else
FormatPrice = FormatNumber(nCost,2)
End If
Else
FormatPrice = "Error!"
End If
End Function
'===========================================================
' Function: FormatDefCurr (num)
' Desc: Returns a price formatted as currency using the default
' currency settings.
'===========================================================
Function FormatDefCurr (num)
'Formats a number (num) as a currency figure with 2 decimal digits
If IsNumeric(num) Then
FormatDefCurr = Replace(shop_DefCurName,"#",FormatNumber(num,2))
Else
FormatDefCurr = "Error!"
End If
End Function
'===========================================================
' Function: FormatSecCurr (ByVal num)
' Desc: Returns a price converted and formatted as currency
' using the secondary currency settings.
'===========================================================
Function FormatSecCurr (ByVal num)
'Converts and formats a number (num) as a secondary currency figure with 2 decimal digits
If IsNumeric(num) Then
FormatSecCurr = Replace(shop_SecCurName,"#",FormatNumber (num / (CDbl(shop_SecCurConv)),2))
Else
FormatDefCurr = "Error!"
End If
End Function
'===========================================================
' Function not currently used
'===========================================================
'Function FormatDefCurrTax (ByVal nCost, ByVal nTaxRate)
' If IsNumeric(nCost) AND IsNumeric(nTaxRate) Then
' FormatDefCurrTax = FormatDefCurr(nCost*(1+ntaxrate/100.0))
' Else
' FormatDefCurrTax = "Error!"
' End If
'End Function
'===========================================================
' Function: GetDBCurrentDateTime
' Desc: Returns the current date and time in a format
' accepted by the current database (Access or SQL Server)
'===========================================================
Function GetDBCurrentDateTime
Dim strDateDelim, dtDate
If shop_DB = "SQL" Then
strDateDelim = "" 'MS SQL Server
dtDate = "GETDATE()"
Else
strDateDelim = "#" 'MS Access
'Use with Access: It must be in US format MM/DD/YY regardless of local settings.
dtDate = Month(Date) & "/" & Day(Date) & "/" & Year(Date) & " " & Time
End If
'Build and return final date/time
GetDBCurrentDateTime = strDateDelim & dtDate & strDateDelim
End Function
'===========================================================
' Function: ParseInj
' Desc: Parses a string for SQL injection attacks.
'===========================================================
Function ParseInj(strIn)
ParseInj = Replace(strIn, "'", "''")
End Function
'===========================================================
' Function: RemoveHTML
' Desc: Removes HTML tags from a string
'===========================================================
Function RemoveHTML(sText)
Dim RegEx
Set RegEx = New RegExp
RegEx.Pattern = "<[^>]*>"
RegEx.Global = True
RegEx.IgnoreCase = True
RemoveHTML = RegEx.Replace(sText, "")
End Function
'========================================
'Create connection object
Call OpenCnx (conn)
'========================================
%>
<%
'-----------------------------------------------------------
' Q-Shop Parameter/Settings definition
' Developed by QuadComm Inc. for use with Q-Shop
' © Copyright QuadComm, Inc. 2003. All rights reserved
'-----------------------------------------------------------
'========================================================================
' CONSTANTS HARDCODED
'========================================================================
'=========================================
'Collect Credit Card Details
'=========================================
Dim bCollectCCDetails 'Indicates whether credit card details fields should be shown
'If True CC fields are collected and saved to the database (True|False)
'Use True when processing credit cards manually
'Choose of the two options and comment the other one:
bCollectCCDetails = False 'Display CC details fields
'bCollectCCDetails = True 'Don't display CC details fields
'=========================================
'=========================================
'Paypal configuration
'=========================================
Dim bEnablePaypal 'When True a paypal option will be displayed (True|False). (default is False)
'Choose of the two options and comment the other one:
bEnablePaypal = True 'Enable Paypal
'bEnablePaypal = False 'Disable Paypal
'=========================================
'=========================================
'Cash on Delivery (COD) configuration
'=========================================
Dim bEnableCOD 'When True a COD option will be displayed (True|False). (default is True)
'Choose of the two options and comment the other one:
'bEnableCOD = True 'Enable COD
bEnableCOD = False 'Disable COD
'=========================================
'=========================================
'External payment gateway link configuration
'=========================================
Dim bExtGateway 'Indicates whether the credit card payment is processed in an external site
'If True the credit card options including details won't be shown. (True|False)
'Choose of the two options and comment the other one:
'bExtGateway = True 'Use external gateway
bExtGateway = False 'No external gateway
'=========================================
'=========================================
'CC extra fields configuration
'=========================================
Dim bShow_CCIssueNumber 'Display issue number field? (True|False)
bShow_CCIssueNumber = False
Dim bShow_CVV 'Display CVV number field? (True|False)
bShow_CVV = True
Dim bShow_L4SSN 'Display last 4 SNN digits field? (True|False)
bShow_L4SSN = False 'Used for Transact-Secure with Authorize.Net
'=========================================
'=========================================
'Order email confirmation
'=========================================
Dim bSendMailConf 'Defines whether a mail confirmation should be sent (True|False). Default to True
bSendMailConf = True 'Default True: Send email confirmation message.
'========================================================================
'Get secure URL details. If there is a secure URL get the non-secure as well.
'========================================================================
Dim strNonSecPath
Dim strSecPath
strSecPath = Application("SECUREURL")
If strSecPath <> "" Then strNonSecPath = Application("URL")
'Hardcode if necessary:
'strSecPath = "https://www.secure-us.net/quadcomm/demo/"
'strNonSecPath = "http://quadcomm.com/demo/"
'========================================================================
'========================================================================
' Logo file paths. If you need to have content other than images, you can
' hardcode the value here.
'========================================================================
Dim LogoURL, smLogoURL, LineLogoURL
'URL of the main logo. Double quote all quote characters
'LogoURL = " user (used by the web server).
shop_TempPath = Application("TempPath") '***** CONFIGURE IN CONTROL PANEL *****
' Currency
shop_DefCurName = Application("DefCurName")
shop_SecCurName = Application("SecCurName")
shop_SecCurConv = Application("SecCurConv")
'Others
shop_CompanyName = Application("CompanyName")
shop_Mail = Application("Mail")
shop_Title = Application("Title")
If Application("ShowTerms") = "1" Then
shop_ShowTerms = True
Else
shop_ShowTerms = False
End If
If Application("StockControl") = "1" Then
shop_StockControl = True
Else
shop_StockControl = False
End If
shop_DB = Application("DBSystem")
shop_MailSystem = Application("MailSystem")
shop_URL = Application("URL") 'Shop base URL.
'If the URL doesn't end with "/" add it:
If RIGHT(shop_URL,1) <> "/" Then shop_URL = shop_URL & "/"
'Colour settings
Dim CART_HEAD_BG, CART_HEAD_FONT, CART_BODY_BG, LMENU_BG, LMENU_FONT, LMENU_SUB_FONT, TMENU_BG
Dim TMENU_FONT, SEC_BG, SEC_FONT, DETAILS_BG, DETAILS_HEAD_BG, DETAILS_HEAD_FONT
CART_HEAD_BG = Application("CART_HEAD_BG")
CART_HEAD_FONT = Application("CART_HEAD_FONT")
CART_BODY_BG = Application("CART_BODY_BG")
LMENU_BG = Application("LMENU_BG")
LMENU_FONT = Application("LMENU_FONT")
LMENU_SUB_FONT = Application("LMENU_SUB_FONT")
TMENU_BG = Application("TMENU_BG")
TMENU_FONT = Application("TMENU_FONT")
SEC_BG = Application("SEC_BG")
SEC_FONT = Application("SEC_FONT")
DETAILS_BG = Application("DETAILS_BG")
DETAILS_HEAD_BG = Application("DETAILS_HEAD_BG")
DETAILS_HEAD_FONT = Application("DETAILS_HEAD_FONT")
'Tax Settings
Dim Tax_Model, Tax_ShowVAT
Tax_Model = Application("Tax_Model") 'EU, US or CAN supported
Tax_ShowVAT = Application("Tax_ShowVAT") '1: Show VAT included.
'========================================================================
' DB Constant definitions (From adovbs.inc)
' Remove if including adovbs.inc
'========================================================================
'---- CursorTypeEnum Values ----
Const adOpenForwardOnly = 0
Const adOpenKeyset = 1
Const adOpenDynamic = 2
Const adOpenStatic = 3
'---- LockTypeEnum Values ----
Const adLockReadOnly = 1
Const adLockPessimistic = 2
Const adLockOptimistic = 3
Const adLockBatchOptimistic = 4
'---- CursorLocationEnum Values ----
Const adUseServer = 2
Const adUseClient = 3
'---- Other ----
Const adExecuteNoRecords = &H00000080
%>
<%= shop_Title %>
<%
'======================================================================================
' File: head.inc
' Description: This file produces the HTML for the definition of the top of all the
' shop pages. It also includes a call to the include file that creates
' the left hand side navigation bar leftinc.asp and until the creation of
' the cell that contains the main body of the pages.
'======================================================================================
' Initialise cat variable with the contents of Request("cat"). This holds current
' category/section
Dim strNav
If Request("cat") <> "" Then strNav = "cat=" & Request("cat") & "&path=" & Request("path")
%>
<%= LogoURL %>
Shipping and Handling costs:
Within the US
1 book
$6.00
2-4 books
$12.00
International
1 book
$18.00
2 books
$30.00
3 books
$42.00
4 books
$54.00
<%
'Close and destroy connection
Call CloseCnx(conn)
%>
Cart
Feedback
