%@ Language=VBScript %>
<%
'*************************************************************************
' DO NOT MODIFY THIS SCRIPT IF YOU WANT UPDATES TO WORK!
' Function : Displays a list of products that match a given criteria...
' : - Matches search criteria
' : - Matches a category
' : - Matches "specials" on flagged products
' : If a category is supplied which has sub categories, the
' : script will display a summary of categories instead of the
' : product list.
' Product : CandyPress Store Frontend
' Version : 6.2
' Modified : May 2007
' Copyright: Copyright (C) 2010 Cavallo Communications, LLC.
' See "license.txt" for this product for details regarding
' licensing, usage, disclaimers, distribution and general
' copyright requirements. If you don't have a copy of this
' file, you may request one at http://www.candypress.com
'*************************************************************************
' Date Description
' 10/23/05 Added user exit
' 10/28/05 Modified expandCategory to use different languages
' 10/28/05 Add script delimiters for prodList user exit
' 01/02/06 Category heading text was not reading from langCategory
' 02/20/06 Fixed problem with Supplier filters not working correctly.
' 04/18/06 Added branding support
' 05/31/06 Corrected brand searching functionality
' 11/05/06 categoryHTMLLong will display in all cases when it is defined.
' 02/17/06 Changed branding support for database
' 05/22/07 Added manufacturer support
' 06/09/09 Added code to return to last displayed category page and sortorder
' 03/31/09 Added UOM display to listings
' 04/07/09 By adding the above the search required that idUOM be added to the select statement
' 05/18/10 Corrected formatting issue (TID=11988&title=prodlist-formatting-issue-61)
'*************************************************************************
' 02/07/10 : Removed tables, replaced with div - candythemes.com
'*************************************************************************
Option explicit
Response.Buffer = true
%>
<%
'Work Fields
dim I
dim totalRecs
dim totalPages
dim count
dim curPage
dim catPos
dim catLst
dim listHeading
dim special
dim strSearch, strSearchType, strSearchMax, strSearchMin, strSearchCat, strSearchBrand, strSearchManufacturer
dim sortField
dim queryStr
dim subCount, maxCol, cellWidth
dim searchArr
dim tmpSQL1, tmpSQL2, tmpSQL3, tmpSQL4
dim wishlist
dim favorites
dim idSF
dim idbrand
dim idmanufacturer
dim errMsg
dim userroles
'Categories
dim IDCategory
dim categoryDesc
dim IDParentCategory
dim categoryHTML
dim categoryHTMLLong
dim sortOrder
dim breadcrumb
'Product
dim IDProduct
dim SKU
dim Description
dim DescriptionLong
dim Price
dim Details
dim listPrice
dim smallImageURL
dim smallImageURL2
dim imageURL
dim Stock
dim fileName
dim noShipCharge
dim handlingFee
dim wholesaleprice
dim msrp
dim map
dim freight
dim estimatedship
dim brand
dim refurbished
dim manufacturer
dim minorder
dim idUOM
'Database
dim mySQL
dim conntemp
dim rstemp
dim rstemp2
dim recordArr
'Session
dim idOrder
dim idCust
'*************************************************************************
'Open Database Connection
call openDb()
'Store Configuration
if loadConfig() = false then
call errorDB(LangText("ErrConfig",""),"")
end if
'Get/Set Cart/Order Session
idOrder = sessionCart()
'Get/Set Customer Session
idCust = sessionCust()
idSF = Request.cookies(storeID & "idSF")
if len(idSF) = 0 or IsNull(idSF) then
'Create empty favorites record
set rsTemp = openRSopen(tablePrefix & "CustSF",adUseServer,adOpenKeySet,adLockOptimistic,adCmdTable,0)
rsTemp.AddNew
rsTemp("dateCreated") = currDateTime("DT",timeOffSet)
rsTemp("dateCreatedInt")= dateInt(currDateTime("DT",timeOffSet))
rsTemp.update
Response.cookies(storeID & "idSF") = rsTemp("idSF")
Response.cookies(storeID & "idSF").expires = dateAdd("d",30,now())
Response.cookies(storeID & "idSF").path = "/"
idSF = rsTemp("idSF")
call closeRS(rsTemp)
end if
'Get/Set Affilate ID
call getIdAffiliate(validHTML(Request.QueryString("idAff")))
'---------------------------------
' PARMS - Search
'---------------------------------
strSearch = Request("strSearch")
strSearchType = Request("strSearchType")
strSearchMin = Request("strSearchMin")
strSearchMax = Request("strSearchMax")
strSearchCat = Request("strSearchCat")
strSearchBrand = Request("strSearchBrand")
strSearchManufacturer = Request("strSearchManufacturer")
if len(strSearch & strSearchMin & strSearchMax & strSearchCat & strSearchBrand & strSearchManufacturer) > 0 then
'Get rid of malicious HTML
strSearch = validHTML(strSearch)
strSearchType = validHTML(strSearchType)
strSearchMin = validHTML(strSearchMin)
strSearchMax = validHTML(strSearchMax)
strSearchCat = validHTML(strSearchCat)
strSearchBrand = validHTML(strSearchBrand)
strSearchManufacturer = validHTML(strSearchManufacturer)
'Get rid of multiple spaces in keywords
do until instr(strSearch," ") = 0
strSearch = replace(strSearch," "," ")
loop
'After all this string manipulation, check the search is still valid
if len(strSearch & strSearchMin & strSearchMax & strSearchCat & strSearchBrand & strSearchManufacturer) = 0 then
Response.Clear
errMsg = LangText("ErrInvSearch","")
call closeDB()
Response.redirect "sysMsg.asp?errMsg=" & server.URLEncode(errMsg)
end if
'Assign default values
if strSearchType <> "AND" _
and strSearchType <> "OR" _
and strSearchType <> "PHR" then
strSearchType = "OR"
end if
if not(isNumeric(strSearchMin)) then
strSearchMin = 0
else
strSearchMin = CDbl(strSearchMin)
end if
if not(isNumeric(strSearchMax)) then
strSearchMax = 0
else
strSearchMax = CDbl(strSearchMax)
end if
if not(isNumeric(strSearchCat)) then
strSearchCat = 0
else
strSearchCat = CInt(strSearchCat)
end if
if len(strSearchBrand) = 0 then
strSearchBrand = ""
brand = ""
else
mySQL = "SELECT name FROM " & tablePrefix & "brand WHERE idBrand = " & strSearchBrand
set rsTemp = openRSexecute(mySQL)
if not rsTemp.eof then
brand = rsTemp("name")
else
brand = ""
end if
end if
if len(strSearchManufacturer) = 0 then
strSearchManufacturer = ""
manufacturer = ""
else
mySQL = "SELECT name FROM " & tablePrefix & "manufacturer WHERE idManufacturer = " & strSearchManufacturer
set rsTemp = openRSexecute(mySQL)
if not rsTemp.eof then
manufacturer = rsTemp("name")
else
manufacturer = ""
end if
end if
'
' Log the search
'
if strSearchCat <> 0 then
mySQL = "SELECT breadcrumb, categoryDesc FROM " & tablePrefix & "categories WHERE idCategory = " & strSearchCat
set rsTemp = openRSexecute(mySQL)
if not rsTemp.eof then
breadcrumb = rsTemp("breadcrumb") & ">" & rsTemp("categoryDesc")
end if
else
breadcrumb = ""
end if
mySQL = "INSERT INTO " & tablePrefix & "searchLog " _
& "(Category, MinPrice, MaxPrice, Keywords, Brand, Manufacturer, Created) " _
& "VALUES " _
& "('" & validSQL(breadcrumb,"A") & "'," & validSQL(strSearchMin,"D") & "," & validSQL(strSearchMax,"D") & ",'" & validSQL(strSearch,"A") & "','" & validSQL(brand,"A") & "','" & validSQL(manufacturer,"A") & "',"
if dbType = 0 then
mySQL = mySQL & "#" & Date() & "#)"
else
mySQL = mySQL & "'" & Date() & "')"
end if
set rsTemp = openRSexecute(mySQL)
end if
'---------------------------------
' PARMS - Specials
'---------------------------------
special = validHTML(Request.QueryString("special"))
if len(special) > 0 and special <> "Y" then
special = "N"
end if
wishlist = validHTML(Request.QueryString("wishlist"))
if len(wishlist) > 0 and wishlist <> "Y" then
wishlist = "N"
end if
favorites = validHTML(Request.QueryString("favorites"))
if len(favorites) > 0 and favorites <> "Y" then
favorites = "N"
end if
idbrand = validSQL(Request.QueryString("brand"),"I")
idmanufacturer = validSQL(Request.QueryString("manufacturer"),"I")
'---------------------------------
' PARMS - Categories
'---------------------------------
idCategory = Request.QueryString("idCategory")
if len(idCategory) > 0 then
'Validate that Category is numeric
if not IsNumeric(idCategory) then
errMsg = LangText("ErrInvCategory","")
call closeDB()
Response.redirect "sysMsg.asp?errMsg=" & server.URLEncode(errMsg)
end if
'Validate that Category exists in DB
mySQL = "SELECT idCategory, categoryDesc, categoryHTMLLong " _
& "FROM " & tablePrefix & "categories " _
& "WHERE idCategory = " & validSQL(idCategory,"I")
set rsTemp = openRSexecute(mySQL)
if rsTemp.eof then
'Give error
errMsg = LangText("ErrInvCategory","")
call closeDB()
Response.redirect "sysMsg.asp?errMsg=" & server.URLEncode(errMsg)
else
'Get Category HTML (Long)
categoryHTMLLong = trim(rsTemp("categoryHTMLLong"))
categoryDesc = trim(rsTemp("categoryDesc"))
end if
call closeRS(rsTemp)
end if
'---------------------------------
' PARMS - Validate
'---------------------------------
if len(strSearch & strSearchMin & strSearchMax & strSearchCat & strSearchBrand & strSearchManufacturer) = 0 _
and len(special) = 0 _
and len(idCategory) = 0 _
and len(wishlist) = 0 _
and len(favorites) = 0 _
and len(idbrand) = 0 _
and len(idmanufacturer) = 0 then
'If no valid parms were passed, or the script was called without
'parms, then display the entire category tree.
mySQL = "SELECT idCategory, categoryDesc " _
& "FROM " & tablePrefix & "categories " _
& "WHERE IdParentCategory = 0"
set rsTemp = openRSexecute(mySQL)
if rsTemp.eof then
errMsg = LangText("ErrInvCategory","") & " / " & LangText("ErrInvSearch","")
call closeDB()
Response.redirect "sysMsg.asp?errMsg=" & server.URLEncode(errMsg)
else
IDCategory = rsTemp("idCategory")
categoryDesc = rsTemp("categoryDesc")
end if
call closeRS(rsTemp)
end if
if len(Request.QueryString("curPage")) > 0 and not isNumeric(Request.QueryString("curPage")) then
errMsg = LangText("ErrInvParameter","Invalid Parameter")
call closeDB()
Response.redirect "sysMsg.asp?errMsg=" & server.URLEncode(errMsg)
end if
%>
<%
'Close Database Connection
call closeDB()
'*************************************************************************
'Main Shopping Cart Display Area
'*************************************************************************
sub cartMain()
response.write("
")
'Display message if any
if len(Request.querystring("msg")) > 0 then
'Response.write "
" & validHTML(Request.QueryString("Msg")) & "
"'
end if
'SEARCH
if len(strSearch & strSearchMin & strSearchMax & strSearchCat) > 0 then
listHeading = "
"
queryStr="manufacturer=" & idmanufacturer
call displayItems("manufacturername")
elseif len(wishlist) > 0 then
'wishlist
call displayItems("wishlist")
else
'CATEGORIES
'Determine category tree position (eg: You are at : cat1 > cat2)
catPos = getCategoryPos(IDCategory,"","Y")
'Expand the Category tree from the supplied category onward
catLst = expandCategory(IDCategory,"")
'Display Category Tree position
listHeading = "
"
'Display list of products that match category
if len(trim(catLst)) = 0 then
queryStr = "idcategory=" & IDCategory
call displayItems("list")
'Display Category Tree
else
call displayCategory()
end if
end if
end if
%>
<%
end sub
'*************************************************************************
'Expand Categories tree from given category (recursive). Will also
'display the number of products in each sub category.
'*************************************************************************
function expandCategory(IDCategory,tempStr)
dim mySQL, rsTemp, catArr, row
'Get Sub-Categories
mySQL = "SELECT idCategory, categoryDesc,categoryHTML," _
& " (SELECT COUNT(*) " _
& " FROM " & tablePrefix & "products a, " & tablePrefix & "categories_products b " _
& " WHERE a.idProduct = b.idProduct " _
& " AND b.idCategory = c.idCategory " _
& " AND active = -1) " _
& " AS prodCount " _
& "FROM " & tablePrefix & "categories c " _
& "WHERE idParentcategory = " & validSQL(idCategory,"I") & " " _
& "ORDER BY sortOrder, categoryDesc "
set rsTemp = openRSexecute(mySQL)
if not rsTemp.EOF then
'Use getRows() to reduce DB resource requirements. This is a
'little more difficult to work with, but makes the queries
'much faster. After populating the array, the values are :
'- catArr(0,row) = idCategory
'- catArr(1,row) = categoryDesc
'- catArr(2,row) = categoryHTML
'- catArr(3,row) = prodCount
catArr = rsTemp.getRows()
end if
call closeRS(rsTemp)
'Show Sub-Categories
if isArray(catArr) then
tempStr = tempStr & "
"
for row = 0 to UBound(catArr,2)
tempStr = tempStr & "
"
end if
expandCategory = tempStr
end function
'*************************************************************************
'Display Category Tree
'*************************************************************************
sub displayCategory()
%>
<% response.write listHeading
'Display Category HTML (Long)
if len(categoryHTMLLong) > 0 then
response.write langCategory(idCategory,"categoryHTMLLong",categoryHTMLLong)
end if
response.write catLst %>
<%
end sub
'*************************************************************************
'Display list of products for category
'*************************************************************************
sub displayItems(listAction)
'Initialize variables
count = 0
subCount = 0
if listViewLayout = 2 then '2 Column View
maxCol = 2
cellWidth = "prod-front2"
end if
if listViewLayout = 3 then '3 Column View
maxCol = 3
cellWidth = "prod-front"
end if
if listViewLayout = 4 then '4 Column View
maxCol = 4
cellWidth = "prod-front4"
end if
'Determine sort order
sortField = lcase(trim(validHTML(Request.QueryString("sortField"))))
if len(sortField) = 0 then
sortField = lcase(trim(Request.Form("sortField")))
if len(sortField) = 0 then
sortField = pListSortOrder
end if
end if
if sortField <> pListSortOrder _
and sortField <> "description" _
and sortField <> "price" _
and sortField <> "sortorder" _
and sortField <> "sku" then
sortField = pListSortOrder
end if
'Determine page number
curPage = validHTML(Request.QueryString("curPage"))
if len(curPage) = 0 or not isNumeric(curPage) then
curPage = Request.Form("curPage")
if len(curPage) = 0 or not isNumeric(curPage) then
curPage = 1
end if
else
curPage = CLng(curPage)
end if
'Create SQL statement
select case listAction
'SEARCH
case "search"
'SQL - General
mySQL = "SELECT a.idProduct,a.SKU,a.description," _
& " a.descriptionLong,a.listPrice,a.Price,a.wholesaleprice," _
& " a.SmallImageUrl,a.Stock,a.fileName," _
& " a.noShipCharge, a.handlingFee, minorder, idUom " _
& "FROM " & tablePrefix & "products a " _
& "WHERE a.active = -1 "
'SQL - Minimum Price
if strSearchMin <> 0 then
mySQL = mySQL & "AND a.Price >= " & validSQL(strSearchMin,"D") & " "
end if
'SQL - Maximum Price
if strSearchMax <> 0 then
mySQL = mySQL & "AND a.Price <= " & validSQL(strSearchMax,"D") & " "
end if
if len(strSearchBrand) <> 0 then
mySQL = mySQL & "AND a.idBrand = " & validSQL(strSearchBrand,"I") & " "
end if
if len(strSearchManufacturer) <> 0 then
mySQL = mySQL & "AND a.idManufacturer = " & validSQL(strSearchManufacturer,"I") & " "
end if
'SQL - Category
if strSearchCat <> 0 then
mySQL = mySQL _
& "AND EXISTS ("_
& " SELECT b.idCategory " _
& " FROM " & tablePrefix & "categories_products b " _
& " WHERE b.idProduct = a.idProduct " _
& " AND b.idCategory = " & validSQL(strSearchCat,"I") & ") "
end if
'SQL - Keywords
if len(strSearch) > 0 then
if strSearchType = "PHR" then
redim searchArr(0)
searchArr(0) = trim(strSearch)
else
searchArr = split(trim(strSearch)," ")
end if
tmpSQL1 = ""
for i = 0 to Ubound(searchArr)
tmpSQL1= tmpSQL1 & "( (a.details LIKE '%" & validSQL(searchArr(i),"A") & "%') OR (a.description LIKE '%" & validSQL(searchArr(i),"A") & "%') OR (a.descriptionLong LIKE '%" & validSQL(searchArr(i),"A") & "%') OR (a.SKU LIKE '%" & validSQL(searchArr(i),"A") & "%') )"
if i < Ubound(searchArr) then
if strSearchType = "OR" then
tmpSQL1 = tmpSQL1 & " OR "
else
tmpSQL1 = tmpSQL1 & " AND "
end if
end if
next
'Put it all together
mySQL = mySQL & " AND " & tmpSQL1
end if
'Sort Order
mySQL = mySQL & "ORDER BY a." & sortField
'------------------------------------------------------------
if debugMode = "Y" then response.write "" & vbCrLf
'SPECIALS
case "special"
mySQL = "SELECT idProduct,SKU,Description,DescriptionLong," _
& " ListPrice,wholesaleprice,Price,SmallImageUrl,Stock," _
& " fileName,noShipCharge,handlingFee, minorder, iduom " _
& "FROM " & tablePrefix & "products " _
& "WHERE hotDeal = -1 " _
& "AND active = -1 " _
& "ORDER BY " & sortField
'favorites
case "favorites"
mySQL = "SELECT idProduct,SKU,Description,DescriptionLong," _
& " ListPrice,wholesaleprice,Price,SmallImageUrl,Stock," _
& " fileName,noShipCharge,handlingFee, minorder, iduom " _
& "FROM " & tablePrefix & "products " _
& "WHERE idProduct IN " _
& "(SELECT idProduct " _
& "FROM " & tablePrefix & "favorites " _
& "WHERE idCustomer = " & validSQL(idSF,"I") & ") " _
& "AND active = -1 " _
& "ORDER BY " & sortField
'Brand Name
case "brandname"
mySQL = "SELECT idProduct,SKU,Description,DescriptionLong," _
& " ListPrice,wholesaleprice,Price,SmallImageUrl,Stock," _
& " fileName,noShipCharge,handlingFee,b.name, minorder, iduom " _
& "FROM " & tablePrefix & "products a INNER JOIN " & tablePrefix & "brand b ON a.idBrand = b.idBrand " _
& "WHERE a.idbrand = " & validSQL(idbrand,"I") & " " _
& "AND a.active = -1 " _
& "ORDER BY " & sortField
'Manufacturer Name
case "manufacturername"
mySQL = "SELECT idProduct,SKU,Description,DescriptionLong," _
& " ListPrice,wholesaleprice,Price,SmallImageUrl,Stock," _
& " fileName,noShipCharge,handlingFee,b.name, minorder, iduom " _
& "FROM " & tablePrefix & "products a INNER JOIN " & tablePrefix & "manufacturer b ON a.idManufacturer = b.idManufacturer " _
& "WHERE a.idmanufacturer = " & validSQL(idmanufacturer,"I") & " " _
& "AND a.active = -1 " _
& "ORDER BY " & sortField
'wishlist
case "wishlist"
mySQL = "SELECT idProduct,SKU,Description,DescriptionLong," _
& " ListPrice,wholesaleprice,Price,SmallImageUrl,Stock," _
& " fileName,noShipCharge, handlingFee, minorder, iduom " _
& "FROM " & tablePrefix & "products " _
& "WHERE hotDeal = -1 " _
& "AND active = -1 " _
& "ORDER BY " & sortField
'CATEGORY
case else
mySQL = "SELECT a.idProduct,a.SKU,a.Description," _
& " a.DescriptionLong,a.ListPrice,a.wholesaleprice,"_
& " a.Price,a.SmallImageUrl,a.Stock," _
& " a.fileName,a.noShipCharge,a.handlingfee, minorder, iduom " _
& "FROM " & tablePrefix & "products a, " & tablePrefix & "categories_products b " _
& "WHERE a.idProduct = b.idProduct " _
& "AND b.idCategory = " & validSQL(idCategory,"I") & " " _
& "AND a.active = -1 " _
& "ORDER BY a." & sortField
end select
'Create and Open recordset
set rsTemp = openRSopen(mySQL,0,adOpenStatic,adLockReadOnly,adCmdText,pMaxItemsPerPage)
'Read through recordset and display products
if rstemp.eof then
Response.write "
" & LangText("ErrNoRecFound","") & "
"
else
rstemp.MoveFirst
rstemp.PageSize = pMaxItemsPerPage
totalPages = rstemp.PageCount
totalRecs = rstemp.RecordCount
if curPage > totalPages then curPage = totalPages
rstemp.AbsolutePage = curPage
'Display Category HTML (Long)
if len(categoryHTMLLong) > 0 then %>
<%
end if
'Display top page navigation and sort
%>
<%=listHeading%>
<%
'Show list of Products
do while not rstemp.eof and count < rstemp.pageSize
IDProduct = rstemp("idProduct")
SKU = trim(rstemp("SKU")&"")
if session("language") = "en" then
Description = trim(rstemp("description")&"")
DescriptionLong = trim(rstemp("descriptionLong")&"")
else
Description = trim(langProduct(idProduct,"description",rstemp("description"))&"")
DescriptionLong = trim(langProduct(idProduct,"descriptionLong",rstemp("descriptionLong"))&"")
end if
listPrice = rstemp("listPrice")
Price = rstemp("price")
wholesaleprice = rstemp("wholesaleprice")
smallImageURL = trim(rstemp("smallImageUrl")&"")
smallImageURL2 = trim(rstemp("smallImageUrl")&"")
Stock = rstemp("Stock")
fileName = trim(rstemp("fileName")&"")
noShipCharge = trim(rstemp("noShipCharge")&"")
handlingFee = rstemp("handlingFee")
minorder = rstemp("minorder")
idUOM = rsTemp("idUOM")
if len(minorder) = 0 or Not IsNumeric(minorder) then
minorder = 1
end if
' Custom user exit to change pricing etc.
%>
<%
' Currency Support
listPrice = Exchange(listPrice)
price = Exchange(price)
handlingFee = Exchange(handlingFee)
wholesaleprice = Exchange(wholesaleprice)
idCust = sessionCust()
if Not IsNull(idCust) then
userroles = session(storeID & "userroles")
if (CInt(userroles) and CInt(WHOLESALER)) then
if price > wholesaleprice then price = wholesaleprice
end if
end if
'Check if we must show Classic (0) or Extended (1) layout
if listViewLayout = 0 or listViewLayout = 1 then
%>
"
call getprodDescLong()
response.write " "
'Extended Layout
if listViewLayout = 1 then
call getFreeShip()
call getStockLevel()
call getRatings()
end if %>
<% if listAction <> "favorites" then
call getAddButt()
else
call getDeleteButt()
end if %>
<% call getPricing(0) %>
<%
'Increment record counter & read next record
count = count + 1
rstemp.moveNext
'Check if we must show 2, 3 or 4 Column layouts
else
'Increment sub counter
subCount = subCount + 1
'Begin table row
if subCount = 1 then %>
<% end if
'If 2 Columns, show slightly differnt layout
if listViewLayout = 2 then
%>
<% call getprodDesc()
call getprodDescLong()
response.write " "
call getAddButt()
response.write ""
call getPricing(1)
response.write " " & vbCrLf
if listAction = "favorites" then
call getDeleteButt()
end if %>
<%
else
'If 3 Columns, show default layout
if listViewLayout = 3 then
%>
<% call getProdImage("center")
call getprodDesc()
call getprodDescLong()
call getPricing(1)
call getAddButt()
if listAction = "favorites" then
call getDeleteButt()
end if %>
<% else %>
<% call getProdImage2("center")
call getprodDesc()
call getprodDescLong()
call getPricing(1)
call getAddButt()
if listAction = "favorites" then
call getDeleteButt()
end if %>
<%
end if
end if
'Increment record counter & read next record
count = count + 1
rstemp.moveNext
'End table row
if subCount >= maxCol or rsTemp.EOF or count >= rstemp.pageSize then
'Write empty cells if necessary
'do while subCount < maxCol %>
<% subCount = subCount + 1
'loop
subCount = 0
end if
end if
loop
%>
<%
'Show bottom page navigation
if totalPages > 1 then
%>
<%
end if
end if
call closeRS(rsTemp)
end sub
'*********************************************************************
'Display page navigation
'*********************************************************************
sub pageNavigation(formFieldName)
Response.Write LangText("GenNavPage","") & " "
Response.Write " " & LangText("GenOf","") & " " & TotalPages & " "
Response.Write "[ "
if curPage > 1 then
Response.Write "" & LangText("GenNavBack","") & ""
else
Response.Write LangText("GenNavBack","")
end if
Response.Write " | "
if curPage < TotalPages then
Response.Write "" & LangText("GenNavNext","") & ""
else
Response.Write LangText("GenNavNext","")
end if
Response.Write " ]"
end sub
'*********************************************************************
'Display sort list
'*********************************************************************
sub pageSort(formFieldName)
Response.Write LangText("GenSort","") & " : "
%>
<%
end sub
'*********************************************************************
'Display product description
'*********************************************************************
sub getprodDesc()
%>
<%=addHighlight(Description,searchArr)%>
<%
end sub
'*********************************************************************
'Display product long description
'*********************************************************************
sub getprodDescLong()
%>
<%=addHighlight(DescriptionLong,searchArr)%>
<%
end sub
'*********************************************************************
'Display product SKU
'*********************************************************************
sub getprodSKU()
%>
(<%=addHighlight(SKU,searchArr)%>)
<%
end sub
'*********************************************************************
'Display prices
'priceDispType : 0 = Show List, Price, Discount amount
' : 1 = Show Price Only
'*********************************************************************
sub getPricing(priceDispType)
if not(pHidePricingZero=-1 and Price=0) then
if listPrice > Price and priceDispType = 0 then
%>
<%=LangText("GenListPrice","")%>:<%=moneyS(ListPrice)%> <%
end if
%>
<%=LangText("GenOurPrice","")%> <%=moneyS(Price)%> <%=getUOMabbr(idUOM)%>
<%
if (listPrice - Price) > 0 and priceDispType = 0 then
%>
<%=LangText("GenYouSave","")%>:<%=moneyS(listPrice-Price)%> (<%=formatNumber((((listPrice-Price)/listPrice)*100),0)%>%) <%
end if
if handlingFee > 0 then
%>
<%=LangText("GenHandlingFee","")%>:<%=moneyS(HandlingFee)%><%
end if
end if
end sub
'*********************************************************************
'Display product image
'imgAlign : Images are aligned according to the layout being used
'*********************************************************************
sub getProdImage(imgAlign)
%>
<%
if smallImageURL <> "" then
%>
<%
else
%>
<%=LangText("GenNoImage","")%>
<%
end if
end sub
sub getProdImage2(imgAlign)
%>
<%
if smallImageURL2 <> "" then
%>
<%
else
%>
<%=LangText("GenNoImage","")%>
<%
end if
%>
<%
end sub
'*********************************************************************
'Display Free Shipping Message
'*********************************************************************
sub getFreeShip()
if UCase(noShipCharge) = "Y" and len(fileName) = 0 then
%>
<%=LangText("GenFreeShipping","")%> <%
end if
end sub
'*********************************************************************
'Display Stock Level Message
'*********************************************************************
sub getStockLevel()
if pShowStockView = -1 then
if pHideAddStockLevel = -1 then
%>
<%=LangText("GenInStock","")%> <%
else
if Stock > pHideAddStockLevel then
%>
<%=LangText("GenInStock","")%> <%
else
%>
<%=LangText("GenOutStock","")%> <%
end if
end if
end if
end sub
'*********************************************************************
'Display Ratings
'*********************************************************************
sub getRatings()
dim mySQL, rsTemp
'Show current ratings
mySQL="SELECT SUM(revRating) AS revSum, " _
& " COUNT(revRating) AS revCount " _
& "FROM " & tablePrefix & "reviews " _
& "WHERE idProduct = " & validSQL(idProduct,"I") & " " _
& "AND revStatus = 'A' "
set rsTemp = openRSexecute(mySQL)
if not rsTemp.EOF then
if rsTemp("revSum") > 0 and rsTemp("revCount") > 0 then
%>
<%=LangText("GenAverageRating","")%> : <%=ratingImage(rsTemp("revSum")/rsTemp("revCount"))%> <%
end if
end if
call closeRS(rsTemp)
end sub
'*********************************************************************
'Get View Add Button
'*********************************************************************
sub getViewButt()
%>
View
<%
end sub
'*********************************************************************
'Get Delete Button
'*********************************************************************
sub getDeleteButt()
%>
Remove
<%
end sub
'*********************************************************************
'Display Add Button
'*********************************************************************
sub getAddButt()
dim mySQL, rsTemp
dim formAction
'Show Add button
if pCatalogOnly = 0 _
and hideAddOnProdList = 0 _
and minorder = 1 _
and (pHideAddStockLevel = -1 or pHideAddStockLevel < CDbl(Stock)) then
'Check for options and change form "action" attribute
mySQL = "SELECT idOptionGroup " _
& "FROM " & tablePrefix & "optionsGroupsXref " _
& "WHERE idProduct = " & validSQL(idProduct,"I")
set rsTemp = openRSexecute(mySQL)
if rsTemp.eof then
formAction = "cart.asp"
else
formAction = "prodView.asp"
end if
call closeRS(rsTemp)
%>
<%
end if
end sub
'*********************************************************************
'Display horizontal line
'*********************************************************************
sub getHLine()
%>
<%
end sub
'*********************************************************************
'Add highlights to text for search keys
'*********************************************************************
function addHighlight(byVal strIn, keyWords)
dim keyInd
if len(trim(strIn)) > 0 and isArray(keyWords) then
for keyInd = LBound(keyWords) to UBound(keyWords)
strIn = Replace(strIn, keyWords(keyInd), "*|*" & keyWords(keyInd) & "*||*", 1, -1, 1)
'strIn = Replace(strIn, keyWords(keyInd), "*|*" & UCase(keyWords(keyInd)) & "*||*", 1, -1, 1)
next
end if
strIn = Replace(strIn, "*|*", "")
strIn = Replace(strIn, "*||*", "")
addHighLight = strIn
end function
%>