<%Option explicit%>
<%
'********************************************************************
' Saves individual products in the wish list file
' VP-ASP 6.50 Permanent wish list Aug 16, 2004
' action=add&catalogid=x
' action=delete
' action=display (or null)
' Dec 12, 2004 do allow add if product has inventory products
' *********************************************************************
dim msg, conn, dbc
Dim Action, catalogid
Dim infomsg, customerid, nameincart
dim fieldcount, fields(10), fieldnames, captions(10)
customerid=getsess("customerid")
setsess "currenturl","shopwishlist.asp"
sError=""
If getsess("customerid") = "" then
Responseredirect "shopcustadminlogin.asp"
end if
If getconfig("xproductwishlist")<>"Yes" then
shoperror getlang("LangCustNotAllowed")
end if
action=request("action")
if action="" then
action="list"
else
action=lcase(action)
end if
if action<>"list" then
catalogid=request("id")
if catalogid="" then
catalogid=request("catalogid")
end if
if catalogid="" then
shoperror getlang("LangNoCatalogId")
end if
if not isnumeric(catalogid) then
shoperror getlang("LangNoCatalogId")
end if
end if
shoppageheader
if getconfig("xbreadcrumbs") = "Yes" then
response.write "" & vbCrLf
end if
Response.write "" & getlang("langwishlist") & "
" & vbCrLf
shopopendatabase dbc
select case action
case "add"
wishlistadd customerid, catalogid
case "delete"
wishlistdelete customerid, catalogid
end select
If serror<>"" then
shopwriteerror serror
serror=""
end if
Wishlistdisplay
If serror<>"" then
shopwriteerror serror
end if
shopclosedatabase dbc
shoppagetrailer
Sub wishlistadd (customerid, catalogid)
' check if that item exists
dim sql, rs
sql="select catalogid from savedcarts where customerid=" &customerid & " and catalogid=" & catalogid
set rs=dbc.execute(sql)
if not rs.eof then
Serror=getlang("langwishlistduplicate")
closerecordset rs
exit sub
end if
closerecordset rs
sql="insert into savedcarts (customerid, catalogid) "
sql=sql & " values (" &customerid& "," &catalogid& ")"
dbc.execute(sql)
end sub
Sub wishlistdelete (customerid, catalogid)
' check if that item exists
dim rs, sql
sql="select catalogid from savedcarts where customerid=" &customerid & " and catalogid=" & catalogid
set rs=dbc.execute(sql)
if rs.eof then
Serror=getlang("langwishlistnoproduct")
closerecordset rs
exit sub
end if
closerecordset rs
sql="delete from savedcarts where customerid=" & customerid & " and catalogid=" & catalogid
dbc.execute(sql)
end sub
'******************************************************************************
' wish shares table with saved carts
' bypass anything with something in cartname field
'*****************************************************************************
sub WishlistDisplay
dim rs, sql, catalogid, cartname
shopopendatabaseP conn
sql="select * from savedcarts where customerid=" & customerid
sql=sql & " and cartname is null"
set rs=dbc.execute(sql)
If rs.eof then
serror=getlang("langwishlistnone")
closerecordset rs
exit sub
end if
WriteWishlistheaders
do while not rs.eof
catalogid=rs("catalogid")
Formatwishlistentry conn, catalogid
rs.movenext
loop
closerecordset rs
shopclosedatabase conn
response.write tabledefend
end sub
Sub Formatwishlistentry (conn, catalogid)
dim rc, price, fieldvalue
dim my_link
CartGetProduct catalogid, rc
if rc>0 then exit sub
response.write ""
FormatProductcolumn strcname
FormatProductcolumn memcdescription
price=shopformatcurrency(curcprice, getconfig("xdecimalpoint"))
FormatProductcolumn price
'
my_link="shopwishlist.asp?action=delete&id=" & catalogid
my_link=addwebsess(my_link)
fieldvalue="" & getlang("LangCommonDelete") & ""
FormatProductcolumn fieldvalue
my_link="shopquery.asp?catalogid=" & catalogid
my_link=addwebsess(my_link)
fieldvalue="" & getlang("LangCommonView") & ""
FormatProductcolumn fieldvalue
If strinventoryproducts="" then
my_link="shopaddtocart.asp?catalogid=" & catalogid
my_link=addwebsess(my_link)
fieldvalue="" & getlang("LangCommonOrderNow") & ""
FormatProductcolumn fieldvalue
else
FormatProductcolumn " " ' no buy
end if
response.write "
"
end sub
Sub Formatproductcolumn (fieldvalue)
response.write ReportDetailColumn & fieldvalue & ReportDetailcolumnEnd
end sub
Sub WriteWishlistheaders
dim i
Fieldnames="cname,cdescription,cprice"
parserecord fieldnames, fields, fieldcount,","
Captions(0)=getlang("langproductname")
Captions(1)=getlang("Langproductdescription")
Captions(2)=getlang("Langproductprice")
Captions(fieldcount)=" "
fieldcount=fieldcount+1
Captions(fieldcount)=" "
fieldcount=fieldcount+1
Captions(fieldcount)=" "
response.write ReportTableDef
response.write ReportHeadRow
for i = 0 to fieldcount
Response.write ReportHeadColumn & Captions(i) & ReportHeadColumnEnd
next
response.write ReportRowEnd
end sub
%>