<%
ShopCheckAdmin "shopa_editdisplay.asp"
'************************************************************************
' VP-ASP 4.00 Select tables to do mailing
' Determine how to mail
'************************************************************************
dim sAction
Dim strbody
Dim strSubject
Dim strFrom
dim strFromemail
dim currentURL
dim returnURL
Dim Fieldnames(10)
Dim Fieldvalues(10)
Dim captions(10)
Dim fieldname
Dim Fieldvalue
Dim Fieldcount
Dim AllowDatabase
AllowDatabase="No"
sAction=request("Action")
if saction="" then
sAction=request("Action.x")
end if
returnURL=GetSess("CurrentURL")
GetFieldNames
GetFieldvalues
if saction="" then
AdminPageHeader
DisplayForm
AdminPageTrailer
else
ProcessForm
If Serror="" then
Response.redirect returnURL & "?SpecialFunction=" & langspecialmail
else
AdminPageHeader
DisplayForm
AdminPageTrailer
end if
end if
Sub DisplayForm
Getcaptions
response.write "")
response.write ""
end sub
Sub FormatRow (fieldname,fieldvalue, sRowColor, caption)
If caption="" then
caption=fieldname
end if
Response.Write(tablerow & tableColumn & trim(caption) & tablecolumnend & "
")
end sub
Sub ProcessForm
dim strname
dim strvalue
For Each key in Request.Form
strname = key
strvalue = Request.Form(key)
if ucase(key)="TABLE" then
strvalue=lcase(strvalue)
end if
if ucase(key)="EMAILUSETEMPLATE" then
strvalue=ucase(replace(strvalue," ",""))
end if
SetSess strname, strvalue
'debugwrite key & "=" & strvalue
Next
Emailformat=request("Emailformat")
Setsess "Emailformat",emailformat
sError=""
If GetSess("Emailbody")= "" then
If getsess("Emailfilename")="" then
sError=langmailMessage & " " & LangCustRequired & " "
else
shopFileexists Getsess("emailfilename"), rc
if rc>0 then
Serror=Serror & LangReadfail & " " & Getsess("emailfilename")
end if
end if
end if
end sub
'
Sub GetFieldnames
Fieldnames(0)="EmailFromAddress"
Fieldnames(1)="EmailFromName"
Fieldnames(2)="EmailSubject"
Fieldnames(3)="EmailType"
Fieldnames(4)="EmailFormat"
Fieldnames(5)="Table"
Fieldnames(6)="EmailFileName"
Fieldnames(7)="EmailUseTemplate"
fieldcount=7
If AllowDatabase="Yes" then
Fieldnames(fieldcount)="Database"
Fieldcount=fieldcount+1
Fieldnames(fieldcount)="DatabaseLocation"
end if
end sub
'
Sub GetFieldvalues
Dim strvalue
strvalue=GetSess(fieldnames(0))
if strvalue="" then
SetDefaultValues
else
for i = 0 to fieldcount
fieldvalues(i)=Getsess(fieldnames(i))
next
strbody=GetSess("Emailbody")
end if
end sub
Sub SetDefaultValues
Fieldvalues(0)=getconfig("xemail")
Fieldvalues(1)=getconfig("xemailname")
Fieldvalues(2)=getconfig("xemailsubject")
Fieldvalues(3)=getconfig("xemailtype")
Fieldvalues(4)=getconfig("xemailformat")
Fieldvalues(5)="customers"
Fieldvalues(6)=""
fieldvalues(7)=replace(LangCommonNo," ","")
'
end sub
Sub GetCaptions
Captions(0)=LangCustEmail
Captions(1)="xEmailname"
Captions(2)="xEmailsubject"
Captions(3)="xEmailtype"
captions(4)="Xemailformat"
captions(5)=LangExportSetTable
captions(6)=LangMenuFileName
captions(7)=LangTemplateMerge
end sub
%>