%@ 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 : 2.5
' Modified : February 2004
' Copyright: Copyright (C) 2004 CandyPress.Com
' 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 webmaster@candypress.com
'*************************************************************************
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
'Options
dim priceToAdd
dim percToAdd
'Work Fields
dim testMode
dim revCount
dim revSum
dim numMandatoryOpt
dim optSize
'Database
dim mySQL
dim conntemp
dim rstemp
dim rstemp2
dim rsTemp3
'Session
dim idOrder
dim idCust
'*************************************************************************
'Open Database Connection
call openDb()
'Store Configuration
if loadConfig() = false then
call errorDB(langErrConfig,"")
end if
'Get/Set Cart/Order Session
idOrder = sessionCart()
'Get/Set Customer Session
idCust = sessionCust()
'Get/Set Affilate ID
call getIdAffiliate(Request.QueryString("idAff"))
'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 products " _
& "WHERE sku = '" & validSQL(sku,"A") & "' "
set rsTemp = openRSexecute(mySQL)
if not rsTemp.EOF then
idProduct = rsTemp("idProduct")
else
response.redirect "sysMsg.asp?errMsg=" & server.URLEncode(langErrInvProdID)
end if
call closeRS(rsTemp)
else
response.redirect "sysMsg.asp?errMsg=" & server.URLEncode(langErrInvProdID)
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," _
& " listprice,smallImageUrl,imageurl,stock,sku," _
& " fileName,noShipCharge,reviewAllow,details " _
& "FROM 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
response.redirect "sysMsg.asp?errMsg=" & server.URLEncode(langErrInvProdID)
end if
'Assign product DB fields to local fields
Details = trim(rsTemp("details")&"")
Description = trim(rsTemp("description")&"")
DescriptionLong = trim(rsTemp("DescriptionLong")&"")
relatedKeys = trim(rsTemp("relatedKeys")&"")
Price = rsTemp("price")
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")&"")
call closeRS(rsTemp)
%>
<%
'Close Database Connection
call closeDb()
'*************************************************************************
'Main Shopping Cart Display Area
'*************************************************************************
sub cartMain()
%>
<%
end sub
'*************************************************************************
' Display Product Details
'*************************************************************************
sub getProdDetail()
if len(Details) = 0 then %>
<%=DescriptionLong%>
<% else %>
<%=Details%>
<% end if
end sub
'*************************************************************************
' Display Product Pricing
'*************************************************************************
sub getProdPricing()
if isEmpty(idCust) or not IsNumeric(idCust) Then
Response.Write "Para informações sobre este produto entre em contato. É necessário uma senha para ter acesso.
"
else
'Check if we need to hide pricing if price=0
if pHidePricingZero=-1 and Price=0 then
exit sub
end if
'Show Prices
if listPrice > Price then
%> <%=langGenListPrice%>:<%=pCurrencySign & moneyS((listPrice))%>
<% end if %>
<%=langGenOurPrice%>:<%=pCurrencySign & moneyS(Price)%>
<% if (listPrice - Price) > 0 then %>
<%=langGenYouSave%>:<%=pCurrencySign & moneyS((listPrice-Price))%> (<%=formatNumber((((listPrice-Price)/listPrice)*100),0)%>%)
<% end if %>
<%
end if
end sub
'*************************************************************************
' Display Product Stock Description
'*************************************************************************
sub getProdStock()
if pShowStockView = -1 then
if pHideAddStockLevel = -1 then %>
<%=langGenInStock%>
<% else
if Stock > pHideAddStockLevel then %>
<%=langGenInStock%>
<% else %>
<%=langGenOutStock%>
<% end if
end if
end if
'*FACEBOOK
dim thispage
thispage ="http://" & Request.ServerVariables("SERVER_NAME") & Request.ServerVariables("URL") & "?" & Request.Querystring
%>
Recomende para seus amigos no facebook:
<%
end sub
'*************************************************************************
' Display Free Shipping message
'*************************************************************************
sub getFreeShipMsg()
if UCase(noShipCharge) = "Y" and len(fileName) = 0 then %>
<%=langGenFreeShipping%>
<% end if
end sub
'*************************************************************************
' Display Product Options
'*************************************************************************
sub getOptionsGroups()
dim mySQL, rstemp, rstemp2, rstemp3, optionDesc
'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 optionsGroups a, 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 optionsXref a, options b " _
& "WHERE a.idOptionGroup = " & rstemp2("idOptionGroup") & " " _
& "AND b.idOption = a.idOption " _
& "AND NOT EXISTS " _
& " (SELECT c.idOptionsProdEx " _
& " FROM 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%>
<%=rstemp2("optionGroupDesc")%> (*) :
<% else %>
<%=rstemp2("optionGroupDesc")%> :
<% end if
'Create hidden variables that will be used in validations %>
" value="<%=rstemp2("optionGroupDesc")%>">
" value="<%=rstemp2("optionReq")%>">
" value="<%=rstemp2("optionType")%>">
<%
'Show Drop-Down List options
if rstemp2("optionType") = "S" then%>
<% end if
'Show Radio Button options
if rstemp2("optionType") = "R" then
'Only show "Not Applicable" if the option group is optional
if UCase(rstemp2("optionReq")) = "N" then %>
" value="" checked>
<%=langGenNotApplicable%>
<% end if
do while not rstemp3.EOF
priceToAdd = getOptionPrice(rstemp3("priceToAdd"),rstemp3("percToAdd"),price)
optionDesc = rstemp3("optionDescrip")
if priceToAdd > 0 then
optionDesc = optionDesc & " " & pCurrencySign & moneyS(priceToAdd)
end if %>
" value="<%=rstemp3("idOption")%>">
<%=optionDesc%>
<% rstemp3.movenext
loop %>
<% end if
'Show Text Input options
if rstemp2("optionType") = "T" then
if rsTemp2("optionLength") > 25 then
optSize = 25
else
optSize = rsTemp2("optionLength")
end if %>
" value="<%=rstemp3("idOption")%>">
" size="<%=optSize%>" maxlength="<%=rsTemp2("optionLength")%>" class="CPoptTxt">
<% end if
end if
call closeRS(rsTemp3)
rstemp2.movenext
loop
call closeRS(rsTemp2)
end sub
'*************************************************************************
' Display Qty box and Add Button
'*************************************************************************
sub getQtyAndAdd()
if isEmpty(idCust) or not IsNumeric(idCust) then %>
<% else
if pCatalogOnly = 0 and _
(pHideAddStockLevel = -1 or _
pHideAddStockLevel < CDbl(Stock)) then
%>
<% if rsTemp("discToQty") > 9999 then
response.Write ">"
else
response.Write rsTemp("discToQty")
end if %>
<%=langGenSave%>
<% if isNull(rsTemp("discPerc")) then
Response.Write pCurrencySign & moneyS(rsTemp("discAmt")) & " " & langGenEach
else
Response.Write rsTemp("discPerc") & "% " & langGenEach
end if %>
<% rsTemp.Movenext
loop %>
<% end if
call closeRS(rsTemp)
end if
end sub
'*************************************************************************
' Display Related Products
'*************************************************************************
sub getProdRelated()
dim mySQL, rstemp, rsTemp2, count
const bullet = "
"
%>
<%=langGenRelatedProd%> :
<%
'Get Product Group products
mySQL="SELECT prodGroupP " _
& "FROM productGroups " _
& "WHERE prodGroupC = " & validSQL(idProduct,"I")
set rsTemp = openRSexecute(mySQL)
do while not rsTemp.EOF
mySQL="SELECT b.idProduct, b.description,b.price, " _
& " b.smallImageURL, b.descriptionLong " _
& "FROM productGroups a, products b " _
& "WHERE a.prodGroupP = " & rsTemp("prodGroupP") & " " _
& "AND a.prodGroupC <> " & validSQL(idProduct,"I") & " " _
& "AND b.idProduct = a.prodGroupC " _
& "AND b.active = -1 " _
& "ORDER BY b.description "
set rsTemp2 = openRSexecute(mySQL)
do while not rstemp2.EOF
count = count + 1
'Show thumbnails and long description
if pProdThumbs = -1 then
if count = 1 then %>
<% end if
if len(trim(rsTemp2("smallImageURL"))&"") > 0 then %>
">" vspace=3 align=left border=0>
<% else
response.Write bullet & " "
end if %>
"><%=rsTemp2("description")%> <% if isEmpty(idCust) or not IsNumeric(idCust) then %><% else %><%=pCurrencySign & moneyS(rsTemp2("Price"))%><% end if %> <%=rsTemp2("descriptionLong")%>
<% else %>
<%=bullet%> "><%=rsTemp2("description")%> <% if isEmpty(idCust) or not IsNumeric(idCust) then %><% else %><%=pCurrencySign & moneyS(rsTemp2("Price"))%><% end if %>
<% end if
rsTemp2.Movenext
loop
call closeRS(rsTemp2)
rsTemp.Movenext
loop
call closeRS(rsTemp)
'Get categories for this product
mySQL="SELECT a.idCategory, b.categoryDesc " _
& "FROM Categories_Products a " _
& "INNER JOIN Categories b " _
& "ON a.idCategory = b.idCategory " _
& "WHERE a.idProduct = " & validSQL(idProduct,"I")
set rsTemp = openRSexecute(mySQL)
do while not rsTemp.eof %>
<%=bullet%> "><%=getCategoryPos(rsTemp("idCategory"),"","Y")%>
<% rsTemp.movenext
loop
call closeRS(rsTemp)
'Related keys for this product
if len(relatedKeys) > 0 then %>
<%=bullet%> <%=langGenSearchRelated%>
<% end if
end sub
'*************************************************************************
' Display Product Review Summary
'*************************************************************************
sub getProdReview()
dim mySQL, rstemp
'Check if reviews are allowed for this product
if UCase(reviewAllow) = "Y" then
%>
<%=langGenProductReviews%> :
<%
'Get current ratings
mySQL="SELECT SUM(revRating) AS revSum, " _
& " COUNT(revRating) AS revCount " _
& "FROM reviews " _
& "WHERE idProduct = " & validSQL(idProduct,"I") & " " _
& "AND revStatus = 'A' "
set rsTemp = openRSexecute(mySQL)
if not rsTemp.EOF then
revSum = rsTemp("revSum")
revCount = rsTemp("revCount")
else
revSum = 0
revCount = 0
end if
call closeRS(rsTemp)
'Show Ratings
if revSum > 0 and revCount > 0 then
%>
<%=langGenAverageRating%> : <%=ratingImage(revSum/revCount)%> <%=langGenNumberReviews%> : <%=revCount%>
<%
end if
%>
<%=langGenWriteReview%>
<%
end if
end sub
'*************************************************************************
' Display Product Image
'*************************************************************************
sub getProdImage()
if imageURL <> "" then %>
<% else
if smallImageURL <> "" then %>
<% else %>
<%=langGenNoImage%>
<% end if
end if
end sub
'*************************************************************************
' Display Miscellaneous items
'*************************************************************************
sub getMisc()
if mailComp <> 0 or demoMode = "Y" then
%>
<%=langGenMiscellaneous%> : <%=langGenEmailFriendHdr%> "><%=langGenProdInquiry%>
<%
end if
end sub
'*************************************************************************
' Display "Mandatory" message
'*************************************************************************
sub getMandatoryMsg()
if numMandatoryOpt > 0 then
%>
(*) <%=langGenMandatoryOpt%>
<%
end if
end sub
%>