gustavovalle

Fala Bareta cara eu coloquei o codigo la, de envio, o problema e que ele não pega a qquantidade de email que vai ser enviado e não envia os mesmo. Mas não envia por não achar os emails entendeu?

Tem sim basta voce fazer uma verificação antes de apagar a imagem tipo "se não existir a imagem ele não executa o comando de apagar" Dados = split(Request.QueryString("dados"),"|") Varcod = Dados(0) VarArquivo = Dados(1) Caminho = "D:\Domains\laboratoriocepac.com.br\wwwroot\figuras\" 'VarCaminho = "c:\Sitelab\figuras\" & VarArquivo VarCaminho = "D:\Domains\laboratoriocepac.com.br\wwwroot\figuras\" & VarArquivo If VarCaminho <> "" Then Set FSO = Server.CreateObject("Scripting.FileSystemObject") Linha 16: FSO.DeleteFile VarCaminho 'Server.MapPath("../figuras") & "/" & VarArquivo End If Acho que e isso.

Bom dia peguei um codigo e adapitei algumas coisas para o desenvolvimento de um sistema que envia Newsletter sem limite de emails e sem TIMEOUT. Mas alguma coisa esta errada e não consigo achar o erro. Abaixo o codigo passo a passo. Página que chama o envio da nesletter: Esta página com iframe chama o formulario que enviará a newsletter sem que seje nessessário sair da página atual. <iframe name="formulario" src="news_form.asp?id=<%=lc_id%>" width="581" height="64" scrolling="no" frameborder="0"></iframe> <iframe name="codigo" width="1" height="1"></iframe> A seguir vem o form que envia as variaveis para o código de envio atraves do botao enviar: <% lc_id = request("id") %> <form id="frm" name="frm" action="news.asp" target="codigo"> <input name="txt_id" type="hidden" value="<%=lc_id%>" /> <input name="pagina" type="hidden" value="1" /> <input name="contador" type="hidden" value="1" /> <table width="100%" border="0" cellspacing="0" cellpadding="0"> <tr> <td id="td_status" class="Mensagem_erro"><input name="Enviar" type="image" src="img/bt_continuar.gif"></td> </tr> </table> </form> Agora segue o codigo que pega as variaveis e faz o envio dos emails: <!--#include virtual="/conn/connect.asp"--> <!--#include file="inc/common.asp"--> <% Response.Buffer = FALSE Server.ScriptTimeout = 99999 '****************************************************************** 'Pega o Caminho dos dados '****************************************************************** Set rs = Dados_Gerais("") lc_empresa = rs("nome") lc_url = rs("url") lc_email_empresa = rs("email") rs.Close '****************************************************************** lc_id = request("txt_id") '****************************************************************** Set rs = Registro_Seleciona("tbl_newsletter", "id_news", lc_id) lc_tipo = rs("tipo") vc_assunto = "Newsletter (" & lc_empresa & ")" tx_editor = (trim(rs("texto"))) rs.Close pagina = int(request("pagina")) contador = int(request("contador")) if pagina = 1 then contador = 0 %> <script> parent.formulario.document.getElementById("td_status").innerHTML = '<input type="text" name="it_enviados" class="forms" value="0" size="5"> emails enviados de <input type="text" name="it_total" class="forms" value="0" size="5">' </script> <% end if '****************************************************************** 'Pega os e-mais que estao relacionados ao grupo desta newsletter '****************************************************************** SQL = "SELECT * FROM tbl_email" SQL = SQL & " WHERE grupo = "& lc_tipo &"" SQL = SQL & " ORDER BY id" Set RS = conDB.Execute(SQL) it_total = RS.RecordCount RS.PageSize = 10 ' aqui é definido o tamanho do pacote que será enviado RS.absolutepage = pagina if pagina = 1 then %> <script> parent.formulario.document.getElementById("it_total").value = <%=it_total%>; </script> <% end if i = 0 do while NOT RS.EOF AND i < RS.PageSize set objCDOSYSMail = Server.CreateObject ("CDO.Message") set objCDOSYSCon = Server.CreateObject ("CDO.Configuration") Set objCDOSYSMail.Configuration = objCDOSYSCon With objCDOSYSCon .Fields("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "mail-fwd" .Fields("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 .Fields("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 .Fields("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30 .Fields.update End With With objCDOSYSMail .From = lc_email_empresa .To = rs("email") .Subject = vc_assunto .HtmlBody = tx_editor .Send End With set objCDOSYSMail = nothing set objCDOSYSCon = nothing %> <script> parent.formulario.document.getElementById("it_enviados").value = '<%=i + contador%>'; </script> <% i = i + 1 RS.MoveNext loop %> <script> parent.formulario.document.getElementById("pagina").value = Number(parent.formulario.document.getElementById("pagina").value) + Number(1); parent.formulario.document.getElementById("contador").value = Number(parent.formulario.document.getElementById("contador").value) + Number(<%=i%>); </script> <% if RS.PageCount >= pagina then %> <script> setTimeout('parent.formulario.document.frm.submit()',10000); // De 10 em 10 segundos ele vai mandar o formulario </script> <% else '========================================================================== 'Update no Status da Newsletter '========================================================================== lc_status = "2" lc_data = year(now)& "/" & Month(now)& "/" & day(now) lc_hora = Time() '========================================================================== 'Altera o status da Newsletter para enviado SQL1 = "UPDATE tbl_newsletter SET data = '"& lc_data &"' , hora = '" & lc_hora & "' , status = '"& lc_status &"' WHERE id_news = " & lc_id & "" set rsquery = conDB.Execute(SQL1) set rsquery = nothing '========================================================================== %> <script> alert('Mailing enviado com sucesso!'); </script> <% end if %> Ele não retorna erro algum mas não envia a newsletter. Obrigado para quem poder me ajudar.

