<%Option Explicit%>
[an error occurred while processing this directive]
<%
dim xSearchSortField,xsearchsortupdown
Sub ProductCreateSQL (sql, dbc)
'*****************************************************
' VP-ASP 5.00 
' Generates SQL to display a product.
' Creates SQL for dispaly products, search and shopquery 
' expects most parameters to be in global
' June 26 fix categoriessimple
' Nov 29, 2003 add additional sql injection tests
' Feb 21, 2004 Fix product match query
'*****************************************************
sql=""
dim strProductFields
dim i
dim strdistinct
strdistinct="DISTINCTROW"
if UCASE(xdatabasetype)="SQLSERVER" or ucase(getconfig("xdatabasetype"))="SQLSERVER" then
	strdistinct="DISTINCT"
end if
strProductFields=Getsess("strProductFields")
If strProductFields="" then
	GetProductfields dbc
	strProductFields=Getsess("strProductFields")
end if
If getconfig("xCategoriesSimple")="Yes" then
   NewProductSQL sql
   exit sub
end if
' Find sql injection attack
dim tcategory, tproductname
catalogid=cleancharsint(catalogid)   
cat_id=cleancharsint(cat_Id)
tcategory=cleanchars(category)
tproductname=cleanchars(productname)
'
	sql="select " & strdistinct & " " & strproductfields
	sql=sql & " from products p, prodcategories cc, categories c"
	sql=sql & " where cc.intcatalogid=p.catalogid and cc.intcategoryid=c.categoryid and"
	if cat_id <> "" then
	     sql = sql & " cc.intcategoryid = " & cat_id
	else
	    if catalogid<>"" then
	           sql = sql & " p.catalogid = " & catalogid
	    else       
	       if tproductname="" then 
	          sql = sql & " c.catdescription like '"& tcategory & "%'"
	       else
	         sql = sql & "p.cname like '"& tproductname & "%'" 
	       end if
	    end if   
	end if
	sql=sql & " and hide=0 "
	if getconfig("xstocklow")<>"" then
	    lngcstock= clng(getconfig("xstocklow")) 
	    sql = sql & " and cstock> " & lngcstock
	end if
	if getconfig("xproductmatch")="Yes" then
         sql=sql & " and (p.productmatch='" & xproductmatch & "'"
         sql=sql & " or p.productmatch is null)"
        end if 
      	if getconfig("xproductmatchcustomer")="Yes" then
          if GetSess("CustomerProductGroup")<>"" then
            sql=sql & " and (p.customermatch like '%" & getsess("customerProductgroup") & "%'"
            sql=sql & " or p.customermatch is null)"
          else
              sql=sql & " and p.customermatch is null"  
          end if    
        end if    
        If getconfig("xselectproductsbylanguage")="Yes" and getsess("language")<>"" then
            sql=sql & " and (clanguage='" & getsess("language") & "'"
            sql=sql & " or clanguage is null)"
        end if    
	sql = sql & " order by " & getconfig("xsortproducts")
	'SetSess "SQL", sql
	if getconfig("xdebug")="Yes" then
	  debugwrite sql
	end if  
end sub

Sub SearchGenerateSQL(dbc)
dim i, j
dim whereok
Dim SearchFields
dim Fieldcount
dim strdistinct
dim tword
strdistinct="DISTINCTROW"
if UCASE(xdatabasetype)="SQLSERVER" or ucase(getconfig("xdatabasetype"))="SQLSERVER" then
	strdistinct="DISTINCT"
end if
If getconfig("xCategoriesSimple")="Yes" then
   NewSearchGenerateSQL sql
   exit sub
end if   
SetupSearchFields SearchFields
Fieldcount=ubound(Searchfields)
whereok=" AND "
dim strProductFields, tmpstr
GetProductFields dbc
strProductFields=Getsess("strProductFields")
tmpstr="select " & strdistinct & " " & strproductfields & " from products p, prodcategories cc, prodcategories sc, categories c"
sql= " where cc.intcatalogid=p.catalogid and cc.intcategoryid=c.categoryid AND sc.intcatalogid=p.catalogid"
if wordcount> 0  then
  SQL = SQL & whereok 
  SQL = SQL & "("
  Whereok="" 
  for i = 0 to wordcount-1
   SQL=SQL & whereok
    For j=0 to fieldcount
      If j> 0 then
         SQL = SQL & " OR "
      else
         SQL=SQL & " ( "
      end if  
      tword=cleanchars(Words(i))
      SQL = SQL & Searchfields(j) & " Like '%" & tword & "%' "
    next
    SQL = SQL & " )"
  whereok=" OR "
  next
  SQL = SQL & ")"
  whereok=" AND "
