 |
ActiveDelphi .: O site do programador Delphi! :.
|
Exibir mensagem anterior :: Exibir próxima mensagem |
Autor |
Mensagem |
DarkProgrammer Novato

Registrado: Terça-Feira, 11 de Setembro de 2012 Mensagens: 33
|
Enviada: Seg Set 18, 2017 9:06 pm Assunto: Problema com IdSMTP |
|
|
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 |
|
 |
DarkProgrammer Novato

Registrado: Terça-Feira, 11 de Setembro de 2012 Mensagens: 33
|
Enviada: Ter Set 19, 2017 10:02 pm Assunto: |
|
|
up |
|
Voltar ao Topo |
|
 |
strak2012 Colaborador


Registrado: Segunda-Feira, 13 de Janeiro de 2014 Mensagens: 1518 Localização: Maceió - AL
|
Enviada: Ter Set 19, 2017 11:58 pm Assunto: |
|
|
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 |
|
 |
DarkProgrammer Novato

Registrado: Terça-Feira, 11 de Setembro de 2012 Mensagens: 33
|
Enviada: Qua Set 20, 2017 10:40 am Assunto: |
|
|
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 |
|
 |
|
|
Enviar Mensagens Novas: Proibido. Responder Tópicos Proibido Editar Mensagens: Proibido. Excluir Mensagens: Proibido. Votar em Enquetes: Proibido.
|
|