Club Delphi  
    FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Bases de datos > Firebird e Interbase
Registrarse FAQ Miembros Calendario Guía de estilo Temas de Hoy

Respuesta
 
Herramientas Buscar en Tema Desplegado
  #1  
Antiguo 30-09-2011
Avatar de GustavoCruz
GustavoCruz GustavoCruz is offline
Miembro
 
Registrado: jul 2006
Ubicación: Sampués Sucre (Colombia)
Posts: 293
Poder: 18
GustavoCruz Va por buen camino
UDF no funciona en xp

Buenos día amigos foreros, hace algún tiempo tomé el código de Atexto y lo puse en una dll para utilizarla en una base de datos firebird.
Me funcionó sin ningún problema, pero hace poco la quise utilizar nuevamente y me muestra el siguiente error:
Código SQL [-]
Invalid token.
invalid request BLR at offset 480.
function A_LETRAS is not defined.
module name or entrypoint could not be found.

Luego volví a compilar el proyecto utilizado lazarus y todo me fue perfectamente bien, hasta que monté la udf en un equipo con XP.

la udf la compilé en un equipo con win7 utilizando Delphi y Lazarus, en ambos casos me funcionó bien.

Mi pregunta es qué estoy haciendo mal?

El código en Delphi es el siguiente:

Código Delphi [-]
unit Conversiones;

interface

uses ib_util, SysUtils, Classes;

function NumeroALetra(var fNumero: Double; FMoneda: PChar): PChar; cdecl; export;


implementation


