1 Enviando e-mail via SMTP pelo indy ( Delphi 7 ) Sáb Mar 16, 2013 3:14 pm
Moedas : 11
Mensagens : 16
Humor : Bom
Reputação : 0
Mensagens : 16
Humor : Bom
Reputação : 0
TH3 CH4OS
Estagiário
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 no link abaixo:
[Tens de ter uma conta e sessão iniciada para poderes visualizar este link]
Após baixa-las, descompacte-as no diretório C:\WINDOWS\System32
Vamos ao programa
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 como a imagem abaixo:
[Tens de ter uma conta e sessão iniciada para poderes visualizar esta imagem]
o evento onclik do botão enviar digite o que esta em negrito:
no evento onclose do form digite o que esta de negrito abaixo:
no evento KeyPress do form digite o que esta em negrito abaixo:
no evento keydown do listbox adicione o que esta em negrito abaixo:
no evento onclik so botão anexo digite o que esta em negrito abaixo:
no evento onclik do popMenu Deletar anexo selecionado digite o que esta em negrito abaixo:
[/code]
procedure TForm1.mnuDeletarAnexoSelecionadoClick(Sender: TObject);
begin
if ListBoxAnexos.ItemIndex <> -1 then
ListBoxAnexos.DeleteSelected;
end;
[/code]
no evento onclik do popMenu Deletar todos anexos selecionado digite o que esta em negrito abaixo:
no evento Connected do IdSmtp digite o que esta em negrito abaixo:
no evento Disconnected do IdSmtp digite o que esta em negrito abaixo:
no evento onclik do BitBtn1 digite o que esta em negrito abaixo:
no evento onclik da Image1 digite o que esta em negrito abaixo:
no evento Create do form digite o que esta em negrito abaixo:
no evento onclik do Button digite o que esta em negrito abaixo:
Funcional com Gmail, Hotmail, Yahoo e ig
Creditos devmedia
libeay32.dll e ssleay32.dll. Elas podem ser encontradas no link abaixo:
[Tens de ter uma conta e sessão iniciada para poderes visualizar este link]
Após baixa-las, descompacte-as no diretório C:\WINDOWS\System32
Vamos ao programa
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 como a imagem abaixo:
[Tens de ter uma conta e sessão iniciada para poderes visualizar esta imagem]
- Código:
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;
o evento onclik do botão enviar digite o que esta em negrito:
- 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 o que esta de negrito abaixo:
- Código:
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
IdSMTP1.Disconnect;
end;
no evento KeyPress do form digite o que esta em negrito abaixo:
- Código:
procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin
cancelar:= (key = #27);
end;
no evento keydown do listbox adicione o que esta em negrito abaixo:
- 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 o que esta em negrito abaixo:
- 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 o que esta em negrito abaixo:
[/code]
procedure TForm1.mnuDeletarAnexoSelecionadoClick(Sender: TObject);
begin
if ListBoxAnexos.ItemIndex <> -1 then
ListBoxAnexos.DeleteSelected;
end;
[/code]
no evento onclik do popMenu Deletar todos anexos selecionado digite o que esta em negrito abaixo:
- Código:
procedure TForm1.DeletarTodososAnexos1Click(Sender: TObject);
begin
ListBoxAnexos.Clear;
end;
no evento Connected do IdSmtp digite o que esta em negrito abaixo:
- 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 o que esta em negrito abaixo:
- 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 TH3 CH4OS''#13+
''Fuck You!''#13 +
''''#13 +
''''),'''',mb_iconInformation);
end;
no evento onclik da Image1 digite o que esta em negrito abaixo:
- Código:
procedure TForm1.Image1Click(Sender: TObject);
begin
{declare " ShellAPI " na user}
ShellExecute(handle,''open'',''http://darkgames.forumeiros.com/u723'',nil,nil,SW_SHOWMAXIMIZED)
end;
no evento Create do form digite o que esta em negrito abaixo:
- 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 o que esta em negrito abaixo:
- Código:
procedure TForm1.Button1Click(Sender: TObject);
begin
close;
end;
end.
Funcional com Gmail, Hotmail, Yahoo e ig
Creditos devmedia