ActiveDelphi - Índice do Fórum ActiveDelphi
.: O site do programador Delphi! :.
 
 FAQFAQ   PesquisarPesquisar   MembrosMembros   GruposGrupos   RegistrarRegistrar 
 PerfilPerfil   Entrar e ver Mensagens ParticularesEntrar e ver Mensagens Particulares   EntrarEntrar 

Problema com IdSMTP

 
Novo Tópico   Responder Mensagem    ActiveDelphi - Índice do Fórum -> Delphi
Exibir mensagem anterior :: Exibir próxima mensagem  
Autor Mensagem
DarkProgrammer
Novato
Novato


Registrado: Terça-Feira, 11 de Setembro de 2012
Mensagens: 33
MensagemEnviada: Seg Set 18, 2017 9:06 pm    Assunto: Problema com IdSMTP Responder com Citação
Olá pessoal, estou precisando da ajuda de vocês. vou postar o código e logo abaixo o problema.

Código:
unit SMTP;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  IdSMTP, IdSSLOpenSSL, IdMessage, IdText, IdAttachmentFile, IdExplicitTLSClientServerBase, System.Win.ScktComp;

type
  TSMTP = class(TThread)
  private
    TAccount   : AnsiString;
    TName      : AnsiString;
    TLastName : AnsiString;
    TEmail     : AnsiString;
    TSocket    : TCustomWinSocket;
    function SendCode() : Boolean;
    { Private declarations }
  protected
    procedure Execute; override;
  public
  function SMTPCon(Port : Integer; SMTP : AnsiString; User : AnsiString; Password : AnsiString) : Boolean;
  constructor Create (const CreateSuspended      : Boolean;
                        const Account        : AnsiString;
                          const Name         : AnsiString;
                            const LastName   : AnsiString;
                              const Email    : AnsiString;
                                const Socket : TCustomWinSocket);
  end;

var
  IdSMTP: TIdSMTP;

implementation
uses GDefs, uFrmP, GenerateCode;

{ TSMTP }
function TSMTP.SMTPCon(Port: Integer; SMTP, User,Password: AnsiString): Boolean;
var
  IdSSLIOHandlerSocket: TIdSSLIOHandlerSocketOpenSSL;
begin
  Result:= False;

  LoadOpenSSLLibrary;
  IdSSLIOHandlerSocket := TIdSSLIOHandlerSocketOpenSSL.Create(nil);
  IdSMTP    := TIdSMTP.Create(nil);

  try
    if (MyData.SMAuth) then
      IdSMTP.AuthType  := satDefault
    else
      IdSMTP.AuthType  := satNone;

    if (MyData.SMSSL)  then
    begin
      IdSSLIOHandlerSocket.SSLOptions.Method := sslvSSLv23;
      IdSSLIOHandlerSocket.SSLOptions.Mode   := sslmClient;
      IdSMTP.IOHandler := IdSSLIOHandlerSocket;
      IdSMTP.UseTLS    := utUseImplicitTLS;
    end
    else
      IdSMTP.IOHandler := nil;

    IdSMTP.Port      := Port;
    IdSMTP.Host      := SMTP;
    IdSMTP.Username  := User;
    IdSMTP.Password  := Password;

    try
      IdSMTP.ReadTimeout    := MyData.SMReadTimeout;
      IdSMTP.ConnectTimeout := MyData.SMConnectTimeout;
      IdSMTP.Connect;
      IdSMTP.Authenticate;
      Logger.Write(Format('Guaranteed SMTP access [User: %s | Server: %s]',[User, SMTP]), clGreen);
    except
      on E: Exception do
      begin
        Logger.Write(Format('Error in SMTP Authentication [Class: %s | Message: %s]',[E.ClassName, E.Message]), clGray);
        Exit;
      end;
    end;
  finally
    Result:= True;
  end;
end;

constructor TSMTP.Create(const CreateSuspended: Boolean; const Account,
  Name, LastName, Email: AnsiString; const Socket: TCustomWinSocket);
begin
  Self.TAccount  := Account;
  Self.TName     := Name;
  Self.TLastName := LastName;
  Self.TEmail    := Email;
  Self.TSocket   := Socket;
  inherited Create(CreateSuspended);
end;

procedure TSMTP.Execute;
begin
  inherited;
  SendCode();
end;

function TSMTP.SendCode: Boolean;
var
  IdMessage: TIdMessage;
  IdText: TIdText;
  i : Integer;