function NumeroALetra(var fNumero: Double; FMoneda: PChar): PChar;
     (*** NUEVA ***)
     (*** Ej: 'treinta y una millones' --> 'treinta y un millones' ***)
     function Cambiar_na_a_masculino(Texto: String): String;
     var
       P: Integer;
     begin
       Result:= Texto;
       P:= Pos('na', Result);
       while P > 0 do begin
         Delete(Result, P+1, 1);
         P:= Pos('na', Result);
       end;
     end;

     (*** NUEVA ***)
     (*** Ej: 'quinientas millones' --> 'quinientos millones' ***)
     function Cambiar_as_a_masculino(Texto: String): String;
     var
       P: Integer;
     begin
       Result:= Texto;
       P:= Pos('as', Result);
       while P > 0 do begin
         Result[P]:='o';
         P:= Pos('as', Result);
       end;
     end;

     (*** Optimizada ***)
     function Unidades(numero:Integer): String;
     begin
       case numero of
         0: Result:='';
         1: Result:='un';
         2: Result:='dos';
         3: Result:='tres';
         4: Result:='cuatro';
         5: Result:='cinco';
         6: Result:='seis';
         7: Result:='siete';
         8: Result:='ocho';
         9: Result:='nueve';
       end;
     end;

     (*** Optimizada ***)
     function Decenas(numero:integer): String;
     begin
       Case numero of
         0:Result:='';
         1..9:Result:=Unidades(numero);
         10: Result:='diez';
         11: Result:='once';
         12: Result:='doce';
         13: Result:='trece';
         14: Result:='catorce';
         15: Result:='quince';
         16: Result:='dieciséis';
         17: Result:='diecisiete';
         18: Result:='dieciocho';
         19: Result:='diecinueve';
         20: Result:='veinte';
         21,24,25,27..29: Result:='veinti'+Unidades(numero mod 10);
         22: Result:='veintidós';
         23: Result:='veintitrés';
         26: Result:='veintiséis';
         30: Result:='treinta';
         40: Result:='cuarenta';
         50: Result:='cincuenta';
         60: Result:='sesenta';
         70: Result:='setenta';
         80: Result:='ochenta';
         90: Result:='noventa';
         else Result:=Decenas(numero - numero mod 10)+' y '+ unidades(numero mod 10);
       end;
     end;

     (*** Optimizada ***)
     function Centenas(numero:integer): String;
     begin
       case numero of
         0: Result:='';
         1..99: Result:=Decenas(numero);
         100: Result:='cien';
         101..199: Result:='ciento '+Decenas(numero mod 100);
         500: Result:='quinientos ';
         700: Result:='setecientos ';
         900: Result:='novecientos ';
         501..599,
         701..799,
         901..999: Result:= Centenas(numero - numero mod 100)+Decenas(numero mod 100);
         else Result:=Unidades(numero div 100)+'cientos'+' '+Decenas(numero mod 100)
       end;
     end;

     (*** NUEVA ***)
     (*** Esta funcion traduce los números menores a un millón ***)
     function Millares(numero: Longint): String;
     begin
       if numero > 999 then begin
         if numero > 1999
         then Result:= Centenas(numero div 1000)+' mil '+Centenas(numero mod 1000)
         else Result:= 'mil '+Centenas(numero mod 1000);
       end else
         Result:= Centenas(numero);
     end;

     (*** NUEVA ***)
     (*** Esta funcion traduce los números menores a un billón ***)
     function Millones(numero: Extended):String;
     var tmp : String;
         A, B: Longint;
     begin
       A:= Trunc(numero * 0.000001);
       B:= Trunc(numero - (A / 0.000001));
       if A = 1 then
         Result:= 'un millón '+Millares(B)
       else begin
         tmp:= Millares(A);
         if Trim(tmp) <> '' then begin
           tmp:= Cambiar_as_a_masculino(tmp);
           tmp:= Cambiar_na_a_masculino(tmp);
           Result:= tmp+' millones '+Millares(B);
         end else
           Result:= Millares(B);
       end;
     end;

     (*** NUEVA ***)
     (*** Esta funcion traduce los números menores a un trillón ***)
     function Billones(numero: Extended):String;
     var tmp: String;
         A: Longint;
         B: Extended;
     begin
       A:= Trunc(numero * 0.000000000001);
       B:= numero - (A / 0.000000000001);
       if A = 1 then
         Result:= 'un billón '+Millones(B)
       else begin
         tmp:= Millares(A);
         if Trim(tmp) <> '' then begin
           tmp:= Cambiar_as_a_masculino(tmp);
           tmp:= Cambiar_na_a_masculino(tmp);
           Result:= tmp+' billones '+Millones(B);
         end else
           Result:= Millones(B);
       end;
     end;

     (*** NUEVA ***)
     (*** Esta funcion traduce los números menores a 10 trillones, no he
       podido traducir cifras superiores por la simple razon de que los
       números EXTENDED sólo tienen 19 cifras significativas y la traducción
       sale herrada, además, no creo que las necesite  ***)
     function Trillones(numero: Extended):String;
     var tmp: String;
         A: Longint;
         B: Extended;
     begin
       A:= Trunc(numero * 0.000000000000000001);
       B:= numero - (A / 0.000000000000000001);
       if A = 1 then
         Result:= 'un trillón '+Billones(B)
       else begin
         if A <= 9 then begin
           tmp:= Millares(A);
           if Trim(tmp) <> '' then begin
             tmp:= Cambiar_as_a_masculino(tmp);
             tmp:= Cambiar_na_a_masculino(tmp);
             Result:= tmp+' trillones '+Billones(B);
           end else
             Result:= Billones(B);
         end else
           Result:= '# # # # # # # # #';
       end;
     end;

     (*** NUEVA ***)
     (*** Suprime los caracteres [espacio] que se encuentren junto a otros
       caracteres [espacio].
       Ej: 'mil  cien' --> 'mil cien' ***)
     function CorrigeTexto(Frase: String): String;
     var
       P: Integer;
     begin
       Result:= LowerCase(Frase);
       P:= Pos('  ', Result);
       while P > 0 do begin
         Delete(Result, P, 1);
         P:= Pos('  ', Result);
       end;
     end;

var
  S: String;
  Num_Ctvs  : Integer;
  Num_Largo : Extended;
