CREATE PROCEDURE FU_ABS(
WVAR DOUBLE PRECISION)
RETURNS (
R_ABS DOUBLE PRECISION)
AS
begin
/*
devolve o valor Absoluto de um número.
-123,47 ou 123,47 devolve sempre 123,47
*/
if (:wvar is not null) then begin
if (:wvar < 0.0000) then
r_abs = :wvar * -1;
else
r_abs = :wvar;
end
suspend;
end
===================================
CREATE PROCEDURE FU_ALLTRIM(
WVAR VARCHAR(8192))
RETURNS (
R_ALLTRIM VARCHAR(8192))
AS
DECLARE VARIABLE T SMALLINT;
begin
/*
Devolve um string sem espaços
*/
select r_Len from Fu_Len(:wvar) into :t;
r_alltrim = '';
while ((:wvar is not null) and (:t > 0)) do begin
if (substring(:wvar from 1 for 1) <> ' ') then
r_alltrim = :r_alltrim || substring(:wvar from 1 for 1);
wvar = substring(:wvar from 2 for 8191);
t = :t - 1;
end
suspend;
end
====================================
CREATE PROCEDURE FU_BEFORE_AFTER(
WPES VARCHAR(8192),
WVAR VARCHAR(8192),
WTIP CHAR(1))
RETURNS (
WRET VARCHAR(8192))
AS
declare variable wint smallint;
declare variable wlen smallint;
begin
/*
Devolve os caracteres "Anteriores" ou "Posteriores" de
um string tomando como base "WPES"
*/
wtip = upper(:wtip);
select result from Fu_Pos(:wpes, :wvar) into :wint;
if (:wtip = 'B') then -- Before
begin
if (:wint = 0) then
wret = wpes;
else
select r_Copy from Fu_Copy(:wvar, 1, (:wint - 1)) into :wret;
end
else begin -- After
if (:wint = 0) then
wret = '';
else begin
select r_Len from Fu_Len(:wpes) into :wlen;
select r_Copy from Fu_Copy(:wvar, (:wint + :wlen), 8191) into :wret;
end
end
suspend;
end
================================================
CREATE PROCEDURE FU_CENTRO(
WSTR VARCHAR(8192),
WTAM SMALLINT)
RETURNS (
R_CENTRO VARCHAR(8192))
AS
DECLARE VARIABLE I SMALLINT;
DECLARE VARIABLE T SMALLINT;
DECLARE VARIABLE S VARCHAR(8192);
begin
/*
Devolve um string Centralizado Com o tamanho "WRAM"
*/
select r_Len from Fu_Len(:wstr) into :t;
if (:t > :wtam) then
select r_Copy from Fu_Copy(:wstr, 1, :wtam) into :r_centro;
else if (:t = :wtam) then
r_centro = :wstr;
else begin
select r_div from Fu_div((:wtam - :t), 2) into :i;
select r_replicate from Fu_replicate(:i, ' ') into :s;
wstr = :s || :wstr;
select r_replicate from Fu_replicate(((:wtam - :t) - :i), ' ') into :s;
r_centro = :wstr || :s;
end
suspend;
end
==============================================
CREATE PROCEDURE FU_CLASS(
WSTR VARCHAR(8192),
WSUB VARCHAR(8192),
WDEL CHAR(1),
WORD CHAR(1))
RETURNS (
R_RET VARCHAR(8192))
AS
declare variable wpos smallint;
declare variable tra1 varchar(8192);
declare variable wfez smallint = 1;
begin
/*
Insere "WSUB" em "WSTR" na ordem ascending ou
descending (conforme "WORD"). "WSTR" deve estar delimitada por "WDEL"
*/
select result from Fu_pos(:wdel, :wstr) into :wpos;
select r_copy from Fu_Copy(:wstr, 1, (:wpos - 1)) into :tra1;
if (:word = 'A') then -- Ordem Ascending...
begin
if (:wsub < :tra1) then -- Se já for a primeira
r_ret = :wsub || :wdel || :wstr; -- Concatenar
else begin -- Senão...
select r_last_pos from Fu_last_pos(:wdel, :wstr) into :wpos; -- Última Posição do delimitador
select r_copy from Fu_Copy(:wstr, (:wpos + 1), 8191) into :tra1; -- Última String
if (:wsub >= :tra1) then -- Se for a última
r_ret = :wstr || :wdel || :wsub; -- Concatenar
else begin -- Senão
select result from Fu_pos(:wdel, :wstr) into :wpos; -- Posição do delimitador
select r_copy from Fu_Copy(:wstr, 1, (:wpos - 1)) into :tra1; -- Primeira String
r_ret = :tra1 || :wdel; -- ... e concatenar
select r_copy from Fu_Copy(:wstr, (:wpos + 1), 8191) into :wstr; -- STR resultante
while (:wfez = 1) do begin -- Enquanto não achar o lugar
select result from Fu_pos(:wdel, :wstr) into :wpos; -- Posição do delimitador ns STR resultante
if (:wpos = 0) then -- Se não tem mais...
tra1 = :wstr; -- Inicializo :TRA1
else -- Senão...
select r_copy from Fu_Copy(:wstr, 1, (:wpos - 1)) into :tra1; -- Defino
if (:wsub <= :tra1) then -- Comparo
begin
r_ret = :r_ret || :wsub || :wdel; -- Concateno se é o lugar
select r_copy from Fu_Copy(:wstr, (:wpos + 1), 8191) into :wstr;-- STR resultante
r_ret = :r_ret || :wstr; -- Concateno o restante
wfez = 0; -- Para sair do LOOP
end
else begin -- Senão...
r_ret = :r_ret || :wdel || :tra1; -- concateno
select r_copy from Fu_Copy(:wstr, (:wpos + 1), 8191) into :wstr; -- STR resultante
end
end
end
end
end
else begin -- Orden Descending...
if (:tra1 < :wsub) then
r_ret = :wsub || :wdel || :wstr;
else begin
select r_last_pos from Fu_last_pos(:wdel, :wstr) into :wpos;
select r_copy from Fu_Copy(:wstr, (:wpos + 1), 8191) into :tra1;
if (:tra1 >= :wsub) then
r_ret = :wstr || :wdel || :wsub;
else begin
select result from Fu_pos(:wdel, :wstr) into :wpos;
select r_copy from Fu_Copy(:wstr, 1, (:wpos - 1)) into :tra1;
r_ret = :tra1 || :wdel;
select r_copy from Fu_Copy(:wstr, (:wpos + 1), 8191) into :wstr;
while (:wfez = 1) do begin
select result from Fu_pos(:wdel, :wstr) into :wpos;
if (:wpos = 0) then
tra1 = :wstr;
else
select r_copy from Fu_Copy(:wstr, 1, (:wpos - 1)) into :tra1;
if (:tra1 <= :wsub) then
begin
r_ret = :r_ret || :wsub || :wdel;
select r_copy from Fu_Copy(:wstr, (:wpos + 1), 8191) into :wstr;
r_ret = :r_ret || :wstr;
wfez = 0;
end
else begin
r_ret = :r_ret || :wdel || :tra1;
select r_copy from Fu_Copy(:wstr, (:wpos + 1), 8191) into :wstr;
end
end
end
end
end
suspend;
end
================================================
CREATE PROCEDURE FU_COPY(
WVAR VARCHAR(8192),
WINI INTEGER,
WTAM INTEGER)
RETURNS (
R_COPY VARCHAR(8192))
AS
DECLARE VARIABLE I INTEGER;
DECLARE VARIABLE J INTEGER;
DECLARE VARIABLE K INTEGER;
begin
/*
Copia de "WINI" "WTAM" bytes de "WVAR"
Este recurso não é mais necessário no FB 2
Pois já aceita o substring com variáveis
*/
select r_Len from Fu_Len(:wvar) into :i;
j = 1;
k = 1;
r_copy = '';
while ((:wvar is not null) and (:i > 0) and (j <= :wtam)) do begin
if (:k >= :wini) then begin
r_copy = :r_copy || substring(:wvar from 1 for 1);
j = j + 1;
end
wvar = substring(:wvar from 2 for 8191);
k = :k + 1;
i = :i - 1;
end
suspend;
end
========================================
CREATE PROCEDURE FU_CPA_PERI(
PER1 VARCHAR(8),
PER2 VARCHAR(8))
RETURNS (
R_CPA_PERI CHAR(1))
AS
begin
/*
Compara dois períodos (MM/AAAA) e devolve
"<", ">" ou "=" conforme o caso
*/
if ((:per1 is not null) and (:per2 is not null)) then begin
if ((substring(:per1 from 4 for 4) || substring(:per1 from 1 for 2)) =
(substring(:per2 from 4 for 4) || substring(:per2 from 1 for 2))) then
r_cpa_peri = '=';
else if ((substring(:per1 from 4 for 4) || substring(:per1 from 1 for 2)) >
(substring(:per2 from 4 for 4) || substring(:per2 from 1 for 2))) then
r_cpa_peri = '>';
else if ((substring(:per1 from 4 for 4) || substring(:per1 from 1 for 2)) <
(substring(:per2 from 4 for 4) || substring(:per2 from 1 for 2))) then
r_cpa_peri = '<';
end
suspend;
end
===========================================
CREATE PROCEDURE FU_CRIP(
WSTR VARCHAR(1024),
ACAO SMALLINT)
RETURNS (
R_STR VARCHAR(1024))
AS
DECLARE VARIABLE WS1 VARCHAR(255);
DECLARE VARIABLE WS2 VARCHAR(255);
DECLARE VARIABLE WLT CHAR(1);
DECLARE VARIABLE WIN SMALLINT;
DECLARE VARIABLE WLE SMALLINT;
DECLARE VARIABLE WPO SMALLINT;
begin
/*
Devolve um string criptografado se "ACAO" = 0
senão descriptografa. Função bem CASEIRA
*/
ws1 = ' [AaB1bC2(c+Ç3çD4dE5eF6fG7g)H8hI9iJ0jKk-LlMmNn]OoPpQqRrSsTtUuVvXxYyWwZz"!@#$%¨&*_´`{^~}|\<,>.:;?/' ||
'éóúàèìòùêûâîôÁÉÍÓÚÀÈÌÒÙÃÕ¥¡¢£¤¦§¨©ª®°±²³µ•¸¹"¼¾¿ÅÆÏÐÑÖ×ÝÞö÷øýþ';
ws2 = 'éóúàèìòùêûâîôÁÉÍÓÚÀÈÌÒÙÃÕ¥¡¢£¤¦§¨©ª®°±²³µ•¸¹"¼¾¿ÅÆÏÐÑÖ×ÝÞö÷øýþ' ||
' AB0CÇ9DE8FG7HI6JK5LM4NO3PQ2RS1TUVXYWZabcçdefghijklmnopqrstuvxywz"!@#$%¨&*()_+´`{[^~}]|\<,>.:;?/-';
r_str = '';
select r_Len from Fu_Len(:wstr) into :wle;
win = 1;
if (:acao = 0) then -- Criptografa a string
begin
while (:win <= :wle) do begin
select r_Copy from Fu_Copy(:wstr, :win, 1) into :wlt;
select result from Fu_Pos(:wlt, :ws1) into :wpo;
if (:wpo > 0) then
select r_Copy from Fu_Copy(:ws2, :wpo, 1) into :wlt;
r_str = :r_str || :wlt;
win = :win + 1;
end
end
else begin -- desfaz a criptografia
while (:win <= :wle) do begin
select r_Copy from Fu_Copy(:wstr, :win, 1) into :wlt;
select result from Fu_Pos(:wlt, :ws2) into :wpo;
if (:wpo > 0) then
select r_Copy from Fu_Copy(:ws1, :wpo, 1) into :wlt;
r_str = :r_str || :wlt;
win = :win + 1;
end
end
suspend;
end
=========================================
CREATE PROCEDURE FU_CUBE(
WNUM DOUBLE PRECISION)
RETURNS (
RAIZ DOUBLE PRECISION)
AS
declare variable parc double precision;
declare variable wraz smallint = 3;
begin
/*
Devolve a Raiz Cúbica de um número.
Há uma tolerância em caso de inexato.
*/
select sqr from Fu_sqrt(:wnum) into :parc;
while (:wraz > 2) do begin
select sqr from Fu_sqrt(:parc) into :raiz;
wraz = :wraz - 1;
end
wraz = 3;
parc = :raiz * raiz * :raiz;
while (:parc < :wnum) do begin
raiz = :raiz + 1;
parc = :raiz * raiz * :raiz;
end
if (:parc > :wnum) then begin
raiz = :raiz - 1;
parc = :raiz * raiz * :raiz;
while (:parc < :wnum) do begin
raiz = :raiz + 0.50000;
parc = :raiz * raiz * :raiz;
end
if (:parc > :wnum) then begin
raiz = :raiz - 0.50000;
parc = :raiz * raiz * :raiz;
while (:parc < :wnum) do begin
raiz = :raiz + 0.10000;
parc = :raiz * raiz * :raiz;
end
if (:parc > :wnum) then begin
raiz = :raiz - 0.250000;
parc = :raiz * raiz * :raiz;
while (:parc < :wnum) do begin
raiz = :raiz + 0.050000;
parc = :raiz * raiz * :raiz;
end
if (:parc > :wnum) then begin
raiz = :raiz - 0.050000;
parc = :raiz * raiz * :raiz;
while (:parc < :wnum) do begin
raiz = :raiz + 0.001000;
parc = :raiz * raiz * :raiz;
end
if (:parc > :wnum) then begin
raiz = :raiz - 0.0010000;
parc = :raiz * raiz * :raiz;
while (:parc < :wnum) do begin
raiz = :raiz + 0.0001000;
parc = :raiz * raiz * :raiz;
end
if (:parc > :wnum) then begin
raiz = :raiz - 0.00010000;
parc = :raiz * raiz * :raiz;
while (:parc < :wnum) do begin
raiz = :raiz + 0.00001000;
parc = :raiz * raiz * :raiz;
end
if (:parc > :wnum) then begin
raiz = :raiz - 0.000010000;
parc = :raiz * raiz * :raiz;
while (:parc < :wnum) do begin
raiz = :raiz + 0.000001000;
parc = :raiz * raiz * :raiz;
end
end
end
end
end
end
end
end
parc = cast(:raiz as integer);
if ((:parc * :parc * :parc) = :wnum) then
raiz = :parc;
suspend;
end
======================================
CREATE PROCEDURE FU_DATATELA(
DAT1 DATE,
DAT2 VARCHAR(24),
TIPO CHAR(1))
RETURNS (
DATA_TELA VARCHAR(19))
AS
begin
/*
Devolve uma data ou um TaimeStamp como:
DD/MM/YY ou DD/MM/YYYY ou
DD/MM/YY HH:MM:SS ou DD/MM/YYYY HH:MM:SS
como um string (Bom para relatórios)
*/
tipo = upper(:tipo);
if(:dat1 is not null) then
begin
if (:tipo = 'E') then
data_tela = substring(cast(:dat1 as varchar(10)) from 9 for 2) || '/' ||
substring(cast(:dat1 as varchar(10)) from 6 for 2) || '/' ||
substring(cast(:dat1 as varchar(10)) from 1 for 4);
else
data_tela = substring(cast(:dat1 as varchar(10)) from 9 for 2) || '/' ||
substring(cast(:dat1 as varchar(10)) from 6 for 2) || '/' ||
substring(cast(:dat1 as varchar(10)) from 2 for 2);
end
else begin
if (tipo = 'E') then
data_tela = substring(:dat2 from 9 for 2) || '/' ||
substring(:dat2 from 6 for 2) || '/' ||
substring(:dat2 from 1 for 4) || ' ' ||
substring(:dat2 from 12 for 8);
else
data_tela = substring(:dat2 from 9 for 2) || '/' ||
substring(:dat2 from 6 for 2) || '/' ||
substring(:dat2 from 2 for 2) || ' ' ||
substring(:dat2 from 12 for 8);
end
suspend;
end
================================================
CREATE PROCEDURE FU_DATE_TO_INTEGER(
WDAT CHAR(10))
RETURNS (
R_DTI INTEGER)
AS
declare variable wano smallint;
declare variable wmes smallint;
declare variable wdia smallint;
declare variable trab integer;
declare variable wmat integer;
begin
/*
Devolve um inteiro conforme a data informada
"WDAT" deve vir assim: aaaa-mm-dd
*/
wano = cast(substring(:wdat from 1 for 4) as smallint);
wmes = cast(substring(:wdat from 6 for 2) as smallint);
wdia = cast(substring(:wdat from 9 for 2) as smallint);
if (:wmes = 2) then wmat = 31;
else if (:wmes = 3) then wmat = 59;
else if (:wmes = 4) then wmat = 90;
else if (:wmes = 5) then wmat = 120;
else if (:wmes = 6) then wmat = 151;
else if (:wmes = 7) then wmat = 181;
else if (:wmes = 8) then wmat = 212;
else if (:wmes = 9) then wmat = 243;
else if (:wmes = 10) then wmat = 273;
else if (:wmes = 11) then wmat = 304;
else if (:wmes = 12) then wmat = 334;
else wmat = 0;
select r_abs from fu_abs(((:wano - 1901) * 366)) into :trab;
r_dti = :trab + :wmat + :wdia;
suspend;
end
============================================
CREATE PROCEDURE FU_DECIMAL_HORA(
FNUM DECIMAL(10,4))
RETURNS (
HORA VARCHAR(10),
WHOR INTEGER,
WMIN INTEGER)
AS
declare variable wint integer;
declare variable wtam integer;
declare variable trab varchar(14);
declare variable tra1 varchar(14);
begin
/*
Se "FNUM" = 10,50 então devolve 10,30... etc
Se "FNUM" = 15,20 então devolve 15,12
*/
select r_formatar from Fu_formatar(:fnum, '######0,0000') into :trab;
select r_sright from Fu_s_right(:trab, 1) into :tra1;
select r_ltrim from Fu_ltrim(:trab) into :trab;
select r_len from Fu_len(:trab) into :wtam;
while (:tra1 = '0') do begin
select r_sleft from Fu_s_left(:trab, :wtam - 1) into :trab;
select r_sright from Fu_s_right(:trab, 1) into :tra1;
wtam = :wtam - 1;
end
tra1 = :trab;
select result from Fu_pos(',', :trab) into :wint;
select r_copy from Fu_Copy(:trab, (:wint + 1), (:wtam - :wint)) into :trab;
wmin = cast(:trab as integer);
wmin = :wmin * 6;
select r_div from Fu_div(:wmin, 10) into :wmin;
select r_copy from Fu_Copy(:tra1, 1, (:wint - 1)) into :trab;
whor = cast(:trab as integer);
while (:wmin > 60) do begin
wmin = :wmin - 60;
whor = :whor + 1;
end
hora = cast(:whor as varchar(6));
select r_len from Fu_len(:trab) into :wtam;
if (:wtam = 1) then
hora = '0' || :hora;
select r_intzero from Fu_intzero(:wmin, 2) into :trab;
hora = :hora || ':' || :trab;
suspend;
end
======================================
CREATE PROCEDURE FU_DECODE_DATE(
WDAT DATE)
RETURNS (
RDIA SMALLINT,
RMES SMALLINT,
RANO SMALLINT)
AS
begin
/*
Igual ao Delphi
*/
rdia = extract(day from :wdat);
rmes = extract(month from :wdat);
rano = extract(year from :wdat);
suspend;
end
=======================================
CREATE PROCEDURE FU_DECODE_DATE_TIME(
WDAT TIMESTAMP)
RETURNS (
RDIA SMALLINT,
RMES SMALLINT,
RANO SMALLINT,
RHOR SMALLINT,
RMIN SMALLINT,
RSEG DECIMAL(6,4),
WEEK SMALLINT,
YDIA SMALLINT)
AS
declare variable trab varchar(24);
begin
/*
Igual ao Delphi
*/
trab = cast(:wdat as varchar(24));
rdia = extract(day from :wdat);
rmes = extract(month from :wdat);
rano = extract(year from :wdat);
if (substring(:trab from 12 for 13) = '00:00:00.0000') then
begin
rhor = 0;
rmin = 0;
rseg = 0.0000;
end
else begin
rhor = extract(hour from :wdat);
rmin = extract(minute from :wdat);
rseg = extract(second from :wdat);
end
week = extract(weekday from :wdat);
ydia = extract(yearday from :wdat);
suspend;
end
===================================
CREATE PROCEDURE FU_DIV(
WRAD INTEGER,
WDIV INTEGER)
RETURNS (
R_DIV INTEGER)
AS
begin
/*
Igual ao Delphi
*/
R_DIV = :WRAD / :WDIV;
suspend;
end
=====================================
CREATE PROCEDURE FU_DSTR(
WSTR VARCHAR(8192),
WTAM SMALLINT)
RETURNS (
R_DSTR VARCHAR(8192))
AS
DECLARE VARIABLE T SMALLINT;
declare variable s varchar(8192);
begin
/*
Devolve um string com espaços à direita até
o tamanho "WTAM"
*/
select r_Len from Fu_Len(:wstr) into :t;
if (:wstr is null) then
wstr = '';
if (:t > :wtam) then
select r_Copy from Fu_Copy(:wstr, 1, :wtam) into :r_dstr;
else begin
select r_spaces from Fu_spaces(:wtam - :t) into :s;
r_dstr = :wstr || :s;
end
suspend;
end
=========================================
CREATE PROCEDURE FU_DVMODULO10(
WSTR VARCHAR(50))
RETURNS (
WDIG INTEGER)
AS
declare variable wsom integer;
declare variable wreg integer;
declare variable wmul integer;
declare variable wini integer;
declare variable winj integer;
declare variable winh integer;
declare variable trab varchar(6);
begin
/*
Dígito Verificador Módulo 10
*/
wsom = 0;
wreg = 0;
wmul = 2;
select r_Len from Fu_Len(:wstr) into :wini;
winh = :wini;
winj = 1;
while (:winj <= :wini) do begin
select r_Copy from Fu_Copy(:wstr, :winh, 1) into :trab;
wreg = cast(:trab as integer) * :wmul;
wsom = :wsom + :wreg;
if (:wmul = 2) then
wmul = 1;
else
wmul = :wmul + 1;
winj = :winj + 1;
winh = :winh - 1;
end
select r_mod from Fu_mod(:wsom, 10) into :wdig;
suspend;
end
==========================================
CREATE PROCEDURE FU_DVMODULO11(
WSTR VARCHAR(50))
RETURNS (
WDIG INTEGER)
AS
declare variable wsom integer;
declare variable wreg integer;
declare variable wmul integer;
declare variable wini integer;
declare variable winj integer;
declare variable winh integer;
declare variable wxi1 integer;
declare variable wxi2 integer;
declare variable waux char(2);
declare variable wax1 char(1);
declare variable wax2 char(1);
declare variable wtra varchar(10);
begin
/*
Dígito Verificador Módulo 11
*/
wsom = 0;
wreg = 0;
wmul = 2;
select r_Len from Fu_Len(:wstr) into :wini;
winh = :wini;
winj = 1;
while (:winj <= :wini) do begin
select r_Copy from Fu_Copy(:wstr, :winh, 1) into :wtra;
wreg = cast(:wtra as integer) * :wmul;
while (:wreg > 9) do begin
waux = cast(:wreg as char(2));
wax1 = substring(:waux from 1 for 1);
wax2 = substring(:waux from 2 for 1);
wxi1 = cast(:wax1 as integer);
wxi2 = cast(:wax2 as integer);
wreg = :wxi1 + :wxi2;
end
wsom = :wsom + :wreg;
if (:wmul = 9) then
wmul = 2;
else
wmul = :wmul + 1;
winj = :winj + 1;
winh = :winh - 1;
end
select r_mod from Fu_mod(:wsom, 11) into :wdig;
if ((:wdig = 10) or (:wdig = 1) or (:wdig = 0)) then
wdig = 0;
suspend;
end
=======================================
CREATE PROCEDURE FU_ESTR(
WSTR VARCHAR(8192),
WTAM SMALLINT)
RETURNS (
R_ESTR VARCHAR(8192))
AS
DECLARE VARIABLE T SMALLINT;
begin
/*
Devolve um string com espaços à direita conforme "WTAM"
*/
select r_Len from Fu_Len(:wstr) into :t;
r_estr = :wstr;
if (:t > :wtam) then
select r_Sright from Fu_S_Right(:wstr, :wtam) into :r_estr;
else begin
while (:t < :wtam) do begin
r_estr = ' ' || :r_estr;
t = :t + 1;
end
end
suspend;
end
==============================================
CREATE PROCEDURE FU_EXTENSO(
VALO DECIMAL(18,2),
LIN1 INTEGER,
LIN2 INTEGER)
RETURNS (
R_EXT1 VARCHAR(126),
R_EXT2 VARCHAR(126),
R_EXT3 VARCHAR(256))
AS
declare variable nao1 varchar(16);
declare variable nao2 varchar(50);
declare variable nao3 varchar(16);
declare variable nao4 varchar(25);
declare variable wvlr varchar(16);
declare variable trab varchar(256);
declare variable tra1 varchar(16);
declare variable rext varchar(256);
declare variable wint integer;
declare variable wtri integer;
declare variable var1 integer;
declare variable var2 integer;
declare variable var3 integer;
begin
/*
Devolve duas linhas com o número "VALO" por extenso
a primeira linha tem "LIN1" de tamanho e
a segunda linha tem "LIN2" de tamanho.
Também é feita uma separação silábica considerando as
regras de sintaxe da l´ngua portuguesa.
Utiliza-se em conjunto as SPs FU_EXT_TESTA1 e FU_EXT_TESTA2 abaixo
*/
if (Lin1 = 0) then
Lin1 = 1;
if (Lin2 = 0) then
Lin2 = 1;
if (:Lin1 > 128) then Lin1 = 125;
if (:Lin2 > 128) then Lin2 = 125;
nao1 = 'bctdrqvhêõãm?';
nao2 = ' o; n; s; u;ci;ei;nh;ce;qu;he;nz;oz;rz;ai;ss;uz';
nao3 = 'rea;are;doi;ato';
nao4 = 'trez;uinh;nhen;uato;ssei';
r_ext1 = '';
wvlr = '';
wint = 1;
if (:valo < 0.01) then valo = :valo * -1;
select r_Formatar from Fu_Formatar(:valo, '##########0,00') into :rext;
while (:wint < 15) do begin
select r_Copy from Fu_Copy(:rext, :wint, 1) into :trab;
select result From Fu_Pos(:trab, '0123456789,') into :wtri;
if (:wtri > 0) then wvlr = :wvlr || :trab;
wint = :wint + 1;
end
rext = '';
select result From Fu_Pos(',', :wvlr) into :wtri;
if (:wtri = 0) then wvlr = :wvlr || ',00';
select r_Len from Fu_Len(:wvlr) into :wtri;
while (:wtri < 14) do begin
wvlr = '0' || :wvlr;
wtri = :wtri + 1;
end
if (substring(:wvlr from 13 for 1) = ',') then
wvlr = substring(:wvlr from 2 for 11) || ',' || substring(:wvlr from 14 for 1) || '0';
if (cast(substring(:wvlr from 1 for 2) as integer) > 0) then begin
trab = substring(:wvlr from 1 for 2);
var1 = 0;
var2 = cast(substring(:trab from 1 for 1) as integer);
var3 = cast(substring(:trab from 2 for 1) as integer);
select r_ext_2 from Fu_Ext_Testa2(:rext, :var2, :var3) into :rext;
if (:trab = '01') then
rext = :rext || ' bilhão';
else
rext = :rext || ' bilhões';
if (substring(:wvlr from 3 for 9) = '000000000') then
rext = :rext || ' de reais';
else begin
if ((substring(:wvlr from 3 for 3) = '000') and
(substring(:wvlr from 6 for 1) = '0') or
(substring(:wvlr from 6 for 6) = '000000') or
(substring(:wvlr from 7 for 8) = '00000,00')) then
rext = :rext || ' e ';
else
rext = :rext || ' , ';
end
end
if (substring(:wvlr from 3 for 3) > '000') then begin
var1 = cast(substring(:wvlr from 3 for 1) as integer);
var2 = cast(substring(:wvlr from 4 for 1) as integer);
var3 = cast(substring(:wvlr from 5 for 1) as integer);
if (:var1 > 0) then
begin
select r_ext_1 from Fu_Ext_Testa1(:rext, :var1, :var2, :var3) into :rext;
if ((:var2 + :var3) > 0) then
select r_ext_2 from Fu_Ext_Testa2(:rext, :var2, :var3) into :rext;
end
else
select r_ext_2 from Fu_Ext_Testa2(:rext, :var2, :var3) into :rext;
if ((:var1 + :var2 = 0) and (:var3 = 1)) then
rext = :rext || ' milhão';
else
rext = :rext || ' milhões';
if (substring(:wvlr from 6 for 6) = '000000') then
rext = :rext || ' de reais';
else if ((substring(:wvlr from 6 for 3) = '000') and (substring(:wvlr from 13 for 2) = '00')) then
rext = :rext || ' e ';
else
rext = :rext || ', ';
end
if (substring(:wvlr from 6 for 3) > '000') then begin
var1 = cast(substring(:wvlr from 6 for 1) as integer);
var2 = cast(substring(:wvlr from 7 for 1) as integer);
var3 = cast(substring(:wvlr from 8 for 1) as integer);
if (:var1 > 0) then
begin
select r_ext_1 from Fu_Ext_Testa1(:rext, :var1, :var2, :var3) into :rext;
if ((:var2 + :var3) > 0) then
select r_ext_2 from Fu_Ext_Testa2(:rext, :var2, :var3) into :rext;
end
else
select r_ext_2 from Fu_Ext_Testa2(:rext, :var2, :var3) into :rext;
rext = :rext || ' mil';
if (substring(:wvlr from 9 for 3) = '000') then
rext = :rext || ' reais';
else if ((substring(:wvlr from 9 for 3) > '000') and (substring(:wvlr from 13 for 2) > '00')) then
rext = :rext || ', ';
else
rext = :rext || ' e ';
end
if (substring(:wvlr from 9 for 3) > '000') then begin
var1 = cast(substring(:wvlr from 9 for 1) as integer);
var2 = cast(substring(:wvlr from 10 for 1) as integer);
var3 = cast(substring(:wvlr from 11 for 1) as integer);
if (:var1 > 0) then
begin
select r_ext_1 from Fu_Ext_Testa1(:rext, :var1, :var2, :var3) into :rext;
if ((:var2 + :var3) > 0) then
select r_ext_2 from Fu_Ext_Testa2(:rext, :var2, :var3) into :rext;
end
else
select r_ext_2 from Fu_Ext_Testa2(:rext, :var2, :var3) into :rext;
if (substring(:wvlr from 1 for 11) > '00000000001') then
rext = :rext || ' reais';
else
rext = :rext || ' real';
end
if (substring(:wvlr from 13 for 2) > '00') then begin
select r_Len from Fu_Len(:rext) into :wint;
if (:wint > 2) then
rext = :rext || ' e ';
var1 = 0;
var2 = cast(substring(:wvlr from 13 for 1) as integer);
var3 = cast(substring(:wvlr from 14 for 1) as integer);
select r_ext_2 from Fu_Ext_Testa2(:rext, :var2, :var3) into :rext;
rext = :rext || ' centavo';
if (substring(:wvlr from 13 for 2) > '01') then
rext = :rext || 's';
end
select r_Len from Fu_Len(:rext) into :wtri;
select r_replicate from Fu_Replicate(:lin2, '*') into r_ext2;
select r_replicate from Fu_Replicate(:lin2, '*') into r_ext3;
if (:wtri = :lin1) then
r_ext1 = :rext;
else if (:wtri < :lin1) then
begin
select r_replicate from Fu_Replicate((:lin1 - :wtri), '*') into r_ext1;
r_ext1 = :rext || :r_ext1;
end
else begin -- Se não for igual nem menor então é maior
-- Preparo a primeira variável
var1 = 0;
select r_Copy from Fu_Copy(:rext, 1, :lin1) into :r_ext1; -- a variável
select r_Copy from Fu_Copy(:rext, (:lin1 + 1), (:lin2 + :lin2)) into :rext; -- sobrou
while (:var1 = 0) do begin
var1 = 1; -- Suponho que farei este passo apenas esta vez
-- Verifico a separação silábica com uma casa
select r_Len from Fu_Len(:r_ext1) into :var2;
select r_Copy from Fu_Copy(:r_ext1, :var2, 1) into :tra1;
select result From Fu_Pos(:tra1, :nao1) into :var3;
if (:var3 > 0) then begin -- Letra final não permitida
select r_Copy from Fu_Copy(:r_ext1, :var2, 1) into :tra1;
rext = :tra1 || :rext; -- Coloco na sobra
select r_Copy from Fu_Copy(:r_ext1, 1, (:var2 - 1)) into :r_ext1; -- Tiro daqui
var1 = 0; -- Fazer o passo (while) novamente
end
-- Verifico a separação silábica com duas casas
select r_Len from Fu_Len(:r_ext1) into :var2;
select r_Copy from Fu_Copy(:r_ext1, (:var2 -1), 2) into :tra1;
select result From Fu_Pos(:tra1, :nao2) into :var3;
if (:var3 > 0) then begin
select r_Copy from Fu_Copy(:r_ext1, (:var2 - 1), 2) into :tra1;
rext = :tra1 || :rext; -- Coloco na sobra
select r_Copy from Fu_Copy(:r_ext1, 1, (:var2 - 2)) into :r_ext1; -- Tiro daqui
var1 = 0; -- Fazer o passo (while) novamente
end
-- Verifico a separação silábica com três casas
select r_Len from Fu_Len(:r_ext1) into :var2;
select r_Copy from Fu_Copy(:r_ext1, (:var2 - 2), 3) into :tra1;
select result From Fu_Pos(:tra1, :nao3) into :var3;
if (:var3 > 0) then begin
select r_Copy from Fu_Copy(:r_ext1, (:var2 - 2), 3) into :tra1;
rext = :tra1 || :rext; -- Coloco na sobra
select r_Copy from Fu_Copy(:r_ext1, 1, (:var2 - 3)) into :r_ext1; -- Tiro daqui
var1 = 0; -- Fazer o passo (while) novamente
end
-- Verifico a separação silábica com quatro casas
select r_Len from Fu_Len(:r_ext1) into :var2;
select r_Copy from Fu_Copy(:r_ext1, (:var2 - 3), 4) into :tra1;
select result From Fu_Pos(:tra1, :nao4) into :var3;
if (:var3 > 0) then begin
select r_Copy from Fu_Copy(:r_ext1, (:var2 - 3), 4) into :tra1;
rext = :tra1 || :rext; -- Coloco na sobra
select r_Copy from Fu_Copy(:r_ext1, 1, (:var2 - 4)) into :r_ext1; -- Tiro daqui
var1 = 0; -- Fazer o passo (while) novamente
end
end
-- Ajustando o tamanho da primeira
select r_Len from Fu_Len(:r_ext1) into :var2;
if (:var2 < :lin1) then begin
select r_Dstr From Fu_DStr(:r_ext1, :lin1) into :r_ext1;
select r_Copy from Fu_Copy(:r_ext1, :lin1, 1) into :tra1;
if (:tra1 <> ' ') then begin
select r_Copy from Fu_Copy(:r_ext1, 1, (:lin1 - 1)) into :r_ext1;
r_ext1 = :r_ext1 || '-';
end
end
-- Preparando a segunda variável (sempre existirá)
select r_Len from Fu_Len(:rext) into :var2; -- Apuro o comprimento da sobra
if (:var2 <= :lin2) then -- Se não houver a terceira string igualo e completo
begin
r_ext2 = :rext;
select r_Replicate from Fu_Replicate((:lin2 - :var2), '*') into :rext;
r_ext2 = :r_ext2 || :rext;
end
else begin -- Tem terceira variável
-- Preparo a segunda
var1 = 0;
select r_Copy from Fu_Copy(:rext, 1, :lin2) into :r_ext2; -- Copio novo conteúdo
select r_Copy from Fu_Copy(:rext, (:lin2 + 1), :lin2) into :rext; -- sobrou
select r_RTrim from Fu_RTrim(:r_ext2) into :r_ext2; -- Retiro espaços
while (:var1 = 0) do begin
var1 = 1;
select r_Len from Fu_Len(:r_ext2) into :var2;
select r_Copy from Fu_Copy(:r_ext2, :var2, 1) into :tra1;
select result From Fu_Pos(:tra1, :nao1) into :var3;
if (:var3 > 0) then begin
select r_Copy from Fu_Copy(:r_ext2, :var2, 1) into :tra1;
rext = :tra1 || :rext;
select r_Copy from Fu_Copy(:r_ext2, 1, (:var2 - 1)) into :r_ext2;
var1 = 0;
end
select r_Len from Fu_Len(:r_ext2) into :var2;
select r_Copy from Fu_Copy(:r_ext2, (:var2 -1), 2) into :tra1;
select result From Fu_Pos(:tra1, :nao2) into :var3;
if (:var3 > 0) then begin
select r_Copy from Fu_Copy(:r_ext2, (:var2 - 1), 2) into :tra1;
rext = :tra1 || :rext;
select r_Copy from Fu_Copy(:r_ext2, 1, (:var2 - 2)) into :r_ext2;
var1 = 0;
end
select r_Len from Fu_Len(:r_ext2) into :var2;
select r_Copy from Fu_Copy(:r_ext2, (:var2 - 2), 3) into :tra1;
select result From Fu_Pos(:tra1, :nao3) into :var3;
if (:var3 > 0) then begin
select r_Copy from Fu_Copy(:r_ext2, (:var2 - 2), 3) into :tra1;
rext = :tra1 || :rext;
select r_Copy from Fu_Copy(:r_ext2, 1, (:var2 - 3)) into :r_ext2;
var1 = 0;
end
select r_Len from Fu_Len(:r_ext2) into :var2;
select r_Copy from Fu_Copy(:r_ext2, (:var2 - 3), 4) into :tra1;
select result From Fu_Pos(:tra1, :nao4) into :var3;
if (:var3 > 0) then begin
select r_Copy from Fu_Copy(:r_ext2, (:var2 - 3), 4) into :tra1;
rext = :tra1 || :rext;
select r_Copy from Fu_Copy(:r_ext2, 1, (:var2 - 4)) into :r_ext2;
var1 = 0;
end
-- Ajustando o tamanho da segunda
select r_Len from Fu_Len(:r_ext2) into :var2;
if (:var2 < :lin2) then begin
select r_Dstr From Fu_DStr(:r_ext2, :lin2) into :r_ext2;
select r_Copy from Fu_Copy(:r_ext2, :lin1, 1) into :tra1;
if (:tra1 <> ' ') then begin
select r_Copy from Fu_Copy(:r_ext2, 1, (:lin2 - 1)) into :r_ext2;
r_ext2 = :r_ext2 || '-';
end
end
-- Preparando a terceira variável (sempre existirá)
select r_Len from Fu_Len(:rext) into :var2;
select r_Replicate from Fu_Replicate((:lin2 - :var2), '*') into :r_ext3;
r_ext3 = :rext || :r_ext3;
end
end
end
if (substring(:r_ext2 from 1 for 4) = 's***') then begin
r_ext1 = :r_ext1 || 's';
r_ext2 = '*' || substring(:r_ext2 from 2 for 125);
end
r_ext1 = upper(substring(:r_ext1 from 1 for 1)) || substring(:r_ext1 from 2 for 125);
suspend;
end
==================================================
CREATE PROCEDURE FU_EXT_TESTA1(
WEXT VARCHAR(255),
VAR1 INTEGER,
VAR2 INTEGER,
VAR3 INTEGER)
RETURNS (
R_EXT_1 VARCHAR(255))
AS
begin
/*
Auxiliar de FU_EXTENSO
*/
if (:var1 = 1) then
begin
if (:var2 + :var3 = 0) then
wext = :wext || 'cem';
else
wext = :wext || 'cento';
end
else if (:var1 = 2) then
wext = :wext || 'duzentos';
else if (:var1 = 3) then
wext = :wext || 'trezentos';
else if (:var1 = 4) then
wext = :wext || 'quatrocentos';
else if (:var1 = 5) then
wext = :wext || 'quinhentos';
else if (:var1 = 6) then
wext = :wext || 'seiscentos';
else if (:var1 = 7) then
wext = :wext || 'setecentos';
else if (:var1 = 8) then
wext = :wext || 'oitocentos';
else if (:var1 = 9) then
wext = :wext || 'novecentos';
if (:var2 + :var3 > 0) then
wext = :wext || ' e ';
r_ext_1 = :wext;
suspend;
end
===========================================
CREATE PROCEDURE FU_EXT_TESTA2(
WEXT VARCHAR(255),
VAR2 INTEGER,
VAR3 INTEGER)
RETURNS (
R_EXT_2 VARCHAR(255))
AS
begin
/*
Auxiliar de FU_EXTENSO
*/
if (:var2 = 1) then
begin
if (:var3 = 0) then
wext = :wext || 'dez';
else if (:var3 = 1) then
wext = :wext || 'onze';
else if (:var3 = 2) then
wext = :wext || 'doze';
else if (:var3 = 3) then
wext = :wext || 'treze';
else if (:var3 = 4) then
wext = :wext || 'quatorze';
else if (:var3 = 5) then
wext = :wext || 'quinze';
else if (:var3 = 6) then
wext = :wext || 'dezesseis';
else if (:var3 = 7) then
wext = :wext || 'dezessete';
else if (:var3 = 8) then
wext = :wext || 'dezoito';
else if (:var3 = 9) then
wext = :wext || 'dezenove';
end
else if (:var2 = 2) then
wext = :wext || 'vinte';
else if (:var2 = 3) then
wext = :wext || 'trinta';
else if (:var2 = 4) then
wext = :wext || 'quarenta';
else if (:var2 = 5) then
wext = :wext || 'cinquenta';
else if (:var2 = 6) then
wext = :wext || 'sessenta';
else if (:var2 = 7) then
wext = :wext || 'setenta';
else if (:var2 = 8) then
wext = :wext || 'oitenta';
else if (:var2 = 9) then
wext = :wext || 'noventa';
if (:var2 <> 1) then begin
if (:var3 > 0) then begin
if (:var2 > 0) then
wext = :wext || ' e ';
if (:var3 = 1) then
wext = :wext || 'um';
else if (:var3 = 2) then
wext = :wext || 'dois';
else if (:var3 = 3) then
wext = :wext || 'três';
else if (:var3 = 4) then
wext = :wext || 'quatro';
else if (:var3 = 5) then
wext = :wext || 'cinco';
else if (:var3 = 6) then
wext = :wext || 'seis';
else if (:var3 = 7) then
wext = :wext || 'sete';
else if (:var3 = 8) then
wext = :wext || 'oito';
else if (:var3 = 9) then
wext = :wext || 'nove';
end
end
r_ext_2 = :wext;
suspend;
end
=====================================
CREATE PROCEDURE FU_EXTRACT_STR(
WSUB VARCHAR(8192),
WSTR VARCHAR(8192))
RETURNS (
WRET VARCHAR(8192))
AS
declare variable wlen smallint;
declare variable wint smallint;
declare variable wpos smallint;
declare variable wvar varchar(8192);
begin
/*
Retira de "WSTR" uma "WSUB" Encontrada
*/
select r_Len from Fu_Len(:wsub) into :wlen;
select r_Len from Fu_Len(:wstr) into :wint;
select result from Fu_Pos(:wsub, :wstr) into :wpos;
if (:wpos = 0) then
wret = :wstr;
else begin
select r_Copy from Fu_Copy(:wstr, 1, (:wpos - 1)) into :wret;
select r_Copy from Fu_Copy(:wstr, (:wpos + :wlen), 8191) into :wvar;
wret = :wret || :wvar;
end
suspend;
end
==========================================
CREATE PROCEDURE FU_FERIADOS_DATAS(
WDAT DATE)
RETURNS (
WTIP CHAR(1))
AS
declare variable c integer;
declare variable d integer;
declare variable g integer;
declare variable h integer;
declare variable i integer;
declare variable j integer;
declare variable l integer;
declare variable m integer;
declare variable w integer;
declare variable de date;
declare variable ds date;
declare variable dp date;
declare variable cc date;
declare variable wano integer;
declare variable wfer varchar(40) = '0101,0421,0501,0907,1012,1102,1115,1225';
declare variable trab varchar(5);
begin
/*
Localiza feriados nacionais e religiosos de um ano
*/
wtip = 'U';
if (:wdat is not null) then begin
w = extract(weekday from :wdat);
if (:w = 0) then
wtip = 'D';
else if (:w = 6) then
wtip = 'B';
trab = substring(cast(:wdat as varchar(10)) from 6 for 2) ||
substring(cast(:wdat as varchar(10)) from 9 for 2);
select result from Fu_pos(:trab, :wfer) into i;
if (:i > 0) then -- Feriado Indicado em WFER
wtip = 'F';
end
-- Ver se é Páscoa
select rdia, rmes, rano from Fu_decode_date(:wdat) into :d, :m, :wano;
select r_mod from Fu_Mod(:wano, 19) into :g;
select r_div from Fu_Div(:wano, 100) into :c;
-- Cálculo de H (C - C div 4 - (8 * C + 13) div 25 + 19 * G + 15) mod 30;)
select r_div from Fu_Div(:c, 4) into :w;
h = c - w;
w = (8 * :c) + 13;
select r_div from Fu_Div(:w, 25) into :w;
h = :h - :w + (19 * :g) + 15;
select r_mod from Fu_Mod(:h, 30) into :h;
-- Cálculo de i (H - (H div 28) * (1 - (H div 28) * (29 div (H + 1)) * ((21 - G) div 11)) )
select r_div from Fu_Div(:h, 28) into :w; -- H DIV 28
select r_div from Fu_Div(29, (:h + 1)) into :m; -- 29 DIV (h + 1)
select r_div from Fu_Div((21 - :g), 11) into :l; -- ((21 - G) div 11)
i = (:h - :w) * 1 - (:w * :m * :l);
-- Cálculo de j ((ano + ano div 4 + I + 2 - C + C div 4) mod 7)
select r_div from Fu_Div(:wano, 4) into :w;
select r_div from Fu_Div(:c, 4) into :l;
select r_mod from Fu_Mod(:wano + :w + :i + 2 - :c + :l, 7) into :j;
l = :i - :j;
-- Cálculo de m (3 + (L + 40) div 44)
select r_div from Fu_Div((:l + 40), 44) into :w;
m = 3 + :w;
-- Cálculo de d (L + 28 - 31 * (m div 4))
select r_div from Fu_Div((:m + 44), 44) into :w;
d = (:l + 28) - 31 * :w;
-- Finalmente acha DE (Como o domingo de Páscoa)
if (:d < 10) then
de = cast(substring(cast(:wdat as varchar(10)) from 1 for 5) ||
'0' || cast(:m as char(1)) || '-0' || cast(:d as char(1)) as date);
else
de = cast(substring(cast(:wdat as varchar(10)) from 1 for 5) ||
'0' || cast(:m as char(1)) || '-' || cast(:d as char(2)) as date);
-- Páscoa
dp = :de;
w = extract(weekday from :de);
while (:w > 1) do begin
de = :de + 1;
w = extract(weekday from :de);
end
-- Sexta-Feira Santa
ds = :de - 2;
-- Corpus Christi
cc = :ds + 62;
-- Carnaval
de = :de - 47;
if (:wdat = :de) then -- È Carnaval
wtip = 'C';
else if (:wdat = :ds) then -- É Sexta-Feira Santa
wtip = 'S';
else if (:wdat = :dp) then -- É Páscoa
wtip = 'P';
else if (:wdat = :cc) then -- É Corpus Christi
wtip = 'T';
suspend;
end
============================================
CREATE PROCEDURE FU_FORMATAR(
WVLR DECIMAL(15,4),
WMOD VARCHAR(32))
RETURNS (
R_FORMATAR VARCHAR(32))
AS
declare variable vls varchar(44);
declare variable dcm SmallInt;
declare variable vir SmallInt;
declare variable win SmallInt;
declare variable tam SmallInt;
declare variable npo smallint;
declare variable trb varchar(2);
begin
/*
Recebe um decimal e um modelo de máscara e devolve
uma forma adequada p/ impressão.
Ex: 1234,56 e "###.##0,00" devolve " 1.234,56" ou ainda
-1234,56 e "###.##0,00" devolve " -1.234,56" ou ainda
-1234,56 e "A##.##0,00" devolve " 1.234,56" ou ainda (valor absoluto) ou ainda
1234,56 e '***.**0,00" devolve "**1.234,56"
*/
if ((substring(:wmod from 1 for 1) = 'A') and (:wvlr < 0)) then begin -- Se for valor absoluto
select r_abs from fu_abs(:wvlr) into :wvlr;
select result from Fu_pos('*', :wmod) into :npo;
if (:npo > 0) then
wmod = '*' || substring(:wmod from 2);
else begin
select result from Fu_pos('$', :wmod) into :npo;
if (:npo > 0) then
wmod = '$' || substring(:wmod from 2);
else
wmod = '#' || substring(:wmod from 2);
end
end
vls = cast(:wvlr as varchar(32)); -- Valor como String
select r_len from Fu_len(:vls) into :tam; -- Tamanho do Valor como String
select r_len from Fu_len(:wmod) into :win; -- Tamanho da Máscara
select result from Fu_pos(',', :wmod) into :dcm;
dcm = :win - :dcm;
select wret from Fu_replace_all_str(:vls, '.', ',') into :vls;
select r_len from Fu_len(:vls) into :tam; -- Tamanho do Valor como String
select result from Fu_pos(',', :vls) into :vir;
vir = :tam - :vir;
while (:vir > :dcm) do begin
tam = :tam - 1;
select r_copy from Fu_copy(:vls, 1, :tam) into vls;
vir = :vir - 1;
end
if (:dcm > 4) then begin
while (:vir < :dcm) do begin
vls = :vls || '0';
vir = :vir + 1;
end
end
select r_len from Fu_Len(:vls) into :tam; -- Tamanho do Valor como String
r_formatar = '';
while ((:win > 0) or (:tam > 0)) do begin
if ((:win = 0) and (:tam > 0)) then
begin
select r_copy from Fu_copy(:vls, :tam, 1) into :trb;
r_formatar = :trb || :r_formatar;
tam = :tam - 1;
end
else begin
select r_sright from Fu_s_right(:wmod, 1) into :trb;
select r_copy from Fu_copy(:wmod, 1, (:win -1)) into :wmod;
if (:tam = 0) then
begin
if (:trb in ('#', 'A', '.')) then
r_formatar = ' ' || :r_formatar;
else
r_formatar = :trb || :r_formatar;
end
else begin
if (:trb = '.') then
r_formatar = '.' || r_formatar;
else begin
select r_copy from Fu_copy(:vls, :tam, 1) into :trb;
r_formatar = :trb || :r_formatar;
tam = :tam - 1;
select r_copy from Fu_copy(:vls, 1, :tam) into :vls;
end
end
win = :win - 1;
end
end
select result from fu_pos('-.', :r_formatar) into :dcm;
if (:dcm > 0) then
select wret from fu_replace_str(' -', :r_formatar, :dcm) into :r_formatar;
else if (substring(:r_formatar from 1 for 1) = '.') then
select wret from fu_replace_str(' ', :r_formatar, 1) into :r_formatar;
else begin
select result from fu_pos(' .', :r_formatar) into :dcm;
if (:dcm > 0) then
select wret from fu_replace_str(' ', :r_formatar, :dcm) into :r_formatar;
end
suspend;
end
===============================================
CREATE PROCEDURE FU_HORA_DECIMAL(
FHOR VARCHAR(8))
RETURNS (
WDEC DECIMAL(10,2))
AS
declare variable whor integer;
declare variable wmin integer;
declare variable wint integer;
declare variable wtam integer;
declare variable trab varchar(10);
begin
/*
recebe uma hora tipo HH:MM e devolve em decimal
Ex: Recebe 3:23 e devolve 3,38
*/
select result from Fu_pos(':', :fhor) into :wint;
select r_len from Fu_len(:fhor) into :wtam;
if (:wint = 0) then
begin
wmin = 0;
select r_onlydigit from Fu_onlydigit(:fhor) into :trab;
wdec = cast(:trab as decimal(10, 2));
end
else begin
select r_copy from Fu_copy(:fhor, :wint + 1, :wtam - :wint) into :trab;
wmin = cast(:trab as integer);
select r_copy from Fu_copy(:fhor, 1, :wint - 1) into :trab;
whor = cast(:trab as integer);
while (:wmin > 60) do begin
wmin = :wmin - 60;
whor = :whor + 1;
end
wdec = cast((:wmin / 60.00) as decimal(10, 2));
wdec = cast(:whor + :wdec as decimal(10, 2));
end
suspend;
end
=============================================
CREATE PROCEDURE FU_INC_DEC_MES(
WDAT DATE,
WQTD SMALLINT)
RETURNS (
R_INC_DEC_MES DATE)
AS
DECLARE VARIABLE WDIA SMALLINT;
DECLARE VARIABLE WMES SMALLINT;
DECLARE VARIABLE WANO SMALLINT;
DECLARE VARIABLE WINT SMALLINT;
DECLARE VARIABLE WTRM CHAR(2);
DECLARE VARIABLE WTRD CHAR(2);
begin
/*
Incrementa ou decrementa meses em uma data
Se "WQTD" > 0 incrementa senão decrementa
*/
wdia = extract(day from :wdat);
wmes = extract(month from :wdat);
wano = extract(year from :wdat);
wmes = :wmes + :wqtd;
if (:wqtd > 0) then
begin
while (:wmes > 12) do begin
wano = :wano + 1;
wmes = :wmes - 12;
end
end
else begin
while (:wmes < 1) do begin
wano = :wano - 1;
wmes = :wmes + 12;
end
end
if ((:wmes = 2) and (:wdia > 28)) then
begin
select r_mod from Fu_mod(:wano, 4) into :wint;
if ((:wint = 0) and (:wdia > 29)) then
wdia = 29;
else if ((:wint > 0) and (:wdia > 28)) then
wdia = 28;
end
else if (:wdia > 30) then begin
if ((:wmes = 4) or (:wmes = 6) or (:wmes = 9) or (:wmes = 11)) then
wdia = 30;
end
select r_IntZero from Fu_IntZero(:wdia, 2) into :wtrd;
select r_IntZero from Fu_IntZero(:wmes, 2) into :wtrm;
r_Inc_Dec_Mes = cast(cast(:wano as varchar(4)) || '-' ||
:wtrm || '-' || :wtrd as date);
suspend;
end
=============================================
CREATE PROCEDURE FU_INC_DEC_PERI(
WPER VARCHAR(7),
WQTD SMALLINT)
RETURNS (
R_INC_DEC_PERI VARCHAR(7))
AS
DECLARE VARIABLE WMES SMALLINT;
DECLARE VARIABLE WANO SMALLINT;
begin
/*
Incrementa ou decrementa meses em um mês e ano.
Se "WQTD" > 0 incrementa senão decrementa
*/
wmes = cast(substring(:wper from 1 for 2) as SmallInt) + :wqtd;
wano = cast(substring(:wper from 4 for 4) as SmallInt);
if (:wqtd < 0) then
begin
while (:wmes < 1) do begin
wmes = :wmes + 12;
wano = :wano - 1;
end
end
else begin
while (:wmes > 12) do begin
wmes = :wmes - 12;
wano = :wano + 1;
end
end
select r_IntZero from Fu_IntZero(:wmes, 2) into r_Inc_Dec_peri;
r_Inc_Dec_Peri = :r_inc_dec_peri || '/' || cast(:wano as varchar(4));
suspend;
end
==============================================
CREATE PROCEDURE FU_INSERT_STR(
WSUB VARCHAR(2048),
WSTR VARCHAR(2048),
WPOS SMALLINT)
RETURNS (
WRET VARCHAR(4096))
AS
declare variable wlen smallint;
declare variable wvar varchar(255);
begin
/*
Insere um string em outro na posição "WPOS"
*/
select r_Len from Fu_Len(:wstr) into :wlen;
if (:wlen <= :wpos) then
wret = :wstr || :wsub;
else begin
select r_Copy from Fu_Copy(:wstr, 1, (:wpos - 1)) into :wret;
select r_Copy from Fu_Copy(:wstr, :wpos, 255) into :wvar;
wret = :wret || :wsub || :wvar;
end
suspend;
end
===========================================
CREATE PROCEDURE FU_INTBRANCOS(
WINT BIGINT,
WTAM INTEGER)
RETURNS (
R_INTBRANCOS VARCHAR(36))
AS
begin
/*
Recebe um inteiro e devolve um string com brancos à esquerda no
tamanho "WTAM"
*/
if (:wint is null) then
select r_replicate from Fu_replicate(:wtam, ' ') into r_IntBrancos;
else
select r_Sright from Fu_S_Right(' ' || cast(:wint as varchar(18)), :wtam) into :r_intbrancos;
suspend;
end
========================================
CREATE PROCEDURE FU_INTZERO(
WINT BIGINT,
WTAM INTEGER)
RETURNS (
R_INTZERO VARCHAR(8192))
AS
begin
/*
Recebe um inteiro e devolve um string com zeros à esquerda no tamanho "WTAM"
*/
if (:wint is null) then
select r_replicate from Fu_replicate(:wtam, ' ') into r_IntZero;
else begin
select r_abs from fu_abs(:wint) into :wint;
select r_Sright from Fu_S_Right('000000000000000000' || cast(:wint as varchar(18)), :wtam) into :r_intzero;
end
suspend;
end
=====================================
CREATE PROCEDURE FU_LASTDAY(
WANO SMALLINT,
WMES SMALLINT)
RETURNS (
R_LASTDAY SMALLINT)
AS
declare variable i integer;
begin
/*
Recebe um ano e um mês e devolve o último dia do mês daquele ano
*/
if ((:wmes = 1) or (:wmes = 3) or (:wmes = 5) or (:wmes = 7) or (:wmes = 8) or (:wmes = 10) or (:wmes = 12)) then
r_Lastday = 31;
else if (:wmes = 2) then
begin
select r_mod from Fu_Mod(:wano, 4) into :i;
if (:i = 0) then
r_Lastday = 29;
else
r_Lastday = 28;
end
else
r_Lastday = 30;
suspend;
end
=========================================
CREATE PROCEDURE FU_LAST_POS(
WSUB VARCHAR(8192),
WSTR VARCHAR(8192))
RETURNS (
R_LAST_POS SMALLINT)
AS
declare variable wtam smallint;
declare variable trab varchar(8192);
declare variable wint smallint = 1;
begin
/*
Devolve a última posição do "WSUB" dentro do "WSTR"
*/
r_last_pos = 0;
if ((:wsub is not null) and (:wstr is not null)) then begin
select r_len from Fu_len(:wsub) into :wtam;
while (:wstr <> '') do begin
select r_copy from Fu_copy(:wstr, 1, :wtam) into :trab;
if (:trab = :wsub) then
r_last_pos = :wint;
wint = :wint + 1;
wstr = substring(:wstr from 2);
end
end
suspend;
end
===========================================
CREATE PROCEDURE FU_LEN(
WSTR VARCHAR(8192))
RETURNS (
R_LEN SMALLINT)
AS
DECLARE VARIABLE L varchar(10);
begin
/*
Devolve o tamanho em bytes de um string
no FB 2 não é mais necessário
*/
if (:wstr = 'MithBuster') then
r_Len = 10;
else begin
wstr = :wstr || 'MithBuster';
r_Len = 0;
l = substring(:wstr from 1 for 10);
while (:l <> 'MithBuster') do begin
r_Len = :r_Len + 1;
wstr = substring(:wstr from 2);
l = substring(:wstr from 1 for 10);
end
end
suspend;
end
==============================================
CREATE PROCEDURE FU_LTRIM(
WVAR VARCHAR(8192))
RETURNS (
R_LTRIM VARCHAR(8192))
AS
DECLARE VARIABLE J INTEGER;
DECLARE VARIABLE K INTEGER;
begin
/*
Devolve um string sem espaços à esquerda
*/
j = 0;
select r_Len from Fu_Len(:wvar) into :k;
r_ltrim = '';
while ((:wvar is not null) and (:k > 0)) do begin
if (:j > 0) then
r_ltrim = r_ltrim || substring(:wvar from 1 for 1);
else if (substring(:wvar from 1 for 1) <> ' ') then begin
r_ltrim = r_ltrim || substring(:wvar from 1 for 1);
j = 1;
end
wvar = substring(:wvar from 2 for 8191);
k = :k - 1;
end
suspend;
end
==========================================
CREATE PROCEDURE FU_MES_EXT(
WMES SMALLINT,
WCEN CHAR(1),
WTIP CHAR(1))
RETURNS (
R_MES_EXT VARCHAR(9))
AS
begin
/*
Devolve o mês por extenso (WMES) conforme o modelo desejado (WTIP)
*/
if (:wtip = 'R') then
begin
if (:wmes = 1) then r_mes_ext = 'JAN';
else if (:wmes = 2) then r_mes_ext = 'FEV';
else if (:wmes = 3) then r_mes_ext = 'MAR';
else if (:wmes = 4) then r_mes_ext = 'ABR';
else if (:wmes = 5) then r_mes_ext = 'MAI';
else if (:wmes = 6) then r_mes_ext = 'JUN';
else if (:wmes = 7) then r_mes_ext = 'JUL';
else if (:wmes = 8) then r_mes_ext = 'AGO';
else if (:wmes = 9) then r_mes_ext = 'SET';
else if (:wmes = 10) then r_mes_ext = 'OUT';
else if (:wmes = 11) then r_mes_ext = 'NOV';
else if (:wmes = 12) then r_mes_ext = 'DEZ';
end
else if (:wcen = 'S') then
begin
if (:wmes = 1) then r_mes_ext = ' JANEIRO ';
else if (:wmes = 2) then r_mes_ext = 'FEVEREIRO';
else if (:wmes = 3) then r_mes_ext = ' MARÇO ';
else if (:wmes = 4) then r_mes_ext = ' ABRIL ';
else if (:wmes = 5) then r_mes_ext = ' MAIO ';
else if (:wmes = 6) then r_mes_ext = ' JUNHO ';
else if (:wmes = 7) then r_mes_ext = ' JULHO ';
else if (:wmes = 8) then r_mes_ext = ' AGOSTO ';
else if (:wmes = 9) then r_mes_ext = 'SETEMBRO ';
else if (:wmes = 10) then r_mes_ext = ' OUTUBRO ';
else if (:wmes = 11) then r_mes_ext = 'NOVEMBRO ';
else if (:wmes = 12) then r_mes_ext = 'DEZEMBRO ';
end
else begin
if (:wmes = 1) then r_mes_ext = 'JANEIRO';
else if (:wmes = 2) then r_mes_ext = 'FEVEREIRO';
else if (:wmes = 3) then r_mes_ext = 'MARÇO';
else if (:wmes = 4) then r_mes_ext = 'ABRIL';
else if (:wmes = 5) then r_mes_ext = 'MAIO';
else if (:wmes = 6) then r_mes_ext = 'JUNHO';
else if (:wmes = 7) then r_mes_ext = 'JULHO';
else if (:wmes = 8) then r_mes_ext = 'AGOSTO';
else if (:wmes = 9) then r_mes_ext = 'SETEMBRO';
else if (:wmes = 10) then r_mes_ext = 'OUTUBRO';
else if (:wmes = 11) then r_mes_ext = 'NOVEMBRO';
else if (:wmes = 12) then r_mes_ext = 'DEZEMBRO';
end
suspend;
end
=========================================
CREATE PROCEDURE FU_MINUTESBETWEEN(
WD1 TIMESTAMP,
WD2 TIMESTAMP)
RETURNS (
R_MINUTESBETWEEN INTEGER)
AS
begin
/*
Minutos entre dois TS
*/
r_MinutesBetween =
(cast(substring(cast(:wd2 as varchar(24)) from 15 for 2) as integer) +
(cast(substring(cast(:wd2 as varchar(24)) from 12 for 2) as integer) * 60)) -
(cast(substring(cast(:wd1 as varchar(24)) from 15 for 2) as integer) +
(cast(substring(cast(:wd1 as varchar(24)) from 12 for 2) as integer) * 60)) +
cast((:wd2 - :wd1) as integer) * 1440;
suspend;
end
=============================================
CREATE PROCEDURE FU_MOD(
WRAD INTEGER,
WDIV INTEGER)
RETURNS (
R_MOD INTEGER)
AS
begin
/*
Resto da divisão entre inteiros
*/
if(:wrad < :wdiv) then
r_mod = :wdiv;
else
R_MOD = :WRAD - ((:WRAD / :WDIV) * :WDIV);
suspend;
end
===========================================
CREATE PROCEDURE FU_ONLYCHAR(
WVAR VARCHAR(255))
RETURNS (
R_ONLYCHAR VARCHAR(255))
AS
DECLARE VARIABLE K INTEGER;
declare variable i integer;
begin
/*
A partir de um string devolve somente o que não for números
*/
select r_Len from Fu_Len(:wvar) into :k;
r_onlychar = '';
while (:k > 0) do begin
select result from Fu_Pos(substring(:wvar from 1 for 1), '0123456789') into :i;
if (:i = 0) then
r_onlychar = r_onlychar || substring(:wvar from 1 for 1);
wvar = substring(:wvar from 2 for 255);
k = :k - 1;
end
suspend;
end
==========================================
CREATE PROCEDURE FU_ONLYDIGIT(
WVAR VARCHAR(255))
RETURNS (
R_ONLYDIGIT VARCHAR(255))
AS
DECLARE VARIABLE K INTEGER;
DECLARE VARIABLE I INTEGER;
begin
/*
A partir de um string devolve apenas o que for número
*/
select r_Len from Fu_Len(:wvar) into :k;
r_onlydigit = '';
while (:k > 0) do begin
select result from Fu_Pos(substring(:wvar from 1 for 1), '0123456789') into :i;
if (:i > 0) then
r_onlydigit = r_onlydigit || substring(:wvar from 1 for 1);
wvar = substring(:wvar from 2 for 254);
k = :k - 1;
end
suspend;
end
=======================================
CREATE PROCEDURE FU_POS(
SUB VARCHAR(8192),
STR VARCHAR(8192))
RETURNS (
RESULT SMALLINT)
AS
DECLARE VARIABLE SUB2 VARCHAR(8192);
DECLARE VARIABLE TMP VARCHAR(8192);
BEGIN
/*
Devolve a primeira posição de "SUB" dentro de "STR"
*/
if ((Sub is null) or (Str is null)) then begin
result = 0;
exit;
end
Sub2 = Sub || '%';
Tmp = '';
result = 1;
while ((Str not like Sub2) and (Str not like Tmp)) do begin
Sub2 = '_' || Sub2;
Tmp = Tmp || '_';
result = :result + 1;
end
if (Str like Tmp) then
result = 0;
suspend;
end
==============================================
CREATE PROCEDURE FU_QUEBRA_LINHA(
WVAR VARCHAR(8192),
WTAM SMALLINT)
RETURNS (
WLIN1 VARCHAR(8192),
WLIN2 VARCHAR(8192))
AS
declare variable wini SmallInt;
declare variable wstr char(1);
begin
/*
WVAR = um string supostamente maior que uma linha de impressão desejada
WTAM = O tamanho do espaço (linha) de impressão desejada
OBS: Quando se digitar em tela um varchar digamos de 900 bytes se for pressionado um ENTER
Em qualquer tempo antes do final então devemos gravar "<BR>" <-- = à quebra de linha no HTML
Então enviamos o Stringão e o tamanho e serão devolvidas linhas com até WTAM em bytes respeitando
sempre uma quebra com espaços ou <BR>. Sem quebrar uma aplavra pelo meio
Devolve WLIN1 com o string a ser impresso e WLIN2 com o resto até que WLIN2 seja NULL
*/
if (:wvar is not null) then begin -- A variável está definida
if ((:wtam is null) or (:wtam = 0)) then -- Tamamho não definido (só copia)
wlin1 = :wvar;
else begin -- Tamanho está definido
if (substring(:wvar from 1 for 4) = '<BR>') then
begin
wlin1 = '';
wlin2 = substring(:wvar from 5 for 8188);
end
else begin
select result from Fu_Pos('<BR>', :wvar) into :wini;
if (:wini > 0) then
begin
if (:wini > :wtam) then
begin
select r_copy from Fu_Copy (:wvar, 1, :wtam) into :wlin1;
select r_copy from Fu_Copy (:wvar, (:wtam + 1), (8192 - :wtam)) into :wlin2;
end
else begin
select r_copy from Fu_copy (:wvar, 1, (:wini - 1)) into :wlin1;
select r_copy from Fu_copy (:wvar, (:wini + 4), (8192 - (:wini + 4))) into :wlin2;
end
end
else begin
select r_copy from Fu_copy (:wvar, 1, :wtam) into :wlin1;
select r_copy from Fu_copy (:wvar, (:wtam + 1), (8192 - :wtam)) into :wlin2;
end
select r_rtrim from Fu_rtrim (:wlin1) into :wlin1;
select r_len from Fu_len (:wlin1) into :wini;
if (:wini = :wtam) then begin
select result from Fu_pos(' ', :wlin1) into :wini;
if (:wini > 0) then begin
select r_sright from Fu_s_right(:wlin1, 1) into :wstr;
select r_len from Fu_len (:wlin1) into :wtam;
while ((:wstr <> ' ') and (:wtam > 0)) do begin
select r_copy from Fu_Copy(:wlin1, 1, (:wtam - 1)) into :wlin1;
wlin2 = :wstr || :wlin2;
select r_sright from Fu_s_right(:wlin1, 1) into :wstr;
wtam = :wtam - 1;
end
end
end
end -- O tamanho é superior ao solicitado (quebra foi necessária)
end -- O tamanho estava definido
end -- A variável estava definida
if (:wlin2 = '') then
wlin2 = null;
if (:wlin2 is not null) then
select r_ltrim from Fu_ltrim(:wlin2) into :wlin2;
else
wlin2 = null;
suspend;
end
====================================================
CREATE PROCEDURE FU_REPLACE_ALL_STR(
WSTR VARCHAR(2048),
OSTR VARCHAR(128),
NSTR VARCHAR(128))
RETURNS (
WRET VARCHAR(8192))
AS
declare variable wlen smallint;
declare variable part varchar(128);
begin
/*
Troca wm WSTR tudo que encontrar igual a OSTR(OLD) por NSTR (NEW)
*/
select r_len from Fu_len(:ostr) into :wlen;
wret = '';
while (:wstr <> '') do begin
select r_copy from Fu_copy(:wstr, 1, :wlen) into :part;
if (:part <> :ostr) then
begin
wret = :wret || substring(:wstr from 1 for 1);
wstr = substring(:wstr from 2);
end
else begin
wret = :wret || :nstr;
select r_copy from Fu_copy(:wstr, :wlen + 1, 2047) into :wstr;
end
end
suspend;
end
============================================
CREATE PROCEDURE FU_REPLACE_STR(
WSUB VARCHAR(2048),
WSTR VARCHAR(2048),
WPOS SMALLINT)
RETURNS (
WRET VARCHAR(4096))
AS
declare variable wlen smallint;
declare variable wint smallint;
begin
/*
Troca WSUB em WSTR na posição WPOS
*/
select r_Len from Fu_Len(:wstr) into :wint;
if (:wint <= :wpos) then
begin
select r_DStr from Fu_DStr(:wstr, :wpos -1) into :wret;
wret = :wret || :wsub;
end
else begin
select r_Len from Fu_Len(:wsub) into :wlen;
select r_Copy from Fu_Copy(:wstr, 1, (:wpos - 1)) into :wret;
wret = :wret || :wsub;
select r_Len from Fu_Len(:wret) into :wlen;
select r_Copy from Fu_Copy(:wstr, :wlen + 1, :wint - :wlen) into :wstr;
wret = :wret || :wstr;
end
suspend;
end
=======================================
CREATE PROCEDURE FU_REPLICATE(
WQTD INTEGER,
WVAR VARCHAR(255))
RETURNS (
R_REPLICATE VARCHAR(8192))
AS
begin
/*
Replica WQTD caracteres ou strings em WVAR
*/
r_replicate = '';
while (:wqtd > 0) do begin
r_replicate = r_replicate || :wvar;
wqtd = :wqtd - 1;
end
suspend;
end
=========================================
CREATE PROCEDURE FU_RTRIM(
WVAR VARCHAR(8192))
RETURNS (
R_RTRIM VARCHAR(8192))
AS
DECLARE VARIABLE I INTEGER;
declare variable s varchar(1);
begin
/*
Retira os espaços à direita de um string
*/
select r_Len from Fu_Len(:wvar) into :i;
if ((:i < 2) or (:wvar = ' ')) then
r_rtrim = '';
else begin
while ((:i > 0) and (:wvar is not null)) do begin
select r_Sright from Fu_S_Right(:wvar, 1) into :s;
if (:s = ' ') then
begin
select r_copy from Fu_copy(:wvar, 1, (:i - 1)) into :wvar;
i = :i - 1;
end
else
break;
end
r_rtrim = :wvar;
end
suspend;
end
================================================
CREATE PROCEDURE FU_SEM_ACENTOS(
WSTR VARCHAR(1024))
RETURNS (
R_SEM_ACENTOS VARCHAR(1024))
AS
DECLARE VARIABLE CA VARCHAR(53);
DECLARE VARIABLE SA VARCHAR(53);
DECLARE VARIABLE WI SMALLINT;
DECLARE VARIABLE WT SMALLINT;
declare variable i integer;
DECLARE VARIABLE WS VARCHAR(2);
begin
/*
Substitui caracteres acentuados de um string pelo correspondente sem acento.
Útil para enviarmos string para impressoras matriciais ou Arquivos eletrônicos
*/
if (:wstr is null) then
wstr = '';
ca = '%°ºáàâãäéèêëíìîïóòôõöúùûüçÁÀÂÃÄÉÈÊËÍÌÎÏÓÒÔÕÖÚÙÛÜÇâÂñÑ';
sa = '%rºaaaaaeeeeiiiiooooouuuucAAAAAEEEEIIIIOOOOOUUUUCaAhH';
select r_Len from Fu_Len(:wstr) into :wt;
wi = 1;
r_sem_acentos = '';
while (:wt > 0) do begin
select r_Copy from Fu_Copy(:wstr, :wi, 1) into :ws;
if (:ws <> ' ') then begin
select result from Fu_Pos(:ws, :ca) into :i;
if (:i > 0) then begin
if (:ws = 'ñ') then
ws = 'nh';
else if (:ws = 'Ñ') then
ws = 'NH';
else
select r_Copy from Fu_Copy(:sa, :i, 1) into :ws;
end
end
r_sem_acentos = :r_sem_acentos || :ws;
wt = :wt - 1;
wi = :wi + 1;
end
suspend;
end
==========================================
CREATE PROCEDURE FU_SORT_B(
WSTR VARCHAR(8192),
WDEL CHAR(1),
WORD CHAR(1))
RETURNS (
WRET VARCHAR(8192))
AS
declare variable tra1 varchar(8192);
declare variable wpos smallint;
begin
/*
Classifica um string delimitado por WDEL na ordem WORD (A,D)
*/
select result from Fu_pos(:wdel, :wstr) into :wpos; -- Primeiro delimitador
select r_copy from Fu_copy(:wstr, 1, (:wpos -1)) into :tra1; -- Primeira String
wret = :tra1; -- Primeiro retorno = String
select r_copy from Fu_copy(:wstr, (:wpos + 1), 8191) into :wstr; -- STR resultante
while (:wstr <> '') do begin -- Enquanto houver uma String...
select result from Fu_pos(:wdel, :wstr) into :wpos; -- Primeiro delimitador da STR resultante
if (:wpos = 0) then -- Se não tem mais...
begin
tra1 = :wstr; -- Inicializo :TRA1
wstr = ''; -- Esvazio STR resultante
end
else -- Senão...
select r_copy from Fu_copy(:wstr, 1, (:wpos - 1)) into :tra1; -- Primeira String
select r_ret from Fu_class(:wret, :tra1, :wdel, :word) into :wret; -- Rotina de Classificação
select r_copy from Fu_copy(:wstr, (:wpos + 1), 8191) into :wstr; -- String resultante
end
suspend;
end
============================================
CREATE PROCEDURE FU_SPACES(
WQTD INTEGER)
RETURNS (
R_SPACES VARCHAR(8192))
AS
begin
/*
devolve WQTD espaços em um string
*/
r_spaces = '';
while (:wqtd > 0) do begin
r_spaces = r_spaces || ' ';
wqtd = :wqtd - 1;
end
suspend;
end
===========================================
CREATE PROCEDURE FU_SQRT(
NUM DOUBLE PRECISION)
RETURNS (
SQR DOUBLE PRECISION)
AS
declare variable inc integer = 1;
declare variable pas integer;
declare variable nua double precision;
begin
/*
Devolve a Raiz Quadrade de um número
Há uma tolerância ou margem de erro para raizes inaxatas
*/
pas = 0; -- Passos (= SQR)
nua = :num; -- Salvando caso não seja inteiro
while (:num > 0) do begin
num = :num - :inc;
inc = :inc + 2;
pas = :pas + 1;
end
if (:num = 0) then
sqr = :pas; -- Quadrado perfeito
else begin -- Há fração
sqr = :pas -1; -- Maior quadrado que não ultrapasse
sqr = cast((:sqr + 0.0001) as double precision);
-- Otimizando de Quartas em Quartas partes (Divide o tempo de processamento por 4)
if ((:sqr * :sqr) < :nua) then begin
sqr = :sqr + 0.2500; -- Primeiro Quarto
if ((:sqr * :sqr) > :nua) then
begin
sqr = :sqr - 0.2500;
while ((:sqr * :sqr) <= :nua) do begin
sqr = :sqr + 0.0001;
end
end
else begin
sqr = :sqr + 0.2500; -- Segundo Quarto
if ((:sqr * :sqr) > :nua) then
begin
sqr = :sqr - 0.2500;
while ((:sqr * :sqr) <= :nua) do begin
sqr = :sqr + 0.0001;
end
end
else begin -- Terceiro Quarto
sqr = :sqr + 0.2500;
while ((:sqr * :sqr) > :nua) do begin
sqr = :sqr - 0.0500;
end
while ((:sqr * :sqr) <= :nua) do begin
sqr = :sqr + 0.0001;
end
end
end
end
if ((:sqr * :sqr) > :nua) then
sqr = :sqr - 0.0001;
end
suspend;
end
========================================
CREATE PROCEDURE FU_STRZERO(
WVAR VARCHAR(8192),
WTAM INTEGER)
RETURNS (
R_STRZERO VARCHAR(8192))
AS
declare variable wint integer;
begin
/*
Devolve WVAR com tamanho WTAM só que com zeros à esquerda
*/
select r_Len from Fu_Len(:wvar) into :wint;
wint = 255 - :wint;
select r_Replicate from Fu_Replicate(:wint, '0') into r_StrZero;
r_StrZero = r_StrZero || :wvar; -- 255 Bytes
select r_Sright from Fu_S_Right(:r_strzero, :wtam) into :r_strzero;
suspend;
end
======================================================
CREATE PROCEDURE FU_S_LEFT(
WVAR VARCHAR(8192),
WQTD INTEGER)
RETURNS (
R_SLEFT VARCHAR(8192))
AS
DECLARE VARIABLE K INTEGER;
begin
/*
Devolve WQTD caracteres à esquerda de um string
*/
select r_Len from Fu_Len(:wvar) into :k;
r_sleft = '';
while ((:wvar is not null) and (:k > 0) and (:wqtd > 0)) do begin
r_sleft = r_sleft || substring(:wvar from 1 for 1);
wvar = substring(:wvar from 2 for 8191);
k = :k - 1;
wqtd = :wqtd - 1;
end
suspend;
end
================================================
CREATE PROCEDURE FU_S_RIGHT(
WVAR VARCHAR(8192),
WQTD INTEGER)
RETURNS (
R_SRIGHT VARCHAR(8192))
AS
DECLARE VARIABLE K INTEGER;
begin
/*
Devolve WQTD caracteres à direita de um string
*/
if (:wvar is not null) then begin
select r_Len from Fu_Len(:wvar) into :k;
if (:wqtd >= :k) then
r_sright = :wvar;
else
select r_Copy from Fu_Copy(:wvar, ((:k - :wqtd) + 1), :wqtd) into :r_sright;
end
suspend;
end
=============================================
CREATE PROCEDURE FU_TEMPO_BETWEEN(
INI TIMESTAMP,
FIM TIMESTAMP)
RETURNS (
DIAS INTEGER,
HORA INTEGER,
MINU INTEGER,
SEGU INTEGER)
AS
DECLARE VARIABLE TEMP NUMERIC(18,7);
BEGIN
/*
Devolve dias, horas, minutos e segundos entre 2 TS
*/
-- Inicializa variáveis
dias = 0;
hora = 0;
minu = 0;
segu = 0;
-- Temp armazena a diferenca do periodo, em dias e frações de dias
temp = (fim - ini);
-- Pega o numero de dias - parte inteira
if (:temp > 0) then
dias = temp - 0.5;
else
dias = temp;
-- extraí os dias do timestamp, deixando apenas hora/min/seg'
temp = temp - dias;
-- Um dia tem 86.400 segundos, assim transformamos o valor
-- que temos em total em segundos
temp = temp * 86400;
-- Uma hora tem 3.600 segundos
hora = (temp / 3600);
if (hora > 0) then
hora = hora - 0.5;
-- Temp vale agora minutos e segundos
temp = temp - (hora * 3600);
-- Um minuto tem 60 segundos
minu = (temp / 60);
if (minu > 0) then
minu = minu - 0.5;
-- Para finalizar extrai os segundos
segu = temp - (minu * 60);
suspend;
end
===========================================
CREATE PROCEDURE FU_TRIM(
WVAR VARCHAR(8192))
RETURNS (
R_TRIM VARCHAR(8192))
AS
DECLARE VARIABLE J INTEGER;
DECLARE VARIABLE K INTEGER;
DECLARE VARIABLE I INTEGER;
declare variable s varchar(1);
begin
/*
Retira espaços à direita e à esquerda de um string
*/
j = 0;
select r_Len from Fu_Len(:wvar) into :k;
r_trim = '';
while ((:wvar is not null) and (:k > 0)) do begin
if (:j > 0) then
r_trim = r_trim || substring(:wvar from 1 for 1);
else if (substring(:wvar from 1 for 1) <> ' ') then begin
r_trim = r_trim || substring(:wvar from 1 for 1);
j = 1;
end
wvar = substring(:wvar from 2 for 8191);
k = :k - 1;
end
wvar = :r_trim;
select r_Len from Fu_Len(:wvar) into :i;
if ((:i < 2) or (:wvar = ' ')) then
r_trim = '';
else begin
while ((:i > 0) and (:wvar is not null)) do begin
select r_Sright from Fu_S_Right(:wvar, 1) into :s;
if (:s = ' ') then
begin
select r_copy from Fu_copy(:wvar, 1, (:i - 1)) into :wvar;
i = :i - 1;
end
else
break;
end
r_trim = :wvar;
end
suspend;
end
====================================================
CREATE PROCEDURE FU_TROCA_BYTES(
WSTR VARCHAR(1024),
WSUB VARCHAR(255),
WTRO VARCHAR(255))
RETURNS (
R_TROCA_BYTES VARCHAR(1024))
AS
declare variable trab varchar(1024);
declare variable xtra varchar(1024);
declare variable wtra varchar(1024);
declare variable wint smallint;
declare variable tsub smallint;
declare variable tstr smallint;
begin
/*
Troca em WSTR todas as ocorrências de WSUB por WTRO encontradas
*/
if (:wsub = :wtro) then
r_troca_bytes = :wstr;
else if (:wtro is null) then
r_troca_bytes = :wstr;
else if (:wsub is null) then
r_troca_bytes = :wtro;
else begin
select r_len from Fu_len(:wstr) into :tstr;
select r_len from Fu_len(:wsub) into :tsub;
wtra = :wstr;
wint = 1;
if (:tsub > 255) then begin
tsub = 255;
wsub = substring(:wsub from 1 for 255);
wtro = substring(:wtro from 1 for 255); -- 1234567890
end -- xxxxyyxxxx
while (:wint > 0) do begin
select result from Fu_pos(:wsub, :wtra) into :wint;
if (:wint > 0) then begin
select r_copy from Fu_copy(:wtra, 1, (:wint - 1)) into :trab;
select r_copy from Fu_copy(:wtra, (:wint + :tsub), 1024) into :xtra;
wtra = :trab || :wtro || :xtra;
end
end
r_troca_bytes = :wtra;
end
suspend;
end
=================================================
CREATE PROCEDURE FU_VALIDACGC(
WCGC VARCHAR(14))
RETURNS (
OK CHAR(1))
AS
declare variable trab varchar(2);
declare variable wcal varchar(12);
declare variable wsom integer;
declare variable wdig smallint;
declare variable wint smallint;
begin
/*
Valida um CNPJ
*/
select r_OnlyDigit from Fu_OnlyDigit(:wcgc) into :wcgc;
wsom = 0;
wcal = substring(:wcgc from 1 for 12);
wint = 1;
while (:wint <= 4) do begin
select r_Copy from Fu_Copy(:wcgc, :wint, 1) into :trab;
wsom = :wsom + cast(:trab as smallint) * (6 - :wint);
wint = :wint + 1;
end
wint = 1;
while (:wint <= 8) do begin
select r_Copy from Fu_Copy(:wcgc, (:wint + 4), 1) into :trab;
wsom = :wsom + cast(:trab as smallint) * (10 - :wint);
wint = :wint + 1;
end
select r_mod from Fu_mod(:wsom, 11) into :wdig;
wdig = 11 - :wdig;
if ((:wdig = 10) or (:wdig = 11)) then
wcal = :wcal || '0';
else
wcal = :wcal || cast(:wdig as char(1));
wsom = 0;
wint = 1;
while (:wint <= 5) do begin
select r_Copy from Fu_Copy(:wcgc, :wint, 1) into :trab;
wsom = :wsom + cast(:trab as smallint) * (7 - :wint);
wint = :wint + 1;
end
wint = 1;
while (:wint <= 8) do begin
select r_Copy from Fu_Copy(:wcgc, (:wint + 5), 1) into :trab;
wsom = :wsom + cast(:trab as smallint) * (10 - :wint);
wint = :wint + 1;
end
select r_mod from Fu_mod(:wsom, 11) into :wdig;
wdig = 11 - :wdig;
if ((:wdig = 10) or (:wdig = 11)) then
wcal = :wcal || '0';
else
wcal = :wcal || cast(:wdig as char(1));
if (:wcgc <> :wcal) then
ok = 'N';
else
ok = 'S';
suspend;
end
============================================
CREATE PROCEDURE FU_VALIDACPF(
WCPF VARCHAR(11))
RETURNS (
OK CHAR(1))
AS
declare variable trab varchar(2);
declare variable wcal varchar(12);
declare variable wsom integer;
declare variable wdig smallint;
declare variable wint smallint;
begin
/*
Valida um CPF
*/
select r_OnlyDigit from Fu_OnlyDigit(:wcpf) into :wcpf;
wsom = 0;
wcal = substring(:wcpf from 1 for 9);
wint = 1;
while (:wint <= 9) do begin
select r_Copy from Fu_Copy(:wcpf, :wint, 1) into :trab;
wsom = :wsom + cast(:trab as smallint) * (11 - :wint);
wint = :wint + 1;
end
select r_mod from Fu_mod(:wsom, 11) into :wdig;
wdig = 11 - :wdig;
if ((:wdig = 10) or (:wdig = 11)) then
wcal = :wcal || '0';
else
wcal = :wcal || cast(:wdig as char(1));
wsom = 0;
wint = 1;
while (:wint <= 10) do begin
select r_Copy from Fu_Copy(:wcpf, :wint, 1) into :trab;
wsom = :wsom + cast(:trab as smallint) * (12 - :wint);
wint = :wint + 1;
end
select r_mod from Fu_mod(:wsom, 11) into :wdig;
wdig = 11 - :wdig;
if ((:wdig = 10) or (:wdig = 11)) then
wcal = :wcal || '0';
else
wcal = :wcal || cast(:wdig as char(1));
if (:wcpf <> :wcal) then
ok = 'N';
else
ok = 'S';
suspend;
end
==============================================
Os IIFs abaixo trabalham conforme o IIF do Delphi só que
recebendo e devolvendo a natureza de cada variável........
Use quem preferir
----------------------------------------------------------
CREATE PROCEDURE FU_IIF_DEC(
STR1 DECIMAL(16,4),
WSIG VARCHAR(2),
STR2 DECIMAL(16,4),
STR3 DECIMAL(16,4),
STR4 DECIMAL(16,4))
RETURNS (
R_DEC DECIMAL(16,4))
AS
begin
if (:wsig = '=') then
begin
if (:str1 = :str2) then
r_dec = :str3;
else
r_dec = :str4;
end
else if (:wsig = '<') then
begin
if (:str1 < :str2) then
r_dec = :str3;
else
r_dec = :str4;
end
else if (:wsig = '>') then
begin
if (:str1 > :str2) then
r_dec = :str3;
else
r_dec = :str4;
end
else if (:wsig = '>=') then
begin
if (:str1 >= :str2) then
r_dec = :str3;
else
r_dec = :str4;
end
else if (:wsig = '<=') then
begin
if (:str1 <= :str2) then
r_dec = :str3;
else
r_dec = :str4;
end
else if (:wsig = '<>') then begin
if (:str1 <> :str2) then
r_dec = :str3;
else
r_dec = :str4;
end
suspend;
end
=======================================
CREATE PROCEDURE FU_IIF_INT(
STR1 INTEGER,
WSIG VARCHAR(2),
STR2 INTEGER,
STR3 INTEGER,
STR4 INTEGER)
RETURNS (
R_INT INTEGER)
AS
begin
if (:wsig = '=') then
begin
if (:str1 = :str2) then
r_int = :str3;
else
r_int = :str4;
end
else if (:wsig = '<') then
begin
if (:str1 < :str2) then
r_int = :str3;
else
r_int = :str4;
end
else if (:wsig = '>') then
begin
if (:str1 > :str2) then
r_int = :str3;
else
r_int = :str4;
end
else if (:wsig = '>=') then
begin
if (:str1 >= :str2) then
r_int = :str3;
else
r_int = :str4;
end
else if (:wsig = '<=') then
begin
if (:str1 <= :str2) then
r_int = :str3;
else
r_int = :str4;
end
else if (:wsig = '<>') then begin
if (:str1 <> :str2) then
r_int = :str3;
else
r_int = :str4;
end
suspend;
end
============================================
CREATE PROCEDURE FU_IIF_INT_DEC(
STR1 INTEGER,
WSIG VARCHAR(2),
STR2 INTEGER,
STR3 DECIMAL(16,4),
STR4 DECIMAL(16,4))
RETURNS (
R_INT_DEC DECIMAL(16,4))
AS
begin
if (:wsig = '=') then
begin
if (:str1 = :str2) then
r_int_dec = :str3;
else
r_int_dec = :str4;
end
else if (:wsig = '<') then
begin
if (:str1 < :str2) then
r_int_dec = :str3;
else
r_int_dec = :str4;
end
else if (:wsig = '>') then
begin
if (:str1 > :str2) then
r_int_dec = :str3;
else
r_int_dec = :str4;
end
else if (:wsig = '>=') then
begin
if (:str1 >= :str2) then
r_int_dec = :str3;
else
r_int_dec = :str4;
end
else if (:wsig = '<=') then
begin
if (:str1 <= :str2) then
r_int_dec = :str3;
else
r_int_dec = :str4;
end
else if (:wsig = '<>') then begin
if (:str1 <> :str2) then
r_int_dec = :str3;
else
r_int_dec = :str4;
end
suspend;
end
=============================================
CREATE PROCEDURE FU_IIF_INT_SMI(
STR1 INTEGER,
WSIG VARCHAR(2),
STR2 INTEGER,
STR3 SMALLINT,
STR4 SMALLINT)
RETURNS (
R_INT_SMI SMALLINT)
AS
begin
if (:wsig = '=') then
begin
if (:str1 = :str2) then
r_int_smi = :str3;
else
r_int_smi = :str4;
end
else if (:wsig = '<') then
begin
if (:str1 < :str2) then
r_int_smi = :str3;
else
r_int_smi = :str4;
end
else if (:wsig = '>') then
begin
if (:str1 > :str2) then
r_int_smi = :str3;
else
r_int_smi = :str4;
end
else if (:wsig = '>=') then
begin
if (:str1 >= :str2) then
r_int_smi = :str3;
else
r_int_smi = :str4;
end
else if (:wsig = '<=') then
begin
if (:str1 <= :str2) then
r_int_smi = :str3;
else
r_int_smi = :str4;
end
else if (:wsig = '<>') then begin
if (:str1 <> :str2) then
r_int_smi = :str3;
else
r_int_smi = :str4;
end
suspend;
end
=======================================
CREATE PROCEDURE FU_IIF_INT_STR(
STR1 INTEGER,
WSIG VARCHAR(2),
STR2 INTEGER,
STR3 VARCHAR(255),
STR4 VARCHAR(255))
RETURNS (
R_INT_STR VARCHAR(255))
AS
begin
if (:wsig = '=') then
begin
if (:str1 = :str2) then
r_int_str = :str3;
else
r_int_str = :str4;
end
else if (:wsig = '<') then
begin
if (:str1 < :str2) then
r_int_str = :str3;
else
r_int_str = :str4;
end
else if (:wsig = '>') then
begin
if (:str1 > :str2) then
r_int_str = :str3;
else
r_int_str = :str4;
end
else if (:wsig = '>=') then
begin
if (:str1 >= :str2) then
r_int_str = :str3;
else
r_int_str = :str4;
end
else if (:wsig = '<=') then
begin
if (:str1 <= :str2) then
r_int_str = :str3;
else
r_int_str = :str4;
end
else if (:wsig = '<>') then begin
if (:str1 <> :str2) then
r_int_str = :str3;
else
r_int_str = :str4;
end
suspend;
end
===============================================
CREATE PROCEDURE FU_IIF_SMI(
STR1 SMALLINT,
WSIG VARCHAR(2),
STR2 SMALLINT,
STR3 SMALLINT,
STR4 SMALLINT)
RETURNS (
R_SMI SMALLINT)
AS
begin
if (:wsig = '=') then
begin
if (:str1 = :str2) then
r_smi = :str3;
else
r_smi = :str4;
end
else if (:wsig = '<') then
begin
if (:str1 < :str2) then
r_smi = :str3;
else
r_smi = :str4;
end
else if (:wsig = '>') then
begin
if (:str1 > :str2) then
r_smi = :str3;
else
r_smi = :str4;
end
else if (:wsig = '>=') then
begin
if (:str1 >= :str2) then
r_smi = :str3;
else
r_smi = :str4;
end
else if (:wsig = '<=') then
begin
if (:str1 <= :str2) then
r_smi = :str3;
else
r_smi = :str4;
end
else if (:wsig = '<>') then begin
if (:str1 <> :str2) then
r_smi = :str3;
else
r_smi = :str4;
end
suspend;
end
========================================
CREATE PROCEDURE FU_IIF_SMI_DEC(
STR1 SMALLINT,
WSIG VARCHAR(2),
STR2 SMALLINT,
STR3 DECIMAL(16,4),
STR4 DECIMAL(16,4))
RETURNS (
R_SMI_DEC DECIMAL(16,4))
AS
begin
if (:wsig = '=') then
begin
if (:str1 = :str2) then
r_smi_dec = :str3;
else
r_smi_dec = :str4;
end
else if (:wsig = '<') then
begin
if (:str1 < :str2) then
r_smi_dec = :str3;
else
r_smi_dec = :str4;
end
else if (:wsig = '>') then
begin
if (:str1 > :str2) then
r_smi_dec = :str3;
else
r_smi_dec = :str4;
end
else if (:wsig = '>=') then
begin
if (:str1 >= :str2) then
r_smi_dec = :str3;
else
r_smi_dec = :str4;
end
else if (:wsig = '<=') then
begin
if (:str1 <= :str2) then
r_smi_dec = :str3;
else
r_smi_dec = :str4;
end
else if (:wsig = '<>') then begin
if (:str1 <> :str2) then
r_smi_dec = :str3;
else
r_smi_dec = :str4;
end
suspend;
end
=========================================
CREATE PROCEDURE FU_IIF_SMI_INT(
STR1 SMALLINT,
WSIG VARCHAR(2),
STR2 SMALLINT,
STR3 INTEGER,
STR4 INTEGER)
RETURNS (
R_SMI_INT INTEGER)
AS
begin
if (:wsig = '=') then
begin
if (:str1 = :str2) then
r_smi_int = :str3;
else
r_smi_int = :str4;
end
else if (:wsig = '<') then
begin
if (:str1 < :str2) then
r_smi_int = :str3;
else
r_smi_int = :str4;
end
else if (:wsig = '>') then
begin
if (:str1 > :str2) then
r_smi_int = :str3;
else
r_smi_int = :str4;
end
else if (:wsig = '>=') then
begin
if (:str1 >= :str2) then
r_smi_int = :str3;
else
r_smi_int = :str4;
end
else if (:wsig = '<=') then
begin
if (:str1 <= :str2) then
r_smi_int = :str3;
else
r_smi_int = :str4;
end
else if (:wsig = '<>') then begin
if (:str1 <> :str2) then
r_smi_int = :str3;
else
r_smi_int = :str4;
end
suspend;
end
============================================
CREATE PROCEDURE FU_IIF_SMI_STR(
STR1 SMALLINT,
WSIG VARCHAR(2),
STR2 SMALLINT,
STR3 VARCHAR(255),
STR4 VARCHAR(255))
RETURNS (
R_SMI_STR VARCHAR(255))
AS
begin
if (:wsig = '=') then
begin
if (:str1 = :str2) then
r_smi_STR = :str3;
else
r_smi_STR = :str4;
end
else if (:wsig = '<') then
begin
if (:str1 < :str2) then
r_smi_STR = :str3;
else
r_smi_STR = :str4;
end
else if (:wsig = '>') then
begin
if (:str1 > :str2) then
r_smi_STR = :str3;
else
r_smi_STR = :str4;
end
else if (:wsig = '>=') then
begin
if (:str1 >= :str2) then
r_smi_STR = :str3;
else
r_smi_STR = :str4;
end
else if (:wsig = '<=') then
begin
if (:str1 <= :str2) then
r_smi_STR = :str3;
else
r_smi_STR = :str4;
end
else if (:wsig = '<>') then begin
if (:str1 <> :str2) then
r_smi_STR = :str3;
else
r_smi_STR = :str4;
end
suspend;
end
=============================================
CREATE PROCEDURE FU_IIF_STR(
STR1 VARCHAR(255),
WSIG VARCHAR(2),
STR2 VARCHAR(255),
STR3 VARCHAR(255),
STR4 VARCHAR(255))
RETURNS (
R_STR VARCHAR(255))
AS
begin
if (:wsig = '=') then
begin
if (:str1 = :str2) then
r_str = :str3;
else
r_str = :str4;
end
else if (:wsig = '<') then
begin
if (:str1 < :str2) then
r_str = :str3;
else
r_str = :str4;
end
else if (:wsig = '>') then
begin
if (:str1 > :str2) then
r_str = :str3;
else
r_str = :str4;
end
else if (:wsig = '>=') then
begin
if (:str1 >= :str2) then
r_str = :str3;
else
r_str = :str4;
end
else if (:wsig = '<=') then
begin
if (:str1 <= :str2) then
r_str = :str3;
else
r_str = :str4;
end
else if (:wsig = '<>') then begin
if (:str1 <> :str2) then
r_str = :str3;
else
r_str = :str4;
end
suspend;
end
============================================
CREATE PROCEDURE FU_IIF_STR_DEC(
STR1 VARCHAR(255),
WSIG VARCHAR(2),
STR2 VARCHAR(255),
STR3 DECIMAL(16,4),
STR4 DECIMAL(16,4))
RETURNS (
R_STR_DEC DECIMAL(16,4))
AS
begin
if (:wsig = '=') then
begin
if (:str1 = :str2) then
r_str_dec = :str3;
else
r_str_dec = :str4;
end
else if (:wsig = '<') then
begin
if (:str1 < :str2) then
r_str_dec = :str3;
else
r_str_dec = :str4;
end
else if (:wsig = '>') then
begin
if (:str1 > :str2) then
r_str_dec = :str3;
else
r_str_dec = :str4;
end
else if (:wsig = '>=') then
begin
if (:str1 >= :str2) then
r_str_dec = :str3;
else
r_str_dec = :str4;
end
else if (:wsig = '<=') then
begin
if (:str1 <= :str2) then
r_str_dec = :str3;
else
r_str_dec = :str4;
end
else if (:wsig = '<>') then begin
if (:str1 <> :str2) then
r_str_dec = :str3;
else
r_str_dec = :str4;
end
suspend;
end
====================================================
CREATE PROCEDURE FU_IIF_STR_INT(
STR1 VARCHAR(255),
WSIG VARCHAR(2),
STR2 VARCHAR(255),
STR3 INTEGER,
STR4 INTEGER)
RETURNS (
R_STR_INT INTEGER)
AS
begin
if (:wsig = '=') then
begin
if (:str1 = :str2) then
r_str_int = :str3;
else
r_str_int = :str4;
end
else if (:wsig = '<') then
begin
if (:str1 < :str2) then
r_str_int = :str3;
else
r_str_int = :str4;
end
else if (:wsig = '>') then
begin
if (:str1 > :str2) then
r_str_int = :str3;
else
r_str_int = :str4;
end
else if (:wsig = '>=') then
begin
if (:str1 >= :str2) then
r_str_int = :str3;
else
r_str_int = :str4;
end
else if (:wsig = '<=') then
begin
if (:str1 <= :str2) then
r_str_int = :str3;
else
r_str_int = :str4;
end
else if (:wsig = '<>') then begin
if (:str1 <> :str2) then
r_str_int = :str3;
else
r_str_int = :str4;
end
suspend;
end
================================================
CREATE PROCEDURE FU_IIF_STR_SMI(
STR1 VARCHAR(255),
WSIG VARCHAR(2),
STR2 VARCHAR(255),
STR3 SMALLINT,
STR4 SMALLINT)
RETURNS (
R_STR_SMI SMALLINT)
AS
begin
if (:wsig = '=') then
begin
if (:str1 = :str2) then
r_str_smi = :str3;
else
r_str_smi = :str4;
end
else if (:wsig = '<') then
begin
if (:str1 < :str2) then
r_str_smi = :str3;
else
r_str_smi = :str4;
end
else if (:wsig = '>') then
begin
if (:str1 > :str2) then
r_str_smi = :str3;
else
r_str_smi = :str4;
end
else if (:wsig = '>=') then
begin
if (:str1 >= :str2) then
r_str_smi = :str3;
else
r_str_smi = :str4;
end
else if (:wsig = '<=') then
begin
if (:str1 <= :str2) then
r_str_smi = :str3;
else
r_str_smi = :str4;
end
else if (:wsig = '<>') then begin
if (:str1 <> :str2) then
r_str_smi = :str3;
else
r_str_smi = :str4;
end
suspend;
end