end if    
if catCount<>0  then
   SQL=SQL & whereok
   SQL = SQL & " ("  
   whereok=""  
   for i =0 to catcount-1
      sql = sql & whereok &  " cc.intcategoryid = " & cleancharsint(catarray(i))  
      whereOK=" OR "  
   next 
   Sql=Sql & ")"
   whereok=" AND "
end if

if SubcatCount<>0  then
   SQL=SQL & whereok
   SQL = SQL & " ("  
   whereok=""
   dim blnSubcat
   blnSubCat=False  
   for i =0 to Subcatcount-1
      sql=sql & whereok &  "sc.intcategoryid" & "=" &  cleancharsint(subcatarray(i)) 
      whereOK=" OR "
      blnSubCat=True        
   next 
   Sql=Sql & ")"
   whereok=" AND "
end if
'
Sql=Sql & whereok
sql=sql &  " hide=0"
whereok=" AND " 
if getconfig("xstocklow")<>"" then
    lngCStock= clng(getconfig("xStockLow")) 
    SQL= SQL & WhereOK 
    sql = sql & " cstock> " & lngcstock
    whereok=" AND " 
end if
if getconfig("xproductmatch")="Yes" then
   SQL= SQL & WhereOK 
   sql=sql & " ( p.productmatch='" & xproductmatch & "'"
   sql=sql & " or p.productmatch is null)"
   whereok=" AND " 
end if    
if getconfig("xproductmatchcustomer")="Yes" then
    if GetSess("CustomerProductGroup")<>"" then
       SQL= SQL & WhereOK 
       sql=sql & " (p.customermatch like '%" & getsess("customerProductgroup") & "%'"
       sql=sql & " or p.customermatch is null)"
       whereok=" AND " 
     else
         SQL= SQL & WhereOK 
         sql=sql & " p.customermatch is null"
         whereok=" AND " 
     end if      
end if
If getconfig("xselectproductsbylanguage")="Yes" and getsess("language")<>"" then
      sql=sql & " and (clanguage='" & getsess("language") & "'"
      sql=sql & " or clanguage is null)"
end if 
'added for search sort 3 April 2002n
If xSearchSortField<>"" Then
	sql = sql &  " order by " & xSearchSortField & " " & xsearchsortupdown
Else
	sql = sql &  " order by " & getconfig("xSortProducts")
End If               
sql=tmpStr & sql
SetSess "SQL",SQL
SetSessA "words",Words
SetSess "wordcount",wordcount
if getconfig("xdebug")="Yes" then
	  debugwrite sql
end if  
end sub

Sub QueryGenerateSQl (dbc) 
dim i
dim rc
dim strProductFields
dim strdistinct
strdistinct="DISTINCTROW"
if UCASE(xdatabasetype)="SQLSERVER" or ucase(getconfig("xdatabasetype"))="SQLSERVER" then
	strdistinct="DISTINCT"
end if
If getconfig("xCategoriesSimple")="Yes" then
   NewQueryGenerateSQL 
   exit sub
end if   
strProductFields=Getsess("strProductFields")
If strProductFields="" then
   GetProductFields dbc
   strProductFields=Getsess("strProductFields")
End If
tmpstr="select " & strdistinct & " " & strproductfields & " from products p, prodcategories cc, categories c "
'on error resume next
firsttime="FALSE"
sql=" where cc.intcatalogid=p.catalogid and cc.intcategoryid=c.categoryid "
for i=0 to keycount-1
      AddSQL  Keys(i), keyvalues(i), SQL
Next
AddPrefix
sql=sql &  " hide=0"
if getconfig("xstocklow")<>"" then
    lngCStock= clng(getconfig("xStockLow")) 
    AddPrefix 
    sql = sql  & " cstock > " & lngcstock
end if
if getconfig("xproductmatch")="Yes" then
   AddPrefix
   sql=sql & " p.productmatch='" & xproductmatch & "'"
