<%
'==============================================================
' 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 & "
"
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 '.
" & aryOptions(2,j)
If CStr(aryOptions(4,j)) <> "" AND CStr(aryOptions(4,j)) <> "0" Then
strTemp = strTemp & " (" & strAddDisc & FormatDefCurr (FormatPrice(Abs(aryOptions(4,j)), aryOptions(6,j), aryOptions(5,j))) & ")" & vbCrLf
End If
strAddDisc = null
Next
strTemp = strTemp & " "
End If
WritePriceOptionsPrintable = strTemp
End Function
'=========================================================================
' Function: UnitPrs
' Returns units description. Currently only 1 is used
'=========================================================================
Function UnitPrs (cod)
if cod = 1 Then UnitPrs = "Unit/s"
if cod = 2 Then UnitPrs = "gr."
if cod = 3 Then UnitPrs = "Kg."
End Function
'=========================================================================
' Function: CutRFWord
' Trim and cut to nlength craracters max the Request.Form(name) passed.
'=========================================================================
Function CutRFWord (name, nlength)
Dim sTmp
sTmp = Left(Trim(Request.Form(name)),nlength)
If sTmp <> "" Then
CutRFWord = sTmp
Else
CutRFWord = Null
End If
End Function
'=========================================================================
' Function: ProdName
' Returns the name of a product with id cod
'=========================================================================
Function ProdName (cod)
Dim rs, sql
Set rs = Server.CreateObject("ADODB.Recordset")
sql= "SELECT Name FROM products WHERE ProdID = '" & cod & "'"
rs.Open sql,Conn, adOpenStatic, adLockOptimistic
If rs.EOF AND rs.BOF Then
ProdName = "Product deleted"
else
ProdName = rs("Name")
End If
rs.Close
set rs = nothing
End Function
'=========================================================================
' Function: DeleteCart
' Deletes cart with ID IDCart
'=========================================================================
Function DeleteCart (IDCart)
Dim rs, sql
sql= "DELETE FROM Carts WHERE CartID = '" & IDCart & "'"
set rs = Conn.Execute(sql)
set rs = nothing
End Function
'=========================================================================
' Function: CreateOrder
' Creates order from cart with ID = IDCart in the orders/orderlines tables
'Uses from form:
'TotalTax: Total taxes
'ShipCost: Shipping costr
'e-mail: Email address
'Password: Password
'Billing details
'Name: Customer's Name
'Surname: Customer's Surname
'Company: Customer's Company name
'Address: Customer's Address part 1
'Address2: Customer's Address part 2
'CP: Customer's Post Code/ZIP
'Town: Customer's City/Town
'Province: Customer's State or Province
'Country: Customer's Country
'Telephone: Customer's Telephone number
'mailme: Is customer subscribing to receive news and notifications? (True/False)
'rememberme:Does customer want to be logged in automatically next time? (True/False)
'Shipping/Recepient details
'DName: Ship to Name
'DAddress: Ship to Address part 1
'DAddress2: Ship to Address part 2
'DCompany: Ship to Company
'DCP: Ship to Post Code/ZIP
'DTown: Ship to City/Town
'DProvince: Ship to State or Province
'DTelephone:Ship to Telephone number
'DCountry: Ship to Country
'
'payment: Payment type (VISA,COD, etc)
'CCOwner Name on Credit Card
'CCNumber: Credit Card Number
'CCExpDateMonth: Credit Card Expiration date month
'CCExpDateYear: Credit Card Expiration date year
'CCIssueNumber: Credit Card Issue Number
'CCCVV: Credit Card verification number
'TaxId: Tax code (Tax ID) (eg VAT number)
'strUPS: String returned by UPS real time calculation module
'
'Comments: Customer order comments.
'Uses variables from prochkoutend.asp:
'PriceT: Products total cost
'Taxes: Order tax
'TotalTax: Tax rate
'ShipCost: Shipping cost applied
'PriceTG: Order total
'WeightT: Total products weight
'=========================================================================
Function CreateOrder (IDCart)
Dim rs, rsh, rsu, rsl, rsoid
Dim sql
Dim NewUSer
Dim OrderID
'Get cart
Set rs = Server.CreateObject("ADODB.Recordset")
sql= "SELECT Carts.*, Products.Name, PriceOptions.Description As PODescription " & _
"FROM (Carts INNER JOIN Products ON Carts.ProdID = Products.ProdID) " & _
"LEFT OUTER JOIN PriceOptions ON Carts.PriceOption = PriceOptions.id " & _
"WHERE CartID = '" & IDCart & "'"
rs.Open sql, Conn, adOpenStatic, adLockOptimistic
'Orders Headers DB: rsh
'Note: We query an impossible record to correct a possible
'wrong behaviour with Microsoft's DB drivers
Set rsh = Server.CreateObject("ADODB.Recordset")
rsh.Open "SELECT * from Orders WHERE (0 = 1)", Conn, adOpenKeySet, adLockOptimistic
'OrderLines DB: rsl
Set rsl = Server.CreateObject("ADODB.Recordset")
rsl.Open "SELECT * from Orderlines WHERE (0 = 1)", Conn, adOpenStatic, adLockOptimistic
'User Data: rsu
Set rsu = Server.CreateObject("ADODB.Recordset")
rsu.Open "SELECT * from Users WHERE UserID ='" & UserID & "'", Conn, adOpenStatic, adLockOptimistic
If rsu.EOF AND rsu.BOF Then
'If no data found create a new one
NewUSer = True
rsu.Close
rsu.Open "SELECT * from Users WHERE (1=0)", Conn, adOpenStatic, adLockOptimistic
Else
NewUser = False
End If
If NewUSer then rsu.AddNew
rsu("UserID") = UserID
If Request("Company") <> "" Then
rsu("Company") = CutRFWord("Company",50)
Else
rsu("Company") = Null
End If
rsu("Name") = CutRFWord("Name",50)
rsu("Surname") = CutRFWord("Surname",50)
rsu("Address") = CutRFWord("Address",100)
rsu("Address2") = CutRFWord("Address2",100)
rsu("CP") = CutRFWord("CP",10)
rsu("City") = CutRFWord("Town",50)
If Trim(Request.Form("Province")) <> "" Then rsu("Province") = CutRFWord("Province",50)
rsu("Country") = CutRFWord("Country",20)
If Trim(Request.Form("Telephone")) <> "" Then rsu("Phone") = CutRFWord("Telephone",50)
If Request.Form("e-mail") <> "" Then
rsu("mail") = CutRFWord("e-mail",100)
If Request.Form("mailme") = "yes" Then
rsu("mailme") = 1
else
rsu("mailme") = 0
End If
else
rsu("mailme") = 0
End If
If Request.Form("rememberme") = "yes" Then
rsu("rememberme") = 1
Else
rsu("rememberme") = 0
End If
rsu("Date") = Now
'If is a new user and has chosen a password (error if not) and is not logged (extra check) then
'use the suggested password
If NewUser AND (NOT Session("Logged")) AND Request.Form("Password") <> "" Then
rsu("pwd") = Request.Form("Password")
End If
' If IsNull(rsu("pwd")) AND Session("uPwd")<> "" Then rsu("pwd") = Session("uPwd")
rsu("LastVisit") = Date
Session("DateUpdated") = True
rsu.Update
rsu.Close
set rsu = nothing
rsh.AddNew
rsh("UserID") = UserID
rsh("CartID") = CartID
rsh("Date") = Now 'Formatdatetime(now(),2)
'Customer details
If Trim(Request.Form("Company")) <> "" Then rsh("Company") = CutRFWord("Company",100)
rsh("Name") = CutRFWord("Name",50)
rsh("Surname") = CutRFWord("Surname",50)
rsh("Address") = CutRFWord("Address",100)
rsh("Address2") = CutRFWord("Address2",100)
rsh("CP") = CutRFWord("CP",10)
rsh("City") = CutRFWord("Town",50)
if Request.Form("Province") <> "" Then rsh("Province") = CutRFWord("Province",50)
If Request.Form("Telephone") <> "" Then rsh("Phone") = CutRFWord("Telephone",50)
rsh("mail") = CutRFWord("e-mail",100)
rsh("Country") = CutRFWord("Country",20)
'Delivery Details
If Trim(Request.Form("DName")) <> "" Then rsh("DName") = CutRFWord("DName",100)
If Trim(Request.Form("DAddress")) <> "" Then rsh("DAddress") = CutRFWord("DAddress",100)
If Trim(Request.Form("DAddress2")) <> "" Then rsh("DAddress2") = CutRFWord("DAddress2",100)
If Trim(Request.Form("DCompany")) <> "" Then rsh("DCompany") = CutRFWord("DCompany",100)
If Trim(Request.Form("DCP")) <> "" Then rsh("DCP") = CutRFWord("DCP",10)
If Trim(Request.Form("DTown")) <> "" Then rsh("DCity") = CutRFWord("DTown",50)
If Trim(Request.Form("DProvince")) <> "" Then rsh("DProvince") = CutRFWord("DProvince",50)
If Trim(Request.Form("DTelephone")) <> "" Then rsh("DPhone") = CutRFWord("DTelephone",50)
If Trim(Request.Form("DCountry")) <> "" Then rsh("DCountry") = CutRFWord("DCountry",20)
'Costs
rsh("SubTotal") = CDbl(PriceT)
rsh("Taxes") = Taxes
rsh("TotalTax") = TotalTax
rsh("Delivery") = ShipCost
rsh("Total") = CDbl(PriceTG)
If CStr(WeightT) <> "" Then
rsh("Weight") = CDbl(WeightT)
else
rsh("Weight") = 0
End If
'Store user discount value.
rsh("UserDiscount") = nUrDiscountTotal
'====================================
' Order status and billing status
' Change the default values at the top
'====================================
' Set the status of new orders.
rsh("Status") = N_STATUS_NEWORDER
' Set the billing status of new orders.
rsh("BillingStatus") = N_BILLINGSTATUS_NEWORDER
'Payment method
rsh("PaymentMode") = CutRFWord("payment",50)
'Credit card details stored if there is an owner name (CCOwner).
If Request.Form("CCOwner") <> "" Then
rsh("CCOwner") = CutRFWord("CCOwner",100)
'Remove spaces and "-".
Dim sEncCCNumber
sEncCCNumber = Replace(Replace(CutRFWord("CCNumber",40)," ",""),"-","")
'Encrypt and encode into HEX string to be safely stored
sEncCCNumber = EncryptAndEncode(sEncCCNumber)
'rsh("CCNumber") = Replace(Replace(CutRFWord("CCNumber",40)," ",""),"-","")
rsh("CCNumber") = sEncCCNumber 'Store the encrypted and encoded in Hex string CC number
rsh("CCExpDate") = EncryptAndEncode(CutRFWord("CCExpDateMonth",2) & "/" & Right(Request.Form("CCExpDateYear"),2))
If Request.Form("CCIssueNumber") <> "" Then
rsh("CCIssueNumber") = CutRFWord("CCIssueNumber",10)
End If
'Get CVV number (from back of some cards). Cut to 7 characters.
If CutRFWord("CCCVV",7) <> "" Then
rsh("CCCVV") = CutRFWord("CCCVV",7)
End If
End If
'UPS returned values. Store here if adding another external company system.
If Request.Form("strUPS") <> "" Then
rsh("Shipping") = CutRFWord("strUPS",50)
End If
'VAT number used in European Union to allow tax exemption for companies
If Request.Form("TaxId") <> "" Then
rsh("TaxID") = CutRFWord("TaxId",100)
End If
'Transaction values return in real time payment processing like Authorize.Net.
If strTrans <> "" Then
rsh("TransactionData") = Left(strTrans,150)
End If
'User comments
If Trim(Request.Form("Comments")) <> "" Then rsh("Comments") = Request.Form("Comments")
'User IP address stored as security meassure.
rsh("RemoteIP") = LEFT(Request.ServerVariables("REMOTE_ADDR"),15)
'Save details
rsh.Update
'Obtain the order Id generated automatically by the database
OrderID = rsh("Id")
rsh.Close
set rsh = nothing
'If the Order id wasn't retrieved correctly, attempt to query the record using the combination
'of Cart Id and User Id. This code should not get to be executed in a normal installation!.
If CStr(orderID) = "" Then
set rsoid = conn.Execute ("SELECT Id FROM orders WHERE UserID = '" & UserID & "' AND CartId = '" & CartID & "' ORDER BY Id DESC")
If rsoid.EOF and rsoid.BOF Then
set rsoid = nothing
%>
Fatal Error occurred, please contact shop administrator. Your order ID could not be retrieved
[an error occurred while processing this directive]