<% ' VP-ASP 4.50a const Hyperlinkfont="" '************************************************ ' Shop subroutines VP-ASP 4.50a ' Jan 31, 2002 Fix problem when logorequired ' Sept 24, 2002 fix dual currency display ' VP-ASP 4.50a add hyperlink font for categories '************************************************* Sub SetupProductFieldsXXX (ProdFields, ProdHeaders) dim tempfields,swords(20),swordscount,i tempfields=getconfig("xproductfields") parserecord tempfields,swords,swordscount,"," redim prodFields(swordscount-1) for i = 0 to swordscount-1 prodfields(i)=swords(i) next end sub ' Sub SetupSearchFields (SearchFields) dim tempfields,swords(20),swordscount,i tempfields=getconfig("xsearchfields") parserecord tempfields,swords,swordscount,"," redim SearchFields(swordscount-1) for i = 0 to swordscount-1 searchfields(i)=swords(i) next end sub ' ' Shopcartformat Formats field in cart Sub GetNameInCart (Rsitem) dim tempfields,cartfields(20),fieldcount,i, fieldvalue tempfields=getconfig("xcartfields") parserecord tempfields,cartfields,fieldcount,"," nameincart="" for i = 0 to fieldcount-1 If cartfields(i)="cdescription" then fieldvalue= memCDescription else fieldvalue=rsitem(cartfields(i)) end if if not isnull(fieldvalue) then if nameincart<>"" then nameincart=nameincart & "
" end if nameincart=nameincart & fieldvalue end if next end sub Function GetMailCR 'GetMailCR= Chr(13) GetMailCR= Chr(13) & chr(10) end function ' Sub CreateCustRow (caption, fieldname, fieldvalue, required) Dim aster If required="Yes" then aster="* " else aster=" " end if Response.write tablerow & tablecolumn Response.write aster & Caption & TablecolumnEnd Response.write tablecolumn %> <% Response.write tablecolumnend & tableRowend end sub ' Sub CreateCustRowP (caption, fieldname, fieldvalue, required) Dim aster If required="Yes" then aster="* " else aster=" " end if Response.write tablerow & tablecolumn Response.write aster & Caption & TablecolumnEnd Response.write tablecolumn %> <% Response.write tablecolumnend & tableRowend end sub Sub FormatEditRow (caption,fieldname,fieldvalue) dim capdisplay capdisplay=caption if capdisplay="" then capdisplay=fieldname end if Response.Write TableRow Response.write TableColumn & capdisplay & TableColumnEnd Response.write TableColumn & "" Response.write tableColumnEnd Response.write TableRowEnd end sub ' Sub NavigateShowCategories() If getconfig("Xnavigatecategories")="No" then exit sub If getconfig("xlogonrequired")="Yes" then If getsess("login")="" then exit sub end if end if dim cid, name,catSQL,i dim strcategory, catcount, categories,maxcategories Dim catdbc,catrs, hassubcategory,mylink catcount=getsess("catcount") If catcount="" then catcount=0 If catcount=0 then catcount=0 maxcategories=getconfig("xmaxcategories") redim categories(maxcategories) ShopOpenDatabase catdbc catSQL="Select * from categories where highercategoryid=0 and cathide is null order by catdescription" set catrs=catdbc.execute(catsql) While Not catrs.EOF and catcount" & hyperlinkfont & name & "" else mylink="" & hyperlinkfont & name & "..." end if categories(catcount)=mylink catcount=catcount+1 catrs.MoveNext Wend setsess "categories",categories setsess "catcount",catcount catrs.Close set catrs=nothing ShopCloseDatabase catdbc end if ' catcount=getsess("catcount") categories=getsess("categories") response.write NavCatTable for i = 0 to catcount-1 mylink=categories(i) response.write NavCatRow & NavCatColumn response.write mylink response.write NavCatColumnend next response.write "" exit sub end sub ' MiniCart Sub NavigateShowMiniCart (itype) ' VP-ASP 4.00 dim showtype showtype=ucase(itype) Dim scartItem, arrCart, displayprice dim dualtotal, dualsubtotal, dualprice dim totalquantity, totalproductquantity Dim i, CartFields, total, subtotal, name, quantity, price scartItem = GetSess("CartCount") arrCart = GetSessA("CartArray") If scartitem="" then exit sub if scartitem=0 then exit sub If getconfig("Xnavigateminicart")="No" then exit sub response.write "

