<%option explicit%>
<%
ShopCheckAdmin "shopa_editdisplay.asp"
'*****************************************************"
' Version 4.50 April 10, 2002
' mails to selected customers
' Check maillist field in customers table to see if person
' should receive mail. Aug 28 lower case
'*******************************************************
Dim validtables
validtables=array("customers","affiliates","projects","orders")
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 body
Dim Msg
Dim mailtype
Dim mailer
Dim MailList
Dim dbc
dim dbTable
Dim Idfield
Dim Allrecords
Dim mailrs
dim mailsql
Dim firstname
Dim Lastname
Dim emailUseTemplate
'**************************************************************************
' Session Variables are used
' Session (table") = table to open
' Session ("db")= database
' Session ("EmailBody") = body Text
'**************************************************************************
Dim rc
Serror=""
AdminPageHeader
Response.Flush
GetSessionVariables rc ' see what we must do
if rc=0 then
EditOpenDatabase dbc, database, dbtable ' open database
if Allrecords="" then
MailSelectedRecords
else
MailAllRecords
end if
ShopCloseDatabase dbc
end if
Response.write getconfig("xfont") & "" & sError & ""
AdminPageTrailer
'
Sub GetSessionVariables (rc)
dim yesans
yesans=ucase(replace(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")
emailUseTemplate=Getsess("EmailUseTemplate")
MailList=Getsess("MailList")
database=GetSess("db")
dbtable=GetSess("table")
idfield=GetSess("idfield")
AllRecords=GetSess("AllRecords")
If Emailfilename<>"" and emailUseTemplate<>"YES" then
GetFileREcords
If Serror<>"" then
rc=4
exit sub
end if
end if
Response.write "" & getconfig("Xfont") & LangMail01 & "
"
dbtable=lcase(dbtable)
ValidateTable dbtable, rc
end Sub
Sub MailSelectedRecords
Dim array
Dim i,f
f=0
dim item
If MailList="" then
SError=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
Server.scripttimeout=500
Set MailRs = Server.CreateObject("ADODB.Recordset")
if Getsess("sqlquery")="" then
mailRs.Open dbTable, dbc, adOpenForwardOnly,adLockReadOnly,adCmdTable
Else
mailRs.Open Getsess("sqlquery"), dbc, adOpenForwardOnly,adLockReadOnly,adCmdText
End if
If not mailrs.EOF then
Response.write getconfig("xfont")
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
Response.write"
"& 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 emailUseTemplate="YES" Then
FormatOtherMail emailFilename, mailrs, body
end if
'debugwrite body
End Sub
'
Sub MailRecord(Item)
dim acount
my_attachment=""
acount=0
mailsql = "Select * from " & dbtable & " Where " & idfield & " =" & item
'debugwrite mailsql
set mailrs=dbc.execute(mailsql)
FormatRecord
mailrs.close
set mailrs=nothing
If getconfig("xCheckmaillist")="Yes" Then
If blnMailList=TRUE then
Response.write getconfig("xfont") & 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
Response.write getconfig("xfont") & 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
'Debugwrite "reading" & emailfilename
Dim Records(500), recordcount, i
dim CR
serror=""
ShopReadFile emailfilename, records, recordcount
If RecordCount=0 then
Serror=Serror & 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=LangMailError01
rc=4
end sub
%>