Un saludo a todos.
Aunque soy un veterano del Club Delphi apenas tengo intervenciones, puesto que me limito a pasarme de vez en cuando y leer los mensajes, y alguna vez he preguntado algo.
En este momento estoy migrando una aplicación desde FB 1.5 a 2.5.1 en Linux, por lo que me he tenido que plantear la migración de una librería UDF de mi propiedad a linux, recompilandola con Lazarus. Esto me hizo plantearme la conveniencia de seguir por ahí o portar toda esta librería a procedimientos almacenados, puesto que FB 2.5 es un tanto pijotero y estricto, sobre todo con los strings. Mi conclusión ha sido que migraré en su totalidad a procedimientos almacenados, puesto que FB 2.5 trae una buena colección de funciones internas, que facilitan dicha labor.
Como parte de dicha migración he concluido un procedimiento, que se basa a su vez en otro que permite conocer el literal de cualquier número, positivo o negativo, entero o fraccionario, con una determinada precisión (no mayor que 6). Para ello hay dos procedimientos:
1º IUDF_NUMERAL, que admite como parámetro un número entero positivo y devuelve el literal. Este es recursivo, y permite con las cadenas básicas componer cualquier número.
2º IUDF_NUMLITERAL, utiliza el anterior, y permite la entrada de cualquier número decimal de hasta precisión 6, y un parámetro que ajustará la precisión de salida. La salida es un número, positivo o negativo, entero o fraccionario, con la precisión solicitada, en formato literal.
Ahí va un script con el código:
Código SQL
[-]
SET NAMES ISO8859_1;
SET CLIENTLIB 'C:\Program Files (x86)\Firebird\Firebird_2_5\bin\fbclient.dll';
CONNECT 'path base datos' USER 'SYSDBA' PASSWORD 'masterkey';
SET TERM ^ ;
CREATE PROCEDURE IUDF_NUMERAL (
NUMERO INTEGER)
RETURNS (
NUMERAL VARCHAR(500))
AS
BEGIN
SUSPEND;
END^
CREATE PROCEDURE IUDF_NUMLITERAL (
NUMERO DECIMAL(15,6),
PREC SMALLINT)
RETURNS (
LITERAL VARCHAR(500))
AS
BEGIN
SUSPEND;
END^
SET TERM ; ^
SET TERM ^ ;
ALTER PROCEDURE IUDF_NUMERAL (
NUMERO INTEGER)
RETURNS (
NUMERAL VARCHAR(500))
AS
declare variable UN varchar(10);
declare variable UNO varchar(10);
declare variable DOS varchar(10);
declare variable TRES varchar(10);
declare variable CUATRO varchar(10);
declare variable CINCO varchar(10);
declare variable SEIS varchar(10);
declare variable SIETE varchar(10);
declare variable OCHO varchar(10);
declare variable NUEVE varchar(10);
declare variable DIEZ varchar(10);
declare variable ONCE varchar(10);
declare variable DOCE varchar(10);
declare variable TRECE varchar(10);
declare variable CATORCE varchar(10);
declare variable QUINCE varchar(10);
declare variable DIECI varchar(10);
declare variable VEINT varchar(10);
declare variable TREINTA varchar(10);
declare variable CUARENTA varchar(10);
declare variable CINCUENTA varchar(10);
declare variable SESENTA varchar(10);
declare variable SETENTA varchar(10);
declare variable OCHENTA varchar(10);
declare variable NOVENTA varchar(10);
declare variable TOS varchar(10);
declare variable CIEN varchar(10);
declare variable CIENTOS varchar(10);
declare variable QUINIENTOS varchar(10);
declare variable SETE varchar(10);
declare variable NOVE varchar(10);
declare variable MIL varchar(10);
declare variable MILLON varchar(10);
declare variable MILLONES varchar(10);
declare variable SONMILES varchar(5);
declare variable Y varchar(5);
declare variable ESPACIO varchar(5);
declare variable RESUL_NUMERAL varchar(500);
declare variable RESUL_NUMERAL_MOD varchar(500);
declare variable RESUL_NUMERAL_DIV varchar(500);
declare variable UN_MILLON integer;
begin
UN = 'UN';
UNO = UN || 'O'; DOS = 'DOS'; TRES = 'TRES'; CUATRO = 'CUATRO'; CINCO = 'CINCO';
SEIS = 'SEIS'; SIETE = 'SIETE'; OCHO = 'OCHO'; NUEVE = 'NUEVE'; NOVE = 'NOVE';
DIEZ = 'DIEZ'; ONCE = 'ONCE'; DOCE = 'DOCE'; TRECE = 'TRECE';
CATORCE = 'CATORCE'; QUINCE = 'QUINCE'; Y = ' Y '; ESPACIO = ' ';
-- Lista de palabras compuestas
DIECI = 'DIECI'; VEINT = 'VEINT'; TREINTA = 'TREINTA';
CUARENTA = 'CUARENTA'; CINCUENTA = 'CINCUENTA'; SESENTA = 'SESENTA';
SETENTA = 'SETENTA'; OCHENTA = 'OCHENTA'; NOVENTA = 'NOVENTA';
TOS = 'TOS';
CIEN = 'CIEN'; CIENTOS = CIEN || TOS;
QUINIENTOS = 'QUINIEN' || TOS; SETE = 'SETE'; NOVE = 'NOVE';
MIL = 'MIL';
MILLON = 'MILLON';
MILLONES = MILLON || 'ES';
un_millon = 1000000;
numeral = '';
-- sonmiles = 'N';
if (numero = 0) then
begin
numeral = '';
exit;
end else
if (numero between 1 and 15) then
begin
if (numero = 1) then if (sonmiles = 'S') then numeral = un; else numeral = uno;
if (numero = 2) then numeral = dos;
if (numero = 3) then numeral = tres;
if (numero = 4) then numeral = cuatro;
if (numero = 5) then numeral = cinco;
if (numero = 6) then numeral = seis;
if (numero = 7) then numeral = siete;
if (numero = 8) then numeral = ocho;
if (numero = 9) then numeral = nueve;
if (numero = 10) then numeral = diez;
if (numero = 11) then numeral = once;
if (numero = 12) then numeral = doce;
if (numero = 13) then numeral = trece;
if (numero = 14) then numeral = catorce;
if (numero = 15) then numeral = quince;
end
if (numero between 16 and 19) then
begin
execute procedure iudf_numeral(mod(numero, 10)) returning_values(resul_numeral);
numeral = dieci || resul_numeral;
end
if (numero = 20) then numeral = veint || 'E';
if (numero between 21 and 29) then
begin
execute procedure iudf_numeral(mod(numero, 10)) returning_values(resul_numeral);
numeral = veint || 'I' || resul_numeral;
end
if (numero between 30 and 99) then
begin
if (numero between 30 and 39) then
begin
execute procedure iudf_numeral(mod(numero, 10)) returning_values(resul_numeral);
numeral = treinta || y || resul_numeral;
end
if (numero between 40 and 49) then
begin
execute procedure iudf_numeral(mod(numero, 10)) returning_values(resul_numeral);
numeral = cuarenta || y || resul_numeral;
end
if (numero between 50 and 59) then
begin
execute procedure iudf_numeral(mod(numero, 10)) returning_values(resul_numeral);
numeral = cincuenta || y || resul_numeral;
end
if (numero between 60 and 69) then
begin
execute procedure iudf_numeral(mod(numero, 10)) returning_values(resul_numeral);
numeral = sesenta || y || resul_numeral;
end
if (numero between 70 and 79) then
begin
execute procedure iudf_numeral(mod(numero, 10)) returning_values(resul_numeral);
numeral = setenta || y || resul_numeral;
end
if (numero between 80 and 89) then
begin
execute procedure iudf_numeral(mod(numero, 10)) returning_values(resul_numeral);
numeral = ochenta || y || resul_numeral;
end
if (numero between 90 and 99) then
begin
execute procedure iudf_numeral(mod(numero, 10)) returning_values(resul_numeral);
numeral = noventa || y || resul_numeral;
end
end
if (numero = 100) then numeral = cien;
if (numero between 101 and 199) then
begin
execute procedure iudf_numeral(mod(numero, 100)) returning_values(resul_numeral);
numeral = cien || 'TO ' || resul_numeral;
end
if (numero >= 200) then
begin
if (numero = 0) then espacio = '';
if (numero between 200 and 999) then
begin
if ((numero/100) = 2) then
begin
execute procedure iudf_numeral(mod(numero, 100)) returning_values(resul_numeral);
numeral = dos || cientos || espacio || resul_numeral;
end
if ((numero/100) = 3) then
begin
execute procedure iudf_numeral(mod(numero, 100)) returning_values(resul_numeral);
numeral = tres || cientos || espacio || resul_numeral;
end
if ((numero/100) = 4) then
begin
execute procedure iudf_numeral(mod(numero, 100)) returning_values(resul_numeral);
numeral = cuatro || cientos || espacio || resul_numeral;
end
if ((numero/100) = 5) then
begin
execute procedure iudf_numeral(mod(numero, 100)) returning_values(resul_numeral);
numeral = quinientos || espacio || resul_numeral;
end
if ((numero/100) = 6) then
begin
execute procedure iudf_numeral(mod(numero, 100)) returning_values(resul_numeral);
numeral = seis || cientos || espacio || resul_numeral;
end
if ((numero/100) = 7) then
begin
execute procedure iudf_numeral(mod(numero, 100)) returning_values(resul_numeral);
numeral = sete || cientos || espacio || resul_numeral;
end
if ((numero/100) = 8) then
begin
execute procedure iudf_numeral(mod(numero, 100)) returning_values(resul_numeral);
numeral = ocho || cientos || espacio || resul_numeral;
end
if ((numero/100) = 9) then
begin
execute procedure iudf_numeral(mod(numero, 100)) returning_values(resul_numeral);
numeral = nove || cientos || espacio || resul_numeral;
end
end
if (numero > 999) then
begin
sonmiles = 'S';
if (numero between 1000 and 1999) then
begin
execute procedure iudf_numeral(mod(numero, 1000)) returning_values(resul_numeral);
numeral = mil || espacio || resul_numeral;
end
if (numero between 2000 and 9999) then
begin
execute procedure iudf_numeral(mod(numero, 1000)) returning_values(resul_numeral_mod);
execute procedure iudf_numeral(numero/1000) returning_values(resul_numeral_div);
numeral = resul_numeral_div || espacio || mil || espacio || resul_numeral_mod;
end
if (numero between 10000 and 999999) then
begin
execute procedure iudf_numeral(mod(numero, 1000)) returning_values(resul_numeral_mod);
execute procedure iudf_numeral(numero/1000) returning_values(resul_numeral_div);
numeral = resul_numeral_div || espacio || mil || espacio || resul_numeral_mod;
end
if (numero between 1000000 and 1999999) then
begin
execute procedure iudf_numeral(mod((numero-un_millon), 1000)) returning_values(resul_numeral_mod);
execute procedure iudf_numeral((numero-un_millon)/1000) returning_values(resul_numeral_div);
numeral = un || espacio || millon || espacio || resul_numeral_div || espacio || mil || espacio || resul_numeral_mod;
end
if (numero >= 2000000) then
begin
execute procedure iudf_numeral(mod(numero, 1000000)) returning_values(resul_numeral_mod);
execute procedure iudf_numeral(numero/1000000) returning_values(resul_numeral_div);
numeral = resul_numeral_div || espacio || millones || espacio || resul_numeral_mod;
end
end else sonmiles = 'N';
end
-- if (numero = 0) then numeral = 'CERO';
suspend;
end^
ALTER PROCEDURE IUDF_NUMLITERAL (
NUMERO DECIMAL(15,6),
PREC SMALLINT)
RETURNS (
LITERAL VARCHAR(500))
AS
declare variable PARTE_ENTERA integer;
declare variable PARTE_DECIMAL integer;
declare variable NUM float;
declare variable NEGATIVO varchar(10);
declare variable LITERAL_ENTERO varchar(500);
declare variable LITERAL_DECIMAL varchar(50);
declare variable NUM_CAD varchar(50);
declare variable POSDEC smallint;
begin
if (numero < 0) then negativo = 'MENOS '; else negativo = '';
numero = abs(numero);
-- Bloque para impedir que la precisión con que se piden los decimales
-- sea mayor que seis, y en todo caso, mayor que el número de decimales significativos
if (prec > 6) then prec = 6;
num_cad = cast(numero as varchar(50));
posdec = position('.' in num_cad);
if (posdec <> 0) then
begin
num_cad = substring(num_cad from posdec+1);
num_cad = trim(trailing '0' from num_cad);
end
if (prec > char_length(num_cad)) then prec = char_length(num_cad);
-- Fin del chequeo de la precisión
-- Extracción de la parte entera y decimal
parte_entera = floor(numero);
num = round(numero, prec);
num = num - parte_entera;
parte_decimal = cast(num * power(10, prec) as integer);
if ((parte_entera > 0) and (parte_decimal > 0)) then
begin
execute procedure iudf_numeral(parte_entera) returning_values(literal_entero);
execute procedure iudf_numeral(parte_decimal) returning_values(literal_decimal);
literal = negativo || literal_entero || ' CON ' || literal_decimal;
end else
if ((parte_entera > 0) and (parte_decimal = 0)) then
begin
execute procedure iudf_numeral(parte_entera) returning_values(literal_entero);
literal = literal_entero;
end else
if ((parte_entera = 0) and (parte_decimal > 0)) then
begin
execute procedure iudf_numeral(parte_decimal) returning_values(literal_decimal);
literal = 'CERO CON ' || literal_decimal;
end else
if ((parte_decimal = 0) and (parte_decimal = 0)) then literal = 'CERO';
suspend;
end^
SET TERM ; ^
Si hay algo erróneo, por favor hacérmelo saber, en todo caso, que os resulte de provecho.
Un saludo.