Error UDF realizada en Delphi

[morta71]

Hola a todos,

estoy escribiendo mi primera UDF en Delphi para calcular la edad de una persona y la muestre en una vista. La función tiene el siguiente código fuente:

Código Delphi [-]
uses
  Windows, Messages, SysUtils, Controls;

type
   {InterBase Date/Time Record}
   ISC_QUAD = record
      isc_quad_high : Integer ;  // Date
      isc_quad_low  : Cardinal ; // Time
      end;
   PISC_QUAD = ^ISC_QUAD;

  function CalculaEdad(var IBDate: PISC_QUAD): Integer; stdcall;

implementation

function CalculaEdad(var IBDate: PISC_QUAD): Integer;
var
   iTemp,iTemp2,Nada:word;
   Fecha: TDate;
begin
  Fecha := IBDate^.isc_quad_high;

  if Fecha = 0 then Result := 0
  else
  begin
    DecodeDate(Date,itemp,Nada,Nada);
    DecodeDate(Fecha,itemp2,Nada,Nada);
     if FormatDateTime('mmdd',Date) <
        FormatDateTime('mmdd',Fecha) then Result:=iTemp-iTemp2-1
                                     else Result:=iTemp-iTemp2;
  end;
end;

end.

Para importarla a FIREBIRD, utilizo el siguiente script:

Código SQL [-]
DECLARE EXTERNAL FUNCTION GETEDAD
    TIMESTAMP
RETURNS INTEGER BY VALUE
ENTRY_POINT 'CalculaEdad' MODULE_NAME 'MiUDF'

Y la Vista es algo como

Código SQL [-]
SELECT GETEDAD(F_NACIMIENTO) AS EDAD FROM PERSONAS

El Caso es que, probandolo en el IBExpert, retorna siempre éste error:

Error Message:
----------------------------------------
Unsuccessful execution caused by a system error that precludes
successful execution of subsequent statements.
Error writing data to the connection.


Ya no sé que variaciones realizar, he intentado varias formas y no hay manera.

Os agradecería vuestras sugerencias al respecto, ¿qué hago mla? Gracias

[morta71]

Me respondo yo mismo, ya encontré la solución ... buf, aquí queda para quien le pueda servir.

Añadí la siguiente unidad con las definiciones que me hacian falta:

Código Delphi [-]
unit fb_tools;

interface

const
  IBASE_DLL='FBCLIENT.DLL';

type
  Int                  = LongInt; // 32 bit signed
  DWord                = Cardinal; // 32 bit unsigned
  UInt                 = DWord;   // 32 bit unsigned
  Long                 = LongInt; // 32 bit signed
  ULong                = DWord;   // 32 bit unsigned

  TM = record
    tm_sec : integer;   // Seconds
    tm_min : integer;   // Minutes
    tm_hour : integer;  // Hour (0--23)
    tm_mday : integer;  // Day of month (1--31)
    tm_mon : integer;   // Month (0--11)
    tm_year : integer;  // Year (calendar year minus 1900)
    tm_wday : integer;  // Weekday (0--6) Sunday = 0)
    tm_yday : integer;  // Day of year (0--365)
    tm_isdst : integer; // 0 if daylight savings time is not in effect)
  end;
  PTM             = ^TM;

  ISC_TIMESTAMP = record
    timestamp_date : Integer;
    timestamp_time : Cardinal;
  end;
  PISC_TIMESTAMP = ^ISC_TIMESTAMP;
  
procedure isc_encode_timestamp  (tm_date                    : PTM;
                                 ib_date                    : PISC_TIMESTAMP);
                                stdcall; external IBASE_DLL;
procedure isc_decode_timestamp  (ib_date: PISC_TIMESTAMP;
                                 tm_date: PTM);
                                stdcall; external IBASE_DLL;

procedure isc_decode_sql_date   (var ib_date: Long;
                                 tm_date: PTM);
                                stdcall; external IBASE_DLL;
procedure isc_encode_sql_date   (tm_date: PTM;
                                 var ib_date: Long);
                                stdcall; external IBASE_DLL;

procedure isc_decode_sql_time   (var ib_date: ULong;
                                 tm_date: PTM);
                                stdcall; external IBASE_DLL;
procedure isc_encode_sql_time   (tm_date: PTM;
                                 var ib_date: ULong);
                                stdcall; external IBASE_DLL;
implementation

end.

Así el código de la librería queda

Código Delphi [-]
library free_fbudf;

uses
  SysUtils,
  Classes,
  Global in 'Global.pas',
  fb_tools in 'fb_tools.pas';

{$R *.RES}

exports
  CalculaEdad;

begin
  isMultiThread := True;
end.

Código Delphi [-]
unit Global;

interface

uses
  Windows, Messages, SysUtils, Controls, fb_tools;

  function CalculaEdad(var ib_date: Long): Integer; stdcall;

implementation

function CalculaEdad(var ib_date: Long): Integer;
var
  iTemp,iTemp2,Nada:word;
  Fecha: TDate;
  tm_date: TM;
begin
  isc_decode_sql_date(ib_date, @tm_date);

  Fecha := EncodeDate(tm_date.tm_year + 1900, tm_date.tm_mon + 1, tm_date.tm_mday);

  if Fecha = 0 then Result := 0
  else
  begin
    DecodeDate(Date,itemp,Nada,Nada);
    DecodeDate(Fecha,itemp2,Nada,Nada);
     if FormatDateTime('mmdd',Date) <
        FormatDateTime('mmdd',Fecha) then Result:=iTemp-iTemp2-1
                                     else Result:=iTemp-iTemp2;
  end;
end;

end.

La declaración de la función en Firebird será la siguiente:

Código SQL [-]
DECLARE EXTERNAL FUNCTION GETEDAD
    DATE
RETURNS INTEGER BY VALUE
ENTRY_POINT 'CalculaEdad' MODULE_NAME 'free_fbudf'

Funciona correctamente, tan sólo queda contemplar aquellos casos en que la fecha de nacimeinto almacenada en la base de datos tenga un valor NULL.