<% '##### EMAIL 'Sub EmailASP() If Request("acaba") = "sim" Then Session("adm_descprod") = "" Session("adm_email") = "" End If Select Case strAcao Case "escrever" varimg = " " strTextoHtml = strTextoHtml & "

 Escrever nova Newsletter

---

" If Request("sucesso") = "sim" Then strTextoHtml = strTextoHtml & "
E-MAIL(S) ENVIADO(S) COM SUCESSO!

" Else strTextoHtml = strTextoHtml & "
" End If strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" '*** Adaptacao para usar o Htmlarea If Request.ServerVariables("SERVER_NAME")="localhost" then caminho_pasta_htmlarea = Server.MapPath("htmlarea") caminho_pasta_htmlarea = replace(caminho_pasta_htmlarea,"\","/") caminho_pasta_htmlarea = caminho_pasta_htmlarea & "/" Else caminho_pasta_htmlarea = "htmlarea/" End If strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "

Enviar para:	" strTextoHtml = strTextoHtml & "Para Todos (Clientes e Assinantes)Somente Clientes da LojaSomente Assinantes da Newsletter da Loja" '*** Clientes Cadastrados If VersaoDb = 1 then Set rs = conexao.Execute("SELECT nome, email FROM clientes ORDER by nome;") else Set rs = conexao.Execute("SELECT nome, email FROM clientes ORDER by nome;") end if strTextoHtml = strTextoHtml & "" While Not rs.EOF strTextoHtml = strTextoHtml & "" & Cripto(rs("nome"),False) & " (" & Cripto(rs("email"), False) & ")" rs.movenext Wend strTextoHtml = strTextoHtml & "" '*** Assinantes Cadastrados If VersaoDb = 1 then Set rs2 = conexao.Execute("SELECT email FROM newsletter ORDER by email;") else Set rs2 = conexao.Execute("SELECT email FROM newsletter ORDER by email;") end if strTextoHtml = strTextoHtml & "" While Not rs2.EOF strTextoHtml = strTextoHtml & "" & rs2("email") & "" rs2.movenext Wend strTextoHtml = strTextoHtml & "
Assunto:	" If Request("erro2") = "sim" Then strTextoHtml = strTextoHtml & varimg End If strTextoHtml = strTextoHtml & "
" strTextoHtml = strTextoHtml & "" & vbNewLine strTextoHtml = strTextoHtml & "
Texto do e-mail:	" & Session("adm_email") & "" strTextoHtml = strTextoHtml & " Dica: Para fazer uma simples quebra de linha , digite Shift+Enter " If Request("erro") = "sim" Then strTextoHtml = strTextoHtml & varimg End If strTextoHtml = strTextoHtml & "
" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "

---

Voltar para página inicial
" Case "grava" email = Request("email") para = Request("para") assunto = Request("assunto") Session("adm_email") = email If email = "" Or assunto = "" Then If email = "" Then erro = "sim" End If If assunto = "" Then erro2 = "sim" End If Response.Redirect "administrador.asp?link=news&acao=escrever&erro=" & erro & "&erro2=" & erro2 & "&msg=" & assunto Else strString = email 'strString = Codifica(strString) 'Usar somente qdo nao se usa a Ferramenta HTMLarea email = "" email = strString strEmailHTML = "" strEmailHTML = strEmailHTML & "" strEmailHTML = strEmailHTML & "" strEmailHTML = strEmailHTML & "" strEmailHTML = strEmailHTML & "" strEmailHTML = strEmailHTML & ""&email&"" strEmailHTML = strEmailHTML & "" Select Case para 'Envia para email para todos Case "todos" Set rs = conexao.Execute("SELECT email FROM newsletter;") While Not rs.EOF EnviaEmail Application("HostLoja"), Application("ComponenteLoja"), emailloja, "", rs("email"), "Informativo " & nomeloja & " - " & assunto, strEmailHTML rs.movenext Wend Set rs2 = conexao.Execute("SELECT nome, email FROM clientes") While Not rs2.EOF EnviaEmail Application("HostLoja"), Application("ComponenteLoja"), emailloja, "", Cripto(rs2("email"), False), "Informativo " & nomeloja & " - " & assunto, strEmailHTML rs2.movenext Wend 'Envia para email para todos os assinantes da newsletter da loja Case "news" Set rs = conexao.Execute("SELECT email FROM newsletter;") While Not rs.EOF EnviaEmail Application("HostLoja"), Application("ComponenteLoja"), emailloja, "", rs("email"), "Informativo " & nomeloja & " - " & assunto, strEmailHTML rs.movenext Wend 'Envia para email para todos os clientes da loja Case "clientes" Set rs = conexao.Execute("SELECT nome, email FROM clientes;") While Not rs.EOF EnviaEmail Application("HostLoja"), Application("ComponenteLoja"), emailloja, "", Cripto(rs("email"), False), "Informativo " & nomeloja & " - " & assunto, strEmailHTML rs.movenext Wend 'Envia para email somente para o email selecionado (nao importa se é cliente ou assinante da newsletter Case Else if instr(para, "@") <> 0 then EnviaEmail Application("HostLoja"), Application("ComponenteLoja"), emailloja, "", para, "Informativo " & nomeloja & " - " & assunto, strEmailHTML end if End Select Response.Redirect "administrador.asp?link=news&acao=escrever&sucesso=sim&acaba=sim" End If Case "excluir" strTextoHtml = strTextoHtml & " Excluir emails cadastrados na newsletter da loja

