<%Option Explicit%> <% '********************************************************************** ' Version 6.50 ' rewritten to use checkboxes and subcategory ' Remove request.form to allow calls via hyperlink ' Search fields are determined by table in shop$colors.asp ' April 11, 2004, search by price '********************************************************************** InitializeSystem dim howManyItems, chosencategory, lowprice, highprice dim mysearchfields dim allwordsString, exactString, atleastString, withoutString Dim fieldCount,delimiter Dim allwordsCount, atleastCount, withoutCount Dim allwordsWords(10), atleastWords(10), withoutWords(10) Dim dbc Dim strSearchFields dim Saction SetSess "CurrentURL","shopsearch.asp" 'VP-ASP 6.50 - precautionary security fix Saction=cleanchars(Request.Querystring("Search")) SError=cleanchars(Request("msg")) IF Saction = "" THEN ShopPageHeader 'VP-ASP 6.09 - added breadcrumb / VP-ASP 6.50 - added config option to turn breadcrumb on/off if getconfig("xbreadcrumbs") = "Yes" then response.write "

" & getlang("langcommonhome") & " " & SubCatSeparator & getlang("langcommonsearch") & "

" end if showAdvancedSearch ShopPageTrailer Else ShopOpenDatabaseP dbc SearchGetFormData ' response.write(howManyItems) 'response.write(chosencategory) 'response.write(lowprice) 'response.write(highprice) 'response.write(allwordsString) 'response.write(exactString) 'response.write(atleastString) 'response.write(withoutString) 'Dim j 'For j = 0 to Ubound(searchfields) SearchGenerateSQLv2 dbc shopclosedatabase dbc DOSearchCapture 'debugwrite sql responseredirect "shopdisplayproducts.asp?Search=Yes&sppp=" & howManyItems End if Sub SearchGetFormData() dim tempcount Dim i 'VP-ASP 6.50 - precautionary security fix strSearchFields = cleanchars(Request("searchfields")) xsearchsortfield="" xsearchsortupdown="" XSearchSortField = cleanchars(Request("strsearchsort")) XSearchSortupdown = cleanchars(Request("strsearchsortupdown")) if xsearchsortfield=getlang("langcommonselect") then xsearchsortfield="" end if if xsearchsortupdown=getlang("langcommonselect") then xsearchsortupdown="ASC" end if If instr(strSearchFields,";") then strSearchFields="" If strSearchFields="" then Fieldcount=0 else mysearchfields=split(strSearchFields,",") Fieldcount=ubound(mysearchfields) Fieldcount=Fieldcount+1 end if 'VP-ASP 6.50 - precautionary security fix chosencategory = cleanchars(Request("category")) highprice=Replace(cleanchars(Request("highprice")),"$","") lowprice=Replace(cleanchars(Request("lowprice")),"$","") howManyItems = cleanchars(Request("howmanyitems")) if chosencategory = "" then chosencategory = "ALL" if howManyItems = "" then howManyItems = getconfig("xproductsperpage") 'setsess "searchitemsperpage", howManyItems 'VP-ASP 6.50 - precautionary security fix allwordsString = cleanchars(Request("allwords")) if allwordsString = "" then allwordsString = cleanchars(Request("Keyword")) end if 'VP-ASP 6.50 - precautionary security fix exactString = cleanchars(Request("exact")) atleastString = cleanchars(Request("atleast")) withoutString = cleanchars(Request("without")) '*************************************************************** ' All Words If Instr(allwordsString,";") then allwordsString="" end if if allwordsString<>"" then 'VP-ASP 6.08 - If there's a comma in the string, use it as the delimiter if instr(allwordsstring, ",") > 0 then delimiter = "," else Delimiter=" " end if parseRecord allwordsString, allwordswords, allwordscount,delimiter CorrectSearchWords allwordswords, allwordscount Else allwordscount=0 end if '*************************************************************** ' At least some words If Instr(atleastString,";") then atleastString="" end if if atleastString<>"" then Delimiter=" " parseRecord atleastString, atleastwords, atleastcount,delimiter CorrectSearchWords atleastwords, atleastcount Else atleastcount=0 end if '*************************************************************** ' Without words If Instr(withoutString,";") then withoutString="" end if if withoutString<>"" then Delimiter=" " parseRecord withoutString, withoutwords, withoutcount,delimiter CorrectSearchWords withoutwords, withoutcount Else withoutcount=0 end if end sub Sub CorrectSearchWords (words, wordcount) dim i for i =0 to wordcount-1 '------------------------------------------ ' VP-ASP 6.50.4 Bugs Fix - 08 October 2008 '------------------------------------------ words(i)=replace(words(i),"''","'") words(i)=replace(words(i),"'","''") next end sub Sub DoSearchCapture if getconfig("XSearchCapture")<>"Yes" then exit sub 'VP-ASP 6.50 - broadened defintion of IF statement to cover cases where xmysql hasn't been set if ucase(xdatabasetype) = "MYSQL" OR ucase(xdatabasetype) = "MYSQL351" OR getconfig("xMYSQL")="Yes" then MYSQLDOSearchCapture exit sub end if '******************************************************** ' Store search results in seach table '******************************************************* dim dbc Dim Subcategories dim servername on error resume next servername=request.servervariables("HTTP_ADDR") ShopOpenOtherDB dbc,getconfig("XSearchDb") Set objRS=Server.createObject ("ADODB.Recordset") objrs.open "searchresults", dbc, adopenkeyset, adlockoptimistic, adcmdtable objRS.AddNew 'updateresultfield "categories",strcategory objRS("categories") = chosencategory ' getsubcategories subcategories ' updateresultfield "subcategories",subcategories ' updateresultfield "words",strkeyword dim updatesearchstring if allwordsString > "" then updatesearchstring = "ALL: " & allwordsString end if if exactString > "" then if updatesearchstring > "" then updatesearchstring = updatesearchstring & " / " end if updatesearchstring = updatesearchstring & "EXACT: " & exactString end if if atleastString > "" then if updatesearchstring > "" then updatesearchstring = updatesearchstring & " / " end if updatesearchstring = updatesearchstring & "AT LEAST: " & atleastString end if if withoutString > "" then if updatesearchstring > "" then updatesearchstring = updatesearchstring & " / " end if updatesearchstring = updatesearchstring & "WITHOUT: " & withoutString end if objRS("words") = updatesearchstring objRS("lastname") = getsess("lastname") objRS("customerid") = getsess("customerid") objRS("ipaddress") = servername objRS("rdate") = date() 'VP-ASP 6.09 - added formatdatetime objRS("rtime") = formatdatetime(time(), vbshorttime) objRS.Update objRS.close ShopCloseDatabase dbc end sub %>