Ajuda enviar email com thread?

Delphi

16/09/2011

Não estou conseguindo usar a thread

Chamo assim
//Clientes com pendencias
      while not Qr_Clientes.Eof do
      begin
        CriaEmail;
        if EnviarEmail then
          MarcarEnvio
        else
          OcorreuErro:= True;
        Qr_Clientes.Next;
        F_Aguarde.Lbl_Mensagem.Caption:= IntToStr(Trunc(100 * Qr_Clientes.RecNo / Qr_Clientes.RecordCount)) + '% Concluído';
        Application.ProcessMessages;
      end;


Este [b]if EnviarEmail then[/b] é a função original que ja esta no sistema, e que funciona.

Agora quero ver se da pra colocar numa thread para não ficar bloqueado o sistema
Aqui esta o codigo da função aonde estou chamando a thread, e comentei o codigo abaiixo que funciona
function TF_Enviar_Email_Titulos_Vencidos.EnviarEmail: Boolean;
var
  Nome_Remetente, Email_Remetente,
  Assunto_Email, Servidor_SMTP,
  Usuario, Senha: String;
begin
  with TIniFile.Create(ExtractFilePath(ParamStr(0)) + 'Email\Configuracoes.ini') do
  try
    Nome_Remetente:= ReadString('EMAIL_EMPRESA', 'NOME_EMPRESA', '');
    Email_Remetente:= ReadString('EMAIL_EMPRESA', 'EMAIL_EMPRESA', '');
    Assunto_Email:= ReadString('EMAIL_EMPRESA', 'ASSUNTO_EMAIL_EMPRESA', '');
    Servidor_SMTP:= ReadString('EMAIL_EMPRESA', 'SERVIDOR_SMTP_EMPRESA', '');
    Usuario:= ReadString('EMAIL_EMPRESA', 'USUARIO_EMPRESA', '');
    Senha:= ED(False, ReadString('EMAIL_EMPRESA', 'SENHA_EMPRESA', ''));
  finally
    Free;
  end;

  if (Servidor_SMTP = '') or (Usuario = '') or (Senha = '') then
  begin
    ShowMessage(443, 2);
    Abort;
  end;
  
  //Chama a classe da thread
  TMail.Create(Nome_Remetente,
                Email_Remetente,
                Trim(Qr_Clientes.FieldByName('EMAIL').AsString), //Email do destinatário
                Assunto_Email,
                Servidor_SMTP,
                Usuario,
                Senha,
                'Email\Temp\TempAvisoBloqueioVarios.html');
{

  with IdMsgSend do
  begin
    IdMsgSend.Clear;
    From.Name:= Nome_Remetente;
    From.Address:= Email_Remetente;
    Recipients.EMailAddresses:= Trim(Qr_Clientes.FieldByName('EMAIL').AsString);
    Subject:= Assunto_Email;
    ContentType:= 'multipart/related';
    Priority:= mpHigh;
  end;

  with TIdText.Create(IdMsgSend.MessageParts) do
     ContentType := 'text/plain';

  with TIdText.Create(IdMsgSend.MessageParts) do
  begin
    ContentType:= 'text/html';
    Body.LoadFromFile(ExtractFilePath(ParamStr(0)) + 'Email\Temp\TempAvisoBloqueioVarios.html');
  end;

  with TIdAttachment.Create(IdMsgSend.MessageParts, ExtractFilePath(ParamStr(0)) + 'Email\imagem.jpg') do
  begin
    ContentType:= 'image/jpeg';
    ContentDisposition:= 'inline; filename="imagem.jpg"';
    ExtraHeaders.Add('content-id:imagem.jpg');
  end;

  try
    with SMTP do
    begin
      Host:= Servidor_SMTP;
      Username:= Usuario;
      Password:= Senha;

      try
        Connect;
        Send(IdMsgSend);
        Result:= True;
      finally
        if Connected then
        try
          Disconnect;
        except
        end;
      end;
    end;
  except
    Result:= False;
  end; }
end;


E aqui esta a thread que fiz e não funciona
unit U_EnviaEmail;

interface

uses
  Classes, IdComponent, IdTCPConnection, IdTCPClient, IdMessageClient, IdSMTP,
  IdBaseComponent, IdMessage, IdAntiFreezeBase, IdAntiFreeze, IniFiles,
  SysUtils, Mensagem, Criptografia, ActiveX, Forms, Dialogs;

type
  TMail = class(TThread)
  private
    FEmailCliente: String;
    FEmail_Remetente: String;
    FSenha: String;
    FUsuario: String;
    FAssunto_Email: String;
    FServidor_SMTP: String;
    FNome_Remetente: String;
    Path_HTML: String; //Caminho aonde está o arquivo HTML
    procedure SetAssunto_Email(const Value: String);
    procedure SetEmail_Remetente(const Value: String);
    procedure SetEmailCliente(const Value: String);
    procedure SetNome_Remetente(const Value: String);
    procedure SetSenha(const Value: String);
    procedure SetServidor_SMTP(const Value: String);
    procedure SetUsuario(const Value: String);
  public
    constructor Create(sNomeRementente, sEmailRemetente, sEmailDestinatario,
       sAssunto, sServidor_SMTP, sUsuario, sSenha, sTextoMensagem: String);
    destructor Destroy; override;
    //Método execuite da thread
    procedure Execute; override;
    //Propriedades associadas (encapsulamentos)
    property Nome_Remetente: String read FNome_Remetente write SetNome_Remetente;
    property Email_Remetente: String read FEmail_Remetente write SetEmail_Remetente;
    property EmailCliente: String read FEmailCliente write SetEmailCliente;
    property Assunto_Email: String read FAssunto_Email write SetAssunto_Email;
    property Servidor_SMTP: String read FServidor_SMTP write SetServidor_SMTP;
    property Usuario: String read FUsuario write SetUsuario;
    property Senha: String read FSenha write SetSenha;
  end;