end if    
if getconfig("xproductmatchcustomer")="Yes" then
    if GetSess("CustomerProductGroup")<>"" then
       AddPrefix
       sql=sql & " (p.customermatch like '%" & getsess("customerProductgroup") & "%'"
       sql=sql & " or p.customermatch is null)"
       whereok=" AND " 
     else
       AddPrefix
       sql=sql & " p.customermatch is null"
       whereok=" AND " 
     end if  
end if    
 
If getconfig("xselectproductsbylanguage")="Yes" and getsess("language")<>"" then
    sql=sql & " and clanguage='" & getsess("language") & "'"
end if    
If getconfig("xsortproducts")<>"" then 
  sql = sql & " ORDER BY " & getconfig("xSortProducts")
end if  
sql=tmpStr & sql
if getconfig("xdebug")="Yes" then
   debugwrite sql
end if
end sub
Sub addPrefix
if firsttime="TRUE" then
      SQL=SQL & " WHERE "
      firsttime="FALSE"
else
   SQL = SQL & " AND "
end if
end sub

Sub GetProductFields (dbc)
dim sortfields, strproductfields
strproductfields="p.catalogid"
sortfields=lcase(getconfig("xsortproducts"))
sortfields=replace(sortfields," asc","")
sortfields=replace(sortfields," desc","")
sortfields=replace(lcase(sortfields),"catalogid","")
if sortfields<>"" Then 
   strproductfields=strproductfields & "," & sortfields
end if   
setsess "strProductFields", strProductFields
end sub	

SUB AddSQL (strname,strvalue, SQL)
const Queryprefix="%"
dim fieldtype, istrname, tvalue
ustrname=Ucase(strname)
CheckValidField ustrname, rc, fieldtype
if rc>0 then
   exit sub
end if 
if Fieldtype ="Number" or FieldType="Currency" then
     strvalue=cleancharsInt(strvalue)
end if

if fieldtype="Text" or fieldtype="Memo" then
  If ucase(strvalue)=allvalues then          ' make all really mean all
     strvalue=""
  end if
   addprefix
   tvalue=cleanchars(strvalue)
   SQL=SQL & " p." &  strname & " like '" & queryprefix & tvalue & "%'"
   exit sub
end if 
If Fieldtype="DateTime" then
     addprefix
     SQL=SQL & " p." &  strname & "=#" & cdate(strvalue) & "#"
     exit sub
end if
If Fieldtype="Currency"  then
   if strvalue<0 then
       exit sub
   end if
   If not IsNumeric(strvalue) then
      exit sub
   end if 
   if getconfig("xConvertEuropeanNumbers")="Yes" then
     strvalue=replace(strvalue,",",".")
   end if
   'strvalue=Formatnumber(strvalue,2)
   addprefix
   If strname<>"lowprice" then 
     SQL=SQL & " p." &  strname & "<=" & strvalue 
    else
       SQL=SQL & " p.cprice>=" & strvalue 
   end if   
   exit sub
end if
if Fieldtype ="Number" then
    If strvalue<0 then
       exit sub
    end if
    If not IsNumeric(strvalue) then
      exit sub
     end if 
     addprefix
     SQL=SQL & " p." &  strname & "=" & strvalue 
     exit sub
end if
addprefix
  SQL=SQL & " p." &  strname & " like '" & strvalue & "%'"
end sub
'
Sub addPrefix
if firsttime="TRUE" then
      SQL=SQL & " WHERE "
      firsttime="FALSE"
else
   SQL = SQL & " AND "
end if
end sub
'**********************************************************
' dont use prod categories table
'************************************************************
Sub NewProductSQL(sql)
sql = "select * from products where "
if cat_id <> "" then
    sql = sql & " ccategory = " & cat_id & " or subcategoryid = " & cat_id
else
    if catalogid<>"" then
           sql = sql & " catalogid = " & cleancharsint(catalogid)
    else       
       if productname="" then 
          sql = sql & "category like '"& cleanchars(category) & "%'"
       else
         sql = sql & "cname like '"& cleanchars(productname) & "%'" 
       end if
    end if   
end if
if subcat<> "" then
'   sql = sql & " and subcategoryid=" & subcat
end if   
sql = sql & " and hide=0" 
if getconfig("xstocklow")<>"" then
    lngcstock= clng(getconfig("xstocklow")) 
    sql = sql & " and cstock> " & lngcstock
end if
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") & "'"
   end if  