begin
  IdMessage := TIdMessage.Create(nil);
  try
    IdMessage.From.Address := MyData.SMUSer ; //Email de quem manda
    IdMessage.From.Name    :=  MyData.SYCompany; // Nome de quem manda
    IdMessage.ReplyTo.EMailAddresses := IdMessage.From.Address;//Email de quem manda para réplica
    IdMessage.Recipients.Add.Text := Self.TEmail; //Quem irá receber
    IdMessage.Subject := MyData.SYSMSubject;  //Assunto
    IdMessage.Encoding := meMIME;

    for i := 0 to Length(Player) -1 do
    if (Player[i].Status) and (Player[i].Socket = Self.TSocket) then
    begin
      Player[i].AuthCode:= GetHash(5);
      Break;
    end;

    IdText := TIdText.Create(IdMessage.MessageParts);
    IdText.Body.Add('<html>');
    IdText.Body.Add('<body>');
    IdText.Body.Add(Format('Hello <i> %s %s.</i>',[Self.TName, Self.TLastName]));
    IdText.Body.Add(Format('<br><br>'+ MyData.SYMessage, [Self.TAccount]));
    IdText.Body.Add(Format('<br><br> AuthCode: <i> <font> %s </i> </font>',[Player[i].AuthCode]));
    IdText.Body.Add(Format('<br><br> Best regards, <br> <i> %s </i>',[MyData.SYCompany]));
    IdText.Body.Add('</body>');
    IdText.Body.Add('</html>');
    IdText.ContentType := 'text/html; charset=iso-8859-1';

    try
      IdSMTP.Send(IdMessage);
      Logger.Write(Format('Code sended [Socket: %d | Account: %s | Email: %s | Code: %s]',[Self.TSocket.Handle, Self.TAccount, Self.TEmail,Player[i].AuthCode]), clBlue);
      if FrmP.cPacket($B11F,$AA,$00000000) then
        Self.TSocket.SendBuf(Build, SizeOf(Build));
    except
      On E:Exception do
      begin
        Logger.Write(Format('Error sending code [Class: %s | Message: %s]',[E.ClassName, E.Message]), clRed);
      end;
    end;

  finally
    FreeAndNil(IdMessage);
    FreeAndNil(IdText);
  end;
end;

end.


Bom, esssas 2 funções tem como objetivo estabelecer a conexão a um servidor SMTP e enviar mensagem para determinado e-mail.

Primeiramente logo quando meu projeto é aberto, eu faço a conexão SMTP chamando a função "SMTPCon" dessa maneira.

SMTPS.SMTPCon(MyData.SMPort, MyData.SMServer, MyData.SMUSer, MyData.SMPass);

Até ai tudo bem, conexão estabelecida com sucesso.

Bom, minha aplicação server-side tem como objetivo controlar os usuários que estão logando no lado do cliente. Logo quando um usuário faz login, eu tenho que enviar um e-mail pra ele com um código, no qual ele irá usar para autenticar sua conta, e para isso eu crio o constructor Create da classe TThread passando todos os parâmetros, e logo depois a função SendCode é chamada.

SMTPS:= TSMTP.Create(False, Player[i].Account, Player[i].Date.Name, Player[i].Date.LastName, Player[i].Date.Email, Socket)

Eis agora o problema. Se 2 ou mais usuários logam ao mesmo tempo, a função me retorna erros.
[Class: EIdReadTimeout | Message: Read timed out.]
[Class: EIdSocketError | Message: Socket Error # 10060
Connection timed out.]
E a partir daí a função buga, e não manda e-mail para ninguém mais, só reiniciando a aplicação para voltar ao normal.

Pois bem, em contra partida, se um usuário loga e a função envia o e-mail e outro usuário loga em seguida, a função funciona normalmente enviando o e-mail para este usuário também.

Na minha teoria creio que o problema esteja na chamada da thread, que chamando mais de 1 no mesmo tempo a função está bugando. Eu necessito de usar uma thread, caso contrário a aplicação vai travar por conta do delay do envio da mensagem.
Até o momento não achei uma solução, caso alguém queira tentar me ajudar eu postei a unit toda la em cima, basta remover as coisas desnecessárias que irá compilar.

Agradeço.
Voltar ao Topo
Ver o perfil de Usuários Enviar Mensagem Particular
DarkProgrammer
Novato
Novato


