<% '******************************************************* ' Version 6.50 ' Project Subroutines ' August 31, 2004 '******************************************************* Dim pid, pdescription, pcustomer dim pprice, pdualprice, pquantity dim customername, usprice dim strpemail, strpid dim projectfields(20), Projectcaptions(20), projectfieldcount dim pnameincart ' Mods Aug 31 dim pbillid, pbilldescription ' Sub ProjectLocate(strpid,strpemail) dim projectdb, objrs dim strSQL ' projectdb=getconfig("xprojectdb") strpemail=replace(strpemail,"=","") if projectdb="" then shopopendatabase dbc else OpenOtherDatabase dbc, projectdb, xdblocation, xdatabasetype end if 'VP-ASP 6.09 - Security Fix strsql="select * from projects where customeremail='" & cleanchars(strpemail) & "' and pid=" & strpid set objrs=dbc.execute(strsql) If objRS.EOF then sError= getlang("LangProjectError") & "
" else pbilldescription=objrs("billdescription") pid=objrs("pid") pprice=objRS("price") pdualprice=objrs("dualprice") pbillid=objrs("billid") pquantity=1 if not isnull(pbillid) then if pbillid<>0 and not isnull(pbilldescription) then BillingnameInCart objrs, pnameincart end if else Projectnameincart objrs, pnameincart end if sError="" end if Closerecordset objrs shopclosedatabase dbc End Sub ' ' Sub ProjectAddToCart dim NameinCart, catalogid dim scartitem, arrCart,i dim cartisubtotal, price dim quantity dim mininame quantity=1 price=pprice catalogid=getconfig("xprojectcatalogid") if catalogid="" then catalogid=0 end if mininame=getlang("LangProjectNumber") & " " & strpid Nameincart=pnameincart arrCart = getsessa("CartArray") scartItem = Getsess("CartCount") scartitem=scartitem+1 setsess "CartCount",scartitem arrCart(cProductid,scartItem) = catalogid arrCart(cProductCode,scartItem) = strpid arrCart(cProductname,scartItem) = NameInCart arrCart(cQuantity,scartItem) = Clng(pquantity) arrCart(cOriginalPrice,scartItem) = pPrice arrCart(cUnitPrice,scartItem) = pPrice arrCart(cProductfeatures,scartItem) = strpid arrCart(cProductmininame,scartItem) = mininame if getconfig("XdualPrice")="Yes" then arrCart(cDualPrice,scartItem) = pdualprice else arrCart(cDualPrice,scartItem) = 0 end if setsessa "CartArray",arrCart end sub Sub ProjectNameInCart (Rsitem, nameincart) dim tempfields,cartfields,cartcaptions, fieldcount,i, fieldvalue SetupProjectfields cartfields, cartcaptions fieldcount=ubound(cartfields) nameincart="" for i = 0 to fieldcount fieldvalue=rsitem(cartfields(i)) if not isnull(fieldvalue) then nameincart=nameincart & ProdFeatureCaption & cartcaptions(i) & ": " & prodfeaturecaptionend & fieldvalue end if next end sub ' sub UpdateProjectpayment (conn, orderid) '************************************************************************* ' Updates project payment at the end of an order '************************************************************************* dim projectdb, dbc, orderdb, doopen dim pid,psql, projectid, upsql, prs, catalogid pid=getconfig("Xprojectcatalogid") If not isnumeric(pid) then exit sub pid=clng(pid) ' projectdb=getconfig("xprojectdb") Orderdb=getconfig("xorderdb") doopen=true if projectdb="" and orderdb="" then doopen=false end if if doopen=True then if orderdb="" then shopopendatabase dbc else OpenOtherDatabase dbc, projectdb, xdblocation, xdatabasetype end if end if Psql="select * from oitems where catalogid=" & pid & " and orderid=" & orderid set prs=conn.execute(psql) Do while not prs.eof projectid=prs("features") If isnumeric(projectid) then upsql="update projects set orderid=" & orderid upsql=upsql & ",paid='" & getlang("langcommonyes") & "'" upsql=upsql & ",datepaid=" & datedelimit(date()) upsql=upsql & " where pid=" & projectid If doopen=True then dbc.execute(upsql) else conn.execute(upsql) end if end if prs.movenext loop closerecordset prs If doopen=True then shopclosedatabase dbc end if end sub '****************************************************** ' This is what appears in the cart after a login for ' a billing record' ' '****************************************************** Sub BillingnameInCart (Rsitem, nameincart) dim tempfields,cartfields,cartcaptions, fieldcount,i, fieldvalue SetupProjectfields cartfields, cartcaptions fieldcount=ubound(cartfields) nameincart="" for i = 0 to fieldcount fieldvalue=rsitem(cartfields(i)) if not isnull(fieldvalue) then nameincart=nameincart & "" & cartcaptions(i) & ": " &"" nameincart=nameincart & fieldvalue & "
" end if next nameincart= nameincart & "

" & pbilldescription end sub %>