Ver Mensaje Individual
  #2  
Antiguo 11-02-2007
Avatar de morta71
morta71 morta71 is offline
Miembro
 
Registrado: may 2006
Ubicación: Girona - España
Posts: 30
Reputación: 0
morta71 Va por buen camino
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.
Responder Con Cita