begin
  FNumero      := Abs(FNumero);
  Num_Largo    := Int(FNumero);

  //si es menor que mil billones... tomamos en cuenta los decimales,
  //de lo contrario no podemos tomarlos en cuenta... por aquello de
  //las cifras significativas... uds. saben...
  if Num_Largo < 1000000000000000.0 then begin
    S:= FormatFloat('0.00', FNumero);
    Num_Ctvs := StrToInt(Copy(S, Length(S)-1, 2));
  end else
    Num_Ctvs := 0;

  //Se traduce la cifra sin decimales
  S:= Trillones(Num_Largo);

  //Se traducen los decimales
  if (Num_Ctvs > 0)
  then Result:= pchar(Decenas(Num_Ctvs))
  else Result:= pchar('');



  //Compactamos en un solo texto
  if (Trim(S) <> '') then begin
    if (Result <> '')
    then Result:= pchar(Trim(S) +' ' +FMoneda +' con '+ Result)
    else Result:= pchar(Trim(S) +' ' +FMoneda);
  end;

  //quitamos los caracteres [espacio] junto a otros caracteres [espacio]
  Result:= PChar(CorrigeTexto(Result));
end;

end.

El proyecto

Código Delphi [-]
library g_udf;

{ Important note about DLL memory management: ShareMem must be the
  first unit in your library's USES clause AND your project's (select
  Project-View Source) USES clause if your DLL exports any procedures or
  functions that pass strings as parameters or function results. This
  applies to all strings passed to and from your DLL--even those that
  are nested in records and classes. ShareMem is the interface unit to
  the BORLNDMM.DLL shared memory manager, which must be deployed along
  with your DLL. To avoid using BORLNDMM.DLL, pass string information
  using PChar or ShortString parameters. }

uses
  SysUtils,
  Classes,
  Conversiones in 'Conversiones.pas',
  ib_util in 'ib_util.pas';

{$R *.res}
  exports    
    NumeroALetra;

begin

end.

Gracias por vuestro tiempo



GustavoCruz
Responder Con Cita
  #2  
Antiguo 30-09-2011
Avatar de jhonny
jhonny jhonny is offline
Jhonny Suárez
 
Registrado: may 2003
Ubicación: Colombia
Posts: 7.058
Poder: 30
jhonny Va camino a la famajhonny Va camino a la fama
Bueno, ahí lo que dice es que no está declarada esa UDF en la base de datos, debes ejecutar algo parecido a lo siguiente en tu BD:

Código SQL [-]
DECLARE EXTERNAL FUNCTION A_LETRAS
    DOUBLE PRECISION
RETURNS CHAR(1000)
ENTRY_POINT 'NumeroALetra' MODULE_NAME 'g_udf';
__________________
Lecciones de mi Madre. Tema: modificación del comportamiento, "Pará de actuar como tu padre!"

http://www.purodelphi.com/
http://www.nosolodelphi.com/
Responder Con Cita
  #3  
Antiguo 30-09-2011
Avatar de GustavoCruz
GustavoCruz GustavoCruz is offline
Miembro
 
Registrado: jul 2006
Ubicación: Sampués Sucre (Colombia)
Posts: 293
Poder: 18
GustavoCruz Va por buen camino
Mi amigo Jhonny, he declarado la udf en firebird y no me funciona:

estoy utilizado Firebird 2.1 y el IBExpert Versión 2011.04.03
y me sigue apareciendo el mismo problema


Gracias por tu respuesta



GustavoCruz
Responder Con Cita
  #4  
Antiguo 30-09-2011
Avatar de jhonny
jhonny jhonny is offline
Jhonny Suárez
 
Registrado: may 2003
Ubicación: Colombia
Posts: 7.058
Poder: 30
jhonny Va camino a la famajhonny Va camino a la fama
¿Ya intentaste reiniciar el servicio?
__________________
Lecciones de mi Madre. Tema: modificación del comportamiento, "Pará de actuar como tu padre!"

http://www.purodelphi.com/
http://www.nosolodelphi.com/
Responder Con Cita
  #5  
Antiguo 30-09-2011
Avatar de GustavoCruz
GustavoCruz GustavoCruz is offline
Miembro
 
