<% ' CatalogIt! 1.0.2 (07-22-2002) ' ' This is an enhanced version of the Worldsites' Dynamic Information System. ' ' Infolink ' Carlos A. Madrigal ' ' sCurrentPage="products" page="Products" gbIncludeSearch=true ' '**Start Encode** %> <% sScriptName = Mid(Request.ServerVariables("SCRIPT_NAME"), InStrRev(Request.ServerVariables("SCRIPT_NAME"), "/")+1) Response.Flush Dim iCategoryID, iProductID Dim sHierarchy Dim bDisplaySearchResults, sSearchFor Dim iCurrPage, iPages ' Read request variables and cache them iCategoryID = DefaultRequest("iCat", 0) If iCategoryID < 0 Then iCategoryID = 0 iProductID = DefaultRequest("iProd", 0) If iProductID < 0 Then iProductID = 0 bDisplaySearchResults = IsRequestDefined("goSearch") iCurrPage = CLng(DefaultRequest("iPag", 1)) iCurrRecord = CLng(DefaultRequest("i", 0)) sHierarchy = Request("Hierarchy") sSearchFor = Request("searchfor") ' Paints the search panel where users input what they want to search. Sub PaintSearchPanel() %>
<% End Sub ' Paints the current category. If no category is selected, some introductory ' text is displayed. Sub PaintCurrentCategory() If iCategoryID = 0 Then If bDisplaySearchResults Then %><% Else %><% End If Else PaintFullCategory iCategoryID End If End Sub Sub PaintFullCategory(iCategoryID) Dim rsExtraFieldNames Dim iImgWidth, iImgHeight, iImgColors, sImgType ' Get category data '** E.S. Addition here made to the SQL Query to Order Items by Order Shown Parameter from Table **** sSQL = "" _ + "SELECT Name, Code, Description, ThumbnailFile, ImageFile, Keywords, ExtraField1, ExtraField2, ExtraField3 FROM " _ + "Categories WHERE " _ + "CategoryID = " & iCategoryID _ & " ORDER BY OrderShown" '********************************** 5/6/2003 Set rsData = Server.CreateObject("ADODB.Recordset") rsData.Open sSQL, conDB, adOpenKeyset, adLockOptimistic If Not IsRSEmpty(rsData) Then With rsData %>
<%=.Fields("Name")%>
<% If Not IsNull(.Fields("ThumbnailFile")) Then If Not IsNull(.Fields("ImageFile")) Then gfxSpex Server.MapPath("catimages/" + .Fields("ImageFile")), iImgWidth, iImgHeight, iImgColors, sImgType %> ', '<%=JavaScriptString(.Fields("Code"))%>', '<%=.Fields("ImageFile")%>', 'c', '<%=iImgWidth%>', '<%=iImgHeight%>');"> <%=smClickLargeImage%>">
<%=smShowLargerPhoto%> <%Else%> "> <%End If ElseIf Not IsNull(.Fields("ImageFile")) Then gfxSpex Server.MapPath("catimages/" + .Fields("ImageFile")), iImgWidth, iImgHeight, iImgColors, sImgType %> ', '<%=JavaScriptString(.Fields("Code"))%>', '<%=.Fields("ImageFile")%>', 'c', '<%=iImgWidth%>', '<%=iImgHeight%>');"> Click here for a larger image">
<%=smShowLargerPhoto%> <% End If %>		 <%If Not IsNull(.Fields("Description")) Then%>
<%=.Fields("Description")%>
<%End If%>
<%End With End If rsData.Close End Sub ' Paints the current control Sub PaintCurrentProduct() Dim rs Dim rsExtraFieldNames Dim iImgWidth, iImgHeight, iImgColors, sImgType ' Open product data Set rs = Server.CreateObject("ADODB.Recordset") rs.Open "SELECT * FROM Products WHERE ProductID = " & iProductID, conDB, adOpenKeyset, adLockOptimistic If rs.BOF And rs.EOF Then Response.Write "Invalid product id!" 'TODO: Maker a better error message Exit Sub End If %>
<%=rs("Name")%>
<% If Len(rs("ThumbnailFile")) > 0 Then %> " alt="<%=rs("Name")%>">
<% ElseIf Len(rs("ImageFile")) > 0 Then gfxSpex Server.MapPath("prodimages/" + rs("ImageFile")), iImgWidth, iImgHeight, iImgColors, sImgType %> ', '<%=JavaScriptString(rs("Code"))%>', '<%=rs("ImageFile")%>', 'p', '<%=iImgWidth%>', '<%=iImgHeight%>');">" alt="<%=rs("Name")%>">
<% End If If Len(rs("ImageFile")) > 0 Then gfxSpex Server.MapPath("prodimages/" + rs("ImageFile")), iImgWidth, iImgHeight, iImgColors, sImgType %>', '<%=JavaScriptString(rs("Code"))%>', '<%=rs("ImageFile")%>', 'p', '<%=iImgWidth%>', '<%=iImgHeight%>');"> <%=smShowLargerPhoto%> <% End If %>		 <%If Not IsNull(rs("ListPrice")) Then%>
<%=smListPrice%>: <%If Not IsNull(rs("Price")) Then Response.Write ""%> $<%=FormatNumber(rs("ListPrice"))%>
<%If Not IsNull(rs("Price")) Then Response.Write ""%> <%End If%> <%If Not IsNull(rs("Price")) Then%>
<%=smPrice%>: $<%=FormatNumber(rs("Price"))%>
<%End If%>
<%If Not IsNull(rs.Fields("Code")) Then%> <%=smCode%>: <%=rs.Fields("Code")%>
<%End If If Not IsNull(rs.Fields("ExternalURL")) Then%> <%=smExternalURL%>: " target="_blank"><%=rs.Fields("ExternalURL")%>
<%End If If Not IsNull(rs.Fields("OtherFile")) Then%> "><%=smDownloadProductFile%>
<%End If ' Get and paint field names sSQL = "SELECT ExtraFieldID, Name FROM ExtraFields WHERE ExtraFieldID >= 4 AND ExtraFieldID <= 8 AND IsActive<>0" Set rsExtraFieldNames = Server.CreateObject("ADODB.Recordset") rsExtraFieldNames.Open sSQL, conDB, adOpenKeyset While Not rsExtraFieldNames.EOF If Not IsNull(rs.Fields("ExtraField" & rsExtraFieldNames("ExtraFieldID"))) Then%> <%=rsExtraFieldNames("Name")%>: <%=rs.Fields("ExtraField" & rsExtraFieldNames("ExtraFieldID"))%>
<% End If rsExtraFieldNames.MoveNext Wend rsExtraFieldNames.Close %>
<%If Not IsNull(rs("Description")) Then%>

