ActiveDelphi

[labambamogi]

Essa rotina retorna os comentários (descriptions) dos campos das tabelas ou procedures do Firebird
Amigos usuários, desculpem-me quanto o alinhamento do código, a explicação está logo em seguida.

Moderadores: tive que desativar BBCode nesta mensagem porque ele está alterando o código, façam testes e vejam que linhas como
while (cTabProc <> '') do
são alteradas p/
while (cTabProc <do> 0) then
Corrijam o site por favor, abraço.

create or alter procedure TITULO_CAMPO (
CTABPROC varchar(250),
CTIPO char(1) = 'T')
returns (
CAMPO varchar(50),
DESCRICAO varchar(1000))
as
declare variable CTABPROC2 varchar(50);
declare variable I integer;
declare variable PREFIXO varchar(10);
begin
cTabProc = upper(cTabProc);
cTipo = upper(cTipo);

--Como posso ter mandado mais de um objeto (a.ORC, b.CONTATO)...
while (cTabProc <do> 0) then
begin
cTabProc2 = trim(substring(cTabProc from 1 for i-1));
cTabProc = trim(substring(cTabProc from i+1 for char_length(cTabProc)));
end
else
begin
cTabProc2 = trim(cTabProc);
cTabProc = '';
end

i = position('.' in cTabProc2);
if (i > 0) then
begin
prefixo = substring(cTabProc2 from 1 for i-1) || '.';
cTabProc2 = substring(cTabProc2 from i+1 for char_length(cTabProc2));
end
else
prefixo = '';

--O uso da trim aqui é imprescindível p/ evitar espaços em branco no nome do campo gerando erros em comandos
--no Delphi como Locate
if (cTipo = 'T') then --T = Tabelas, P = Procedures
begin
for SELECT :prefixo || trim(upper(rdb$field_name)),
case
when position(ascii_char(13),rdb$description) > 0 then
substring(rdb$description from 1 for position(ascii_char(13),rdb$description)-1)
else rdb$description
end descricao
FROM rdb$relation_fields
WHERE rdb$relation_name = :cTabProc2 and rdb$description is not null
into :CAMPO, :DESCRICAO
do
suspend;
end
else
begin
--No caso das procedures, não considerei que as descrições dos campos requeressem mais que 1 linha
for select :prefixo || trim(upper(RDB$PARAMETER_NAME)), RDB$DESCRIPTION
from RDB$PROCEDURE_PARAMETERS
where RDB$PROCEDURE_NAME = :cTabProc2 and RDB$DESCRIPTION is not null
into :CAMPO, :DESCRICAO
do
suspend;
end
end
end

[danieldgm3]

Valeu!