<%
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
'*****************************************************
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 & " 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 

%>