end if
If getconfig("xselectproductsbylanguage")="Yes" and getsess("language")<>"" then
            sql=sql & " and clanguage='" & getsess("language") & "'"
end if    
sql = sql & " order by " & getconfig("xsortproducts")
'debugwrite sql
end sub
'***********************************************************
' Simple category mode for searches
'************************************************************
Sub NewSearchGenerateSQL(sql)
dim i, j, tword
dim whereok
Dim SearchFields
dim Fieldcount
SetupSearchFields SearchFields
Fieldcount=ubound(Searchfields)
whereok=" WHERE "
SQL = "SELECT * FROM products " 
if wordcount> 0  then
  SQL = SQL & whereok 
  SQL = SQL & "("
  Whereok="" 
  for i = 0 to wordcount-1
   SQL=SQL & whereok
    For j=0 to fieldcount
      If j> 0 then
         SQL = SQL & " OR "
      else
         SQL=SQL & " ( "
      end if 
      tword=cleanchars(words(i)) 
      SQL = SQL & Searchfields(j) & " Like '%" & tword & "%' "
    next
    SQL = SQL & " )"
  whereok=" OR "
  next
  SQL = SQL & ")"
  whereok=" AND "
end if    
if catCount<>0  then
   SQL=SQL & whereok
   SQL = SQL & " ("  
   whereok=""  
   for i =0 to catcount-1
      sql = sql & whereok &  " ccategory = " & clearcharint(catarray(i))  
      whereOK=" OR "  
   next 
   Sql=Sql & ")"
   whereok=" AND "
end if
if SubcatCount<>0  then
   SQL=SQL & whereok
   SQL = SQL & " ("  
   whereok=""  
   for i =0 to Subcatcount-1
      sql = sql & whereok &  " subcategoryid = " & cleancharsint(subcatarray(i))  
      whereOK=" OR "  
   next 
   Sql=Sql & ")"
   whereok=" AND "
end if
Sql=Sql & whereok
sql=sql &  " (hide=0)"
whereok=" AND " 
if getconfig("xstocklow")<>"" then
    lngCStock= clng(getconfig("xStockLow")) 
    SQL= SQL & WhereOK 
    Sql = sql & " cStock> " & lngCStock
    whereok=" AND " 
end if
if getconfig("xproductmatch")="Yes" then
   SQL= SQL & WhereOK 
   sql=sql & " productmatch='" & xproductmatch & "'"
   whereok=" AND " 
end if  
if getconfig("xproductmatchcustomer")="Yes" then
    if GetSess("CustomerProductGroup")<>"" then
       SQL= SQL & WhereOK 
       sql=sql & " customermatch='" & getsess("customerProductgroup") & "'"
     end if  
end if    
If getconfig("xselectproductsbylanguage")="Yes" and getsess("language")<>"" then
            sql=sql & " and clanguage='" & getsess("language") & "'"
end if    
sql = sql &  " order by " & getconfig("xSortProducts")
SetSess "SQL",SQL
SetSessA "words",Words
SetSess "wordcount",wordcount
'debugwrite SQL
end sub

'****************************************************
' simple category mode for shopquery
'*************************************************** 
Sub NEWQuerygenerateSQl 
on error resume next
firsttime="TRUE"
SQL = "SELECT * FROM products " 
if getconfig("xstocklow")<>"" then
    lngCStock= clng(getconfig("xStockLow")) 
    oldaddprefix 
    SQL = SQL  & " cStock> " & lngCStock
end if
for i=0 to keycount-1
      oldAddSQL  Keys(i), keyvalues(i), SQL
Next
oldaddprefix
sql=sql &  " (hide is NULL OR hide=0)"
if getconfig("xproductmatch")="Yes" then
   oldaddprefix
   sql=sql & " productmatch='" & xproductmatch & "'"
end if    
if getconfig("xproductmatchcustomer")="Yes" then
    if GetSess("CustomerProductGroup")<>"" then
       oldaddprefix
       sql=sql & " customermatch='" & getsess("customerProductgroup") & "'"
       whereok=" AND " 
     end if  
end if    
If getconfig("xselectproductsbylanguage")="Yes" and getsess("language")<>"" then
        oldaddprefix
        sql=sql & " clanguage='" & getsess("language") & "'"
end if    
sql = sql & " ORDER BY " & getconfig("xSortProducts")
if getconfig("xdebug")="Yes" then
   debugwrite sql
end if
end sub

