<% '*********************************************************** ' VP-ASP 6.50 March 6, 2004 ' VP-ASP General Query of Products based on any field ' and field=value can come from a form or hyperlink ' If using a form, the Form field name must be SHOPQUERY ' if numbers < 0 then they are ignore ' if fieldvalue="ALL" then all fieldvalues match ' lowprice allowed for cprice ' Cookieless fix '************************************************************* const cMaxProductFields=100 dim allvaluues allvalues="ALL" Dim keys(100) dim keyvalues(100) dim keycount dim firsttime dim Words(10) Dim wordcount Dim ProductFields dim ProductTypes Dim ProductFieldCount dim fieldtype dim dbc dim qtemplate ' InitializeSystem ShopopendatabaseP dbc QueryGetProductFields GetInput ' see what user wants GenerateSQL dbc ' generate SQL shopclosedatabase dbc SetSess "wordcount",keycount SetSessa "Words",keys Setsess "SQL",SQL 'VP-ASP 6.50 - precautionary security fix qtemplate=cleanchars(Request("template")) 'VP-ASP 6.09 - hide breadcrumb on exd page If qtemplate="" then ResponseRedirect "shopdisplayproducts.asp?search=yes&bc=no" else ResponseRedirect "shopdisplayproducts.asp?search=yes&template=" & server.urlencode(qtemplate) & "&bc=no" end if ' Sub GetInput dim key dim strname, strvalue keycount=0 wordcount=0 For Each key in Request.form strname = key 'VP-ASP 6.50 - precautionary security fix strvalue = cleanchars(Request.Form(key)) if strvalue<>"" Then KeyValues(keycount)=strvalue Keys(keycount)=strname keycount=keycount+1 end if next For Each key in Request.Querystring strname = key 'VP-ASP 6.50 - precautionary security fix strvalue = cleanchars(Request.querystring(key)) if strvalue<>"" Then KeyValues(keycount)=strvalue Keys(keycount)=strname keycount=keycount+1 end if next end sub Sub GenerateSQL (dbc) dim i dim rc 'VP-ASP 6.09 - Comment this out so feature can't be used - it's outdated 'If getconfig("xoldcategorymode")="Yes" Then ' OldGeneratesql ' exit sub 'end if QueryGenerateSQL dbc end sub Sub OldGenerateSQL dim i dim rc If getconfig("XProductMultiCategories")="Yes" Then OLDQueryGenerateMultiSQL exit sub end if OLDQueryGenerateSQL end sub ' don't allow bad fields to get into query Sub QueryGetProductFields dim fSql dim rs dim fldname dim fieldtype ProductFieldCount=GetSess("ProductFieldCount") If ProductFieldCount="" then ProductFieldCount=0 ReDim ProductFields(cMaxProductFields) ReDim ProductTypes(cMaxProductFields) fsql = "select * from products" Set rs = dbc.Execute(fSQL) For each fldName in rs.Fields ProductFields(productfieldcount)=ucase(fldName.Name) fieldtype=GetTypeName(fldname.type) ProductTypes(productfieldcount)=fieldtype ' debugwrite fieldtype If lcase(productfields(productfieldcount))<>"template" then Productfieldcount=Productfieldcount+1 end if next closerecordset rs SetSessA "ProductFields",ProductFields SetSessA "ProductTypes",ProductTypes SetSess "ProductFieldCount",ProductFieldCount end if ProductFields=GetsessA("ProductFields") ProductTypes=GetsessA("ProductTypes") ProductFieldCount=GetSess("ProductFieldCount") End Sub ' Sub CheckValidfield (fieldname, rc, fieldtype) rc =0 for i = 0 to ProductFieldcount-1 if fieldname=ProductFields(i) then fieldtype=ProductTypes(i) exit sub end if next Select case fieldname case "LOWPRICE" rc=0 fieldtype="Currency" exit sub case "CPRICE" rc=0 fieldtype="Currency" exit sub end select rc=4 end sub Function GetTypeName(id) Select Case id Case "3" GetTypeName = "Number" Case "200" GetTypeName = "Text" Case "129" GetTypeName = "Text" Case "201" GetTypeName = "Memo" Case "6" GetTypeName = "Currency" Case "11" GetTypeName = "YesNo" Case "5" GetTypeName = "Number" Case "7", "133","134","135" GetTypeName = "DateTime" Case Else GetTypeName = "Text" End Select End Function %>