por ·1 Comentário

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).

[code lang=”pascal”]
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;
[/code]

 

Dependência: System.uJson

 

por ·1 Comentário

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

 

por ·0 comentários

É 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:

[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]

  • HELPERs para adicionar funcionalidade aos objetos existentes no DELPHI.

[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]

  • Métodos para gravação e leitura para o arquivo INI utilizando RTTI:

[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]

  • Gravando o objeto no arquivo INI:

[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]

  • Carregando o objeto com os dados do INI:

[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

 

por ·0 comentários

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.

    [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]

  2. Implementar no cliente Datasnap:

    [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 ·0 comentários

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]

Ver Exemplos

 

.

por ·0 comentários

Quando se trabalha com processos paralelos o isolamento de memória com acesso comum a processos diferentes é fundamental.

Uma opção é implementar utilizando  TThreadList que mantem o controle da lista bloqueando ou liberando quando precisa acessar a área de armazenamento sem especialidades do TStringList .

De outro lado o TStringList não é threadsafe o que motiva a reescrever as funcionalidades para compartilhamento da lista entre os processos…   Ver Classes TThreadSafe….

[code lang=”pascal”]
TThreadSafeStringList
// public
procedure Clear;
function Count: integer;
function IndexOf(AText: string): integer;
function IndexOfName(AText: string): integer;
procedure Add(AText: string; ADupl: boolean = true);
procedure Delete(AIndex: integer);
procedure Remove(AText: string);
function LockList: TStringList;
procedure UnlockList; inline;
property Items[AIndex: integer]: string read Getitems write Setitems;
property Delimiter: Char read GetDelimiter write SetDelimiter;
property DelimitedText: string read GetDelimitedText write SetDelimitedText;
function Text: string;
property CommaText: string read GetCommaText write SetCommaText;
property QuoteChar: Char read GetQuoteChar write SetQuoteChar;
procedure Assing(AStrings: TStrings);
procedure AssingTo(AStrings: TStrings);
procedure AddTo(AStrings: TStrings);
property Values[AName: string]: String read GetValues write SetValues;
property Names[AIndex: integer]: String read GetNames write SetNames;
[/code]

Exemplo de como utilizar as lista compartilhando em Threads diferentes mantendo o controle do acesso a lista… [Codigo]

[code lang=”pascal”]
{$R *.fmx}

procedure TForm2.Button1Click(Sender: TObject);
var
x: integer;
begin
strList.Clear;
// Thread 1
tthread.CreateAnonymousThread(
procedure
var
x: integer;
begin
for x := 0 to random(1000) do
begin
strList.Add(‘X’ + intToStr(x));
tthread.Sleep(random(10));
end;
strList.Add(‘X-FIM’);

tthread.Queue(nil,
procedure
begin
strList.AssingTo(Memo1.lines);
end);

end).start;

// Thread 2
tthread.CreateAnonymousThread(
procedure
var
x: integer;
begin
for x := 0 to random(1000) do
begin
strList.Add(‘Z’ + intToStr(x));
tthread.Sleep(random(10));
end;
strList.Add(‘Z-FIM’);

tthread.Queue(nil,
procedure
begin
strList.AssingTo(Memo1.lines);
end);

end).start;

end;

procedure TForm2.FormCreate(Sender: TObject);
begin
strList := TThreadSafeStringList.create;

end;

procedure TForm2.FormDestroy(Sender: TObject);
begin
strList.free;
end;

[/code]

por ·0 comentários

Um boa dor de cabeça é resolver exceções em TThread, TTasks….

Base de Conhecimento
Como pré-requisito é preciso ter em mente (“recomenda-se”) não existir uma exceção não tratada dentro de uma TThread – então todos os processo deveriam tratar as suas exceções internamente com um Try/Exception.

[code]
Try
código com erro…
Except
on e:exception do
fazer algo…
end;
[/code]

 

No framework parte do “post” LogEvents é possível prever o tratamento de exception acrescentando o método RUN…

[code]
procedure TLogListItems.Run(proc: TProc);
begin
TThread.CreateAnonymousThread(
procedure
begin
try
proc;
except
on e: exception do
LogEvents.DoErro(nil, 0, e.message);
end;
end).start;
end;
[/code]

Com método RUN recebendo um ANONIMOUS Procedure – permite que a aplicação faça assim:

[code]
// usado metodo ANONIMOUS para tratar exception internamente
LogEvents.Run(
procedure begin
// código com potencial de exceção

// força um exception
raise Exception.Create(‘Error Message’);
end);

[/code]

Como mostrar o erro ao usuário

O Framework “LogEvents” possui um método de inicialização “register” que o formulário irá se inscrever para receber mensagens… e outro para retirar a inscrição “unregister“.

LogEvents.register(self, DoErro, 0); // recebe os registro de ERROS

onde:

  • self é o formulário que irá recebe mensagens…
  • DoErro é o método do furmulario…
  • e o terceiro parâmetro é um identificador que qualifica o tipo de mensagem que irá receber

O mesmo formulário pode subscrever a receber mais de um tipo de mensagem;

[code]

LogEvents.register(self, DoErro, 0); // recebe os registro de ERROS
LogEvents.register(self, DoSucesso, 1); // registra para receber os sucessos

[/code]

Para não receber mensagens – em geral quando o formulário fecha “close” usar: LogEvents.unregister(self);

Enviando mensagem para o formulário

O método genérico “Log” permite enviar uma mensagem para o identificador “0” (usado no register):

LogEvents.Log(‘Minha mensagem a ser mostrada’);

Para enviar uma mensagem com um identificador específico:

LogEvents.DoErro(nil, 1, ‘LOG…..’);  // register = 1

Código de Exemplo: LogEvents – Mostrando Erros ao usuário

 

 

por ·0 comentários

[usa LogEvents]
Tenho uma quantidade de produtos relativamente grande que requer processamento de custos de produção envolvendo custo de matérias primas, mão-de-obra e outros custos vinculado a célula de produção.

A modelagem prevê que uma ficha de produção pode conter outras fichas formando uma lista de dependências dos processos o que gera processamento recursivo de dependências.

Como se pode imaginar, não é um processamento sequenciado tão simples e pode ser demorado em face a profundidade da arvore de dependência que um produto pode exigir.

Então repensando os processos, o desafio passou exigir processamento em paralelo das fichas de tal forma que fosse possível processar uma quantidade de produtos ao mesmo tempo e aproveitando melhor os recursos da máquina;

Neste cenário, saber qual o estágio de processamento de cada ficha e o onde se encontra o cálculo passou a ser requisito de interação com usuário;

Para executar vamos utilizar da biblioteca de processamento em paralelo do Delphi (introduzido no XE7, no exemplo usamos Berlin).

Passos:

  • Isolar as conexões de banco de dados para trata-las individualmente por Task;
  • Criar infraestrutura de comunicação entre o processamento e feedback com usuário;
  • Tratar a sincronização de informações geradas pelas várias TTasks em andamento informando a janela de progresso do usuário;
imagem_janela
Tendo em mente que o controle possa ser utilizado em outras aplicações, o uso de um procedimento ANONIMOUS me parece bastante resistente a diversidade de códigos a que poderá vir a ser utilizado.
Veja como ficou o exemplo de execução:

[code lang=”pascal”]

procedure TForm8.Button1Click(Sender: TObject);
var
LProgr: IProgressEvents;
i: integer;
begin
// inicializa a janela de progresso
LProgr := TProgressEvents.new;
LProgr.max := 100; // opcional: marca o número máximo itens
LProgr.MaxThreads := SpinEdit1.Value ; // indica o número máximo de threads em paralelo
LProgr.CanCancel := true; :// marca se pode cancelar a operação

for i := 1 to 100 do
begin // loop de demonstração – simulando uma lista de processos
LProgr.Text := ‘Produto: ‘ + intToStr(i); // texto livre

// onde as coisas acontecem…..
// adiciona o processo a ser executado e aponta o método anonimous as ser executado pela TTask
LProgr.add(i, ‘Produto: ‘ + intToStr(i), // processo a executar
procedure(x: integer)
var
n: integer;
msg: string;
begin
msg := ‘Produto: ‘ + intToStr(x); // processo em execução
LogEvents.DoProgress(self, 0, etStarting, msg); // notifica que o processo foi iniciado
n := Random(10000);

sleep(n);
LogEvents.DoProgress(self, 0, etWorking, msg); // notifica que esta em execução
// executa o código de calculo … aqui…
n := Random(10000);
if LProgr.Terminated then exit; // checa se o usuario cancelou a operação
sleep(n);
end);
if LProgr.Terminated then
break;
end;
LogEvents.DoProgress(self, 0, etAllFinished, ”); // sinaliza que todas os processo foram completados.
end;

[/code]

Código fonte com o Exemplo e classes que implementam a janela de monitoramento do progresso de cada thread.

por ·0 comentários

Como é de conhecimento da comunidade o FireDac não tem suporte completo ao Firebird3, já que o lançamento do FB3 veio depois do lançamento do Berlin.

Quando se trabalha com Package (novidade no FB3) não é possível escolher na IDE qual o procedimento a executar no componente TFDStoredProc.
Uma forma de fazer isto é escrevendo um editor (delphi way) para auxiliar a propriedade StoredProcName…

[code lang=”pascal”]

unit Data.fireStoredProcEditor;

interface

uses
SysUtils, Classes, DesignIntf, DesignEditors, DB;

type
TFireStoredProcNames = class(TStringProperty)
private
procedure GetValues(Proc: TGetStrProc); override;

public
function GetAttributes: TPropertyAttributes; override;
end;

procedure Register;

implementation

uses FireDAC.Comp.Client, FireDAC.Phys.Intf;

procedure Register;
begin
RegisterPropertyEditor(TypeInfo(string), TFDCustomStoredProc,
‘StoredProcName’, TFireStoredProcNames);
end;

{ TFireStoredProcNames }

function TFireStoredProcNames.GetAttributes: TPropertyAttributes;
begin
result := [paValueList];
end;

procedure TFireStoredProcNames.GetValues(Proc: TGetStrProc);
var
DB: TFDCustomStoredProc;
qry: TFDQuery;
eh3:boolean;
oMetaIntf: IFDPhysConnectionMetadata;
function iff(b:boolean;t,f:string):string;
begin
if b then result := t else result := f;
end;
begin
if (GetComponent(0).InheritsFrom(TFDCustomStoredProc)) then
begin
DB := TFDCustomStoredProc(GetComponent(0));
if assigned(DB.Connection) then
begin
if (DB.Connection.DriverName = ‘FB’) then
begin
oMetaIntf := DB.Connection.ConnectionMetaDataIntf;
eh3 := oMetaIntf.ServerVersion.ToString[1]=’3′;
qry := TFDQuery.create(nil);
try
qry.Connection := DB.Connection;
qry.SQL.Text := ‘select rdb$procedure_name sName from rdb$procedures ‘;
if eh3 then
qry.SQL.Text := qry.SQL.Text+ iff(db.PackageName<>”, ‘ where rdb$package_name = ‘ + QuotedStr(DB.PackageName.ToUpper),’ where rdb$package_name is null ‘);
qry.Open;
with qry do
while eof = false do
begin
Proc(fieldByName(‘sName’).asString);
next;
end;
finally
qry.Free;
end;
end
else
inherited;
end;
end
else
inherited;

end;

end.

[/code]

Exemplo de uma package no FB3: DateUtils Package

Criando um Packege no Delphi para a Integração
Para integrar o novo editor é necessário criar um novo projeto Package no Delphi e incluir o código do editor.
[code]
// exemplo do projeto do Package (mínimo)
package FireEditores;
{$R *.res}
requires
DesignIDE;
contains
Data.fireStoredProcEditor in ‘Data.fireStoredProcEditor.pas’;
end.

[/code]

por ·0 comentários

Estava precisando de informações sobre uma exceção e o log de erro não dizia nada relevante possível de encontrar onde o problema ocorria.

Já vi vários posts sobre o assunto peguntando como fazer isto. Então não tive outra saída… mãos-a-obra.

(uso Delphi 10.1)

A instância  “Application” possui um evento “application.onException” que permite indicar um método para redirecionar a saída de todas as exceções não tratadas pelo aplicativo.

[code lang=”pascal”]
// preparando o evento no formulário principal
procedure TForm1.DoAppException(sender:TObject; E:Exception);
begin
DoAppExceptionEvent(sender,e,true);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Application.OnException := DoAppException;
…
end;
[/code]

[code lang=”pascal”]
uses Forms, System.Classes,System.SysUtils,System.RTTI;

// grava o log em disco
procedure ErrorLog(ATexto: string);
var
LArquivo: string;
LTextFile: textfile;
begin
LArquivo := ‘Erros_’ + formatDateTime(‘yyyymmdd’, date) + ‘.log’;
ForceDirectories(ExtractFilePath(LArquivo));

AssignFile(LTextFile, LArquivo);
try
{$I-}
Append(LTextFile);
{$I+}
if IOResult <> 0 then // se o arquivo nao existe, criar um novo;
Rewrite(LTextFile);
WriteLn(LTextFile, ATexto);
finally
CloseFile(LTextFile);
end;
end;

// monta a mensagem do log com base nos atributos do objecto que gerou a exceção
procedure DoAppExceptionEvent(Sender: TObject; E: Exception;
AShow: boolean = True);
var
LMsg: string;
function GetRTTILog(ASender: TObject): string;
var
LNome: string;
LContext: TRttiContext;
LType: TRttiType;
LProp: TRttiProperty;
LVar: TValue;
LTxt: String;
begin
result := ”;
if ASender=nil then exit;
result := ‘ClassName: ‘ + ASender.ClassName + #13#10;
LContext := TRttiContext.Create;
try
LType := LContext.GetType(ASender.ClassType);
for LProp in LType.GetProperties do
begin
try
LVar := LProp.GetValue(ASender);
LTxt := LVar.AsString;
if LTxt <> ” then
result := result + LProp.Name + ‘: ‘ + LTxt + #13#10;
except
end;
end;
finally
LContext.Free;
end;
end;

begin
try
LMsg := ”;
if assigned(Sender) then
begin
LMsg := GetRTTILog(Sender);
end;
LMsg := LMsg + ‘ Message: ‘ + E.Message;
ErrorLog(LMsg);
except
on ee: Exception do
ErrorLog(ee.Message);
end;
if AShow then
begin
E.Message := LMsg;
Application.ShowException(E);
end;
end;

[/code]