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
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
É 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.
[code]
// 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;
[/code]
[code lang=”pascal”]
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;
[/code]
[code]
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;
[/code]
[code]
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;
[/code]
[code]
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;
[/code]
Código Fonte no GIT
Para escrever arquivos JSON com as configurações ver o post seguinte
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
[code lang=”pascal”]
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;
[/code]
[code lang=”pascal”]
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;
[/code]
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.
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.
[code lang=”pascal”]
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;
[/code]
Ver classe completa: RTTI Class Helper
* alguns métodos foram alterados para resolver conflitos.
Exemplo:
[code]
{$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;
[/code]
.