Subject | Re: File seek to external "file of records" within UDF |
---|---|
Author | phil_henningsen |
Post date | 2006-04-22T01:45:23Z |
Oh, so sorry, my bad. In the class of "rtfm" (read the darn manual!)
The fix is:
wYr := tm_date.tm_year+1900; // rtfm!
which caused "iFilePos" in the "offending code" to be negative and all
hell broke loose.
Phil
--- In firebird-support@yahoogroups.com, "phil_henningsen"
<PHenningsen@...> wrote:
The fix is:
wYr := tm_date.tm_year+1900; // rtfm!
which caused "iFilePos" in the "offending code" to be negative and all
hell broke loose.
Phil
--- In firebird-support@yahoogroups.com, "phil_henningsen"
<PHenningsen@...> wrote:
>('ari','tau','gem','can','leo','vir','lib','sco','sag','cap','aqu','pis');
> 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 =
>
> 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,('Aries','Taurus','Gemini','Cancer','Leo','Virgo','Libra','Scorpio','Sagittarius','Capricorn','Aquarius','Pisces');
> 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 =
>
> 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.
>