<%Option Explicit%>
<%
const MaxSubLevels=3
Dim subcatlevels, subcatcount, levelnum
dim subcatother
dim levelnames, hsubcat
Dim Mylink
dim colcount
dim producturl, subcaturl
'******************************************************************
' Display Subcategories for a category
' Supports sub sub categories
' ' page=x ' used when recusrsively called to display next page
' search=yes ' used when someone else created sql such as search.asp
' ' then sql in session variable SQL
' Version 3.0
' in products tables
' id= category id
' subcat= subcategoryid
' level= current level
' cat= higher category name
' hsubcat higher level subcateory number
' If level="" then table subcategories
' if level=3 then table = subcatelevel3
' l2=xxx,l3=xxx,l4=xxx
'***********************************************************************
Dim rs
Dim subcatid, subcatname, subcatlevel, subcatimage
dim sucatother, subcathassubcaytegory, hassubcategory, subcategoryof
dim levels(10)
Dim dbc
Dim Catid, Cat, level
Dim strimage
GetInput ' get input values
CreateSQl ' generate sql to get subcategory names
ShopPageHeader
colcount=0
DisplayCategoryHeader
ShopOpenDatabase dbc
'debugwrite sql
Set rs = Server.CreateObject ("ADODB.Recordset")
rs.Open sql, dbc, adOpenForwardOnly,adLockReadOnly,adcmdtext
While Not rs.EOF
getsubcatfield "subcategoryid", subcatid
getsubcatfield "subcategory", subcatname
getsubcatfield "subcatimage", subcatimage
getsubcatfield "hassubcategory", hassubcategory
getsubcatfield "subcatother", subcatother
FormatSubCategory
rs.MoveNext
Wend
if colcount> 0 then
FillRemainingcolumns
end if
response.write ""
rs.Close
set rs=nothing
ShopCloseDatabase dbc
ShopPageTrailer
Sub GetSubCatField (fieldname,fieldvalue)
fieldvalue=rs(fieldname)
if isnull(fieldvalue) then
fieldvalue=""
end if
end sub
' Process first time
Sub CreateSQL()
dim dbtable
If level=2 then
dbtable="subcategories"
Sql = "select * from subcategories WHERE categoryid=" & catid
Sql = sql & " Order by " & xSortSubcategories
exit sub
end if
dbtable="subcatlevel" & level
Sql = "select * from " & dbtable & " WHERE highersubcategoryid=" & Hsubcat
Sql = sql & " Order by " & xSortSubcategories
'debugwrite sql
end sub
'
Sub GetInput
dim i
catid = Request("id")
if catid<>"" then
catid=cint(catid)
end if
cat= Request("cat")
if catid="" then
catid=Getsess("catid")
cat=getsess("cat")
end if
level=request("level")
subcat=request("subcat")
hsubcat=request("Hsubcat")
if level="" then level=2 ' subcategory is level 2
levelnames=GetSessA("Levelnames")
if not isarray(levelnames) then
redim levelnames(maxsublevels+1)
end if
For i = 2 to MaxSublevels+1
Levelnames(i)=request("L" & i)
next
SetsessA "levelnames",levelnames
Setsess "catid",catid
setsess "cat",cat
end sub
'
' ***********Format Category
Sub FormatSubCategory
dim name
name=subcatname
if colcount=0 then
Response.write SubCatRow
end if
If level=5 then
hassubcategory="" ' avoid customer mistake
end if
GenerateProductUrl Producturl
response.write SubCatColumn
if HasSubcategory="" then
response.write "" & name & ""
else
GenerateSubcatURL SubcatURL
Response.write "" & subcatname & "..."
Response.write "
"
response.write "" & LangProductProduct & ""
Response.write " " & langSubcategories & ""
end if
If SubcatImage<> "" then
AddImage catid, Name
end if
Response.write CatColumnEnd
colcount=colcount+1
if colcount>= SubCatMaxColumns then
response.write ""
colcount=0
end if
end sub
Sub AddImage(id, iname)
dim mylink
dim linkname
linkname=Server.URLEncode(Iname)
if strSubcategory ="" then
%>
<%
else
%>
<%
end if
end sub
Sub DisplayCategoryHeader
' displays header for categories
dim cathead, i
cathead=""
cathead = cat
For i = 2 to level-1
if levelnames(i)<>"" then
cathead = cathead & subcatseparator & Levelnames(i)
end if
next
response.write subcatheader & cathead & subcatheaderend
Response.write "
"
Response.write SubCatTable
end sub
'
Sub FillRemainingColumns
Do While Colcount "
colcount=colcount+1
loop
response.write ""
end sub
'
Sub GenerateProductURL (producturl)
dim fieldname, fieldvalue
dim fieldurl
fieldurl=""
ProductUrl="id=" & catid
if level>2 then
producturl=producturl & "&subcat=" & subcat & "&cat=" & Server.URLEncode(subcatname)
AddPreviousLevels producturl
else
producturl=producturl & "&subcat=" & subcatid & "&cat=" & Server.URLEncode(subcatname)
end if
end sub
Sub GenerateSubCatURL (subcatURL)
dim levelnum
SubcatUrl="id=" & catid & "&cat=" & Server.URLEncode(cat)
SubcatUrl=subcaturl& "&Hsubcat=" & subcatid
levelnum=level+1
Subcaturl= subcaturl & "&level=" & levelnum
if level=2 then
subcaturl=subcaturl & "&subcat=" & subcatid
else
subcaturl=subcaturl & "&subcat=" & subcat
end if
AddPreviousLevels SubCaturl
end sub
Sub AddPreviousLevels(url)
dim i
If level=2 then
url= url & "&L2=" & Server.URLEncode(subcatname)
exit sub
end if
If level=3 then
url= url & "&L2=" & Server.URLEncode(levelnames(2))
url= url & "&L3=" & Server.URLEncode(subcatname)
exit sub
end if
If level=4 then
url= url & "&L2=" & Server.URLEncode(levelnames(2))
url= url & "&L3=" & Server.URLEncode(levelnames(3))
url= url & "&L4=" & Server.URLEncode(subcatname)
exit sub
end if
If level=5 then
url= url & "&L2=" & Server.URLEncode(levelnames(2))
url= url & "&L3=" & Server.URLEncode(levelnames(3))
url= url & "&L4=" & Server.URLEncode(levelnames(4))
url= url & "&L5=" & Server.URLEncode(subcatname)
exit sub
end if
end sub
%>