<%=rs("Description")%>

<%End If%>
<% rs.Close End Sub ' Paints the list of categories ( THE ONES ON RIGHT SIDE OF SCREEN AFTER CLICKING ON A PRODUCT ) Sub PaintCategories() If Len(Request("iProd")) = 0 Then If iCategoryID = 0 Then ' Get categories and display them ' **** E.S. Changed here to Do the SQL and sort by OrderShown Instead of By Name sSQL = "" _ + "SELECT CategoryID, Name, Code, ShortDescription, Description, ThumbnailFile, ImageFile " _ + "FROM Categories " _ + "WHERE IsTop <> 0 AND IsActive <> 0 " _ + "ORDER BY OrderShown" ' *********** 5/6/2003 *************************************** Set rsData = conDB.Execute(sSQL) With rsData While Not .EOF PaintCategory .Fields("CategoryID"), .Fields("Name"), iCategoryID, .Fields("ShortDescription") Response.Write "
" .MoveNext Wend End With rsData.Close ElseIf iProductID = 0 Then ' Get categories and display them ' **** E.S. Changed here to Do the SQL and sort by OrderShown Instead C.Name This is for Categories that are not TOP Cat sSQL = "" _ + "SELECT CH.ChildCategoryID, C.Name, C.Code, C.Description, C.ShortDescription, C.ThumbnailFile, C.ImageFile " _ + "FROM Categories AS C, CategoryHierarchy AS CH " _ + "WHERE CH.CategoryID = " & iCategoryID & " AND C.IsActive <> 0 AND C.CategoryID = CH.ChildCategoryID " _ + "ORDER BY C.OrderShown" ' *********** 5/6/2003 *************************************** Set rsData = conDB.Execute(sSQL) With rsData While Not .EOF PaintCategory .Fields("ChildCategoryID"), .Fields("Name"), iCategoryID, .Fields("ShortDescription") Response.Write "
" .MoveNext Wend End With rsData.Close Else PaintCategory iCategoryID, conDB.Execute("SELECT Name FROM Categories WHERE CategoryID = " & iCategoryID)(0), "", .Fields("ShortDescription") End If End If If gbIncludeSearch Then PaintSearchPanel End Sub ' Paints the list of products with paging included Sub PaintProducts() Dim rs, iRecord, iRecsToMove, iColWidth If bDisplaySearchResults Then DisplaySearchResults ' Paint products that belong to this category ' *** E.S. CHANED SQL Query to Show Products by Order Shown no by P.Name sSQL = "" _ + "SELECT P.ProductID, P.Name, P.Code, P.ShortDescription, P.Description, P.ThumbnailFile, P.ImageFile, P.Keywords, " _ + "P.ListPrice, P.Price, " _ + "P.ExtraField4, P.ExtraField5, P.ExtraField6, P.ExtraField7, P.ExtraField8 " _ + "FROM Products AS P, ProductCatalog AS PC " _ + "WHERE PC.CategoryID = " & iCategoryID & " AND P.ProductID = PC.ProductID AND P.IsActive<>0 " _ + "ORDER BY P.OrderShown" ' ************************ 5/6/2003 Set rs = Server.CreateObject("ADODB.Recordset") With rs .Open sSQL, conDB, adOpenKeyset, adLockOptimistic If Not IsRSEmpty(rs) Then .PageSize = gcProductsPerPage iPages = .PageCount .AbsolutePage = iCurrPage %><% iColWidth = 100 \ gcProductsPerRow For iRecord = 1 To gcProductsPerPage If (iRecord Mod gcProductsPerRow) = 1 Then Response.Write vbCrLf + "" + vbCrLf PaintProduct rs, iColWidth If (iRecord Mod gcProductsPerRow) = 0 Then Response.Write vbCrLf + "" + vbCrLf .MoveNext If .EOF Then Exit For Next If (iRecord Mod gcProductsPerRow) <> 0 Then Response.Write vbCrLf + "" + vbCrLf %>
<% Response.Write "
" If iCurrPage > 1 Then %> [Prev] <% End If If iPages > 1 Then %> Page <%=iCurrPage%> of <%=iPages%> <% End If If iCurrPage < iPages Then %> [Next] <% End If End If .Close End With Set rs = Nothing End Sub ' Display search results Sub DisplaySearchResults() Dim sKeywords, rsSearch, rsProduct, iPage, iRecord sKeywords = sSearchFor sSQL = "" _ + "SELECT SourceID, Source FROM (" _ + "SELECT ProductID AS SourceID, 10 AS Weight, 'Product' AS Source FROM Products WHERE IsActive<>0 AND " + BuildKeywordCriteria("Keywords", sKeywords, True, True) _ + " UNION " _ + "SELECT ProductID AS SourceID, 8 AS Weight, 'Product' AS Source FROM Products WHERE IsActive<>0 AND " + BuildKeywordCriteria("Name", sKeywords, True, True) _ + " UNION " _ + "SELECT ProductID AS SourceID, 5 AS Weight, 'Product' AS Source FROM Products WHERE IsActive<>0 AND " + BuildKeywordCriteria("Description", sKeywords, True, True) _ + " UNION " _ + "SELECT CategoryID AS SourceID, 3 AS Weight, 'Category' AS Source FROM Categories WHERE IsActive<>0 AND " + BuildKeywordCriteria("Keywords", sKeywords, True, True) _ + " UNION " _ + "SELECT CategoryID AS SourceID, 2 AS Weight, 'Category' AS Source FROM Categories WHERE IsActive<>0 AND " + BuildKeywordCriteria("Name", sKeywords, True, True) _ + " UNION " _ + "SELECT CategoryID AS SourceID, 1 AS Weight, 'Category' AS Source FROM Categories WHERE IsActive<>0 AND " + BuildKeywordCriteria("Description", sKeywords, True, True) _ + ") AS T GROUP BY SourceID, Source ORDER BY Source DESC, SUM(Weight) DESC" Set rsSearch = Server.CreateObject("ADODB.Recordset") rsSearch.Open sSQL, conDB, adOpenKeyset, adLockOptimistic rsSearch.PageSize = gcProductsPerPage iPages = rsSearch.PageCount If rsSearch.BOF And rsSearch.EOF Then %><%=smNoMatches%><% Else rsSearch.AbsolutePage = iCurrPage For iRecord = 1 To gcProductsPerPage Select Case rsSearch("Source") Case "Product"%>
<% Set rsProduct = conDB.Execute("SELECT * FROM Products WHERE ProductID = " & rsSearch("SourceID")) iColWidth = 100 \ gcProductsPerRow PaintProduct rsProduct, iColWidth rsProduct.Close Set rsProduct = Nothing %>

