Share Button

#compartilhandoconhecimento #wba10anos
THIS não é um método ou propriedade de classes no DELPHI como ocorre com JAVA.
Emprestando a definição do JAVA-ORACLE temos: “this is a reference to the current object — the object whose method or constructor is being called”…

Acompanhando os artigos do Marcos Douglas B. Santos em seu Blog: Object Pascal Programming por vezes versa sobre implementar uma class function a classes que instâncie e retorne o próprio objeto de preferência por uma INTERFACE.

Bem, a questão nos apresenta quando temos uma interface e precisamos obter a referência ao objeto criado pelo seu construtor. Neste casos, em geral, fazer um CAST da INTERFACE para o OBJETO não é garantia de sucesso.

Depois de lutar muito com o problema minha conclusão é que a melhor solução seria a INTERFACE retornar o próprio objeto criado em seu construtor – o THIS – como definido no JAVA.

Exemplo:


type
      TTransporteClass = class;
  

      ITransporte = interface
         {...}
         function This:TTransporteClass;
      end;


     TTransporteClass = class(TInterfacedObject, ITransporte)
       public
         class function New:ITransporte;
         function This:TTransporteClass;
     end;


   ...
    // class function para iniciar a instância
    class function TTransporteClass.New:ITransporte;
    begin
       result := TTransporteClass.create;
    end; 

    // function para obter o objeto instanciado
    function TTransporteClass.This:TTransporteClass;
    begin
      result := self;
    end;

A boa prática logo vai se manifestar com argumento de promover maior acoplamento do código – perfeitamente… neste caso retornar uma classe de nível superior pode contribuir em elevar o acoplamento do código… para isto, vamos trocar o retorno da function THIS:


      IThis = interface
         {...}
         function This:TObject;
      end; 

      ITransporte = interface
         {...}
      end;

      TTransporteClass = class(TInterfacedObject, ITransporte, IThis)
      .....



Share Button

Congelando a janela com TTask.WaitForAll ???

#compartilhandoconhecimento #wba10anos
Depois que publiquei o vídeo Papo sobre POO (TTask e outros), recebi um comentário que me deixou intrigado.

Porquê o a janela principal trava quando executo   TTask.WaitForAll(  ….  );

Fui dar uma olhando como foi implementado o método – observei que é feito uma chamada para uma camada de TEvent que é implementado nas chamadas internas da rotina. Por traz da mecânica com TEvent é feito uso de  WaitForSingleObject – que é uma camada de acesso a biblioteca do windows.

A alteração não é trivial. O primeiro problema é como reescrever o método considerando que o array passado como parametro é um   .. AArray: array of ITask… qualquer deslize no seu uso vai provocar um incremento no contador RefCount da interface e pode levar a perda de controle no autofree do processo…
Para não causar um incremento do RefCount é preciso fazer uso da instrução  [unsafe] o que foi feito através de um “wrapper” para um record marcado para não incrementar o RefCount.

Contornado a questão de referência, o próximo obstáculo é encontrar um mecanismo que permita parar o processamento sem congelar a janela…

Depois de várias tentativas a solução encontrada foi o “infamous” application.processmessage. Esta não é uma boa opção, já que  mantém o processador em atividade,  quando o ideal seria encontrar um modelo que não fizesse uso do processador enquanto esta atualizando a janela principal.

Primeiramente foi criado um Class Helper para o TTask:

 


Type
  TTaskHelper = class helper for TTask
  private type
    TUnsafeTaskEx = record
    private
      [Unsafe]
      // preciso de um record UNSAFE para nao incrementar o RefCount da Interface
      FTask: TTask;
    public
      property Value: TTask read FTask write FTask;
    end;
  public
    class function WaitForAllEx(AArray: Array of ITask;
    ATimeOut: int64 = INFINITE): boolean;
  end;

Versão 1. Implementando o método:

class function TTaskHelper.WaitForAllEx(AArray: array of ITask;
ATimeOut: int64 = INFINITE): boolean;
var
  task: TUnsafeTaskEx;
  i: integer;
  taskInter: TArray<TUnsafeTaskEx>;
  completou: boolean;
  Canceled, Exceptions: boolean;
