<%Option Explicit%> <% '****************************************************************** ' Version 6.50 ' compare two or more products side by side '****************************************************************** 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 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 Dim InventoryCheck, InventoryPriceDisplay, inventoryquantitydisplay, inventoryoutofstock Productwithhtml="Yes" ProductSelect=getconfig("xProductSelect") '***************************************************** ' open database and see if we are doing with html or not ' See if this is a next page request or first time '****************************************************** initializesystem SetSess "CurrentUrl","shopcomparison.asp" CreateSql ' generate sql shopopendatabaseP dbc ShopPageHeader ' normal page header DisplayProducts ' display products shopclosedatabase dbc ShopPageTrailer ' normal trailer Sub DisplayProducts() dim objrs1,recordcount, i ShopOpenRecordSet SQL,objRS1, 1, 1 recordcount=0 ' display breadcrumbs response.write "

" & getlang("langcommonhome") & " " & SubCatSeparator & getlang("langcompareproducts") & "

" ' display heading Response.write "

" & getlang("langcompareproducts") & "

" if objRS1.eof then objRS1.Close set objRS1=nothing ' call shoperror if referer url does not match current url, else just write error If Right(Request.ServerVariables("HTTP_REFERER"),len(getsess("CurrentURL"))) <> GetSess("CurrentURL") Then shoperror getlang("langcompareempty") Else shopwriteerror getlang("langcompareempty") End If exit sub end if 'VP-ASP 6.50 - add scroller if content too wide 'Response.write "

" Response.write "

" if getconfig("xcomparesidebyside") = "Yes" then response.write "" end if If getconfig("xproductselect") = "Yes" then response.write "" Prodindex=0 else Prodindex="" end if While Not objRS1.EOF and recordcount < getconfig("xcomparemax") GetProductRecordset objrs1, objrs ProductGetValues objRS, dbc ' get product values Inventorycheck=false ' no sub products InventoryPriceDisplay=true ' display prices with sub products Inventoryoutofstock=false ' there are inventory products to display InventoryProductYesNo dbc, objrs, lngcatalogid, inventorycheck, Inventorypricedisplay, Inventoryquantitydisplay, inventoryoutofstock FormatComparisonRow ' actual row is formatted If ProductSelect="Yes" then ProdIndex=ProdIndex+1 ' For select product end if objRS1.MoveNext closerecordset objrs recordcount=recordcount+1 Wend response.write "

" if ProductSelect="Yes" and getconfig("xproductcatalogonly") <> "Yes" then response.write "" shopbutton Getconfig("xbuttonorderproduct"),getlang("langProductSelectButton"),"action" 'VP-ASP 6.50 - advanced session handling Addwebsessform response.write("") end if 'VP-ASP 6.50 - add scroller if content too wide 'response.write "

" ' javascript back link response.write "

" & getlang("LangCommonBack") & "

" objRS1.Close set objRS1=nothing end sub Sub CreateSQL if getsess("compareproducts") > "" then if left(getsess("compareproducts"), 1) = "," then setsess "compareproducts", right(getsess("compareproducts"), len(getsess("compareproducts")) - 1) end if if right(getsess("compareproducts"), 1) = "," then setsess "compareproducts", left(getsess("compareproducts"), len(getsess("compareproducts")) - 1) end if sql = "select * from products where catalogid IN (" & getsess("compareproducts") & ")" else shoperror getlang("langcompareempty") end if end sub 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 sub formatcomparisonrow if getconfig("xcomparesidebyside") = "Yes" then response.write "" else response.write "" end if dim template, rc, url, stayonpage if getconfig("xcomparesidebyside") = "Yes" then template=getconfig("xcomparesidebysidetemplate") else template=getconfig("xcomparedownpagetemplate") end if If Template="" then shopclosedatabase dbc shoperror getlang("LangExdNoTemplate") end if If getconfig("xproductselect") <>"Yes" then response.write "" end if ' display remove for side by side, so that it lines up. if getconfig("xcomparesidebyside") = "Yes" then response.write "" else response.write "" end if end sub Sub Handle_Product (isub) select case isub Case "FORMATIMAGE" Formatimage Case "FORMATBUTTON" If ProductSelect="Yes" then AddSelect else Formatbutton end if Case "FORMATHYPERLINKS" Formathyperlinks Case "FORMATOVERALLRATING" Formatoverallrating Case "FORMATPRODUCTOPTIONS" Formatinventoryproducts dbc,objrs Formatproductoptions Case "FORMATQUANTITY" Formatquantity Case "FORMATCOMPARISON" FormatComparison case else debugwrite "Unknown sub" end select end sub %>