" Response.write Minitable If showtype<>"SHORT" Then response.write MiniTitleRow response.write MiniNameTitleColumn & minititlefont & LangProductDescription & "" & Minifontend response.write MiniPriceColumn & minititlefont & LangProductQuantity & "" & Minifontend If getconfig("xdisplayprices")="Yes" then response.write MiniPriceColumn & minititlefont & LangProductPrice & "" & Minifontend response.write MiniPriceColumn & minititlefont & LangProductTotal & "" & Minifontend If getconfig("xdualprice")="Yes" then response.write MiniPriceColumn & minititlefont & LangDualPrice & "" & Minifontend response.write MiniPriceColumn & minititlefont & LangDualTotal & "" & Minifontend end if end if end if Response.write "" if getconfig("xLCID")<>"" then Session.LCID=getconfig("xLCID") ' set user supplied LCID end if total = 0 totalquantity=scartitem totalproductquantity=0 For i = 1 to scartItem Quantity =arrCart(cQuantity,i) Price=arrCart(cUnitPrice,i) dualprice=arrCart(cdualPrice,i) Name=arrCart(cProductName,i) If len(name)>100 then name=mid(name,1,100) end if subtotal=quantity*price dualsubtotal=quantity*dualprice Total=total+subtotal dualtotal=dualtotal+dualsubtotal totalproductquantity=totalproductquantity+quantity If showtype<>"SHORT" Then Price=shopformatcurrency(price,getconfig("xdecimalpoint")) response.write minirow Response.write MiniNameColumn & Minifont & name & minicolumnend Response.write MiniPricecolumn & MiniFont & quantity & minicolumnend If getconfig("xdisplayprices")="Yes" then Response.write MiniPriceColumn & MiniFont & Price & minicolumnend Response.write MiniPriceColumn & Minifont & shopformatcurrency(subtotal,getconfig("xdecimalpoint")) & minicolumnend If getconfig("xdualprice")="Yes" then dualPrice=formatnumber(dualprice,getconfig("xdecimalpoint")) Response.write MiniPriceColumn & MiniFont & dualPrice & minicolumnend Response.write MiniPriceColumn & Minifont & formatnumber(dualsubtotal,getconfig("xdecimalpoint")) & minicolumnend end if end if response.write "" end if next If showtype="SHORT" Then response.write MinititleRow response.write MiniPriceColumn & minifont & LangProductQuantity & "" & Minifontend If getconfig("xdisplayprices")="Yes" then response.write MiniPriceColumn & minifont & LangProductPrice & "" & Minifontend end if response.write "" response.write minirow Response.write MinipriceColumn & Minifont & totalproductquantity & Minicolumnend If getconfig("xdisplayprices")="Yes" then Response.write MinipriceColumn & minifont & shopformatcurrency(total,getconfig("xdecimalpoint")) & Minicolumnend end if else If getconfig("xdisplayprices")="Yes" then response.write "" & minifont & "" & LangMiniexcludes & "" & minicolumnend & "" response.write MiniPricecolumn & minifont & minifontend response.write MiniPriceColumn & minifont & shopformatcurrency(total,getconfig("xdecimalpoint")) & minifontend If getconfig("xdualprice")="Yes" then response.write "" & MiniPriceColumn & minifont & shopformatnumber(dualtotal,getconfig("xdecimalpoint")) & minifontend end if end if end if response.write "" end sub %>