begin
  Canceled := false;
  Exceptions := false;
  result := true;
  try
    for i := low(AArray) to High(AArray) do
    begin
      task.Value := TTask(AArray[i]);
      if task.Value = nil then
        raise EArgumentNilException.Create('Wait Nil Task');

      completou := task.Value.IsComplete;
      if not completou then
      begin
        taskInter := taskInter + [task];
      end
      else
      begin
        if task.Value.HasExceptions then
          Exceptions := true
        else if task.Value.IsCanceled then
          Canceled := true;
      end;
    end;

    try
      for task in taskInter do
      begin
        while not task.Value.IsComplete do
        begin
          try
            TThread.Queue(nil,
              procedure
              begin
                application.ProcessMessages;
              end);
          finally
          end;
        end;
        if task.Value.IsComplete then
        begin
          if task.Value.HasExceptions then
            Exceptions := true
          else if task.Value.IsCanceled then
            Canceled := true;
        end;
      end;
    finally
    end;
  except
    result := false;
  end;

  if (not Exceptions and not Canceled) then
    Exit;
  if Exceptions or Canceled then
    raise EOperationCancelled.Create
      ('One Or More Tasks HasExceptions/Canceled');

end;

Versão 2. Revisando o código para um uso mais eficiente com MsgWaitForMultipleObjectsEx:

class function TTaskHelper.WaitForAllEx(AArray: array of ITask;
ATimeOut: int64 = INFINITE): boolean;
var
  FEvent: TEvent;
  task: TUnsafeTaskEx;
  i: integer;
  taskInter: TArray<TUnsafeTaskEx>;
  completou: boolean;
  Canceled, Exceptions: boolean;
  ProcCompleted: TProc<ITask>;
  LHandle: THandle;
  LStop: TStopwatch;
begin
  LStop := TStopwatch.StartNew;
  ProcCompleted := procedure(ATask: ITask)
    begin
      FEvent.SetEvent;
    end;

  Canceled := false;
  Exceptions := false;
  result := true;
  try
    for i := low(AArray) to High(AArray) do
    begin
      task.Value := TTask(AArray[i]);
      if task.Value = nil then
        raise EArgumentNilException.Create('Wait Nil Task');

      completou := task.Value.IsComplete;
      if not completou then
      begin
        taskInter := taskInter + [task];
      end
      else
      begin
        if task.Value.HasExceptions then
          Exceptions := true
        else if task.Value.IsCanceled then
          Canceled := true;
      end;
    end;

    try
      FEvent := TEvent.Create();
      for task in taskInter do
      begin
        try
          FEvent.ResetEvent;
          if LStop.ElapsedMilliseconds > ATimeOut then
            break;
          LHandle := FEvent.Handle;
          task.Value.AddCompleteEvent(ProcCompleted);
          while not task.Value.IsComplete do
          begin
            try
              if LStop.ElapsedMilliseconds > ATimeOut then
                break;
                  if MsgWaitForMultipleObjectsEx(1, LHandle,
                    ATimeOut - LStop.ElapsedMilliseconds, QS_ALLINPUT, 0)
                    = WAIT_OBJECT_0 + 1 then
                    application.ProcessMessages;
            finally
            end;
          end;
          if task.Value.IsComplete then
          begin
            if task.Value.HasExceptions then
              Exceptions := true
            else if task.Value.IsCanceled then
              Canceled := true;
          end;
        finally
          task.Value.removeCompleteEvent(ProcCompleted);

        end;
      end;
    finally
      FEvent.Free;
    end;
  except
    result := false;
  end;

  if (not Exceptions and not Canceled) then
    Exit;
  if Exceptions or Canceled then
    raise EOperationCancelled.Create
      ('One Or More Tasks HasExceptions/Canceled');

end;

Reescrevendo o Exemplo:  Dia11_Threading_TParallel

 

Este é um comportamento quando o SO é windows. Em outras plataformas o resultado poderá ser outro.

 

 

