<%@ 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 : 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 %> <% '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 dim sortField dim queryStr dim subCount, maxCol, cellWidth dim searchArr dim tmpSQL1, tmpSQL2, tmpSQL3, tmpSQL4 'Categories dim IDCategory dim categoryDesc dim IDParentCategory dim categoryHTML dim categoryHTMLLong dim sortOrder 'Product dim IDProduct dim SKU dim Description dim DescriptionLong dim Price dim Details dim listPrice dim smallImageURL dim imageURL dim Stock dim fileName dim noShipCharge 'Database dim mySQL dim conntemp dim rstemp dim rstemp2 '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")) '--------------------------------- ' PARMS - Search '--------------------------------- strSearch = Request("strSearch") strSearchType = Request("strSearchType") strSearchMin = Request("strSearchMin") strSearchMax = Request("strSearchMax") strSearchCat = Request("strSearchCat") if len(strSearch & strSearchMin & strSearchMax & strSearchCat) > 0 then 'Get rid of malicious HTML strSearch = validHTML(strSearch) strSearchType = validHTML(strSearchType) strSearchMin = validHTML(strSearchMin) strSearchMax = validHTML(strSearchMax) strSearchCat = validHTML(strSearchCat) '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) = 0 then Response.Clear response.redirect "sysMsg.asp?errMsg=" & server.URLEncode(langErrInvSearch) 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 end if '--------------------------------- ' PARMS - Specials '--------------------------------- special = Request.QueryString("special") if len(special) > 0 and special <> "Y" then special = "N" end if '--------------------------------- ' PARMS - Categories '--------------------------------- idCategory = Request.QueryString("idCategory") if len(idCategory) > 0 then 'Validate that Category is numeric if not IsNumeric(idCategory) then Response.Clear response.redirect "sysMsg.asp?errMsg=" & server.URLEncode(langErrInvCategory) end if 'Validate that Category exists in DB mySQL = "SELECT idCategory, categoryHTMLLong " _ & "FROM categories " _ & "WHERE idCategory = " & validSQL(idCategory,"I") set rsTemp = openRSexecute(mySQL) if rsTemp.eof then 'Give error Response.Clear response.redirect "sysMsg.asp?errMsg=" & server.URLEncode(langErrInvCategory) else 'Get Category HTML (Long) categoryHTMLLong = trim(rsTemp("categoryHTMLLong")) end if call closeRS(rsTemp) end if '--------------------------------- ' PARMS - Validate '--------------------------------- if len(strSearch & strSearchMin & strSearchMax & strSearchCat) = 0 _ and len(special) = 0 _ and len(idCategory) = 0 then 'If no valid parms were passed, or the script was called without 'parms, then display the entire category tree. mySQL = "SELECT idCategory " _ & "FROM categories " _ & "WHERE IdParentCategory = 0" set rsTemp = openRSexecute(mySQL) if rsTemp.eof then Response.Clear response.redirect "sysMsg.asp?errMsg=" & server.URLEncode(langErrInvCategory & " / " & langErrInvSearch) else IDCategory = rsTemp("idCategory") end if call closeRS(rsTemp) end if %> <% 'Close Database Connection call closeDb() '************************************************************************* 'Main Shopping Cart Display Area '************************************************************************* sub cartMain() 'SEARCH if len(strSearch & strSearchMin & strSearchMax & strSearchCat) > 0 then listHeading = "" & langGenSearchFor & " : " & strSearch & " [" & strSearchType & "," & strSearchMin & "," & strSearchMax & "," & strSearchCat & "] " queryStr = "strSearch=" & Server.UrlEncode(strSearch) & "&strSearchType=" & Server.UrlEncode(strSearchType) & "&strSearchMin=" & Server.UrlEncode(strSearchMin) & "&strSearchMax=" & Server.UrlEncode(strSearchMax) & "&strSearchCat=" & Server.UrlEncode(strSearchCat) call displayItems("search") else 'SPECIALS if len(special) > 0 then listHeading = "" & langGenSpecials & "" queryStr = "special=Y" call displayItems("special") 'CATEGORIES else '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 = "" & langGenYouAreAt & " : " & catPos '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 products, categories_products " _ & " WHERE products.idProduct = categories_products.idProduct " _ & " AND categories_products.idCategory = categories.idCategory " _ & " AND active = -1) " _ & " AS prodCount " _ & "FROM categories " _ & "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 & "" end if expandCategory = tempStr end function '************************************************************************* 'Display Category Tree '************************************************************************* sub displayCategory() %>
<%=listHeading%>