var
  IdMessage1: TIdMessage;
  IdSMTP1: TIdSMTP;

implementation

{ TMail }

//Métodos constructor e destructor
constructor TMail.Create(sNomeRementente, sEmailRemetente, sEmailDestinatario,
       sAssunto, sServidor_SMTP, sUsuario, sSenha, sTextoMensagem: String);
begin
  inherited Create(False);
  //Cria os componentes de acesso
  IdMessage1 := TIdMessage.Create(nil);
  IdSMTP1:= TIdSMTP.Create(nil);
  //
  FNome_Remetente  := sNomeRementente;
  FEmail_Remetente := sEmailRemetente;
  FEmailCliente    := sEmailDestinatario;
  FAssunto_Email   := sAssunto;
  FServidor_SMTP   := sServidor_SMTP;
  FUsuario         := sUsuario;
  FSenha           := sSenha;
  Path_HTML        := sTextoMensagem;
end;

destructor TMail.Destroy;
begin
  IdSMTP1.Free;
  IdMessage1.Free;
  inherited Destroy;
end;

procedure TMail.Execute;
begin
  IdSMTP1.AuthenticationType := atLogin; { Conexão com autenticação }
  IdSMTP1.Host := FServidor_SMTP;  {Servidor  }
  IdSMTP1.Password := FSenha;  { Senha }
  IdSMTP1.Port := 25;  { porta é sempre essa não mude isso se não mudar no servidor }
  IdSMTP1.Username := FUsuario; { Usuario }
  //-------------------------Mensagens-------------------------
  IdMessage1.From.Address := FEmail_Remetente; {rementente  email }

  with TIdText.Create(IdMessage1.MessageParts) do
    ContentType := 'text/plain';

  with TIdText.Create(IdMessage1.MessageParts) do
  begin
    ContentType := 'text/html';
    Body.LoadFromFile(ExtractFilePath(ParamStr(0)) + Path_HTML);
  end;

  //Este caminho sempre será este aqui
  with TIdAttachment.Create(IdMessage1.MessageParts, ExtractFilePath(ParamStr(0)) + 'Email\imagem.jpg') do
  begin
    ContentType := 'image/jpeg';
    ContentDisposition := 'inline; filename="imagem.jpg"';
    ExtraHeaders.Add('content-id:imagem.jpg');
  end;

  IdMessage1.Recipients.EMailAddresses := FEmailCliente; { o email do destinatário }
  IdMessage1.Subject := FAssunto_Email; { assunto da mensagem }
  IdMessage1.ContentType := 'multipart/related';
  IdMessage1.Priority := mpHigh;
  //-----------------Conexão com o servidor-------------
  IdSMTP1.Connect; { conecta ao servidor de email }
  try
    IdSMTP1.Send(IdMessage1); { envia a menssagem }
    //Close;
  finally
    IdSMTP1.Disconnect; { Disconecta do servidor }
  end;
end;

procedure TMail.SetAssunto_Email(const Value: String);
begin
  FAssunto_Email := Value;
end;

procedure TMail.SetEmail_Remetente(const Value: String);
begin
  FEmail_Remetente := Value;
end;

procedure TMail.SetEmailCliente(const Value: String);
begin
  FEmailCliente := Value;
end;

procedure TMail.SetNome_Remetente(const Value: String);
begin
  FNome_Remetente := Value;
end;

procedure TMail.SetSenha(const Value: String);
begin
  FSenha := Value;
end;

procedure TMail.SetServidor_SMTP(const Value: String);
begin
  FServidor_SMTP := Value;
end;

procedure TMail.SetUsuario(const Value: String);
begin
  FUsuario := Value;
end;

end.

Alguem por favor pode me ajudar a resolver isso?

Obrigado.
Adriano Dolce

Adriano Dolce

Curtidas 0

Respostas

Emerson Nascimento

Emerson Nascimento

16/09/2011

......
GOSTEI 0
Emerson Nascimento

Emerson Nascimento

16/09/2011

não consigo postar minha sugestão por aqui.

te mandei um email. veja se resolve o seu problema.
GOSTEI 0
Adriano Dolce

Adriano Dolce

16/09/2011

não consigo postar minha sugestão por aqui.

te mandei um email. veja se resolve o seu problema.
Olá amigo, vi seu email sim, inclusive mandei outro pra vc ver se tem como fazer daquela forma...

Obrigado Emerson.
GOSTEI 0
POSTAR