Clube da Programação e Hardware

Tutorial, dicas, Programação, Hardware entre outros assuntos.
 
InícioInício  CalendárioCalendário  FAQFAQ  BuscarBuscar  MembrosMembros  GruposGrupos  Registrar-seRegistrar-se  Login  

Compartilhe | 
 

 Envio de E-mail em massa, usando o Gmail e Componente Indy (Delphi)

Ver o tópico anterior Ver o tópico seguinte Ir em baixo 
AutorMensagem
Moderador
Admin


Mensagens : 30
Data de inscrição : 18/01/2011

MensagemAssunto: Envio de E-mail em massa, usando o Gmail e Componente Indy (Delphi)   Sex Out 12, 2012 9:34 am

O Gmail utiliza um sistema de criptografia chamado SSL, e para podermos conectar nossa aplicação à ele, necessitamos de duas dlls especificas:

baixe esta ddls. libeay32.dll e ssleay32.dll.
apos baixadas, adicione-as no diretorio : C:\WINDOWS\System32


abre um novo projeto e salve-os :

USendMail.pas

SendMail.dpr


adicione os componentes:

Standard
1) PopMenu
1) ListBox
1) Memo
1) GroupBox
1) CheckBox
10) Label
9) Edit
1)Button

indy Clients
1) IdSMTP
indy Misc
1)IdMessage
1) IdAntiFreeze
indy I/O Handles
1)IdISSLOHANDLERSocket

Dialogs
1) OpenDialog

Additional
2) BitBtn
1) SpeedButton


Samples
1) Gauge

Win32
1) StatusBar

configure e renomeie as propriedades

btnEnviar: TBitBtn;
ScrollBox1: TScrollBox;
pg1: TGauge;
StatusBar1: TStatusBar;
Label1: TLabel;
EdtNum: TEdit;
EdtAssunto: TEdit;
Label2: TLabel;
EdtOrigem: TEdit;
Label3: TLabel;
Label5: TLabel;
mmoMsg: TMemo;
Label6: TLabel;
EdtSMTP: TEdit;
Label7: TLabel;
EdtUsuario: TEdit;
Label8: TLabel;
EdtSenha: TEdit;
GroupBox1: TGroupBox;
Label4: TLabel;
Label9: TLabel;
Label10: TLabel;
EdtPara: TEdit;
EdtCC: TEdit;
EdtBCC: TEdit;
CheckBox1: TCheckBox;
ListBoxAnexos: TListBox;
Label11: TLabel;
btnAnexo: TSpeedButton;
OpenDialog1: TOpenDialog;
PopupMenu1: TPopupMenu;
mnuDeletarAnexoSelecionado: TMenuItem;
DeletarTodososAnexos1: TMenuItem;
BitBtn3: TBitBtn;
IdSMTP1: TIdSMTP;
IdMessage1: TIdMessage;
SSLSocket: TIdSSLIOHandlerSocket;
Button1: TButton;
IdAntiFreeze1: TIdAntiFreeze;
Image1 : TImage;

vamos para o código

no evento onclik do botão enviar digite :

Código:
procedure TForm1.btnEnviarClick(Sender: TObject);
var
i: integer;
begin
try
cancelar:= false;
Screen.Cursor:= crHourGlass;
btnEnviar.Enabled:= false;
pg1.MaxValue := StrToInt(EdtNum.Text);
pg1.Progress := 0;
IdSMTP1.Host := EdtSMTP.Text;
IdSMTP1.Username:= EdtUsuario.Text;
IdSMTP1.Password := EdtSenha.Text;

if CheckBox1.Checked then
IdSMTP1.AuthenticationType:= atLogin
else IdSMTP1.AuthenticationType:= atNone;

IdMessage1.MessageParts.Clear;
if ListBoxAnexos.Items.Count > 0 then
begin
for i:= 0 to ListBoxAnexos.Items.Count - 1 do
TIdAttachment.Create(IdMessage1.MessageParts, ListBoxAnexos.Items[i]);
end;

IdMessage1.From.Address:= EdtOrigem.Text;
IdMessage1.Subject:= EdtAssunto.Text;
{podem tirar a linha abaixo se vcs quiserem}
IdMessage1.Body.Text := mmoMsg.Lines.Text;


            IdMessage1.ContentType:='text/html';
  {aqui eu coloquei  codigo html  e todos estão marcados com *  } 
IdMessage1.Body.Add('<*html><*body>');
    IdMessage1.Body.Add('<*p><*a href="http://marcos.sytes.net/comprar/index.php"><*img src="http://www.websitebauru.110mb.com/compra.gif"><*/a><*/p>');
    IdMessage1.Body.Add('<*p><*hr><*/p><*br>'+mmoMsg.Text);
    IdMessage1.Body.Add('<*/body><*/html>');


