<%option explicit%> <% '************************************************************************** ' Version 4.50 June 2, 2002 ' This routines does quite a lot ' sets up e-mail messages for merchant and customer ' Updates stock ' Adds points ' calculated affiliate commission ' updates gifts ' mails to suupliers ' updates project payments ' updates session variables to clear order details ' This is final file in order process ' calls shopthanksmerchant, shopmailformat and shopmail ' calls giftmailing, stock control. '************************************************************************** Dim maillist(20) Dim Maillistcount Dim Textarray(500) Dim TextCount dim my_system dim my_from dim my_fromAddress dim my_subject dim my_to dim my_toAddress Dim attachmentarray(20),attachmentcount dim htmlformat Dim arrCart, scartItem dim mailtype dim body Dim merchant Dim customer dim ordernumber Dim myconn Dim attachmentfile Dim returnlocation Dim Merchantemailformat,customeremailformat ' used to add extra information to messages from shopthanksmerchnat dim merchantextraInfo, CustomerExtraInfo ' dim affiliateid ' Logic ordernumber=Getsess("oid") if ordernumber="" then ' ordernumber=Request("oid") If ordernumber="" then Response.Redirect "shoperror.asp?msg=" & Server.URLEncode (LangShopThanks03) end if end if attachmentcount=0 Setsess "emailformat",getconfig("xemailformat") Merchantemailformat="" Customeremailformat="" Merchantextrainfo="" Customerextrainfo="" ' ShopPageHeader ' Normal shop header ' OpenOrderDB myconn ' Open database ShopThanksLinks myconn, ordernumber, attachmentarray,attachmentcount ' if there is a merchane email address then do the stuff ShopThanksMerchant myconn, ordernumber Shoppinnumbers myconn, ordernumber DisplayOrderNumber myconn ' Display the order number sql = "select * from orders where orderid=" & clng(ordernumber) Set rsorder = myconn.Execute(SQL) affiliateid=rsorder("oaffid") ' get affilaite If getconfig("xemailname")<>"" then ' this is name to email strSQL = "select * FROM oitems where orderid = " & rsorder("orderid") Set Items = myconn.Execute(strSQL) ' get the record st for order and order items If getconfig("xemailwithtemplates")="Yes" then TemplateFormatMail rsorder, items, merchant, customer ' format the mail message else FormatMail rsorder, items, merchant, customer ' format the mail message end if SetupmailMerchant ' Setup Aspmail or Cdonts etc SetupmailCustomer items.close set items=nothing end if ShopGiftControl ' Giftceritificate e-mails MailToSuppliers MailtoGiftRegistry CloseRecordset rsorder ShopStockControl ' Update stock if necessary ShopCouponControl ' Update stock if necessary ShopProjectControl ' update project payments ShopCommissionControl ' calculate commission ShopCancelOrder ' WriteMailError If getconfig("xFrames")="Yes" Then response.write "" else ShopPageTrailer end if ShopCloseDatabase myconn ' Close the database ' '*****DisplayorderNumber Sub DisplayOrderNumber(conn) %>

<%=getconfig("xfont")%><%=LangShopthanks01%> <% ShopFormatOrder conn, ordernumber, "NoAdmin" If getconfig("xFrames")="Yes" Then returnlocation=getconfig("xhome1") else returnlocation="shopend.asp" end if %>

<% end sub ' Sub MailPerson (toname, toaddress, fromname, fromaddress, subject, tobody,attachmentYesNo) dim acount SetSess "mailerror","" my_system=getconfig("xemailsystem") ' mail.mysystem.com mailtype=getconfig("xemailtype") ' aspmail, jmail, cdonts my_subject=subject my_to=toname my_toAddress=toaddress my_from=fromname my_fromAddress=fromaddress if my_toAddress= "" then exit sub end if if my_from = "" then my_from="Unknown" end if if my_fromAddress="" then my_fromAddress="unknown@unknown.com" end if body=tobody if getconfig("xDebug")="Yes" then debugwrite "mailing to " & toname & " " & toaddress end if htmlformat=Getsess("EmailFormat") If attachmentYesNo="Yes" then acount=attachmentcount else acount=0 end if ExecuteMail mailtype,My_from,my_fromaddress,my_to,my_toaddress,my_subject,body,htmlformat,attachmentarray,acount writemailerror end sub Sub SetupMailMerchant() dim subject if getconfig("Xemailmerchant")<>"Yes" then exit sub If merchantemailformat<>"" then SetSess "emailformat",merchantemailformat end if If merchantextrainfo<>"" then merchant=merchant & merchantextrainfo end if subject=getconfig("xemailsubject") & " " & langproductordernumber & " " & ordernumber MailPerson getconfig("xemailname"),getconfig("xemail"),rsorder("olastname"), rsorder("oemail"), subject, Merchant,"No" end sub Sub SetupMailCustomer() if getconfig("Xemailcustomer")<>"Yes" then exit sub If customeremailformat<>"" then SetSess "emailformat",customeremailformat end if dim toname, subject toname=rsorder("ofirstname") & " " toname= toname & rsorder("olastname") ' this is name to email 'debugwrite "toname=" & toname subject=getconfig("xemailsubject") & " " & langproductordernumber & " " & ordernumber If customerextrainfo<>"" then customer=customer & customerextrainfo end if MailPerson toname,rsorder("oemail"),getconfig("xemailname"), getconfig("xemail"), subject, Customer,"Yes" end sub ' ' Stock control logic Sub ShopStockControl on error resume next if ucase(getconfig("xstockControl"))="YES" Then UpdateStock ordernumber end if end sub ' Sub ShopCouponControl If GetSess("Coupon")<>"" then UpdateCoupon end if end sub Sub ShopGiftControl If GetSess("Giftid")<>"" then ShopGiftmail ordernumber ' mail gift cerificates in shopgiftdb.asp end if end sub Sub MailToSuppliers if getconfig("xmailtosuppliers")="Yes" then Shopmailtosuppliers end if end sub Sub WriteMailError If GetSess("Mailerror")="" then exit sub If getconfig("xDebug")<>"Yes" then exit sub response.write getconfig("xfont") & GetSess("mailerror") & "
" end sub ' Sub MailToGiftregistry if getconfig("xgiftregistry")<>"Yes" then exit sub ProcessGiftRegistryEmails end sub ' Sub Shopprojectcontrol if getconfig("xprojectupdate")<>"Yes" then exit sub UpdateProjectpayment myconn, ordernumber end sub Sub ShopCommissionControl ' Calculate affiliate commission if not isnull(affiliateid) then if affiliateid>0 then shopthankscommission myconn, ordernumber, affiliateid end if end if end sub %>