[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