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;
Organização da tela
Figura 1. Organização da tela

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.