<% ShopCheckAdmin "shopa_editdisplay.asp" '************************************************************************ ' VP-ASP 6.50 Select tables to do mailing ' Determine how to mail ' Feb 13, 2004 ' Oct 23, 2004 support db=template '************************************************************************ dim sAction dim currentURL dim returnURL dim emailfromaddress,emailfrom,emailsubject,emailtype dim emailformat,table,emailfilename,emailusetemplate, emailbody Dim fieldname Dim Fieldvalue dim attachmentfilename Dim YesNos(3), YesNoCount Yesnos(0)=replace(getconfig("langcommonYes")," ","") Yesnos(1)=replace(getconfig("LangCommonNo")," ","") dim emailformats(2),emailformatcount Emailformats(0)="Text" Emailformats(1)="HTML" emailformatcount=2 Dim Novalue, yesvalue Yesvalue=yesnos(0) novalue=yesnos(1) Yesnocount=2 dim emailtypes(20), emailtypecount, emailtypenames emailtypenames="cdonts,aspmail,jmail,aspemail,ocxmail,cdosys" parserecord emailtypenames, emailtypes, emailtypecount, "," sAction=request("Action") if saction="" then sAction=request("Action.x") end if 'returnURL=GetSess("CurrentURL") returnURL = "shopa_editdisplay.asp?table=" & request("table") GetFieldvalues if saction="" then AdminPageHeader DisplayForm GetHelp() AdminPageTrailer else ProcessForm If Serror="" then responseredirect returnURL & "&SpecialFunction=" & getlang("langspecialmail") else AdminPageHeader DisplayForm GetHelp() AdminPageTrailer end if end if Sub DisplayForm GenerateDisplayHeader "Mail Setup" GenerateDisplayBodyHeader response.write "
" if serror > "" then shopwriteerror sError end if Response.Write tabledef FormatRow "emailfromaddress",emailfromaddress,getlang("LangCustEmail") FormatRow "emailfromname",emailfrom,getlang("LangCommonName") FormatRow "emailsubject",emailsubject,getlang("LangSubject") FormatRowDrop "emailtype",emailtype,getlang("LangCommontype"),emailtypes, emailtypecount FormatRowDrop "emailformat",emailformat,getlang("Langemailformat"), emailformats, emailformatcount FormatRow "table",table,getlang("LangEditTableName") FormatRow "emailfilename",emailfilename,getlang("LangMenuFileName") FormatRow "attachmentfilename",attachmentfilename,getlang("LangOrderAttachment") FormatRowDrop "emailusetemplate",emailusetemplate,getlang("LangTemplateMerge"),Yesnos,yesnocount Response.Write(tabledefend) Response.write "

" ShopWriteHeader getlang("langmailMessage") Response.write "

" %>

<% If Getconfig("xbuttoncontinue")="" then Response.Write("") else Response.Write("") end if %>
<% Response.Write("
") GenerateDisplayBodyFooter response.write "

" end sub Sub FormatRow (fieldname,fieldvalue, caption) If caption="" then caption=fieldname end if Response.Write(tablerow & tableColumn & trim(caption) & tablecolumnend & "") end sub Sub FormatRowDrop (fieldname,fieldvalue, caption, dropnames, dropcount) If caption="" then caption=fieldname end if Response.Write(tablerow & tableColumn & trim(caption) & tablecolumnend & Tablecolumn) GenerateselectNV dropnames,fieldvalue,fieldname,dropcount, "" Response.write tablecolumnend & tablerowend end sub Sub ProcessForm dim strname dim strvalue GetField "emailfromaddress",emailfromaddress,"" GetField "emailfromname",emailfrom,"" Getfield "emailsubject",emailsubject,"" Getfield "emailtype",emailtype,"" Getfield "emailformat",emailformat,"" Getfield "table",table,"" Getfield "emailfilename","emailfilename","" Getfield "attachmentfilename","attachmentfilename","" Getfield "emailusetemplate",emailusetemplate,"" Getfield "emailbody",emailbody,"" sError="" If GetSess("Emailbody")= "" then If getsess("Emailfilename")="" then sError=getlang("langmailMessage") & " " & getlang("LangCustRequired") & "
" else If left(lcase(getsess("Emailfilename")),3)="db=" then ShopFileExistsDB getsess("Emailfilename"), rc Else shopFileexists Getsess("emailfilename"), rc End If if rc>0 then Serror=Serror & getlang("LangReadfail") & " " & Getsess("emailfilename") end if end if end if end sub ' Sub Getfield (fieldname, fieldvalue, unused) fieldvalue=request(fieldname) Setsess fieldname, fieldvalue end sub Sub GetDefaultvalues emailfromaddress=getconfig("xemail") emailfrom=getconfig("xemailname") emailsubject=getconfig("xemailsubject") emailtype=getconfig("xemailtype") emailformat=getconfig("xemailformat") if request("table") > "" then table = request("table") else table="customers" end if emailfilename="" attachmentfilename="" emailusetemplate=Yesnos(1) emailbody="" end sub ' Sub GetFieldvalues If getsess("emailfromaddress")="" then Getdefaultvalues exit sub end if GetFieldSess "emailfromaddress",emailfromaddress,"" GetFieldSess "emailfromname",emailfrom,"" GetFieldSess "emailsubject",emailsubject,"" GetFieldSess "emailtype",emailtype,"" GetFieldSess "emailformat",emailformat,"" GetFieldSess "table",table,"" GetFieldSess "emailusetemplate",emailusetemplate,"" GetFieldSess "emailfilename",emailfilename,"" GetFieldSess "attachmentfilename",attachmentfilename,"" GetFieldSess "emailbody",emailbody,"" end sub Sub GetfieldSess (fieldname, fieldvalue, unused) fieldvalue=getsess(fieldname) end sub Sub GetfieldSess (fieldname, fieldvalue, unused) fieldvalue=getsess(fieldname) end sub Sub ShopFileExistsDB(filename, rc) dim dbprefix, dbfilename, conn, recordobj, sql shopopendatabase conn dbprefix=left(filename,3) if lcase(dbprefix)="db=" then dbfilename=right(filename,len(filename)-3) else dbfilename=filename end if sql="select * from templates where templatename='" & dbfilename & "'" set recordobj=conn.execute(sql) If not recordobj.eof then rc=0 else rc=4 end if closerecordset recordobj shopclosedatabase conn If rc=0 then SetSess "dbTemplate", "Yes" end if End Sub %>