[firebase-br] UDF's

Marcos Thomaz (Prog_CPD) thomazs em ufac.br
Qui Set 22 17:10:00 -03 2005


Pessoal, aproveitando os códigos de algumas UDF's já existentes, fiz uma UDF
assim:

//Arquivo uTiposAuxiliares
type
  TDateRec = record
    Year: SmallInt;
    Month: SmallInt;
    Day: SmallInt;
  end;

  TTimeRec = record
    Hour: SmallInt;
    Minute: SmallInt;
    Second: SmallInt;
  end;

  TTSRec = record
    Date: TDateRec;
    Time: TTimeRec;
  end;

  TFBDate = integer;
  TFBTime = Cardinal;

  { FireBird TimeStamp record }
  TFBTS = packed record
    Date: TFBDate;
    Time: TFBTime;
  end;

  PFBTS = ^TFBTS;

  function DateRec(const Year, Month, Day: SmallInt): TDateRec;
  function FBDecDate(T: TFBDate): TDateRec;

implementation

function DateRec(const Year, Month, Day: SmallInt): TDateRec;
begin
  Result.Year := Year;
  Result.Month := Month;
  Result.Day := Day;
end;

function FBDecDate(T: TFBDate): TDateRec;
var
  Century, Y, M, D: integer;
begin
  T := T - (1721119 - 2400001);
  Century := (4 * T - 1) div 146097;
  T := 4 * T - 1 - 146097 * Century;
  D := T div 4;
  T := (4 * D + 3) div 1461;
  D := 4 * D + 3 - 1461 * T;
  D := (D + 4) div 4;
  M := (5 * D - 3) div 153;
  D := 5 * D - 3 - 153 * M;
  D := (D + 5) div 5;
  Y := 100 * Century + T;

  if M < 10 then
    M := M + 3
  else begin
    M := M - 9;
    Y := Y + 1;
  end;

  Result.Year := Y;
  Result.Month := M;
  Result.Day := D;
end;


//Código fonte da DLL
library MyFBUDF;

uses
  SysUtils,
  Classes,
  Math,
  uTiposAuxiliares in 'uTiposAuxiliares.pas';

{$R *.res}

function UDF_ANOMESS(ret:PChar;T: PFBTS)cdecl; export;
var
  MesI,AnoI:SmallInt;
  MesS,AnoS:String;
begin
  MesI := FBDecDate(T^.Date).Month;
  AnoI := FBDecDate(T^.Date).Year;
  MesS := IntToStr(MesI);
  if MesI < 10 then
    MesS := '0'+MesS;
  AnoS := IntToStr(AnoI);
  StrPCopy( Ret , AnoS+MesS );
end;

exports
  UDF_ANOMESS;
begin
end.



Ela registra no IBExpert legal, mas quando vou usá-la, ela dá um erro louco,
me retornando a grid em branco, e em seguida, simplesmente trava o IBExpert.
O que tem de errado??





Mais detalhes sobre a lista de discussão lista