On 07.10.2011 18:32, sir_wally_lewis wrote:
>
> as far as i can see to do the task.
> i must import isc_decode_date/isc_encode_date from fbclient library
>
> however as soon as i call a function that connects to these methods the
> connection crashes.
>
> also a major hurdle is no real way of debugging the dll as to why
> it would cause the firebird connection to abort.
>
> Kind Regards,
>
> Robert.
>
> really what i need is a failsafe way of writing these functions
>
>
> procedure fbdatetopascaldate( VAR ISCQUAD; VAR TDATETIME );
> procedure pascaldatetofbfate( VAR PISCQUAD; VAR TDATETIME );
As starting point I have attached some examples that I wrote a long time
ago for FreePascal.
This version works for me with Firebird 2.5
hth
Frank
<---------------code-------------------------------------->
{
$Id: fpc_udf_dt.pp,v 1.2 2000/10/26 07:09:13 frank Exp $
(C)2000 Frank Schlottmann-Goedde
time/date handling
user defined functions (UDF)
for Interbase 6.0 SS for Linux
use at your own risc
}
library fpc_udf_dt;
{$mode objfpc}
{$PACKRECORDS C}
uses ib_util;
{$linklib fbclient} {I only need isc_decode_date at the moment}
type
isc_quad= record
low:longint;
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;
function dt_Month(ib_date: PISC_QUAD): longint;cdecl;export;
var
tm_date:Tm;
begin
init_tm(tm_date);
isc_decode_date(ib_date,@tm_date);
result :=tm_date.tm_mon+1;
end;
function dt_Day(ib_date: PISC_QUAD): longint;cdecl;export;
var
tm_date:Tm;
begin
init_tm(tm_date);
isc_decode_date(ib_date,@tm_date);
result :=tm_date.tm_mday;
end;
function dt_Year(ib_date: PISC_QUAD): longint;cdecl;export;
var
tm_date:Tm;
begin
init_tm(tm_date);
isc_decode_date(ib_date,@tm_date);
result :=tm_date.tm_year+1900;
end;
function dt_MaxDate(ib_d1, ib_d2: PISC_QUAD):PISC_QUAD;cdecl;export;
var
tm1,tm2:TM;
begin
result:=ib_util_malloc(sizeof(ISC_QUAD));
result^:=ib_d1^;
end;
exports
dt_year name 'dt_year',
dt_day name 'dt_day',
dt_month name 'dt_month',
dt_MaxDate name 'dt_maxdate';
end.
<----------------------------------------------------------------------------------------->
<-----------------------Makefile---------------------------------------------------------->
#$Id: Makefile,v 1.2 2000/10/26 07:09:13 frank Exp $
# Path to Free Pascal compiler
BP = /usr/bin/ppc386
# where is install
INSTALL = /usr/bin/ginstall -c
# where to install the libraries
UDFDIR =/usr/local/firebird/UDF
all: intlib strlib bloblib dtlib
strlib: libfpc_udf_str.so
intlib: libfpc_udf_int_math.so
bloblib:libfpc_udf_blob.so
dtlib:libfpc_udf_dt.so
libfpc_udf_blob.so: fpc_udf_blob.pp
$(BP) fpc_udf_blob.pp
libfpc_udf_dt.so: fpc_udf_dt.pp
$(BP) fpc_udf_dt.pp
libfpc_udf_str.so: fpc_udf_str.pp
$(BP) fpc_udf_str.pp
libfpc_udf_int_math.so: fpc_udf_int_math.pp
$(BP) fpc_udf_int_math.pp
install: all
install -g root -o root -m 750 -s libfpc_udf_str.so $(UDFDIR)
install -g root -o root -m 750 -s libfpc_udf_int_math.so $(UDFDIR)
install -g root -o root -m 750 -s libfpc_udf_blob.so $(UDFDIR)
install -g root -o root -m 750 -s libfpc_udf_dt.so $(UDFDIR)
#END
<---------------------------------------------------------------------------------------------->
<------------------------------UDFDeclaration-------------------------------------------------->
/*$Id: udf_dt.sql,v 1.3 2000/10/26 07:11:18 frank Exp $*/
/* Returns month from a timestamp */
DECLARE EXTERNAL FUNCTION dt_month
date
RETURNS integer by value
ENTRY_POINT 'dt_month' MODULE_NAME 'libfpc_udf_dt.so';
/* Returns day from a timestamp */
DECLARE EXTERNAL FUNCTION dt_day
date
RETURNS integer by value
ENTRY_POINT 'dt_day' MODULE_NAME 'libfpc_udf_dt.so';
/* Returns year from a timestamp */
DECLARE EXTERNAL FUNCTION dt_year
date
RETURNS integer by value
ENTRY_POINT 'dt_year' MODULE_NAME 'libfpc_udf_dt.so';
/*Returns the maximum of the two dates (had to use FREE_IT to get it to
work*/
DECLARE EXTERNAL FUNCTION dt_maxdate
date,date
RETURNS date FREE_IT
ENTRY_POINT 'dt_maxdate' MODULE_NAME 'libfpc_udf_dt.so';
<------------------------------------------------------------------------------------------------>
--
"Fascinating creatures, phoenixes, they can carry immensely heavy loads,
their tears have healing powers and they make highly faithful pets."
- J.K. Rowling
----------
{
$Id: fpc_udf_dt.pp,v 1.2 2000/10/26 07:09:13 frank Exp $
(C)2000 Frank Schlottmann-Goedde
time/date handling
user defined functions (UDF)
for Interbase 6.0 SS for Linux
use at your own risc
}
library fpc_udf_dt;
{$mode objfpc}
{$PACKRECORDS C}
uses ib_util;
{$linklib fbclient} {I only need isc_decode_date at the moment}
type
isc_quad= record
low:longint;
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;
function dt_Month(ib_date: PISC_QUAD): longint;cdecl;export;
var
tm_date:Tm;
begin
init_tm(tm_date);
isc_decode_date(ib_date,@tm_date);
result :=tm_date.tm_mon+1;
end;
function dt_Day(ib_date: PISC_QUAD): longint;cdecl;export;
var
tm_date:Tm;
begin
init_tm(tm_date);
isc_decode_date(ib_date,@tm_date);
result :=tm_date.tm_mday;
end;
function dt_Year(ib_date: PISC_QUAD): longint;cdecl;export;
var
tm_date:Tm;
begin
init_tm(tm_date);
isc_decode_date(ib_date,@tm_date);
result :=tm_date.tm_year+1900;
end;
function dt_MaxDate(ib_d1, ib_d2: PISC_QUAD):PISC_QUAD;cdecl;export;
var
tm1,tm2:TM;
begin
result:=ib_util_malloc(sizeof(ISC_QUAD));
result^:=ib_d1^;
end;
exports
dt_year name 'dt_year',
dt_day name 'dt_day',
dt_month name 'dt_month',
dt_MaxDate name 'dt_maxdate';
end.
----------
#$Id: Makefile,v 1.2 2000/10/26 07:09:13 frank Exp $
# Path to Free Pascal compiler
BP = /usr/bin/ppc386
# where is install
INSTALL = /usr/bin/ginstall -c
# where to install the libraries
UDFDIR =/usr/local/firebird/UDF
all: intlib strlib bloblib dtlib
strlib: libfpc_udf_str.so
intlib: libfpc_udf_int_math.so
bloblib:libfpc_udf_blob.so
dtlib:libfpc_udf_dt.so
libfpc_udf_blob.so: fpc_udf_blob.pp
$(BP) fpc_udf_blob.pp
libfpc_udf_dt.so: fpc_udf_dt.pp
$(BP) fpc_udf_dt.pp
libfpc_udf_str.so: fpc_udf_str.pp
$(BP) fpc_udf_str.pp
libfpc_udf_int_math.so: fpc_udf_int_math.pp
$(BP) fpc_udf_int_math.pp
install: all
install -g root -o root -m 750 -s libfpc_udf_str.so $(UDFDIR)
install -g root -o root -m 750 -s libfpc_udf_int_math.so $(UDFDIR)
install -g root -o root -m 750 -s libfpc_udf_blob.so $(UDFDIR)
install -g root -o root -m 750 -s libfpc_udf_dt.so $(UDFDIR)
#END
[Non-text portions of this message have been removed]