Share Button

Introdução
Tomando emprestado o WIKI “plugin” é um componente computacional que adiciona recursos a um programa existente. Quando um programa suporta “plugins” ele permite ser customizado para responder a necessidades não previstas no projeto original.

Uma interface de “plugin” deve prever a possibilidade de um conjunto de código ou janela permitir ser inserida em partes do programa principal.

Em um primeiro instante – é comum encontrar “plugins” que publicam alguma função ou procedimento a ser chamado pelo aplicativo principal. Este modelo limita as funcionalidade dos “plugins” que em geral ficam mais estáticos a serem um item de menu ou uma ou outra funcionalidade.

O “plugin” que irá assinar algum serviço do aplicativo

A idéia que motiva esta publicação é a construção de um modelo de aplicativo principal HOST que publica serviços implementados em seu código e ficam disponíveis para que os “plugins” possam assinar estes serviços.

Então o HOST se torna um “publisher” é o plugin um “subscriber”, onde o plugin que solicita a assinatura de um determinado serviço do HOST.

Com a mecânica em que o “plugin” assina aos serviços do aplicativo servidor permitirá que o “plugin” tome a decisão sobre qual tipo de serviço ele quer assinar no aplicativo principal . Um exemplo é um “plugin” assinar  para ser um item do menu –  em outros casos poderá assinar funcionalidade de uma “aba” de janela ou adicionar “frames” a alguma interface do usuário – entregando mais poder de escolha ao “plugin”.

Segurança x Flexibilidade

Ainda que “flexibilidade” seja o principal objetivo, segurança segue o mesmo caminho da flexibilidade. Há que se questionar o quanto um HOST pode ser seguro o bastante para não permitir um assinante malicioso. Não tenho resposta para a questão, já que um “plugin” maldoso poderia assinar a serviços para aplicar táticas maliciosas – questão que precisa ser avaliada.

diagrama

Uma interface para publicar serviços

Considerando que o programa principal tem um formulário:

TMeuMenu = class(TForm)

end;

o que precisamos fazer é dotar o formulário principal de uma interface que permita publicar os seus serviços:

  IPluginApplication = interface
    ['{6ED989EA-E8B5-4435-A0BC-33685CFE7EEB}']
    procedure RegisterMenuItem(const AParentMenuItemName, ACaption: string; ADoExecute: IPluginMenuItem);
    procedure RegisterToolbarItem(const AParentItemName, ACaption: string;  ADoExecute: IPluginToolbarItem);
    procedure RegisterAttributeControl(const AType,ASubType: Int64;  ADoExecute: IPluginControl);
  end;

Com isto o formulário passa a implementar a interface de serviço de “plugins” da seguinte forma:

TMeuMenu = class(TForm, IPluginApplication)
….
end;

 

Registrando o Plugin para o Aplicativo Principal

Antes de carregar um “plugin” o aplicativo host precisa conhece-lo (uma lista de plugins registrados). Uma forma simplista, é guardar uma lista de “plugins” disponíveis em um arquivo INI do host. A lista é necessária para que o aplicativo possa fazer carga dos seus “plugins”. Uma vez feito a carga do plugin, estes  irão assinar os serviços a que desejam interagir com o host.

O framework utiliza a implementação de DLLs para troca de código com o aplicativo principal, publicando duas chamadas – uma para carga inicial da DLL e outra para quando o aplicativo principal esta encerrando o uso do plugin:

function LoadPlugin(AAplication: IPluginApplication): IPluginItems;
procedure UnloadPlugin;
...
exports LoadPlugin, UnloadPlugin;

Carregando o Plugin
Sabedor destas duas entradas disponíveis no “plugin”, resta escrever os métodos de carga do plugin (ver TPluginManager nos fontes):

function LoadPluginService(APlugin: string;
  AAppliction: IPluginApplication): Integer;
var
  F: function(APApplication: IPluginApplication): IPluginItems;
  H: THandle;
