<% '******************************************************* ' VP-ASP 5.00 Gift subroutines ' May 30, 2003 ' Sept 26 2003 fix case '******************************************************* Dim lngGiftid Dim datGiftissuedate Dim datGiftexpirydate Dim curGiftamount Dim strGifttoname Dim strGiftfromname Dim strGifttoemail Dim strGiftfromemail Dim strGiftmessage Dim strGiftother Dim datGiftused Dim lngGiftusedcustomerid Dim lngGiftusedorder Dim strGiftauthorized dim curGiftAmountremaining dim stremails, Giftcount Dim Giftnums(50),giftarray(50) '********************************************************************* ' add Gift records to database for a specific order ' VP-ASP 6.50 ' Feb 4, 2003 '******************************************************************* sub GiftAddToDatabase dim i Shopopendatabase dbc oid=Getsess("oid") GenerateGiftNumbers For i = 0 to giftcount-1 AddGiftRecord giftnums(i), giftarray(i), i next shopclosedatabase dbc OpenOrderDb dbc UpdateOrderDatabase ShopCloseDatabase dbc end sub ' Sub AddGiftRecord (certificate, email, i ) 'VP-ASP 6.50 - broadened defintion of IF statement to cover cases where xmysql hasn't been set if ucase(xdatabasetype) = "MYSQL" OR ucase(xdatabasetype) = "MYSQL351" OR getconfig("xMYSQL")="Yes" then MYSQLAddGiftRecord certificate, email, i exit sub end if Dim giftexpires, today Dim DoUpdate DoUpdate="" today=date() giftexpires=dateadd("d",date(),getconfig("xgiftexpirydays")) Set objRS = Server.CreateObject("ADODB.Recordset") objRS.open "Gifts", dbc, adOpenKeyset, adLockOptimistic, adCmdTable objRS.AddNew updategiftfield "giftnumber", certificate updategiftfield "giftissuedate", date() updategiftfield "giftexpirydate", giftexpires updategiftfield "giftamount", getsess("giftamount") if i = 0 then updategiftfield "gifttoname", getsess("gifttoname") else updategiftfield "gifttoname", email end if updategiftfield "giftfromname", getsess("giftfromname") updategiftfield "gifttoemail", email updategiftfield "giftfromemail", getsess("giftfromemail") updategiftfield "giftmessage", getsess("giftmessage") updategiftfield "giftorderid", getsess("oid") updategiftfield "giftcustomerid", getsess("customerid") updategiftfield "giftamountremaining", getsess("giftamount") objRS.Update objRS.close set objrs=nothing SetSess "GiftId",oid end sub ' Sub UpdateGiftField (fieldname,fieldvalue) on error resume next if fieldvalue="" then exit sub end if If getconfig("xdebug")="Yes" then Debugwrite fieldname & " " & fieldvalue & "
" end if objRS(fieldname)=fieldvalue end Sub Sub UpdateOrderDatabase 'VP-ASP 6.50 - broadened defintion of IF statement to cover cases where xmysql hasn't been set if ucase(xdatabasetype) = "MYSQL" OR ucase(xdatabasetype) = "MYSQL351" OR getconfig("xMYSQL")="Yes" then MYSQLUpdateOrderDatabase exit sub end if dim i Dim strSQl, nameincart NameinCart= getlang("LangGiftCertificate") for i = 0 to Giftcount nameincart=nameincart & "
" & Giftnums(i) next strSQL = "select * FROM oitems where orderid = " & Getsess("oid") Set objRS = Server.CreateObject("ADODB.Recordset") objRS.open strsql, dbc, adOpenKeyset, adLockOptimistic, adCmdText If Not objrs.eof then objrs("itemname")=NameinCart objrs("numitems")=Giftcount end if objrs.update objrs.close set objrs=nothing end sub Sub GenerateGiftNumbers dim prefix, hh,mm,ss,oid, giftnum, stremails, mytime prefix=getconfig("xGiftPrefix") oid=Getsess("Oid") mytime=now() hh=hour(mytime) mm=minute(mytime) ss=Second(mytime) Giftcount=1 Giftnum=prefix &"-" & hh &mm &ss & "0" & "-" & Oid Giftnums(0)=Giftnum Giftarray(0)=Getsess("GifttoEmail") stremails=getsess("Giftotheremails") if strEmails="" then exit sub end if dim words(20),wordcount, delimiter,i delimiter="," ParseRecord stremails,words,wordcount,delimiter For i = 0 to wordcount-1 Giftnum=prefix &"-" & hh &mm &ss & Giftcount &"-" & Oid Giftnums(giftcount)=Giftnum Giftarray(giftcount)=words(i) giftcount=giftcount+1 next end sub '********************************************************************** ' Delete Gift records '********************************************************************** Sub GiftDeleteCertificates dim oid, dbc Shopopendatabase dbc oid=Getsess("oid") if oid="" then exit sub dbc.execute "delete from gifts where giftorderid = " & clng(getsess("oid")) shopclosedatabase dbc end sub Sub GiftAddToCart dim strdualprice dim Price, arrcart,scartitem, count, totalprice, nameincart Price=Getsess("Giftamount") Count=Getsess("Giftcount") NameinCart= getlang("LangGiftCertificate") arrCart = GetSessA("CartArray") scartitem=1 SetSess "CartCount",scartitem arrCart(cProductid,scartItem) = getconfig("xGiftProductId") arrCart(cProductCode,scartItem) = 1 arrCart(cProductname,scartItem) = NameInCart arrCart(cQuantity,scartItem) = giftcount arrCart(cOriginalPrice,scartItem) = Price arrCart(cUnitPrice,scartItem) = Price 'VPASP 6.50 - Remove Images from Cart arrCart(cProductimage,scartItem) = "" if getconfig("XdualPrice")="Yes" then Convertcurrency Price, strDualPrice arrCart(cDualPrice,scartItem) = strDualprice else arrCart(cDualPrice,scartItem) = 0 end if arrCart(cDelivery,scartItem) = "" SetSessA "CartArray",arrCart TotalPrice=Price*count SetSess "Ordertotal",totalprice SetSess "OrderProducttotal",totalprice end sub '************************************************************ ' mail to all gift holders for this order ' database is assumed opened with dbc=open database '************************************************************ Sub ShopGiftMail (orderid) Dim oid, giftsql, giftmessage, gifts(50), i, giftcount dim template,giftid, giftrs, myconn dim attachyesno attachyesno="No" Shopopendatabase myconn template=getconfig("xgifttemplate") if template="" then exit sub Oid=orderid giftcount=0 giftsql="select * from gifts where giftorderid=" & oid set giftrs=myconn.execute(Giftsql) do while not giftrs.eof FormatOtherMail template, giftrs, GiftMessage strgifttoname = giftrs("gifttoname") strgiftfromname = giftrs("giftfromname") strgifttoemail = giftrs("gifttoemail") strgiftfromemail = giftrs("giftfromemail") mailPerson strGiftToname, strgifttoemail, strgiftfromname, strgiftfromemail, getlang("LangGiftCertificate"), GiftMessage,attachyesno 'Debugwrite strGifttoname & " " & Giftmessage If getconfig("xdebug")="Yes" then Debugwrite "Gift certificate send to " & strGifttoemail & " from " & strgiftfromemail end if gifts(giftcount)=giftrs("giftid") ' save for autoenable giftcount=giftcount+1 giftrs.movenext loop giftrs.close set giftrs=nothing If getconfig("xGiftAutoEnable")="Yes" Then for i = 0 to giftcount-1 giftsql="update gifts set giftauthorized = 'Yes' where giftid=" giftsql=giftsql & Gifts(i) myconn.execute(giftsql) next end if shopclosedatabase myconn end sub Sub GiftDecrementAmountUsed(certificate,amountused, msg) '************************************************************************ ' Update gift certificate amount tto reflect amount used ' Giftused=certificate ' Giftusedamount=amount used" '************************************************************************ 'VP-ASP 6.50 - broadened defintion of IF statement to cover cases where xmysql hasn't been set if ucase(xdatabasetype) = "MYSQL" OR ucase(xdatabasetype) = "MYSQL351" OR getconfig("xMYSQL")="Yes" then MYSQLGiftDecrementAmountUsed certificate,amountused, msg exit sub end if Dim myconn, customerid dim strSql msg="" dim giftnumber, giftusedamount, amount, giftusedtrace, giftusedcount Dim orderid, giftrace Giftnumber=certificate GiftUsedamount=amountused customerid=getsess("Customerid") orderid=getsess("oid") Shopopendatabase myconn 'debugwrite "updating " & certificate & " " & amountused strSQL = "select * FROM gifts where giftnumber='" & Giftnumber & "'" Set objRS = Server.CreateObject("ADODB.Recordset") objRS.open strsql, myconn, adOpenKeyset, adLockOptimistic, adCmdText If Not objrs.eof then amount=objrs("giftamountremaining") giftrace=objrs("giftusedtrace") giftusedcount=objrs("giftusedcount") amountused=csng(amountused) If amount>= amountused then amount=amount-GiftUsedamount objrs("giftamountremaining")=amount objrs("giftusedlastamount")=giftusedamount objrs("giftuseddate")=date() objrs("giftusedcustomerid")=customerid objrs("giftusedorderid")=orderid giftusedcount=giftusedcount+1 objrs("GiftUsedcount")=giftusedcount If isnull(giftrace) then Giftrace="" else Giftrace=giftrace & ";" end if Giftrace=Giftrace & orderid & "," & giftusedamount objrs("giftusedtrace")=giftrace objrs.update else msg= getlang("LangGiftPartlyUsed") msg=msg & " " & shopformatcurrency(amount,getconfig("xdecimalpoint")) end if else msg= getlang("LangGiftNotFound") end if objrs.close set objrs=nothing Shopclosedatabase myconn End sub Sub GiftRestoreAmountUsed(certificate,amountused) '************************************************************************ ' Update gift certificate amount tto reflect amount used ' Giftused=certificate ' Giftusedamount=amount used" '************************************************************************ 'VP-ASP 6.50 - broadened defintion of IF statement to cover cases where xmysql hasn't been set if ucase(xdatabasetype) = "MYSQL" OR ucase(xdatabasetype) = "MYSQL351" OR getconfig("xMYSQL")="Yes" then MYSQLGiftRestoreAmountUsed certificate,amountused exit sub end if dim myconn dim strSql dim giftnumber, giftusedamount, amount Giftnumber=certificate GiftUsedamount=amountused Shopopendatabase myconn strSQL = "select * FROM gifts where giftnumber='" & Giftnumber & "'" Set objRS = Server.CreateObject("ADODB.Recordset") objRS.open strsql, myconn, adOpenKeyset, adLockOptimistic, adCmdText If Not objrs.eof then amount=objrs("GiftAmountRemaining") amount=amount+GiftUsedamount objrs("giftamountremaining")=amount objrs("giftusedlastamount")=giftusedamount objrs("giftuseddate")=date() objrs.update end if objrs.close set objrs=nothing Shopclosedatabase myconn End sub Sub ShopValidateGiftCertificate (gift,msg) dim objrs, strsql, normexpiry, normtoday dim today, dbc Shopopendatabase dbc strSQL = "select * FROM gifts where giftnumber='" & replace(Gift,"'","") & "'" set objrs=dbc.execute(strsql) if objrs.eof then msg= getlang("LangGiftNotFound") &"
" else strGiftauthorized=objrs("giftauthorized") datgiftexpirydate=objrs("giftexpirydate") curGiftAmountRemaining=objrs("giftamountremaining") end if objrs.close set objrs=nothing shopclosedatabase dbc if msg<>"" then exit sub If isnull(strGiftAuthorized) then msg= getlang("LangGiftNotAuthorized") & "
" exit sub end if normexpiry=Datedelimit(datgiftexpirydate) normtoday=Datedelimit(date()) If normtoday>normexpiry then msg= getlang("LangGiftExpired") & "
" end if If CurGiftamountremaining<=0 then msg= getlang("LangGiftUsed") exit sub end if SetSess "giftamountmax",curgiftamountremaining SetSess "giftcertificate",gift end sub %>