<%
'************************************************
' Shop subroutines VP-ASP 5.00
' VP-ASP 5.00
' May 9, 2003, demo version
'*************************************************
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
'
'*******************************************************************
' This routine puts fields into the cart
'****************************************************************
' 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
'
'***************************************************************
' Used throughout the code to create a text form box
'***************************************************************
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
'******************************************************************
' used in the admin section to create a text form box
'*******************************************************************
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 & "" & vbcrlf
Response.write tableColumnEnd
Response.write TableRowEnd
end sub
Sub FormatEditRowBoolean (caption,fieldname,fieldvalue, Yesnos, Yesnocount,helpfile)
dim capdisplay
capdisplay=caption
if capdisplay="" then
capdisplay=fieldname
end if
Response.Write TableRow
Response.write TableColumn & capdisplay & TableColumnEnd
Response.write TableColumn
GenerateselectNV YesNos,fieldvalue,fieldname,yesnocount, ""
Response.write tableColumnEnd
If helpfile<>"" and getconfig("xproducthelp")="Yes" then
FormatEditHelp fieldname, helpfile
end if
Response.write TableRowEnd
end sub
'******************************************************************
' used in admin section to create a static equivalent of a text box
'*******************************************************************
Sub FormatEditRowStatic (caption,fieldname,fieldvalue)
dim capdisplay, yfont
capdisplay=caption
if capdisplay="" then
capdisplay=fieldname
end if
yfont=xTableRowFont
Response.Write TableRow
Response.write TableColumn & capdisplay & TableColumnEnd
Response.write TableColumn & Yfont & fieldvalue & xTableRowFontEnd
Response.write tableColumnEnd
Response.write TableRowEnd
end sub
'***********************************************************
' used in admin area to ceate a multirow text area
'************************************************************
Sub FormatEditRowTextArea (caption,fieldname,fieldvalue)
dim capdisplay, rows
capdisplay=caption
if capdisplay="" then
capdisplay=fieldname
end if
rows=3
Response.Write TableRow
Response.write TableColumn & capdisplay & TableColumnEnd
response.write "
" & vbcrlf
Response.write tableColumnEnd
Response.write TableRowEnd
end sub
'***********************************************************************
' if doing help for products and categories
'************************************************************************
Sub FormatEditHelpHeader
if getconfig("xproducthelp")<>"Yes" then exit sub
%>
<%
end sub
'********************************************************************
' write help column for products and categories
'*******************************************************************
Sub FormatEditHelp(fieldname, helpfile)
if getconfig("xproducthelp")<>"Yes" then exit sub
response.write tablecolumn
%>
<%
response.write tablecolumnend
end sub
'
'****************************************************************
' creates category drop down list
'***************************************************************
Sub NavigateShowCategories()
end sub
' MiniCart
'*******************************************************************
' Create mini cart
' If passed value "SHORT" it creates a small mini cart
'*******************************************************************
Sub NavigateShowMiniCart (itype)
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 "
"
If showtype<>"SHORT" Then
Response.write Minitable
response.write MiniTitleRow
response.write MiniNameTitleColumn & minititlefont & getlang("langProductDescription") & "" & Minifontend
response.write MiniPriceColumn & minititlefont & getlang("langProductQuantity") & "" & Minifontend
If getconfig("xdisplayprices")="Yes" then
response.write MiniPriceColumn & minititlefont & getlang("langProductPrice") & "" & Minifontend
response.write MiniPriceColumn & minititlefont & getlang("langProductTotal") & "" & Minifontend
If getconfig("xdualprice")="Yes" then
response.write MiniPriceColumn & minititlefont & getlang("langDualPrice") & "" & Minifontend
response.write MiniPriceColumn & minititlefont & getlang("langDualTotal") & "" & Minifontend
end if
end if
Response.write ""
end if
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(cProductMiniName,i)
if name="" then
Name=arrCart(cProductName,i)
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 MinitableShort
response.write MinititleRow
response.write MiniPriceColumn & minifont & getlang("langProductQuantity") & Minifontend
If getconfig("xdisplayprices")="Yes" then
response.write MiniPriceColumn & minifont & getlang("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 "
"
end sub
'********************************************************************
' creates quick go to categories
' currently used in shoppage_header.htm
'*********************************************************************
Sub NavigateShowAllCategories()
end sub
Sub CorrectBooleanProgram (fieldvalue)
'If it is yes set to 1 else set to 0
If isnull(fieldvalue) then
fieldvalue=0
end if
If fieldvalue<>0 then
fieldvalue=yesnos(0) ' Yes
else
fieldvalue=yesnos(1) ' no
end if
end sub
Sub CorrectBooleanHuman (fieldvalue)
'If it is yes set to 1 else set to 0
If fieldvalue=yesnos(0) then
fieldvalue=1
else
fieldvalue=0
end if
end sub
'
'**************************************************************
' Used in shipping calculation to get total weight including
' feature weight
'***********************************************************
' Get total weight of products
Sub GetTotalProductWeight (conn,totalWeight,totalfeatureweight)
end sub
'*********************************************************************
' features come in as a list 5,9,11
' reread the feature record and get weight from featureother1
'****************************************************************
Sub GetTotalfeatureweight (dbc, prodid, prodfeatures, featureweight)
end sub
'***********************************************************************
' write login form for shopcustomer, shopcustadminlogin
'************************************************************************
Sub ShopLOginForm
Dim caption
If getconfig("xcustomeruserid")="Yes" then
caption=getlang("langAdminUsername")
else
caption=getlang("langStatusEmail")
end if
If ucase(getconfig("Xpassword"))="YES" then
Response.Write(""
response.write ("" & getlang("langLoginForgot") & "")
else
Response.Write(""
end if
end sub
'*********************************************************************
' Display all products in a quick shop list
'********************************************************************
Sub NavigateShowProducts
end sub
Sub NavigateTopTen
end sub
'******************************************************************
' Format the top ten products
'*******************************************************************
Sub TopTenProduceDetail (dbc,rs)
end sub
%>
<%
response.write tablecolumnend
end sub
'
'****************************************************************
' creates category drop down list
'***************************************************************
Sub NavigateShowCategories()
end sub
' MiniCart
'*******************************************************************
' Create mini cart
' If passed value "SHORT" it creates a small mini cart
'*******************************************************************
Sub NavigateShowMiniCart (itype)
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 "