Bareta e o seguinte este codigo roda no server local, e apos quebrar a cabeça por algumas horas vi que alguns formatos de imagem .JPG dao esse erro outros enviam normalmente. O que pode ser? Já que as imagens possuem o mesmo formato?

Aqui não corrompe nehum arquivo, utilizo em 3 sistemas perfeitamente.

Bareta desculpe a sumida, estive fora e não pude ver as menssagens, consegui solucionar o problema meu codigo ficou assim. Case "INCLUIR_IMAGEM" 'Pega o Caminho da Pasta Imagens Set rs = Dados_Gerais("") lc_diretorio = rs("picture") rs.Close Set Upload = Server.CreateObject("Persits.Upload") '============================================================================== 'LIMITA O TAMANHO DO ARQUIVO PARA 500KB '============================================================================== Upload.SetMaxSize 500000, True Count = Upload.Save (lc_diretorio) If Err.Number = 8 Then response.write "<table width=100% height=85 border=0 cellspacing=0 cellpadding=0>" response.write "<td align=center valign=middle class=Nomes_Forms>" response.Write "Esta imagem possui "& FormatNumber(File.Size,0) &" Kb<BR><BR>" response.Write "O que exede o máximo permitido que é de 500 Kb por imagem<BR><BR>" response.Write "<a href=java script:history.go(-1); class=Nomes_Forms_Normal>" response.Write "&laquo; voltar ao formulário" response.Write "</a>" response.write "</td>" response.write "</table>" Response.End Else '============================================================================== Set File = Upload.Files(1) If File.ImageType <> "UNKNOWN" Then lc_id = Upload.form("txt_id") lc_galeria = Upload.form("txt_galeria") lc_legenda = Trim(Upload.form("txt_legenda")) lc_link = Right(File.ExtractFileName,4) lc_diahora = day(now) & month(now) & year(now) & hour(now) & minute(now) & second(now) lc_foto = lc_cliente & lc_id & lc_diahora & lc_link Rem Redimencionando a Imagem Set Jpeg = Server.CreateObject("Persits.Jpeg") Jpeg.Open (File.Path) if Jpeg.Width > Jpeg.Height then intXSize = 90 intYSize = (intXSize / Jpeg.Width) * Jpeg.Height else intYSize = 90 intXSize = (intYSize / Jpeg.Height) * Jpeg.Width end if Jpeg.Width = intXSize Jpeg.Height = intYSize 'Jpeg.Sharpen 1, 150 Jpeg.Save lc_diretorio & "P" & lc_foto Set Jpeg = nothing Rem Redimencionando a Imagem Set Jpeg = Server.CreateObject("Persits.Jpeg") Jpeg.Open (File.Path) if Jpeg.Width > Jpeg.Height then intXSize = 170 intYSize = (intXSize / Jpeg.Width) * Jpeg.Height else intYSize = 170 intXSize = (intYSize / Jpeg.Height) * Jpeg.Width end if Jpeg.Width = intXSize Jpeg.Height = intYSize 'Jpeg.Sharpen 1, 150 Jpeg.Save lc_diretorio & "M" & lc_foto Set Jpeg = nothing Rem Redimencionando a Imagem Set Jpeg = Server.CreateObject("Persits.Jpeg") Jpeg.Open (File.Path) if Jpeg.Width > Jpeg.Height then intXSize = 449 intYSize = (intXSize / Jpeg.Width) * Jpeg.Height else intYSize = 449 intXSize = (intYSize / Jpeg.Height) * Jpeg.Width end if Jpeg.Width = intXSize Jpeg.Height = intYSize 'Jpeg.Sharpen 1, 150 Jpeg.Save lc_diretorio & "G" & lc_foto Set Jpeg = nothing Set Upload = Nothing ' deleta a imagem original do servidor Set imagem = CreateObject("Scripting.FileSystemObject") If (imagem.FileExists(lc_diretorio&File.FileName)) Then imagem.DeleteFile(lc_diretorio&File.FileName) end if Set imagem = Nothing 'Se não existe insere no banco de dados SQL1 = "INSERT INTO tbl_foto (galeria, imagem, legenda) VALUES ('" & lc_id & "','" & lc_foto & "','" & lc_legenda & "')" set rsquery = conDB.Execute(SQL1) set rsquery = nothing Response.Redirect "galeria.asp?acao=3&opcao=1&text=Img_Inserido&id="&lc_id&"" End If End If

