<% @Language=VBScript %>
<%
'========================================================================
' Extract some fundamental variables
'========================================================================
Dim CartID, UserID
'Extract Cart ID from session, Query String or Form if not available (some SSL)
If Session("CartID") <> "" Then
CartID = Session("CartID")
elseif Request.QueryString("CartID") <> "" Then
CartID = Request.QueryString("CartID")
Session("CartID") = CartID 'Save in the session
else
CartID = unescape(Request("CartID"))
End If
'Extract UserID from session, Query String or Form if not available
If Session("UserID") <> "" Then
UserID = Session("UserID")
elseif Request.QueryString("UserID") <> "" Then
UserID = Request.QueryString("UserID")
else
UserID = unescape(Request("UserID"))
End If
'If the Session UserID is different to the one in the querystring then take the one from the
'URL and update the Session variable and the variable UserID.
'This should only happen during checkout on a SSL connection if the ASP application is different
'i.e. using a shared certificate.
If Session("UserID") <> Request.QueryString("UserID") AND Request.QueryString("UserID") <> "" Then
Session("UserID") = Request.QueryString("UserID")
UserID = Request.QueryString("UserID")
End If
'========================================================================
Function WritePriceOptions (ByVal PID,ByVal n)
'----------------------------------------------------------
' Writes the select box with the contents of the price
' options.
'----------------------------------------------------------
Dim Options, strSQL, strTemp
'Dim aryOptions ()
strTemp = ""
strSQL = "SELECT * FROM PriceOptions WHERE ProdId ='" & PID & "'"
set Options = conn.Execute (strSQL)
If NOT (Options.EOF AND Options.BOF) Then
aryOptions = Options.GetRows
Else
set Options = nothing
Exit Function
End If
Options.Close
set Options = nothing
If UBound(aryOptions,2) - LBound(aryOptions,2) > 0 Then
strTemp = "Select Option: "
End If
WritePriceOptions = strTemp
End Function
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 (name, nlength)
'Trim and cut to nlength craracters max the Request(name) passed.
Dim sTmp
sTmp = Left(Trim(unescape(Request(name))),nlength)
If sTmp <> "" Then
CutRFWord = sTmp
Else
CutRFWord = Null
End If
End Function
Function ProdName (cod)
'Returns the name of a product with id cod
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 (IDCart)
'Deletes cart with ID IDCart
Dim rs
sql= "DELETE FROM Carts WHERE CartID = '" & IDCart & "'"
set rs = Conn.Execute(sql)
set rs = nothing
End Function
'=========================================================================
'Function: MoveCart
'Moves cart with ID = IDCart into the orders table
'Uses from form:
'TotalTax
'ShipCost
'e-mail
'Password
'Name
'Surname
'Company
'Address
'Address2
'CP
'Town
'Province
'Country
'Telephone
'mailme
'rememberme
'
'DName
'DAddress
'DAddress2
'DCompany
'DCP
'DTown
'DProvince
'DTelephone
'DCountry
'
'payment
'CCOwner
'CCNumber
'CCExpDateMonth
'CCExpDateYear
'CCIssueNumber
'CCCVV
'VATNumber
'strUPS
'
'Comments
'Uses variables from prochkoutend.asp:
'PriceT
'Taxes
'TotalTax
'ShipCost
'PriceTG
'WeightT
'=========================================================================
Function MoveCart (IDCart)
'Get cart
Set rs = Server.CreateObject("ADODB.Recordset")
sql= "SELECT * FROM Carts 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 unescape(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(unescape(Request("Province"))) <> "" Then rsu("Province") = CutRFWord("Province",50)
rsu("Country") = CutRFWord("Country",20)
If Trim(unescape(Request("Telephone"))) <> "" Then rsu("Phone") = CutRFWord("Telephone",50)
If unescape(Request("e-mail")) <> "" Then
rsu("mail") = CutRFWord("e-mail",100)
If unescape(Request("mailme")) = "yes" Then
rsu("mailme") = 1
else
rsu("mailme") = 0
End If
else
rsu("mailme") = 0
End If
If unescape(Request("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 unescape(Request("Password")) <> "" Then
rsu("pwd") = unescape(Request("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(unescape(Request("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 unescape(Request("Province")) <> "" Then rsh("Province") = CutRFWord("Province",50)
If unescape(Request("Telephone")) <> "" Then rsh("Phone") = CutRFWord("Telephone",50)
rsh("mail") = CutRFWord("e-mail",100)
rsh("Country") = CutRFWord("Country",20)
'Delivery Details
If Trim(unescape(Request("DName"))) <> "" Then rsh("DName") = CutRFWord("DName",100)
If Trim(unescape(Request("DAddress"))) <> "" Then rsh("DAddress") = CutRFWord("DAddress",100)
If Trim(unescape(Request("DAddress2"))) <> "" Then rsh("DAddress2") = CutRFWord("DAddress2",100)
If Trim(unescape(Request("DCompany"))) <> "" Then rsh("DCompany") = CutRFWord("DCompany",100)
If Trim(unescape(Request("DCP"))) <> "" Then rsh("DCP") = CutRFWord("DCP",10)
If Trim(unescape(Request("DTown"))) <> "" Then rsh("DCity") = CutRFWord("DTown",50)
If Trim(unescape(Request("DProvince"))) <> "" Then rsh("DProvince") = CutRFWord("DProvince",50)
If Trim(unescape(Request("DTelephone"))) <> "" Then rsh("DPhone") = CutRFWord("DTelephone",50)
If Trim(unescape(Request("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 here the default values
'====================================
' Set the status of new orders.
rsh("Status") = 0 'Just Placed (0)
' Set the billing status of new orders.
rsh("BillingStatus") = 0 'Default value is 0.
'Payment method
rsh("PaymentMode") = CutRFWord("payment",50)
'Credit card details stored if there is an owner name (CCOwner).
If unescape(Request("CCOwner")) <> "" Then
rsh("CCOwner") = CutRFWord("CCOwner",100)
'Remove spaces and "-".
rsh("CCNumber") = Replace(Replace(CutRFWord("CCNumber",20)," ",""),"-","")
rsh("CCExpDate") = CutRFWord("CCExpDateMonth",2) & "/" & Right(unescape(Request("CCExpDateYear")),2)
If unescape(Request("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 unescape(Request("strUPS")) <> "" Then
rsh("Shipping") = CutRFWord("strUPS",50)
End If
'VAT number used in European Union to allow tax exemption for companies
If unescape(Request("VATNumber")) <> "" Then
rsh("TaxID") = CutRFWord("VATNumber",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
Dim userComments
userComments = ""
'next line by theng
if session("cc") = "CreditCard" Then userComments = "Credit Card" & " "
If Trim(unescape(Request("poNumber"))) = "" and Trim(unescape(Request("checkNumber"))) = "" and Trim(unescape(Request("Bank"))) = "" and session("cc") <> "CreditCard" then userComments = "Cash On Delivery" & " "
'If Trim(unescape(Request("poNumber"))) <> "" Then userComments = "P/O number: " & Trim(unescape(Request("poNumber"))) & " "
If Trim(unescape(Request("checkNumber"))) <> "" Then userComments = userComments & "Cheque number: " & Trim(unescape(Request("checkNumber")))
If Trim(unescape(Request("Bank"))) <> "" Then userComments = userComments & ", Bank: " & Trim(unescape(Request("Bank")))
If Trim(unescape(Request("checkNumber"))) <> "" OR Trim(unescape(Request("Bank"))) <> "" Then userComments = userComments & " "
If Trim(unescape(Request("Comments"))) <> "" Then userComments = userComments& Trim(unescape(Request("Comments")))
If userComments <> "" Then
rsh("Comments") = userComments
End If
'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 orderID = "" Then
set rsoid = conn.Execute ("SELECT Id from orders where CartId = '" & CartID & "'")
If rsoid.EOF and rsoid.BOF Then
%>
Fatal Error ocurred, please contact shop administrator.
[an error occurred while processing this directive]
<%
If IsObject(conn) Then
conn.close
set conn = nothing
End If
%>
<% Response.End
else
OrderID = rsoid("Id")
End If
rsoid.Close
set rsoid = nothing
End If
Do while NOT rs.eof
rsl.AddNew
rsl("OrderID") = OrderID
rsl("ProdID") = rs("ProdID")
rsl("Price") = rs("Price")
rsl("Qtty") = rs("Qtty")
rsl("Units") = rs("Units")
If rs("Option1") <> "" AND rs("Option1") <> vbNull Then
rsl("Option1") = rs("Option1")
End If
If rs("Option2") <> "" AND rs("Option2") <> vbNull Then
rsl("Option2") = rs("Option2")
End If
If rs("PriceOption") <> "" AND rs("PriceOption") <> vbNull Then
rsl("PriceOption") = rs("PriceOption")
End If
rsl.Update
RegPurch rs("ProdID"), rs("CatID"), UserID
DecreaseStock rs("ProdId"), rs("Qtty")
rs.movenext
Loop
rs.Close
rsl.Close
set rs = nothing
set rsl = nothing
'If it's a new user then set basic info in the Session
If NOT Session("Logged") Then
Session("Name") = unescape(Request("Name"))
Session("Surname") = unescape(Request("Surname"))
Session("Mail") = unescape(Request("E-Mail"))
Session("Country") = unescape(Request("Country"))
Session("uPwd") = unescape(Request("Password"))
Session("UserDiscount") = 0 'Set new users discount to 0 as default.
End If
'Log the user in automatically
Session("Logged") = True
'Return the order Id
MoveCart = OrderID
End Function
Function RegPurch (PID, CID, UID)
'Registers purchase in the customer's purchase history
Set reg = Server.CreateObject("ADODB.Recordset")
sql= "SELECT * FROM Historic WHERE UserID = '" & UID & "' AND ProdID = '" & PID & "'"
reg.Open sql,Conn, adOpenStatic, adLockOptimistic
If reg.EOF AND reg.BOF Then 'reg.recordcount = 0
reg.AddNew
reg("UserID")= UID
reg("ProdID")= PID
reg("CatID")= CID
reg("Qtty")= 1
reg("Date") = Now
reg.Update
Else
TotalItms = reg("Qtty")
reg("Qtty") = TotalItms + 1
reg("Date") = Now
reg.Update
End If
reg.Close
set reg = nothing
End Function
Function DecreaseStock (PID, Qtty)
'Decreases the Stock for Product Id PID is Stock control is active
Dim stock, sql
If shop_StockControl Then
Set stock = Server.CreateObject("ADODB.Recordset")
sql= "UPDATE Products SET Stock = Stock - " & Qtty & " WHERE ProdID = '" & PID & "'"
set stock = conn.Execute(sql)
set stock = nothing
End If
End Function
Function CheckStock
'Checks that all products are in stock.
'Returns True if all products are in stock and False if not
Dim strSQL, CartRs
'Only check if the stock control is on
If shop_StockControl Then
strSQL = "SELECT Products.ProdId FROM Carts, Products where Carts.ProdId = Products.ProdId AND Stock < Qtty AND Carts.CartID = '" & CartID & "'"
'Response.Write strSQL
Set CartRs = Server.CreateObject("ADODB.Recordset")
set CartRs = conn.Execute(strSQL)
If CartRs.EOF AND CartRs.BOF Then
'All products are in stock
CheckStock = True
Else
'Some products are not in stock
CheckStock = False
End If
CartRs.Close
set CartRs = nothing
else
CheckStock = True
End If
End Function
%>
<%
'==============================================================
' This file contains the database configuration. It also opens
' a connection object (Conn).
' The file also contains some constants definitions, SSL config.
' and colour settings.
'==============================================================
'Opens connection conn if it is not already open.
'Please, modify configuration with correct values
If NOT IsObject(conn) Then
Dim conn
Set conn = Server.CreateObject("ADODB.Connection")
On Error Resume Next
Password = "qs1898"
'-------------------------------------------------------
'Pick ONE of the following configurations:
'(comment the others)
'For additional tech. info see
' - http://www.able-consulting.com/ADO_Conn.htm
'-------------------------------------------------------
ConnStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Session("shop_db_path") & "; Jet OLEDB:Database Password=" & Password
'response.write connstr
'response.end
conn.open ConnStr
'-------------------------------------------------------
'When the site is working we recommend you to comment
'Option 1 and uncomment option 2
'-------------------------------------------------------
If conn.errors.count > 0 then
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.End
'Option 2
'Redirect user to an error page if there is a connetion error.
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
'========================================================================
'If the checkout is in a different URL (same server but different domain
'as in shared certificates ) :
' 1. Define strNonSecPath with the non secure path ending with "/"
' Ex. strNonSecPath = "http://domain.com/shop/"
' 2. Define strSecPath with the secure path ending with "/"
' Ex. strSecPath = "https://securedomain.com/shop/"
Dim strNonSecPath
Dim strSecPath
'strSecPath = "https://www.secure-us.net/quadcomm/demo/"
'strNonSecPath = "http://quadcomm.com/demo/"
'strSecPath = "https://olymp/secshop/"
'strNonSecPath = "http://olymp/devshop/"
Dim i, j
i = instrRev(Request.ServerVariables("SCRIPT_NAME"),"/",-1,1)
j = len(Request.ServerVariables("SCRIPT_NAME"))
if lcase(Request.ServerVariables("SERVER_NAME")) = "win2000" Then
Session("store_processor_location") = "http://" & Request.ServerVariables("SERVER_NAME") & Left(Request.ServerVariables("SCRIPT_NAME"),i)
else
Session("store_processor_location") = "http://" & Request.ServerVariables("SERVER_NAME") & "/shop/storefront/"
End if
strNonSecPath = Session("store_processor_location")
'response.write strNonSecPath
'response.end
'========================================================================
' Shop Settings definitions
Dim shop_DefCurName, shop_SecCurName, shop_SecCurConv, shop_CompanyName, shop_Mail, shop_Title
' Currency
shop_DefCurName = Session("DefCurName")
shop_SecCurName = Session("SecCurName")
shop_SecCurConv = Session("SecCurConv")
'Others
shop_CompanyName = Session("CompanyName")
shop_Mail = Session("Mail")
shop_Title = Session("Title")
If Session("StockControl") = "1" Then
shop_StockControl = True
Else
shop_StockControl = False
End If
shop_DB = Session("DBSystem")
shop_MailSystem = Session("MailSystem")
shop_URL = Session("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
CART_HEAD_BG = Session("CART_HEAD_BG")
CART_HEAD_FONT = Session("CART_HEAD_FONT")
CART_BODY_BG = Session("CART_BODY_BG")
LMENU_BG = Session("LMENU_BG")
LMENU_FONT = Session("LMENU_FONT")
LMENU_SUB_FONT = Session("LMENU_SUB_FONT")
TMENU_BG = Session("TMENU_BG")
TMENU_FONT = Session("TMENU_FONT")
SEC_BG = Session("SEC_BG")
SEC_FONT = Session("SEC_FONT")
DETAILS_BG = Session("DETAILS_BG")
DETAILS_HEAD_BG = Session("DETAILS_HEAD_BG")
DETAILS_HEAD_FONT = Session("DETAILS_HEAD_FONT")
'========================================================================
' 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
'========================================================================
' Basic Functions
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 (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
'--------------------------------------------------------------------
' Connection procedures - open and close
'--------------------------------------------------------------------
Session("drive") = Server.Mappath(".")
Session("drive") = left(Session("drive"),1)
Session("root_path") = Session("drive") & ":\"
Dim dbc
Dim strConn
'this procedure is called wherever a connection is needed. Returns 'dbc' as active connection
sub openConn()
'use appropriate connection string
strConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Session("root_path") & "db\ASPportal.mdb"
Set dbc = Server.CreateObject("ADODB.Connection")
dbc.open strConn
end sub
sub closeConn()
if isobject(dbc) then
if dbc.State = adStateOpen then
dbc.Close
end if
set dbc = nothing
end if
end sub
%>
<%
'=============================================================================='
' '
' Copyright 2001 UniVista Corporation Pte Ltd '
' All Rights Reserved. Singapore '
' '
'=============================================================================='
'=================================== Store Custom =================================
'======================= Check for graphical template ============================
Dim templateEXIST
templateEXIST = FALSE
if Session("TenantID") <> "" Then
call openConn()
if request("menu") <> "" Then Session("menu_identifier") = request("menu")
mySQL = "SELECT template_navigation_ID, language_group, gui_template_file FROM template_navigation "
mySQL = mySQL & "WHERE navigation_name = '" & Session("menu_identifier") & "' "
mySQL = mySQL & "AND template_navigation.tenantID = " & Session("TenantID")
Set rs = Server.CreateObject("ADODB.Recordset")
rs.Open mySQL, dbc, 3, 1
If Not rs.EOF Then
gui_template = rs("gui_template_file")
codepage = rs("language_group")
template_navigation_ID = rs("template_navigation_ID")
templateEXIST = TRUE
rs.close
set rs = nothing
'================================== Template Source Verification ================================
'--- Check whether user uses a custom template, custom templates are stored in user's web folder
'--- SiteComposer templates are stored in templates folder
mySQL = "SELECT DISTINCT template_master.template_categoryID FROM template_master, tenants"
mySQL = mySQl & " WHERE template_master.template_master_ID = tenants.template_master_ID "
mySQL = mySQl & " AND tenants.tenantID = " & Session("TenantID")
Set rsSource = Server.CreateObject("ADODB.Recordset")
rsSource.Open mySQL, dbc, 3, 1
If NOT rsSource.EOF Then
If rsSource("template_categoryID") = 3 Then
template_url = Session("theme_path_url_custom") & "images/"
template_path = Session("theme_path_custom")
Else
template_url = Session("theme_path_url") & "images/"
template_path = Session("theme_path")
End If
End If
rsSource.close
set rsSource = nothing
Else
rs.close
set rs = nothing
End If
End If
%>
<%
'=======================================================
' File: browse.asp
' Shows products for a section or offers list depending
' on request(cat):
' - catid: Section listing
' - ManuId: Manufacturer listing
' - "ofer": List of offers
' - "feat": List of featured products
'=======================================================
Dim MaxItems 'Defines the maximum number of items per page
Dim strBrowse 'Defines the type of additions to cart (Multi/Single)
Dim path 'Defines the path of the current category/section
Dim strPath 'Used to store the querystring path value (used when ordering by different field)
Dim strCat 'Used to store the section path
Dim ManuID 'Manufacturer ID
Dim CurrentPage 'Current recordset page
Dim sBrowseOffer'Browse type for Offers pages
Dim sBrowseManu 'Browse type for Manufacturers pages
Dim sBrowseFeat 'Browse type for Featured Products pages
Dim TotPages, itrecordcount
strPath = Request.QueryString("path")
path = "path=" & strPath
strCat = Request.QueryString("Cat")
CatID = strCat
ManuID = Request.QueryString("ManuID")
'==========================================
'Set Browse types: S (single), M (multiple)
'==========================================
sBrowseOffer = "M" 'Offers
sBrowseManu = "M" 'Manufacturer
sBrowseFeat = "M" 'Featured Products
'==========================================
' Init. Paging
MaxItems = 20 ' Maximum number of items displayed at once
If Request.QueryString ("MOVE")="NEXT" Then
CurrentPage = Request.QueryString("CurrentPage") + 1
End If
If Request.QueryString ("MOVE")="PREV" Then
CurrentPage = Request.QueryString("CurrentPage") - 1
End If
If Request.QueryString ("MOVE")="" Then
CurrentPage = 1
End If
' End Init. Paging
'-------------------------------------------------------
If NOT (templateEXIST) Then
%>
<%= shop_Title %>
<% End If
'-------------------------------------------------------
%>
<%
'=============================================================================='
' '
' Copyright 2001 UniVista Corporation Pte Ltd '
' All Rights Reserved. Singapore '
' '
'=============================================================================='
'===================================== Products =================================
'--- variables needed for displaying storefront system on a custom graphical template.
'- sHeader
'- Search
'- Quick Browse
'- Cart Total
'- Categories
'- User Area
'- Featured product
'- content
'---------------------------------------------------------------------------------
Dim StoreLinks
Dim Search
Dim QuickBrowse
Dim CartTotal
Dim Categories
Dim UserArea
'--- Shop Logo
'=======================================================================================
'Definition of logos file paths
'URL of the main logo. Double quote all quote characters
LogoURL = ""
'URL of the small logo on the left-hand side bar. Double quote all quote characters
SmLogoURL = ""
'URL of the small logo displayed when a product has no picture (called in inc/line.asp). Double quote all quote characters. This could also be text or HTML code.
'LineLogoURL = ""
LineLogoURL = ""
'=======================================================================================
'---Disable logo
LogoURL = ""
' Initialise cat variable with the contents of Request("cat"). This holds current
' category/section
If Request("cat") <> "" Then strNav = "cat=" & Request("cat") & "&path=" & Request("path")
If (templateEXIST) Then '--- Set variables. To be use later to write on graphical template
'--- Header links or bar for store front system
StoreLinks = vbcrlf & "" & vbcrlf
StoreLinks = StoreLinks & "
<% End If '--- for templateEXIST. %>
<% If NOT (templateEXIST) Then %>
<% End If %>
<% If NOT (templateEXIST) Then %>
<% End If %>
<%
'Initialise ordering
Dim OrderBy, QryOrderBy, sqlOrderBy
'Read value from Query String
OrderBy = Request("OrderBy")
'If OrderBy has a value set the SQL order by string
If OrderBy <> "" Then
QryOrderBy = "&OrderBy=" & OrderBy
sqlOrderBy = "ORDER BY " & OrderBy
'If it is special offers order by offer price instead of normal price
If CatID = "ofer" Then sqlOrderBy = Replace(sqlOrderBy,"Price","Offer")
Else 'Else order by Name (default)
sqlOrderBy = " ORDER BY Name"
End If
'If user has just selected a new ordering then reset current page
'Page browsing includes NewStart=1 (to ensure it keeps the page
If Request.QueryString("KeepPage") = "" Then CurrentPage = 1
'End ordering
'=====================================================================
' Build the queries depending on type and generate title for page
'=====================================================================
'---------------------
' Offers List
'---------------------
If CatID = "ofer" Then
'If the category is "Special Offers" build SQL query for products on sale
'and print the title
sql= "SELECT Products.* FROM Products INNER JOIN Categories ON Products.CatID = Categories.CatID WHERE Products.Offer > 1 AND (Products.Show = 1 AND Categories.Show = 1 ) " & sqlOrderBy
strBrowse = sBrowseOffer
'---------------------------------------------------------------------------
If (templateEXIST) Then
content_title = " Special Offers"
Else
%> Special Offers<%
End If
'---------------------------------------------------------------------------
'------------------------
' Featured Products List
'------------------------
ElseIf CatID = "feat" AND Session("Featured") <> "" Then
'If the category is "Featured Products" build SQL query for featured products
'and print the title
sql= "SELECT * FROM Products WHERE ProdID IN ( '" & Replace(Session("Featured"),",","','") & "' ) " & sqlOrderBy
strBrowse = sBrowseFeat
'---------------------------------------------------------------------------
If (templateEXIST) Then
content_title = " Featured Products"
Else
%> Featured Products<%
End If
'---------------------------------------------------------------------------
'-----------------------
' Section/category List
'-----------------------
ElseIf IsNumeric(CatID) AND CatID <> "" Then
'Obtaing current category properties
Set pcat = Server.CreateObject("ADODB.Recordset")
sql= "SELECT * FROM categories WHERE CatID= " & CatID
pcat.Open sql,Conn, adOpenStatic, adLockReadOnly
strBrowse = pcat("browsetype")
strSection = pcat("Titulo")
pcat.close
set pcat = nothing
'If (CatID <> "ofer") AND IsNumeric(CatID) AND CatID <> "" Then
sql= "SELECT * FROM products WHERE CatID = " & CatID & " AND Show = 1 " & sqlOrderBy
'---------------------------------------------------------------------------
If (templateEXIST) Then
content_title = " " & strSection & "" & vbcrlf
Else
%> <%= strSection %><%
End If
'---------------------------------------------------------------------------
'---------------------
' Manufacturer List
'---------------------
ElseIf IsNumeric(ManuID) AND ManuID <> "" Then
'Obtaing current category properties
Set pcat = Server.CreateObject("ADODB.Recordset")
sql= "SELECT Manufacturer FROM Manufacturer WHERE ManuID= " & ManuID
pcat.Open sql,Conn, adOpenStatic, adLockOptimistic
strBrowse = sBrowseManu
strSection = pcat("Manufacturer")
pcat.close
set pcat = nothing
sql= "SELECT * FROM products WHERE ManuID = " & ManuID & " AND Show = 1 " & sqlOrderBy
'---------------------------------------------------------------------------
If (templateEXIST) Then
content_title = " " & strSection & "" & vbcrlf
Else
%> <%= strSection %><%
End If
'---------------------------------------------------------------------------
End If
'Now open the recordset.
Set rs = Server.CreateObject("ADODB.Recordset")
If shop_DB = "SQL" Then
rs.CursorLocation = adUseClient
End If
'Set recordset page size
rs.Pagesize= MaxItems
'Set how many records to retrieve at one time into local memory from the provider.
rs.Cachesize = MaxItems
'Open Recordset
'Response.Write sql 'Print query
rs.Open sql, Conn, adOpenStatic, adLockOptimistic
TotPages = Rs.PageCount
itrecordcount = rs.recordcount
content_InStruction = ""
'If there are no results display message
If itrecordcount = 0 Then
'---------------------------------------------------------------------------
If (templateEXIST) Then
content_InStruction = content_InStruction & "
" & vbcrlf
content_InStruction = content_InStruction & "Sorry, there are no products available in this section at the moment." & vbcrlf
content_InStruction = content_InStruction & "
" & vbcrlf & vbcrlf
Else
%>
Sorry, there are no products available in this section at the moment.
<%
End If
'---------------------------------------------------------------------------
Else
rs.AbsolutePage = CurrentPage
'---------------------------------------------------------------------------
'--- State Instructions or Error messages
If (templateEXIST) Then
'content_InStruction = content_InStruction & "" & vbcrlf
content_InStruction = content_InStruction & "
" & vbcrlf
Else
%>
<%
End If
'---------------------------------------------------------------------------
'If BrowseType = Multiple Addition
If strBrowse <> "S" Then
'---------------------------------------------------------------------------
If (templateEXIST) Then
content_InStruction = content_InStruction & "Enter the quantity of the product/s that you want to purchase and then click on ""Add products to cart"" at the bottom of the page. " & vbcrlf
content_InStruction = content_InStruction & "For detailed information of a product click on its image or name." & vbcrlf & vbcrlf
Else
%>
Enter the quantity of the product/s that you want to purchase and then click on "Add products to cart" at the bottom of the page.
For detailed information of a product click on its image or name.
<%
End If
'---------------------------------------------------------------------------
'If BrowseType = Single Addition
Else
'---------------------------------------------------------------------------
If (templateEXIST) Then
content_InStruction = content_InStruction & "Click on ""Add to cart"" to add a product to your shopping cart. For detailed information of a product click on its image or title." & vbcrlf
Else
%>
Click on "Add to cart" to add a product to your shopping cart. For detailed information of a product click on its image or title.
<%
End If
'---------------------------------------------------------------------------
End If
'---------------------------------------------------------------------------
If (templateEXIST) Then
content_InStruction = content_InStruction & "
"
Else %>
<%
End if
'---------------------------------------------------------------------------
'--- Display Products
'---------------------------------------------------------------------------
content_Products = ""
If (templateEXIST) Then
content_Products = content_Products & "
" & vbcrlf
'If BrowseType = Multiple Addition create a common form for all items
If strBrowse <> "S" Then
content_Products = content_Products & "
<%
End If
'---------------------------------------------------------------------------
'===============================================
'Build the pages list and previous/next links.
'===============================================
'If there are more than 1 page show the links.
If itrecordcount > MaxItems Then
Response.Write "[ "
'If we are not in the first page display the "Previous" link
If CurrentPage > 1 Then
'---------------------------------------------------------------------------
If (templateEXIST) Then
content_navigation = content_navigation & "Previous | "
Else %>
&CurrentPage=<%= CurrentPage %>&<%= path %>&ManuID=<%= ManuID %>&KeepPage=1<%= QryOrderBy %>">Previous |
<%
End If
'---------------------------------------------------------------------------
End If
'Display individual pages links
For i = 1 to TotPages
'If i is not the current page add a link to the number
If i <> CurrentPage Then
'---------------------------------------------------------------------------
If (templateEXIST) Then
content_navigation = content_navigation & "" & i & " |"
Else %>
&CurrentPage=<%= i-1 %>&<%= path %>&ManuID=<%= ManuID %>&KeepPage=1<%= QryOrderBy %>"><%= i %> |
<%
End If
'---------------------------------------------------------------------------
Else
'---------------------------------------------------------------------------
If (templateEXIST) Then
content_navigation = content_navigation & i
Else
Response.Write i
End If
'---------------------------------------------------------------------------
'If this is not the last page display separator "|"
If CurrentPage <> TotPages Then
'---------------------------------------------------------------------------
If (templateEXIST) Then
content_navigation = content_navigation & " | "
Else
Response.Write " | "
End If
'---------------------------------------------------------------------------
End If
End If
Next
'If this is not the last page display the "Next" link
If CurrentPage < TotPages Then
'---------------------------------------------------------------------------
If (templateEXIST) Then
content_navigation = content_navigation & "Next |"
Else %>
&CurrentPage=<%= CurrentPage %>&<%= path %>&ManuID=<%= ManuID %>&KeepPage=1<%= QryOrderBy %>">Next
<%
End If
'---------------------------------------------------------------------------
End If
'---------------------------------------------------------------------------
If (templateEXIST) Then
content_navigation = content_navigation & " ] "
Else
Response.Write " ] "
End If
'---------------------------------------------------------------------------
End If
'---------------------------------------------------------------------------
If (templateEXIST) Then
content_navigation = content_navigation & ""
'--- Combine content_Products & content_navigation
content_Products = content_Products & content_navigation
content_Products = content_Products & "
"
Else %>
<%
End If
'---------------------------------------------------------------------------
'If BrowseType = Multiple Addition then show submit button (image) and close the form
If strBrowse <> "S" Then
'---------------------------------------------------------------------------
If (templateEXIST) Then
content_Products = content_Products & "
<% End If ' --- templateEXIST
'---------------------------------------------------------------------------
End If
'End if If rs.recordcount = 0
End If %>
<%
'---------------------------------------------------------------------------
If (templateEXIST) Then
ContentContainerEND = ContentContainerEND & "
<% End If ' --- templateEXIST
'---------------------------------------------------------------------------
%>
<% If NOT (templateEXIST) Then%>
<% End If%>
<%
If IsObject(conn) Then
conn.close
set conn = nothing
End If
%>
<%
If (templateEXIST) Then
'============================ Write HTML File ===============================
'--- compose content
if strContent = "" Then
strContent = ContentContainerStart & content_InStruction & content_Products & ContentContainerEND
End If
'const ForReading = 1
'const TristateFalse = 0
'dim strSearchThis
'dim ourtext
'dim ts
if gui_template = "" OR gui_template = "0" then
Msg = "This page cannot be displayed due to template error. Click here to report this error."
call errMsg("Template Error",Msg)
End If
set fso = Server.CreateObject("Scripting.FileSystemObject")
template_filename = gui_template
set ourtext = fso.GetFile(template_path & template_filename)
set ts = ourtext.OpenAsTextStream(1, 0)
myText = ts.Read(ourtext.Size)
if strContent = "" Or IsNull(strContent) Then
strContent = "
Information on this section is currently not available.
" & vbcrlf
StoreLinks = StoreLinks & " 
"
' Initialise cat variable with the contents of Request("cat"). This holds current
' category/section
If Request("cat") <> "" Then strNav = "cat=" & Request("cat") & "&path=" & Request("path")
If (templateEXIST) Then '--- Set variables. To be use later to write on graphical template
'--- Header links or bar for store front system
StoreLinks = vbcrlf & "" & vbcrlf
StoreLinks = StoreLinks & "
