<%Option Explicit%> <% '****************************************************************** ' Version 4.50 June 2, 2002 ' filtering two sort fields and no display fields ' Main program logic for displaying products. ' actual formatting is done in shopproductformat or shopproductformat_withhtml '****************************************************************** dim search Dim dbc Dim PRODUCTNAME, CATALOGID Dim ProductFields ' fields being displayed in order Dim ProductCaptions ' Product column captions Dim ProductFieldCount ' count of fields Dim ProductSelect Dim level3, level4, level5 Dim Colcount, totalcolcount dim ProductMaxColumns, Productwithhtml ' Mod dim yfieldnames,Sortnames, yfieldcount, sortcount dim displayfields, displayfieldcount, displaycaptions dim sortcaptions, yfieldcaptions dim sortupdownnames(3),sortupdownvalues(3), sortupdowncount dim sortfield, sortupdown, selectfield, i dim sortfield2, sortupdown2 ' end mod '***************************************************** ' open database and see if we are doing with html or not ' See if this is a next page request or first time '****************************************************** shopopendatabase dbc ProductmaxColumns=Getconfig("xproductcolumns") ProductwithHtml=Getconfig("xProductwithhtml") If productmaxcolumns="" then productmaxcolumns=1 end if productmaxcolumns=clng(productmaxcolumns) If Productmaxcolumns>1 then Productwithhtml="Yes" end if ProductSelect=getconfig("xProductSelect") SetSess "CurrentUrl","shopdisplayproducts.asp" mypage=request.querystring("page") mypagesize=getconfig("xProductsPerPage") If getconfig("xproductfiltering")="Yes" then GetFilteringfields SetupFiltering end if ' If there is no page, then we must generate sql otherwise sqlis in Session(sqlQuery) if mypage= "" then mypage=1 ' first time through ProcessFirst ' get input variables CreateSql ' generate sql else sql=GetSess("sqlquery") ' on recursive calls we stored sql in sessikon variable Category=GetSess("Category") ' see what previous one was Subcat=getsess("Subcat") cat_id=getsess("Cat_id") ' GetFilteringfields end if ShopPageHeader ' normal page header DisplayProducts ' display products ShopPageTrailer ' normal trailer shopclosedatabase dbc ' Process first time Sub ProcessFirst() CAT_ID = Request("id") ' category id If not isnumeric(CAT_ID) then CAT_ID="" CATEGORY = Request("cat") ' category name SUBCAT=Request("subcat") ' subcategory id PRODUCTNAME=Request("PRODUCT") ' product name CATALOGID=Request("CATALOGID") ' catalogid SetSess "Category",CATEGORY 'remember category see what previous one was setsess "Subcat",subcat setsess "cat_id",cat_id LEVEL3=Request("L3") LEVEL4=Request("L4") LEVEL5=Request("L5") end sub ' '******************************************************* ' product loop logic is here ' Put out headers, category image, open recordset ' SQL already exists so we simply loop through the products '******************************************************** Sub DisplayProducts() Dim header Dim recordcount dim words dim wordcount dim i dim msg dim rc, url, stayonpage header=Prodheaderfont & "" If category <> "" Then header = header & Category else header= header & LangProduct01 End If header = header & "" response.write header ShowCategoryImage 'debugwrite sql ShopOpenRecordSet SQL,objRS, mypagesize, mypage if objRS.eof then objRS.Close set objRS=nothing response.write "
" & getconfig("xfont") & langProductSearch & "" exit sub end if recordcount=0 response.write "

" & getconfig("xfont") & LangCommonPage & mypage & LangCommonOf & maxpages & "" If ProductSelect="Yes" then Response.Write("

") Prodindex=0 else Prodindex="" end if If ProductwithHtml<>"Yes" Then ProductFormatHeader else htmlProductFormatHeader end if While Not objRS.EOF and recordcount < maxrecs ProductGetValues (objRS) ' get product values If Productwithhtml<>"Yes" then ProductFormatRow ' actual row is formatted else htmlProductFormatRow ' actual row is formatted end if If ProductSelect="Yes" then ProdIndex=ProdIndex+1 ' For select product end if objRS.MoveNext recordcount=recordcount+1 colcount=colcount+1 totalcolcount=totalcolcount+1 if colcount>= ProductMaxColumns and ProductMaxcolumns>1 then response.write "" colcount=0 end if Wend FillRemainingColumns response.write "" if ProductSelect="Yes" then response.write "" response.write "
" shopbutton Getconfig("xbuttonorderproduct"),LangProductSelectButton,"action" response.write "

" shopbuttonreset getconfig("xbuttonreset"),LangCommonReset,"" stayonpage=getconfig("Xproductstayonpage") If stayonpage="Yes" then url="shopdisplayproducts.asp?page=" & mypage response.write "

" end if response.write("") end if if getconfig("xproductpagingnextprevious")="Yes" then PageNavBarNext SQL else PageNavBar SQL end if objRS.Close set objRS=nothing If getconfig("xproductfiltering")="Yes" then DisplayFiltering end if end sub '****************************** ' Sub ShowCategoryImage ' ===================== ' If DisplayCategoryImages is set to Yes ' Displays the CatImage if there are not subcategories ' Displays the SubCatImage if there is '****************************** Sub ShowCategoryImage Dim ImageFileName Dim rs Dim query imagefilename="" If getconfig("xDisplayCategoryImages") <> "Yes" Then exit sub If SubCat="" and cat_id="" then exit sub If subcat<>"" Then query = "select subcatimage from subcategories where subcategoryid = " & subcat query=query & " AND categoryid=" & cat_id set rs = dbc.execute(query) If not rs.EOF Then ImageFileName = rs("SubCatImage") if isnull(imagefilename) then imagefilename="" end if end if rs.close set rs=nothing end if if imagefilename="" then query = "select catimage from categories where categoryid = " & cat_id set rs = dbc.execute(query) If not rs.EOF Then imagefilename = rs("catimage") if isnull(imagefilename) then imagefilename="" end if end if rs.close set rs=nothing End if If ImageFileName="" then exit sub %>

