"
response.write CatTable
end sub
' ***********Format Category
Sub FormatCategory (id, name)
if ucase(strcathide)="YES" then
exit sub
end if
if colcount=0 then
Response.write CatRow
end if
response.write CatColumn
if strSubcategory ="" then
response.write "" & name & ""
else
Response.write "" & name & "..."
If getconfig("Xcategoryproductsonly")="No" then
Response.write "
"
response.write "" & LangProductProduct & ""
Response.write " " & langSubcategories & ""
Response.write ""
end if
end if
If strCatImage<> "" then
AddImage id, Name
end if
Response.write CatColumnEnd
colcount=colcount+1
totalcolumncount=totalcolumncount+1
if colcount>= yCatMaxColumns 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 FillRemainingColumns
If totalcolumncount< ycatmaxcolumns then
response.write ""
exit sub
end if
Do While Colcount "
colcount=colcount+1
loop
response.write ""
end sub
'
Sub GenerateCategoryLinks
dim highercatid, cats(10),catids(10), i
dim cathead, more, catsql, rs
dim id,name
highercatid=highercategoryid
cathead=""
More=True
i=0
Do while more=True
catsql="select * from categories where categoryid=" & highercatid
Set rs=dbc.execute(catsql)
If not rs.eof then
highercatid=rs("highercategoryid")
name=rs("catdescription")
id=rs("categoryid")
mylink="" & name & ""
cats(i)=mylink
i=i+1
if highercatid=0 then
more=false
end if
else
more=false
end if
Closerecordset rs
loop
For i = 0 to i-1
If cathead="" Then
cathead = cats(i)
else
cathead= cats(i) & subcatseparator & cathead
end if
next
response.write subcatheader & cathead & subcatheaderend
end sub
'***********************************************************
' compatibility mode for previous VP-ASP Versions
'***********************************************************
Sub OldShopCategories
ycatmaxcolumns=clng(getconfig("xcatmaxcolumns"))
ShopPageHeader ' Page header for shop
OldCategoryHeader ' category header on this page
OldShowcategories ' format categories on this page
ShopPageTrailer ' shop page trailer
end sub
'
' Show Categories
Sub OldShowCategories()
Dim rs
dim lngcatid
dim strcategory
colcount=0
SQL="Select * from categories "
SQL=sql & " Where highercategoryid=0 order by " & Getconfig("xsortcategories")
OpenRecordSet dbc, rs, sql
While Not rs.EOF
lngcatid=rs("categoryid")
strcategory=rs("catdescription")
strsubcategory=rs("hassubcategory")
strcatimage=rs("catimage") ' image
strcathide=rs("cathide") ' hide field
if isnull(strcathide) then
strcathide="No"
else
strcathide="Yes"
end if
if isNull(strcatimage) then
strcatimage=""
end if
if isNULL(strsubcategory) then
strsubcategory=""
end if
If isnull(strcategory) then
strcathide="Yes"
end if
OldFormatCategory lngcatid, strcategory
rs.MoveNext
Wend
if colcount> 0 then
FillRemainingcolumns
end if
response.write "
"
CloseRecordSet rs
end sub
'*************************************
Sub OldCategoryHeader
' displays header for categories
%>
<%=catHeader%><%=LangCat01%>
<%
response.write "