<% '********************************************************* ' VP-ASP 6.50 ' MYSQL and Chillisoft subroutines for updating the database ' April 29, 2004, address2, coupon and commission ' June 24, 2004 Issue start date ' August 31, 2004 userid on registration ' Dec 31, 2005 Add mysqlupdatemenu '******************************************************** Sub MYSQLUpdateContact() Dim dbc, sqlo, rso Dim DoUpdate DoUpdate="" dim tlastname tlastname=Getsess("lastname") tlastname=replace(tlastname,"'","''") 'on error resume next OpenCustomerDb dbc If GetSess("CustomerId")<>"" and GetSess("Lastname") <> "" and getconfig("xAllowCustomerUpdates")="Yes" then sql="select * from customers where contactid=" & getsess("customerid") sql=sql & " and lastname='" & tlastname & "'" set objrs=dbc.execute(sql) if not ObjRS.eof then DoUpdate="True" strcustomerid=getsess("customerid") end if closerecordset objrs end if If Doupdate="" then sqlo="insert into customers (lastname) values('" & tlastname & "')" dbc.execute(sqlo) sqlo = "select max(contactid) from customers where lastname='" & tlastname & "'" Set rso = dbc.Execute(sqlo) strcustomerid = rso(0) rso.close set rso=nothing end if sqlo="" mysqltextfield sqlo, "firstname",strfirstname mysqltextfield sqlo, "lastname",strlastname mysqltextfield sqlo, "address",straddress mysqltextfield sqlo, "city",strcity mysqltextfield sqlo, "state",strstate mysqltextfield sqlo, "postcode",strpostcode mysqltextfield sqlo, "phone",strphone mysqltextfield sqlo, "country",strcountry mysqltextfield sqlo, "workphone",strworkphone mysqltextfield sqlo, "mobilephone",strmobilephone mysqltextfield sqlo, "website",strwebsite mysqltextfield sqlo, "email",stremail mysqltextfield sqlo, "fax",strfax mysqltextfield sqlo, "company",strcompany If getconfig("xPassword")="Yes" and strpassword1<>"" then mysqltextfield sqlo,"password", strpassword1 mysqltextfield sqlo,"userid",strcustuserid ' 5.00 end if mysqlboolfield sqlo, "cookiequestion",blncookiequestion mysqlboolfield sqlo, "maillist",blnmaillist ' 4.50 mysqltextfield sqlo,"vatnumber",strvatnumber ' 4.50 mysqltextfield sqlo, "hearaboutus",strhearaboutus '5.00 mysqltextfield sqlo, "address2",straddress2 '5.10 if getconfig("xCustomerOtherfields")<>"" then MYSQLCustomerUpdateFields sqlo ' update additional end if sqlo="update customers " & sqlo & " where contactid=" & strcustomerid 'debugwrite sqlo Set rso=dbc.execute(sqlo) ShopCloseDatabase dbc UpdateCustomerSessionData ' 2.4 SetSess "customerid",strCustomerID end sub '*************************************************************************** ' add sql to sql string if the value is something otherwise set to null '************************************************************************** Sub mysqltextfield (isql,fieldname,fieldvalue) dim tfieldvalue 'on error resume next if fieldvalue="" then tfieldvalue="NULL" else tfieldvalue=replace(fieldvalue,"'","''") end if If getconfig("xdebug")="Yes" then Debugwrite fieldname & " " & tfieldvalue & "
" end if if isql="" then isql="SET " else isql=isql &"," end if If tfieldvalue="NULL" then isql=isql & fieldname & "=" & tfieldvalue else isql=isql & fieldname & "='" & tfieldvalue & "'" end if end Sub '*************************************************************************** ' add sql to sql string if the value is something otherwise set to null '************************************************************************** Sub mysqlnumbfield (isql,fieldname,fieldvalue) on error resume next 'VP-ASP 6.09 - change exit sub to NULL if fieldvalue="" then 'exit sub fieldvalue="NULL" else 'VP-ASP 6.50 - security update fieldvalue = cleanchars(fieldvalue) end if If getconfig("xdebug")="Yes" then Debugwrite fieldname & " " & tfieldvalue & "
" end if if isql="" then isql="SET " else isql=isql &"," end if isql=isql & fieldname & "=" & fieldvalue end Sub '********************************************************************** ' set value to 1 or 0 depending on current setting '*********************************************************************** Sub mysqlboolfield (isql,fieldname,fieldvalue) dim tfieldvalue on error resume next if fieldvalue="" then exit sub end if If fieldvalue=TRUE then tfieldvalue=1 else tfieldvalue=0 end if if isql="" then isql="SET " else isql=isql &"," end if isql=isql & fieldname & "='" & tfieldvalue & "'" end Sub '******************************************************* ' add order to database '****************************************************** Sub MYSQLAddOrder Dim arrCart, scartItem, orderdbc Dim dbc Dim oid, sqlo Dim i, features dim rso dim supplierid, productaddress, currentordernumber dim tlastname, ipaddress dim newdate, newtime arrCart = GetSessA("CartArray") ' get shopping cart data scartItem = GetSess("CartCount") OpenOrderdb orderdbc If GetSess("Orderid")<>"" then CancelOrderRecord orderdbc,getsess("orderid") SetSess "Orderid","" end if GetCustomerSessionData ' make sure we have session into local Errors="" ' no errors If getconfig("xConvertEuropeanNumbers")="Yes" then PerformNumberConversion end if tlastname=replace(strlastname,"'","''") sqlo="insert into orders (olastname) values('" & tlastname & "')" orderdbc.execute(sqlo) ' debugwrite sqlo sqlo = "select max(orderid) from orders where olastname='" & tlastname & "'" Set rso = orderdbc.Execute(sqlo) oid = Clng(rso(0)) CurrentOrdernumber=oid Setsess "oid",oid rso.Close set rso=nothing sqlo="" MYSQLNumbField sqlo,"ocustomerid", strCustomerid If getconfig("xTimeDifference")="" then MYSQLtextField sqlo, "odate", datenormalize(date()) MYSQLtextField sqlo, "otime", formatdatetime(Time(),vbshorttime) else adjustdate newdate MYSQLtextField sqlo, "odate", datenormalize(newdate) adjusttime newtime MYSQLtextField sqlo, "otime", newtime end if mysqlnumbfield sqlo,"orderamount", getsess("ordertotal") mysqltextfield sqlo,"olastname",strlastname mysqltextfield sqlo,"ofirstname",strfirstname mysqltextfield sqlo,"oemail",stremail mysqltextfield sqlo,"oaddress",straddress mysqltextfield sqlo,"ocity",strcity mysqltextfield sqlo,"opostcode",strpostcode mysqltextfield sqlo,"ostate",strstate mysqltextfield sqlo,"ophone", strphone if lcase(left(getsess("shipmethod"), 4)) = "
" then mysqltextfield sqlo,"oshipmethodtype",getsess("shipmethodtype") & " " & getsess("shipmethod") else mysqltextfield sqlo,"oshipmethodtype",getsess("shipmethod") end if ' mysqltextfield sqlo,"oshipmethodtype",getsess("shipmethod") mysqlnumbfield sqlo,"oshipcost",replace(getsess("smprice"), "$","") mysqlnumbfield sqlo,"otax",getsess("taxes") mysqlnumbfield sqlo,"opst",getsess("pst") '6.5 mysqltextfield sqlo,"ocountry",strcountry mysqltextfield sqlo,"ofax", strfax mysqltextfield sqlo,"ocompany", strcompany mysqltextfield sqlo,"ocomment",strshipcomment mysqltextfield sqlo,"oshipname", getsess("shipname") mysqltextfield sqlo,"oshipaddress",getsess("shipaddress") mysqltextfield sqlo,"oshiptown",getsess("shiptown") mysqltextfield sqlo,"oshipzip", getsess("shipzip") mysqltextfield sqlo,"oshipstate",getsess("shipstate") mysqltextfield sqlo,"oshipcountry",getsess("shipcountry") mysqltextfield sqlo, "oshipcompany", getsess("shipcompany") mysqlnumbfield sqlo, "odiscount", getsess("discount") mysqlnumbfield sqlo, "ohandling", getsess("handling") mysqlnumbfield sqlo, "oaffid", getsess("affid") mysqlnumbfield sqlo, "canceled", 0 ipaddress=request.servervariables("REMOTE_ADDR") mysqltextfield sqlo,"ipaddress",ipaddress mysqlnumbfield sqlo, "hackeryesno",0 mysqltextfield sqlo,"vatnumber",getsess("vatnumber") mysqltextfield sqlo, "oerrors", errors 'write errors to database If getconfig("xdualprice")="Yes" then mysqlnumbfield sqlo,"odualtotal",GetSess("dualtotal") mysqlnumbfield sqlo,"odualshipping",GetSess("dualshipping") mysqlnumbfield sqlo,"odualtaxes",GetSess("dualtaxes") mysqlnumbfield sqlo,"odualpst",GetSess("dualpst") '6.5 mysqlnumbfield sqlo,"odualdiscount",GetSess("dualdiscount") mysqlnumbfield sqlo,"odualhandling",GetSess("dualhandling") end if mysqltextfield sqlo,"coupon", getsess("coupon") ' saved order info mysqlnumbfield sqlo,"coupondiscount", getsess("coupondiscount") ' saved order info mysqlnumbfield sqlo,"coupondiscountdual", getsess("coupondiscountdual") ' saved order info mysqltextfield sqlo,"giftcertificate",getsess("giftcertificate") mysqlnumbfield sqlo,"giftamountused",getsess("giftamountused") mysqlnumbfield sqlo, "giftamountuseddual",getsess("giftamountuseddual") mysqltextfield sqlo,"shipmessage",Getsess("Shipmessage") ' 5.0 mysqltextfield sqlo,"hearaboutus",Getsess("hearaboutus") ' 5.0 mysqltextfield sqlo,"oaddress2",Getsess("address2") ' 5.50 mysqltextfield sqlo,"oshipaddress2",Getsess("shipaddress2") ' 5.50 mysqltextfield sqlo,"deliverydate",Getsess("deliverydate") ' 5.50 mysqltextfield sqlo,"deliverytime",Getsess("deliverytime") ' 5.50 'VP-ASP 6.08a - Product Total wasn't being added mysqlnumbfield sqlo,"producttotal",Getsess("OrderProductTotal") 'VP-ASP 6.50 - add flag to order to say customer has agreed to terms mysqltextfield sqlo,"otermsagreed",Getsess("Licenseagreement") 'VP-ASP 6.50 - add selected currency and exchange rate to order record mysqltextfield sqlo,"ocurrency",Getsess("cid") mysqltextfield sqlo,"ocurrencyrate",Getsess("Conversionvalue") If Getconfig("xcustomerotherfieldsinorder")="Yes" then if getconfig("xcustomerotherfields")<>"" then Mysqlorderupdatefields sqlo end if end if if getconfig("xshippingotherfields")<>"" then Mysqlshippingupdatefields sqlo end if sqlo="update orders " & sqlo & " where orderid=" & oid ' debugwrite sqlo orderdbc.execute(sqlo) SetSess "orderid",oid SetSess "oid", oid ' add Items To Database Dim isql,xdualprice For i = 1 To scartItem supplierid = arrCart(csupplierid,i) if supplierid<>"" and isnumeric(supplierid) then else supplierid = 0 end if xdualprice = arrCart(cdualprice,i) if xdualprice<>"" and isnumeric(xdualprice) then else xdualprice = 0 end if productaddress="NULL" features = arrCart(cProductFeatures,i) if features="" then features="NULL" else features="'" & features & "'" end if if getconfig("XdeliveryAddress")="Yes" then ConvertDeliverytoString arrCart(cDelivery,i), ProductAddress If ProductAddress="" then ProductAddress="NULL" else Productaddress="'" & normalizefield(productaddress) & "'" end if end if 'VP-ASP 6.50 - allow customer to upload image to order isql="insert into oitems (orderid, catalogid, numitems,itemname, customerimage, unitprice,dualprice,supplierid,address,features) " isql = isql & "Values (" isql=isql & oid & "," & arrCart(cProductid,i) & "," & arrCart(cQuantity,i) isql=Isql & ",'" & normalizefield(arrCart(cProductname,i)) & "', '" & arrCart(cgraphicname1,i) & "'," & arrCart(cUnitPrice,i) &"," & xdualprice isql=Isql & "," & supplierid &"," & productaddress & "," & features isql=isql & ")" 'debugwrite isql orderdbc.execute(isql) Next ShopCloseDatabase orderdbc End Sub '************************************************************** ' add gift record to database '************************************************************** Sub MYSQLAddGiftRecord (certificate, email, i ) Dim giftexpires, today dim sqlo, giftid,gsql Dim DoUpdate DoUpdate="" today=date() giftexpires=dateadd("d",date(),getconfig("xgiftexpirydays")) gsql="insert into gifts (giftnumber) values('" & certificate & "')" dbc.execute(gsql) gsql="select max(giftid) from gifts where giftnumber='" & certificate & "'" set objrs=dbc.execute(gsql) giftid=objrs(0) objrs.close set objrs=nothing sqlo="" mysqltextfield sqlo,"giftnumber", certificate mysqltextfield sqlo,"giftissuedate", datenormalize(date()) mysqltextfield sqlo,"giftexpirydate", datenormalize(giftexpires) mysqlnumbfield sqlo,"giftamount", getsess("giftamount") if i = 0 then mysqltextfield sqlo,"gifttoname", getsess("gifttoname") else mysqltextfield sqlo,"gifttoname", email end if mysqltextfield sqlo,"giftfromname", getsess("giftfromname") mysqltextfield sqlo,"gifttoemail", email mysqltextfield sqlo,"giftfromemail", getsess("giftfromemail") mysqltextfield sqlo,"giftmessage", getsess("giftmessage") mysqltextfield sqlo,"giftorderid", getsess("oid") mysqltextfield sqlo,"giftcustomerid", getsess("customerid") mysqlnumbfield sqlo,"giftamountremaining", getsess("giftamount") gsql="update gifts " & sqlo & " where giftid=" & giftid dbc.execute(gsql) SetSess "GiftId",oid end sub Sub MYSQLUpdateOrderDatabase dim i, recordnum, giftproductid Dim strSQl, nameincart NameinCart=getlang("LangGiftCertificate") for i = 0 to Giftcount nameincart=nameincart & "
" & Giftnums(i) next strsql = "update oitems set itemname='" & nameincart & "',numitems=" & giftcount & " where orderid = " & getsess("oid") strsql = strsql & " and catalogid=" & getconfig("xgiftproductid") dbc.execute(strsql) end sub Sub MYSQLGiftDecrementAmountUsed(certificate,amountused, msg) '************************************************************************ ' Update gift certificate amount tto reflect amount used ' Giftused=certificate ' Giftusedamount=amount used" '************************************************************************ Dim myconn, customerid dim strSql msg="" dim giftnumber, giftusedamount, amount, gidtusedtrace, giftusedcount Dim orderid, giftrace Giftnumber=certificate GiftUsedamount=amountused customerid=getsess("Customerid") orderid=getsess("oid") Shopopendatabase myconn strsql="select * from gifts where giftnumber='" & Giftnumber & "'" Set objrs=myconn.execute(strsql) if not objrs.eof then giftrace=objrs("giftusedtrace") giftusedcount=objrs("giftusedcount") amount=objrs("giftamountremaining") objrs.close set objrs=nothing If amount>= amountused then amount=amount-GiftUsedamount giftusedcount=giftusedcount+1 strSQL = "update gifts set " strsql=strsql & " giftamountremaining=" & amount strsql=strsql & ",giftusedlastamount=" & giftusedamount strsql=strsql & ",giftuseddate=" & datedelimit(date()) strsql=strsql & ",giftusedcustomerid=" & customerid strsql=strsql & ",giftusedorderid=" & orderid strsql=strsql & ",giftusedcount=" & giftusedcount If isnull(giftrace) then Giftrace="" else Giftrace=giftrace & ";" end if Giftrace=Giftrace & orderid & "," & giftusedamount strsql=strsql & ",giftusedtrace='" & giftrace & "'" strSql=StrSql & "where giftnumber='" & Giftnumber & "'" ' debugwrite strsql myconn.execute(strsql) shopclosedatabase myconn exit sub else msg=getlang("LangGiftPartlyUsed") msg=msg & " " & shopformatcurrency(amount,xdecimalpoint) end if else msg=getlang("LangGiftNotFound") objrs.close set objrs=nothing end if Shopclosedatabase myconn End sub Sub MYSQLGiftRestoreAmountUsed(certificate,amountused) '************************************************************************ ' Update gift certificate amount tto reflect amount used ' Giftused=certificate ' Giftusedamount=amount used" '************************************************************************ dim myconn dim strSql dim giftnumber, giftusedamount, amount Giftnumber=certificate GiftUsedamount=amountused Shopopendatabase myconn strSQL = "select * FROM gifts where giftnumber='" & Giftnumber & "'" Set objRS = myconn.execute(strsql) If Not objrs.eof then amount=objrs("giftamountremaining") amount=amount+giftusedamount closerecordset objrs strSQL = "update gifts set " strsql=strsql & " giftamountremaining=" & amount strsql=strsql & ",giftamountrused=" & giftusedamount strsql=strsql & ",giftuseddate=" & datenormalize(date()) strsql=strsql & " where giftnumber='" & Giftnumber & "'" myconn.execute(strsql) else closerecordset objrs end if Shopclosedatabase myconn End sub ' '************************************************************** ' search capture '*************************************************************** Sub MYSQLDoSearchCapture '******************************************************** ' Store search results in seach table '******************************************************* dim dbc Dim Subcategories dim servername,sql, id, objrs, sqlo, usql 'on error resume next servername=request.servervariables("HTTP_HOST") ShopOpenOtherDB dbc,getconfig("XSearchDb") sql="insert into searchresults (ipaddress) values('" & servername & "')" dbc.execute(sql) sql="select max(ID) from searchresults where ipaddress='" & servername & "'" set objrs=dbc.execute(sql) id=objrs(0) objrs.close set objrs=nothing sqlo="" ' mysqltextfield sqlo, "categories",strcategory mysqltextfield sqlo,"categories",chosencategory ' getsubcategories subcategories ' mysqltextfield sqlo,"subcategories",subcategories ' mysqltextfield sqlo,"words",strkeyword dim updatesearchstring if allwordsString > "" then updatesearchstring = "ALL: " & allwordsString end if if exactString > "" then if updatesearchstring > "" then updatesearchstring = updatesearchstring & " / " end if updatesearchstring = updatesearchstring & "EXACT: " & exactString end if if atleastString > "" then if updatesearchstring > "" then updatesearchstring = updatesearchstring & " / " end if updatesearchstring = updatesearchstring & "AT LEAST: " & atleastString end if if withoutString > "" then if updatesearchstring > "" then updatesearchstring = updatesearchstring & " / " end if updatesearchstring = updatesearchstring & "WITHOUT: " & withoutString end if mysqltextfield sqlo,"words", updatesearchstring mysqltextfield sqlo,"lastname", getsess("lastname") mysqltextfield sqlo,"customerid", getsess("customerid") mysqltextfield sqlo,"ipaddress", servername mysqltextfield sqlo,"rdate", datenormalize(date()) mysqltextfield sqlo, "rtime",mysqltimenormalize(time()) usql="update searchresults " & sqlo usql=usql & " where id=" & id dbc.execute(usql) ShopCloseDatabase dbc end sub ' Function mysqlTimeNormalize(itime) mysqlTimenormalize=formatdatetime(itime,vbshorttime) end function '****************************************************************** ' additional customer fields '******************************************************************* ' Sub MYSQLCustomerUpdateFields (sqlo) dim words,wordcount,i, customerfieldcount dim cfieldname, fieldvalue if getconfig("xCustomerOtherFields")="" then exit sub redim words(Getconfig("xCustomermaxotherfields")) on error resume next Parserecord getconfig("xcustomerOtherFields"), words, wordcount,"," for i = 0 to wordcount-1 cfieldname="c_" & words(i) fieldvalue=getsess(cfieldname) ' debugwrite words(i) & "=" & fieldvalue If fieldvalue<>"" then mysqltextfield sqlo, words(i),fieldvalue end if next end sub ' Sub MYSQLUpdateRating dim whereok, sqlo dim doupdate, templastname, which dim rsql,rstemp rsql="Insert into reviews (catalogid) Values(" & catalogid & ")" dbc.execute(rsql) rsql="SELECT MAX(id) FROM reviews where catalogid=" & catalogid set rstemp=dbc.execute(rsql) which=rstemp(0) rstemp.close set rstemp=nothing rsql="" sqlo="" mysqlnumbfield sqlo, "catalogid",catalogid mysqlnumbfield sqlo, "rating",ratingstars mysqltextfield sqlo, "title",ratingtitle mysqltextfield sqlo, "comment",ratingcomment mysqltextfield sqlo, "location",ratinglocation mysqltextfield sqlo, "reviewdate",datenormalize(date()) 'VP-ASP 6.09 - added formatdatetime mysqltextfield sqlo, "reviewtime",formatdatetime(time(), vbshorttime) mysqltextfield sqlo, "name",ratingname If getconfig("xratingauthorize")<>"Yes" then mysqltextfield sqlo, "authorized",trim(getlang("LangcommonYes")) end if rsql ="update reviews " & sqlo & " where id=" & which 'debugwrite "rsql=" & rsql dbc.execute(rsql) set rstemp=dbc.execute("select * from reviews where id=" & which) SendMailToMerchant rstemp rstemp.close set rstemp=nothing end sub '********************************************************************* ' Update affiliate '******************************************************************** Sub MYSQLUpdateAffiliate Dim doupdate, sqlo, rso doupdate="" ShopOpenOtherDB dbc,getconfig("xaffiliateDB") If GetSess("affRegister")<>"" then LngAffid=Getsess("AffRegister") SQL="Select * from affiliates Where affid=" & lngaffid OpenRecordset dbc, objrs, sql if not ObjRS.eof then DoUpdate="True" end if closerecordset objrs end if If Doupdate="" then dim templastname templastname=replace(affstrlastname,"'","''") sqlo="insert into affiliates (lastname) values('" & templastname & "')" dbc.execute(sqlo) sqlo="select max(affid) from affiliates where lastname='" & templastname & "'" set rso=dbc.execute(sqlo) lngaffid=rso(0) rso.close set rso=nothing SetSess "AffRegister","" end if sqlo="" mysqltextfield sqlo,"firstname", affstrfirstname mysqltextfield sqlo,"lastname", affstrlastname mysqltextfield sqlo,"address", affstraddress mysqltextfield sqlo,"city", affstrcity mysqltextfield sqlo,"state", affstrstate mysqltextfield sqlo,"postcode", affstrpostcode mysqltextfield sqlo,"country", affstrcountry mysqltextfield sqlo,"company", affstrcompany mysqltextfield sqlo,"phone", affstrphone mysqltextfield sqlo,"website", affstrwebsite mysqltextfield sqlo,"fax", affstrfax mysqltextfield sqlo,"email", affstremail mysqltextfield sqlo,"comment", affstrcomment mysqltextfield sqlo,"typeofpayment", affstrtypeofpayment mysqltextfield sqlo,"bank", affstrbank mysqltextfield sqlo,"bankaccount", affstrbankaccount mysqltextfield sqlo,"bankbranch", affstrbankbranch mysqltextfield sqlo,"bankaddress", affstrbankaddress mysqltextfield sqlo,"bankother", affstrbankother 'mysqltextfield sqlo,"[password]", affstrpassword mysqltextfield sqlo,"password", affstrpassword mysqlnumbfield sqlo, "referralid", lngreferralid if doupdate="" then mysqlnumbfield sqlo,"commissionrate", getconfig("affcommissionrate") mysqltextfield sqlo,"directurl", getconfig("affdirecturl") mysqlnumbfield sqlo,"mastercommissionrate", getconfig("affmastercommissionrate") end if sqlo="Update affiliates " & sqlo & " where affid=" & lngaffid ' debugwrite sqlo dbc.execute(sqlo) shopclosedatabase dbc end sub '********************************************************************** ' update customer record '********************************************************************** Sub MYSQLUpdateCustomer Dim dbc, sqlo, rso Dim DoUpdate, customerid DoUpdate="" 'on error resume next customerid=Getsess("Customerid") dim templastname OpenCustomerDb dbc templastname=replace(strlastname,"'","''") SQL = "SELECT * FROM " & dbtable & " WHERE contactid= " & Customerid Openrecordset dbc, objrs, sql If objrs.eof then closerecordset objrs objrs.close shopclosedatabase dbc Serror="Customer id not found " & customerid exit sub end if sqlo="" mysqltextfield sqlo, "firstname",strfirstname mysqltextfield sqlo, "lastname",strlastname mysqltextfield sqlo, "address",straddress 'VP-ASP 6.091 - add address2 to database mysqltextfield sqlo, "address2",straddress2 mysqltextfield sqlo, "city",strcity mysqltextfield sqlo, "state",strstate mysqltextfield sqlo, "postcode",strpostcode mysqltextfield sqlo, "country",strcountry mysqltextfield sqlo, "phone",strphone mysqltextfield sqlo, "workphone",strworkphone mysqltextfield sqlo, "mobilephone",strmobilephone mysqltextfield sqlo, "website",strwebsite mysqltextfield sqlo, "email",stremail mysqltextfield sqlo, "company",strcompany mysqltextfield sqlo, "hearaboutus",strhearaboutus If ucase(blnmaillist)="FALSE" then blnmaillist=0 If ucase(blnmaillist)="TRUE" then blnmaillist=1 mysqlnumbfield sqlo, "maillist",blnmaillist mysqltextfield sqlo, "Fax",strFax If getconfig("xPassword")="Yes" and strpassword1<>"" then mysqltextfield sqlo,"password", strpassword1 end if if getconfig("xCustomerOtherfields")<>"" then MYSQLCustomerUpdateFields sqlo ' update additional end if sqlo="Update customers " & sqlo & " where contactid=" & customerid 'debugwrite sqlo Set rso=dbc.execute(sqlo) ShopCloseDatabase dbc UpdateCustomerSessionData end sub Sub MYSQLMaillistUpdateCustomer dim dbc, doupdate, rso DoUpdate="" 'on error resume next 'VP-ASP 6.09 - Start Security Fix dim templastname, whereok, sqlo, tempemail OpenCustomerDb dbc templastname=replace(strlastname,"'","''") tempemail=replace(stremail,"'","''") SQL = "SELECT * FROM " & dbtable & " WHERE " whereok="" sql=sql & whereok & " lastname='" & TempLastName & "'" whereok = " AND " SQL = SQL & whereok & " email='" & tempemail & "'" 'VP-ASP 6.09 - End Security Fix openrecordset dbc, objrs, sql if not ObjRS.eof then DoUpdate="True" strcustomerid=objrs("contactid") 'VP-ASP 6.09 - add customerid to session SetSess "customerid", strCustomerID end if closerecordset objrs If Doupdate="" then sqlo="Insert into customers (lastname) VALUES('" & templastname & "')" ' debugwrite sqlo dbc.execute(sqlo) sqlo = "select max(contactid) from customers where lastname='" & templastname & "'" Set rso = dbc.Execute(sqlo) strcustomerid = rso(0) 'VP-ASP 6.09 - add customerid to session SetSess "customerid", strCustomerID rso.close set rso=nothing end if sqlo="" mysqltextfield sqlo, "firstname",strfirstname mysqltextfield sqlo, "lastname",strlastname mysqltextfield sqlo, "address",straddress mysqltextfield sqlo, "city",strcity mysqltextfield sqlo, "state",strstate mysqltextfield sqlo, "postcode",strpostcode mysqltextfield sqlo, "country",strcountry mysqltextfield sqlo, "email",stremail mysqltextfield sqlo, "phone",strphone mysqltextfield sqlo, "workphone",strworkphone mysqltextfield sqlo, "mobilephone",strmobilephone mysqltextfield sqlo, "website",strwebsite mysqltextfield sqlo, "fax",strfax mysqltextfield sqlo, "password",strpassword1 mysqltextfield sqlo, "userid",strcustuserid mysqltextfield sqlo, "contactreason",maillistkey mysqltextfield sqlo, "company",strcompany ' fix july 7 If ucase(blnmaillist)="FALSE" then blnmaillist=0 If ucase(blnmaillist)="TRUE" then blnmaillist=1 mysqlnumbfield sqlo, "maillist",blnmaillist if getconfig("xCustomerOtherfields")<>"" then MYSQLCustomerUpdateFields sqlo ' update additional end if sqlo="Update customers " & sqlo & " Where contactid=" & strcustomerid ' debugwrite sqlo Set rso=dbc.execute(sqlo) ShopCloseDatabase dbc end sub '**************************************************************** ' update product in admin section '***************************************************************** Sub MYSQLUpdateProduct dim sqlo dim rso dim filtersql dim tcname 'VP-ASP 6.09 - unused due to new features selection list 'GetProductFeatures GetCrossSelling2 If ActionType="FIX" then lngcatalogid=GetSess("productID") '========================= 'VP-ASP 600 - insertion of date product was added '12/10/2005 '========================= cdateupdated = now() ' time and date product last updated '========================= else tcname=replace(strcname,"'","''") '========================= 'VP-ASP 600 - insertion of date product was added '12/10/2005 '========================= sqlo="Insert into products (cname,cdateadded,cdateupdated) VALUES('" & tcName & "', " & datedelimit(now()) & ", " & datedelimit(now()) & ")" '========================= myconn.execute(sqlo) sqlo = "SELECT max(catalogid) FROM products where cname='" & tcName & "'" Set rso = myconn.Execute(sqlo) lngCatalogid = rso(0) rso.close set rso=nothing end if sqlo="" mysqltextfield sqlo,"ccode", strccode mysqltextfield sqlo,"cname", strcname mysqltextfield sqlo,"cdescription", memcdescription mysqlnumbfield sqlo,"cprice", curcprice 'mysqlnumbfield sqlo,"ccategory", lngccategory mysqltextfield sqlo,"category", strcategory mysqltextfield sqlo,"features", strfeatures '========================= 'VP-ASP 600 - insertion of page impressions '12/10/2005 '========================= if (strimpressions = "") or (isnull(strimpressions)) then strimpressions = 0 end if mysqltextfield sqlo,"impressions", strimpressions '========================= mysqltextfield sqlo,"cimageurl", strcimageurl 'VP-ASP 6.50 - added extra image fields mysqltextfield sqlo,"extraimage1", strimageextra1 mysqltextfield sqlo,"extraimage2", strimageextra2 mysqltextfield sqlo,"extraimage3", strimageextra3 mysqltextfield sqlo,"extraimage4", strimageextra4 mysqltextfield sqlo,"extraimage5", strimageextra5 mysqltextfield sqlo,"buttonimage", strbuttonimage mysqltextfield sqlo,"cdescurl", strcdescurl ' If datcdateavailable<>"" then datcdateavailable=datenormalize(datcdateavailable) end if mysqltextfield sqlo,"cdateavailable", datcdateavailable mysqlnumbfield sqlo,"cstock", lngcstock mysqltextfield sqlo,"weight", strweight mysqltextfield sqlo,"mfg", strmfg ' mysqltextfield sqlo,"pother1", strpother1 mysqltextfield sqlo,"pother2", strpother2 mysqltextfield sqlo,"pother3", strpother3 mysqltextfield sqlo,"pother4", strpother4 mysqltextfield sqlo,"pother5", strpother5 mysqltextfield sqlo,"level3", strlevel3 mysqltextfield sqlo,"level4", strlevel4 mysqltextfield sqlo,"level5", strlevel5 mysqlnumbfield sqlo,"subcategoryid", lngsubcategoryid mysqltextfield sqlo,"specialoffer", strspecialoffer mysqlnumbfield sqlo,"retailprice", strretailprice mysqltextfield sqlo,"allowusertext", strallowusertext mysqltextfield sqlo,"featuredflag", strfeaturedflag '6.50 mysqltextfield sqlo,"customerimage", strcustomerimage '6.50 mysqltextfield sqlo,"rmadays", strrmadays '6.50 mysqltextfield sqlo,"template", strtemplate '========================= 'VP-ASP 600 - insertion of template for shopdisplayproducts listing '14/10/2005 '========================= mysqltextfield sqlo,"templatelisting", strtemplatelisting '========================= mysqltextfield sqlo,"extendeddesc", memexdesc mysqltextfield sqlo,"extendedimage", strextendedimage mysqltextfield sqlo,"selectlist", strselectlist mysqltextfield sqlo,"keywords", strkeywords mysqltextfield sqlo,"minimumquantity", strminimumquantity mysqlnumbfield sqlo,"supplierid", strsupplierid mysqltextfield sqlo,"crossselling", strcrossselling If boolhide="" then boolhide=0 end if mysqlnumbfield sqlo,"hide", boolhide mysqltextfield sqlo, "clanguage", strclanguage mysqltextfield sqlo, "groupfordiscount", strgroupfordiscount mysqltextfield sqlo,"orderattachment", strattachment mysqltextfield sqlo,"orderdownload", strdownload mysqltextfield sqlo,"customermatch", strcustomermatch mysqltextfield sqlo,"productmatch", strproductmatch mysqlnumbfield sqlo,"points", strpoints mysqlnumbfield sqlo,"pointstobuy", strpointstobuy mysqlnumbfield sqlo,"price2", strprice2 mysqlnumbfield sqlo,"price3", strprice3 mysqlnumbfield sqlo,"maximumquantity", strmaximumquantity mysqltextfield sqlo,"frontpage", strfrontpage mysqlnumbfield sqlo,"billprice",strbillprice mysqlnumbfield sqlo,"billinstallments",strinstallments mysqltextfield sqlo,"billinstallmenttype",strinstallmenttype mysqlnumbfield sqlo,"billinterval",strinstallmentinterval mysqlnumbfield sqlo,"taxfree", strtaxfree ' 5.50 mysqlnumbfield sqlo,"freeshipping", strfreeshipping ' 5.50 mysqlnumbfield sqlo,"highercatalogid", strhighercatalogid ' 6.0 mysqltextfield sqlo,"hassubproduct", strHasSubProduct ' 6.0 mysqltextfield sqlo,"spdisplaytype", strSPDisplayType ' 6.0 if strproductuserid="" then mysqltextfield sqlo,"userid", getsess("shopadmin") ' user that added product else mysqltextfield sqlo,"userid", strproductuserid ' user that added product end if mysqlupdateproductotherfields sqlo sqlo="Update products " & sqlo & " where catalogid=" & lngcatalogid ' debugwrite sqlo myconn.execute(sqlo) SetSess "ProductID",lngCatalogID 'UpdateCategory lngCatalogId, strCategoryList, strsubcategorylist UpdateCategory lngCatalogId, strCategoryList, lngccategory End Sub Sub MYSQLUpdateSupplier Dim doupdate, sqlo, rso doupdate="" OpenCustomerDb dbc If getsess("supplierid")<>"" then strsupplierid=Getsess("Supplierid") Set objRS = Server.CreateObject("ADODB.Recordset") SQL="Select * from suppliers Where supplierid=" & strsupplierid objRS.open SQL, dbc, adOpenKeyset, adLockOptimistic, adcmdText if not ObjRS.eof then DoUpdate="True" objRS.update else objRs.close set objRS=nothing end if end if If Doupdate="" then sqlo="Insert into suppliers (lastname) Values('" & strLastname & "')" dbc.execute(sqlo) sqlo="select max(supplierid) from suppliers where lastname='" & strlastname & "'" set rso=dbc.execute(sqlo) strsupplierid=rso(0) rso.close set rso=nothing end if sqlo="" mysqlupdatesupplierfield sqlo, "supplieruserid",struserid 'mysqlupdatesupplierfield sqlo, "userid",struserid mysqlupdatesupplierfield sqlo, "name",strsuppliername mysqlupdatesupplierfield sqlo, "firstname",strfirstname mysqlupdatesupplierfield sqlo, "lastname",strlastname mysqlupdatesupplierfield sqlo, "address",straddress mysqlupdatesupplierfield sqlo, "city",strcity mysqlupdatesupplierfield sqlo, "state",strstate mysqlupdatesupplierfield sqlo, "postcode",strpostcode mysqlupdatesupplierfield sqlo, "country",strcountry mysqlupdatesupplierfield sqlo, "company",strcompany mysqlupdatesupplierfield sqlo, "phone",strphone mysqlupdatesupplierfield sqlo, "workphone",strworkphone mysqlupdatesupplierfield sqlo, "mobilephone",strmobilephone mysqlupdatesupplierfield sqlo, "fax",strfax mysqlupdatesupplierfield sqlo, "email",stremail mysqlupdatesupplierfield sqlo, "website",strwebsite 'mysqlupdatesupplierfield sqlo, "password",strpassword1 mysqlupdatesupplierfield sqlo, "supplierpassword",strpassword1 sqlo="Update suppliers " & sqlo & " where supplierid=" & strsupplierid dbc.execute(sqlo) setsess "supplierid",strsupplierid shopclosedatabase dbc writeinfomessage end sub Sub mysqlupdatesupplierfield (sql,fieldname,fieldvalue) if fieldvalue="" then fieldvalue=NULL else fieldvalue=replace(fieldvalue,"'","''") end if If sql="" then sql="SET " else sql=sql & "," end if sql = sql & fieldname & "='" & fieldvalue &"'" end Sub '********************************************************************** ' numerous routines acll this routine to either add or update 'a record. if updateaction=nothin then add a record otherwise edit record ' The fields are in the form ' globval dbtable, idfield are necessary '************************************************************************* Sub MYSQLProcessrecord (updateaction, conn, dbtable, idfield, which) If updateaction<>"" then MYSQLEditRecord conn, dbtable, idfield, which else MYSQLAddRecord conn, dbtable, idfield, which end if end sub ' '*************************************************************************** ' know record exists. ' generate sql and update the record '************************************************************ Sub MYSQLEditRecord (conn, dbtable, idfield, which) dim sqltemp, updatesql sqltemp="select * from " & dbtable sqltemp= sqltemp & " where " & idfield & "=" & which set rstemp=conn.execute(sqltemp) MYSQLGenerateEditSQL updatesql rstemp.close set rstemp=nothing on error resume next updatesql ="update " & dbtable & " " & updatesql & " where " & idfield & "=" & which if getconfig("xdebug")="yes" then debugwrite updatesql end if conn.execute(updatesql) sError= sError & "
" & getlang("LangEdit03") & "" end sub ' ******** general Sql Sub MYSQLGenerateEditSQL(updatesql) Dim howmanyfields dim fieldname, fieldvalue, fieldtype dim i updatesql="" howmanyfields=rstemp.fields.count -1 for i=1 to howmanyfields fieldname = rstemp(i).name fieldtype=rstemp(i).type fieldvalue = request.form(fieldname) ' debugwrite "fn=" & fieldname & "ft=" & fieldtype 'VP-ASP 6.09 - check if higercategoryid has been set to categoryID for categories if lcase(dbtable) = "categories" then if lcase(fieldname) = "highercategoryid" then if clng(fieldvalue) = clng(which) then serror=serror & "Higher Category ID is the same as the Category ID! Please change the Higher Category ID for this record.
" end if end if end if 'VP-ASP 6.09 - if fieldtype is TIME then format it before writing to database if fieldtype = 134 then if fieldvalue > "" then fieldvalue = formatdatetime(fieldvalue, vbshorttime) end if end if MYSQLEUpdatefield updatesql,fieldname,fieldvalue,fieldtype next end sub Sub MYSQLEUpdateField (updatesql,fieldname, fieldvalue,fieldtype) 'on error resume next 'Debugwrite fieldname & " value=" & fieldvalue & " fieldtype=" & fieldtype if getconfig("xdebug")="yes" then Debugwrite fieldname & " value=" & fieldvalue & " fieldtype=" & fieldtype end if if fieldname="featuremulti" then mysqladjustfieldNull fieldname,fieldvalue end if If updatesql="" then updatesql="SET " else updatesql= updatesql & "," end if if fieldvalue="" then fieldvalue="NULL" else MYSQLNormalizeFieldValue fieldname, fieldvalue,fieldtype end if updatesql=updatesql & fieldname & "=" & fieldvalue end sub Sub MYSQLAddRecord (conn, dbtable, idfield, which) Dim rso, tempsql Dim sqlo dim fieldname dim fieldvalue dim fieldtype dim thing dim strSQL, sqltemp, howmanyfields, rstemp, i dim xxnames, xxvalues xxnames="" xxvalues="" sqltemp="select * from " & dbtable Set rstemp = Server.CreateObject("ADODB.Recordset") rstemp.open sqltemp, conn, 1, 3 howmanyfields=rstemp.fields.count -1 idfield=rstemp(0).name for i=1 to howmanyfields fieldname = rstemp(i).name fieldtype=rstemp(i).type fieldvalue = request.form(fieldname) MYSQLAAUpdatefield xxnames,xxvalues,fieldname,fieldvalue, fieldtype next rstemp.close set rstemp=nothing sqlo="Insert into "& dbtable & "(" & xxnames & ") values(" & xxvalues & ")" conn.execute(sqlo) strSQL="SELECT MAX(" & idfield & ") FROM " & dbtable set rstemp=conn.execute(strsql) which=rstemp(0) end sub Sub MYSQLAAUpdateField (xxnames, xxvalues,fieldname, fieldvalue, fieldtype) if fieldvalue="" then exit sub end if MYSQLNormalizeFieldvalue fieldname, fieldvalue,fieldtype If xxnames="" then xxnames=fieldname xxvalues=fieldvalue else xxnames=xxnames & "," & fieldname xxvalues=xxvalues & "," & fieldvalue end if end sub Sub MYSQLNormalizeFieldValue (fieldname, Fieldvalue,fieldtype) dim tfieldtype select case fieldtype case "134" fieldvalue = formatdatetime(fieldvalue, vbshorttime) case "133" If isdate(fieldvalue) then fieldvalue=datenormalize(fieldvalue) end if case "6", "4", "5" ' currency exit sub case "11" if isnumeric(fieldvalue) then exit sub If ucase(fieldvalue)="FALSE" then fieldvalue=0 exit sub else fieldvalue=1 end if exit sub Case "16" ' tinyint MYsqlAdjustfieldvalue fieldvalue exit sub end select fieldvalue=replace(fieldvalue,"'","''") fieldvalue="'" & fieldvalue & "'" end sub ' add credit card info to order Sub MYSQLUpdateCreditInfo dim CVN, newcardno, oauthorization, ucardno Dim dbc OpenOrderDB dbc sqltemp="" if strOCardType<> "" then ' Credit card ucardno=strocardno Encryptkey=Getencryptkey If getconfig("xEncryptCreditcard")="Yes" and encryptkey<>"" then newcardno=EnDecrypt(strocardno, encryptkey) ucardno=Converttoplain(newcardno) end if mysqlupdatefield "ocardtype",strocardtype mysqlupdatefield "ocardno",ucardno mysqlupdatefield "ocardname", strocardname mysqlupdatefield "ocardexpires",strocardexpires mysqlupdatefield "ocardaddress", strocardaddress if strOCardCVN<>"" then CVN="CVN " & stroCardCVN oauthorization=cvn end if if strocardissue<>"" Then If oauthorization="" Then oauthorization=getlang("langcardissue") &"=" & strocardissue else oauthorization=" " & oauthorization & " " & getlang("langcardissue") &"=" & strocardissue end if end if if strvalidfrom<>"" then oauthorization=oauthorization & " " & getlang("langvalidfromdate") &"=" & strvalidfrom end if mysqlUpdateField "oauthorization", oauthorization else ' Other payment mysqlupdatefield "ocardtype",stroother mysqlupdatefield "ocardname", stromore paymenturl="" end if sqltemp="update orders " & sqltemp & " where orderid=" & oid 'debugwrite sqltemp dbc.execute(sqltemp) ShopcloseDatabase dbc End Sub Sub mysqlUpdateField (fieldname, fieldvalue) if fieldvalue="" then exit sub end if if sqltemp="" then sqltemp="SET " else sqltemp=sqltemp &"," end if sqltemp=sqltemp & fieldname & "='" & fieldvalue & "'" end sub Function Normalizefield(fieldvalue) Normalizefield = replace (fieldvalue,"'","''") end function Sub FormatMonthChilli month=cint(month) if Year="0" then Year=Datepart("yyyy",date()) else Year=clng(year) end if fromdate= month & "/1" & "/" & Year month=month+1 if month = 13 then month=1 Year=Year+1 end if Todate= month & "/1" & "/" & Year 'debugwrite "fromdate=" & fromdate 'debugwrite "todate=" & todate fromdate=cdate(fromdate) todate=cdate(todate) todate = dateadd("d",-1, todate) end sub Sub formatYearChilli Year=clng(year) month=1 fromdate= month & "/" & "01/" & Year Year=Year+1 Todate= month & "/01/" & Year fromdate=cdate(fromdate) todate=cdate(todate) todate=dateadd("d",-1,todate) end sub Sub mysqlUpdateStockLevels (catalogid, quantity,stockconn) dim rsproduct, sql dim myconn dim stock sql ="select cstock from products where catalogid=" & catalogid set rsproduct=stockconn.execute(sql) If rsproduct.eof then rsproduct.close set rsproduct=nothing exit sub else stock=rsproduct("cstock") stock=stock-quantity end if rsproduct.close set rsproduct=nothing sql="update products set cstock=" & stock & " where catalogid=" & catalogid stockconn.execute(sql) end sub Sub MYSQLUpdateCategory (dbc) Dim doupdate, sqlo, rso, filtersql doupdate="" If updateaction<>"" then doupdate="True" infomsg= strcatdescription & getlang("LangProductUpdated") & " - " & GetSess("CategoryID") & "
" lngcategoryid=getsess("categoryid") end if If Doupdate="" then sqlo="Insert into categories (catdescription) Values('" & strcatdescription & "')" ' debugwrite sqlo dbc.execute(sqlo) sqlo="select max(categoryid) from categories where catdescription='" & strcatdescription & "'" set rso=dbc.execute(sqlo) lngcategoryid=rso(0) rso.close set rso=nothing Setsess "categoryID",lngcategoryid Infomsg= strcatdescription & getlang("LangProductAdded") & " - " & GetSess("categoryID") & "
" end if sqlo="" mysqltextField sqlo,"catdescription",strcatdescription mysqltextField sqlo,"catimage",strcatimage mysqlnumbField sqlo,"highercategoryid",lnghighercategoryid mysqltextField sqlo,"hassubcategory",strcathassubcategory mysqltextField sqlo,"catextra",strcatextra 'VP-ASP 6.50 - extra category fields mysqltextField sqlo,"catextra2",strcatextra2 mysqltextField sqlo,"catextra3",strcatextra3 mysqltextField sqlo,"cathide",strcathide mysqltextField sqlo,"productmatch",strcatproductmatch mysqltextField sqlo,"customermatch",strcatcustomermatch mysqltextField sqlo,"catmemo",strcatmemo mysqltextField sqlo,"catlanguage",strcatlanguage mysqltextField sqlo,"catproducttemplate",strcattemplate sqlo="Update categories " & sqlo & " where categoryid=" & lngcategoryid ' debugwrite sqlo dbc.execute(sqlo) end sub Sub MYSQLUpdateREgistrant() Dim dbc, sqlo, rso Dim DoUpdate DoUpdate="" 'on error resume next OpenCustomerDb dbc If GetSess(REGISTRANTID)<>"" then Set objRS = Server.CreateObject("ADODB.Recordset") sql="select * from registrant where registrantid=" & getsess(REGISTRANTID) set objrs=dbc.execute(sql) if not ObjRS.eof then DoUpdate="True" end if CloseRecordset objRs end if If Doupdate="" then sqlo="insert into registrant (lastname) values('" & strlastname & "')" ' debugwrite sqlo dbc.execute(sqlo) sqlo = "select max(registrantid) from registrant where lastname='" & strlastname & "'" Set rso = dbc.Execute(sqlo) Setsess REGISTRANTID, rso(0) CloseRecordset rso end if sqlo="" 'VP-ASP 6.09 - normalize date streventdateend=datenormalize(dateadd("d",cdate(streventdate),xgiftregdays)) mysqltextfield sqlo,"eventtype",streventtype mysqltextfield sqlo,"eventdate",streventdate mysqltextfield sqlo,"eventdateend",streventdateend mysqltextfield sqlo,"lastname",strlastname mysqltextfield sqlo,"copostcode",costrpostcode mysqltextfield sqlo,"sendfirstname",sendstrfirstname mysqltextfield sqlo,"sendaddress",sendstraddress mysqltextfield sqlo,"firstname",strfirstname mysqltextfield sqlo,"address",straddress mysqltextfield sqlo,"sendpostcode",sendstrpostcode mysqltextfield sqlo,"sendphone",sendstrphone mysqltextfield sqlo,"city",strcity mysqltextfield sqlo,"cofirstname",costrfirstname mysqltextfield sqlo,"cocountry",costrcountry mysqltextfield sqlo,"state",strstate mysqltextfield sqlo,"postcode",strpostcode mysqltextfield sqlo,"country",strcountry mysqltextfield sqlo,"costate",costrstate mysqltextfield sqlo,"cophone",costrphone mysqltextfield sqlo,"phone",strphone mysqltextfield sqlo,"coaddress",costraddress mysqltextfield sqlo,"email",stremail mysqltextfield sqlo,"sendcity",sendstrcity mysqltextfield sqlo,"sendcountry",sendstrcountry mysqltextfield sqlo,"colastname",costrlastname mysqltextfield sqlo,"cocity",costrcity mysqltextfield sqlo,"sendlastname",sendstrlastname 'mysqltextfield sqlo,"thankyou",strthankyou mysqltextfield sqlo,"sendstate",sendstrstate mysqltextfield sqlo,"shippingtype",shippingtype 'mysqltextfield sqlo,"publicallowed",strpublicallowed sqlo="update registrant " & sqlo & " where registrantid=" & getsess(REGISTRANTID) 'debugwrite sqlo Set rso=dbc.execute(sqlo) ShopCloseDatabase dbc end sub Sub MYSQLUpdateRegistrantPass dim regid, dbc shopopendatabase dbc regid=GetSess(REGISTRANTID) If strpublicpass="" then strpublicPASS="NULL" else strPublicPass="'" & strpublicpass & "'" end if If strprivatepass="" then strprivatePASS="NULL" else strPrivatePass="'" & strprivatepass & "'" end if If strthankyou="" then strthankyou="NULL" else strthankyou=replace(strthankyou,"'","''") strthankyou="'" & strthankyou & "'" end if if strpublicallowed="" then strpublicallowed=0 else strpublicallowed=1 end if sql="Update registrant set regpassword=" & strprivatepass sql= sql & ",publicpassword=" & strpublicpass sql= sql & ",thankyounote=" & strthankyou sql= sql & ",publicallowed=" & strpublicallowed sql=sql & " where registrantid=" & getsess(REGISTRANTID) debugwrite sql dbc.execute(sql) ShopCloseDatabase dbc end sub '************************************************************** ' if therea re customer other fields, then add them to the order '*************************************************************** Sub MysqlOrderUpdateFields (sqlo) dim words,wordcount,customervalues,i, customerfieldcount dim cfieldname, fieldvalue on error resume next if getconfig("xCustomerOtherFields")="" then exit sub redim words(Getconfig("xCustomermaxotherfields")) Parserecord getconfig("xcustomerOtherFields"), words, wordcount,"," for i = 0 to wordcount-1 cfieldname="c_" & words(i) fieldvalue=getsess(cfieldname) If fieldvalue<> "" then mysqltextfield sqlo,Words(i), fieldvalue end if next end sub '****************************************************************** ' Update other fields in product add '***************************************************************** Sub MysqlUpdateProductOtherFields (sqlo) dim words(50),wordcount,i if getconfig("xProductOtherFields")="" then exit sub If not isarray(Productvalues) then exit sub Parserecord getconfig("xProductOtherFields"), words, wordcount,"," for i = 0 to wordcount-1 If productvalues(i)<> "" then mysqltextfield sqlo, words(i),productvalues(i) end if next end sub Sub MysqlShippingUpdateFields (sqlo) dim words,wordcount,shippingvalues,i, shippingfieldcount dim cfieldname, fieldvalue on error resume next if getconfig("xShippingOtherFields")="" then exit sub redim words(Getconfig("xCustomermaxotherfields")) Parserecord getconfig("xshippingOtherFields"), words, wordcount,"," for i = 0 to wordcount-1 cfieldname="s_" & words(i) fieldvalue=getsess(cfieldname) If fieldvalue<> "" then mysqltextfield sqlo, words(i),fieldvalue end if next end sub Sub MYsqlAdjustfieldvalue (fieldvalue) dim yesvalue yesvalue=trim(getlang("langcommonyes")) If isnumeric(fieldvalue) then exit sub If Fieldvalue=yesvalue then fieldvalue=1 else fieldvalue=0 end if end sub '*********************************************************************** ' Because we now do yes/no '********************************************************************* sub mysqladjustfieldNull (fieldname,fieldvalue) 'If value is Yes then leave otherwise set to null dim novalue novalue=trim(getlang("langcommonNo")) If fieldvalue=Novalue then fieldvalue="" end if end sub '************************************************************ ' Update coupon at end of order '********************************************************** Sub MysqlUpdatecoupon dim objrs, sql, dbc, sqlo, usecount Shopopendatabase dbc sql="select * from coupons where couponname='" & getsess("coupon") &"'" set objRS=dbc.execute(sql) if not ObjRS.eof then usecount=objrs("couponusedcount") if isnull(usecount) then usecount=0 end if usecount=usecount+1 end if if usecount = "" then usecount = 0 end if closerecordset objrs sql="Update coupons set couponusedcount=" & usecount sql= sql & ",couponlastuseddate=" & datedelimit(date()) dbc.execute(sql) shopclosedatabase dbc end sub '********************************************************************** ' Update commission for order '****************************************************************** Sub mysqlupdatecommission (conn, commission, orderid) dim sql sql="update orders set commission=" & commission sql=sql & " where orderid=" & orderid conn.execute(sql) end sub 'VP-ASP 6.00 Sub MYSQLShopAddRegistry (oid) Dim arrCart, scartItem Dim dbc Dim i dim newdate, newtime dim rsitem dim SQLo arrCart = GetSessA("cartarray") ' get shopping cart data scartItem = GetSess("cartcount") ShopOpenDatabase dbc For i = 1 To scartItem sqlo = "insert into registryitems (registrantid, orderid, regcatalogid, numitems, itemname, unitprice, dualPrice, supplierid, numpurchased) " sqlo = sqlo & "values (" & getsess(REGISTRANTID) & ", " & oid & ", " & arrCart(cProductid,i) & ", " & arrCart(cQuantity,i) & ", '" & replace(arrCart(cProductname,i), "'", "''") & "', '" & arrCart(cUnitPrice,i) & "', '" & arrCart(cdualprice,i) & "', " If IsNumeric (arrCart(csupplierid,i)) then sqlo = sqlo & arrCart(csupplierid,i) & ", " else sqlo = sqlo & "0, " end if sqlo = sqlo & "0)" dbc.execute(sqlo) Next 'Set the order number in the registrant record. sql = "UPDATE registrant SET regorderid = " & oid & " WHERE registrantid = " & getsess(REGISTRANTID) dbc.execute sql ShopCloseDatabase dbc End Sub '******************************************************************* ' navigation menu '******************************************************************** Sub Mysqlupdatemenu dim menuitemid, conn, sqlo sqlo="" shopopendatabase conn menuitemid=getsess("menuitemid") 'VP-ASP 6.50 - precautionary security fix mysqltextfield sqlo,"name",cleanchars(request.form("name")) mysqltextfield sqlo,"contentid",cleanchars(request.form("contentpage")) mysqltextfield sqlo,"url",cleanchars(request.form("url")) mysqltextfield sqlo,"seq",cleanchars(request.form("seq")) mysqltextfield sqlo,"pmenuitemid",cleanchars(request.form("pmenuitemid")) mysqltextfield sqlo,"openin",cleanchars(request.form("openin")) 'VP-ASP 6.50 - productmatch menus mysqltextfield sqlo,"productmatch",cleanchars(request.form("productmatch")) sqlo="update menuitem " & sqlo & " where id=" & menuitemid debugwrite sqlo conn.execute(sqlo) shopclosedatabase conn end sub '*************************************************************************** 'Insert A new menu item ' First insert a new record then do normal update '************************************************************************** Sub Mysqladdmenu dim menuitemid, conn, sqlo, formname, rso sqlo="" 'VP-ASP 6.50 - precautionary security fix formname=cleanchars(request.form("name")) shopopendatabase conn sqlo="insert into menuitem (name) values('" & formname & "')" conn.execute(sqlo) debugwrite sqlo sqlo = "select max(id) from menuitem where name='" & formname & "'" Set rso = conn.Execute(sqlo) menuitemid = Clng(rso(0)) closerecordset rso setsess "menuitemid",menuitemid shopclosedatabase conn Mysqlupdatemenu end sub %>