Encontrei Memory Leak’s

[VagnerAlmeida]

Olá!
Gostaria que um dos integrantes que mantém o UserControl entrasse em contato comigo.

Pois encontrei Memory Leak’s no componente e os corrigi.

Gostaria de passar minha contribuição para que possam corrigir o problema.

E também saber como posso contribuir para a melhoria do componente (ferramenta).

Abraços….

[mariodosreis]

Enquanto isso, não poderia partilhar connosco como resolveu o problema para aqueles entre nós que têm o mesmo problema o corrijam sem estar à espera que seja corrigido e republicado no site, pois isso provavelmente irá demorar.
Já agora pergunto se você usa o UCHISTORIC, é que com esse então não se fala. São só problemas. Obrigado

[VagnerAlmeida]

Vá na unit UCDataInfo (UCDataInfo.pas) linha 276…
Você vai encontrar a GetFieldList da seguinte forma:

function TUCTableUsers.GetFieldList: TStringList;
begin
Result := TStringList.Create;
Result.Add(FieldUserID);
Result.Add(FieldUserName);
Result.Add(FieldLogin);
Result.Add(FieldPassword);
Result.Add(FieldEmail);
Result.Add(FieldPrivileged);
Result.Add(FieldTypeRec);
Result.Add(FieldProfile);
Result.Add(FieldKey);
Result.Add(FieldDateExpired);
Result.Add(FieldUserExpired);
Result.Add(FieldUserDaysSun);
Result.Add(FieldUserInative);
Result.Add(FieldImage);
end;

Veja que ela sempre aloca memória quando dá o create -> Result := TStringList.Create;
Mas em momento algum destrói o que criou. A função funciona, mas sempre utiliza a memória sem liberar cada vez que é executada (e essa função é muito utilizada dentro do UC).

Para resolver é extremamente simples, substitua pela função abaixo:

function TUCTableUsers.GetFieldList: TStringList;
var
LFieldList: TStringList;
begin
LFieldList := TStringList.Create;
try
LFieldList.Add(FieldUserID);
LFieldList.Add(FieldUserName);
LFieldList.Add(FieldLogin);
LFieldList.Add(FieldPassword);
LFieldList.Add(FieldEmail);
LFieldList.Add(FieldPrivileged);
LFieldList.Add(FieldTypeRec);
LFieldList.Add(FieldProfile);
LFieldList.Add(FieldKey);
LFieldList.Add(FieldDateExpired);
LFieldList.Add(FieldUserExpired);
LFieldList.Add(FieldUserDaysSun);
LFieldList.Add(FieldUserInative);
LFieldList.Add(FieldImage);
Result := LFieldList;
finally
FreeAndNil(LFieldList);
end;
end;

Com relação ao UCHISTORIC, eu não uso, não me atende, mas pretendo fazer algumas modificações no componente para que tenha mais funcionalidades úteis.

Abraços…

[Giovani Da Cruz]

Olá Vagner Almeida, em breve vamos incorporar está sua sugestão.

[mariodosreis]

Bom, não expliquei que ainda estou a usar o Delphi XE7; tentei com a função FreeAndNil e não compilou, mas com LFieldList.Free correu bem.
Enquanto isso verifiquei talvez me falte incluir na
interface
uses
Classes,

System

, UCSettings;
porque causa do “System.SysUtils.FreeAndNil” ou talvez nem seja necessário já que fazem o mesmo.

De qualquer forma muito Obrigado. Agora é só trabalho de sapa e uns testes e voltarei aqui a dizer se funciona bem só assim.
Obrigado mesmo.

[VagnerAlmeida]

Olá pessoal!
Encontrei mais Memory Leaks!
No método TUserControl.RegistraCurrentUser(Dados: TDataSet; Pass: String)
Na instrução:
// if Assigned(PerfilUsuario) then
// PerfilUsuario := Nil;

// PerfilUsuario := DataConnector.UCGetSQLDataset(SQLstmt);

Troquei por:
if Assigned(FPerfilUsuario) then
FreeAndNil(FPerfilUsuario);

FPerfilUsuario := DataConnector.UCGetSQLDataset(SQLstmt);