SUB OLDAddSQL (strname,strvalue, SQL)
dim fieldtype, istrname
ustrname=Ucase(strname)
CheckValidField ustrname, rc, fieldtype
if rc>0 then
   exit sub
end if 
if Fieldtype ="Number" or FieldType="Currency" then
   strvalue=cleancharsint(strvalue)
end if

if fieldtype="Text" or fieldtype="Memo" then
  If ucase(strvalue)=allvalues then          ' make all really mean all
     strvalue=""
  end if
   oldaddprefix
   SQL=SQL & " " &  strname & " like '" & cleanchars(strvalue) & "%'"
   exit sub
end if 
If Fieldtype="DateTime" then
     oldaddprefix
     SQL=SQL & " " &  strname & "=#" & cdate(strvalue) & "#"
     exit sub
end if
If Fieldtype="Currency"  then
   if strvalue<0 then
       exit sub
   end if
   If not IsNumeric(strvalue) then
      exit sub
   end if 
   if getconfig("xConvertEuropeanNumbers")="Yes" then
     strvalue=replace(strvalue,",",".")
   end if
   'strvalue=Formatnumber(strvalue,2)
   oldaddprefix
   SQL=SQL & " " &  strname & "<=" & strvalue 
     exit sub
end if
if Fieldtype ="Number" then
    If strvalue<0 then
       exit sub
    end if
    If not IsNumeric(strvalue) then
      exit sub
     end if 
     oldaddprefix
     SQL=SQL & " " &  strname & "=" & strvalue 
     exit sub
end if
oldaddprefix
  SQL=SQL & " " &  strname & " like '" & strvalue & "%'"
end sub
'
Sub oldaddPrefix
if firsttime="TRUE" then
      SQL=SQL & " WHERE "
      firsttime="FALSE"
else
   SQL = SQL & " AND "
end if
end sub

'****************************************************************************
' SQL injection Function
'***************************************************************************
function CleanChars(strWords) 
dim badChars,i
dim newChars 
newchars=strwords
if len(Strwords)<15 then
    cleanChars = newChars
    exit function
end if     
badChars = array("select", "drop", ";", "--", "insert",  "delete", "xp_","union","char","@@") 
newChars = strWords 
for i = 0 to uBound(badChars) 
   if instr(1,newchars,badchars(i),1)>0 then
       newchars=""
       cleanchars=newchars
       exit function
   end if    
next 
newchars=replace(newchars,"'","''")
cleanChars = newChars 
end function 
'****************************************************************************
' SQL injection Function
'***************************************************************************
function CleanCharsInt(strWords) 
dim newchars
newchars=strwords
if not isnumeric(strwords) then
   newchars=0
end if   
cleanCharsint = newChars 
end function 

%>
<%
'**********************************************************************
' Version 5.00 
' rewritten to use checkboxes and subcategory
' Remove request.form to allow calls via hyperlink
' Search fields are determined by table in shop$colors.asp
' Nov 28, 2003 SQL Injection fixes
'**********************************************************************
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") & "'"
          end if  
       end if
       handle_selectcategoriesbylanguage    
       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
    responseredirect "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 "<p align='center'>"
if sError <>"" then
	shopwriteerror sError 
        Serror=""
end if
        shopwriteheader getlang("LangSearch01")
	Response.Write("<form name=form1 method=Post action='shopsearch.asp?search=Yes'>")
	Response.Write SearchKeywordTable
	Response.Write(SearchHeaderRow  & getlang("langSearch02") & "</b></td></tr>")
	Response.Write(SearchKeywordRow & getlang("langSearchKeyword") & "</td><td><input size=50 name=Keyword></td></tr>")
	If othercount>0 then
	   Response.Write(SearchKeywordRow & getlang("langEditSort") & "</td>" & "<td>")
           GenerateSelectV OtherCaptions,OtherTypes,strsearchsort,"strsearchsort",OtherCount,getlang("langCommonSelect") 
           Response.write "</td></tr>"
           Response.Write(SearchKeywordRow & "" & "</td>" & "<td>")
           GenerateSelectV Sortupdownnames,sortupdownvalues,strsearchsortupdown,"strsearchsortupdown",sortupdowncount,getlang("langCommonSelect") 
           Response.write "</td></tr>"
        end if
        Response.Write("</table><p>")
      If ySearchDisplayCategories="Yes" then
        Response.Write(SearchCatTable)
        Response.Write(SearchCatHeaderLeft  & getlang("langSearchCategory") & "</b></td>")
        If ySearchDisplaySubCat="Yes" then
          Response.Write(SearchCatHeaderRight & getlang("langSearchSubCategory") & "</b></td></tr>")
        else
           response.write "</tr>" 
        end if 
         Do While NOT RSCat.EOF
            if rscat("catdescription") <> "" then
                if isnull(rscat("cathide")) then
                  Response.write SearchCatRowStart
                  GenerateCategory
                  GenerateSubCategory
                  Response.write SearchCatRowEnd 
                end if  
            End If
            RSCat.MoveNext
        Loop 
        rscat.close
        set rscat=nothing
        Response.Write("</table><p>")
       end if
       shopbutton Getconfig("xbuttonsearch"),getlang("langCommonSearch"),"action"
       Response.write "<br><br>"
       shopbuttonreset getconfig("Xbuttonreset"),getlang("langCommonReset"),"action"
       Response.Write("</form>")
   
