::BUY::

" colcount=0 end if End Sub '************************************* Sub CategoryHeader ' displays header for categories If highercategoryid<>0 then Generatecategorylinks else response.write catHeader & LangCat01 & "

" end if response.write "" 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 If strcatmemo<>"" then FormatCatmemo 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" 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 "

<%option explicit%> <% '**************************************************************** ' VP-ASP Display shop categories ' displays a list of categories from Shopping Database ' Version 4.50 May 5, 2002 ' Support images for each category and multiple columns per listing ' Now allows product displays or subcategory displays ' Sub hide for categories ' add template handling '**************************************************************** ' dim colcount, ycatmaxcolumns, totalcolumncount Dim strcatImage dim lngcatid 'dim strcategory dim strcathide Dim Mylink, dbc dim highercategoryid dim strcatmemo, strcatextra ShopOpenDatabase dbc CheckDatabaseOpen dbc ycatmaxcolumns=clng(getconfig("xcatmaxcolumns")) ' If getconfig("xoldcategorymode")="Yes" then OldShopCategories else ShopCategories end if ShopCloseDatabase dbc ' Sub ShopCategories highercategoryid=request("id") if highercategoryid="" then highercategoryid=0 end if ShopPageHeader ' Page header for shop CategoryHeader ' category header on this page Showcategories ' format categories on this page ShopPageTrailer ' shop page trailer end sub ' ' Show Categories Sub ShowCategories() Dim rs colcount=0 totalcolumncount=0 SQL="Select * from categories " sql = Sql & " where highercategoryid=" & highercategoryid 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 sql=sql & " order by " & Getconfig("xsortcategories") OpenRecordSet dbc, rs, sql While Not rs.EOF strcatmemo=rs("catmemo") strcatextra=rs("catextra") lngcatid=rs("categoryid") strcategory=rs("catdescription") strsubcategory=rs("hassubcategory") strcatimage=rs("catimage") ' image strcathide=rs("cathide") ' hide field if isnull(strcathide) then strcathide="No" end if if isNull(strcatimage) then strcatimage="" end if if isNULL(strsubcategory) then strsubcategory="" end if If isnull(strcategory) then strcathide="Yes" end if If isnull(strcatextra) then strcatextra="" end if If isnull(strcatmemo) then strcatmemo="" end if If getconfig("xcategoryusetemplate")= "Yes" then FormatCategoryTemplate lngcatid, strcategory,rs else FormatCategory lngcatid, strcategory End if rs.MoveNext Wend if colcount> 0 then FillRemainingcolumns end if response.write "

" CloseRecordSet rs end sub '************************************* Sub FormatCategoryTemplate(lngcatid, strcategory, objrs) dim template, rc template=getconfig("xcategorydisplaytemplate") If Template="" then Serror=LangExdNoTemplate shoperror serror end if if ucase(strcathide)="YES" then exit sub end if if colcount=0 then Response.write CatRow end if response.write CatColumn ShopTemplateWrite template, objRs, rc Response.write CatColumnEnd colcount=colcount+1 totalcolumncount=totalcolumncount+1 if colcount>= yCatMaxColumns then response.write "

" CloseRecordSet rs end sub '************************************* Sub OldCategoryHeader ' displays header for categories %> <%=catHeader%><%=LangCat01%>

<% response.write "" response.write CatTable end sub ' ***********Format Category Sub OldFormatCategory (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 & "..." Response.write "
" response.write "" & LangProductProduct & "" Response.write " " & langSubcategories & "" Response.write "" end if If strCatImage<> "" then OldAddImage id, Name end if Response.write CatColumnEnd colcount=colcount+1 if colcount>= yCatMaxColumns then response.write "