——————-

// if Assigned(PerfilGrupo) then
// PerfilGrupo := Nil;

// PerfilGrupo := DataConnector.UCGetSQLDataset(SQLstmt);

troquei por:
if Assigned(FPerfilGrupo) then
FreeAndNil(FPerfilGrupo);

FPerfilGrupo := DataConnector.UCGetSQLDataset(SQLstmt);

e por fim:
else
// PerfilGrupo := Nil;
FreeAndNil(FPerfilGrupo);

—–
Como testar:

Coloque um botão para fazer um teste na sua própria aplicação.
Na programação do botão execute o método VerificarLogin assim:

if UserControl1.VerificarLogin(‘User’, ‘Password’) = 0 then
ShowMessage(‘1. Login OK’);

if UserControl1.VerificarLogin(‘User’, ‘Password’) = 0 then
ShowMessage(‘2. Login OK’);

(Isso mesmo para fazer duas vezes a verificação)
Com um controle de verificação de Memory Leaks (eu uso o madExcept) ao finalizar a aplicação ele irá mostrar dentre vários vazamentos dois objetos TUniQuery (eu uso o UniDAC) não destruídos.

Implemente as alterações acima e verá e teste novamente, verá que não ocorrerá mais Memory Leaks.

Possa ser que eu esteja errado, mas sempre que utilizar o Método DataConnector.UCGetSQLDataset creio que deveria passar o resultado para uma variável TDataSet, pois a classe que a implementa não controla a criação ou destruição do objeto que ela cria, assim poderíamos destruir a variável que recebeu o objeto do método DataConnector.UCGetSQLDataset eliminando muitos problemas.

Sou um programador com pouca experiência e sou totalmente aberto caso alguém identifique algo em meu pensamento que esteja errado, ficarei muito caso alguém pudesse me corrigir se eu estiver errado.
Abraços….

[VagnerAlmeida]

Bem…
Na verdade, acredito que na classe TUCCurrentUser as property deveriam cuidar disso.
Atualmente estão assim:
property PerfilUsuario: TDataSet read FPerfilUsuario write FPerfilUsuario;
property PerfilGrupo: TDataSet read FPerfilGrupo write FPerfilGrupo;

Não seria o casso de no write ter um método para resolver esse problema?
Tipo:

property PerfilUsuario: TDataSet read FPerfilUsuario write SetPerfilUsuario;
property PerfilGrupo: TDataSet read FPerfilGrupo write SetPerfilGrupo;

procedure TUCCurrentUser.SetPerfilUsuario(const Value: TDataSet);
begin
if Assigned(FPerfilUsuario) then
FreeAndNil(FPerfilUsuario);
— ou —
if Assigned(FPerfilUsuario) then
begin
FPerfilUsuario := nil;
FPerfilUsuario.Free;
end;

FPerfilUsuario := Value;
end;

e o mesmo para PerfilGrupo.

[VagnerAlmeida]

Correções que eu fiz:

Metodo: ActionEsqueceuSenha(Sender: TObject);
Faltou liberar a variável “FDataPer”.
Ficou assim:
procedure TUserControl.ActionEsqueceuSenha(Sender: TObject);
var
FDataset, FDataPer: TDataSet;
begin
FDataset := DataConnector.UCGetSQLDataset(‘Select * from ‘ +
TableUsers.TableName + ‘ Where ‘ + TableUsers.FieldLogin + ‘ = ‘ +
QuotedStr(TfrmLoginWindow(FFormLogin).EditUsuario.Text));

FDataPer := DataConnector.UCGetSQLDataset(‘select ‘ + TableUsers.FieldUserName
+ ‘ from ‘ + TableUsers.TableName + ‘ Where ‘ + TableUsers.FieldUserID +
‘ = ‘ + FDataset.FieldByName(TableUsers.FieldProfile).AsString);

try
if not FDataset.IsEmpty then
MailUserControl.EnviaEsqueceuSenha
(FDataset.FieldByName(TableUsers.FieldUserID).AsInteger,
FDataset.FieldByName(TableUsers.FieldUserName).AsString,
FDataset.FieldByName(TableUsers.FieldLogin).AsString,
FDataset.FieldByName(TableUsers.FieldPassword).AsString,
FDataset.FieldByName(TableUsers.FieldEmail).AsString,
FDataPer.FieldByName(TableUsers.FieldUserName).AsString)
// EncryptKey)

