Ir para conteúdo

POWERED BY:

Arquivado

Este tópico foi arquivado e está fechado para novas respostas.

marcio.theis

Envio de E-Mail

Recommended Posts

Este programa de envio de e-mail foi desenvolvido para uso pessoal, mas resolvi compartilhar com vocês.

Tela do programa:

 

Imagem Postada

 

Ele faz envio de e-mail inclusive para servidores que precisam de SSL, no caso é preciso ter duas DLL junto com o .exe do programa para que o envio seja feito, pode baixar o indy_OpenSSL096m.

Não fiz testes com todos os provedores, se não funcionar para algum, pode desenvolver, ou então responder neste tópico mesmo.

 

É usado a versão 9 do indy. Sendo utilizado os componentes:

TIdAntiFreeze

TIdMessage

TIdSMTP

TIdSSLIOHandlerSocket

 

Pode enviar anexos se desejar, e texto/html.

 

 

 

 

Arquivo .dfm

object frmPrincipal: TfrmPrincipal  Left = 226  Top = 112  BorderIcons = [biSystemMenu]  BorderStyle = bsSingle  Caption = 'Envio de E-Mail'  ClientHeight = 539  ClientWidth = 675  Color = clBtnFace  Font.Charset = DEFAULT_CHARSET  Font.Color = clWindowText  Font.Height = -11  Font.Name = 'MS Sans Serif'  Font.Style = []  OldCreateOrder = False  Position = poScreenCenter  PixelsPerInch = 96  TextHeight = 13  object Panel1: TPanel	Left = 0	Top = 0	Width = 675	Height = 129	Align = alTop	TabOrder = 0	object GroupBox1: TGroupBox	  Left = 7	  Top = 5	  Width = 662	  Height = 119	  Caption = ' Configuração '	  TabOrder = 0	  object Label1: TLabel		Left = 10		Top = 65		Width = 76		Height = 13		Caption = 'Usuário acesso:'	  end	  object Label2: TLabel		Left = 10		Top = 89		Width = 71		Height = 13		Caption = 'Senha acesso:'	  end	  object Label3: TLabel		Left = 10		Top = 17		Width = 81		Height = 13		Caption = 'Servidor (SMTP):'	  end	  object Label4: TLabel		Left = 10		Top = 41		Width = 65		Height = 13		Caption = 'Porta acesso:'	  end	  object Label5: TLabel		Left = 274		Top = 18		Width = 62		Height = 13		Caption = 'E-Mail Envio:'	  end	  object Label6: TLabel		Left = 274		Top = 42		Width = 61		Height = 13		Caption = 'Nome Envio:'	  end	  object Label7: TLabel		Left = 274		Top = 66		Width = 54		Height = 13		Caption = 'Máximo de:'	  end	  object Label8: TLabel		Left = 395		Top = 65		Width = 96		Height = 13		Caption = 'envios por conexão.'	  end	  object Gauge: TGauge		Left = 515		Top = 87		Width = 131		Height = 19		Progress = 0		Visible = False	  end	  object Label11: TLabel		Left = 274		Top = 90		Width = 35		Height = 13		Caption = 'Assuto:'	  end	  object edtUsuario: TEdit		Left = 96		Top = 61		Width = 161		Height = 21		TabOrder = 3	  end	  object edtSenha: TEdit		Left = 96		Top = 85		Width = 161		Height = 21		PasswordChar = '*'		TabOrder = 4	  end	  object edtServidor: TEdit		Left = 96		Top = 13		Width = 161		Height = 21		TabOrder = 0	  end	  object edtPorta: TEdit		Left = 96		Top = 37		Width = 30		Height = 21		TabOrder = 1		Text = '25'	  end	  object ckbRequerAutenticacao: TCheckBox		Left = 129		Top = 39		Width = 125		Height = 17		Alignment = taLeftJustify		Caption = 'Requer Autenticação:'		TabOrder = 2	  end	  object edtEMailEnvio: TEdit		Left = 341		Top = 14		Width = 150		Height = 21		TabOrder = 5	  end	  object edtNomeEnvio: TEdit		Left = 341		Top = 38		Width = 150		Height = 21		TabOrder = 6	  end	  object edtMaxEnvioConexao: TEdit		Left = 341		Top = 62		Width = 50		Height = 21		TabOrder = 7		Text = '100'		OnExit = edtMaxEnvioConexaoExit	  end	  object btnEnviar: TBitBtn		Left = 543		Top = 34		Width = 75		Height = 25		Caption = 'Enviar'		TabOrder = 10		OnClick = btnEnviarClick		Glyph.Data = {		  36030000424D3603000000000000360000002800000010000000100000000100		  1800000000000003000000000000000000000000000000000000000000000000		  0000000000000000000000000000000000001C1B195A4D380D0D0D0000000000		  0000000000000000000000000000000000000000000000000000000000000001		  0101896124B1731299781B100F08000000000000000000000000000000000000		  00000000000000000000000005050556472CBE8C3CAD781ECFB1567A714B0000		  00000000000000000000000000000000000000000000000000050505A28F63CA		  A765B3833EB58B53F2EACAEEE4B96B6240050505000000000000000000000000		  0101012E2B2488826CD6CDAAE1CE97D9BF81C09852D0B592FBF9F1F5EED3BBAB		  651717170000000000000000000000003E3D37F5EED5F8F3E0FAF6E9DFCA7DC4		  9F36C6A566EADFCFFEFEFCF7F2DDC1B0671D1D1D000000000000000000000000		  575754FCFBF4FDFCF8DED8BFCBB973C1B071BEB386F0EDE3FFFFFEF8F4E2C8B6		  69242424000000000000000000000000616160FEFEFDE8E4D4D8CFAAF8F3E0F8		  F4E3F2EEDAC3B88BB7AB7ADDD4B1CEBB6B2A2A2A000000000000000000000000		  696969F3F1E9D2C9A4FAF6E9FAF6EAFBF8EEF5F3F17E7DF8F5F4F3CEC5A0A995		  433030300000000000000000000000006F6E6BCBC29BE9DAADC99F4DB8892EFA		  F6EDE5E5FB4545FEF9F9FEFCFBF6E4DDBE383838000000000000000000000000		  635F4DEADEB1C7A21EC19314A5701DFDFCFAFEFDFBF9F6E7F5EED2F2E9C6E5E1		  D2303030000000000000000000000000868685EADCA7CDAE34C9A625A06A2DF0		  E5BCECDEABDBCE9EA9A17D5E5948171714010101000000000000000000000000		  4C493EDAC363C7A53AB99736745532534E3F1B1A160303030000000000000000		  000000000000000000000000000C0C0CB0AA8DDAC585AA792494875F03030300		  0000000000000000000000000000000000000000000000000000000000010101		  3A3936AD885CB78D29755F2C0000000000000000000000000000000000000000		  0000000000000000000000000000000000000026221F5746330C0C0C00000000		  0000000000000000000000000000000000000000000000000000}	  end	  object btnFechar: TBitBtn		Left = 543		Top = 59		Width = 75		Height = 25		Caption = 'Fechar'		TabOrder = 11		OnClick = btnFecharClick		Glyph.Data = {		  36030000424D3603000000000000360000002800000010000000100000000100		  1800000000000003000000000000000000000000000000000000000000000000		  8080800000808080800000000000000000000000000000000000000000000000		  000000000000000000000000000000800000800000FF00008000008000000000		  00000000000000000000000000800000800000800000000000008080800000FF		  0000800000800000FF0000800000800000000000000000000000800000FF0000		  800000FF0000800000000000008080800000800000FF0000800000800000FF80		  80808080800000FF000080000080000080000080000080808080000000000000		  0000000000800000FF0000800000FF0000800000FF0000800000FF0000800000		  FF0080808080800000000000000000000000000000000080800000FF00008000		  00FF0000800000FF008080000080000000000000000000000000000000000000		  0000000000000000000000800000FF0080800000FF0000800000800000000000		  000000000000000000000000000000000000000000008080800000FF0000FF00		  00800000FF0000FF008080000000000000000000000000000000000000000000		  0000000000000000FF0080800000FF0000FF0080800000FF0000FF8080800000		  000000000000000000000000000000000000000000FF0000FF0000FF00808000		  00FF0000FF0080800000FF0000FF0000FF000000000000000000000000000000		  0000000000FF0080800000FF0000FF8080800000800000FF0000FF0000FF0080		  800000FF0000FF0000000000000000000000000000FF0000FF0000FF00808000		  00000000000000800080800000FF0000FF0000FF008080000000000000000000		  0000000080800000FF0080800000000000000000008080800000800000800000		  FF0080800000800000000000000000000000000000800000FF00008000000000		  0000000000000000000000000080000080000080000000000000000000000000		  0000000000000000808080800000000000000000000000000000000000000000		  0000000000000000000000000000000000000000000000000000000000000000		  0000000000000000000000000000000000000000000000000000}	  end	  object edtAssunto: TEdit		Left = 341		Top = 86		Width = 150		Height = 21		TabOrder = 8	  end	  object ckbSSL: TCheckBox		Left = 505		Top = 15		Width = 136		Height = 17		Caption = 'Usar autenticação SSL.'		TabOrder = 9		OnClick = ckbSSLClick	  end	end  end  object Panel2: TPanel	Left = 0	Top = 129	Width = 225	Height = 183	Align = alLeft	BevelInner = bvLowered	BorderWidth = 4	TabOrder = 1	object MemoEnvio: TMemo	  Left = 6	  Top = 23	  Width = 213	  Height = 154	  Align = alClient	  BorderStyle = bsNone	  PopupMenu = PopupMenu1	  ScrollBars = ssVertical	  TabOrder = 0	end	object Panel3: TPanel	  Left = 6	  Top = 6	  Width = 213	  Height = 17	  Align = alTop	  BevelOuter = bvNone	  TabOrder = 1	  object lblTotalEMail: TLabel		Left = 4		Top = 2		Width = 110		Height = 13		Caption = 'Endereços para enviar:'	  end	end  end  object Panel9: TPanel	Left = 0	Top = 312	Width = 675	Height = 208	Align = alBottom	BevelInner = bvLowered	BorderWidth = 4	TabOrder = 4	object Panel8: TPanel	  Left = 6	  Top = 6	  Width = 474	  Height = 138	  Align = alClient	  BevelInner = bvLowered	  BorderWidth = 4	  TabOrder = 0	  object MemoTextoEnvio: TMemo		Left = 99		Top = 6		Width = 369		Height = 126		Align = alClient		BorderStyle = bsNone		ScrollBars = ssBoth		TabOrder = 0	  end	  object Panel14: TPanel		Left = 6		Top = 6		Width = 93		Height = 126		Align = alLeft		BevelOuter = bvNone		TabOrder = 1		object Label15: TLabel		  Left = 29		  Top = 2		  Width = 55		  Height = 13		  Caption = 'Mensagem:'		end		object rgModEnvio: TRadioGroup		  Left = 7		  Top = 64		  Width = 80		  Height = 57		  Caption = ' Modo Envio:'		  ItemIndex = 0		  Items.Strings = (			'Html'			'Texto')		  TabOrder = 1		end		object btnCarregarMsg: TBitBtn		  Left = 9		  Top = 25		  Width = 75		  Height = 25		  Caption = 'Carregar Msg'		  TabOrder = 0		  OnClick = btnCarregarMsgClick		end	  end	end	object Panel10: TPanel	  Left = 6	  Top = 144	  Width = 663	  Height = 58	  Align = alBottom	  BevelInner = bvLowered	  BorderWidth = 4	  TabOrder = 2	  object MemoStatus: TMemo		Left = 6		Top = 6		Width = 651		Height = 46		Align = alClient		BorderStyle = bsNone		ReadOnly = True		ScrollBars = ssVertical		TabOrder = 0	  end	end	object Panel11: TPanel	  Left = 480	  Top = 6	  Width = 189	  Height = 138	  Align = alRight	  BevelInner = bvLowered	  BorderWidth = 4	  TabOrder = 1	  object listArquivos: TListBox		Left = 6		Top = 23		Width = 177		Height = 109		Align = alClient		BorderStyle = bsNone		ItemHeight = 13		TabOrder = 1	  end	  object Panel15: TPanel		Left = 6		Top = 6		Width = 177		Height = 17		Align = alTop		BevelOuter = bvNone		TabOrder = 0		object Label16: TLabel		  Left = 4		  Top = 2		  Width = 38		  Height = 13		  Caption = 'Anexos:'		end		object btnAdicionarArquivo: TBitBtn		  Left = 57		  Top = 0		  Width = 60		  Height = 17		  Caption = 'Adicionar'		  TabOrder = 0		  OnClick = btnAdicionarArquivoClick		end		object btnRemoverArquivo: TBitBtn		  Left = 117		  Top = 0		  Width = 60		  Height = 17		  Caption = 'Remover'		  TabOrder = 1		  OnClick = btnRemoverArquivoClick		end	  end	end  end  object Panel7: TPanel	Left = 0	Top = 520	Width = 675	Height = 19	Align = alBottom	BevelOuter = bvNone	TabOrder = 5	object Label9: TLabel	  Left = 3	  Top = 3	  Width = 150	  Height = 13	  Caption = 'Desenvolvido por: Márcio Theis'	end	object Label10: TLabel	  Left = 297	  Top = 3	  Width = 114	  Height = 13	  Cursor = crHandPoint	  Caption = 'marcio.theis@gmail.com'	  Font.Charset = DEFAULT_CHARSET	  Font.Color = clBlue	  Font.Height = -11	  Font.Name = 'MS Sans Serif'	  Font.Style = [fsUnderline]	  ParentFont = False	  OnClick = Label10Click	end	object Label12: TLabel	  Left = 547	  Top = 3	  Width = 125	  Height = 13	  Cursor = crHandPoint	  Caption = 'http://www.plic-plac.com/'	  Font.Charset = DEFAULT_CHARSET	  Font.Color = clBlue	  Font.Height = -11	  Font.Name = 'MS Sans Serif'	  Font.Style = [fsUnderline]	  ParentFont = False	  OnClick = Label12Click	end	object Label13: TLabel	  Left = 506	  Top = 3	  Width = 38	  Height = 13	  Caption = 'Acesse:'	end	object Label14: TLabel	  Left = 263	  Top = 3	  Width = 32	  Height = 13	  Caption = 'E-Mail:'	end  end  object Panel6: TPanel	Left = 225	Top = 129	Width = 225	Height = 183	Align = alClient	BevelInner = bvLowered	BorderWidth = 4	TabOrder = 2	object MemoEnviado: TMemo	  Left = 6	  Top = 23	  Width = 213	  Height = 154	  Align = alClient	  BorderStyle = bsNone	  PopupMenu = PopupMenu1	  ReadOnly = True	  ScrollBars = ssVertical	  TabOrder = 0	end	object Panel12: TPanel	  Left = 6	  Top = 6	  Width = 213	  Height = 17	  Align = alTop	  BevelOuter = bvNone	  TabOrder = 1	  object Label17: TLabel		Left = 4		Top = 2		Width = 47		Height = 13		Caption = 'Enviados:'	  end	end  end  object Panel5: TPanel	Left = 450	Top = 129	Width = 225	Height = 183	Align = alRight	BevelInner = bvLowered	BorderWidth = 4	TabOrder = 3	object MemoRecusado: TMemo	  Left = 6	  Top = 23	  Width = 213	  Height = 154	  Align = alClient	  BorderStyle = bsNone	  PopupMenu = PopupMenu1	  ReadOnly = True	  ScrollBars = ssVertical	  TabOrder = 0	end	object Panel13: TPanel	  Left = 6	  Top = 6	  Width = 213	  Height = 17	  Align = alTop	  BevelOuter = bvNone	  TabOrder = 1	  object Label18: TLabel		Left = 4		Top = 2		Width = 57		Height = 13		Caption = 'Recusados:'	  end	end  end  object PopupMenu1: TPopupMenu	Left = 72	Top = 176	object Carregar1: TMenuItem	  Caption = 'Carregar'	  OnClick = Carregar1Click	end  end  object OpenDialog: TOpenDialog	DefaultExt = '*.txt'	Filter = 'Arquivos Texto|*.txt'	Left = 44	Top = 176  end  object IdSMTP: TIdSMTP	MaxLineAction = maException	Port = 25	AuthenticationType = atNone	Left = 280	Top = 24  end  object IdMessage: TIdMessage	AttachmentEncoding = 'MIME'	BccList = <>	CCList = <>	DeleteTempFiles = False	Encoding = meMIME	Recipients = <>	ReplyTo = <>	Left = 308	Top = 24  end  object IdAntiFreeze: TIdAntiFreeze	Left = 336	Top = 24  end  object IdSSLIOHandlerSocket: TIdSSLIOHandlerSocket	SSLOptions.Method = sslvSSLv2	SSLOptions.Mode = sslmUnassigned	SSLOptions.VerifyMode = []	SSLOptions.VerifyDepth = 0	Left = 252	Top = 24  end  object OpenDialogAnexo: TOpenDialog	Filter = 'Todos os Arquivos|*.*'	Title = 'Inserir Anexo'	Left = 496	Top = 375  endend

 

 