end sub
'
Sub GenerateCategory
%>
<td>
<center><input type=checkbox name="category" value="<%=rsCat("categoryid")%>"></center></td>
<%=SearchCatColumnStart%><%=RSCat("catdescription")%><%=SearchCatColumnEnd%>
<%
end sub
Sub GenerateSubCategory
If ySearchDisplaySubcat<>"Yes" then exit sub
dim subsql
if isnull(rscat("hassubcategory")) then
       Response.write SearchSubCatColumnStart & getlang("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") & "'"
    end if  
end if    
'handle category languages
subsql=Handle_selectsubcategoriesbylanguage(subsql)
subsql = subsql & " Order by " & getconfig("xsortcategories")
'debugwrite subsql
set rsSubcat=dbc.execute(subsql)
%>
   <select size="1" name="SubCategory">
    <option><%=getlang("langCommonAll")%></option>
<%
Do While NOT RSSubCat.EOF
   If RSSubCat("catdescription") <> "" Then
     if isnull(rssubcat("cathide")) then
       response.write "<option value=" & RsSubcat("categoryid") & ">" & RSSubCat("catdescription") & "</option>"
     end if   
   End If
   RSSubCat.MoveNext
   Loop 
   rsSubcat.close
   set rssubcat=nothing 
%>
 </select>&nbsp;<%=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
    responseredirect "shopdisplayproducts.asp?Search=Yes"

End if
end sub
' Generate SQL
'
Sub SearchGetFormData()
dim tempcount
Dim i
strCategory = Request("Category")
If instr(strcategory,";") then strcategory=""
If StrCategory="" then
     Catcount=0
else
     CatArray=split(strCategory,",")
     Catcount=ubound(CatArray)
     catcount=catcount+1
  end if
strSubCategory = Request("SubCategory")
If instr(strsubcategory,";") then strsubcategory=""
If strSubcategory="" then
   Subcatcount=0
else
     ParseRecord strSubcategory, subcatTempArray, tempcount, ","
     subcatcount=0
     for i = 0 to tempcount-1
         If SubCatTempArray(i) <> trim(getlang("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=getlang("langcommonselect") then
  xsearchsortfield=""
end if  
if xsearchsortupdown=getlang("langcommonselect") then
  xsearchsortupdown="ASC"
end if  
strKeyword = Request("Keyword")
If Instr(strkeyword,";") then 
   strkeyword=""
end if   
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_ADDR")
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)=getlang("langAscending")
Sortupdownnames(1)=getlang("langDescending")
Sortupdownvalues(0)="ASC"
Sortupdownvalues(1)="DESC"
SortUpDowncount=2
end sub

sub Handle_selectcategoriesbylanguage
If getconfig("xselectproductsbylanguage")="Yes" and getsess("language")<>"" then
     sql=sql & " and (catlanguage='" & getsess("language") & "'"
     sql=sql & " or catlanguage is null)"
end if    
end sub

function Handle_selectsubcategoriesbylanguage(tmpsql)
If getconfig("xselectproductsbylanguage")="Yes" and getsess("language")<>"" then
     tmpsql=tmpsql & " and (catlanguage='" & getsess("language") & "'"
     tmpsql=tmpsql & " or catlanguage is null)"
end if    
Handle_selectsubcategoriesbylanguage = tmpsql
end function

%>