else
MessageDlg(UserSettings.CommonMessages.InvalidLogin, mtWarning,
[mbOK], 0);
finally
FDataset.Close;
FDataPer.Close;
SysUtils.FreeAndNil(FDataset);
SysUtils.FreeAndNil(FDataPer);
end;
end;

—

Metodo: GetAllUsers(Names: Boolean): TStringList;
Faltou liberar a variável “FDataset” e não estava controlando a destruição do TStringList (redefini o método).
Ficou assim:
function TUserControl.GetAllUsers(Names: Boolean): TStringList;
Var
FDataset: TDataSet;
LStringList: TStringList;
begin
LStringList := TStringList.Create;

try
if Names then
FDataset := DataConnector.UCGetSQLDataset
(‘Select ‘ + TableUsers.FieldUserName + ‘ from ‘ + TableUsers.TableName +
‘ Where ‘ + TableUsers.FieldTypeRec + ‘ = ‘ + QuotedStr(‘U’) +
‘ order by ‘ + TableUsers.FieldUserName)
else
FDataset := DataConnector.UCGetSQLDataset(‘Select ‘ + TableUsers.FieldLogin
+ ‘ from ‘ + TableUsers.TableName + ‘ Where ‘ + TableUsers.FieldTypeRec +
‘ = ‘ + QuotedStr(‘U’) + ‘ order by ‘ + TableUsers.FieldUserName);

if not FDataset.IsEmpty then
begin
FDataset.First;
while not FDataset.Eof do
begin
LStringList.Add(FDataset.Fields[0].AsString);
FDataset.Next;
end;
end;

Result := LStringList;
finally
FDataset.Close;
SysUtils.FreeAndNil(FDataset);
SysUtils.FreeAndNil(LStringList);
end;
end;

—

Metodo TUserControl.RegistraCurrentUser(Dados: TDataSet; Pass: String) estava com vazamento de memória ao utilizar os métodos PerfilUsuario e PerfilGrupo (TDataset’s do TUCCurrentUser).
Criei dois métodos no TUCCurrentUser, o SetPerfilUsuario e SetPerfilGrupo.
A classe TUCCurrentUser ficou assim:
TUCCurrentUser = class(TComponent)
private
FPerfilUsuario: TDataSet;
FPerfilGrupo: TDataSet;
procedure SetPerfilUsuario(const Value: TDataSet);
procedure SetPerfilGrupo(const Value: TDataSet);
public
UserID: Integer;
Profile: Integer;
UserIDOld: Integer;
IdLogon: String;
ProfileName: String;
UserName: String;
UserLogin: String;
Password: String;
PassLivre: String;
Email: String;
DateExpiration: TDateTime;
Privileged: Boolean;
UserNotExpired: Boolean;
UserDaysExpired: Integer;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property PerfilUsuario: TDataSet read FPerfilUsuario write SetPerfilUsuario;
// Cadastro de Usuarios
property PerfilGrupo: TDataSet read FPerfilGrupo write SetPerfilGrupo;
// Cadastro de Perfil
end;

A implementação da classe ficou assim:
{ TUCCurrentUser }

constructor TUCCurrentUser.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
end;

destructor TUCCurrentUser.Destroy;
begin
if Assigned(FPerfilUsuario) then
SysUtils.FreeAndNil(FPerfilUsuario);
if Assigned(FPerfilGrupo) then
SysUtils.FreeAndNil(FPerfilGrupo);
inherited;
end;

procedure TUCCurrentUser.SetPerfilUsuario(const Value: TDataSet);
begin
if Assigned(FPerfilUsuario) then
SysUtils.FreeAndNil(FPerfilUsuario);

FPerfilUsuario := Value;
end;

procedure TUCCurrentUser.SetPerfilGrupo(const Value: TDataSet);
begin
if Assigned(FPerfilGrupo) then
SysUtils.FreeAndNil(FPerfilGrupo);