<% Case "Category" PaintFullCategory rsSearch("SourceID") Response.Write "
" End Select rsSearch.MoveNext If rsSearch.EOF Then Exit For Next rsSearch.Close Response.Write "
" If iCurrPage > 1 Then %> &iPag=<%=iCurrPage-1%>"> <%=smPrev%> <% End If If iPages > 1 Then %> Page <%=iCurrPage%> of <%=iPages%> <% End If If iCurrPage < iPages Then %> &iPag=<%=iCurrPage+1%>"> <%=smNext%> <% End If End If End Sub Sub PaintCategory(iCategoryID, sName, iCurrentCategoryID, sShortDescription) Dim sHierarchy, iRemovedCategoryID If iCategoryID >= 0 Then %> <%=sName%> <% Else sHierarchy = RemoveLastCategory(iRemovedCategoryID) %> <%=sName%> <% End If End Sub Sub PaintProduct(ByRef rs, ByVal iColWidth) Dim rsExtraFieldNames %>
<%=rs("Name")%>
><% If Len(rs("ThumbnailFile")) > 0 Then %> &iCat=<%=iCategoryID%>&hierarchy=<%=sHierarchy%>">" alt="<%=rs("Name")%>"><% ElseIf Len(rs("ImageFile")) > 0 Then %> &iCat=<%=iCategoryID%>&hierarchy=<%=sHierarchy%>">" alt="<%=rs("Name")%>"><% End If %> <%=rs("ShortDescription")%> &iCat=<%=iCategoryID%>&hierarchy=<%=sHierarchy%>"><%=smViewDetail%>
<% End Sub ' Builds the hierarchy that is passed in the query string. Function SaveHierarchy(iCategoryID) Dim sHierarchy sHierarchy = Request("hierarchy") & "|" & iCategoryID If Left(sHierarchy, 1) = "|" Then sHierarchy = Mid(sHierarchy, 2) If Right(sHierarchy, 1) = "|" Then sHierarchy = Left(sHierarchy, Len(sHierarchy)-1) SaveHierarchy = sHierarchy End Function ' Removes the last category id from the hierarchy string. Function RemoveLastCategory(ByRef iRemovedCategoryID) Dim sHierarchy, iDivPos sHierarchy = SaveHierarchy("") iDivPos = InStrRev(sHierarchy, "|") If iDivPos > 0 Then iRemovedCategoryID = Trim(Mid(sHierarchy, iDivPos+1)) If Len(iRemovedCategoryID) > 0 And IsNumeric(iRemovedCategoryID) Then iRemovedCategoryID = CLng(iRemovedCategoryID) Else iRemovedCategoryID = -1 End If sHierarchy = Left(sHierarchy, Len(sHierarchy)-Len(CStr(iRemovedCategoryID))-1) Else iRemovedCategoryID = -1 End If If sHierarchy = "0" Then sHierarchy = "" RemoveLastCategory = sHierarchy End Function ' Build a SQL criteria fragment using ANDs for each word found in sKeywords. Function BuildKeywordCriteria(sFieldName, sKeywords, bUseQuotes, bUseLike) Dim sKeyword, asKeywords, sCriteria asKeywords = Split(sKeywords, " ") For Each sKeyword In asKeywords sKeyword = Trim(sKeyword) If Len(sKeyword) > 0 Then If bUseQuotes Then If bUseLike Then sCriteria = sCriteria & sFieldName & " LIKE '%" & sKeyword & "%'" Else sCriteria = sCriteria & sFieldName & " = '" & sKeyword & "'" End If Else sCriteria = sCriteria & sFieldName & " = " & sKeyword End If sCriteria = sCriteria & " AND " End If Next If Right(sCriteria, 5) = " AND " Then sCriteria = Left(sCriteria, Len(sCriteria)-5) BuildKeywordCriteria = sCriteria End Function ' Returns a value even if the variable in the request is not defined Function DefaultRequest(ByVal sRequestVariable, vDefaultValue) If IsRequestDefined(sRequestVariable) Then DefaultRequest = Request(sRequestVariable) Else DefaultRequest = vDefaultValue End If End Function ' Tells if a variable was passed or not Function IsRequestDefined(sVarName) IsRequestDefined = Len(Request(sVarName)) > 0 End Function ' Returns a safe JavaScript string Function JavaScriptString(sString) If Not IsNull(sString) Then JavaScriptString = Replace(Replace(sString, "'", "\'"), """", "\""") Else JavaScriptString = "" End If End Function Sub PaintHierarchy() Dim sNewHierArchy Dim sTempHierArchy Dim aHierArray Dim dHierName Dim iCatID Dim sColor If iProductID <> 0 Then sHierarchy = sHierarchy & "|" & Request("iCat") End If sNewHierArchy = Replace( sHierarchy, "|", "," ) Set dHierName = CreateObject("Scripting.Dictionary") sSQL = "" _ + "SELECT CategoryID, Name " _ + "FROM Categories " _ + "WHERE CategoryID IN (" & sNewHierArchy & ")" Set rsData = conDB.Execute(sSQL) With rsData While Not .EOF dHierName.Add rsData("CategoryID").value, rsData("Name").value .MoveNext Wend End With rsData.Close aHierArray = Split( sNewHierArchy,"," ) sTempHierArchy = "" %><%=smProductsLink%> <% For iCatID = LBound(aHierArray) To UBound(aHierArray) If iCatID = UBound(aHierArray) Then sColor = "#5B926F" Else sColor = "#62684E" End If If iCatId <> 0 Then %>: ><%=dHierName.Item(Cint(aHierArray(iCatID)))%><% End If If iCatID <> LBound(aHierArray) Then sTempHierArchy = sTempHierArchy & "|" + aHierArray(iCatID) Else sTempHierArchy = sTempHierArchy + aHierArray(iCatID) End If Next Response.Write "" End Sub %> <% if gcCatalogLayout = "top" Then %> <% End If %> <% if gcCatalogLayout = "left" Then %> <% End If %> <% if gcCatalogLayout = "right" Then %> <% End If %> <% if gcCatalogLayout = "bottom" Then %> <% End If %>
<%PaintCategories%> 
<%PaintCategories%> 

 <%If Len( sHierarchy ) <> 0 Then%> <%End If%> <%If iProductID = 0 Then%> <%Else%> <%End If%>
<%PaintHierarchy%>
<%PaintCurrentCategory%> 
<%PaintProducts%>
<%PaintCurrentProduct%> 
<%PaintCategories%> 

<%PaintCategories%>