<% End Sub '***************************************************** ' sql is actually created in shopproductcreatesql ' it can be complex or it could have been created by search '********************************************************* Sub CreateSQL dim search search=Request.querystring("Search") if search<>"" then SQL=GetSess("SQL") setsess "sqlnofilter",sql exit sub end if if getconfig("Xoldcategorymode")="Yes" then oldProductCreateSql sql else ProductCreateSql sql, dbc end if setsess "sqlnofilter",sql end sub '******************************************************** ' If we are doing multiple columns, fill them up '******************************************************* Sub FillRemainingColumns If productmaxcolumns=1 then exit sub If totalcolcount" exit sub end if Do While Colcount0 response.write " " colcount=colcount+1 loop response.write "" end sub '**************************************************** ' Filtering allows customers to restort displayed products '************************************************** Sub SetupFiltering redim yfieldnames(50) redim sortnames(50) redim sortcaptions(50) redim yfieldcaptions(50) Getfieldnames SetUpDown sortupdownnames,sortupdownvalues, sortupdowncount If displayfieldcount="" then DisplayFields=yFieldnames Displayfieldcount=0 end if End sub '************************************************** ' filtering form is formatted '*********************************************** Sub Displayfiltering ' debugwrite "In display displayfieldcount=" & displayfieldcount response.write "

" Response.write Productfilteringtable Response.write productfilteringrow Response.write productfilteringcolumn & LangEditSort & Productfilteringcolumnend Response.write productfilteringcolumn & LangEditSort & " 2" & Productfilteringcolumnend Response.write productfilteringcolumn & LangEditDisplay & Productfilteringcolumnend Response.write "" Response.write productfilteringrow Response.write ProductFilteringColumn response.write " " generateSelectV sortcaptions,sortnames,sortfield,"sortfield", sortcount, LangCommonSelect Response.write "

" GenerateSelectV Sortupdownnames,Sortupdownvalues,sortupdown,"sortupdown", sortupdowncount,"" response.write Productfilteringcolumnend Response.write ProductFilteringColumn response.write " " GenerateSelectV sortcaptions,sortnames,sortfield2,"sortfield2", sortcount, LangCommonSelect response.write "

" GenerateSelectV Sortupdownnames,Sortupdownvalues,sortupdown2,"sortupdown2", sortupdowncount,"" response.write Productfilteringcolumnend Response.write ProductFilteringColumn GenerateSelectV yfieldcaptions,yfieldnames,SelectField,"SelectField", yfieldcount, LangCommonSelect response.write "
" Response.write "" response.write Productfilteringcolumnend response.write "" Response.write productfilteringrow Response.write ProductFilteringColumn response.write Productfilteringcolumnend Response.write ProductFilteringColumn If getconfig("Xbuttonreset")="" then Response.Write("") else Response.Write("") end if response.write Productfilteringcolumnend Response.write ProductFilteringColumn shopbutton getconfig("xbuttoncontinue"),LangCommonContinue,"action" response.write Productfilteringcolumnend Response.write "" response.write "" response.write "

" end sub ' Sub GetFieldnames Dim prodfields, prodheaders, ucfield,i sortcount=0 yfieldcount=0 SetupProductFields ProdFields, ProdHeaders for i = 0 to ubound(prodfields) ucfield=trim(ucase(prodfields(i))) If ucfield<>"QUANTITY" Then yfieldnames(yfieldcount)=prodfields(i) yfieldcaptions(yfieldcount)=trim(prodheaders(i)) 'DEbugwrite "caption=" & yfieldcaptions(yfieldcount) yfieldcount=yfieldcount+1 If ucfield="CDESCRIPTION" then else sortnames(sortcount)=prodfields(i) sortcaptions(sortcount)=prodheaders(i) sortcount=sortcount+1 end if end if next end sub Sub SetUpDown (sortupdownnames,sortupdownvalues, sortupdowncount) Sortupdownnames(0)="Ascending" Sortupdownnames(1)="Decending" Sortupdownvalues(0)="ASC" Sortupdownvalues(1)="DESC" SortUpDowncount=2 end sub Sub GetFilteringFields yFieldcount=GetSess("prodFieldcount") yFieldnames=GetsessA("prodFieldnames") sortfield=GetSess("prodsortfield") sortfield2=GetSess("prodsortfield2") sortupdown=GetSess("prodsortupdown") DisplayFields=GetSess("prodDisplayFields") DisplayFieldCount=GetSess("prodDisplayCount") Displaycaptions=getsessA("Proddisplaycaptionsall") sortfield="" sortfield2="" ' debugwrite "sortfield=" & sortfield ' debugwrite "displayfieldcount=" & displayfieldcount end sub Sub GenerateSelectMULTV (iFieldnames,ifieldvalues, fieldcount,currentvalues,currentvaluecount, selectname,firstfield) ' Generates select with no values %> <% end sub %>