begin
  result := -1;
  H := LoadLibrary(PWideChar(APlugin));
  if H &gt; 0 then
  begin
    try
      @F := GetProcAddress(H, 'LoadPlugin');
      if assigned(F) then
        result := LPluginManager.FPlugins.Add(H, F(AAppliction))
      else
        raise Exception.Create('Não carregou o plugin');
    except
      FreeLibrary(H);
    end;
  end;
end;

Note que a função “LoadPlugin” do plugin espera que seja enviado um IPluginApplication e retorna uma lista de plugins existente na mesma DLL, já que uma DLL pode conter 1 ou mais plugins.

O IPluginApplication, representa a interface do HOST que publica os serviços que os plugins poderão assinar no HOST – Internamente a DLL irá montar uma lista de plugins disponíveis. Cada plugin da DLL se encarrega de assinar os serviços do HOST.

Estendendo os serviços do HOST

A interface que publica os serviços no HOST é o IPluginApplication que já possui três serviços básicos para a assinatura sendo eles:

  1. MenuItem – Assinatura para se registrar em um item de menu do HOST;
  2. ToolbarItem – Assinatura para se registrar em um item da Toolbar;
  3. AttributeControl – Uma assinatura a utilizar o plugin como um “control” ou atributo de um janela.

Caso deseje implementar outros serviços para o HOST, estendendo suas funcionalidades é possível estender a interface IPluginApplication e implementa-la no HOST:

IMyPluginApplication  =  interface(IPluginAppliction)
     procedure   RegisterXXX(....);
end;

// no host
 TMyMainMenu = class(TForm,  IMyPluginApplication )
 ...
 end;

 

Parte 2 – Construindo o Plugin

(No final o código estará disponível no GIT)
….

Share Button

Trabalhar com RECORD é mais fácil administrar memória quando comparado com classes.

Como cada variável RECORD ocupa um endereço diferente com os dados e controla a sua retirada da memória com mais facilidade, prefiro usar RECORD para fazer CACHE de dados.

Por outro lado, temos vários acessos ao banco de dados que possuem parâmetros que estão nestes RECORD (alguém lembrará um CRUD). Uma solução é utilizar RTTI para ler os valores dos parâmetros que estão armazenados no RECORD e passar os valores para os parâmetros (TParams).

function TALQuery.FillParams<T>(rec: T): TALQuery;
var
  LList: TJsonValuesList;  // unit System.uJson
  LPair:TJsonPair;
  i:integer;
  prm:TParamBase;
begin
  result := self;
  LList := TJsonValuesList.Create();    // unit System.uJson
  try
    TJsonValue.GetRecordList<T>(LList, rec); // carrega os valores do RECORD em um LIST
    for I := 0 to params.count-1 do
         begin
            prm:= params[i];
            LPair := LList.names[ prm.Name ];
            if assigned(LPair) then
              case prm.DataType of
                 ftSmallint,ftInteger:
                   prm.AsInteger := LPair.JsonValue.GetValue<integer>;
                 ftFloat:
                   prm.AsFloat := LPair.JsonValue.GetValue<double>;
                 ftCurrency:
                   prm.AsCurrency := LPair.JsonValue.GetValue<Currency>;
                 ftDateTime,ftDate,ftTime :
                   prm.asDateTime := LPair.JsonValue.getValue<TDateTime>;
               else
                 prm.Value := LPair.JsonValue.getValue<string>;
              end;
         end;
  finally
    LList.free;
  end;
end;


/* aplicando */


Type
    TPedidoRecord = record
      ...
      pedido:integer;
      filial:integer;
      data:TDatetime;
    end;


var qry:   TMinhaQuery;
    rec : TPedidoRecord;
begin
    ....
    qry.fillParams<TPedidoRecord>(rec);
    ...
end;

 

Dependência: System.uJson

 

Share Button

Sabe todos aquelas linhas de código para incluir um item no menu “by code”…

  • inicializa o item de menu;
  • adiciona os parametros;
  • cria o método para o evento OnClick…
  • atribui o evento;
  • adiciona o item à lista;

Exemplo VCL para incluir um item de menu usando código:

