to for SEO Bing
htmlwrite "" & GetLang("LangCat01") & "
"
end if
'6.50 - show category file/image if displaying sub-categories
if highercategoryid > "" then
ShowCategoryImage
end if
htmlwrite ""
end sub
'formats 1 category record
sub FormatCategory (id, name, rs)
'6.50.4 Bugs Fix - category hide issue
if strcathide <> "" or isnull(strcathide) = false then
exit sub
end if
if colcount = 0 then
htmlwrite ""
end if
htmlwrite ""
dim mylink
if trim(strSubcategory) = "" then
mylink = "" & name & ""
else
mylink = "" & name & ""
end if
genseocategoryproductlink_v9 mylink,id,name,name,rs,strSubcategory,"Yes"
if trim(strSubcategory) = "" then
htmlwrite mylink
else
htmlwrite mylink
if GetConfig("Xcategoryproductsonly") = "No" then
htmlwrite "
"
htmlwrite "" & GetLang("LangProductProduct") & ""
htmlwrite " " & GetLang("langSubcategories") & ""
end if
end if
if strCatImage<> "" then
dim returnstr
AddImage returnstr, id, name, rs
end if
if strcatmemo<>"" then
FormatCatMemo
end if
htmlwrite " "
colcount = colcount + 1
totalcolumncount = totalcolumncount + 1
if colcount>= yCatMaxColumns then
htmlwrite " "
colcount = 0
end if
end sub
'if category has image, format it
sub AddImage(returnstr, id, iname, rs)
dim linkname
linkname = Server.URLEncode(Iname)
'700 - SEO
dim mylink
dim tempname
tempname = Iname
if trim(strSubcategory) = "" then
mylink = "shopdisplayproducts.asp?id=" & id & "&cat=" & linkname
else
mylink = "shopdisplaycategories.asp?id=" & id & "&cat=" & linkname
end if
genseocategoryproductlink_v9 mylink,id,tempname,tempname,rs,"","No"
returnstr = "![]()
"
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 (header)
dim highercatid, cats(10), catids(10), i, mylink, categoryid
dim cathead, more, catsql, rs
dim id, name
'701 - 2011.05.18 - Bug Fix: Category name is displaying incorrectly as the title when seo dynamic activated
dim disname
cathead = ""
More = true
i = 0
highercatid = highercategoryid
do while more = true
catsql = "select "& session("get_categories_allstr") &" from categories where categoryid=" & highercatid
openrecordset_common rs
'700 - 2010.09.26 - Enhancement: Speed up front store performance
'701 - 2011.03.15 - Enhancement: Speed up store performance
'701 - 2012.02.16 - Enhancement: Better DB handling on display categories page
rs.open catsql, dbc, adOpenStatic, adLockReadOnly
if not rs.eof then
highercatid = rs("highercategoryid")
categoryid = rs("categoryid")
name = rs("catdescription")
id = rs("categoryid")
'800 - 2015.10.20 - Category: Category name should not have any HTML tag
name = CMSRemoveHTML(TranslateLanguage(dbc, "categories", "catdescription", "categoryid", categoryid, name))
'701 - 2011.05.18 - Bug Fix: Category name is displaying incorrectly as the title when seo dynamic activated
'701 - 2011.06.17 - Bug Fix: Category name is displaying incorrectly while having sub-categories
if cstr(highercategoryid) = cstr(categoryid) then disname = name
'701 - 2011.05.12 - Bug Fix: Higher category link breadcrumb is not formatted correctly if seo dynamic activated
mylink = "" & name & ""
genseocategoryproductlink_v9 mylink,rs("categoryid"),name,name,rs,"","Yes"
cats(i) = mylink
i = i + 1
if highercatid = 0 then
more = false
end if
else
more = false
end if
CloseRecordSet rs
loop
'6.09 - added home to breadcrumb
'800 - Enhanced SEO
mylink = "" & GetLang("langcommonhome") & " " & SubCatSeparator & "" & GetLang("LangCommonCategories") & ""
cats(i) = mylink
i = i + 1
for i = 0 to i -1
if cathead = "" then
cathead = cats(i)
else
cathead = cats(i) & subcatseparator & cathead
end if
next
header = cathead
SetSess "breadcrumb", cathead
'6.50 - added config option to turn breadcrumb on/off
if GetConfig("xbreadcrumbs") = "Yes" then
htmlwrite "" & header & ""
end if
'701 - 2011.05.18 - Bug Fix: Category name is displaying incorrectly as the title when seo dynamic activated
htmlwrite ""
'800 - 2015.05.10 - Bug Fix: Convert main pages from to for SEO Bing
htmlwrite "" & disname & "
"
'2019.09.04 - Bug Fix: Catmemo not shown when Subcategories set to yes
ShowCategoryImage_memo highercategoryid
end sub
'800 - 2015.05.17 - Better handling on routine handle_product
sub Handle_Product (isub, value, parseRS)
select case isub
case "FORMATIMAGE"
if strCatImage<> "" then
AddImage value, lngcatid, strcategory, parseRS
end if
case "FORMATHYPERLINKS"
GenerateCatLink value, lngcatid, strcategory, parseRS
case "ADDNUMBERSUBCATS"
Handle_NumberSubCats lngcatid, "", ""
'800 - 2015.-5.14 - Better handling if xgenerateshopexdlink set to No
case "FORMATEXDLINK_DIV"
formatexdlink_v8 value, parseRS, "div"
case "FORMATEXDLINK_SEARCH"
formatexdlink_v8 value, parseRS, "searchlink"
case "FORMATEXDLINK_MOBILE_DETAIL"
formatexdlink_v8 value, parseRS, "mobiledetail"
case "FORMATEXDLINK_SIDE_DESKTOP_DETAIL"
formatexdlink_v8 value, parseRS, "sidedesktopdetail"
case "FORMATEXDLINK_SIDE_MOBILE_DETAIL"
formatexdlink_v8 value, parseRS, "sidemobiledetail"
case "FORMATEXDLINK_FRONT_DESKTOP_SEARCH"
formatexdlink_v8 value, parseRS, "frontdesktopsearch"
case "FORMATEXDLINK_FRONT_MOBILE_SEARCH"
formatexdlink_v8 value, parseRS, "frontmobiletopsearch"
case "FORMATEXDLINK"
value = formatexdlink_v9(parseRS)
case else
messagewrite "Unknown sub"
end select
end sub
sub GenerateCatLink(returnstr, id, name, rs)
'2021.07.26 - Category listings: Better handling on identify parent category
dim strSubcategory
strSubcategory = rs("hassubcategory")
if isnull(strSubcategory) then strSubcategory = ""
dim mylink
if strSubcategory = "" then
mylink = "" & name & ""
'700 - SEO
genseocategoryproductlink_v9 mylink,id,name,name,rs,strSubcategory,"Yes"
returnstr = mylink
else
mylink = "" & name & ""
'700 - SEO
genseocategoryproductlink_v9 mylink,id,name,name,rs,strSubcategory,"Yes"
returnstr = mylink
if GetConfig("Xcategoryproductsonly") = "No" then
returnstr = returnstr & "
"
genseocategoryproductlink_v9 mylink,id,name,GetLang("LangProductProduct"),rs,strSubcategory,"Yes"
returnstr = returnstr & mylink
genseocategoryproductlink_v9 mylink,id,name,GetLang("langSubcategories"),rs,strSubcategory,"Yes"
returnstr = returnstr & mylink
end if
end if
end sub
sub FormatCatMemo
if GetConfig("xcategorydisplaytext") = "Yes" then
if strcatmemo<>"" then
htmlwrite "
" & strcatmemo & "
"
end if
end if
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
'6.5 - show category image or file at the top of subcat display
sub ShowCategoryImage
dim ImageFileName, description, i
dim rs
dim query
imagefilename = ""
if highercategoryid = "" then exit sub
'2022.05.24 - SEO: Category listings: Alt should be assigned to image object
dim catdescription
if GetConfig("xDisplayCategoryImages") = "Yes" or GetConfig("xdisplaycategoryfiles") = "Yes" then
'2022.05.24 - SEO: Category listings: Alt should be assigned to image object
query = "select catimage,catextra,catdescription from categories where categoryid = " & highercategoryid
openrecordset_common rs
'700 - 2010.09.26 - Enhancement: Speed up front store performance
'701 - 2011.03.15 - Enhancement: Speed up store performance
'701 - 2012.02.16 - Enhancement: Better DB handling on display categories page
rs.open query, dbc, adOpenStatic, adLockReadOnly
if not rs.eof then
imagefilename = rs("catimage")
description = rs("catextra")
if isnull(imagefilename) then
imagefilename = ""
end if
if isnull(description) then
description = ""
end if
'2022.05.24 - SEO: Category listings: Alt should be assigned to image object
catdescription = rs("catdescription")
if isnull(catdescription) then
catdescription = ""
end if
end if
CloseRecordSet rs
else
exit sub
end if
if GetConfig("xDisplayCategoryImages") = "Yes" and imagefilename<>"" then
'2022.05.24 - SEO: Category listings: Alt should be assigned to image object
htmlwrite "![]()
"
end if
'2022.07.06 - Bug Fix: Category listings: CatExtra show twice on parent category page
exit sub
if GetConfig("xdisplaycategoryfiles") = "Yes" and description <>"" then
dim readarray(500), readcount
readcount = 0
ShopReadFile description, ReadArray, readcount
if readcount = 0 then exit sub
htmlwrite "
"
for i = 0 to readcount -1
htmlwrite readarray(i) & vbcrlf
next
end if
end sub
%>
" & GetLang("LangCat01") & "
"
end sub
'formats 1 category record
sub FormatCategory (id, name, rs)
'6.50.4 Bugs Fix - category hide issue
if strcathide <> "" or isnull(strcathide) = false then
exit sub
end if
if colcount = 0 then
htmlwrite ""
end if
htmlwrite ""
dim mylink
if trim(strSubcategory) = "" then
mylink = "" & name & ""
else
mylink = "" & name & ""
end if
genseocategoryproductlink_v9 mylink,id,name,name,rs,strSubcategory,"Yes"
if trim(strSubcategory) = "" then
htmlwrite mylink
else
htmlwrite mylink
if GetConfig("Xcategoryproductsonly") = "No" then
htmlwrite "
" htmlwrite "" & GetLang("LangProductProduct") & "" htmlwrite " " & GetLang("langSubcategories") & "" end if end if if strCatImage<> "" then dim returnstr AddImage returnstr, id, name, rs end if if strcatmemo<>"" then FormatCatMemo end if htmlwrite " "
colcount = colcount + 1
totalcolumncount = totalcolumncount + 1
if colcount>= yCatMaxColumns then
htmlwrite " "
colcount = 0
end if
end sub
'if category has image, format it
sub AddImage(returnstr, id, iname, rs)
dim linkname
linkname = Server.URLEncode(Iname)
'700 - SEO
dim mylink
dim tempname
tempname = Iname
if trim(strSubcategory) = "" then
mylink = "shopdisplayproducts.asp?id=" & id & "&cat=" & linkname
else
mylink = "shopdisplaycategories.asp?id=" & id & "&cat=" & linkname
end if
genseocategoryproductlink_v9 mylink,id,tempname,tempname,rs,"","No"
returnstr = "![]()
"
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 (header)
dim highercatid, cats(10), catids(10), i, mylink, categoryid
dim cathead, more, catsql, rs
dim id, name
'701 - 2011.05.18 - Bug Fix: Category name is displaying incorrectly as the title when seo dynamic activated
dim disname
cathead = ""
More = true
i = 0
highercatid = highercategoryid
do while more = true
catsql = "select "& session("get_categories_allstr") &" from categories where categoryid=" & highercatid
openrecordset_common rs
'700 - 2010.09.26 - Enhancement: Speed up front store performance
'701 - 2011.03.15 - Enhancement: Speed up store performance
'701 - 2012.02.16 - Enhancement: Better DB handling on display categories page
rs.open catsql, dbc, adOpenStatic, adLockReadOnly
if not rs.eof then
highercatid = rs("highercategoryid")
categoryid = rs("categoryid")
name = rs("catdescription")
id = rs("categoryid")
'800 - 2015.10.20 - Category: Category name should not have any HTML tag
name = CMSRemoveHTML(TranslateLanguage(dbc, "categories", "catdescription", "categoryid", categoryid, name))
'701 - 2011.05.18 - Bug Fix: Category name is displaying incorrectly as the title when seo dynamic activated
'701 - 2011.06.17 - Bug Fix: Category name is displaying incorrectly while having sub-categories
if cstr(highercategoryid) = cstr(categoryid) then disname = name
'701 - 2011.05.12 - Bug Fix: Higher category link breadcrumb is not formatted correctly if seo dynamic activated
mylink = "" & name & ""
genseocategoryproductlink_v9 mylink,rs("categoryid"),name,name,rs,"","Yes"
cats(i) = mylink
i = i + 1
if highercatid = 0 then
more = false
end if
else
more = false
end if
CloseRecordSet rs
loop
'6.09 - added home to breadcrumb
'800 - Enhanced SEO
mylink = "" & GetLang("langcommonhome") & " " & SubCatSeparator & "" & GetLang("LangCommonCategories") & ""
cats(i) = mylink
i = i + 1
for i = 0 to i -1
if cathead = "" then
cathead = cats(i)
else
cathead = cats(i) & subcatseparator & cathead
end if
next
header = cathead
SetSess "breadcrumb", cathead
'6.50 - added config option to turn breadcrumb on/off
if GetConfig("xbreadcrumbs") = "Yes" then
htmlwrite "
" htmlwrite "" & GetLang("LangProductProduct") & "" htmlwrite " " & GetLang("langSubcategories") & "" end if end if if strCatImage<> "" then dim returnstr AddImage returnstr, id, name, rs end if if strcatmemo<>"" then FormatCatMemo end if htmlwrite "
" & header & "
"
end if
'701 - 2011.05.18 - Bug Fix: Category name is displaying incorrectly as the title when seo dynamic activated
htmlwrite ""
'800 - 2015.05.10 - Bug Fix: Convert main pages from to
" for i = 0 to readcount -1 htmlwrite readarray(i) & vbcrlf next end if end sub %>
to for SEO Bing
htmlwrite "" & disname & "
"
'2019.09.04 - Bug Fix: Catmemo not shown when Subcategories set to yes
ShowCategoryImage_memo highercategoryid
end sub
'800 - 2015.05.17 - Better handling on routine handle_product
sub Handle_Product (isub, value, parseRS)
select case isub
case "FORMATIMAGE"
if strCatImage<> "" then
AddImage value, lngcatid, strcategory, parseRS
end if
case "FORMATHYPERLINKS"
GenerateCatLink value, lngcatid, strcategory, parseRS
case "ADDNUMBERSUBCATS"
Handle_NumberSubCats lngcatid, "", ""
'800 - 2015.-5.14 - Better handling if xgenerateshopexdlink set to No
case "FORMATEXDLINK_DIV"
formatexdlink_v8 value, parseRS, "div"
case "FORMATEXDLINK_SEARCH"
formatexdlink_v8 value, parseRS, "searchlink"
case "FORMATEXDLINK_MOBILE_DETAIL"
formatexdlink_v8 value, parseRS, "mobiledetail"
case "FORMATEXDLINK_SIDE_DESKTOP_DETAIL"
formatexdlink_v8 value, parseRS, "sidedesktopdetail"
case "FORMATEXDLINK_SIDE_MOBILE_DETAIL"
formatexdlink_v8 value, parseRS, "sidemobiledetail"
case "FORMATEXDLINK_FRONT_DESKTOP_SEARCH"
formatexdlink_v8 value, parseRS, "frontdesktopsearch"
case "FORMATEXDLINK_FRONT_MOBILE_SEARCH"
formatexdlink_v8 value, parseRS, "frontmobiletopsearch"
case "FORMATEXDLINK"
value = formatexdlink_v9(parseRS)
case else
messagewrite "Unknown sub"
end select
end sub
sub GenerateCatLink(returnstr, id, name, rs)
'2021.07.26 - Category listings: Better handling on identify parent category
dim strSubcategory
strSubcategory = rs("hassubcategory")
if isnull(strSubcategory) then strSubcategory = ""
dim mylink
if strSubcategory = "" then
mylink = "" & name & ""
'700 - SEO
genseocategoryproductlink_v9 mylink,id,name,name,rs,strSubcategory,"Yes"
returnstr = mylink
else
mylink = "" & name & ""
'700 - SEO
genseocategoryproductlink_v9 mylink,id,name,name,rs,strSubcategory,"Yes"
returnstr = mylink
if GetConfig("Xcategoryproductsonly") = "No" then
returnstr = returnstr & "
"
genseocategoryproductlink_v9 mylink,id,name,GetLang("LangProductProduct"),rs,strSubcategory,"Yes"
returnstr = returnstr & mylink
genseocategoryproductlink_v9 mylink,id,name,GetLang("langSubcategories"),rs,strSubcategory,"Yes"
returnstr = returnstr & mylink
end if
end if
end sub
sub FormatCatMemo
if GetConfig("xcategorydisplaytext") = "Yes" then
if strcatmemo<>"" then
htmlwrite "
" & disname & "
" genseocategoryproductlink_v9 mylink,id,name,GetLang("LangProductProduct"),rs,strSubcategory,"Yes" returnstr = returnstr & mylink genseocategoryproductlink_v9 mylink,id,name,GetLang("langSubcategories"),rs,strSubcategory,"Yes" returnstr = returnstr & mylink end if end if end sub sub FormatCatMemo if GetConfig("xcategorydisplaytext") = "Yes" then if strcatmemo<>"" then htmlwrite "
" & strcatmemo & "
" end if end if 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 '6.5 - show category image or file at the top of subcat display sub ShowCategoryImage dim ImageFileName, description, i dim rs dim query imagefilename = "" if highercategoryid = "" then exit sub '2022.05.24 - SEO: Category listings: Alt should be assigned to image object dim catdescription if GetConfig("xDisplayCategoryImages") = "Yes" or GetConfig("xdisplaycategoryfiles") = "Yes" then '2022.05.24 - SEO: Category listings: Alt should be assigned to image object query = "select catimage,catextra,catdescription from categories where categoryid = " & highercategoryid openrecordset_common rs '700 - 2010.09.26 - Enhancement: Speed up front store performance '701 - 2011.03.15 - Enhancement: Speed up store performance '701 - 2012.02.16 - Enhancement: Better DB handling on display categories page rs.open query, dbc, adOpenStatic, adLockReadOnly if not rs.eof then imagefilename = rs("catimage") description = rs("catextra") if isnull(imagefilename) then imagefilename = "" end if if isnull(description) then description = "" end if '2022.05.24 - SEO: Category listings: Alt should be assigned to image object catdescription = rs("catdescription") if isnull(catdescription) then catdescription = "" end if end if CloseRecordSet rs else exit sub end if if GetConfig("xDisplayCategoryImages") = "Yes" and imagefilename<>"" then '2022.05.24 - SEO: Category listings: Alt should be assigned to image object htmlwrite "" for i = 0 to readcount -1 htmlwrite readarray(i) & vbcrlf next end if end sub %>