<%=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 = 50 end if if listViewLayout = 3 then '3 Column View maxCol = 3 cellWidth = 33 end if if listViewLayout = 4 then '4 Column View maxCol = 4 cellWidth = 25 end if 'Determine sort order sortField = lcase(trim(Request.QueryString("sortField"))) if sortField <> "description" _ and sortField <> "price" _ and sortField <> "sortorder" _ and sortField <> "sku" then sortField = "sortorder" end if 'Determine page number curPage = Request.QueryString("curPage") if len(curPage) = 0 or not isNumeric(curPage) then curPage = 1 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.SmallImageUrl,a.Stock,a.fileName," _ & " a.noShipCharge " _ & "FROM 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 'SQL - Category if strSearchCat <> 0 then mySQL = mySQL _ & "AND EXISTS ("_ & " SELECT b.idCategory " _ & " FROM categories_products b " _ & " WHERE b.idProduct = a.idProduct " _ & " AND b.idCategory = " & validSQL(strSearchCat,"I") & ") " end if 'SQL - Keywords if len(strSearch) > 0 then 'Create array of keywords. If we're doing a PHRase 'search, an array with only one position is created 'containing the entire search string. If an AND or 'an OR "keyword" search is being performed, each word 'is put into it's own array position. if strSearchType = "PHR" then redim searchArr(0) searchArr(0) = trim(strSearch) else searchArr = split(trim(strSearch)," ") end if 'Keyword search SQL tmpSQL1 = "(a.details LIKE " tmpSQL2 = "(a.description LIKE " tmpSQL3 = "(a.descriptionLong LIKE " tmpSQL4 = "(a.SKU LIKE " for i = 0 to Ubound(searchArr) if i = Ubound(searchArr) then tmpSQL1 = tmpSQL1 & "'%" & validSQL(searchArr(i),"A") & "%')" tmpSQL2 = tmpSQL2 & "'%" & validSQL(searchArr(i),"A") & "%')" tmpSQL3 = tmpSQL3 & "'%" & validSQL(searchArr(i),"A") & "%')" tmpSQL4 = tmpSQL4 & "'%" & validSQL(searchArr(i),"A") & "%')" else tmpSQL1 = tmpSQL1 & "'%" & validSQL(searchArr(i),"A") & "%' " & strSearchType & " a.details LIKE " tmpSQL2 = tmpSQL2 & "'%" & validSQL(searchArr(i),"A") & "%' " & strSearchType & " a.description LIKE " tmpSQL3 = tmpSQL3 & "'%" & validSQL(searchArr(i),"A") & "%' " & strSearchType & " a.descriptionLong LIKE " tmpSQL4 = tmpSQL4 & "'%" & validSQL(searchArr(i),"A") & "%' " & strSearchType & " a.SKU LIKE " end if next 'Put it all together mySQL = mySQL & "AND (" & tmpSQL1 & " OR " & tmpSQL2 & " OR " & tmpSQL3 & " OR " & tmpSQL4 & ") " end if 'Sort Order mySQL = mySQL & "ORDER BY a." & sortField '------------------------------------------------------------ 'SPECIALS case "special" mySQL = "SELECT idProduct,SKU,Description,DescriptionLong," _ & " ListPrice,Price,SmallImageUrl,Stock," _ & " fileName,noShipCharge " _ & "FROM 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.Price,a.SmallImageUrl,a.Stock," _ & " a.fileName,a.noShipCharge " _ & "FROM products a, 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 "

" & langErrNoRecFound & "

" else rstemp.MoveFirst rstemp.PageSize = pMaxItemsPerPage totalPages = rstemp.PageCount totalRecs = rstemp.RecordCount rstemp.AbsolutePage = curPage %>
<%=listHeading%>

<% 'Display Category HTML (Long) if len(categoryHTMLLong) > 0 then %>
<%=categoryHTMLLong%>

<% end if 'Display top page navigation and sort %>
<% 'Show Page Navigation if more than one page if totalPages > 1 then call pageNavigation("selectPageTop") else Response.Write " " end if %> <% 'Show Page Sort if more than one product if totalRecs > 1 then call pageSort("sortPageTop") else Response.Write " " end if %>