FPerfilGrupo := Value;
end;

Devido a implementação da classe TUCCurrentUser acima o método TUserControl.RegistraCurrentUser(Dados: TDataSet; Pass: String) ficou assim:
procedure TUserControl.RegistraCurrentUser(Dados: TDataSet; Pass: String);
var
SQLstmt: String;
begin
with CurrentUser do
begin
UserID := Dados.FieldByName(TableUsers.FieldUserID).AsInteger;
UserName := Dados.FieldByName(TableUsers.FieldUserName).AsString;
UserLogin := Dados.FieldByName(TableUsers.FieldLogin).AsString;
DateExpiration := StrToDateDef
(Dados.FieldByName(TableUsers.FieldDateExpired).AsString, now);
UserNotExpired := Dados.FieldByName(TableUsers.FieldUserExpired)
.AsInteger = -1;
UserDaysExpired := Dados.FieldByName(TableUsers.FieldUserDaysSun).AsInteger;
PassLivre := Pass;

case Self.Criptografia of
cPadrao:
Password := Decrypt(Dados.FieldByName(TableUsers.FieldPassword)
.AsString, EncryptKey);
cMD5:
Password := Dados.FieldByName(TableUsers.FieldPassword).AsString;
end;

Email := Dados.FieldByName(TableUsers.FieldEmail).AsString;
Privileged := StrToBool(Dados.FieldByName(TableUsers.FieldPrivileged)
.AsString);
Profile := Dados.FieldByName(TableUsers.FieldProfile).AsInteger;

SQLstmt := Format(‘SELECT %s AS ObjName,’ + ‘ %s AS UCKey,’ +
‘ %s AS UserID’ + ‘ FROM %s’ + ‘ WHERE %s = %s AND %s = %s’,
[TableRights.FieldComponentName, TableRights.FieldKey,
TableRights.FieldUserID, TableRights.TableName, TableRights.FieldUserID,
IntToStr(UserID), TableRights.FieldModule, QuotedStr(ApplicationID)]);

PerfilUsuario := DataConnector.UCGetSQLDataset(SQLstmt);

// Aplica Permissoes do Perfil do usuario
if CurrentUser.Profile > 0 then
begin
// Obtem o nome do Perfil do usuario
SQLStmt := ‘SELECT * FROM ‘ + TableUsers.TableName + ‘ WHERE ‘ +
TableUsers.FieldUserID + ‘ = ‘ + IntToStr(CurrentUser.Profile);

PerfilGrupo := DataConnector.UCGetSQLDataset(SQLStmt);
CurrentUser.ProfileName := PerfilGrupo.FieldByName(TableUsers.FieldUserName).AsString;

SQLstmt := Format(‘SELECT %s AS ObjName,’ + ‘ %s AS UCKey,’ +
‘ %s AS UserID’ + ‘ FROM %s’ + ‘ WHERE %s = %s AND %s = %s’,
[TableRights.FieldComponentName, TableRights.FieldKey,
TableRights.FieldUserID, TableRights.TableName, TableRights.FieldUserID,
IntToStr(CurrentUser.Profile), TableRights.FieldModule,
QuotedStr(ApplicationID)]);

PerfilGrupo := DataConnector.UCGetSQLDataset(SQLstmt);
end;

if Assigned(OnLoginSucess) then
OnLoginSucess(Self, UserID, UserLogin, UserName, Password, Email,
Privileged);
end;

if (CurrentUser.UserID <> 0) then
UsersLogged.AddCurrentUser;

ApplyRightsUCControlMonitor;
NotificationLoginMonitor;

if ((FLogin.fDateExpireActive = True) and (Date > CurrentUser.DateExpiration)
and (CurrentUser.UserNotExpired = False)) then
begin
MessageDlg(UserSettings.CommonMessages.PasswordExpired, mtInformation,
[mbOK], 0);

if FFormTrocarSenha = nil then
CriaFormTrocarSenha;
TTrocaSenha(FFormTrocarSenha).ForcarTroca := True;
FFormTrocarSenha.ShowModal;
FreeAndNil(FFormTrocarSenha);
{ Incrementa a Data de Expiração em x dias após a troca de senha }
CurrentUser.DateExpiration := CurrentUser.DateExpiration +
CurrentUser.UserDaysExpired;
end;
end;