Arquivo .PAS

unit fPrincipal;interfaceuses  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,  Dialogs, StdCtrls, ExtCtrls, Menus, Buttons, Gauges, IdAntiFreezeBase,  IdAntiFreeze, IdMessage, IdBaseComponent, IdComponent, IdTCPConnection,  IdTCPClient, IdMessageClient, IdSMTP, IdIOHandler, IdIOHandlerSocket,  IdSSLOpenSSL, ShellAPI;type  TfrmPrincipal = class(TForm)	Panel1: TPanel;	GroupBox1: TGroupBox;	edtUsuario: TEdit;	Label1: TLabel;	Label2: TLabel;	edtSenha: TEdit;	Label3: TLabel;	edtServidor: TEdit;	edtPorta: TEdit;	Label4: TLabel;	ckbRequerAutenticacao: TCheckBox;	edtEMailEnvio: TEdit;	Label5: TLabel;	edtNomeEnvio: TEdit;	Label6: TLabel;	Label7: TLabel;	edtMaxEnvioConexao: TEdit;	Label8: TLabel;	Panel2: TPanel;	MemoEnvio: TMemo;	Panel3: TPanel;	lblTotalEMail: TLabel;	PopupMenu1: TPopupMenu;	Carregar1: TMenuItem;	OpenDialog: TOpenDialog;	Panel9: TPanel;	Gauge: TGauge;	IdSMTP: TIdSMTP;	IdMessage: TIdMessage;	IdAntiFreeze: TIdAntiFreeze;	btnEnviar: TBitBtn;	btnFechar: TBitBtn;	Label11: TLabel;	edtAssunto: TEdit;	IdSSLIOHandlerSocket: TIdSSLIOHandlerSocket;	Panel7: TPanel;	Label9: TLabel;	Label10: TLabel;	Label12: TLabel;	Label13: TLabel;	Label14: TLabel;	Panel8: TPanel;	MemoTextoEnvio: TMemo;	Panel10: TPanel;	Panel11: TPanel;	listArquivos: TListBox;	MemoStatus: TMemo;	Panel14: TPanel;	Label15: TLabel;	Panel15: TPanel;	Label16: TLabel;	btnAdicionarArquivo: TBitBtn;	btnRemoverArquivo: TBitBtn;	OpenDialogAnexo: TOpenDialog;	Panel6: TPanel;	MemoEnviado: TMemo;	Panel12: TPanel;	Label17: TLabel;	Panel5: TPanel;	MemoRecusado: TMemo;	Panel13: TPanel;	Label18: TLabel;	ckbSSL: TCheckBox;	rgModEnvio: TRadioGroup;	btnCarregarMsg: TBitBtn;	procedure Carregar1Click(Sender: TObject);	procedure btnFecharClick(Sender: TObject);	procedure btnEnviarClick(Sender: TObject);	procedure edtMaxEnvioConexaoExit(Sender: TObject);	procedure Label10Click(Sender: TObject);	procedure Label12Click(Sender: TObject);	procedure btnAdicionarArquivoClick(Sender: TObject);	procedure btnRemoverArquivoClick(Sender: TObject);	procedure ckbSSLClick(Sender: TObject);	procedure btnCarregarMsgClick(Sender: TObject);  private	{ Private declarations }	emailEnvio, nomeEnvio, usuario, servidor, senha, assunto: string;	enviadosConexao, porta, maxEnviosConexao: integer;	procedure Conecta;	procedure Desconecta;	procedure EnviarEmail(email: string);  public	{ Public declarations }  end;var  frmPrincipal: TfrmPrincipal;implementation{$R *.dfm}function RemoveEnter(texto: string): string;var   i: integer;   ret: string;beginret:='';for i:=1 to Length(texto) do	begin	if (texto[i] <> #13) and (texto[i] <> #10) then		ret:=ret + texto[i]	else		ret:=ret + '. ';	end;Result:=ret;end;function ConverteEnterBR(texto: string): string;var	i: integer;	ret: string;beginret:='';if (texto <> '') then	begin	for i:=1 to Length(texto) do		begin		if (texto[i] <> #13) and (texto[i] <> #10) then			ret:=ret + texto[i]		else			if ((texto[i] = #13) and (texto[i + 1] = #10)) then				ret:=ret + '<br>';		end;	end;ConverteEnterBR:=ret;end;procedure TfrmPrincipal.Carregar1Click(Sender: TObject);beginif OpenDialog.Execute then	begin	MemoEnvio.Clear;	MemoEnvio.Lines.LoadFromFile(OpenDialog.FileName);	end;end;procedure TfrmPrincipal.btnFecharClick(Sender: TObject);beginClose;end;procedure TfrmPrincipal.Conecta;beginif not IdSMTP.Connected then	begin	IdSMTP.UserName:=usuario;	IdSMTP.Host:=servidor;	if ((ckbRequerAutenticacao.Checked) and (senha <> '')) then		begin		IdSMTP.Password:=senha;		IdSMTP.AuthenticationType:=atLogin;		end;	if porta > 0 then		IdSMTP.Port:=porta	else		IdSMTP.Port:=25;	MemoStatus.Lines.Add('SMTP: ' + IdSMTP.Host + ':' + IntToStr(IdSMTP.Port));	IdSMTP.Connect;	enviadosConexao:=0;	if ckbRequerAutenticacao.Checked then		IdSMTP.Authenticate;	end;end;procedure TfrmPrincipal.Desconecta;beginif IdSMTP.Connected then	IdSMTP.Disconnect;end;procedure TfrmPrincipal.btnEnviarClick(Sender: TObject);var	x: integer;beginassunto:=edtAssunto.Text;usuario:=edtUsuario.Text;servidor:=edtServidor.Text;senha:=edtSenha.Text;emailEnvio:=edtEMailEnvio.Text;nomeEnvio:=edtNomeEnvio.Text;porta:=StrToInt(edtPorta.Text);maxEnviosConexao:=StrToInt(edtMaxEnvioConexao.Text);if MemoEnvio.Text <> '' then	lblTotalEMail.Caption:='Total de ' + IntToStr(MemoEnvio.Lines.Count) + ' E-Mails a enviar.'else	lblTotalEMail.Caption:='Total de 0 E-Mail a enviar.';if IdSMTP.Connected then	Desconecta();Conecta();if IdSMTP.Connected then	begin	Gauge.MaxValue:=MemoEnvio.Lines.Count - 1;	Gauge.Progress:=0;	Gauge.Visible:=True;	Gauge.Refresh;	for x:=0 to MemoEnvio.Lines.Count - 1 do		begin		EnviarEMail(MemoEnvio.Lines.Strings[x]);		Gauge.Progress:=Gauge.Progress + 1;		Gauge.Refresh;		end;	Gauge.Visible:=False;	Gauge.Refresh;	MemoStatus.Lines.Add('');	MemoStatus.Lines.Add('Mensagens enviadas');	MemoStatus.Lines.Add('Total de ' + IntToStr(MemoEnviado.Lines.Count) + ' emails enviados.');	MemoStatus.Lines.Add('Total de ' + IntToStr(MemoRecusado.Lines.Count) + ' emails não enviados.');	end;Desconecta();Application.MessageBox('Concluído envio !','Envio de E-Mail',MB_OK or MB_APPLMODAL or MB_ICONINFORMATION);end;procedure TfrmPrincipal.EnviarEmail(email: string);var   str: string;   lTextPart: TIdText;   lAnexo: TIdAttachment;   enviado: boolean;   x: integer;beginif maxEnviosConexao > 0 then	if enviadosConexao >= maxEnviosConexao then		begin		MemoStatus.Lines.Add('Atingido o limite de ' + IntToStr(maxEnviosConexao) + ' envios, fazer reconexão !');		Desconecta();		Conecta();		end;enviado:=False;str:='';IdMessage.Headers.Values['X-Library']:='';IdMessage.MessageParts.Clear;IdMessage.Recipients.EMailAddresses:=email;IdMessage.Subject:=assunto;IdMessage.ContentType:='text/html';lTextPart:=TIdText.Create(IDMessage.MessageParts);lTextPart.Body.Text:=' ';lTextPart.ContentType:='text/plain';lTextPart:=TIdText.Create(IdMessage.MessageParts);if (rgModEnvio.ItemIndex = 0) then	lTextPart.Body.Text:=MemoTextoEnvio.Textelse	lTextPart.Body.Text:='<html>' + ConverteEnterBR(MemoTextoEnvio.Text) + '</html>';lTextPart.ContentType:='text/html';for x:=0 to listArquivos.Items.Count-1 do	begin	lAnexo:=TIdAttachment.Create(IdMessage.MessageParts,listArquivos.Items.Strings[x]);	lAnexo.Headers.Add('Content-ID: <AnexoNro' + IntToStr(x) + '>');	end;IdMessage.From.Address:=emailEnvio;IdMessage.From.Name:=nomeEnvio;IdMessage.Priority:=mpNormal;try	IdSMTP.Send(IdMessage);	enviado:=True;except	on E: Exception do		MemoRecusado.Lines.Add(email + ' - Erro: ' + RemoveEnter(E.Message));	end;if enviado then	MemoEnviado.Lines.Add(email);Inc(enviadosConexao);end;procedure TfrmPrincipal.edtMaxEnvioConexaoExit(Sender: TObject);beginif Trim(edtMaxEnvioConexao.Text) = '' then	edtMaxEnvioConexao.Text:='100';end;procedure TfrmPrincipal.Label10Click(Sender: TObject);beginShellExecute(Application.Handle,nil,PChar('mailto:marcio.theis@gmail.com'),nil,nil,SW_SHOWNORMAL);end;procedure TfrmPrincipal.Label12Click(Sender: TObject);beginShellExecute(Application.Handle,nil,PChar('http://www.plic-plac.com/forum/'),nil,nil,SW_SHOWNORMAL);end;procedure TfrmPrincipal.btnAdicionarArquivoClick(Sender: TObject);beginif OpenDialogAnexo.Execute then	listArquivos.Items.Add(OpenDialogAnexo.FileName);end;procedure TfrmPrincipal.btnRemoverArquivoClick(Sender: TObject);beginlistArquivos.Items.Delete(listArquivos.ItemIndex);end;procedure TfrmPrincipal.ckbSSLClick(Sender: TObject);beginIdSMTP.IOHandler:=nil;if ckbSSL.Checked then	IdSMTP.IOHandler:=IdSSLIOHandlerSocket;end;procedure TfrmPrincipal.btnCarregarMsgClick(Sender: TObject);beginif OpenDialogAnexo.Execute then	MemoTextoEnvio.Lines.LoadFromFile(OpenDialogAnexo.FileName);end;end.
Precisa somente cuidar a configuração que colocar, como por exemplo a porta usada pelo gMail é a 465...

Qualquer problema coloque no tópico mesmo...

 

Se quiser, pode baixar os fontes já com as DLL necessárias aqui.

Compartilhar este post


Link para o post
Compartilhar em outros sites

Márcio,Gostaria de saber qual a versão da Indy você usou?Baixei o seu projeto e tentei abrir no Delphi 7 com a versão 9.0.18 e faltava uma propriedade "DeleteTempFiles".Desde já agradeço sua atenção.Wagner.

Compartilhar este post


Link para o post
Compartilhar em outros sites

Caro amigo, fiz o test e obtive sucesso. estou trabalhando em cima de um pequeno sis, pra poder esta tambem compartilhando ele com os colegas.

 

A mente que se abre a uma nova idéia jamais voltará ao seu tamanho original.

Compartilhar este post


Link para o post
Compartilhar em outros sites

Excelente exemplo e ajuda!

Estava com várias duvidas e alguns problemas de como enviar email no Delphi 7, e agora está tudo em perfeito estado.

Muito obrigado pelo exemplo marcio!!!

Compartilhar este post


Link para o post
Compartilhar em outros sites

baixei seu projeto e funcionou e é exatamente o que estou precisando mas tenho algumas dúvidas que são as seguintes:

 

1º caso na caixa de "Endereços a enviar" estejam mais de um e-mail ele envia como se fosse um unico e-mail ou um e-mail com varios endereços?

 

2º existe possibilidade de modificação no seu projeto para enviar como CC E/ou CCO?

 

3º qual a função da propriedade DeleteTempFiles?

Compartilhar este post


Link para o post
Compartilhar em outros sites

Prezado Márcio Theis, sei que faz um bom tempo, mas como estou precisando de uma ajuda no sentido de implementar em meu projeto o envio de email, peço ajuda sobre este erro:

 

Socket Error #10060

Connection timed out.

Compartilhar este post


Link para o post
Compartilhar em outros sites

×

Informação importante

Ao usar o fórum, você concorda com nossos Termos e condições.