Error UDF realizada en Delphi
 

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

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.