procedure TForm40.ClickMenuItem(sender:TObject);
  begin
          showMessage('menu sem anonimous');
  end;
procedure TForm40.FormCreate(Sender: TObject);
  var it:TMenuItem;
begin
  it := TMenuItem.Create(MainMenu1);
  it.caption := 'Teste de um menu sem anonimous';
  it.OnClick := ClickMenuItem;
  MainMenu1.Items.Add(it);
end;

Métodos “anonimous” é uma poderosa ferramenta presente no Delphi na era XE, que encurta caminhos complexos. Ao reduzir código ao mesmo tempo aumentamos qualidade (com menor ocorrência de bugs) bem como menor tempo de implementação. Se considerar que o maior tempo se gasta em testes e correções de defeitos, então o ganho é exponencial.

Exemplo usando “Anonimous Method”:

uses VCL.Menus.Helpers;
procedure TForm40.FormCreate(Sender: TObject);
begin
  MainMenu1.Items.CreateAnonimous('Teste menu com anonimous',
     procedure begin
          showmessage('ok...');
     end);
end;

Fontes: https://github.com/amarildolacerda/helpers

Share Button

Em outro “post” escrevi sobre obter o código do cliente gerado automático pelo banco e como retornar o seu valor usando “returning”.

Há situações que é necessário confirmar se uma operação foi aceita pelo banco (sem erro), e que de fator a linha foi inserida, alterada ou excluída do banco de dados.

Depois de submeter um comando de Insert, Update ou Delete para o banco pode-se adotar algumas estratégias para saber se houve sucesso:

  1. usar um Try/Exception para capturar uma exceção. Se o comando retornou uma exceção significa que o banco de dados criticou o comando. De outro lado há comandos que mesmo não retornando nenhum exceção NÃO garante que  conseguiu fazer… ex: envia um update e não encontra o registro – não gera exceção, mas também não fez;
  2. usar a propriedade  RowsAffected  para ler quantas linhas foram afetadas pelo último comando executado.
RowsAffected = 0    ->  não efetuou nenhuma alteração;

RowsAffected = -1   -> quando a operação não suporta ou o banco de dados não suporta obter retorno;

RowsAffected > 0     -> número de linhas que foram alteradas;

 

Exceção:   No MS-SQLServer há situações que o retorno é -1  em decorrência deste recurso ser desligado em triggers ou procedure quando omite o comando:  SET NOCOUNT ON

 

Exemplo:

Query1.sql.text := ‘update clientes set fone = ‘xxxx-xxxx’ where codigo=1′;

Query1.execSql;

if Query1.RowsAffected>0 then

showMessage(‘Sucesso’);

 

Share Button

Sabe aquele cadastro de cliente que você vai inserir um novo cliente e lá o código do cliente é uma coluna gerada com GENERATOR – (auto-incremento), pode ser uma grande dor de cabeça se não estiver seguro sobre o código inserido na tabela.
Muitas vezes precisa deste ID para utiliza-lo em outro lugar. Se errar o ID o registro final irá ficar errado, associando ao cliente errado…
Outra situação é, se demorar algum tempo para descobrir o ID e outro usuário inserir um outro cliente enquanto o app fazia alguma coisa…. vai dar confusão. É preciso garantir com precisão o ID que foi inserido no momento que o banco postou na tabela.

Para resolver estas situações o Firebird permite obter valores de retorno de um INSERT.

Exemplo:

   insert into cliente( nome, endereco, ...) values( :nome,:endereco,...)
   returning id_cliente into :id

Ao executar o comando de INSERT, o banco irá retornar no parâmetro o valor inserido pelo GENERATOR no parâmetro ID.

Share Button

A API do firedac traz um componente que encapsula o nbackup do firebird o que facilita
personalizar o controle de backups. TFDFBNBackup.

Exemplo Nivel 1:

TNBackup.ExecuteNBackup(‘localhost’,’c:\dados\meubanco.fdb’,’sysdba’,’masterkey’,1,’c:\backup\b
ackup2.nbk’);

  • Segestão de como utilizar NIVEL (level):
    a) fazer backup FULL Nivel 0 para um intervalo de período (semanal);
    b) fazer backup Nivel 1, diário;
    c) fazer backup Nivel 2 para backup a cada hora.

