Share Button

Precisa fazer persistência local de configurações ?
Então um dia você ainda vai usar um arquivo JSON ao invés de um INI.

Ver uma classe para TJsonFile     Exemplo

  • Usando RTTI para escrever no TJsonFile

Ver o exemplo com fazer persistência de objeto usando RTTI para descobrir as propriedades a guardar no TJsonFile.WriteObject(…). Do outro lado TJsonFile.ReadObject(…) lê as propriedades no JSONFile e popula o objeto.

O funcionamento do RTTI é o mesmo descrito no post anterior

 

Share Button

É comum encontrar sistemas que utilizam arquivos TIniFiles para persistir informações locais.
O uso de TIniFiles impõe escrever muitas linhas para gravação e leitura do conteúdo.
No exemplo mostro como utilizar RTTI para gravar as propriedades de um objeto diretamente no arquivo INI / carregando as informações do arquivo INI para o objeto.

  • Para o exemplo considerar a seguinte classe base para gravação no arquivo INI:
// Classe a ser gravar no INI
  TIniSecaoClass = class
  private
    Fbase_datetime: TDatetime;
    Fbase_numerico: Double;
    Fbase_string: string;
    Fbase_integer: integer;
    Fbase_boolean: Boolean;
    procedure Setbase_datetime(const Value: TDatetime);
    procedure Setbase_numerico(const Value: Double);
    procedure Setbase_string(const Value: string);
    procedure Setbase_integer(const Value: integer);
    procedure Setbase_boolean(const Value: Boolean);
  public
    // propriedades a serem gravadas ou lidas no INI
    property base_string: string read Fbase_string write Setbase_string;
    property base_datetime: TDatetime read Fbase_datetime
      write Setbase_datetime;
    property base_numerico: Double read Fbase_numerico write Setbase_numerico;
    property base_integer: integer read Fbase_integer write Setbase_integer;
    property base_boolean: Boolean read Fbase_boolean write Setbase_boolean;
  end;
  • HELPERs para adicionar funcionalidade aos objetos existentes no DELPHI.

uses IniFiles, System.DateUtils, System.Rtti, System.TypInfo;

type

  {
    Fragmento de:    System.Classes.Helper
    https://github.com/amarildolacerda/helpers/blob/master/System.Classes.Helper.pas
  }
  TMemberVisibilitySet = set of TMemberVisibility;

  // RTTI para pegar propriedades do object
  TObjectHelper = class helper for TObject
  private
    procedure GetPropertiesItems(AList: TStrings;
      const AVisibility: TMemberVisibilitySet);
  end;

  // Adiciona Uso de RTTI para o INI
  TCustomIniFileHelper = class Helper for TCustomIniFile
  private
    procedure WriteObject(const ASection: string; AObj: TObject);
    procedure ReadObject(const ASection: string; AObj: TObject);
  public
  end;

  // Adiciona funções ao TValue
  TValueHelper = record helper for TValue
  private
    function IsNumeric: Boolean;
    function IsFloat: Boolean;
    function AsFloat: Extended;
    function IsBoolean: Boolean;
    function IsDate: Boolean;
    function IsDateTime: Boolean;
    function IsDouble: Boolean;
    function AsDouble: Double;
    function IsInteger: Boolean;
  end;


  • Métodos para gravação e leitura para o arquivo INI utilizando RTTI:
procedure TCustomIniFileHelper.WriteObject(const ASection: string;
  AObj: TObject);
var
  aCtx: TRttiContext;
  AFld: TRttiProperty;
  AValue: TValue;
begin
  aCtx := TRttiContext.Create;
  try
    for AFld in aCtx.GetType(AObj.ClassType).GetProperties do
    begin
      if AFld.Visibility in [mvPublic] then
      begin
        AValue := AFld.GetValue(AObj);
        if AValue.IsDate or AValue.IsDateTime then
          WriteString(ASection, AFld.Name, ISODateTimeToString(AValue.AsDouble))
        else if AValue.IsBoolean then
          WriteBool(ASection, AFld.Name, AValue.AsBoolean)
        else if AValue.IsInteger then
          WriteInteger(ASection, AFld.Name, AValue.AsInteger)
        else if AValue.IsFloat or AValue.IsNumeric then
          WriteFloat(ASection, AFld.Name, AValue.AsFloat)
        else
          WriteString(ASection, AFld.Name, AValue.ToString);
      end;
    end;
  finally
    aCtx.free;
  end;
