[[birmain]]

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';

/* Fernando Gallego
   02 Nov 2011
   Albacete - España */



SET TERM ^ ; 



/******************************************************************************/
/***                           Stored Procedures                            ***/
/******************************************************************************/

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 ; ^



/******************************************************************************/
/***                           Stored Procedures                            ***/
/******************************************************************************/


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.