Re: [firebird-support] Re: Pascal UDF passing timestamps/strings

[Frank Schlottmann-Gödde]

On 11.10.2011 09:22, sir_wally_lewis wrote:
> so these functions look like:

You will need :

<---ib_util.pp--->
{
$Id: ib_util.pp,v 1.2 2000/10/26 07:09:13 frank Exp $

You will need this if you wish to use FREEIT, but
who will want to do this?
}
unit ib_util;
interface

function ib_util_malloc(_para1:longint):pointer;cdecl;external 'ib_util';

implementation


end.


then the following code should work

<---------------------------------------------------------------------------------->
library fpc_udf_dt;
{$mode objfpc}
{$PACKRECORDS C}

uses ib_util,sysutils,dateutils;

{$linklib fbclient}  {I only need isc_decode_date at the moment}

type

  isc_quad= record
              isc_low:longint;
              isc_high:dword;
             end;

  pisc_quad=^isc_quad;

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

procedure isc_decode_date(_para1:PISC_QUAD; _para2:pointer); cdecl; 
external;
procedure isc_encode_date(_para1:pointer; _para2:PISC_QUAD); cdecl; 
external;

procedure init_tm(var tm_date:Tm);
begin
   with tm_date do
   begin
    tm_sec    := 0;
    tm_min    := 0;
    tm_hour   := 0;
    tm_mday   := 0;
    tm_mon    := 0;
    tm_year   := 0;
    tm_wday   := 0;
    tm_yday   := 0;
    tm_isdst  := 0;
    tm_gmtoff{.low} := 0;
  {  tm_gmtoff.high:= 0; }
   end;
end;


{
/*Converts a Firebird datetime value to a pascal tdatetime*/
DECLARE EXTERNAL FUNCTION dt_topas
         date.
         RETURNS double precision by value
         ENTRY_POINT 'dt_topas' MODULE_NAME 'libfpc_udf_dt.so';
}

function fbdatetopascaldate( ib_datetime : PISC_QUAD):double;cdecl;export;
var
   tm_date:Tm;
begin
   init_tm(tm_date);
   isc_decode_date(ib_datetime,@tm_date);
   result:= EncodeDateTime(tm_date.tm_Year + 1900, tm_date.tm_mon + 1, 
tm_date.tm_mday,tm_date.tm_hour, tm_date.tm_min, tm_date.tm_sec, 0  );
end;


{
/*Converts a Firebird datetime value to a pascal tdatetime*/
DECLARE EXTERNAL FUNCTION dt_topas
         date.
         RETURNS double precision by value
         ENTRY_POINT 'dt_topas' MODULE_NAME 'libfpc_udf_dt.so';


}

function  pascaldatetofbdate(var pscl_dt : double):PISC_QUAD;cdecl;export;
var
   tm_date:Tm;
   yyyy,mm,dd,hh,nn,ss,zzz : word;

begin
   init_tm(tm_date);
   decodedatetime(pscl_dt,yyyy,mm,dd,hh,nn,ss,zzz);
   tm_date.tm_min  := nn;
   tm_date.tm_hour := hh;
   tm_date.tm_sec  := ss;
   tm_date.tm_mday := dd;
   tm_date.tm_mon  := mm-1;
   tm_date.tm_year := yyyy-1900;
   result:=ib_util_malloc(sizeof(ISC_QUAD));
   isc_encode_date(@tm_date,result);
end;

exports
  fbdatetopascaldate name 'dt_topas',
  pascaldatetofbdate name 'dt_tofb';
end.
<----------------------------------------------------------------------->

mit freundlichen Grüßen
Frank Schlottmann-Gödde

-- 
"Fascinating creatures, phoenixes, they can carry immensely heavy loads,
   their tears have healing powers and they make highly faithful pets."
       - J.K. Rowling