<% '******************************************************************************** ' Also bought attempts to display a set of products ' That other people have purchased when they purchased this product ' VP-ASP 6.50 ' Nov 12, 2005 Does not work with MYSQL, currently bypassed '******************************************************************************* Sub DisplayAlsoBought dim i, cartcount, cartarray, productid, productarray, productarraycount, rc redim productarray(100) cartcount = getsess("CartCount") ' number of products cartarray = getsessa("CartArray") 'For i = 1 to scartItem For i = 1 to 1 productid=arrCart(cProductid,i) mininame=arrCart(cProductMiniName,i) If mininame="" then mininame=arrCart(cProductName,i) end if AlsoBoughtExcludecatalogids productid, rc If rc= 0 then Checkalsoboughtduplicate productid, productarray, productarraycount, rc if rc= 0 then FormatAlsoBought productid, mininame end if end if next end sub '*************************************************************************** ' first exclude projects and gift certificates Sub FormatAlsoBought (productid, mininame) dim catalogid, dbc, productlist, headercaption, strsql, lngcstock, rc dim displaylimit ' Get a list of catalogids Getalsoboughtproducts productid, productlist 'VP-ASP 6.50 - move open database call above new sub shopopendatabaseP dbc 'VP-ASP 6.50 - show parent product instead of child product ParentaliseProductList productlist, productid,dbc if productlist="" then shopclosedatabase dbc exit sub end if 'VP-ASP 6.50 - open database call has been moved above new sub 'shopopendatabaseP dbc 'headercaption="
" & mininame &"
" & getlang("langalsoboughtmessage") headercaption="
" & getlang("langalsoboughtmessage") strsql="select * from products where catalogid in (" & productlist & ")" strsql=strsql & " and hide=0" 'VP-ASP 6.50 - show parent product instead of child product strsql=strsql & " and NOT catalogid = " & productid 'VP-ASP 6.50 - removed following line 'strsql=strsql & " AND (highercatalogid is null)" if getconfig("xstocklow")<>"" then lngcstock= clng(getconfig("xstocklow")) strsql = strsql & " and cstock> " & lngcstock end if 'VP-ASP 6.09 - only show product matching products if getconfig("xproductmatch")="Yes" then strsql=strsql & " and (productmatch='" & xproductmatch & "'" strsql=strsql & " or productmatch is null)" end if 'VP-ASP 6.09 - only show customer matching products if getconfig("xproductmatchcustomer")="Yes" then if GetSess("CustomerProductGroup")<>"" then strsql=strsql & " and (customermatch like '%" & getsess("customerProductgroup") & "%'" strsql=strsql & " or customermatch is null)" else strsql=strsql & " and customermatch is null" end if end if 'debugwrite strsql displaylimit=getconfig("xalsoboughtlimit") FormatassociatedProducts dbc, strsql, headercaption, displaylimit shopclosedatabase dbc end sub '************************************************************************* ' look at all orders in last few months ' find all orders with this catalogid ' Then find the top other products ' creatae a list in form 77,33,6 '************************************************************************ Sub Getalsoboughtproducts (incatalogid, productlist) dim orderdbc, orderlist, ordermax, count, productmax, catalogid dim orderdate, sql, rc, rs, orderid, months orderlist="" productlist="" months=getconfig("xalsoboughtmonths") if months="" then months=12 orderdate =dateadd("m",-months,date()) count=0 ordermax=20 productmax=20 ' bypass if mysql which cannot handle sql HK ' xxx openorderdb orderdbc sql="SELECT oitems.catalogid, orders.orderid FROM orders " sql=sql & " INNER JOIN oitems ON orders.orderid = oitems.orderid " sql=sql & " WHERE (orders.odate>=" & datedelimit(orderdate) 'VP-ASP 6.50 - show parent product instead of child product dim ishighersql, ishigherrs ishighersql = "select hassubproduct from products where catalogid = " & incatalogid set ishigherrs=orderdbc.execute(ishighersql) if not ishigherrs.eof then if ishigherrs("hassubproduct") = "Yes" then sql=sql & " AND oitems.catalogid IN (select catalogid from products WHERE highercatalogid = " & incatalogid & "))" else sql=sql & " AND oitems.catalogid=" & incatalogid & ")" end if else sql=sql & " AND oitems.catalogid=" & incatalogid & ")" end if closerecordset ishigherrs 'debugwrite sql set rs=orderdbc.execute(sql) do while not rs.eof and count< ordermax orderid=rs("orderid") if orderlist<>"" then orderlist=orderlist & "," end if orderlist=orderlist & orderid count=count+1 rs.movenext loop closerecordset rs If orderlist="" then shopclosedatabase orderdbc exit sub end if count=0 ' Now we know last 20 orders with this product ' get the other products sorted by quantity 'To getother catalogids '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 sql="SELECT Sum(oitems.numitems) AS SumOfnumitems, oitems.catalogid " sql=sql & " FROM orders INNER JOIN oitems ON orders.orderid = oitems.orderid " sql=sql & " WHERE (((orders.orderid in (" & orderlist & "))))" sql=sql & " GROUP BY oitems.catalogid " sql=sql & " HAVING (((oitems.catalogid)<>" & incatalogid & "))" sql=sql & " ORDER BY SumOfnumitems DESC" else sql="SELECT Sum(oitems.numitems) AS SumOfnumitems, oitems.catalogid " sql=sql & " FROM orders INNER JOIN oitems ON orders.orderid = oitems.orderid " sql=sql & " WHERE (((orders.orderid in (" & orderlist & "))))" sql=sql & " GROUP BY oitems.catalogid " sql=sql & " HAVING (((oitems.catalogid)<>" & incatalogid & "))" sql=sql & " ORDER BY Sum(oitems.numitems) DESC" end if 'debugwrite sql set rs=orderdbc.execute(sql) do while not rs.eof and count < productmax catalogid=rs("catalogid") AlsoBoughtExcludecatalogids catalogid, rc If rc=0 then 'VP-ASP 6.50.1 - moved this call down a bit 'if productlist<>"" then ' productlist=productlist & "," 'end if 'VP-ASP 6.50 - show parent product instead of child product dim subsql, subrs subsql = "select highercatalogid from products where catalogid = " & rs("catalogid") set subrs=orderdbc.execute(subsql) if not subrs.eof Then 'VP-ASP 6.50.1 - moved this call to here if productlist<>"" then productlist=productlist & "," end if if subrs("highercatalogid") > "" Then productlist=productlist & subrs("highercatalogid") else productlist=productlist & catalogid end if else end if count=count+1 end if rs.movenext loop closerecordset rs shopclosedatabase orderdbc 'debugwrite "productlist=" & productlist end sub ' ' Exclude projects and gift certificates sub AlsoBoughtExcludecatalogids (catalogid, rc) rc=4 if not isnumeric(catalogid) then exit sub catalogid=clng(catalogid) ' Exclude Products if catalogid=clng(getconfig("xprojectcatalogid")) then exit sub if catalogid=clng(getconfig("xgiftproductid")) then exit sub rc=0 end sub '************************************************************************* 'if product has already been displayed, dont do it again '************************************************************************* Sub Checkalsoboughtduplicate (productid, productarray, productarraycount, rc) if productarraycount>0 then for i = 0 to productarraycount-1 if productid=productarray(i) then rc=4 exit sub end if next end if productarray(productarraycount)=productid productarraycount=productarraycount+1 rc=0 end sub 'VP-ASP 6.50 - show parent product instead of child product Sub ParentaliseProductList (productlist,productid,dbc) if len(productlist) = 0 or isnull(productlist) then exit sub end if dim tempproductlist, pi, pisql, pirs if instr(productlist, ",") > 0 then tempproductlist = split(productlist, ",") else redim tempproductlist(0) tempproductlist(0) = productlist end if for pi = 0 to ubound(tempproductlist) pisql = "select highercatalogid from products where catalogid = " & tempproductlist(pi) set pirs=dbc.execute(pisql) if not pirs.eof then if pirs("highercatalogid") > "" then if pirs("highercatalogid") <> productid then tempproductlist(pi) = pirs("highercatalogid") end if end if end if next closerecordset pirs productlist = join(tempproductlist,",") end sub %>