---

" finalera = Request.QueryString("final") pag = Request.QueryString("itens") pesss = Trim(Request.QueryString("pesq")) pagdxx = Request.QueryString("pagina") pesqsa = Request.QueryString("pesqsa") catege = Request("cat") If pesss = "" Then pesss = "-" palavra = Split(Trim("asdfghjklçqwertyuiopzxcvbnm"), " ") Else pesss = pesss palavra = Split(Trim(Request.QueryString("pesq")), " ") End If If pag = "" Then inicial = 0 final = 10 Else inicial = pag final = 10 End If If pesqsa = "" Then restinho = "" catege = "todos" Else If catege = "todos" Or catege = "xxx" Or catege = "" Then resto = "" Else resto = "idsessao = '" & catege & "' and" End If palavraz = Split(Trim(pesqsa), " ") restinho = "WHERE email LIKE '%" & palavraz(0) & "%'" End If Set rs = conexao.Execute("SELECT email,datacad FROM newsletter " & restinho) If rs.EOF Or rs.bof Then strTextoHtml = strTextoHtml & "

" strTextoHtml = strTextoHtml & "Cadastro(s) encontrado(s): 0" & totalreg & " " strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & " Para uma busca mais detalhada dos e-mails cadastrados na loja realize uma pesquisa com o e-mail que você procura. " strTextoHtml = strTextoHtml & " " strTextoHtml = strTextoHtml & " " strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & " Nenhum cadastro foi encontrado na base de dados da loja. " strTextoHtml = strTextoHtml & " " strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & " Voltar para Página Inicial

" Else Set rs2 = conexao.Execute("SELECT count(email) AS total FROM newsletter " & restinho & ";") totalreg = rs2("total") rs2.Close Set rs2 = Nothing numiz = Request("pagina") & "0" numiz = CInt(numiz) iz = iz + numiz strTextoHtml = strTextoHtml & "

" strTextoHtml = strTextoHtml & "Assinantes(s) encontrado(s): " & totalreg & " " strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & " Para uma busca mais detalhada dos e-mails cadastrados na loja realize uma pesquisa com o e-mail que você procura. " strTextoHtml = strTextoHtml & " " strTextoHtml = strTextoHtml & " " If Request("status") = "sucesso" Then strTextoHtml = strTextoHtml & " CADASTRO EXCLUÍDO COM SUCESSO! " Else strTextoHtml = strTextoHtml & " " End If strTextoHtml = strTextoHtml & "" While Not rs.EOF iz = iz + 1 emailx = rs("email") emailx = Replace(emailx, "@", "") emailx = Replace(emailx, ".", "") varestoq = "" & rs("email") & "" & vbNewLine strTextoHtml = strTextoHtml & "" & vbNewLine strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & " " strTextoHtml = strTextoHtml & " " & iz & ") " & UCase(varestoq) & "       Data do cadastro: " & rs("datacad") & " Ação: Excluir  " rs.movenext Wend pagn = inicial + 10 paga = pagn - 20 strTextoHtml = strTextoHtml & " Voltar para Página Inicial

" rs.Close Set rs = Nothing End If Case "exclui" notz = Request.QueryString("cli") Set dados = conexao.Execute("delete from newsletter where email = '" & notz & "';") Response.Redirect "?link=news&acao=excluir&status=sucesso" End Select 'End Sub %>