I would very much like to do a seek to and read from a direct file
position in a "file of records" from within a Firebird UDF.

I've used similar code in ISAPI DLLs with no problem.

Using WinXP, Firebird 1.5 and Delphi 7. This is my first UDF in years
& years and the first to try to read an external file.

The offending code is:

function GetPlanetsFromPlanataryTable(BD: TDateTime): string;
var
iFilePos: integer;
aPTRecord: ptRecord;
begin
PTFileCritSec.Acquire;
try{1}
Result := '';
try{2}
iFilePos := Trunc(BD-FPTBaseDate); // relative record position
System.Seek(FPTFile,iFilePos); // <<=== this fails
Read(FPTFile,aPTRecord);
Result := Trim(aPTRecord.ptData);
//Result := '12/29/1939 277 259 306 356 1 24 -48 -176 -122 -206
-108 341 -26';
except{2}
on E:Exception do
raise Exception.Create('Error reading Planetary Table:
'+E.Message);
end;{2}
finally{1}
PTFileCritSec.Release;
end;{1}
end;

Many thanks,

Phil Henningsen

//-------------------------------
The *entire* unit is (sorry about this):

unit ta_udf_1;
(*
Copyright 2006 ZDK Interactive, Inc (dba The Astrologer), San
Francisco, CA

Fearlessly descended from FreeUDFLib. Many thanks to Greg Deatz.

To install or update:
1. Compile
2. Stop Firebird Server
3. Copy C:\home\zdk\dist\lib\ta_udf.dll to C:\Program
Files\Firebird\Firebird_1_5\UDF
4. Start Firebird Guardian
5. Verify that all UDFs are properly defined to TA_FAMOUS.GDB
*)

interface

uses
SysUtils, Classes, ib_externals, ibase, SyncObjs;

//====================================== Type Definitions
======================
//=----------------------------------------- Constants
-------------------------
// 7/11/05 changed from PT01 to PT02, which adds South Node
const
ciPTRecordLength = 80; // for PT02, PT01=70
ciNumSigns = 12;
ciNumPlanets = 13; // (sic) aka "Astrological Objects" (note
that moon is omitted)
ciNumAspects = 6; // only the ones that we care about
caShortSigns: array[1..ciNumSigns] of string =
('ari','tau','gem','can','leo','vir','lib','sco','sag','cap','aqu','pis');
caShortPlanets: array[1..ciNumPlanets] of string =
('sun','mer','ven','mar','jup','sat','ura','nep','plu','t.n','chi','jun','s.n');
caPlanetScores: array[1..ciNumPlanets] of integer = ( 28, 25,
33, 30, 24, 22, 20, 21, 26, 19, 0, 31, 17);
caShortAspects: array[1..ciNumAspects] of string =
('con','sex','squ','tri','qui','opp');
caAspectScores: array[1..ciNumAspects] of integer = ( 33, 20,
10, 30, 5, 15);
caLongSigns: array[1..ciNumSigns] of string =
('Aries','Taurus','Gemini','Cancer','Leo','Virgo','Libra','Scorpio','Sagittarius','Capricorn','Aquarius','Pisces');
caLongPlanets: array[1..ciNumPlanets] of string =
('Sun','Mercury','Venus','Mars','Jupiter','Saturn','Uranus','Neptune','Pluto','North
Node','Chiron','Juno','South Node');
caLongAspects: array[1..ciNumAspects] of string =
('Conjunct','Sextile','Square','Trine','Quincunx','Opposition');

//=----------------------------------------- ptRecord
--------------------------
type
ptRecord = record
ptData: string[ciPTRecordLength];
end;
(*
Contains one line for each date
Each line contains the planetary positions rounded to whole degrees
(negative means Retrograde)
for Sun thru Pluto (no Moon), True Node, Chiron & Juno
; date sun mer ven mar jup sat ura nep plu t.n chi jun
12/01/1950 248 138 264 252 289 330 181 -99 199 -140 -355 263
*)

//=----------------------------------------- Globals
---------------------------
// these are really global constants that are set during initialization
var
PTFileCritSec: TCriticalSection;
FPTPath: string; // path to Planetary Table
FPTFile: file of ptRecord;
FPTBaseDate: TDateTime;
FPTMaxDate: TDateTime;

//=----------------------------------------- UDFs
------------------------------
function GetPlanetsFromPlanataryTable(BD: TDateTime): string;
function GetPlanetsPosition(ShortPlanet, ptData: string): integer;
function CnvtPositionToSignIndex(Position: integer): integer;
//
function ta_score_1(var Method: integer): integer; cdecl;
function ta_score_2(var Method: integer; ib_date_1, ib_date_2:
PISC_QUAD): integer; cdecl;
function ta_sign_index(ib_date: PISC_QUAD): integer; cdecl;
function ta_sign_name(ib_date: PISC_QUAD): PChar; cdecl;

//====================================== Implementation
========================
implementation

uses udf_glob, taUtils;

//====================================== Subroutines
===========================
//=-----------------------------------------
GetPlanetsFromPlanataryTable ------
// see more doc in taReports
function GetPlanetsFromPlanataryTable(BD: TDateTime): string;
var
iFilePos: integer;
aPTRecord: ptRecord;
begin
PTFileCritSec.Acquire;
try{1}
Result := '';
try{2}
iFilePos := Trunc(BD-FPTBaseDate); // relative record position
System.Seek(FPTFile,iFilePos); // <<=== this fails
Read(FPTFile,aPTRecord);
Result := Trim(aPTRecord.ptData);
//Result := '12/29/1939 277 259 306 356 1 24 -48 -176 -122 -206
-108 341 -26';
except{2}
on E:Exception do
raise Exception.Create('Error reading Planetary Table:
'+E.Message);
end;{2}
finally{1}
PTFileCritSec.Release;
end;{1}
end;

//=----------------------------------------- GetPlanetsPosition
----------------
function GetPlanetsPosition(ShortPlanet, ptData: string): integer;
// get a planet's position from PTData
var
sRem, s1: string;
iX, iDeg: integer;
begin
Result := -1;
sRem := ptData;
SplitString(sRem,' ',s1,sRem); // s1 = birthdate
for iX := 1 to ciNumPlanets do
begin
SplitString(sRem,' ',s1,sRem);
if LowerCase(ShortPlanet) = caShortPlanets[iX] then
begin
iDeg := Abs(StrToIntDef(s1,0));
if iDeg = 360 then iDeg := 0;
Result := iDeg;
Break;
end;
end;
end;

//=----------------------------------------- CnvtPositionToSignIndex
-----------
function CnvtPositionToSignIndex(Position: integer): integer;
begin
Result := Position div 30;
end;

//====================================== UDFs
==================================
//=----------------------------------------- ta_score_1
------------------------
function ta_score_1(var Method: integer): integer;
begin
Result := Method;
end;

//=----------------------------------------- ta_score_2
------------------------
function ta_score_2(var Method: integer; ib_date_1, ib_date_2:
PISC_QUAD): integer;
var
tm_date_1, tm_date_2: tm;
begin
isc_decode_date(ib_date_1, @tm_date_1);
isc_decode_date(ib_date_2, @tm_date_2);
Result := tm_date_2.tm_mday;
end;

//=----------------------------------------- ta_sign_index
---------------------
function ta_sign_index(ib_date: PISC_QUAD): integer;
var
tm_date: tm;
wYr, wMo, wDa: Word;
dtTemp: TDateTime;
ptData: string;
iSign: integer;
begin
isc_decode_date(ib_date, @tm_date);
wYr := tm_date.tm_year;
wMo := tm_date.tm_mon+1;
wDa := tm_date.tm_mday;
dtTemp := EncodeDate(wYr, wMo, wDa);
try
ptData := GetPlanetsFromPlanataryTable(dtTemp);
iSign := GetPlanetsPosition('sun',ptData) div 30;
Result := iSign+1;
except
Result := -1;
end;
end;

//=----------------------------------------- ta_sign_name
----------------------
function ta_sign_name(ib_date: PISC_QUAD): PChar;
var
iSign: integer;
begin
iSign := ta_sign_index(ib_date);
if iSign > 0 then
Result := PChar(caLongSigns[iSign])
else
Result := 'Error';
end;

//====================================== Initialization
========================
initialization
IsMultiThread := True;
if PTFileCritSec = nil then
begin
PTFileCritSec := TCriticalSection.Create;
FPTBaseDate := StrToDate('01/01/1900');
FPTMaxDate := StrToDate('01/01/2020')-1; // now 120 years
try
AssignFile(FPTFile, 'C:\home\zdk\dist\data\PT02_1900.dat');
FileMode := 0; // Set file access to read only
Reset(FPTFile);
except
on E:Exception do
raise Exception.Create('Error opening Planetary Table
"C:\home\zdk\dist\data\PT02_1900.dat": '+E.Message);
end;
end;

//====================================== Finalization
==========================
finalization
CloseFile(FPTFile);
PTFileCritSec.Free;
PTFileCritSec := nil;

end.