end;

procedure TCustomIniFileHelper.ReadObject(const ASection: string;
  AObj: TObject);
var
  aCtx: TRttiContext;
  AFld: TRttiProperty;
  AValue, ABase: TValue;
begin
  aCtx := TRttiContext.Create;
  try
    for AFld in aCtx.GetType(AObj.ClassType).GetProperties do
    begin
      if AFld.Visibility in [mvPublic] then
      begin
        ABase := AFld.GetValue(AObj);
        AValue := AFld.GetValue(AObj);
        if ABase.IsDate or ABase.IsDateTime then
          AValue := ISOStrToDateTime(ReadString(ASection, AFld.Name,
            ISODateTimeToString(ABase.AsDouble)))
        else if ABase.IsBoolean then
          AValue := ReadBool(ASection, AFld.Name, ABase.AsBoolean)
        else if ABase.IsInteger then
          AValue := ReadInteger(ASection, AFld.Name, ABase.AsInteger)
        else if ABase.IsFloat or ABase.IsNumeric then
          AValue := ReadFloat(ASection, AFld.Name, ABase.AsFloat)
        else
          AValue := ReadString(ASection, AFld.Name, ABase.asString);
        AFld.SetValue(AObj, AValue);
      end;
    end;
  finally
    aCtx.free;
  end;
end;
  • Gravando o objeto no arquivo INI:

procedure TForm6.Button2Click(Sender: TObject);
begin
  // grava o objeto  OBJ no INI
  // inicializar OBJ antes de executar....
  with TIniFile.Create('teste.ini') do
    try
      WriteObject('SecaoClass', obj);
    finally
      free;
    end;

end;
  • Carregando o objeto com os dados do INI:
procedure TForm6.Button4Click(Sender: TObject);
begin
  // Ler os dados do INI para o OBJ
  with TIniFile.Create('teste.ini') do
    try
      ReadObject('SecaoClass', obj);
    finally
      free;
    end;
end;

Código Fonte no GIT

 

Para escrever arquivos JSON com as configurações ver o post seguinte

 

Share Button

Onde mesmo esta instalado o servidor Datasnap…. gostaria de descobrir a configuração do servidor:  local (ip) onde (porta) como (path)…

Olhando como o Indy-10 trabalha – não é tão intuitivo em se tratando de broadcast – então é preciso trabalhar um pouco.

Utilizar   TIdUDPServer – No Indy-10 o TIdUDPClient não obtive sucesso em pegar o retorno com broadcast… isto mudou o rumo da implementação – passei a pensar em montar DOIS servidores diferentes, um para o Servidor – outro para o Cliente.

Ver Código da Classe:  TIdZeroConfServer     e    TIdZeroConfClient

Projetos exemplos para Servidor e Cliente

Implementação

  1. No servidor datasnap preparar para receber o pedido do cliente solicitando os dados de configuração do servidor.
    
    procedure TForm1.FormCreate(Sender: TObject);
    begin
      FServer := TIdHTTPWebBrokerBridge.Create(Self);
      // criar o servidor zeroConf
      // ----------------------------------------------------------------------
      FZeroConf := TIdZeroConfServer.create(self);
    end;
    
    procedure TForm1.ButtonStopClick(Sender: TObject);
    begin
      TerminateThreads;
      FServer.Active := False;
      FServer.Bindings.Clear;
      // parar o servidor broadcast
      // ----------------------------------------------------------------------
      FZeroConf.active := false;
    end;
    
    
    procedure TForm1.StartServer;
    begin
      if not FServer.Active then
      begin
        FServer.Bindings.Clear;
        FServer.DefaultPort := StrToInt(EditPort.Text);
        FServer.Active := True;
        // configura o ZeroConf
        // --------------------------------------------------------------------
        FZeroConf.active  := false;
        FZeroConf.AppDefaultPort := FServer.DefaultPort; // Porta do servidor Datasnap
        FZeroConf.AppDefaultHost := FZeroConf.LocalHost; // IP de onde se encontra o Servidor da Aplicação Datasnap
        FZeroConf.AppDefaultPath :='/';     // path base do servidor
        FZeroConf.active := true;           // ativar o servidors
      end;
    end;
    
    
  2. Implementar no cliente Datasnap:
    procedure TForm4.FormCreate(Sender: TObject);
    begin
    
      // incia o cliente
      // -------------------------------------------------
      FZeroConfClient := TIdZeroConfClient.create(self);
      FZeroConfClient.OnResponseEvent := DoReceberDados;
    
    end;
    
    procedure TForm4.Button1Click(Sender: TObject);
    begin
      if not FZeroConfClient.active then
        FZeroConfClient.active := true;
      Memo1.Lines.Add('Envia comando de procurar servidor ('+FormatdateTime('hh:mm:ss',now)+')');
      FZeroConfClient.BroadcastIP := '';//'192.168.56.1';
      FZeroConfClient.Send;
    end;
    
    procedure TForm4.DoReceberDados(Sender: TObject; AMessage: String);
    begin
      // AMessage - retorna o JSON com os dados do servidor
      Memo1.Lines.Add('Resposta('+FormatdateTime('hh:mm:ss',now)+'):'+AMessage);
      Memo1.Lines.Add('');
      FZeroConfClient.Active := false; // desliga
    end;
    
    
    

 

