%@ Language=VBScript %>
<%
'*************************************************************************
' DO NOT MODIFY THIS SCRIPT IF YOU WANT UPDATES TO WORK!
' Function : Display details for a specific product, including all
' : options.
' 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
' 12/02/06 Added display of stock level message to related products.
' 10/23/05 Added user exit
' 11/20/05 Corrected problem with price display in getProdRelated();
' 04/05/06 Made option required indicator a language phrase
' 04/18/06 Added branding support
' 09/07/07 Added missing variable errMsg
' 09/12/07 Fixed getStockProd to work correctly with related products
' 05/22/08 Fixed showZeroOptionPrice so that options with zero cost will be hiddenimage
' 06/09/08 Added code to return to last displayed category page and sortorder
' 12/17/08 Added code to support multiple product image display
' 03/31/09 Added UOM display to product price
' 02/07/10 Removed tables, replaced with div - candythemes.com
' 03/10/10 Parens where being displayed when stock status was not diplayed
' 03/10/10 Related products was displaying the stock status for the viewed item
'******************************************************************************************
Option explicit
Response.Buffer = true
%>
<%
'Product
dim IDProduct
dim Description
dim DescriptionLong
dim Price
dim Details
dim relatedKeys
dim listPrice
dim smallImageURL
dim imageURL
dim Stock
dim SKU
dim fileName
dim noShipCharge
dim reviewAllow
dim handlingFee
dim wholesaleprice
dim msrp
dim map
dim refurbished
dim freight
dim brand
dim estimatedship
dim idUOM
dim minorder
'Options
dim priceToAdd
dim percToAdd
'Work Fields
dim testMode
dim revCount
dim revSum
dim numMandatoryOpt
dim optSize
dim errMsg
dim sortField
dim curPage
dim idCategory
dim userroles
'Database
dim mySQL
dim conntemp
dim rstemp
dim rstemp2
dim rsTemp3
dim cats
'Work
dim idCust
dim idOrder
dim action
'*************************************************************************
selectedLang = Request.form("language")
if len(selectedLang) = 2 then
session("language") = selectedLang
Response.cookies("language") = selectedLang
Response.Cookies("language").expires = dateAdd("d",30,now())
else
selectedLang= Request.queryString("language")
if len(selectedLang) = 2 then
session("language") = selectedLang
Response.cookies("language") = selectedLang
Response.Cookies("language").expires = dateAdd("d",30,now())
end if
end if
'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()
if not IsNumeric(idCust) then idCust = session.sessionID
'Get/Set Affilate ID
call getIdAffiliate(validHTML(Request.QueryString("idAff")))
'Get action
action = trim(Request.QueryString("action"))
if len(action) = 0 then
action = trim(Request.Form("action"))
end if
action = lCase(action)
'Check Product Code
idProduct = trim(request("idProduct")&"")
if not IsNumeric(idProduct) then
'Check SKU
sku = trim(request("sku")&"")
if len(sku) > 0 then
mySQL = "SELECT idProduct " _
& "FROM " & tablePrefix & "products " _
& "WHERE sku = '" & validSQL(sku,"A") & "' "
set rsTemp = openRSexecute(mySQL)
if not rsTemp.EOF then
idProduct = rsTemp("idProduct")
else
errMsg = LangText("ErrInvProdID","")
call closeDB()
Response.redirect "sysMsg.asp?errMsg=" & server.URLEncode(errMsg)
end if
call closeRS(rsTemp)
else
errMsg = LangText("ErrInvProdID","")
call closeDB()
Response.redirect "sysMsg.asp?errMsg=" & server.URLEncode(errMsg)
end if
end if
'Check if Product is being displayed as a Test
if Instr(lCase(Request.ServerVariables("HTTP_REFERER")),"/sa_prod") = 0 then
testMode = false
else
testMode = true
end if
'Get Product Detail
mySQL = "SELECT description,descriptionLong,relatedKeys,price,wholesaleprice,idUOM," _
& " listprice,smallImageUrl,imageurl,stock,sku," _
& " fileName,noShipCharge,reviewAllow,details, handlingFee, minorder " _
& "FROM " & tablePrefix & "products " _
& "WHERE idProduct = " & validSQL(idProduct,"I") & " "
if not testMode then
mySQL = mySQL & "AND active = -1"
end if
set rsTemp = openRSexecute(mySQL)
if rsTemp.eof then
errMsg = LangText("ErrInvProdID","")
call closeDB()
Response.redirect "sysMsg.asp?errMsg=" & server.URLEncode(errMsg)
end if
'Assign product DB fields to local fields
relatedKeys = trim(rsTemp("relatedKeys")&"")
Price = rsTemp("price")
idUOM = rsTemp("idUOM")
listPrice = rsTemp("listPrice")
smallImageURL = trim(rsTemp("SmallImageUrl")&"")
imageURL = trim(rsTemp("imageUrl")&"")
Stock = rsTemp("stock")
sku = trim(rsTemp("sku")&"")
fileName = trim(rsTemp("fileName")&"")
noShipCharge = trim(rsTemp("noShipCharge")&"")
reviewAllow = trim(rsTemp("reviewAllow")&"")
handlingFee = rsTemp("handlingFee")
wholesaleprice = rsTemp("wholesaleprice")
minorder = rsTemp("minorder")
if len(minorder) = 0 or not IsNumeric(minorder) then
minorder = 1
end if
'Language for product descriptions
Details = trim(langProduct(idProduct,"details",rsTemp("details")))
Description = trim(langProduct(idProduct,"description",rsTemp("description")))
DescriptionLong = trim(langProduct(idProduct,"DescriptionLong",rsTemp("DescriptionLong")))
closeRS(rsTemp)
'Build a category keyword string
mySQL = "SELECT a.idProduct, b.categoryDesc " _
& "FROM " & tablePrefix & "Categories_Products a INNER JOIN " & tablePrefix & "Categories b ON a.idCategory = b.idCategory " _
& "WHERE (((a.idProduct)= " & validSQL(idProduct,"I") & "));"
set rsTemp = openRSexecute(mySQL)
do while not rsTemp.eof
cats = cats & trim(rsTemp("categoryDesc")) & ","
rsTemp.moveNext
loop
if len(cats) > 0 then cats = mid(cats,1,len(cats) - 1)
closeRS(rsTemp)
'Get the return parameters
curPage = Request.Form("curPage")
if len(curPage) = 0 or not IsNumeric(curPage) then
curPage = 1
end if
sortField = validHTML(Request.Form("sortField"))
if len(sortField) = 0 then
sortField = pListSortOrder
end if
idCategory = Request.Form("idCategory")
if len(idCategory) = 0 or not IsNumeric(idCategory) then
idCategory = 1 'All Categories
end if
%>
<%
'Close Database Connection
call closeDB()
'*************************************************************************
'Main Shopping Cart Display Area
'*************************************************************************
sub cartMain()
%>
<%
' Adjust for displayed currency
listPrice = Exchange(listPrice)
price = Exchange(price)
wholesaleprice = Exchange(wholesaleprice)
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
'if Request.QueryString("Msg") <> "" Then
'Response.write "
" & validHTML(Request.QueryString("Msg")) & "
"
'end if
%>
<% call getProdRelated() %>
<% if pUseProdView = "-1" then call getProductRecommendations(idProduct) %>
<% if pUseProdView = "-1" then
call getProductRecommendations(idProduct)
end if %>
<%
end if %>
<%
end sub
'*************************************************************************
' Display Product Details
'*************************************************************************
sub getProdDetail()
%>
<%=Description%>
<%
if len(Details) = 0 then %>
<%call getProdStock(idProduct)%><%=DescriptionLong%>
<% else %>
<%call getProdStock(idProduct)%><%=Details%>
<% end if
%>
<%
end sub
'*************************************************************************
' Display Product Pricing
'*************************************************************************
sub getProdPricing()
'Check if we need to hide pricing if price=0
if pHidePricingZero=-1 and Price=0 then
exit sub
end if
'Show Prices
%>
<%
if lCase(sku) = "cert" then
'do nothing
Else
if listPrice > Price then
%>
<%=LangText("GenListPrice","")%> : <%=moneyS(ListPrice)%>
<% end if %>
<%=LangText("GenOurPrice","")%> : <%=moneyS(Price)%>
<% if (listPrice - Price) > 0 then %>
<%=LangText("GenYouSave","")%> : <%=moneyS(ListPrice-Price)%> (<%=formatNumber((((listPrice-Price)/listPrice)*100),0)%>%)
<% end if
if handlingFee > 0 then
%>
+ <%=LangText("GenHandlingFee","")%> : <%=moneyS(Exchange(handlingFee))%>
<%
end if
end if
%>
<%
end sub
'*************************************************************************
' Display Certificate Pricing
'*************************************************************************
sub getCertPricing()
'Place a page break here to adjust the spacing as we don't need to
'show the products price.
response.write " "
end sub
'*************************************************************************
' Display Product Stock Description
'*************************************************************************
sub getProdStock(idProduct)
dim rsTemp, mySQL
mySQL = "SELECT stock FROM " & tablePrefix & "products WHERE idproduct = " & validSQL(idProduct,"I")
set rsTemp = openRSexecute(mySQL)
if not rsTemp.eof then
if pShowStockView = -1 then
response.write "( "
if pHideAddStockLevel = -1 then %>
<%=LangText("GenInStock","")%>
<% else
if rsTemp("stock") > pHideAddStockLevel then %>
<%=LangText("GenInStock","")%>
<% else %>
<%=LangText("GenOutStock","")%>
<% end if
end if
response.write " )"
end if
end if
end sub
'*************************************************************************
' Display Free Shipping message
'*************************************************************************
sub getFreeShipMsg()
if UCase(noShipCharge) = "Y" and len(fileName) = 0 then %>
<%=LangText("GenFreeShipping","")%>
<% end if
end sub
'*************************************************************************
' Produce a selection box for the price of the gift certificate
'*************************************************************************
sub certAmount()
dim mySQL, rsTemp, i
%>
<%
end sub
'*************************************************************************
' Display Product Options
'*************************************************************************
sub getOptionsGroups()
dim mySQL, rstemp, rstemp2, rstemp3, optionDesc
if lCase(sku) = "cert" then
call certAmount
end if
'Initialise mandatory option counter
numMandatoryOpt = 0
'Get option groups for this Product
mySQL = "SELECT a.idOptionGroup, a.optionGroupDesc, " _
& " a.optionReq, a.optionType, a.optionLength " _
& "FROM " & tablePrefix & "optionsGroups a, " & tablePrefix & "optionsGroupsXref b " _
& "WHERE a.idOptionGroup = b.idOptionGroup " _
& "AND b.idProduct = " & validSQL(idProduct,"I") & " " _
& "ORDER BY a.sortOrder, a.optionGroupDesc "
set rsTemp2 = openRSexecute(mySQL)
'Extra line break before displaying option groups
if not rsTemp2.EOF then
Response.Write " "
end if
'Loop through option groups
do while not rstemp2.EOF
'Get Options for Option Group
mySQL = "SELECT b.idOption, b.optionDescrip, b.priceToAdd, " _
& " b.percToAdd " _
& "FROM " & tablePrefix & "optionsXref a, " & tablePrefix & "options b " _
& "WHERE a.idOptionGroup = " & rstemp2("idOptionGroup") & " " _
& "AND b.idOption = a.idOption " _
& "AND NOT EXISTS " _
& " (SELECT c.idOptionsProdEx " _
& " FROM " & tablePrefix & "OptionsProdEx c " _
& " WHERE c.idOption = b.idOption " _
& " AND c.idProduct = " & validSQL(idProduct,"I") & ") " _
& "ORDER BY b.sortOrder, b.optionDescrip "
set rsTemp3 = openRSexecute(mySQL)
if not rstemp3.EOF then
'Show option headings
if UCase(rstemp2("optionReq")) = "Y" then
numMandatoryOpt = numMandatoryOpt + 1%>
<%=LangText(rstemp2("optionGroupDesc"),rstemp2("optionGroupDesc"))%> <%=LangText("GenRequired","(Required)")%> :
<% else %>
<%=LangText(rstemp2("optionGroupDesc"),rstemp2("optionGroupDesc"))%> :
<% end if
'Create hidden variables that will be used in validations %>
<%
'Show Drop-Down List options
if rstemp2("optionType") = "S" then
if UCase(rstemp2("optionReq")) = "Y" and OptionInventory(idProduct) then %>