<% 'Show list of Products do while not rstemp.eof and count < rstemp.pageSize IDProduct = rstemp("idProduct") SKU = trim(rstemp("SKU")&"") Description = trim(rstemp("description")&"") DescriptionLong = trim(rstemp("descriptionLong")&"") listPrice = rstemp("listPrice") Price = rstemp("price") smallImageURL = trim(rstemp("smallImageUrl")&"") Stock = rstemp("Stock") fileName = trim(rstemp("fileName")&"") noShipCharge = trim(rstemp("noShipCharge")&"") 'Check if we must show Classic (0) or Extended (1) layout if listViewLayout = 0 or listViewLayout = 1 then %> <% '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 %> <% else %> <% 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 %>
<%call getprodDesc()%> <%call getprodSKU()%>

<%call getprodDescLong()%>

<%call getPricing(0)%>      <% 'Extended Layout if listViewLayout = 1 then call getFreeShip() call getStockLevel() call getRatings() end if %>
<%call getProdImage("center")%> <%call getViewButt()%>
<%call getAddButt()%>
<%call getHLine()%>
<%call getProdImage("right")%> <%call getprodDesc()%>

<%call getprodDescLong()%>

<%call getPricing(1)%>
<%call getViewButt()%>    <%call getAddButt()%>
<%call getProdImage("center")%>
<%call getprodDesc()%>
<%call getPricing(1)%>
<%call parc()%>
<%call getViewButt()%> <%call getAddButt()%>
 

<% 'Show bottom page navigation if totalPages > 1 then %>
<%call pageNavigation("selectPageBot")%>
<% end if end if call closeRS(rsTemp) end sub '********************************************************************* 'Display page navigation '********************************************************************* sub pageNavigation(formFieldName) Response.Write langGenNavPage & " " Response.Write " " & langGenOf & " " & TotalPages & "  " Response.Write "[ " if curPage > 1 then Response.Write "" & langGenNavBack & "" else Response.Write langGenNavBack end if Response.Write " | " if curPage < TotalPages then Response.Write "" & langGenNavNext & "" else Response.Write langGenNavNext end if Response.Write " ]" end sub '********************************************************************* 'Display sort list '********************************************************************* sub pageSort(formFieldName) Response.Write langGenSort & " : " %> <% 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 isEmpty(idCust) or not IsNumeric(idCust) then %> Para informacoes sobre este produto entre em contato.
E necessario uma senha para ter acesso.


R$ Cadastre-se

<% else if not(pHidePricingZero=-1 and Price=0) then if listPrice > Price and priceDispType = 0 then %> <%=langGenListPrice%>: <%=pCurrencySign & moneyS((listPrice))%>
<% end if %> <%=langGenOurPrice%>: <%=pCurrencySign & moneyS(Price)%>
<% if (listPrice - Price) > 0 and priceDispType = 0 then %> <%=langGenYouSave%>: <%=pCurrencySign & moneyS((listPrice-Price)) & " (" & formatNumber((((listPrice-Price)/listPrice)*100),0)%>%)
<% end if 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 %> <%=server.HTMLEncode(description)%>
<% else %> <%=langGenNoImage%>

<% end if %>
<% end sub '********************************************************************* 'Display Free Shipping Message '********************************************************************* sub getFreeShip() if UCase(noShipCharge) = "Y" and len(fileName) = 0 then %> <%=langGenFreeShipping%>
<% end if end sub '********************************************************************* 'Display Stock Level Message '********************************************************************* sub getStockLevel() if pShowStockView = -1 then if pHideAddStockLevel = -1 then %> <%=langGenInStock%>
<% else if Stock > pHideAddStockLevel then %> <%=langGenInStock%>
<% else %> <%=langGenOutStock%>
<% 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 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 %> <%=langGenAverageRating%> : <%=ratingImage(rsTemp("revSum")/rsTemp("revCount"))%>
<% end if end if call closeRS(rsTemp) end sub '********************************************************************* 'Get View Add Button '********************************************************************* sub getViewButt() %>
<% end sub '********************************************************************* 'Display Add Button '********************************************************************* sub getAddButt() if isEmpty(idCust) or not IsNumeric(idCust) then %> Comprar
<% else dim mySQL, rsTemp dim formAction 'Show Add button if pCatalogOnly = 0 _ and hideAddOnProdList = 0 _ and (pHideAddStockLevel = -1 or pHideAddStockLevel < CDbl(Stock)) then 'Check for options and change form "action" attribute mySQL = "SELECT idOptionGroup " _ & "FROM 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 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) next end if strIn = Replace(strIn, "*|*", "") strIn = Replace(strIn, "*||*", "") addHighLight = strIn end function %>