Registrado: jul 2006
Ubicación: Sampués Sucre (Colombia)
Posts: 293
Poder: 18
GustavoCruz Va por buen camino
Efectivamente,

Reinicié el servicio, instalé y desintalé firebird 2.1 y 2.5 para ver si era cuestión de versiones y nada. por lo que supese que debía de tratarse del SO ya que en 7 me funciona perfectamente, pero también pienso que eso no tiene nada que ver...,

actualmente tengo instalado firebird 2.5

Gracias por tu tiempo

Gustvo Cruz
Responder Con Cita
  #6  
Antiguo 30-09-2011
Avatar de Casimiro Notevi
Casimiro Notevi Casimiro Notevi is offline
Moderador
 
Registrado: sep 2004
Ubicación: En algún lugar.
Posts: 32.042
Poder: 10
Casimiro Notevi Tiene un aura espectacularCasimiro Notevi Tiene un aura espectacular
Cada vez que instalas una versión volverás a dar de alta la udf, se supone
Responder Con Cita
  #7  
Antiguo 30-09-2011
Avatar de GustavoCruz
GustavoCruz GustavoCruz is offline
Miembro
 
Registrado: jul 2006
Ubicación: Sampués Sucre (Colombia)
Posts: 293
Poder: 18
GustavoCruz Va por buen camino
Efectivamente mi amigo Casimiro Notevi.

Me gustaría que me colaboren con esto, tomen el código que puse y compilen ustedes, quizas funcione...

Gracias por vuestra ayuda
Responder Con Cita
  #8  
Antiguo 30-09-2011
Avatar de defcon1_es
defcon1_es defcon1_es is offline
Miembro
 
Registrado: mar 2004
Ubicación: Cuenca - España
Posts: 533
Poder: 21
defcon1_es Va por buen camino
Hola. Varias cosas que yo tendría en cuenta:

1) Yo pondría en los uses a la unit ShareMem

Código Delphi [-]
unit Conversiones;  

interface  

uses Sharemem, ib_util, SysUtils, Classes;

Código Delphi [-]
library g_udf;

{ Important note about DLL memory management: ShareMem must be the
  first unit in your library's USES clause AND your project's (select
  Project-View Source) USES clause if your DLL exports any procedures or
  functions that pass strings as parameters or function results. This
  applies to all strings passed to and from your DLL--even those that
  are nested in records and classes. ShareMem is the interface unit to
  the BORLNDMM.DLL shared memory manager, which must be deployed along
  with your DLL. To avoid using BORLNDMM.DLL, pass string information
  using PChar or ShortString parameters. }

uses
  Sharemem,
  SysUtils,
  Classes,
  Conversiones in 'Conversiones.pas',
  ib_util in 'ib_util.pas';

{$R *.res}
  exports    
    NumeroALetra;

begin

end.

2) El fichero g_udf.dll debe estar en la carpeta UDF de Firebird

3) Borra la definición de la función de tu base de datos y vuelve a darla de alta tal como sugiere jhonny
__________________
Progress Openedge
https://abevoelker.com/progress_open...dered_harmful/


Delphi forever...
Responder Con Cita
  #9  
Antiguo 30-09-2011
Avatar de GustavoCruz
GustavoCruz GustavoCruz is offline
Miembro
 
Registrado: jul 2006
Ubicación: Sampués Sucre (Colombia)
Posts: 293
Poder: 18
GustavoCruz Va por buen camino
Hola amigo defcon1_es

esto es lo que me muestra ahora

Invalid data type, length, or value.
function A_LETRAS could not be matched.

la declaración en la base de datos es la siguiente:

Código SQL [-]
DECLARE EXTERNAL FUNCTION A_LETRAS
    DOUBLE PRECISION,
    CSTRING(10)
RETURNS CSTRING(600) FREE_IT
ENTRY_POINT 'NumeroALetra' MODULE_NAME 'g_udf';

Ya no se qué hacer...

Gracias por vuestro tiempo
Responder Con Cita
  #10  
Antiguo 30-09-2011
Avatar de Casimiro Notevi
Casimiro Notevi Casimiro Notevi is offline
Moderador
 
Registrado: sep 2004
Ubicación: En algún lugar.
Posts: 32.042
Poder: 10
Casimiro Notevi Tiene un aura espectacularCasimiro Notevi Tiene un aura espectacular
Por qué no nos escribes paso a paso, exactamente, todo lo que haces. Ya sabes, 4 ojos ven más que 2. Y en este caso 400 ojos ven más que 2
Responder Con Cita
  #11  
Antiguo 30-09-2011
Avatar de guillotmarc
guillotmarc guillotmarc is offline
Miembro
 
Registrado: may 2003
Ubicación: Huelva
Posts: 2.638
Poder: 24
guillotmarc Va por buen camino
Te sería mucho más cómodo traducir este código Delphi a Transact-SQL y así ponerlo en un procedimiento almacenado.

De esta forma no te tendrás que preocupar de UDF's, lo tendrás siempre disponible en tu base de datos. No te tendrás que preocupar de distribuirlo en nuevas instalaciones, de si tu servidor corre en Windows o en Linux, de si será compatible con nuevas versiones de Firebird, etc. ... ...

Claro que esa traducción no es trivial, pero las ventajas sobre una UDF valen la pena.
__________________
Marc Guillot (Hi ha 10 tipus de persones, els que saben binari i els que no).
Responder Con Cita
  #12  
Antiguo 30-09-2011
Avatar de GustavoCruz
GustavoCruz GustavoCruz is offline
Miembro
 
Registrado: jul 2006
Ubicación: Sampués Sucre (Colombia)
Posts: 293
Poder: 18
GustavoCruz Va por buen camino
Bueno listo...

1. Una vez compilado la udf. procedo a copiarla al directorio de UDF que está en la carpeta de Firebird.
2. paso siguiente reinicio el equipo; aunque con reiniciar el servicio es suficiente
3. inicio el IBExpert y borro la declaración previa de la udf
4. doy nuevamente de alta la función.
5. realizo una consulta cualquiera y no me funciona. me muestra los errores que ya he expuesto.

Nota:
No entiendo por qué me funciona en win7 y no así en win xp sp3
si fuese problema de la udf o del código no corriera en win7....

Gracias por vuestro tiempo
Responder Con Cita
  #13  
Antiguo 03-10-2011
cloayza cloayza is offline
Miembro
 
Registrado: may 2003
Ubicación: San Pedro de la Paz, Chile
Posts: 913
Poder: 23
cloayza Tiene un aura espectacularcloayza Tiene un aura espectacular
Cita:
Empezado por guillotmarc Ver Mensaje
Te sería mucho más cómodo traducir este código Delphi a Transact-SQL y así ponerlo en un procedimiento almacenado.

De esta forma no te tendrás que preocupar de UDF's, lo tendrás siempre disponible en tu base de datos. No te tendrás que preocupar de distribuirlo en nuevas instalaciones, de si tu servidor corre en Windows o en Linux, de si será compatible con nuevas versiones de Firebird, etc. ... ...

Claro que esa traducción no es trivial, pero las ventajas sobre una UDF valen la pena.
Tome tu idea, y comenze a buscar en la red algun codigo que realizara el trabajo de traducir numero a palabras. (Para que inventar la rueda ) ..y encontre esto Script de Oracle, especificamente este enlace Numeros a Palabras


Despues de analizar me puse manos a la obra y realizar la traduccion para Firebird...

La estuve probando (Firebird 2.5) y al parecer funciona bien, eso si que hay que seguir chequeando...Les dejo el script para la creacion de los procedimientos almacenados.

Cita:
/**************************************************************************************************** ******/
/* */
/* Procedure: NumberToWords */
/* Description: This package provides a function NumberToWords converting numbers to their */
/* English equivalent and returns it as a string. */
/* */
/* Version: 1.0.0 */
/* */
/* Required: Oracle Server Version 7.3 or higher. */
/* */
/* Example: */
/* */
/* SELECT NumberToWords.NumberToWords(1234567890) FROM DUAL; */
/* */
/* Written by: Material Dreams */
/* EMail: info@materialdreams.com */
/* WWW: http://www.materialdreams.com/oracle */
/* */
/* License: This script can be freely distributed as long as this header will not be removed and */
/* improvements and changes to this script will be reported to the author. */
/* */
/* Copyright (c) 1995-2004 by Material Dreams. All Rights Reserved. */
/* */
/**************************************************************************************************** ******/

/*
Traduccion a Firebird: Christian Loayza

SELECT * FROM NUMBER_EXECUTE(125425)
*/


SET TERM ^ ;
create procedure NUMBER_MILES (
THEVALUE integer)
returns (
ARESULT varchar(20))
as
begin
AResult='';
AResult=IIF(TheValue=1,' ',AResult);
AResult=IIF(TheValue=2,'mil',AResult);
AResult=IIF(TheValue=3,'millon',AResult);
AResult=IIF(TheValue=4,'billon',AResult);
AResult=IIF(TheValue=5,'trillon',AResult);
AResult=IIF(TheValue=6,'quatrillon',AResult);
AResult=IIF(TheValue=7,'quintillon',AResult);
AResult=IIF(TheValue=8,'sistillon',AResult);
AResult=IIF(TheValue=9,'septillion',AResult);
AResult=IIF(TheValue=10,'octillon',AResult);
AResult=IIF(TheValue=11,'nonillion',AResult);
AResult=IIF(TheValue=12,'decillion',AResult);
AResult=IIF(TheValue=13,'undecillion',AResult);
AResult=IIF(TheValue=14,'duodecillio',AResult);
AResult=IIF(TheValue=15,'tredecillion',AResult);
AResult=IIF(TheValue=16,'quintuordecillion',AResult);
AResult=IIF(TheValue=17,'sexdecillion',AResult);
AResult=IIF(TheValue=18,'septendecillion',AResult);
AResult=IIF(TheValue=19,'octodecillion',AResult);
AResult=IIF(TheValue=20,'novemdecillion',AResult);
AResult=IIF(TheValue=21,'vigintillion',AResult);
AResult=IIF(TheValue=22,'vigintillion',AResult);

end^

SET TERM ; ^

SET TERM ^ ;

create procedure NUMBER_NAME (
VALOR integer)
returns (
RESULT varchar(10))
as
begin
SELECT
CASE :Valor
WHEN 01 THEN 'cero'
WHEN 02 THEN 'uno'
WHEN 03 THEN 'dos'
WHEN 04 THEN 'tres'
WHEN 05 THEN 'cuatro'
WHEN 06 THEN 'cinco'
WHEN 07 THEN 'seis'
WHEN 08 THEN 'siete'
WHEN 09 THEN 'ocho'
WHEN 10 THEN 'nueve'
WHEN 11 THEN 'diez'
WHEN 12 THEN 'once'
WHEN 13 THEN 'doce'
WHEN 14 THEN 'trece'
WHEN 15 THEN 'catorce'
WHEN 16 THEN 'quince'
WHEN 17 THEN 'diesiseis'
WHEN 18 THEN 'diesisiete'
WHEN 19 THEN 'diesiocho'
WHEN 20 THEN 'diesinueve'
WHEN 21 THEN iif(MOD(:VALOR, 10)=0,'veinte','veinti')
WHEN 22 THEN 'treinta'
WHEN 23 THEN 'cuarenta'
WHEN 24 THEN 'cincuenta'
WHEN 25 THEN 'sesenta'
WHEN 26 THEN 'setenta'
WHEN 27 THEN 'ochenta'
WHEN 28 THEN 'noventa'
WHEN 29 THEN ''
END as Result
FROM
rdb$database
into :Result;

suspend;
end^

SET TERM ; ^

SET TERM ^ ;

create procedure NUMBER_VALUE (
VALOR integer)
returns (
RESULT integer)
as
begin
SELECT
CASE :Valor
WHEN 01 THEN 0
WHEN 02 THEN 1
WHEN 03 THEN 2
WHEN 04 THEN 3
WHEN 05 THEN 4
WHEN 06 THEN 5
WHEN 07 THEN 6
WHEN 08 THEN 7
WHEN 09 THEN 8
WHEN 10 THEN 9
WHEN 11 THEN 10
WHEN 12 THEN 11
WHEN 13 THEN 12
WHEN 14 THEN 13
WHEN 15 THEN 14
WHEN 16 THEN 15
WHEN 17 THEN 16
WHEN 18 THEN 17
WHEN 19 THEN 18
WHEN 20 THEN 19
WHEN 21 THEN 20
WHEN 22 THEN 30
WHEN 23 THEN 40
WHEN 24 THEN 50
WHEN 25 THEN 60
WHEN 26 THEN 70
WHEN 27 THEN 80
WHEN 28 THEN 90
WHEN 29 THEN 999
END as result
FROM
rdb$database
Into :Result;
SUSPEND;

end^

SET TERM ; ^

SET TERM ^ ;
create procedure NUMBER_DECENAS (
THEVALUE integer)
returns (
S varchar(80))
as
declare variable V integer;
declare variable I integer;
declare variable X integer;
declare variable CNAME varchar(10);
BEGIN
v = theValue;
i = 1;
s ='';
EXECUTE PROCEDURE NUMBER_VALUE(i) RETURNING_VALUES :x;
WHILE (x <= v) DO
BEGIN
i = i + 1;
EXECUTE PROCEDURE NUMBER_VALUE(i) RETURNING_VALUES :x;
END

EXECUTE PROCEDURE NUMBER_NAME(i-1) RETURNING_VALUES :cname;
EXECUTE PROCEDURE NUMBER_VALUE(i-1) RETURNING_VALUES :x;
v = v - x;
s=TRIM(cname);

IF (v > 0) THEN
BEGIN
EXECUTE PROCEDURE NUMBER_NAME(v+1) RETURNING_VALUES :cname;
IF (X<>20) THEN
s = s || ' y ' || TRIM(cname);
ELSE
s = s || IIF(s<>'',' ','') || TRIM(cname);
END
SUSPEND;
end^

SET TERM ; ^

SET TERM ^ ;

create procedure NUMBER_CENTENAS (
THEVALUE integer)
returns (
S varchar(80))
as
declare variable V integer;
declare variable N integer;
declare variable R integer;
declare variable M integer;
declare variable CNAME varchar(80);
BEGIN
v = theValue;
m = MOD(v, 100);
r = FLOOR(v / 100);
s = '';

IF (r > 0) THEN
BEGIN
s='';
s=IIF(r=1 and m=0,'cien',s);
s=IIF(r=1 and m>1,'ciento',s);
s=IIF(r=2,'doscientos',s);
s=IIF(r=3,'trescientos',s);
s=IIF(r=4,'cuatrocientos',s);
s=IIF(r=5,'quinientos',s);
s=IIF(r=6,'seiscientos',s);
s=IIF(r=7,'setecientos',s);
s=IIF(r=8,'ochocientos',s);
s=IIF(r=9,'novecientos',s);
END

IF (m > 0) THEN
BEGIN
EXECUTE PROCEDURE NUMBER_DECENAS(m) RETURNING_VALUES :cname;
s = s ||IIF(s<>'',' ','')||TRIM(cname);
END
SUSPEND;
END^

SET TERM ; ^

SET TERM ^ ;

create procedure NUMBER_EXECUTE (
THENUMBER integer)
returns (
WORD varchar(255))
as

declare variable TRUE integer;
declare variable FALSE integer;
declare variable VAL integer;
declare variable TRI integer;
declare variable PLACE integer;
declare variable NEG integer;
declare variable TEMP varchar(255);
declare variable PHRASE varchar(255);
declare variable S varchar(80);
begin
True=1; False=0; Tri=0; place=0; neg=0; Word='';
val=TheNumber;

-- check for 0
IF (val = 0) THEN
BEGIN
word = 'zero';
suspend;
exit;
END

-- check for negative int
IF (val < 0) THEN
BEGIN
neg= TRUE;
val= -val;
END

-- what we do now is break it up into sets of three, and add the appropriate denominations to each
WHILE (val > 0) DO
BEGIN
phrase = '';
tri = MOD(val, 1000); -- last tree digits
val = FLOOR(val / 1000); -- base 10 shift by 3
IF (tri > 0) THEN
BEGIN
EXECUTE PROCEDURE NUMBER_CENTENAS(tri) RETURNING_VALUES :s;
phrase = phrase || s;
END

IF ((place > 0) AND (tri > 0)) THEN
begin
EXECUTE PROCEDURE NUMBER_MILES(place+1) RETURNING_VALUES :s;

IF (MOD(Tri, 10)=1 ) THEN
phrase = SUBSTRING(phrase FROM 1 FOR CHAR_LENGTH(TRIM(phrase)))||' '|| s;
ELSE
phrase = phrase ||' '|| s ||IIF(place>=2,'es','');
end
place = place + 1;

-- got the phrase, now put in the string
temp = word;
IF ((val > 0) AND (tri > 0)) THEN
word = ' ' || phrase;
ELSE
word = phrase;

word = word || temp;
END

-- remember that minus sign
IF (neg=True) THEN
word = 'negative ' || word;

SUSPEND;
end
^
SET TERM ; ^


Saludos
Responder Con Cita
  #14  
Antiguo 03-10-2011
cloayza cloayza is offline
Miembro
 
Registrado: may 2003
Ubicación: San Pedro de la Paz, Chile
Posts: 913
Poder: 23
cloayza Tiene un aura espectacularcloayza Tiene un aura espectacular
Subi el script al FTP del Club

Números a Palabras Firebird

Chaito
Responder Con Cita
  #15  
Antiguo 03-10-2011
Avatar de Casimiro Notevi
Casimiro Notevi Casimiro Notevi is offline
Moderador
 
Registrado: sep 2004
Ubicación: En algún lugar.
Posts: 32.042
Poder: 10
Casimiro Notevi Tiene un aura espectacularCasimiro Notevi Tiene un aura espectacular
Interesante, hacerlo en la propia base de datos.
Gracias por el aporte.
Responder Con Cita
  #16  
Antiguo 04-10-2011
Avatar de guillotmarc
guillotmarc guillotmarc is offline
Miembro
 
Registrado: may 2003
Ubicación: Huelva
Posts: 2.638
Poder: 24
guillotmarc Va por buen camino
Gracias por traducirlo a Firebird y compartirlo.

Para quienes no hayan usado procedimientos almacenados, la forma de utilizarlos para reemplazar una UDF es llamarlos en una subconsulta.

Por ejemplo, si tenemos la tabla COMPRAS con el campo TOTAL y queremos una consulta con ese campo tanto en valor como en palabras :

select TOTAL, (select WORD from NUMBER_EXECUTE(TOTAL))
from COMPRAS

Saludos.
__________________
Marc Guillot (Hi ha 10 tipus de persones, els que saben binari i els que no).
Responder Con Cita
Respuesta



Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes

El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro

Temas Similares
Tema Autor Foro Respuestas Último mensaje
funciona bien en windows 7 64b pero en XP no funciona ASAPLTDA Varios 5 06-05-2011 16:24:50
IDE funciona mal dfarias Varios 2 10-02-2009 11:04:26
No funciona PHP silviodp PHP 6 07-06-2008 21:51:29
¿Así funciona el BETWEEN? Faust Firebird e Interbase 4 13-05-2008 01:58:40
like no funciona ! dmasson Conexión con bases de datos 9 23-03-2004 14:10:50


La franja horaria es GMT +2. Ahora son las 08:22:39.


Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi
Copyright 1996-2007 Club Delphi