Estou a disposição para ajudar e aberto a correções caso tenha cometido algum erro.
Abraços…

[mariodosreis]

Prezado Amigo,Aqui, onde diz: “Devido a implementação da classe TUCCurrentUser acima o método TUserControl.RegistraCurrentUser(Dados: TDataSet; Pass: String) ficou assim”:
Significa exctamente que já não precisamos mais usar o codigo que começo por implementar método no inicio(?) designadamente, quando fazia:    if Assigned(FPerfilUsuario) then
     FreeAndNil(FPerfilUsuario);
—     if Assigned(FPerfilGrupo) then
        FreeAndNil(FPerfilGrupo);

percebi bem? é isso mesmo? Obirgado

[Antonio Campos]

Olá Vagner Almeida, mesmo após estas correções você consegui disparar e-mail para recuperação de senha, tipo a opção esqueci minha senha tela de login?

Estou tentando utilizar o componente MailUserControl para enviar e-mail se configuro a porta para 587, dá o seguinte erro.
530 5.7.0 Must issue a STARTTLS command first

Se configuro a porta para 465.
A aplicação trava e logo em seguida dá o seguinte Warning:

System Error. Code 10060.
Uma tentativa de conexão falhou porque o componente conectado não respondeu corretamente após um período de tempo ou a conexão estabelecida falhou porque o host conectado não respondeu.

Estou utilizando uma conta do Gmail e a opção permitir aplicativos menos seguros: ATIVADA

Agradeço desde já. Abraço!

[VagnerAlmeida]

[ Sr. Mario dos Reis e colegas de profissão… ]
No corpo do método RegistraCurrentUser tem duas instruções:

if Assigned(PerfilUsuario) then
PerfilUsuario := nil;

e mais a baixo:

if Assigned(PerfilGrupo) then
PerfilGrupo := nil;

Se você incluir os métodos:

SetPerfilUsuario(const Value: TDataSet);

e

SetPerfilGrupo(const Value: TDataSet);

na classe TUCCurrentUser como mostrei acima, você não precisará mais daquelas linhas (Assigned(PerfilUsuario) e Assigned(PerfilGrupo), pois a classe TUCCurrentUser já estará tratando isso para você, que é o correto.

Dá uma analisada no código que você vai entender.

Obs.: onde tem as linhas:
**************************
// Obtem o nome do Perfil do usuario
SQLStmt := ‘SELECT * FROM ‘ + TableUsers.TableName + ‘ WHERE ‘ +
TableUsers.FieldUserID + ‘ = ‘ + IntToStr(CurrentUser.Profile);

PerfilGrupo := DataConnector.UCGetSQLDataset(SQLStmt);
CurrentUser.ProfileName := PerfilGrupo.FieldByName(TableUsers.FieldUserName).AsString;
**************************
foi uma alteração minha para retornar o NOME do perfil do usuário. Isso não tem no UserControl Padrão. Você pode retirar essas linhas.
Mas se quiser utilizar é preciso criar a variável “FProfileName” na Classe TUCCurrentUser, veja que no código que eu postei mostrando essa classe a variável já está lá declarada.

Espero ter esclarecido.
Abraços…

[VagnerAlmeida]

[ Sr. Antonio Campos ]

Infelizmente não testei isso ainda, pois estou refazendo meu PDV e no desenrolar da caminhada vou corrigindo os erros que são apresentados.

Se em algum momento eu me deparar com essa necessidade e verificar algum erro, reportarei aqui com certeza.

Sinto não poder ajudá-lo no momento.

O máximo que posso fazer é informar que deve ser usada as seguintes configurações:

Host: smtp.gmail.com
Port: 465
SSL: Ativo (Usar o protocolo SSL)
User: <seu e-mail>
Password: <senha de acesso do seu e-mail>

Demais…. Pesquise no Google: “Configurar e-mail no usercontrol delphi”.
Tem alguns links que poderão ajudar.

Por favor, peço que compartilhe seu resultado.
Abraços.

[Autor]

Posts