Subject | Re: [firebird-support] Re: Pascal UDF passing timestamps/strings |
---|---|
Author | Frank Schlottmann-Gödde |
Post date | 2011-10-11T13:43:25Z |
On 11.10.2011 09:22, sir_wally_lewis wrote:
<---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
> 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