<%
'****************************************************************
' see if product has any inventory related products
' VP-ASP 6.50
' April 26, 2005 add translate
' Support multiple different formatting types
' table, radio, dropdownlist
' July 28, 2005 fix productid on radio button
' August 9, 2009 add inventory out of stock
' Nov 11, 2006 HK for table formatting use xproductformatinventory template
' tmp_subproductformat.htm
'***************************************************************
Sub FormatInventoryproducts (conn, objrs)
dim inventorytype, hassubproduct, catalogid, spdisplatype
dim lncstock, spdisplaytype
dim strCrossProductIDs,strsql, rs, strmessage, strcdescurl,strurl
If getconfig("XInventoryproducts")<>"Yes" then exit sub
strcrossproductids=objrs("inventoryproducts")
hassubproduct=objrs("hassubproduct")
catalogid=objrs("catalogid")
spdisplaytype=objrs("spdisplaytype")
if isnull(spdisplaytype) then
spdisplaytype="table"
end if
if isnull(strcrossproductids) and isnull(hassubproduct) then exit sub
strsql="select * from products where ("
If strcrossproductids<>"" Then
strsql=strsql & " catalogid in (" & strcrossproductids & ")"
strsql=strsql & " or "
end if
strsql =strsql & "highercatalogid=" & catalogid & ")"
if getconfig("xstocklow")<>"" then
lngcstock= clng(getconfig("xstocklow"))
strsql = strsql & " and cstock> " & lngcstock
end if
'VP-ASP 6.09 - only show products that aren't hidden
strsql = strsql & " and hide = 0 "
if getconfig("xsortproducts") > "" then
strsql = strsql & " ORDER BY " & getconfig("xsortproducts")
end if
set rs=conn.execute(strsql)
If rs.eof then
closerecordset rs
exit sub
end if
Select case lcase(spdisplaytype)
case "table"
FormatInventorytable conn, rs, objrs
case "radio"
FormatInventoryRadio conn, rs, objrs
case "checkbox"
FormatInventoryCheckbox conn, rs, objrs
case "quantity"
FormatInventoryQuantity conn, rs, objrs
case "dropdown"
FormatinventoryDropdown conn, rs, objrs
case else
Formatinventorytable conn, rs, objrs
end select
closerecordset rs
end sub
'************************************************************************
' format inventory as a table'
' rs is the subproducts
' objrs is main product
'***********************************************************************
sub FormatInventorytable (conn, rs, objrs)
dim headerok
'VP-ASP 6.50 - in the table layout for sub-products, you can use a template to display each item
If getconfig("xsubproducttemplate")<>"" then
ProductFormatInventoryTemplate conn, rs
exit sub
end if
'FormatInventoryHeader
headerok=true
While Not rs.EOF
'response.write "
" 'Removed in 6.5
ProductFormatInventoryrow rs
'response.write "
" 'Removed in 6.5
RS.MoveNext
WEND
if headerok=true then
' Response.write tabledefend
end if
end sub
'
'*******************************************************************
' Start Inventory list table
'****************************************************************
Sub FormatInventoryHeader
Response.write reporttabledef
response.write reportheadrow
response.write ReportHeadColumn
Response.write getlang("LangInventory")
Response.write ReportHeadColumnEnd
response.write reportrowend
Response.write tabledefend
Response.write reporttabledef
end sub
'**********************************************************************
' format one row of inventory
' image, description and buy button
'**************************************************************************
Sub ProductFormatInventoryRow (rs)
dim catalogid, imagefile, cname, cprice, url, imageurl, description
dim cstock, outofstockflag
outofstockflag=false
response.write "
" 'Added in 6.5
end sub
'***************************************************************
' Put out image and name
'*****************************************************************
Sub InventoryFormatimage (rs, imagefile, cname, url, outofstockflag)
dim urlimage, urlname
response.write "
"
If not isnull(imagefile) then
If outofstockflag=false then
urlimage=" "
else
urlimage=" "
end if
end if
response.write urlimage
If outofstockflag=false then
' response.write "" & cname & ""
else
' response.write cname
end if
response.write reportDetailColumnEnd
end sub
'*****************************************************************
' Put out description and stock
'***************************************************************
Sub Inventoryformatdescription (rs, description, stock, outofstockflag)
response.write "
"
response.write description
if getconfig("xOutOfStockLimit")<>"" then
Inventoryformatstock stock, outofstockflag
end if
'response.write reportDetailColumnEnd
End sub
Sub InventoryFormatstock (stock, outofstockflag)
response.write " " & getlang("LangProductStock") & " " & stock
end sub
Sub Inventoryformatbutton(url, outofstockflag)
'response.write reportdetailcolumn
response.write " "
If outofstockflag=false then
response.write "" & getlang("langcommonview") & ""
else
Response.write getlang("langOutOfStock")
end if
response.write reportDetailColumnEnd
end sub
Sub InventoryCheckStock (lngcstock, outofstockflag)
if getconfig("xOutOfStockLimit")="" then exit sub
if isnull(lngcstock) then exit sub
if lngcstock>clng(getconfig("xOutOfStocklImit")) then exit sub
outofstockflag=True
end sub
'*******************************************************************************
' need to know whether this product has subproducts.
' If yes inventorycjeck is set to true
' If inventory display type is table, then we don't want to display prices
' since main product cannot be order
'********************************************************************************
sub InventoryProductYesNo (dbc, objrs, catalogid, inventorycheck, pricedisplay, quantitydisplay,inventoryoutofstock)
dim inventorydisplaytype, strhassubproduct, rc
inventorycheck=false
priceDisplay=true
quantitydisplay=true
inventoryoutofstock=false
If getconfig("xinventoryproducts")="No" then exit sub
strinventoryproducts=objrs("inventoryproducts")
inventorydisplaytype=objrs("spdisplaytype")
if isnull(inventorydisplaytype) then
inventorydisplaytype="table"
end if
if lcase(inventorydisplaytype)="table" then
pricedisplay=false
quantitydisplay=false
end if
if lcase(inventorydisplaytype)="quantity" then
quantitydisplay=false
end if
'
if isnull(strinventoryproducts) then strinventoryproducts=""
if strinventoryproducts<>"" then
inventorycheck=true
end if
strhassubproduct=objrs("hassubproduct")
if isnull(strhassubproduct) then strhassubproduct=""
if strhassubproduct<>"" then
inventorycheck=true
end if
If inventorycheck=true then
Inventorystockcheck dbc, objrs, Inventoryoutofstock, rc
end if
'VP-ASP 6.50 - check if all child products are hidden. If so, show out of stock message
If inventorycheck=true then
if Inventoryoutofstock <> true then
inventoryhiddencheck dbc, objrs, Inventoryoutofstock, rc
end if
end if
end sub
'**************************************************************************
' create a radio of subproducts
' ************************************************************************
Sub FormatInventoryRadio ( conn, rs, objrs)
dim selectname, checkname, msize, setselected, Loopend, subcatalogid
dim formcaption, multiple
dim fprefix, sSelect
Formatinventoryformname fprefix, formcaption
selectname=fprefix & "subproductradio"
checkname=selectname
Multiple=""
msize=1
loopend="False"
sSelect=""
setselected=""
sSelect = ProdFeatureCaption & formCaption & ProdFeatureCaptionEnd
tempOption=""
sSelect = sSelect & "
"
Do While LoopEnd="False"
GenerateSubProductName tempoption, rs
subcatalogid=rs("catalogid")
sselect = sselect & "
"
If multiple="Yes" then
sselect=sselect & "
" & tempoption & "
"
else
sselect=sselect & "
" & tempoption & "
"
end if
sselect = sselect & "
"
Rs.movenext
if rs.EOF then
LoopEnd="True"
end if
loop
sSelect = sSelect & "
"
response.write " " & sselect
end sub
'**************************************************************************
' create a Checkbox of subproducts
' ************************************************************************
Sub FormatInventoryCheckbox ( conn, rs, objrs)
dim selectname, checkname, msize, setselected, Loopend, subcatalogid
dim formcaption, multiple
dim fprefix, sSelect
Formatinventoryformname fprefix, formcaption
selectname=fprefix & "subproductCheckbox"
checkname=selectname
Multiple=""
msize=1
loopend="False"
sSelect=""
setselected=""
sSelect = ProdFeatureCaption & formCaption & ProdFeatureCaptionEnd
sSelect = sSelect & "
"
tempOption=""
Do While LoopEnd="False"
GenerateSubProductName tempoption, rs
subcatalogid=rs("catalogid")
sSelect = sSelect & "
"
sselect=sselect & "
" & tempoption & "
"
sSelect = sSelect & "
"
Rs.movenext
if rs.EOF then
LoopEnd="True"
end if
loop
sSelect = sSelect & "
"
response.write " " & sselect
end sub
'**************************************************************************
' create a dropdownlist of subproducts
' subrs is the subproducts
' mainrs is the main product recordset
' ************************************************************************
Sub FormatinventoryDropdown (conn, rs, mainrs)
dim selectname, checkname, msize, setselected, Loopend, subcatalogid
dim formcaption, multiple, discount
dim fprefix, sSelect
Formatinventoryformname fprefix, formcaption
selectname=fprefix & "subproductdropdown"
Multiple=""
msize=1
loopend="False"
sSelect=""
setselected=""
sSelect = ProdFeatureCaption & formCaption & ProdFeatureCaptionEnd
sSelect = sSelect & ""
Response.write sSelect
end sub
'**********************************************************************
' the formfieldname and caption are generated here
'**********************************************************************
Sub Formatinventoryformname (prefix, caption)
dim fprefix
fprefix="Y"
prefix=fprefix & Prodindex
caption=getlang("langinventory")
end sub
'*****************************************************************************
' generate name in form
' cname $xxx.yyy
'****************************************************************************
Sub GenerateSubProductName (tempoption, rs)
dim catalogid, discount, theprice
dim higherprice, newprice, highercat
dim hideprice
hideprice = false
If getconfig("XDisplayPrices")<>"Yes" then
hideprice = true
end if
if getconfig("xpriceloggedinonly") = "Yes" then
if Getsess ("login") = "" then
hideprice= true
end if
end if
If getconfig("xshowchildprice")<>"Yes" then
hideprice = true
end if
catalogid=rs("catalogid")
higherprice=rs("cprice")
newprice=rs("cprice")
highercat=rs("ccategory")
tempoption=rs("cname")
'VP-ASP 6.50 - translate sub-product name
tempoption=translatelanguage(dbc, "products", "cname","catalogid", catalogid, tempoption)
ShopCustomerPrices rs, catalogid, highercat, higherprice, newprice,discount
higherprice=newprice
theprice=shopformatcurrency(higherprice,getconfig("xdecimalpoint"))
if hideprice = true then
tempoption=tempoption
else
tempoption=tempoption & " - " & theprice
end if
end sub
'**************************************************************************
' create a Checkbox of subproducts
' ************************************************************************
Sub FormatInventoryQuantity ( conn, rs, objrs)
dim selectname, checkname, msize, setselected, Loopend, subcatalogid
dim formcaption, multiple, valuename, catalogids, quantityname
dim fprefix, sSelect
Formatinventoryformname fprefix, formcaption
selectname=fprefix & "subproductquantity"
valuename=selectname & "_catalogids"
checkname=selectname
catalogids=""
loopend="False"
sSelect=""
setselected=""
sSelect = ProdFeatureCaption & formCaption & ProdFeatureCaptionEnd
sSelect = sSelect & "
"
tempOption=""
Do While LoopEnd="False"
GenerateSubProductName tempoption, rs
subcatalogid=rs("catalogid")
if catalogids<>"" then
catalogids=catalogids & ","
end if
catalogids=catalogids & subcatalogid
quantityname=selectname & "_" & subcatalogid
sSelect = sSelect & "
"
sselect=sselect & "
"
sselect= sselect & "
" & tempoption & "
"
sSelect = sSelect & "
"
Rs.movenext
if rs.EOF then
LoopEnd="True"
end if
loop
sSelect = sSelect & "
"
response.write " " & sselect
Response.write "" & vbcrlf
Response.Write "" & vbcrlf
end sub
'*******************************************************************************
' see if there is a sub product being added.
' If so use its catalogid and not the main catalogid
' field could be
' subproductdropdown
' subproductquantity
' subproductradio
' subproductcheckbox
' subproduct
'******************************************************************************
' see if we have any sub products and if so handle 4 different types
'*****************************************************************************
sub CartInventoryProduct (productid, rc)
dim selectname, caption, subcatalogid, prefix
' See if we have subproduct radio selection
CartInventorySubproductRadio productid, rc
If rc=0 then
exit sub
end if
CartInventorySubproductDropdown productid, rc
If rc=0 then
exit sub
end if
' If we have a checkbox, product(s) where added in thar routine
' so we need to tell caller to do nothing
CartInventorySubproductCheckbox productid, rc
If rc=0 then
rc=4
exit sub
end if
' If we have a checkbox, product(s) where added in thar routine
' so we need to tell caller to do nothing
CartInventorySubproductQuantity productid, rc
If rc=0 then
rc=4
exit sub
end if
rc=0
end sub
'***********************************************************************
' if there is a radio subproduct, change the main product id to the
' sub productid and that is all that needs to be done
'***********************************************************************
sub CartInventorySubproductRadio (productid, rc )
dim prefix, caption, selectname
rc=4
CartFormatinventoryformname prefix
selectname=prefix & "subproductradio"
subcatalogid=request(selectname)
if subcatalogid<>"" then
If not isnumeric(subcatalogid) then
CartInventoryError getlang("langsubnotnumeric")
else
productid=subcatalogid
'debugwrite "selectname=" & selectname & " Subcatalogid=" & subcatalogid
rc=0
end if
end if
end sub
'***********************************************************************
' if there is a radio subproduct, change the main product id to the
' sub productid and that is all that needs to be done
'***********************************************************************
sub CartInventorySubproductDropdown (productid, rc )
dim prefix, caption, selectname
rc=4
CartFormatinventoryformname prefix
selectname=prefix & "subproductdropdown"
subcatalogid=request(selectname)
'debugwrite "subcatalogid=" & subcatalogid & " selectname=" & selectname
if subcatalogid<>"" then
if subcatalogid=getlang("langcommonselect") then
cartinventoryerror getlang("langselectsubproduct")
end if
If not isnumeric(subcatalogid) then
CartInventoryError getlang("langsubnotnumeric")
else
productid=subcatalogid
'debugwrite "selectname=" & selectname & " Subcatalogid=" & subcatalogid
rc=0
end if
end if
end sub
'***********************************************************************
' if there is a Checkboxes. There can be multiple subproducts toadd to cart at once
' sub productid and that is all that needs to be done
'***********************************************************************
sub CartInventorySubproductCheckbox (productid, rc )
dim prefix, caption, selectname, i, catalogids(100), catalogidcount
dim count
rc=4
CartFormatinventoryformname prefix
selectname=prefix & "subproductcheckbox"
subcatalogid=request(selectname)
'check if this product is a parent and of type checkbox
dim subrs, subdbc
shopopendatabaseP subdbc
sql = "select hassubproduct, spdisplaytype from products where catalogid = " & productid
set subrs = subdbc.execute(sql)
if not subrs.eof then
if subrs("hassubproduct") = "Yes" then
if subrs("spdisplaytype") = "Checkbox" OR subrs("spdisplaytype") = "Radio" then
if subcatalogid="" then
closerecordset subrs
shopclosedatabase subdbc
cartinventoryerror getlang("langselectsubproduct")
end if
else
'VP-ASP 6.09 - close open connection
if subcatalogid="" then
closerecordset subrs
shopclosedatabase subdbc
exit sub
end if
end if
else
'VP-ASP 6.09 - close open connection
if subcatalogid="" then
closerecordset subrs
shopclosedatabase subdbc
exit sub
end if
end if
else
'VP-ASP 6.09 - close open connection
if subcatalogid="" then
closerecordset subrs
shopclosedatabase subdbc
exit sub
end if
end if
closerecordset subrs
shopclosedatabase subdbc
'19/01/2006 - wasn't erroring out if no sub product was selected
'if subcatalogid="" then
' CartInventoryError getlang("langselectsubproduct")
'end if
'VP-ASP 6.08 End Fix
'debugwrite "selectname=" & selectname & " Subcatalogid=" & subcatalogid
parserecord subcatalogid, catalogids,catalogidcount,","
count=0
for i =0 to catalogidcount-1
subcatalogid=catalogids(I)
If not isnumeric(subcatalogid) then
CartInventoryError getlang("langsubnotnumeric")
rc=0
exit sub
end if
next
' if there is only 1 then treat it normally by changing main product id
' At this time we have multiple subproducts to add to the cart
' catalogids are in the catalogids array
for i = 0 to catalogidcount-1
CartInventorySubproductAddtocart catalogids(i), quantity
count=count+1
next
If count>0 then
rc=0
exit sub
end if
CartInventoryError getlang("langselectsubproduct")
end sub
'***********************************************************************
' if there is a quantities have multiple form fields
' subproductquantity_catalogids= 3,5,7 list of subproducts
' subproductquanty_3 = actual quantity for subproduct 3
' sub productid and that is all that needs to be done
'***********************************************************************
sub CartInventorySubproductQuantity (productid, rc )
dim prefix, caption, selectname, i, catalogids(100), catalogidcount
dim quantityname, subcatalogid, valuename
dim catalogidlist, count, subquantity
rc=4
CartFormatinventoryformname prefix
selectname=prefix & "subproductquantity"
valuename=selectname & "_catalogids"
subcatalogid=request(selectname)
if subcatalogid="" then exit sub
'VP-ASP 6.50 - precautionary security fix
catalogidlist=cleanchars(request(valuename))
'debugwrite "selectname=" & selectname & " Subcatalogid=" & catalogidlist
parserecord catalogidlist, catalogids,catalogidcount,","
for i =0 to catalogidcount-1
subcatalogid=catalogids(I)
If not isnumeric(subcatalogid) then
CartInventoryError getlang("langsubnotnumeric")
rc=0
exit sub
end if
next
count=0
' we now know all the sub products. Each can have their own quantity
' in form subproductquantity_x where x is the catalogid
' if there is only 1 then treat it normally by changing main product id
' At this time we have multiple subproducts to add to the cart
' catalogids are in the catalogids array
'debugwrite "catalogidcount=" & catalogidcount
for i = 0 to catalogidcount-1
subcatalogid=catalogids(i)
quantityname=selectname & "_" & subcatalogid
subquantity=request(quantityname)
'debugwrite "quantityname=" & quantityname & " quantity=" & subquantity
if isnumeric(subquantity) then
if subquantity>0 then
CartInventorySubproductAddtocart subcatalogid, subquantity
count=count+1
end if
end if
next
if count>0 then
rc=0
exit sub
end if
CartInventoryError getlang("langselectsubproduct")
end sub
Sub CartInventoryError (msg)
shoperror msg
end sub
'***********************************************************************************
' we need to add the subproduct to the cart with the quantity given
'**********************************************************************************
Sub CartInventorySubproductAddtocart (productid, subquantity)
dim rc
'productid=catalogid
quantity=subquantity
CartGetProduct productid, rc
If rc= 0 then
SetSess "newProductPrice",""
GetProductFeatures prodi ' located in shopproductfeatures
CartAddItem Productid, rc
end if
end sub
'**********************************************************************
' the formfieldname and caption are generated here
'**********************************************************************
Sub CartFormatinventoryformname (prefix)
dim fprefix
fprefix="Y"
prefix=fprefix & Prodi
end sub
'**********************************************************************************************
' check all inventory products to see if they are out of stock
' use highest of xstocklow and xoutofstocklimit
'*********************************************************************************************
sub Inventorystockcheck (dbc, objrs, Inventoryoutofstock, rc)
dim stocknum, stocknum2, rs
dim strcrossproductids,hassubproduct,catalogid,strsql
rc=0
inventoryoutofstock=false
if getconfig("xstocklow")<>"" then
stocknum=clng(getconfig("xstocklow"))
else
stocknum=-1
end if
if getconfig("xOutOfStockLimit")<>"" then
stocknum2=clng(getconfig("xOutOfStockLimit"))
else
stocknum2=-1
end if
if stocknum2>stocknum then
stocknum=stocknum2
end if
if stocknum=-1 then exit sub
strcrossproductids=objrs("inventoryproducts")
hassubproduct=objrs("hassubproduct")
catalogid=objrs("catalogid")
strsql="select * from products where ("
If strcrossproductids<>"" Then
strsql=strsql & " catalogid in (" & strcrossproductids & ")"
strsql=strsql & " or "
end if
strsql =strsql & "highercatalogid=" & catalogid & ")"
if getconfig("xstocklow")<>"" then
lngcstock= clng(getconfig("xstocklow"))
strsql = strsql & " and cstock> " & stocknum
end if
'debugwrite strsql
set rs=dbc.execute(strsql)
If rs.eof then
rc=4
inventoryoutofstock=true
exit sub
end if
closerecordset rs
end sub
'VP-ASP 6.50 - check if all child products are hidden. If so, show out of stock message
sub Inventoryhiddencheck (dbc, objrs, Inventoryoutofstock, rc)
dim strcrossproductids, hassubproduct,strsql,rs
rc=0
inventoryoutofstock=false
strcrossproductids=objrs("inventoryproducts")
hassubproduct=objrs("hassubproduct")
catalogid=objrs("catalogid")
strsql="select * from products where ("
If strcrossproductids<>"" Then
strsql=strsql & " catalogid in (" & strcrossproductids & ")"
strsql=strsql & " or "
end if
strsql =strsql & "highercatalogid=" & catalogid & ")"
if ucase(xdatabasetype) = "MYSQL" OR ucase(xdatabasetype) = "MYSQL351" OR ucase(xdatabasetype) = "SQLSERVER" then
strsql = strsql & " and hide <> 1 "
else
strsql = strsql & " and hide <> TRUE "
end if
set rs=dbc.execute(strsql)
If rs.eof then
rc=4
inventoryoutofstock=true
exit sub
end if
closerecordset rs
end sub
'********************************************************************************
' VP-ASP 6.5
' recordset rs holds the records to format
' create an outside table and then put as many columns as required
'*******************************************************************************
Sub ProductFormatInventoryTemplate (conn, rs)
dim template, maxcolumns, colcount, totalcolcount
template=getconfig("xsubproducttemplate")
maxcolumns=getconfig("xsubproductcolumns")
If maxcolumns="" then maxcolumns=1
If isnumeric(maxcolumns) then
maxcolumns=clng(maxcolumns)
else
maxcolumns=1
end if
'maxcolumns=1
' start outside table
Response.write "
" & vbCrLf
colcount=0
totalcolcount=0
do While Not rs.EOF
SubproductstartColumnorRow maxcolumns, colcount ' create a columnn
ProductFormatInventoryrowtemplate conn, rs, template
RS.MoveNext
colcount=colcount+1
totalcolcount=totalcolcount+1 ' count total written
SubproductEndColumnorRow maxcolumns, colcount ' create a columnn
if colcount>= MaxColumns and Maxcolumns>1 then
'response.write "" ' finish row
colcount=0
end if
loop
'SubproductFillRemainingColumns maxcolumns, colcount, totalcolcount
response.write "
" & vbCrLf ' finish table
end sub
'***************************************************************************
' use a template to format sub products
' Template is xproductformatinventory (tmp_subproductformat.htm)
'**************************************************************************
sub ProductFormatInventoryRowTemplate (conn, rs, template)
'debugwrite "doing subproduct catalogid=" & rs("catalogid")
dim rc
dim catalogid, subrs, subsql
catalogid=rs("catalogid")
subsql="Select * from products where catalogid=" & catalogid
set subrs=conn.execute(subsql)
ShopTemplateWrite template, subRs, rc
closerecordset subrs
end sub
Sub subproductStartColumnorRow (productmaxcolumns, colcount)
'debugwrite "colcount=" & colcount & "maxcolumns=" & productmaxcolumns
If ProductMaxColumns=1 or colcount=0 then
Response.write "
"
end if
end sub
Sub subproductEndColumnorRow (productmaxcolumns, colcount)
If ProductMaxColumns=1 then
Response.write "
"
exit sub
end if
end sub
'********************************************************
' If we are doing multiple columns, fill them up
'*******************************************************
Sub SubproductFillRemainingColumns (productmaxcolumns, colcount, totalcolcount)
If productmaxcolumns=1 then exit sub
If colcount=0 then exit sub
If totalcolcount"
exit sub
end if
Do While Colcount0
response.write "
"
colcount=colcount+1
loop
response.write ""
end sub
%>