Registrado: Terça-Feira, 11 de Setembro de 2012
Mensagens: 33
MensagemEnviada: Ter Set 19, 2017 10:02 pm    Assunto: Responder com Citação
up
Voltar ao Topo
Ver o perfil de Usuários Enviar Mensagem Particular
strak2012
Colaborador
Colaborador


Registrado: Segunda-Feira, 13 de Janeiro de 2014
Mensagens: 1518
Localização: Maceió - AL
MensagemEnviada: Ter Set 19, 2017 11:58 pm    Assunto: Responder com Citação
O problema estar com esta parte:

Código:
var
  IdSMTP: TIdSMTP;


Note que você estar a usar um só objeto para vários usuários logado.
O interessante é criar um deste objeto para cada usuário.

Como o objeto se trata de uma herança do TThread, no TSMTP.Create coloque mais uma linha

Código:
Self.FreeOnTerminate:=true;


Isso fará com que o objeto thread seja destruído e liberado da memoria tão logo que ele termine de executar o método Execute
_________________
Tudo podemos quando tudo sabemos!
Voltar ao Topo
Ver o perfil de Usuários Enviar Mensagem Particular Enviar E-mail MSN Messenger
DarkProgrammer
Novato
Novato


Registrado: Terça-Feira, 11 de Setembro de 2012
Mensagens: 33
MensagemEnviada: Qua Set 20, 2017 10:40 am    Assunto: Responder com Citação
Deu certo com sua dica, o único problema é que toda vez que o user conecta eu vou ter q abrir uma conexão SMTP pra ele, chamando a SMTP.Con toda vez, e isso gera um atraso.
Agora o código ficou assim.
Código:
unit SMTP;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  IdSMTP, IdSSLOpenSSL, IdMessage, IdText, IdAttachmentFile, IdExplicitTLSClientServerBase, System.Win.ScktComp;

type
  TSMTP = class(TThread)
  private
    TAccount   : AnsiString;
    TName      : AnsiString;
    TLastName  : AnsiString;
    TEmail     : AnsiString;
    TSocket    : TCustomWinSocket;
    TPIdSMTP   : TIdSMTP;
    function SendCode() : Boolean;
    { Private declarations }
  protected
    procedure Execute; override;
  public
  function SMTPCon(Port : Integer; SMTP : AnsiString; User : AnsiString; Password : AnsiString; IdSMTP : TIdSMTP) : Boolean;
  constructor Create (const CreateSuspended      : Boolean;
                        const Account            : AnsiString;
                          const Name             : AnsiString;
                            const LastName       : AnsiString;
                              const Email        : AnsiString;
                                const Socket     : TCustomWinSocket;
                                  const PIdSMTP  : TIdSMTP);
  end;

implementation
uses GDefs, uFrmP, GenerateCode;

{ TSMTP }
function TSMTP.SMTPCon(Port: Integer; SMTP, User,Password: AnsiString; IdSMTP : TIdSMTP): Boolean;
var
  IdSSLIOHandlerSocket: TIdSSLIOHandlerSocketOpenSSL;
begin
  Result:= False;

  //LoadOpenSSLLibrary;
  IdSSLIOHandlerSocket := TIdSSLIOHandlerSocketOpenSSL.Create(nil);
  IdSMTP    := TIdSMTP.Create(nil);

  try
    if (MyData.SMAuth) then
      IdSMTP.AuthType  := satDefault
    else
      IdSMTP.AuthType  := satNone;

    if (MyData.SMSSL)  then
    begin
      IdSSLIOHandlerSocket.SSLOptions.Method := sslvSSLv23;
      IdSSLIOHandlerSocket.SSLOptions.Mode   := sslmClient;
      IdSMTP.IOHandler := IdSSLIOHandlerSocket;
      IdSMTP.UseTLS    := utUseImplicitTLS;
    end
    else
      IdSMTP.IOHandler := nil;

    IdSMTP.Port      := Port;
    IdSMTP.Host      := SMTP;
    IdSMTP.Username  := User;
    IdSMTP.Password  := Password;

    try
      IdSMTP.ReadTimeout    := MyData.SMReadTimeout;
      IdSMTP.ConnectTimeout := MyData.SMConnectTimeout;
      IdSMTP.Connect;
      IdSMTP.Authenticate;
      //Logger.Write(Format('Guaranteed SMTP access [User: %s | Server: %s]',[User, SMTP]), clGreen);
      Self.TPIdSMTP:= IdSMTP;
    except
      on E: Exception do
      begin
        Logger.Write(Format('Error in SMTP Authentication [Class: %s | Message: %s]',[E.ClassName, E.Message]), clGray);
        Exit;
      end;
    end;
  finally
    Result:= True;
  end;
