<%Option Explicit%> <% '****************************************************************** ' Version 5.00 ' filtering two sort fields and no display fields ' Main program logic for displaying products. ' actual formatting is done in shopproductformat or shopproductformat_withhtml ' May 20, 2003 '****************************************************************** 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 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 dim rc ' 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 setsess "pagenumber",mypage ' for languae switch 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="" ' hacker fix CATEGORY = Request("cat") ' category name CleanseMessage category, rc if rc> 0 then category="" ' cannot trust it hacker may be trying someting end if SUBCAT=Request("subcat") ' subcategory id PRODUCTNAME=Request("PRODUCT") ' product name CleanseMessage productname, rc if rc>0 then productname="" end if CATALOGID=Request("CATALOGID") ' catalogid SetSess "Category",CATEGORY 'remember category see what previous one was setsess "Subcat",subcat setsess "cat_id",cat_id 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 dim objrs1 Header="" If category <> "" Then header = header & Category else header= header & getlang("langProduct01") End If response.write prodheaderfont & header & prodheaderfontend ShowCategoryImage 'debugwrite sql ShopOpenRecordSet SQL,objRS1, mypagesize, mypage if objRS1.eof then objRS1.Close set objRS1=nothing shopwriteerror getlang("langProductSearch") exit sub end if recordcount=0 response.write "

" & smallinfofont & getlang("langCommonPage") & " " & mypage & getlang("langCommonOf") & " " & maxpages & smallinfoend If ProductSelect="Yes" then Response.Write("

") Prodindex=0 else Prodindex="" end if If ProductwithHtml<>"Yes" Then ProductFormatHeader else htmlProductFormatHeader end if While Not objRS1.EOF and recordcount < maxrecs GetProductRecordset objrs1, objrs 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 objRS1.MoveNext closerecordset objrs 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"),getlang("langProductSelectButton"),"action" response.write "

" shopbuttonreset getconfig("xbuttonreset"),getlang("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 objRS1.Close set objRS1=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 ' Display file associates with actegory ' Displays the SubCatImage if there is '****************************** Sub ShowCategoryImage Dim ImageFileName, description, i Dim rs Dim query imagefilename="" If cat_id="" then exit sub If getconfig("xDisplayCategoryImages")="Yes" or getconfig("xdisplaycategoryfiles")="Yes" Then query = "select * from categories where categoryid = " & cat_id set rs = dbc.execute(query) If not rs.EOF Then imagefilename = rs("catimage") description=rs("catextra") if isnull(imagefilename) then imagefilename="" end if if isnull(description) then description="" end if end if closerecordset rs else exit sub end if If getconfig("xDisplayCategoryImages")="Yes" and imagefilename<>"" then response.write "

" end if If getconfig("xdisplaycategoryfiles")="Yes" and description <>"" then dim readarray(500), readcount readcount=0 ShopReadFile description,ReadArray,readcount 'debugwrite "readcount=" & readcount & " file=" & description if readcount=0 then exit sub response.write "
" for i = 0 to readcount-1 response.write readarray(i) & vbcrlf next end if 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 colcount=0 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 & getlang("langEditSort") & Productfilteringcolumnend Response.write productfilteringcolumn & getlang("langEditSort") & " 2" & Productfilteringcolumnend Response.write productfilteringcolumn & getlang("langEditDisplay") & Productfilteringcolumnend Response.write "" Response.write productfilteringrow Response.write ProductFilteringColumn response.write " " generateSelectV sortcaptions,sortnames,sortfield,"sortfield", sortcount, getlang("langCommonSelect") Response.write "

 " GenerateSelectV Sortupdownnames,Sortupdownvalues,sortupdown,"sortupdown", sortupdowncount,"" response.write Productfilteringcolumnend Response.write ProductFilteringColumn response.write " " GenerateSelectV sortcaptions,sortnames,sortfield2,"sortfield2", sortcount, getlang("langCommonSelect") response.write "

 " GenerateSelectV Sortupdownnames,Sortupdownvalues,sortupdown2,"sortupdown2", sortupdowncount,"" response.write Productfilteringcolumnend Response.write ProductFilteringColumn GenerateSelectV yfieldcaptions,yfieldnames,SelectField,"SelectField", yfieldcount, getlang("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"),getlang("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 '******************************************************************************* ' Get recordset for real product '****************************************************************************** Sub GetProductRecordset (objrs1, objrs) dim catalogid catalogid=objrs1("catalogid") dim sql sql="select * from products where catalogid=" & catalogid set objrs=dbc.execute(sql) end sub %>