<%option explicit%> <% ShopCheckAdmin "shopa_editdisplay.asp" '*****************************************************" ' Version 6.50 March 8, 2004 ' mails to selected customers ' Check maillist field in customers table to see if person ' should receive mail. ' Oct 23, 2004 support db=xxx for templates '******************************************************* Dim validtables validtables=array("customers","affiliates","projects","orders","suppliers") Dim RSTable ' mailing stuff dim my_system dim my_from dim my_fromAddress dim my_subject dim my_to dim my_toAddress dim mY_attachment dim Emailformat Dim EmailFilename dim attachmentfilename,pos dim body Dim Msg Dim mailtype Dim mailer Dim MailList Dim myconn dim dbTable Dim Idfield Dim Allrecords Dim mailrs dim mailsql Dim firstname Dim Lastname Dim emailUseTemplate, mergerecords '************************************************************************** ' Session Variables are used ' Session (table") = table to open ' Session ("db")= database ' Session ("EmailBody") = body Text '************************************************************************** Dim rc Serror="" AdminPageHeader GenerateDisplayHeader "Mailing" GenerateDisplayBodyHeader Response.write "" Response.Flush GetSessionVariables rc ' see what we must do if rc=0 then EditOpenDatabase myconn, database, dbtable ' open database if Allrecords="" then MailSelectedRecords else MailAllRecords end if ShopCloseDatabase myconn end if if serror > "" then shopwriteerror sError end if Response.write "" GenerateDisplayBodyFooter AdminPageTrailer ' Sub GetSessionVariables (rc) dim yesans yesans=ucase(replace(getlang("langcommonyes")," ","")) rc=0 my_from=GetSess("EmailFromName") my_Fromaddress=GetSess("EmailFromAddress") my_system=getconfig("xemailsystem") mailtype=GetSess("EmailType") ' ASPmail, CDONTS, JMail my_subject=GetSess("Emailsubject") body=GetSess("EmailBody") Emailformat=Getsess("EmailFormat") Emailfilename=Getsess("EmailFilename") attachmentfilename=Getsess("attachmentfilename") if attachmentfilename<>"" then pos=Instr(attachmentfilename,":") if pos=0 then attachmentfilename=Server.mappath(attachmentfilename) end if end if emailUseTemplate=Getsess("EmailUseTemplate") If emailusetemplate=trim(getlang("Langcommonyes")) then mergerecords="Yes" else mergerecords="No" end if MailList=Getsess("MailList") database=GetSess("db") dbtable=GetSess("table") idfield=GetSess("idfield") AllRecords=GetSess("AllRecords") If Emailfilename<>"" and Mergerecords="No" then GetFileREcords If Serror<>"" then rc=4 exit sub end if end if 'shopwriteheader getlang("LangMail01") dbtable=lcase(dbtable) ValidateTable dbtable, rc end Sub Sub MailSelectedRecords Dim array Dim i,f f=0 dim item If MailList="" then SError=getlang("LangMailerror02") exit sub end if array = Split(Maillist, ",", -1, 1) for i = 0 to ubound(array) item=Array(i) MailRecord item Response.Flush next end sub ' Sub MailAllRecords dim acount Dim RecordCount dim f f=0 RecordCount=0 acount=0 if attachmentfilename<>"" then my_attachment=Array(attachmentfilename) acount=1 end if Server.scripttimeout=500 Set MailRs = Server.CreateObject("ADODB.Recordset") if Getsess("sqlquery")="" then mailRs.Open dbTable, myconn, adOpenForwardOnly,adLockReadOnly,adCmdTable Else mailRs.Open Getsess("sqlquery"), myconn, adOpenForwardOnly,adLockReadOnly,adCmdText End if If not mailrs.EOF then Response.write smallinfofont End if While Not mailRS.EOF FormatRecord If getconfig("xCheckMailList")="Yes" then if blnmaillist=TRUE then ExecuteMail mailtype,My_from,my_fromaddress,my_to,my_toaddress,my_subject,body,Emailformat,my_attachment,acount RecordCount=RecordCount+1 end if else ExecuteMail mailtype,My_from,my_fromaddress,my_to,my_toaddress,my_subject,body,Emailformat,my_attachment,acount RecordCount=RecordCount+1 end if f=f+1 IF f>200 then f=1 Response.Write("
") end if if ((f mod 5) = 0) then Response.Write(".") Response.Flush end if mailRS.MoveNext Wend mailrs.close set mailrs=nothing shopwriteheader getlang("LangMailPersons") & " " & recordcount End Sub Sub FormatRecord dim utable utable=ucase(dbtable) Select case utable Case "CUSTOMERS" lastname=mailrs("lastname") firstname=mailrs("firstname") my_toaddress = mailrs("email") blnmaillist=mailrs("maillist") if isnull(blnmaillist) then blnmaillist=TRUE end if Case "ORDERS" lastname=mailrs("olastname") firstname=mailrs("ofirstname") my_toaddress = mailrs("oemail") blnmaillist=TRUE Case "AFFILIATES" lastname=mailrs("lastname") firstname=mailrs("firstname") my_toaddress = mailrs("email") blnmaillist=TRUE Case "PROJECTS" lastname=mailrs("customer") firstname="" my_toaddress = mailrs("customeremail") blnmaillist=TRUE end select my_to=firstname & " " & lastname If mergerecords="Yes" Then FormatOtherMail emailFilename, mailrs, body end if 'debugwrite body End Sub ' Sub MailRecord(Item) dim acount my_attachment="" acount=0 if attachmentfilename<>"" then my_attachment=Array(attachmentfilename) acount=1 end if mailsql = "Select * from " & dbtable & " Where " & idfield & " =" & item 'debugwrite mailsql set mailrs=myconn.execute(mailsql) FormatRecord mailrs.close set mailrs=nothing If getconfig("xCheckmaillist")="Yes" Then If blnMailList=TRUE then shopwriteError getlang("LangMailMailing") & my_to & " " & my_toaddress ' debugwrite body ExecuteMail mailtype,My_from,my_fromaddress,my_to,my_toaddress,my_subject,body,Emailformat,my_attachment,acount end if Else shopwriteerror getlang("LangMailMailing") & my_to & " " & my_toaddress 'debugwrite body ExecuteMail mailtype,My_from,my_fromaddress,my_to,my_toaddress,my_subject,body,Emailformat,my_attachment,acount end if end sub Sub GetFileRecords Dim Records(500), recordcount, i dim CR serror="" dim dbprefix, filename, dbfilename filename=getsess("emailfilename") dbprefix=left(filename,3) if lcase(dbprefix)="db=" then dbfilename=right(filename,len(filename)-3) GetFileRecordsDB dbfilename exit sub End If 'Debugwrite "reading" & emailfilename ShopReadFile emailfilename, records, recordcount If RecordCount=0 then Serror=Serror & getlang("LangReadFail") & " " & emailfilename exit sub end if Body="" 'debugwrite "recordcount="& recordcount If ucase(emailformat)<>"HTML" then CR=GetmailCR else CR="" end if For i=0 to recordcount-1 body=body & Records(i) if CR<>"" then body=body& CR end if next 'debugwrite body end sub Sub Validatetable(dbtable, rc) dim i for i = 0 to ubound(validtables) if dbtable=validtables(i) then rc=0 exit sub end if next sError=getlang("LangMailError01") rc=4 end sub Sub GetFileREcordsDB (dbfilename) dim conn, recordobj, filename, CR shopopendatabase conn dim sql If ucase(emailformat)<>"HTML" then CR=GetmailCR else CR="" end if sql="select * from templates where templatename='" & dbfilename & "'" set recordobj=conn.execute(sql) If not recordobj.eof then body=recordobj("template") & CR else Serror=Serror & getlang("LangReadFail") & " " & emailfilename end if closerecordset recordobj shopclosedatabase conn End Sub %>