<%Option Explicit%>
<%
'**********************************************************************
' Version 4.50 Oct 21, 2002 change olgetsubcategories to getsubcateggories
'
' rewritten to use checkboxes and subcategory
' Remove request.form to allow calls via hyperlink
' Search fields are determined by table in shop$colors.asp
'**********************************************************************
SetSess "CurrentURL","shopsearch.asp"
Saction=Request.Querystring("Search")
SError=Request("msg")
Dim ySearchDisplaycategories, ySearchDisplaySubcat
Dim Words(10)
Dim wordcount
Dim delimiter
Dim sAction
Dim strKeyword, strsearchsort, strsearchsortupdown
Dim rscat
Dim dbc
dim Rssubcat
Dim sqlSub
Dim CatArray
Dim CatCount
Dim SubcatArray
redim Subcatarray (Getconfig("xMaxSubcategories"))
Dim SubcatTempArray
Redim SubcattempArray(getconfig("xMaxSubcategories"))
Dim SubCatCount
dim sortupdownnames(2),sortupdownvalues(2),sortupdowncount
ySearchDisplaycategories=getconfig("xsearchdisplaycategories")
ySearchdisplaysubcat=getconfig("xsearchdisplaysubcat")
If getconfig("xoldcategorymode")="Yes" then
OldShopSearch
else
ShopSearch
end if
Sub ShopSearch
ShopOpenDatabase dbc
If SAction="" then
ShopPageHeader
If ySearchDisplayCategories="Yes" then
SQL = "SELECT * from categories "
sql= sql & " where highercategoryid=0 "
if getconfig("xproductmatch")="Yes" then
sql=sql & " and productmatch='" & xproductmatch & "'"
end if
if getconfig("xproductmatchcustomer")="Yes" then
if GetSess("CustomerProductGroup")<>"" then
sql=sql & " and (customermatch='" & getsess("customerProductgroup") & "'" & " or customermatch is null)"
end if
end if
sql= sql & " order by " & getconfig("xsortcategories")
Set rscat = dbc.Execute(SQL)
end if
SearchDisplayForm()
ShopCloseDatabase dbc
ShopPageTrailer
Else
SearchGetFormData
SearchGenerateSQL dbc
shopclosedatabase dbc
DOSearchCapture
' debugwrite sql
Response.Redirect "shopdisplayproducts.asp?Search=Yes"
End if
end sub
' Generate SQL
Sub SearchDisplayForm()
'
Dim othercount,i,stroOther
Dim OtherTypes(50), othercaptions(50), othercaptioncount
othercount=0
othercaptioncount=0
'search sort
If getconfig("xSearchSortFields")<>"" then
parserecord getconfig("xSearchSortFields"),OtherTypes,othercount,","
'debugwrite getconfig("xSearchSortCaptions")
If getconfig("xSearchSortCaptions")<>"" then
parserecord getconfig("xSearchSortCaptions"),OtherCaptions,othercaptioncount,","
end if
for i = 0 to othercount-1
If othercaptions(i)="" then
Othercaptions(i)=othertypes(i)
end if
next
Setupdown
end if
Response.write "
"
if sError <>"" then
Response.Write("" & sError & "
")
Serror=""
end if
Response.Write("" & getconfig("xfont") & LangSearch01 & "")
Response.Write("
")
end sub
'
Sub GenerateCategory
%>
">
<%=SearchCatColumnStart%><%=RSCat("catdescription")%><%=SearchCatColumnEnd%>
<%
end sub
Sub GenerateSubCategory
If ySearchDisplaySubcat<>"Yes" then exit sub
dim subsql
if isnull(rscat("hassubcategory")) then
Response.write SearchSubCatColumnStart & LangSearchNoSubCat & SearchSubCatColumnEnd
exit sub
end if
response.write SearchSubCatColumnStart
Subsql="Select * from categories where highercategoryid=" & rscat("categoryid")
if getconfig("xproductmatch")="Yes" then
subsql=subsql & " and productmatch='" & xproductmatch & "'"
end if
if getconfig("xproductmatchcustomer")="Yes" then
if GetSess("CustomerProductGroup")<>"" then
subsql=subsql & " and (customermatch='" & getsess("customerProductgroup") & "'" & " or customermatch is null)"
end if
end if
subsql = subsql & " Order by " & getconfig("xsortcategories")
'debugwrite subsql
set rsSubcat=dbc.execute(subsql)
%>
<%=SearchSubCatColumnEnd%>
<%
End Sub
'********************************************************
' compatibility Mode
'*********************************************************
Sub OldShopSearch
If SAction="" then
ShopOpenDatabase dbc
ShopPageHeader
If ySearchDisplayCategories="Yes" then
SQL = "SELECT * from categories order by " & getconfig("xsortcategories")
Set rscat = dbc.Execute(SQL)
end if
OldSearchDisplayForm()
ShopCloseDatabase dbc
ShopPageTrailer
Else
SearchGetFormData
oldSearchGenerateSQL 'generate search SQL
DOSearchCapture
' debugwrite sql
Response.Redirect "shopdisplayproducts.asp?Search=Yes"
End if
end sub
' Generate SQL
Sub OLdSearchDisplayForm()
Response.write "
"
if sError <>"" then
Response.Write("" & sError & "
")
Serror=""
end if
Response.Write("" & getconfig("xfont") & LangSearch01 & "")
Response.Write("
")
end sub
'
Sub OldGenerateCategory
%>
">
<%=SearchCatColumnStart%><%=RSCat("catdescription")%><%=SearchCatColumnEnd%>
<%
end sub
Sub OldGenerateSubCategory
If ySearchDisplaySubcat<>"Yes" then exit sub
dim subsql
If IsNull(RsCat("Hassubcategory")) then
Response.write SearchSubCatColumnStart & LangSearchNoSubCat & SearchSubCatColumnEnd
exit sub
end if
response.write SearchSubCatColumnStart
Subsql="Select * from subcategories where categoryid=" & rscat("categoryid")
subsql = subsql & " Order by " & getconfig("xsortsubcategories")
set rsSubcat=dbc.execute(subsql)
%>
<%=SearchSubCatColumnEnd%>
<%
End Sub
'
Sub SearchGetFormData()
dim tempcount
Dim i
strCategory = Request("Category")
If StrCategory="" then
Catcount=0
else
CatArray=split(strCategory,",")
Catcount=ubound(CatArray)
catcount=catcount+1
end if
strSubCategory = Request("SubCategory")
If strSubcategory="" then
Subcatcount=0
else
ParseRecord strSubcategory, subcatTempArray, tempcount, ","
subcatcount=0
for i = 0 to tempcount-1
If SubCatTempArray(i) <> trim(LangCommonAll) then
SubcatArray(subcatcount)=SubCatTempArray(i)
subcatcount=subcatcount+1
end if
next
end if
'added for search sort 30 Jan
xsearchsortfield=""
xsearchsortupdown=""
XSearchSortField = Request("strsearchsort")
XSearchSortupdown = Request("strsearchsortupdown")
if xsearchsortfield=langcommonselect then
xsearchsortfield=""
end if
if xsearchsortupdown=langcommonselect then
xsearchsortupdown="ASC"
end if
strKeyword = Request("Keyword")
if strkeyword<>"" then
Delimiter=","
parseRecord strkeyword, words, wordcount,delimiter
CorrectSearchWords words, wordcount
Else
wordcount=0
end if
end sub
Sub CorrectSearchWords (words, wordcount)
dim i
for i =0 to wordcount-1
words(i)=replace(words(i),"'","''")
next
end sub
'
Sub DoSearchCapture
if getconfig("XSearchCapture")<>"Yes" then exit sub
If 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_HOST")
ShopOpenOtherDB dbc,getconfig("XSearchDb")
Set objRS=Server.createObject ("ADODB.Recordset")
objrs.open "searchresults", dbc, adopenkeyset, adlockoptimistic, adcmdtable
objRS.AddNew
updateresultfield "categories",strcategory
getsubcategories subcategories
updateresultfield "subcategories",subcategories
updateresultfield "words",strkeyword
updateresultfield "lastname", getsess("lastname")
updateresultfield "customerid", getsess("customerid")
updateresultfield "ipaddress", servername
updateresultfield "rdate", date()
updateresultfield "rtime", time()
objRS.Update
objRS.close
ShopCloseDatabase dbc
end sub
Sub UpdateResultField (Fieldname,fieldvalue)
'on error resume next
if fieldvalue="" then
exit sub
end if
objRS(fieldname)=fieldvalue
end sub
Sub GetSubcategories (subcategories)
Dim i
if subcatcount=0 then
subcategories=""
exit sub
end if
for i =0 to subcatcount-1
if i> 0 then
Subcategories= subcategories & "," & Subcatrray(i)
else
Subcategories=Subcategories & subcatarray(i)
end if
next
end sub
Sub SetUpDown
Sortupdownnames(0)=LangAscending
Sortupdownnames(1)=LangDescending
Sortupdownvalues(0)="ASC"
Sortupdownvalues(1)="DESC"
SortUpDowncount=2
end sub
%>