Como funciona a mecânica

Quando iniciar o servidor  TIdZeroConfServer, ele criar um servidor UDP que fica esperando um broadcast na porta 53330 (configurável) ao ativar o ZeroConf passar os parametros do servidor Datasnap que será utilizado para responder as solitações dos clientes;

Do lado do cliente, ao ativar o TidZeroConfClient, ele criar uma escuta na porta 53331 e envia (send) comando solicitando configuração do servidor… recebe a resposta no evento – DoReceberDados(…);

Formato da Resposta

A reposta é um JSON:   {“service”:”ZeroConf”,”command”:”response”,”payload”:”yyyy-dd-mm hh:mm:ss”,”source”:”ip do servidor”,”host”;”ip onde o datasnap esta respondendo”,”port”:”porta do datasnap”,”path”:”caminho http”}

 

Cuidados/Limitações

Alguns firewall tendem a bloquear mensagem de broadcast, já que não é visto com bons olhos pelos gerenciadores de rede.

Usando broadcast por UDP, o pacote circula somente na rede local – não saindo para outras redes.

Multiplos aplicativos tentando utilizar a mesma porta… alterar para utilizar portas diferentes para aplicativos diferentes – provavelmente será necessário tratar as exceções para os casos de tentativa de abrir portas que  estão em uso.

 

 

 

 

Share Button

Por algum tempo não dei muita atenção para a RTTI. Tudo era muito trabalhoso. Quando cheguei na família XE notei que as coisa tinham mudado bastante, então passei a fazer uso de umas coisas aqui.. outras ali… quando nem tinha me dado conta as coisas estavam ficando sérias.

RTTI é uma ferramenta poderosa, mas dá trabalho. Gostaria de simplificar um pouco as coisa para poder usar com mais frequência e com mais segurança.

Depois de várias tentativas concluí que o caminha mais rápido seria usar Class Helper para entregar ao TObject suporte mais facilitado para as chamadas RTTI.

 

  TObjectHelper = class helper for TObject
    ....
    // RTTI
    property Properties[AName: string]: TValue read GetProperties
      write SetProperties;
    property Fields[AName: string]: TValue read GetFields write SetFields;
    property Methods[AName: String]: TRttiMethod read GetMethods;
    function HasAttribute(aMethod: TRttiMethod;
      attribClass: TCustomAttributeClass): Boolean;
    function InvokeAttribute(attribClass: TCustomAttributeClass;
      params: array of TValue): Boolean;
    function InvokeMethod(AName: string; params: array of TValue): Boolean;

  end;

Ver classe completa: RTTI Class Helper
* alguns métodos foram alterados para resolver conflitos.
 

Exemplo:

 

{$R *.dfm}
uses System.Classes.helper, System.TypInfo;

procedure TForm3.Button1Click(Sender: TObject);
begin
   Button1.GetPropertiesList( ListBox1.Items );   // pega uma lista de properiedades do Button1
   edit2.Text := Button1.Properties['Caption'].AsString;   // pega o valor da propriedade caption
end;

procedure TForm3.Button2Click(Sender: TObject);
begin
   button1.Properties[ 'Caption' ] := edit2.Text;  // altera a proprieda do Caption
end;

procedure TForm3.Button3Click(Sender: TObject);
begin
  button1.GetFieldsList( ListBox2.Items, [mvPrivate,mvPublic]  );
end;


Ver Exemplos

 

.