IdMessage1.Recipients.EMailAddresses := EdtPara.Text;
IdMessage1.BccList.EMailAddresses := EdtBCC.Text;
IdMessage1.CCList.EMailAddresses := EdtCC.Text;

if not IdSMTP1.Connected then
IdSMTP1.Connect();
for i:= 1 to pg1.MaxValue do
begin
IdSMTP1.Send(IdMessage1);
if cancelar and (Application.MessageBox(''Deseja cancelar o processo?'',
''Confirmação'',mb_iconQuestion + mb_YesNo + mb_DefButton2) = mrYes) then
break;
cancelar:= false;
pg1.AddProgress(1);
Application.ProcessMessages;
end;
finally
IdSMTP1.Disconnect;
Screen.Cursor:= crDefault;
btnEnviar.Enabled:= true;
end;
end;

no evento onclose do form digite :

Código:
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
IdSMTP1.Disconnect;
end;

no evento KeyPress do form digite :

Código:
procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin
cancelar:= (key = #27);
end;

no evento keydown do listbox adicione :

Código:
procedure TForm1.ListBoxAnexosKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if key = vk_insert then
btnAnexo.Click
else if key = vk_delete then
mnuDeletarAnexoSelecionado.Click;
end;

no evento onclik so botão anexo digite :

Código:
procedure TForm1.btnAnexoClick(Sender: TObject);
var i: integer;
begin
if OpenDialog1.Execute then
begin
for i:= 0 to OpenDialog1.Files.Count -1 do
if (ListBoxAnexos.Items.IndexOf(OpenDialog1.Files[i]) = -1) then
ListBoxAnexos.Items.Add(OpenDialog1.Files[i])
end;
end;

no evento onclik do popMenu Deletar anexo selecionado digite :

Código:
procedure TForm1.mnuDeletarAnexoSelecionadoClick(Sender: TObject);
begin
if ListBoxAnexos.ItemIndex <> -1 then
ListBoxAnexos.DeleteSelected;
end;


no evento onclik do popMenu Deletar todos anexos selecionado digite :

Código:
procedure TForm1.DeletarTodososAnexos1Click(Sender: TObject);
begin
ListBoxAnexos.Clear;
end;

no evento Connected do IdSmtp digite :

Código:
procedure TForm1.IdSMTP1Connected(Sender: TObject);
begin
StatusBar1.Panels[0].Text:= ''Conectado'';
end;

no evento Disconnected do IdSmtp digite o que esta em negrito abaixo:

Código:
procedure TForm1.IdSMTP1Disconnected(Sender: TObject);
begin
StatusBar1.Panels[1].Text:= ''Desconectado'';
end;

no evento onclik do BitBtn1 digite :

Código:
procedure TForm1.BitBtn1Click(Sender: TObject);
begin

Application.MessageBox(pchar(''Sistema de Envio de E-Mails Completo''#13 +
''Utilizando Componentes Indy''#13#13 +
''atualizado por Marcos Pacheco''#13+
''Hacker Bauru''#13 +
''Site: www.websitebauru.vai.la''#13 +
''E-Mail: mgp.1978@hotmail.com''),''Sobre'',mb_iconInformation);
end;

no evento onclik da Image1 digite :

Código:
procedure TForm1.Image1Click(Sender: TObject);
begin
{declare  " ShellAPI "  na user}
ShellExecute(handle,''open'',''www.websitebauru.vai.la'',nil,nil,SW_SHOWMAXIMIZED)
end;


no evento Create do form digite :

Código:
procedure TForm1.FormCreate(Sender: TObject);
begin
with IdSMTP1 do
begin
AuthenticationType := atLogin;
Host := EdtSMTP.Text;
IOHandler := SSLSocket;
Password := EdtSenha.Text;
Port := 465;
Username := EdtUsuario.Text;
end;
SSLSocket.SSLOptions.Method := sslvSSLv2;
SSLSocket.SSLOptions.Mode := sslmClient;
end;

no evento onclik do Button digite :

Código:
procedure TForm1.Button1Click(Sender: TObject);
begin
close;
end;
end.

Espero que este exemplo seja util para muitos, deixe sua resposta se lhe foi util.

Voltar ao Topo Ir em baixo
Ver perfil do usuário http://netdicas.forumfacil.net
 
Envio de E-mail em massa, usando o Gmail e Componente Indy (Delphi)
Ver o tópico anterior Ver o tópico seguinte Voltar ao Topo 
Página 1 de 1
 Tópicos similares
-
» [FAQ] Envio de Mensagens Privadas em massa
» Não consigo enviar e-mail em massa
» Novo recurso para envio de Mensagens Privada em massa
» Erro envio de e-mail via outlook no windows server 2003
» Envio de Mensagens privadas para o e-mail após limite

Permissão deste fórum:Você não pode responder aos tópicos neste fórum
Clube da Programação e Hardware :: DICAS :: Dicas Diversas-
Ir para: