Udf Não funciona

Firebird

07/12/2006

Simplesmente esta udf não ffunciona

function Formata(Str: Pchar; Decimais: Integer): Pchar; cdecl; export;
var
I    : Integer;
S, S2: ShortString;
begin
S:= ´0´ + DecimalSeparator;
  For I:= 0 to Decimais do
      S:= S + ´0´;
     StrPCopy(Result, S);

end;


já tentei de tudo e não da o resultado, quero que ele me retorne decimais conforme a entrada decimais. help...


Sremulador

Sremulador

Curtidas 0

Respostas

Emerson Nascimento

Emerson Nascimento

07/12/2006

function Formata(Str: Pchar; Decimais: Integer): Pchar; cdecl; export;
var
  I    : Integer;
  S, S2: ShortString;
begin
  S := ´0´ + DecimalSeparator;
  For I:= 0 to Decimais-1 do
      S:= S + ´0´;
  Result := AllocMem(Length(S));
  StrPCopy(Result, S);
end;
pra que serve o parâmetro Str? não vi uso pra ele na função.


GOSTEI 0
Sremulador

Sremulador

07/12/2006

function Formata(Str: Pchar; Decimais: Integer): Pchar; cdecl; export; 
var 
  I    : Integer; 
  S, S2: ShortString; 
begin 
  S := ´0´ + DecimalSeparator; 
  For I:= 0 to Decimais-1 do 
      S:= S + ´0´;

[b]      S:= StrPCopy(S + Str);[/b]  Result := AllocMem(Length(S)); 
  StrPCopy(Result, S); 
end;


obrigado emerson, na verdade quero adicionar a quantidade de decimais que tenho em um campo na tabela ex

Decimais
Funcao Formata(´3,1´, 2);
Retorno 3,10...

Valeu


GOSTEI 0
Emerson Nascimento

Emerson Nascimento

07/12/2006

bom, tente fazer algo assim:
function Formata(Str: Pchar; Decimais: Integer): Pchar;
var
  i : Integer;
  s, s2: ShortString;
begin
  i := pos(´,´{ou DecimalSeparator}, Str);
  s2 := str;

  delete( s2,1,i);

  if i > 0 then
     dec(decimais,length(s2));

  if decimais > 0 then
  begin
    if i = 0 then Str := PChar(Str + ´,´);

    for i := 1 to Decimais do
      Str := PChar(Str + ´0´);
  end;

  Result := AllocMem(Length(Str));
  StrPCopy(Result, Str);
end;


ou ainda:
function Formata(Str: Pchar; Decimais: Integer): Pchar;
var
  i : Integer;
  s: ShortString;
  d: double;
begin
  s := ´,#0.´+stringofchar(´0´, decimais);

  try
    d := strtofloat(str);
    str := PChar(formatfloat(s, d));
  except
  end;

  Result := AllocMem(Length(Str));
  StrPCopy(Result, Str);
end;



GOSTEI 0
Sremulador

Sremulador

07/12/2006

alô amigo emerson, sua dica funcionou, porem ao fazer isso no banco de dados da um erro de leitura de dados, e não funciona, você saberia o que e, obs: quando eu coloco os valores de retorno diretamente funciona

Result := AllocMem(Length(´30,3´));
StrPCopy(Result, ´30,3´);


valeu


GOSTEI 0
Sremulador

Sremulador

07/12/2006

Olha o código da dll

library sahudf;

uses
  SysUtils;

{ *** String functions *** }

{Retorna com a formatação de casas decimais
  DECLARE EXTERNAL FUNCTION FORMATA
  DOUBLE PRECISION,
  INTEGER
  RETURNS CSTRING(30) CHARACTER SET NONE
  ENTRY_POINT ´Formata´ MODULE_NAME ´sahudf´;}

function Formata(Str: Pchar; Decimais: Integer): Pchar; cdecl; export;
var
  i : Integer;
  s: ShortString;
  d: double;
begin 
  s := ´,#0.´+stringofchar(´0´, decimais); 

  try 
    d := strtofloat(str); 
    str := PChar(formatfloat(s, d)); 
  except 
  end;
  Result := AllocMem(Length(Str));
  StrPCopy(Result, Str);
end;

exports

  Formata;

begin
  Randomize;
end.



GOSTEI 0
Emerson Nascimento

Emerson Nascimento

07/12/2006

tente isso:
library sahudf;

uses
  SysUtils;

{ *** String functions *** }

{Retorna com a formatação de casas decimais
  DECLARE EXTERNAL FUNCTION FORMATA
  CSTRING(30),
  INTEGER
  RETURNS CSTRING(30)
  ENTRY_POINT ´Formata´ MODULE_NAME ´sahudf´;}

function Formata(Str: Pchar; var Decimais: Integer): Pchar; cdecl; export;
var
  s: shortstring;
  d: double;
begin
  s := ´,#0.´+stringofchar(´0´, decimais);

  try
    d := strtofloat(str);
  except
    d := 0;
  end;

  Str := PChar(formatfloat(s, d));
  Result := StrAlloc(Length(Str));
  Result := PChar(Str);
end;

exports
  Formata;

begin
end.

para declarar no banco de dados, use:
DECLARE EXTERNAL FUNCTION FORMATA
  CSTRING(30),
  INTEGER
RETURNS
  CSTRING(30)
ENTRY_POINT ´Formata´ MODULE_NAME ´sahudf´



GOSTEI 0
Sremulador

Sremulador

07/12/2006

Amigo Emerson o a pesquisa esta retornando as casas decimais certinho, porém não esta retornando os valores corretos isto e esta tudo zerado, verifiquei em ump programa para testes e funcionou porem no banco de dados só sai os zeros mas as casas decimais vem as quantidades corretas, o que você acha...

olha estou utilizando desta forma, uma e para teste, FORMATA(10, 3);
mas nem este...

 SELECT DERS,  DEDZ FROM DIAG_RESULTVALORES
                  WHERE DEAM=:CONTA AND DEFR=:EXMM AND DETT=:DDTT
                  INTO  :TNDC, :DDDZ; BEGIN
                [b]        DESR= FORMATA(10, 3);
--                        DESR= FORMATA(:TNDC, :DECI);[/b]                        END
                  END


Valeu


GOSTEI 0
Sremulador

Sremulador

07/12/2006

Amigo se eu colocar

Result := PChar(´10,3´);

ele sai no db, estou quase ficando doido...


GOSTEI 0
Emerson Nascimento

Emerson Nascimento

07/12/2006

o primeiro parâmetro passado para a função será numérico ou string? eu fiz a função esperando string...


GOSTEI 0
Sremulador

Sremulador

07/12/2006

Amigo o pior que se eu colocar tanto o número diretamente ou em forma de string ele me retorna corretamente mas se eu colocar a variavel fica zerado, já tentei até fazer um cast mas o problema persiste

observe [b:bf847b27a4]´negrito´[/b:bf847b27a4]

CREATE PROCEDURE DIAG_RESULTADOSFINAL(
  CONTA INTEGER,
  EXMM INTEGER)
RETURNS(
  ITEM INTEGER,
  RESU VARCHAR(50) CHARACTER SET NONE,
  DESR VARCHAR(50) CHARACTER SET NONE,
  DDDZ INTEGER,
  BLBS BLOB,
  DECI INTEGER,
  TIPO INTEGER,
  NDEC NUMERIC(18, 6))
AS
DECLARE VARIABLE TEXT VARCHAR(50);
DECLARE VARIABLE DDDR INTEGER;
DECLARE VARIABLE DDGO INTEGER;
DECLARE VARIABLE TPTT INTEGER;
DECLARE VARIABLE DDTT INTEGER;
[b]DECLARE VARIABLE TNDC VARCHAR(18);[/b]
BEGIN
    FOR SELECT  DDDR,  DDGO,  DDTT,  DZCD,  DDCC FROM DIAG_DET_FORMTEXAMES
          INNER JOIN DIAG_ITENS_PARFORMEXAM ON (DDDZ=DZCD)
          WHERE DDFR=:EXMM
          INTO :DDDR, :DDGO, :DDTT, :DDDZ, :DECI DO BEGIN
          NDEC=NULL;
          RESU=NULL;
          DESR=NULL;
          IF (:DDDR IS NOT NULL) THEN BEGIN --RESULTADO POR FOMULA
               TIPO=1;
               SELECT CAST(DFRS AS DECIMAL (18, 4)) FROM DIAG_RESTFORMUL
               WHERE DFAM=:CONTA AND DFFR=:EXMM AND DFDR=:DDDZ
               INTO RESU;
             END

          IF (:DDGO IS NOT NULL) THEN BEGIN --RESULTADO POR GRUPO DE OPÇÕES
               TIPO=2;
               SELECT DLID, IDDS FROM DIAG_RESULTGRPOPC
               INNER JOIN DIAG_ITEMGRP_OPC ON IDCD=DLID
               WHERE DLAM=:CONTA AND DLFR=:EXMM AND DLDZ=:DDDZ
               INTO RESU, DESR;
               END

          IF (:DDTT IS NOT NULL) THEN BEGIN --RESULTADO POR TEXTO
               ITEM=NULL;
               SELECT TTTP FROM DIAG_TEXTOLIVRE
                      WHERE TTCD=:DDTT
                      INTO TPTT;

               IF (TPTT = 1) THEN BEGIN
                  TIPO=4;
                  ITEM=1;
                  SELECT   0,  DSDZ,  DSRS FROM DIAG_RESULTTEXTOS --TEXTO BLOB
                  WHERE DSAM=:CONTA AND DSFR=:EXMM AND DSTT=:DDDZ
                  INTO :DESR, :DDDZ, :BLBS;
                  END ELSE BEGIN
                  TIPO=3;
                  ITEM=0;
                  SELECT DERS,  DEDZ FROM DIAG_RESULTVALORES
                  WHERE DEAM=:CONTA AND DEFR=:EXMM AND DETT=:DDTT
                  INTO  :TNDC, :DDDZ; BEGIN
[b]                        DESR= FORMATA(:TNDC, :DECI);
--                        DESR=:TNDC;[/b]
                        END
                  END
               END
             SUSPEND;
   END
  END



GOSTEI 0
Sremulador

Sremulador

07/12/2006

obs: no log que coloquei ele da este erro:

´1.0000´ is not a valid floating point value



GOSTEI 0
Sremulador

Sremulador

07/12/2006

Fiz um pequeno remendo e funcionou...

d := strtofloat(StringReplace(Str,´.´, ´,´, [rfReplaceAll]));


Obrigadão pela ajuda...


GOSTEI 0
POSTAR