Fiz o codigo igual o Dark postou e retornou o seguinte erro: Objeto Request erro 'ASP 0104 : 80004005' Operação não permitida o Erro esta dando nesta linha: RequestBin = Request.BinaryRead(byteCount) ' Chamando Funções, que fazem o Upload funcionar byteCount = Request.TotalBytes RequestBin = Request.BinaryRead(byteCount) Set UploadRequest = CreateObject("Scripting.Dictionary") BuildUploadRequest RequestBin '===================================== ' Recuperando os Dados Digitados '===================================== lc_id = Trim(UploadRequest.Item("txt_id").Item("Value")) lc_galeria = Trim(UploadRequest.Item("txt_galeria").Item("Value")) lc_legenda = Trim(UploadRequest.Item("txt_legenda").Item("Value")) lc_status = Trim(UploadRequest.Item("txt_status").Item("Value")) '====================================== ' Tipo de arquivo que esta sendo enviado tipo_foto = UploadRequest.Item("txt_imagem").Item("ContentType") '===================================== ' Caminho completo dos arquivos enviados caminho_foto = UploadRequest.Item("txt_imagem").Item("FileName")

Boa tarde pessoal segui a risca toda a documentacao do aspupload e aspjpeg pois para hospedar um site para um cliente no terra so usando esses componentes. Como funciona, 1 envio o arquivo, isso esta ok depois tranformo a imagem para 3 tamanhos diferentes e posteriormente apagop o arquivo original. Mas não esta havendo o redimensionamento e nem apagando o arquivo original. Ele so manda o mesmo. Obrigado Case "INCLUIR_IMAGEM" 'Pega o Caminho da Pasta Imagens Set rs = Dados_Gerais("") lc_diretorio = rs("picture") rs.Close Set upl = Server.CreateObject("Persits.Upload") 'upl.Path = lc_diretorio '============================================================================== 'LIMITA O TAMANHO DO ARQUIVO PARA 500KB '============================================================================== upl.SetMaxSize 500000, True On Error Resume Next upl.Save lc_diretorio If Err.Number = 8 Then response.write "<table width=100% height=85 border=0 cellspacing=0 cellpadding=0>" response.write "<td align=center valign=middle class=Nomes_Forms>" response.Write "Esta imagem possui "& FormatNumber(File.OriginalSize,0) &" Kb<BR><BR>" response.Write "O que exede o máximo permitido que é de 500 Kb por imagem<BR><BR>" response.Write "<a href=java script:history.go(-1); class=Nomes_Forms_Normal>" response.Write "&laquo; voltar ao formulário" response.Write "</a>" response.write "</td>" response.write "</table>" Else '============================================================================== lc_id = upl.form("txt_id") lc_galeria = upl.form("txt_galeria") lc_imagem = Trim(upl.form("txt_imagem")) lc_legenda = Trim(upl.form("txt_legenda")) link = Mid(lc_imagem, InstrRev(lc_imagem, "\") + 1) lc_link = Right(link,4) lc_diahora = day(now) & month(now) & year(now) & hour(now) & minute(now) & second(now) lc_foto = lc_cliente & lc_id & lc_diahora & lc_link Rem Redimencionando a Imagem Set Jpeg = Server.CreateObject("Persits.Jpeg") Jpeg.Open (lc_diretorio & link) if Jpeg.Width > Jpeg.Height then intXSize = 90 intYSize = (intXSize / Jpeg.Width) * Jpeg.Height else intYSize = 90 intXSize = (intYSize / Jpeg.Height) * Jpeg.Width end if Jpeg.Width = intXSize Jpeg.Height = intYSize 'Jpeg.Sharpen 1, 150 Jpeg.Save lc_diretorio & "P" & lc_foto Set Jpeg = nothing Rem Redimencionando a Imagem Set Jpeg = Server.CreateObject("Persits.Jpeg") Jpeg.Open (lc_diretorio & link) if Jpeg.Width > Jpeg.Height then intXSize = 170 intYSize = (intXSize / Jpeg.Width) * Jpeg.Height else intYSize = 170 intXSize = (intYSize / Jpeg.Height) * Jpeg.Width end if Jpeg.Width = intXSize Jpeg.Height = intYSize 'Jpeg.Sharpen 1, 150 Jpeg.Save lc_diretorio & "M" & lc_foto Set Jpeg = nothing Rem Redimencionando a Imagem Set Jpeg = Server.CreateObject("Persits.Jpeg") Jpeg.Open (lc_diretorio & link) if Jpeg.Width > Jpeg.Height then intXSize = 449 intYSize = (intXSize / Jpeg.Width) * Jpeg.Height else intYSize = 449 intXSize = (intYSize / Jpeg.Height) * Jpeg.Width end if Jpeg.Width = intXSize Jpeg.Height = intYSize 'Jpeg.Sharpen 1, 150 Jpeg.Save lc_diretorio & "G" & lc_foto Set Jpeg = nothing upl.Delete Set upl = Nothing 'Se não existe insere no banco de dados SQL1 = "INSERT INTO tbl_foto (galeria, imagem, legenda) VALUES ('" & lc_id & "','" & lc_foto & "','" & lc_legenda & "')" set rsquery = conDB.Execute(SQL1) set rsquery = nothing Response.Redirect "galeria.asp?acao=3&opcao=1&text=Img_Inserido&id="&lc_id&"" End If

Fal Junior beleza? Cara em PHP eu vi que e um código ate pequeno ne mas preciso em asp mesmo, mas valeu de qualquer maneira.

Continuo com problema nesta newsletter alguém pode me indicar alguma newsletter mais facil de se adaptar ou me indicar io erro?

Olha mas o principal problema que esta acontecendo e que ele envia 10 emails, e depois da um reload envia mais 10 e para de enviar, ele deveria ficar dando reload ate finalizar todos os emails. O problema esta na verdade aqui, quando a pagina chega a 2, ele executa o else. If Not (pagina > totpaginas) Then Response.AddHeader "Refresh", "14;URL=newsletter.asp?acao=funcao&action=ENVIAR&txt_id="& lc_id &"&pagina="& pagina + 1 Response.Write("<strong><font face=verdana color=red>10 e-mails enviados.<BR>") Response.Write("Aguarde, preparando script para enviar mais 10 e-mails...</font></strong>") Else 'Altera o status da Newsletter para enviado SQL1 = "UPDATE tbl_newsletter SET data = '"& lc_data &"' , hora = '" & lc_hora & "' , status = '"& lc_status &"' WHERE id_news = " & lc_id & "" set rsquery = conDB.Execute(SQL1) set rsquery = nothing

Bom dia, desenvolvi uma newsletter que evita o bloqueio do servidor que esta hospedado e evite o famoso timeout, mas o problema é que ela esta fazendo o reload so uma vez, ou seja ela envia para os 10 primeiros emails, depois para mais 10 emails e finaliza, sendo que no cadastro possui 350 emails. Coloquei um loop para 10 emails. Se alguém souber onde estou errando por favor me avise. Obrigado If Request.QueryString("pagina") = "" Then pagina = 1 Else pagina = Request.QueryString("pagina") End if Set rs = Registro_Seleciona("tbl_newsletter", "id_news", lc_id) lc_tipo = rs("tipo") lc_imagem = rs("imagem") 'lc_texto = rs("texto") rs.Close SQL = "SELECT * FROM tbl_email" SQL = SQL & " WHERE grupo = "& lc_tipo &"" SQL = SQL & " ORDER BY id" Set rs = conDB.Execute(SQL) const registros = 10 rs.PageSize = 10 rs.CacheSize = 10 rs.AbsolutePage = pagina totpaginas = rs.PageCount totregistros = rs.RecordCount i = 1 While NOT rs.EOF AND Not i > registros lc_email = rs("email") 'lc_nome = rs("nome") '****************************************************************** 'MONTA A NEWSLETTER '****************************************************************** HTML = HTML & "<html>" HTML = HTML & "<head>" HTML = HTML & "<title>" HTML = HTML & lc_empresa HTML = HTML & "</title>" HTML = HTML & "</head>" HTML = HTML & "<body bgcolor=#FFFFFF>" HTML = HTML & "<table width=100% border=0 cellspacing=0 cellpadding=0>" HTML = HTML & "<tr>" HTML = HTML & "<td align=center valign=middle>" If lc_imagem <> "" Then HTML = HTML & "<img src=" HTML = HTML & lc_url HTML = HTML & "/newsletter/pictures/" HTML = HTML & lc_imagem HTML = HTML & " border=0>" End If HTML = HTML & "</td>" HTML = HTML & "</tr>" HTML = HTML & "</table>" HTML = HTML & "</body>" HTML = HTML & "</html>" '****************************************************************** 'ENVIA PARA O E-MAIL '****************************************************************** 'cria o objeto para o envio de e-mail Set objCDOSYSMail = Server.CreateObject("CDO.Message") 'cria o objeto para configuração do SMTP Set objCDOSYSCon = Server.CreateObject ("CDO.Configuration") 'SMTP objCDOSYSCon.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "localhost" 'porta do SMTP objCDOSYSCon.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 'porta do CDO objCDOSYSCon.Fields("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 'timeout objCDOSYSCon.Fields("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30 objCDOSYSCon.Fields.update 'atualiza a configuração do CDOSYS para o envio do e-mail Set objCDOSYSMail.Configuration = objCDOSYSCon 'e-mail do remetente objCDOSYSMail.From = lc_email_empresa 'e-mail do destinatário objCDOSYSMail.To = lc_email 'assunto da mensagem objCDOSYSMail.Subject = "Newsletter (" & lc_empresa & ")" objCDOSYSMail.HtmlBody = HTML 'para envio da mensagem no formato html altere o TextBody para HtmlBody 'objCDOSYSMail.HtmlBody = "Teste do componente CDOSYS" 'objCDOSYSMail.fields.update 'envia o e-mail x = objCDOSYSMail.Send If Not x = true Then Session("good") = Session("good") + 1 Else Session("bad") = Session("bad") + 1 motivo = "" End If i = i + 1 'destrói os objetos Set objCDOSYSMail = Nothing HTML = "" rs.MoveNext Wend If Not (pagina > totpaginas) Then Response.AddHeader "Refresh", "14;URL=newsletter.asp?acao=funcao&action=ENVIAR&txt_id="& lc_id &"&pagina="& pagina + 1 Response.Write("<strong><font face=verdana color=red>10 e-mails enviados.<BR>") Response.Write("Aguarde, preparando script para enviar mais 10 e-mails...</font></strong>") Else 'Altera o status da Newsletter para enviado SQL1 = "UPDATE tbl_newsletter SET data = '"& lc_data &"' , hora = '" & lc_hora & "' , status = '"& lc_status &"' WHERE id_news = " & lc_id & "" set rsquery = conDB.Execute(SQL1) set rsquery = nothing Response.Write("<strong><font face=verdana color=red>Todos os e-mails enviados.</font></strong><BR><BR>") Response.Write("<font face=verdana color=blue><b>Estatísticas</b></font><BR>=============================<BR>") Response.Write("<font face=verdana color=black>E-mails enviados com sucesso: <b>"&Session("good")&"</b><BR>") Response.Write("E-mails enviados sem sucesso: <b>"&Session("bad")&"</b><BR>") 'Response.Write("Erro: <b>"&motivo&"</b><BR>--<BR>") Response.Write("Total de e-mails no banco de dados: <b>"&totregistros&"</b></font>") Session("good") = 0 Session("bad") = 0 Set rs = Nothing Set objCDOSYSCon = Nothing End If

Resolvido aqui obrigado

É o seguinte, teho uma tabela que chama tbl_anuncio onde são registrados os imóveis que serão anunciados, eu preciso que sejem selecionados todos os anuncios com um determinado tipo mas que só sejem mostrados 4 anúncios randômicos e que estes anúncios não se repitam ao ser mostrados(ex: não mostre 2 anúncios com o mesmo id). O problema e que ele esta randomizando so os 4 primeiros registros que ele pega, e o certo e que deveria randomizar todos que estao na tbl_anuncio. Obrigado. lc_data = year(Date())& "-" & Month(Date())& "-" & Day(Date()) SQL = "SELECT tbl_anuncio.*, tbl_imovel.*, tbl_imovel_foto.*, tbl_imovel_tipo.*, tbl_cidade.*" SQL = SQL & " FROM tbl_anuncio, tbl_imovel, tbl_imovel_foto, tbl_imovel_tipo, tbl_cidade" SQL = SQL & " WHERE tbl_anuncio.status = 1" SQL = SQL & " AND tbl_anuncio.tipo = 2" SQL = SQL & " AND tbl_anuncio.data_entrada >= "& lc_data &"" SQL = SQL & " AND tbl_anuncio.data_saida >= "& lc_data &"" SQL = SQL & " AND tbl_anuncio.imovel = tbl_imovel.id_imovel" SQL = SQL & " AND tbl_imovel_foto.imovel = tbl_imovel.id_imovel" SQL = SQL & " AND tbl_imovel_tipo.id_tipo_imovel = tbl_imovel.tipo" SQL = SQL & " AND tbl_cidade.id_cidade = tbl_imovel.cidade" SQL = SQL & " GROUP BY id_anuncio, id_imovel" SQL = SQL & " ORDER BY RAND()" SQL = SQL & " LIMIT 0,4" Set rs = conDB.Execute(SQL)

Com este código inserido no início da página ASP é possível forçar o browser a fazer download do arquivo passado por parâmetro no form. Pode ser qualquer tipo de arquivo, seja ele um .GIF, .JPG, .PDF, .DOC, etc... <% 'É necessário passar o nome do arquivo no FORM Dim Arquivo Arquivo = Request("arquivo") Response.Buffer = True Response.AddHeader "Content-Type","application/x-msdownload" Response.AddHeader "Content-Disposition","attachment; filename=" & Arquivo Response.Flush Set objStream = Server.CreateObject("ADODB.Stream") objStream.Open objStream.Type = 1 objStream.LoadFromFile Server.MapPath(Arquivo) Response.BinaryWrite objStream.Read objStream.Close Set objStream = Nothing Response.Flush %>