[firebase-br] enviar email para todos clientes

[Alysson Gonçalves de Azevedo]

Leia isso:
http://www.devarticles.com/c/a/Delphi-Kylix/Creating-an-SMTP-Server/


Alysson Gonçalves de Azevedo
(11) 8491-7730

(\(''^_^ )/)

"Pobre vive dizendo que não tem nada, mas quando vem a enchente, ele sai
gritando: -Perdi tudo!!!"



2010/11/5 Hugo Jose de Sousa <newprojectsystem em gmail.com>

> unit UEmailBoleto;
>
> interface
>
> uses
>  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
>  Dialogs, StdCtrls, Buttons, jpeg, ExtCtrls, PDJRotoLabel,
>  smtpsend, ssl_openssl, mimemess, mimepart, ComCtrls, Gauges;
> { Units para envio de email : smtpsend ssl_openssl mimemess mimepart,}
>
> type
>  TFEmailBoleto = class(TForm)
>    btnEnviarEmail: TBitBtn;
>    ProLabel1: TPDJRotoLabel;
>    TmTempo: TTimer;
>    img1: TImage;
>    GaugeEmail: TGauge;
>    lb1: TLabel;
>    procedure btnEnviarEmailClick(Sender: TObject);
>    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift:
> TShiftState);
>    procedure TmTempoTimer(Sender: TObject);
>    procedure FormShow(Sender: TObject);
>
>  private
>    { Private declarations }
>
>  public
>    { Public declarations }
>  end;
>  TSendMailThread = class(TThread)
>  private
>    FException: Exception;
>    procedure DoHandleException;
>  public
>    smtp: TSMTPSend;
>    sFrom: string;
>    sTo: string;
>    sCC: TStrings;
>    slmsg_Lines: TStrings;
>    constructor Create;
>    destructor Destroy; override;
>  protected
>    procedure Execute; override;
>    procedure HandleException;
>  end;
> procedure EnviarEmail(const sSmtpHost,
>  sSmtpPort,
>  sSmtpUser,
>  sSmtpPasswd,
>  sFrom,
>  sTo,
>  sAssunto: string;
>  boletoPdf: string;
>  sMensagem: TStrings;
>  SSL: Boolean;
>  EnviaPDF: Boolean = true;
>  sCC: TStrings = nil;
>  Anexos: TStrings = nil;
>  PedeConfirma: Boolean = False);
> var
>  FEmailBoleto: TFEmailBoleto;
>
> implementation
>
> uses
>  UImpDoc, UdmImpCS, FuncoesGeral, UdmPrincipal, StrUtils;
>
> {$R *.dfm}
>
> { TSendMailThread }
>
> procedure TSendMailThread.DoHandleException;
> begin
>  Sysutils.ShowException(FException, nil);
> end;
>
> constructor TSendMailThread.Create;
> begin
>  smtp := TSMTPSend.Create;
>  slmsg_Lines := TStringList.Create;
>  sCC := TStringList.Create;
>
>  sFrom := '';
>  sTo := '';
>
>  FreeOnTerminate := True;
>
>  inherited Create(True);
> end;
>
> destructor TSendMailThread.Destroy;
> begin
>  slmsg_Lines.Free;
>  sCC.Free;
>  smtp.Free;
>
>  inherited;
> end;
>
> procedure TSendMailThread.Execute;
> var
>  i: integer;
> begin
>  inherited;
>  try
>    if not smtp.Login() then
>      raise Exception.Create('SMTP ERROR: Login:' + smtp.EnhCodeString +
>        sLineBreak + smtp.FullResult.Text);
>
>    if not smtp.MailFrom(sFrom, Length(sFrom)) then
>      raise Exception.Create('SMTP ERROR: MailFrom:' + smtp.EnhCodeString +
>        sLineBreak + smtp.FullResult.Text);
>
>    if not smtp.MailTo(sTo) then
>      raise Exception.Create('SMTP ERROR: MailTo:' <'> + smtp.EnhCodeString
> +
>        sLineBreak + smtp.FullResult.Text);
>
>    if (sCC <> nil) then
>    begin
>      for I := 0 to sCC.Count - 1 do
>      begin
>        if not smtp.MailTo(sCC.Strings[i]) then
>          raise Exception.Create('SMTP ERROR: MailTo:' <'> +
> smtp.EnhCodeString +
>            sLineBreak + smtp.FullResult.Text);
>      end;
>    end;
>    if not smtp.MailData(slmsg_Lines) then
>      raise Exception.Create('SMTP ERROR: MailData:' + smtp.EnhCodeString +
>        sLineBreak + smtp.FullResult.Text);
>    if not smtp.Logout() then
>      raise Exception.Create('SMTP ERROR: Logout:' + smtp.EnhCodeString +
>        sLineBreak + smtp.FullResult.Text);
>  except
>    try
>      smtp.Sock.CloseSocket;
>    except
>    end;
>    HandleException;
>  end;
> end;
>
> procedure TSendMailThread.HandleException;
> begin
>  FException := Exception(ExceptObject);
>  try
>    {Não mostra mensagens de EAbort}
>    if not (FException is EAbort) then
>      Synchronize(DoHandleException);
>  finally
>    FException := nil;
>  end;
> end;
>
> procedure EnviarEmail(const sSmtpHost,
>  sSmtpPort,
>  sSmtpUser,
>  sSmtpPasswd,
>  sFrom,
>  sTo,
>  sAssunto: string;
>  boletoPdf: string;
>  sMensagem: TStrings;
>  SSL: Boolean;
>  EnviaPDF: Boolean = true;
>  sCC: TStrings = nil;
>  Anexos: TStrings = nil;
>  PedeConfirma: Boolean = False);
> var
>  ThreadSMTP: TSendMailThread;
>  m: TMimemess;
>  p: TMimepart;
>  StreamBoleto: TStringStream;
>
>  i: Integer;
> begin
>  m := TMimemess.create;
>  ThreadSMTP := TSendMailThread.Create;
>  { Não Libera, pois usa FreeOnTerminate := True}
>  StreamBoleto := TStringStream.Create('');
>  try
>    p := m.AddPartMultipart('mixed', nil);
>    if sMensagem <> nil then
>      m.AddPartText(sMensagem, p);
>
>    if (EnviaPDF) then
>    begin
>      m.AddPartBinaryFromFile(boletoPdf, p);
>    end;
>
>    if assigned(Anexos) then
>      for i := 0 to Anexos.Count - 1 do
>      begin
>        m.AddPartBinaryFromFile(Anexos[i], p);
>      end;
>
>    m.header.tolist.add(sTo);
>    m.header.From := sFrom;
>    m.header.subject := sAssunto;
>    m.Header.ReplyTo := sFrom;
>    if PedeConfirma then
>      m.Header.CustomHeaders.Add('Disposition-Notification-To: ' + sFrom);
>    m.EncodeMessage;
>
>    ThreadSMTP.sFrom := sFrom;
>    ThreadSMTP.sTo := sTo;
>
>    if sCC <> nil then
>      ThreadSMTP.sCC.AddStrings(sCC);
>    ThreadSMTP.slmsg_Lines.AddStrings(m.Lines);
>
>    ThreadSMTP.smtp.UserName := sSmtpUser;
>    ThreadSMTP.smtp.Password := sSmtpPasswd;
>
>    ThreadSMTP.smtp.TargetHost := sSmtpHost;
>    ThreadSMTP.smtp.TargetPort := sSmtpPort;
>
>    ThreadSMTP.smtp.FullSSL := SSL;
>    ThreadSMTP.smtp.AutoTLS := True;
>
>    ThreadSMTP.Resume; { inicia a thread }
>
>  finally
>    m.free;
>    StreamBoleto.Free;
>  end;
> end;
> ______________________________________________
> FireBase-BR (www.firebase.com.br) - Hospedado em www.locador.com.br
> Para saber como gerenciar/excluir seu cadastro na lista, use:
> http://www.firebase.com.br/fb/artigo.php?id=1107
> Para consultar mensagens antigas: http://firebase.com.br/pesquisa
>