Rank: Administration
Groups: Administration
Joined: 10/8/2008(UTC) Posts: 188  Was thanked: 1 time(s) in 1 post(s)
|
Hi All, Many times we've build a product filter so customers can easily select the product they would like to have or need to have. Most of the times this is a lot of custom work, because each and every webshop and kind of product is different and has different specifications. During the creation of my last product filter I tried to make this as global as possible so you can use this exact same filter in other websites. Layout is done in the view instead of JS and the filter automatically selects the requested fields from the layout. This filter includes some advanced possibilities such as changing the url(anker) so you can copy paste this in an e-mail without losing the filter and show the amount of available products behind each option and infinite scrolling. This filter is not perfect and maybe there will be some small bugs if you use this on an other website but this is only the first release. In the end I couldn't avoid to do some custom work because of time pressure but for the most it is build global. I would like to thank Michal for the layout parts. For this filter I created an Open Control like this: description: Code:20131011 BK: productfilter
Jquery and Jquery UI required
Par(0) = view
par(1) = filterfields
par(2) = mainselection
par(3) = Seo Rule
source: Code:Imports Microsoft.Visualbasic
Imports System.Text.RegularExpressions
==>END IMPORTS
try
Dim ViewId as string = ""
Dim Fields as string = ""
Dim mainselection as string = ""
Dim SeoRuleId as string = ""
Dim TabelId as integer = 0
Dim Viewtext as string = ""
Dim Selectie as string = ""
Dim Tablenaam as string = ""
Dim mainselectionvalue as string = "0"
Dim AdvancedEdit as string = ""
Dim Cid as string = pbw.get_Cid_currentdomain()
Dim prefix as string = Cid & "U_"
ViewId = par(0)
Fields = Par(1)
mainselection = Par(2)
SeoRuleId = Par(3)
Dim DestinationUrlTemplate as string = ""
Dim FieldnameKey as string = ""
Using Con As New SqlConnection(constring)
Try
Dim Query As String = ""
Query &= " Select "
Query &= " [DestinationUrlTemplate] "
Query &= " ,[FieldnameKey] "
Query &= " from " & CID & "_SEO "
Query &= " where [Number] = @Number "
Dim Com As New SqlCommand(Query, Con)
Com.Parameters.AddWithValue("@Number", SeoRuleId)
Con.open()
Dim Reader As SqlDataReader = Com.ExecuteReader()
while Reader.Read()
DestinationUrlTemplate = Reader("DestinationUrlTemplate")
FieldnameKey= Reader("FieldnameKey")
end while
Catch ex As Exception
controlplace.controls.add(New LiteralControl("Error retrieving Seo rule: " & ex.tostring & "<br /><br />"))
Finally
Con.close()
End Try
End Using
Using Con As New SqlConnection(constring)
Try
Dim Query As String = ""
Query &= " Select "
Query &= " Tabelid "
Query &= " ,Tekst"
Query &= " ,Selectie"
Query &= " ,AdvancedEdit"
Query &= " from " & CID & "_VIEW"
Query &= " where [Id] = @Id "
Dim Com As New SqlCommand(Query, Con)
Com.Parameters.AddWithValue("@Id", ViewId)
Con.open()
Dim Reader As SqlDataReader = Com.ExecuteReader()
while Reader.Read()
TabelId = Reader("Tabelid")
Viewtext = IIf(ISDBNULL(reader("Tekst")),"",reader("Tekst"))
Selectie = IIf(ISDBNULL(reader("Selectie")),"",reader("Selectie"))
AdvancedEdit = IIf(ISDBNULL(reader("AdvancedEdit")),"",reader("AdvancedEdit"))
end while
Catch ex As Exception
controlplace.controls.add(New LiteralControl("Error retrieving Table: " & ex.tostring & "<br /><br />"))
Finally
Con.close()
End Try
End Using
Selectie = Selectie.replace("WHERE ", "AND ")
Using Con As New SqlConnection(constring)
Try
Dim Query As String = ""
Query &= " Select "
Query &= " Tabelnaam "
Query &= " from " & CID & "_TABEL "
Query &= " where [Id] = @Id "
Dim Com As New SqlCommand(Query, Con)
Com.Parameters.AddWithValue("@Id", TabelId)
Con.open()
Dim Reader As SqlDataReader = Com.ExecuteReader()
while Reader.Read()
Tablenaam = Reader("Tabelnaam")
end while
Catch ex As Exception
controlplace.controls.add(New LiteralControl("Error retrieving Table: " & ex.tostring & "<br /><br />"))
Finally
Con.close()
End Try
End Using
Dim dsTables As New DataSet
Using Con As New SqlConnection(constring)
Try
Dim selectFields as string = Fields
selectFields = selectFields.replace("'","''")
selectFields = selectFields.replace(",","','")
selectFields = "'" & selectFields & "'"
Dim Query As String = ""
Query &= " Select "
Query &= " [Id] "
Query &= " ,[Veldnaam] "
Query &= " ,[Omschrijving] "
Query &= " ,[Veldtype] "
Query &= " ,[Koppelveldid] "
Query &= " ,[Koppelquery] "
Query &= " ,[Opmaak] "
Query &= " from " & CID & "_TABEL_VELDEN "
Query &= " where [Tabelid] = @TableId "
Query &= " and [Veldnaam] in (" & selectFields & ") "
Query &= " order by case Veldnaam "
Dim i as integer = 0
for each field as string in selectFields.split(",")
Query &= " when " & field & " then " & I.tostring
I += 1
next
Query &= " else " & I.tostring
Query &= " end"
Dim Com As New SqlCommand(Query, Con)
Com.Parameters.AddWithValue("@TableId", TabelId)
Dim adt As New SqlDataAdapter()
adt.SelectCommand = com
adt.Fill(dsTables)
Catch ex As Exception
controlplace.controls.add(New LiteralControl("Error retrieving Fields: " & ex.tostring & "<br /><br />"))
Finally
End Try
End Using
if not string.IsNullOrEmpty(Request.params(mainselection)) then
mainselectionvalue = Request.params(mainselection)
end if
Dim Retstring as string = ""
'Retstring &= "<ul id=""productfilter"">" & Environment.NewLine
For Each row As DataRow In dsTables.tables(0).Rows
Dim Id as integer = Row("Id")
Dim Veldnaam as string = Row("Veldnaam")
Dim Omschrijving as string = Row("Omschrijving")
Dim Veldtype as string = Row("Veldtype")
Dim Koppelveldid as integer = Row("Koppelveldid")
Dim Koppelquery as string = Row("Koppelquery")
Dim Opmaak as string = Row("Opmaak")
'Retstring &= "<li id=""li_" & Veldnaam & """ class=""li_" & Veldnaam & """>" & Environment.NewLine
'create exception for one specified field
If Veldnaam = "Jaar" then
Retstring &= "<ul class=""filteritem ui-corner-all"">" & Environment.NewLine
Dim dsOptions As New DataSet
Dim Query As String = ""
Using Con As New SqlConnection(constring)
Try
Query &= " Select "
Query &= " " & Veldnaam
Query &= " FROM " & prefix & Tablenaam
Query &= " Where (" & mainselection & "= @mainselectionvalue "
Query &= " OR @mainselectionvalue = 0) "
Query &= " " & Selectie
Query &= " And " & Veldnaam & " IS NOT NULL "
Query &= " and " & Veldnaam & " > 0 "
Query &= " Group by " & Veldnaam & " "
Query &= " Order by " & Veldnaam & " desc "
Dim Com As New SqlCommand(Query, Con)
Com.Parameters.AddWithValue("@mainselectionvalue", mainselectionvalue)
Dim adt As New SqlDataAdapter()
adt.SelectCommand = com
adt.Fill(dsOptions)
Catch ex As Exception
controlplace.controls.add(New LiteralControl("Error select options " & Veldnaam & ": " & ex.tostring & "<br /><br />" & query & "<br /><br />"))
Finally
End Try
End Using
Retstring &= "<p><label id=""desciption_" & Veldnaam & """>" & Omschrijving & " </label>" & Environment.NewLine
Retstring &= " <ul class=""filteritemoptions ui-corner-all"">" & Environment.NewLine
For Each optrow As DataRow In dsOptions.tables(0).Rows
Dim OptId as integer = optrow(0)
Dim OptValue as string = OptId
if not string.isnullorempty(OptValue.trim) then
Retstring &= "<li><input type=""checkbox"" class=""filter" & Veldnaam & """ id=""filter" & Veldnaam & "_" & OptId & """ onchange=""SetAncherOptions($(this).attr('class'))"" data-val=""" & OptValue & """>" & OptValue & " (<span class=""filteramount"" id=""filteramount_" & Veldnaam & "_" & OptId & """>(0)</span>)</li>" & Environment.NewLine
end if
next
Retstring &= " </ul>" & Environment.NewLine
Retstring &= " <script>" & Environment.NewLine
Retstring &= " checkcheckboxes(""" & Veldnaam & """);" & Environment.NewLine
Retstring &= " </script>" & Environment.NewLine
Retstring &= "</ul>" & Environment.NewLine
'end exception
else If Koppelveldid <= 0 then
Select Case Veldtype
case "Bedrag", "Heel Getal"
Dim minvalue as integer = 0
Dim maxvalue as integer = 0
Using Con As New SqlConnection(constring)
Try
Dim Query As String = ""
Query &= " SELECT "
Query &= " min(" & Veldnaam & ") as minvalue "
Query &= " ,max(" & Veldnaam & ") as maxvalue "
Query &= " FROM " & prefix & Tablenaam
Query &= " WHERE (" & mainselection & "= @mainselectionvalue "
Query &= " OR @mainselectionvalue = 0) "
Query &= " AND Prijsopaanvraag = 'Nee' "
Query &= Selectie
Dim Com As New SqlCommand(Query, Con)
Com.Parameters.AddWithValue("@mainselectionvalue", mainselectionvalue)
Con.open()
Dim Reader As SqlDataReader = Com.ExecuteReader()
while Reader.Read()
minvalue = Math.floor(Reader("minvalue"))
maxvalue = Math.ceiling(Reader("maxvalue"))
end while
Catch ex As Exception
controlplace.controls.add(New LiteralControl("Error select min/max value " & Veldnaam & ": " & ex.tostring & "<br /><br />"))
Finally
Con.close()
End Try
End Using
Dim minrange as integer = minvalue
Dim maxrange as integer = maxvalue
Retstring &= "<div class=""label range"" id=""filterprice"">" & Environment.NewLine
Retstring &= "<span id=""desciption_" & Veldnaam & """>" & Omschrijving & "</span>" & Environment.NewLine
Retstring &= "<label id=""amount_" & Veldnaam & """ class=""lblslider-range"" style=""display:none;""></label>" & Environment.NewLine
Retstring &= "<div class=""control"">" & Environment.NewLine
Retstring &= "&euro; <input class=""from"" type=""text"" onkeyup=""setSlider($(this).val(),0,'min');"" />" & Environment.NewLine
Retstring &= "<div class=""slider-range sliderrange"" id=""slider-range_" & Veldnaam & """></div> " & Environment.NewLine
Retstring &= "&euro; <input class=""to"" type=""text"" onkeyup=""setSlider($(this).val(),1,'max')"" />" & Environment.NewLine
Retstring &= "</div>" & Environment.NewLine
Retstring &= "</div>" & Environment.NewLine
Retstring &= "<script> " & Environment.NewLine
Retstring &= "var timer;" & Environment.NewLine
Retstring &= "function setSlider(value,valid,minmax){" & Environment.NewLine
Retstring &= "clearTimeout(timer);" & Environment.NewLine
Retstring &= "timer=setTimeout(function validate(){" & Environment.NewLine
Retstring &= "$('#slider-range_" & Veldnaam & "').slider('values', valid, parseInt(value));SetAncherParameter('" & Omschrijving & "_' + minmax,parseInt(value)); " & Environment.NewLine
Retstring &= "},500);" & Environment.NewLine
Retstring &= "}" & Environment.NewLine
Retstring &= " var startmin = " & minvalue & ";" & Environment.NewLine
Retstring &= " var startmax = " & maxvalue & ";" & Environment.NewLine
Retstring &= " var minrange = " & minvalue & ";" & Environment.NewLine
Retstring &= " var maxrange = " & maxvalue & ";" & Environment.NewLine
Retstring &= " var from = $(""#filterprice"").find('.from');" & Environment.NewLine
Retstring &= " var to = $(""#filterprice"").find('.to');" & Environment.NewLine
Retstring &= " if (!isNaN(getURLParameter(""" & Omschrijving & "_min""))) {" & Environment.NewLine
Retstring &= " minrange = getURLParameter(""" & Omschrijving & "_min"");" & Environment.NewLine
Retstring &= " }" & Environment.NewLine
Retstring &= " if (!isNaN(getURLParameter(""" & Omschrijving & "_max""))) {" & Environment.NewLine
Retstring &= " maxrange = getURLParameter(""" & Omschrijving & "_max"");" & Environment.NewLine
Retstring &= " }" & Environment.NewLine
Retstring &= "$(document).ready(function() { " & Environment.NewLine
Retstring &= "$(""#slider-range_" & Veldnaam & """).slider({ " & Environment.NewLine
Retstring &= "range: true, " & Environment.NewLine
Retstring &= "min: " & minvalue & ", " & Environment.NewLine
Retstring &= "max: " & maxvalue & ", " & Environment.NewLine
Retstring &= "values: [ minrange, maxrange], " & Environment.NewLine
Retstring &= "slide: function( event, ui ) { " & Environment.NewLine
Retstring &= "$( ""#amount_" & Veldnaam & """ ).text( ""€ "" + ui.values[ 0 ] + "" - € "" + ui.values[ 1 ] ); " & Environment.NewLine
Retstring &= " from.val(ui.values[ 0 ]);" & Environment.NewLine
Retstring &= " to.val(ui.values[ 1 ]);" & Environment.NewLine
Retstring &= "}, " & Environment.NewLine
Retstring &= "start: function( event, ui ) { " & Environment.NewLine
Retstring &= " startmin = ui.values[ 0 ]; "
Retstring &= " startmax = ui.values[ 1 ]; "
Retstring &= "}, "
Retstring &= "stop: function( event, ui ) { " & Environment.NewLine
Retstring &= " if (ui.values[ 0 ] != startmin) { "
Retstring &= " SetAncherParameter(""" & Omschrijving & "_min"",ui.values[ 0 ]); " & Environment.NewLine
Retstring &= " } "
Retstring &= " if (ui.values[ 1 ] != startmax) { "
Retstring &= " SetAncherParameter(""" & Omschrijving & "_max"",ui.values[ 1 ]); " & Environment.NewLine
Retstring &= " } "
Retstring &= "} " & Environment.NewLine
Retstring &= "}); " & Environment.NewLine
Retstring &= "$( ""#amount_" & Veldnaam & """ ).text( ""€ "" + $( ""#slider-range_" & Veldnaam & """ ).slider( ""values"", 0 ) + "" - € "" + $( ""#slider-range_" & Veldnaam & """ ).slider( ""values"", 1 ) ); " & Environment.NewLine
Retstring &= " from.val($( ""#slider-range_" & Veldnaam & """ ).slider( ""values"", 0 ));" & Environment.NewLine
Retstring &= " to.val($( ""#slider-range_" & Veldnaam & """ ).slider( ""values"", 1 ));" & Environment.NewLine
Retstring &= "}); " & Environment.NewLine
Retstring &= "</script> " & Environment.NewLine
case else
controlplace.controls.add(New LiteralControl("Id: " & Id & "<br />"))
controlplace.controls.add(New LiteralControl("Veldnaam: " & Veldnaam & "<br />"))
controlplace.controls.add(New LiteralControl("Omschrijving: " & Omschrijving & "<br />"))
controlplace.controls.add(New LiteralControl("Veldtype: " & Veldtype & "<br />"))
controlplace.controls.add(New LiteralControl("Koppelveldid: " & Koppelveldid & "<br />"))
controlplace.controls.add(New LiteralControl("Koppelquery: " & Koppelquery & "<br />"))
controlplace.controls.add(New LiteralControl("Opmaak: " & Opmaak & "<br /><br />"))
end select
else
Retstring &= "<ul class=""filteritem ui-corner-all"">" & Environment.NewLine
Dim dsOptions As New DataSet
Dim Query As String = ""
Using Con As New SqlConnection(constring)
Try
Query &= Koppelquery
Dim tbljoin as string = Koppelquery.split(",")(0)
tbljoin = tbljoin.split("(")(1)
Dim tempselection as string = " Where (" & mainselection & "= @mainselectionvalue " & selectie
tempselection &= " OR @mainselectionvalue = 0) "
'create exception for one specified field
'If Veldnaam = "Domein" then
' tempselection &= " and GebruikInFilter = 'Ja' and GebruikInFilter IS NOT NULL "
'end exception
'end if
Dim groupby as string = " group by " & Koppelquery.split(" ")(1) & "," & Koppelquery.split(" ")(Koppelquery.split(" ").length -1)
Dim strjoin as string = " join " & prefix & Tablenaam & " on " & tbljoin & " = " & prefix & Tablenaam & "." & Veldnaam & " "
If Veldnaam.tolower.contains("druivenras") then
for i as integer = 2 to 5
strjoin &= " or " & tbljoin & " = " & prefix & Tablenaam & "." & Veldnaam & i & " "
next
end if
if Query.contains("ORDER BY") then
Query = Query.replace("ORDER BY", strjoin & " " & tempselection & " " & groupby & " ORDER BY")
else
Query &= " " & strjoin & " " & tempselection & " " & groupby
end if
'If Veldnaam.tolower.contains("druivenras") then
' pbw.send_mail("info@debruin.nl","bart.kock@sienn.com","","qry",Query,0,"")
'end if
Dim Com As New SqlCommand(Query, Con)
Com.Parameters.AddWithValue("@mainselectionvalue", mainselectionvalue)
Dim adt As New SqlDataAdapter()
adt.SelectCommand = com
adt.Fill(dsOptions)
Catch ex As Exception
controlplace.controls.add(New LiteralControl("Error select options " & Veldnaam & ": " & ex.tostring & "<br /><br />" & Query))
Finally
End Try
End Using
Retstring &= "<p><label id=""desciption_" & Veldnaam & """>" & Omschrijving & " </label>" & Environment.NewLine
Retstring &= " <ul class=""filteritemoptions ui-corner-all"">" & Environment.NewLine
If dsOptions.Tables.count > 0 then
For Each optrow As DataRow In dsOptions.tables(0).Rows
Dim OptId as integer = optrow(0)
Dim OptValue as string = optrow(1)
if not string.isnullorempty(OptValue.trim) then
Retstring &= "<li><input type=""checkbox"" class=""filter" & Veldnaam & """ id=""filter" & Veldnaam & "_" & OptId & """ onchange=""SetAncherOptions($(this).attr('class'))"" data-val=""" & OptValue & """>" & OptValue & " (<span class=""filteramount"" id=""filteramount_" & Veldnaam & "_" & OptId & """>0</span>)</li>" & Environment.NewLine
end if
next
end if
Retstring &= " </ul>" & Environment.NewLine
Retstring &= " <script>" & Environment.NewLine
Retstring &= " checkcheckboxes(""" & Veldnaam & """);" & Environment.NewLine
Retstring &= " </script>" & Environment.NewLine
Retstring &= "</ul>" & Environment.NewLine
end if
'Retstring &= "</li>" & Environment.NewLine
next
'Retstring &= "</ul>" & Environment.NewLine
Viewtext = Viewtext.replace(vbcrlf," ")
If AdvancedEdit = "Ja" then
Dim viewRegexstring as string = "{!!==&gt;END SUBHEADER!!}.*.{!!==&gt;END BODY!!}"
Dim viewmatches As MatchCollection = Regex.Matches(Viewtext, viewregexstring, RegexOptions.Multiline)
For Each submatch As Match In viewmatches
Viewtext = submatch.Value
next
Viewtext = Viewtext.replace("{!!==&gt;END SUBHEADER!!}","")
Viewtext = Viewtext.replace("{!!==&gt;END BODY!!}","")
end if
Dim Selectfieds as string = ""
Dim Joinstring as string = ""
Viewtext = Viewtext.replace("!!}","!!}" & vbcrlf)
Dim Regexstring as string = "{!!.*.!!}"
Dim matches As MatchCollection = Regex.Matches(Viewtext, regexstring, RegexOptions.Multiline)
For Each submatch As Match In matches
Dim orgFieldstring as string = submatch.Value
orgFieldstring = orgFieldstring .replace("{!!","")
orgFieldstring = orgFieldstring .replace("!!}","")
Dim fieldstring as string = orgFieldstring
If fieldstring.contains(".") then
Dim Veldtype as string = ""
If fieldstring.indexOf("_") > 0 then
Dim tablename as string = fieldstring
tablename = tablename.split("_")(1)
tablename = tablename.split(".")(0)
Dim relatedfield as string = fieldstring
relatedfield = relatedfield.split("_")(0)
Dim Joinname as string = fieldstring.split(".")(0)
Joinstring &= " JOIN " & prefix & tablename & " " & prefix & Joinname & " on " & prefix & Tablenaam & "." & relatedfield & " = " & Prefix & Joinname & ".Id "
else
Using Con As New SqlConnection(constring)
Try
Dim Query As String = ""
Query &= " SELECT "
Query &= " [Veldtype] "
Query &= " FROM " & CID & "_TABEL_VELDEN"
Query &= " WHERE [Tabelid] = @Tabelid "
Query &= " AND Veldnaam = @veldnaam "
Dim Com As New SqlCommand(Query, Con)
Com.Parameters.AddWithValue("@Tabelid", TabelId)
Com.Parameters.AddWithValue("@veldnaam", fieldstring.split(".")(1))
Con.open()
Dim Reader As SqlDataReader = Com.ExecuteReader()
while Reader.Read()
Veldtype = reader("Veldtype")
end while
Catch ex As Exception
controlplace.controls.add(New LiteralControl("Error select type " & fieldstring & ": " & ex.tostring & "<br /><br />"))
Finally
Con.close()
End Try
End Using
end if
Select Case Veldtype
Case "Foto"
Joinstring &= " JOIN " & CID & "_Foto on " & prefix & Tablenaam & "." & fieldstring.split(".")(1) & " = " & CID & "_Foto.Id "
if fieldstring.indexOf("_") = 0 then
fieldstring = Cid & "U" & fieldstring
else
fieldstring = prefix & fieldstring
end if
if not Selectfieds.contains(fieldstring) then
if Selectfieds <> ""then
Selectfieds &= ","
end if
Selectfieds &= " " & CID & "_Foto.[fotolocatie] as [" & orgFieldstring & "]"
end if
Case Else
if fieldstring.indexOf("_") = 0 then
fieldstring = Cid & "U" & fieldstring
else
fieldstring = prefix & fieldstring
end if
if not Selectfieds.contains(fieldstring) then
if Selectfieds <> ""then
Selectfieds &= ","
end if
Selectfieds &= fieldstring & " as [" & orgFieldstring & "]"
end if
end select
end if
next
'for each field as string in fields.split(",")
' if Selectfieds <> ""then
' Selectfieds &= ","
' end if
' Selectfieds &= prefix & Tablenaam & "." & field & " as count_" & field
'next
Viewtext = Viewtext.replace(vbcrlf,"")
'Viewtext = Viewtext.replace("<script","&lt;script")
'Viewtext = Viewtext.replace("script>"," script&gt;")
Viewtext = server.htmlencode(Viewtext)
Retstring &= "<div id=""filterlayout"" style=""display:none;"">" & Viewtext & "</div>" & Environment.NewLine
Retstring = "<div id=""filterselects"">" & Retstring & "</div>"
controlplace.controls.add(New LiteralControl(Retstring))
httpcontext.current.session("Selectfieds") = Selectfieds
httpcontext.current.session("Joinstring") = Joinstring
httpcontext.current.session("ViewId") = ViewId
httpcontext.current.session("Fields") = Fields
httpcontext.current.session("mainselection") = mainselection
httpcontext.current.session("DestinationUrlTemplate") = DestinationUrlTemplate
httpcontext.current.session("FieldnameKey") = FieldnameKey
httpcontext.current.session("TabelId") = TabelId
httpcontext.current.session("Selectie") = Selectie
httpcontext.current.session("Tablenaam") = Tablenaam
httpcontext.current.session("mainselectionvalue") = mainselectionvalue
Catch ex As Exception
controlplace.controls.add(New LiteralControl("Error main: " & ex.tostring & "<br /><br />"))
End Try
Then I created a webservice to correspond with this, Description: Code:20131015 BK: Control added,
filter
call: Code:<%@ WebService Language="VB" Class="Filter.WebService" %>
webservice: [code]Imports System.Web Imports System.Web.Services Imports System.Xml Imports System.Web.Services.Protocols Imports System.Web.Script.Services Imports System.Data.SqlClient Imports System.Data Imports...
|