end;

constructor TSMTP.Create(const CreateSuspended: Boolean; const Account,
  Name, LastName, Email: AnsiString; const Socket: TCustomWinSocket; const PIdSMTP : TIdSMTP);
begin
  Self.TAccount  := Account;
  Self.TName     := Name;
  Self.TLastName := LastName;
  Self.TEmail    := Email;
  Self.TSocket   := Socket;
  Self.TPIdSMTP  := PIdSMTP;
  inherited Create(CreateSuspended);
  Self.FreeOnTerminate :=True;
end;

procedure TSMTP.Execute;
begin
  inherited;
  SendCode();
end;

function TSMTP.SendCode: Boolean;
var
  IdMessage: TIdMessage;
  IdText: TIdText;
  i : Integer;
begin
  if SMTPS.SMTPCon(MyData.SMPort, MyData.SMServer, MyData.SMUSer, MyData.SMPass, Self.TPIdSMTP) then
  begin
    IdMessage := TIdMessage.Create(nil);
    try
      IdMessage.From.Address := MyData.SMUSer ; //Email de quem manda
      IdMessage.From.Name    :=  MyData.SYCompany; // Nome de quem manda
      IdMessage.ReplyTo.EMailAddresses := IdMessage.From.Address;//Email de quem manda para réplica
      IdMessage.Recipients.Add.Text := Self.TEmail; //Quem irá receber
      IdMessage.Subject := MyData.SYSMSubject;  //Assunto
      IdMessage.Encoding := meMIME;

      for i := 0 to Length(Player) -1 do
      if (Player[i].Status) and (Player[i].Socket = Self.TSocket) then
      begin
        Player[i].AuthCode:= GetHash(5);
        Break;
      end;

      IdText := TIdText.Create(IdMessage.MessageParts);
      IdText.Body.Add('<html>');
      IdText.Body.Add('<body>');
      IdText.Body.Add(Format('Hello <i> %s %s.</i>',[Self.TName, Self.TLastName]));
      IdText.Body.Add(Format('<br><br>'+ MyData.SYMessage, [Self.TAccount]));
      IdText.Body.Add(Format('<br><br> AuthCode: <i> <font> %s </i> </font>',[Player[i].AuthCode]));
      IdText.Body.Add(Format('<br><br> Best regards, <br> <i> %s </i>',[MyData.SYCompany]));
      IdText.Body.Add('</body>');
      IdText.Body.Add('</html>');
      IdText.ContentType := 'text/html; charset=iso-8859-1';

      try
        Self.TPIdSMTP.Send(IdMessage);
        Logger.Write(Format('Code sended [Socket: %d | Account: %s | Email: %s | Code: %s]',[Self.TSocket.Handle, Self.TAccount, Self.TEmail,Player[i].AuthCode]), clBlue);
        if FrmP.cPacket($B11F,$AA,$00000000) then
          Self.TSocket.SendBuf(Build, SizeOf(Build));
        Self.TPIdSMTP.Disconnect();
      except
        On E:Exception do
        begin
          Logger.Write(Format('Error sending code [Class: %s | Message: %s]',[E.ClassName, E.Message]), clRed);
        end;
      end;

    finally
      FreeAndNil(IdMessage);
      FreeAndNil(IdText);
    end;
  end;
end;

end.


E estou chamando com 1 parâmetro a+, no qual irá passar o endereço particular de cada usuário para ser usado no idSMTP

SMTPS:= TSMTP.Create(False, Player[i].Account, Player[i].Date.Name, Player[i].Date.LastName, Player[i].Date.Email, Socket, Player[i].SMTP)
Voltar ao Topo
Ver o perfil de Usuários Enviar Mensagem Particular
Mostrar os tópicos anteriores:   
Novo Tópico   Responder Mensagem    ActiveDelphi - Índice do Fórum -> Delphi Todos os horários são GMT - 3 Horas
Página 1 de 1

 
Ir para:  
Enviar Mensagens Novas: Proibido.
Responder Tópicos Proibido
Editar Mensagens: Proibido.
Excluir Mensagens: Proibido.
Votar em Enquetes: Proibido.


Powered by phpBB © 2001, 2005 phpBB Group
Traduzido por: Suporte phpBB