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

[sir_wally_lewis]

so these functions look like:


procedure fbdatetopascaldate( ib_datetime : PISC_QUAD; VAR pscl_dt : TDATETIME 
);
var
  tm_date:Tm;


begin
  init_tm(tm_date); 
  isc_decode_date(ib_datetime,@tm_date); 
  pscl_dt := EncodeDate(tm_date.tmYear + 1900, tm_date.tm_mon + 1, 
tm_date.tm_mday )
+ EncodeTime(tm_date.tm_hour, tm_date.tm_min, tm_date.tm_sec, 0  );  
end;

procedure pascaldatetofbdate(  pscl_dt : TDATETIME; VAR ib_datetime : PISC_QUAD 
);
var
  tm_date:Tm;
  ,mm,dd,hh,nn,ss,zzz : word;


begin
  init_tm(tm_date); 
  decodedate(pscl_dt,,mm,dd);
  decodetime(pscl_dt,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 :=  - 1900;

  Creatsomemagicalmemoryforthepointer; 
  isc_encode_date(@tm_date,ib_dateTime); 
end;


Don't know how to create the memory though.
I use this function for strings:

function MakeResultString(Source, OptionalDest: PChar; Len: DWORD): PChar;
begin
  result := OptionalDest;
  if( Len = 0 )then
Len := StrLen(Source) + 1;
  if( result = nil )then
result := ib_util_malloc(Len);
  if( Source  result )then
begin
  if(Source = nil)or( Len = 1 )then
result[0] := #0
  else
Move(Source^, result^, Len);
end;
end;


Kind Regards,

Robert.

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;
   ,mm,dd,hh,nn,ss,zzz : word;

begin
   init_tm(tm_date);
   decodedatetime(pscl_dt,,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 := -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

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

[sir_wally_lewis]

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 );


Kind Regards,

Robert.


--- In firebird-support@yahoogroups.com, Frank Schlottmann-Gödde frank@... 
wrote:

 On 07.10.2011 10:44, sir_wally_lewis wrote:
  Has anyone successfully written a pascal UDF
  to pass timestamps/strings without using
  the ibobjects library?
 
 Yes, what problems do you face?
 
 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