Código base:

uses
FireDAC.Phys.IBWrapper,FireDAC.Phys.FB,FireDAC.Phys.FBDef,FireDAC.Comp.UI,FireDAC.Phys;

type

TNBackup = record
   private
     class function GetNBackup(AHost, ABanco, AUser, APass: string;
        ANivel: integer; ADestino: String): TFDFBNBackup;static;
     class function ExecuteNBackup(AHost, ABanco, AUser, APass: string;
        ANivel: integer; ADestino: String): boolean;static;
end;

class function TNBackup.ExecuteNBackup(AHost, ABanco, AUser, APass: string;
     ANivel: integer; ADestino: String): boolean;
begin
   result := false;
   with TNBackup.GetNBackup(Ahost,ABanco,AUser,APass,ANivel,ADestino) do
   try
      Backup; // gerar backup.
      result := true;
   finally
      free;
   end;
end;

class function TNBackup.GetNBackup(AHost, ABanco, AUser, APass: string;
    ANivel: integer; ADestino: String): TFDFBNBackup;
var
nBackup:TFDFBNBackup;
FDGUIxWaitCursorX: TFDGUIxWaitCursor;
FDPhysFBDriverLinkX: TFDPhysFBDriverLink;
begin
     result:=TFDFBNBackup.create(nil);
     try
        FDGUIxWaitCursorX:= TFDGUIxWaitCursor.Create(result);
        FDPhysFBDriverLinkX:= TFDPhysFBDriverLink.Create(result);
        with result do
        begin
           Level := ANivel;
           host := AHost;
           username := AUser;
           password := APass;
           protocol := ipTCPIP;
           Database := ABanco;
           backupfile := ADestino;
           DriverLink := FDPhysFBDriverLinkX;
        end;
   finally
      // liberar a instancia no metodo chamador
   end;
end;

Share Button

Requer: https://github.com/amarildolacerda/helpers

Uses System.uJson;
type
   TMinhaClasse = class
   public
     Valor: Double;
     Codigo: string;
   end;

procedure TForm33.FormCreate(Sender: TObject);
var
mc: TMinhaClasse;
begin
    mc := TMinhaClasse.create;
    try
      mc.Codigo := '123456';
      mc.Valor := 10;
      ShowMessage(mc.asJson);
   finally
      mc.Free;
   end;
end;

Share Button

Lembra quantas vezes você precisou fazer um Loop em um Dataset para fazer uma soma, uma
contagem ou qualquer outra coisa…
Não gosto de fazer de novo algo que já fiz antes… Pensando nisto passei a usar “anonimous
method” do delphi para executar para mim os trechos repetitivos dos loops…
Veja como ficou.

type
TDatasetHelper = class helper for TDataset
public
   procedure DoLoopEvent(AEvent: TProc&lt;TDataset&gt;); overload;
end;

procedure TForm34.execute;
var total:Double;
begin
   // abere o Dataset com os dados.
   alQuery1.sql.Text := 'select codigo, total valor from sigcaut1 where data&gt;=:data';
   alQuery1.ParamByName('data').AsDateTime := strTodate('01/01/2016');
   alQuery1.Open;
   // fazer um loop para somar o total, usando metodos anonimos;
   total := 0;
   alQuery1.DoLoopEvent( procedure( ds:TDataset)
   begin
     total := total + ds.FieldByName('valor').AsFloat; // executa o loop
     end);
   showMessage( FloatTOStr(total) ); // mostra o total da soma obtida no loop
end;


procedure TDatasetHelper.DoLoopEvent(AEvent: TProc;TDataset;);
var
book: TBookMark;
begin
    book := GetBookmark;
    try
      DisableControls;
      first;
      while eof = false do
      begin
         AEvent(self);
         next;
      end;
    finally
    GotoBookmark(book);
    FreeBookmark(book);
    EnableControls;
  end;
end;

Código Original