O Gmail utiliza um sistema de criptografia chamado SSL, e para podermos conectar nossa aplicação à ele necessitamos de duas DLLs especificas: libeay32.dll e ssleay32.dll. Elas podem ser encontradas junto ao download desse artigo.
Após baixa-las, descompacte-as no diretório C:\WINDOWS\System32.
Vamos ao programa: abra 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 como a Figura 1 mostra.
- 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 ao código mostrado nas Listagens 1 a 13.
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;Listagem 1. Evento OnClick do botão enviar
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
IdSMTP1.Disconnect;
end;Listagem 2. Evento OnClose do form
procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin
cancelar:= (key = #27);
end;Listagem 3. Evento OnKeyPress do form
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;Listagem 4. Evento OmKeyDown do listbox
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;Listagem 5. Evento OnClick do botão anexo
procedure TForm1.mnuDeletarAnexoSelecionadoClick(Sender: TObject);
begin
if ListBoxAnexos.ItemIndex <> -1 then
ListBoxAnexos.DeleteSelected;
end;Listagem 6. Evento OnClick do popMenu Deletar anexo selecionado
procedure TForm1.DeletarTodososAnexos1Click(Sender: TObject);
begin
ListBoxAnexos.Clear;
end;Listagem 7. Evento OnClick do popMenu Deletar todos anexos selecionados
procedure TForm1.IdSMTP1Connected(Sender: TObject);
begin
StatusBar1.Panels[0].Text:= 'Conectado';
end;Listagem 8. Evento OnConnected do IdSmtp
procedure TForm1.IdSMTP1Disconnected(Sender: TObject);
begin
StatusBar1.Panels[1].Text:= 'Desconectado';
end;Listagem 9. Evento OnDisconnected do IdSmtp
aprocedure 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;Listagem 10. Evento Onclick do BitBtn1
procedure TForm1.Image1Click(Sender: TObject);
begin
{declare " ShellAPI " na user}
ShellExecute(handle,''open'',''www.websitebauru.vai.la'',nil,nil,
SW_SHOWMAXIMIZED)
end;Listagem 11. Evento OnClick da Image1
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;Listagem 12. Evento OnCreate do form
procedure TForm1.Button1Click(Sender: TObject);
begin
Close;
end;Listagem 13. Evento OnCclik do Button fechar
Com esses códigos você conseguirá enviar email para todo tipo de email, como Gmail, Hotmail, Yahoo entre outros.
