home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / btree / btriev14 / btp.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-10-27  |  29.7 KB  |  824 lines
  1. UNIT BTP;   {Version 1.4  10/27/91                      (C) 1991 John C. Leon}
  2.  
  3. {$A+}    {word alignment.  Btrieve interface call wants this global directive
  4.           set; is the default compiler setting anyway.                       }
  5.  
  6. INTERFACE
  7. (* ------------------------------------------------------------------------ *)
  8. (* ------------------------------------------------------------------------ *)
  9. USES Objects, Memory;
  10.  
  11. CONST
  12. {      Key Attributes            Key Types          Open Modes               }
  13. {    ------------------      ----------------     ---------------            }
  14.      Duplicates   =   1;     BString    =  0;     Normal    =  0;
  15.      Modifiable   =   2;     BInteger   =  1;     Accel     = -1;
  16.      Binary       =   4;     BFloat     =  2;     ReadOnly  = -2;
  17.      Null         =   8;     BDate      =  3;     Verify    = -3;
  18.      Segmented    =  16;     BTime      =  4;     Exclusive = -4;
  19.      AltCol       =  32;     BDecimal   =  5;
  20.      Descending   =  64;     BMoney     =  6;
  21.      Supplemental = 128;     BLogical   =  7;
  22.      ExtType      = 256;     BNumeric   =  8;
  23.                              BBFloat    =  9;
  24.                              BLString   = 10;
  25.                              BZString   = 11;
  26.                              BUnsBinary = 14;
  27.                              BAutoInc   = 15;
  28.  
  29. {              Btrieve Op Codes                          Misc                }
  30. {  -----------------------------------------   -------------------------     }
  31.    BOpen      =  0;       BAbortTran   = 21;   Zero        : integer = 0;
  32.    BClose     =  1;       BGetPos      = 22;   NotRequired : integer = 0;
  33.    BInsert    =  2;       BGetDir      = 23;
  34.    BUpdate    =  3;       BStepNext    = 24;  {      Error Codes        }
  35.    BDelete    =  4;       BStop        = 25;  {-------------------------}
  36.    BGetEqual  =  5;       BVersion     = 26;   FileNotOpen      =  3;
  37.    BGetNext   =  6;       BUnlock      = 27;   InvalidKeyNumber =  6;
  38.    BGetPrev   =  7;       BReset       = 28;   DiffKeyNumber    =  7;
  39.    BGetGr     =  8;       BSetOwner    = 29;   InvalidPosition  =  8;
  40.    BGetGrEq   =  9;       BClrOwner    = 30;   EndofFile        =  9;
  41.    BGetLess   = 10;       BCrSuppIdx   = 31;   FileNotFound     = 12;
  42.    BGetLessEq = 11;       BDropSuppIdx = 32;   DataBufferLength = 22;
  43.    BGetFirst  = 12;       BStepFirst   = 33;   RejectCount      = 60;
  44.    BGetLast   = 13;       BStepLast    = 34;   IncorrectDesc    = 62;
  45.    BCreate    = 14;       BStepPrev    = 35;   FilterLimit      = 64;
  46.    BStat      = 15;       BGetNextExt  = 36;   IncorrectFldOff  = 65;
  47.    BExtend    = 16;       BGetPrevExt  = 37;   LostPosition     = 82;
  48.    BSetDosDir = 17;       BStepNextExt = 38;
  49.    BGetDosDir = 18;       BStepPrevExt = 39;
  50.    BBegTran   = 19;       BInsertExt   = 40;
  51.    BEndTran   = 20;       BGetKey      = 50;
  52.  
  53. {  Extended Ops Comp Codes/Bias           Extended Ops Logic Constants       }
  54. {  -----------------------------       -----------------------------------   }
  55.    Equal      : byte =   1;            NoFilter   : integer = 0;
  56.    GreaterThan: byte =   2;            LastTerm   : byte    = 0;
  57.    LessThan   : byte =   3;            NextTermAnd: byte    = 1;
  58.    NotEqual   : byte =   4;            NextTermOr : byte    = 2;
  59.    GrOrEqual  : byte =   5;
  60.    LessOrEqual: byte =   6;
  61.    UseAltColl : byte =  32;
  62.    UseField   : byte =  64;
  63.    UseNoCase  : byte = 128;
  64.  
  65. {   Other Unit-Specific Constants   }
  66. { --------------------------------- }
  67.    MaxFixedRecLength   =  4090; {Btrieve limits fixed record length for std  }
  68.    MaxKBufferLength    =   255; {files to 4090.  Max key size is 255.        }
  69.    MaxExtDBufferLength = 32767;
  70.  
  71. TYPE
  72.  
  73. (* Data types for TRecMgr object *)
  74. (* ----------------------------- *)
  75.    TVersion    = record
  76.                     case integer of
  77.                     1: (Number : word;
  78.                         Rev    : integer;
  79.                         Product: char);
  80.                     2: (Entire : array[1..5] of char);
  81.                     end;
  82.    PRecMgr     = ^TRecMgr;
  83.    TRecMgr     = object(TObject)            {Base obj handles abort/begin/end}
  84.                     Version: TVersion;      {tran, reset, version and stop.  }
  85.                     VersionString: string;
  86.                     constructor Init;
  87.                     function BT(OpCode, Key: integer): integer; virtual;
  88.                     destructor Done; virtual;
  89.                     end;
  90.  
  91. (* Data types for BFile object *)
  92. (* --------------------------- *)
  93.    BFileName   = array[1..80] of char;    {79 + blank pad required by Btrieve}
  94.    PKeySpec    = ^KeySpec;
  95.    KeySpec     = record                     {data type for a Btrieve key spec}
  96.                     case integer of
  97.                     1: (KeyPos     : integer;
  98.                         KeyLen     : integer;
  99.                         KeyFlags   : integer;
  100.                         NotUsed    : array[1..4] of byte;
  101.                         ExtKeyType : byte;
  102.                         NullValue  : byte;
  103.                         Reserved   : array[1..4] of byte);
  104.                     2: (Entire     : array[1..16] of byte);
  105.                     end;
  106.    PFileSpec   = ^TFileSpec;
  107.    TFileSpec   = record
  108.                     case integer of
  109.                     1: (RecLen    : integer;
  110.                         PageSize  : integer;
  111.                         NumKeys   : integer;
  112.                         NumRecs   : array[1..2] of integer;
  113.                         FileFlags : integer;
  114.                         Reserved  : array[1..2] of char;
  115.                         PreAlloc  : integer;
  116.                         KeyArray  : array[0..23] of KeySpec);  {24=max # segs}
  117.                     2: (SpecBuf   : integer);  {used to refer to addr of spec}
  118.                     3: (Entire    : array[1..400] of byte);
  119.                     end;
  120.    PBFile      = ^BFile;
  121.    BFile       = object(TObject)
  122.                     DFileName  : FNameStr;                      {DOS filename}
  123.                     Specs      : TFileSpec;               {Btrieve file specs}
  124.                     NumRecs    : longint;             {# records at Init time}
  125.                     NumSegs    : integer;                   {total # key segs}
  126.                     PosBlk     : array[1..128] of char;       {position block}
  127.                     DBufferLen : integer;
  128.                     constructor Init(UserFileName:string; OpenMode: integer);
  129.                     function BT(OpCode, Key: integer): integer; virtual;
  130.                     function Open(OpenMode: integer):  integer; virtual;
  131.                     function Close: integer; virtual;
  132.                     destructor Done; virtual;
  133.                     private
  134.                     FileName   : BFileName;            {Btrieve-type filename}
  135.                     procedure ConvertName(UserFileName: string);
  136.                     end;
  137.  
  138. (* Data types for BFixed object - descendant of BFile *)
  139. (* -------------------------------------------------- *)
  140.    TDBuffer    = array[1..MaxFixedRecLength] of byte;
  141.    TKBuffer    = array[1..MaxKBufferLength] of byte;
  142.    PBFixed     = ^BFixed;
  143.    BFixed      = object(BFile)
  144.                     DBuffer: TDBuffer;
  145.                     KBuffer: TKBuffer;
  146.                     constructor Init(UserFileName:string; OpenMode: integer);
  147.                     function BT(OpCode, Key: integer): integer; virtual;
  148.                     destructor Done; virtual;
  149.                     end;
  150.  
  151. (* Data types for BFileExt object - descendant of BFile *)
  152. (* ---------------------------------------------------- *)
  153.    TCharArray  = array[1..255] of char;
  154.    THeader     = record
  155.                     case integer of
  156.                     1: (DBufferLen : integer;
  157.                         Constant   : array[1..2] of char);
  158.                     2: (Entire     : array[1..4] of byte);
  159.                     end;
  160.    TFilter     = record
  161.                     case integer of
  162.                     1: (MaxSkip       : integer;
  163.                         NumLogicTerms : integer);
  164.                     2: (Entire        : array[1..2] of integer);
  165.                     end;
  166.    TLogicTerm  = record
  167.                     FieldType  : byte;
  168.                     FieldLen   : integer;
  169.                     Offset     : integer;      {0 relative to start of record}
  170.                     CompCode   : byte;
  171.                     Expression : byte;  {0 last term,1 AND w/next,2 OR w/next}
  172.                     case FieldComp: boolean of
  173.                        True : (CompOffset: integer);
  174.                        False: (Value: TCharArray);{an arbitrary limitation of}
  175.                     end;                          {255 on length of values   }
  176.    PFilterSpec = ^TFilterSpec;
  177.    TFilterSpec = object(TObject)
  178.                     LogicTerm: TLogicTerm;
  179.                     constructor InitF(FieldType: byte; FieldLen, Offset:
  180.                                       integer; CompCode, Expression: byte;
  181.                                       FieldComp: boolean; CompOffset: integer);
  182.                     constructor InitV(FieldType: byte; FieldLen, Offset:
  183.                                       integer; CompCode, Expression: byte;
  184.                                       FieldComp: boolean; Value: TCharArray);
  185.                     destructor Done; virtual;
  186.                     end;
  187.    TExtractor  = record
  188.                     case integer of
  189.                     1: (NumRecords: integer;
  190.                         NumFields : integer);
  191.                     2: (Entire    : array[1..2] of integer);
  192.                     end;
  193.    TExtRepeater= record
  194.                     FieldLen: integer;
  195.                     Offset  : integer;
  196.                     end;
  197.    PExtSpec    = ^TExtSpec;
  198.    TExtSpec    = object(TObject)
  199.                     ExtRepeater: TExtRepeater;
  200.                     constructor Init(Len, Ofs: integer);
  201.                     destructor Done; virtual;
  202.                     end;
  203.    PExtDBuffer = ^TExtDBuffer;
  204.    TExtDBuffer = record
  205.                     case integer of
  206.                     1: (Header   : THeader;       {Buffer sent includes these}
  207.                         Filter   : TFilter);         {types at its beginning.}
  208.                     2: (NumRecs  : integer;               {Buffer rec'd looks}
  209.                         Repeater : array[1..32765] of char);      {like this.}
  210.                     {Repeater structure is: 2 for length of record image,    }
  211.                     {                       4 for currency position of rec,  }
  212.                     {                       n for record image itself        }
  213.                     3: (Entire   : array[1..32767] of byte);   {Whole buffer.}
  214.                     end;
  215.    PBFileExt   = ^BFileExt;
  216.    BFileExt    = object(BFile)
  217.                     Header        : THeader;
  218.                     Filter        : TFilter;
  219.                     FilterSpec    : PCollection;
  220.                     Extractor     : TExtractor;
  221.                     ExtractorSpec : PCollection;
  222.                     ExtDBuffer    : PExtDBuffer;
  223.                     constructor Init(UserFileName: string; OpenMode: integer);
  224.                     function BTExt(OpCode, Key: integer): integer; virtual;
  225.                     destructor Done; virtual;
  226.                     private
  227.                     procedure SetExtDBufferLen;
  228.                     procedure MakeExtDBuffer;
  229.                     end;
  230.  
  231.  
  232. (* PUBLIC/EXPORTED VARS *)
  233. (* -------------------- *)
  234. VAR
  235.      BStatus        : integer;
  236.      VarNotRequired : integer;                              {Dummy parameter.}
  237.      VarPosBlk      : array[1..128] of char;    {Dummy used in ops that don't}
  238.                                                 {pass/return position block. }
  239.  
  240. (* PUBLIC/EXPORTED FUNCTIONS *)
  241. (* ------------------------- *)
  242. {The Btrv function declared here is public, but should not ever be needed. It
  243.  is included in the public declaration only to be complete and give you
  244.  access to the standard call if you should need it.}
  245.  
  246. function Btrv(Op:integer; var Pos,Data; var DataLen:integer; var KBuf;
  247.               Key:integer): integer;
  248. function CreateFile(UserFileName:string; UserFileSpec:PFileSpec): integer;
  249. function LTrim(S: String): String;  {LTrim and RTrim were taken from one of }
  250. function RTrim(S: String): String;  {the Turbo Vision .PAS source files.    }
  251.  
  252.  
  253. IMPLEMENTATION
  254. (* ---------------------------------------------------------------------- *)
  255. (* ---------------------------------------------------------------------- *)
  256. uses Dos;{Dos unit needed for the Btrieve interface call (interrupts)      }
  257.  
  258. {$R-}     {Range checking off...is TP's default}
  259. {$B+}     {Boolean complete evaluation on...NOT a default, but apparently
  260.           required by the interface call.  Is turned off at end of Btrieve
  261.           interface definition}
  262. {$V-}    {Non-strict string var checking...Btrieve wants it so.  Strict
  263.           checking is turned back on at the end of the interface definition.}
  264.  
  265. (* BTRV Function...directly from the Btrieve distribution disks, w/comments
  266.    removed *)
  267. (* ----------------------------------------------------------------------- *)
  268. function Btrv(Op:integer; var Pos, Data; var DataLen:integer; var KBuf;
  269.               Key:integer): integer;
  270. const
  271.      VAR_ID          = $6176;
  272.      BTR_INT         = $7B;
  273.      BTR2_INT        = $2F;
  274.      BTR_OFFSET      = $0033;
  275.      MULTI_FUNCTION  = $AB;
  276.      ProcId: integer = 0;
  277.      MULTI: boolean  = false;
  278.      VSet: boolean   = false;
  279.  
  280. type
  281.      ADDR32 = record
  282.     OFFSET: word;
  283.     SEGMENT: word;
  284.      end;
  285.  
  286.      BTR_PARMS = record
  287.     USER_BUF_ADDR: ADDR32;
  288.     USER_BUF_LEN: integer;
  289.     USER_CUR_ADDR: ADDR32;
  290.     USER_FCB_ADDR: ADDR32;
  291.     USER_FUNCTION: integer;
  292.     USER_KEY_ADDR: ADDR32;
  293.     USER_KEY_LENGTH: BYTE;
  294.     USER_KEY_NUMBER: shortint;
  295.     USER_STAT_ADDR: ADDR32;
  296.     XFACE_ID: integer;
  297.      end;
  298.  
  299. var
  300.      STAT: integer;
  301.      XDATA: BTR_PARMS;
  302.      REGS: Dos.Registers;
  303.      DONE: boolean;
  304.  
  305. begin
  306.      REGS.AX := $3500 + BTR_INT;
  307.      INTR ($21, REGS);
  308.      if (REGS.BX <> BTR_OFFSET) then
  309.     STAT := 20
  310.      else
  311.     begin
  312.        if (not VSet) then
  313.           begin
  314.          REGS.AX := $3000;
  315.          INTR ($21, REGS);
  316.          if ((REGS.AX AND $00FF) >= 3) then
  317.             begin
  318.                VSet := true;
  319.                REGS.AX := MULTI_FUNCTION * 256;
  320.                INTR (BTR2_INT, REGS);
  321.                MULTI := ((REGS.AX AND $00FF) = $004D);
  322.             end
  323.          else
  324.             MULTI := false;
  325.           end;
  326.        with XDATA do
  327.           begin
  328.          USER_BUF_ADDR.SEGMENT := SEG (DATA);
  329.          USER_BUF_ADDR.OFFSET := OFS (DATA);
  330.          USER_BUF_LEN := DATALEN;
  331.          USER_FCB_ADDR.SEGMENT := SEG (POS);
  332.          USER_FCB_ADDR.OFFSET := OFS (POS);
  333.          USER_CUR_ADDR.SEGMENT := USER_FCB_ADDR.SEGMENT;
  334.          USER_CUR_ADDR.OFFSET := USER_FCB_ADDR.OFFSET+38;
  335.          USER_FUNCTION := OP;
  336.          USER_KEY_ADDR.SEGMENT := SEG (KBUF);
  337.          USER_KEY_ADDR.OFFSET := OFS (KBUF);
  338.          USER_KEY_LENGTH := 255;
  339.          USER_KEY_NUMBER := KEY;
  340.          USER_STAT_ADDR.SEGMENT := SEG (STAT);
  341.          USER_STAT_ADDR.OFFSET := OFS (STAT);
  342.          XFACE_ID := VAR_ID;
  343.           end;
  344.  
  345.        REGS.DX := OFS (XDATA);
  346.        REGS.DS := SEG (XDATA);
  347.  
  348.        if (NOT MULTI) then
  349.           INTR (BTR_INT, REGS)
  350.        else
  351.           begin
  352.          DONE := FALSE;
  353.          repeat
  354.             REGS.BX := ProcId;
  355.             REGS.AX := 1;
  356.             if (REGS.BX <> 0) then
  357.                REGS.AX := 2;
  358.             REGS.AX := REGS.AX + (MULTI_FUNCTION * 256);
  359.             INTR (BTR2_INT, REGS);
  360.             if ((REGS.AX AND $00FF) = 0) then
  361.                DONE := TRUE
  362.             else begin
  363.                REGS.AX := $0200;
  364.                INTR ($7F, REGS);
  365.                DONE := FALSE;
  366.             end;
  367.          until (DONE);
  368.          if (ProcId = 0) then
  369.             ProcId := REGS.BX;
  370.           end;
  371.        DATALEN := XDATA.USER_BUF_LEN;
  372. end;
  373.      BTRV := STAT;
  374. end;
  375. {$B-}
  376. {$V+}
  377.  
  378. (* BRECMGR.INIT Constructor *)
  379. (* ------------------------ *)
  380. constructor TRecMgr.Init;
  381. var
  382.    Counter   : integer;
  383.    BNumber,
  384.    BRev      : string[2];
  385.    BProduct  : string[1];
  386. begin
  387.    TObject.Init;                              {assures all data fields zeroed}
  388.    BStatus := Btrv(BVersion, VarPosBlk, Version, Counter, VarNotRequired, Zero);
  389.    str(Version.Number:2, BNumber);
  390.    BNumber := LTrim(BNumber);
  391.    str(Version.Rev:2, BRev);
  392.    BProduct := Version.Product;
  393.    VersionString := BNumber + '.' + BRev + BProduct;
  394. end;
  395.  
  396. (* BRECMGR.BT function *)
  397. (* ------------------- *)
  398. {Will not handle reset of other workstations as written, as no true key
  399.  buffer is passed.   Will handle begin/end/abort transaction, reset & stop.
  400.  Would also handle version op, but is handled by BRecMgr.Init anyway!}
  401. function TRecMgr.BT(OpCode, Key: integer): integer;
  402. begin
  403.    BT := Btrv(OpCode, VarPosBlk, VarNotRequired, VarNotRequired,
  404.               VarNotRequired, Key);
  405. end;
  406.  
  407. (* BRECMGR Destructor *)
  408. (* ------------------ *)
  409. destructor TRecMgr.Done;
  410. begin
  411.    TObject.Done;
  412. end;
  413.  
  414. (* BFILE.INIT Constructor *)
  415. (* ---------------------- *)
  416. constructor BFile.Init(UserFileName:string; OpenMode: integer);
  417. const
  418.    FileBufLen : integer = 400;  KeyBufLen  : integer = 384;
  419. var
  420.    Counter, Status : integer;
  421.    NumRecsWord1,
  422.    NumRecsWord2    : word;
  423. begin
  424.    TObject.Init;                              {assures all data fields zeroed}
  425.    ConvertName(UserFileName);             {Sets fields DFileName and FileName}
  426.    Status := Open(OpenMode);
  427.    if Status = 0 then                    {if open op successful, do a stat op}
  428.       begin
  429.          Status := Btrv(BStat, PosBlk, Specs.SpecBuf, FileBufLen, KeyBufLen,
  430.                         Zero);
  431.          {Btrieve filespecs and key specs are now in the BFile object!}
  432.          if Status = 0 then     {if stat successfull, fill object data fields}
  433.             begin
  434.                NumRecsWord1 := Specs.NumRecs[1];  {get rid of sign bit!! by  }
  435.                NumRecsWord2 := Specs.NumRecs[2];  {converting 2 ints to words}
  436.                NumRecs := NumRecsWord1 + NumRecsWord2 * 65536;
  437.                NumSegs := Specs.NumKeys;
  438.                for Counter := 0 to 23 do
  439.                   if (Specs.KeyArray[Counter].KeyFlags and Segmented) =
  440.                       Segmented then inc(NumSegs);
  441.                DBufferLen := Specs.RecLen;
  442.                BStatus := 0;                  {all went well, return a code 0}
  443.             end
  444.             else
  445.             begin
  446.                BStatus := Status;  {Open op succeeded but stat failed; put   }
  447.                Status  := Close;   {error code for bad stat in global var and}
  448.             end;                   {close the damn file quick!}
  449.          end
  450.    else
  451.    BStatus := Status;             {assign err code for bad open to global var}
  452. end;
  453.  
  454. (* BFILE.BT function *)
  455. (* ----------------- *)
  456. function BFile.BT(OpCode, Key: integer): integer;
  457. begin
  458.    Abstract;
  459. end;
  460.  
  461. (* BFILE.OPEN function *)
  462. (* ------------------- *)
  463. function BFile.Open(OpenMode: integer):integer;
  464. begin
  465.    Open := Btrv(BOpen, PosBlk, VarNotRequired, Specs.RecLen, FileName, OpenMode);
  466. end;
  467.  
  468. (* BFILE.CLOSE Function *)
  469. (* -------------------- *)
  470. function BFile.Close:integer;
  471. begin
  472.    Close := Btrv(BClose, PosBlk, VarNotRequired, VarNotRequired,
  473.                  VarNotRequired, NotRequired);
  474. end;
  475.  
  476. (* BFILE.DONE Destructor *)
  477. (* --------------------- *)
  478. destructor BFile.Done;
  479. begin
  480.    TObject.Done;
  481. end;
  482.  
  483. (* BFILE.CONVERTNAME Procedure *)
  484. (* --------------------------- *)
  485. {this one is private to BFile}
  486. procedure BFile.ConvertName(UserFileName: string);
  487. var Counter : integer;
  488. begin
  489.    DFileName := UserFileName;
  490.    if length(UserFileName) > 79 then
  491.       DFileName[0] := chr(79);                   {force short to 79 if needed}
  492.    for Counter := 1 to length(DFileName) do          {convert string to array}
  493.       FileName[Counter] := DFileName[Counter];
  494.    FileName[Counter + 1] := ' ';                   {provide required pad char}
  495. end;
  496.  
  497. (* BFIXED.INIT Constructor *)
  498. (* ----------------------- *)
  499. constructor BFixed.Init(UserFileName:string; OpenMode: integer);
  500. begin
  501.    BFile.Init(UserFileName, OpenMode);
  502. end;
  503.  
  504. (* BFIXED.BT function *)
  505. (* ----------------- *)
  506. function BFixed.BT(OpCode, Key: integer): integer;
  507. begin
  508.    BT := Btrv(OpCode, PosBlk, DBuffer, Specs.RecLen, KBuffer, Key);
  509. end;
  510.  
  511. (* BFIXED.DONE Destructor *)
  512. (* ---------------------- *)
  513. destructor BFixed.Done;
  514. begin
  515.    BFile.Done;
  516. end;
  517.  
  518. (* TFILTERSPEC.INITF Constructor *)
  519. (* ----------------------------- *)
  520. {Be sure to remember that the offset parameter here is 0 relative to start of
  521.  record!!}
  522. constructor TFilterSpec.InitF(FieldType: byte; FieldLen, Offset: integer;
  523.                               CompCode, Expression: byte; FieldComp: boolean;
  524.                               CompOffset: integer);
  525. begin
  526.    TObject.Init;                              {assures all data fields zeroed}
  527.    LogicTerm.FieldType  := FieldType;
  528.    LogicTerm.FieldLen   := FieldLen;
  529.    LogicTerm.Offset     := Offset;
  530.    LogicTerm.CompCode   := CompCode;
  531.    LogicTerm.Expression := Expression;
  532.    LogicTerm.FieldComp  := FieldComp;
  533.    LogicTerm.CompOffset := Offset;
  534. end;
  535.  
  536. (* TFILTERSPEC.INITV Constructor *)
  537. (* ----------------------------- *)
  538. {Be sure to remember that the offset parameter here is 0 relative to start of
  539.  record!!}
  540. constructor TFilterSpec.InitV(FieldType: byte; FieldLen, Offset: integer;
  541.                               CompCode, Expression: byte; FieldComp: boolean;
  542.                               Value: TCharArray);
  543. begin
  544.    TObject.Init;                              {assures all data fields zeroed}
  545.    LogicTerm.FieldType := FieldType;
  546.    LogicTerm.FieldLen  := FieldLen;
  547.    LogicTerm.Offset    := Offset;
  548.    LogicTerm.CompCode  := CompCode;
  549.    LogicTerm.Expression:= Expression;
  550.    LogicTerm.FieldComp := FieldComp;
  551.    LogicTerm.Value     := Value;
  552. end;
  553.  
  554. (* TFILTERSPEC.DONE Destructor *)
  555. (* --------------------------- *)
  556. destructor TFilterSpec.Done;
  557. begin
  558.    TObject.Done;
  559. end;
  560.  
  561. (* TEXTSPEC.INIT Constructor *)
  562. (* ------------------------- *)
  563. constructor TExtSpec.Init(Len, Ofs: integer);
  564. begin
  565.    TObject.Init;                              {assures all data fields zeroed}
  566.    ExtRepeater.FieldLen := Len;
  567.    ExtRepeater.Offset   := Ofs;
  568. end;
  569.  
  570. (* TEXTSPEC.DONE Destructor *)
  571. (* ----------------------- *)
  572. destructor TExtSpec.Done;
  573. begin
  574.    TObject.Done;
  575. end;
  576.  
  577. (* BFILEEXT.INIT Constructor *)
  578. (* ------------------------- *)
  579. {always check for a failure!}
  580. constructor BFileExt.Init(UserFileName: string; OpenMode: integer);
  581. begin
  582.    BFile.Init(UserFileName, OpenMode);
  583.    Header.Constant[1] := 'E';
  584.    Header.Constant[2] := 'G';
  585.    ExtDBuffer    := memallocseg(MaxExtDBufferLength);
  586.    FilterSpec    := new(PCollection, Init(2,2));
  587.    ExtractorSpec := new(PCollection, Init(5,2));
  588.    if (ExtDBuffer = nil) or (FilterSpec = nil) or (ExtractorSpec = nil) then
  589.       Fail;
  590. end;
  591.  
  592. (* BFILEEXT.DONE Destructor *)
  593. (* ------------------------ *)
  594. destructor BFileExt.Done;
  595. begin
  596.    BFile.Done;
  597.    dispose(ExtDBuffer);
  598.    dispose(ExtractorSpec, Done);
  599.    dispose(FilterSpec, Done);
  600. end;
  601.  
  602. (* BFILEEXT.SetExtDBufferLen *)
  603. (* ------------------------- *)
  604. {Compute sizes of data buffers sent and returned, to determine proper size to
  605.  specify in call.}
  606. {Assumes user program has inserted proper items into the collections for
  607.  filter terms and extractor specs.}
  608. procedure BFileExt.SetExtDBufferLen;
  609. var
  610.    LengthSent, LengthReturned,
  611.    RecordLengthReturned, RecordImageReturned : integer;
  612.  
  613.    procedure MakeFilterSpecs;
  614.       procedure CalcFilterLengths(FSpec: PFilterSpec); far;
  615.       begin
  616.       with FSpec^ do
  617.          begin
  618.          inc(LengthSent, 7);
  619.          if (LogicTerm.CompCode and UseField) = UseField then
  620.             inc(LengthSent, 2)
  621.             else
  622.             LengthSent := LengthSent + LogicTerm.FieldLen;
  623.          end;
  624.       end;
  625.    begin
  626.       FilterSpec^.ForEach(@CalcFilterLengths);
  627.    end;
  628.  
  629.    procedure MakeExtSpecs;
  630.       procedure CalcExtLengths(ExtSpec: PExtSpec); far;
  631.       begin
  632.          with ExtSpec^ do
  633.             begin
  634.             inc(LengthSent, 4);
  635.             RecordLengthReturned := RecordLengthReturned + ExtRepeater.FieldLen;
  636.             end;
  637.       end;
  638.    begin
  639.       ExtractorSpec^.ForEach(@CalcExtLengths);
  640.    end;
  641.  
  642. begin
  643.    LengthSent := 8; {4 for header length, 4 for fixed filter length}
  644.  
  645.    {Work on filter logic term portion of spec.}
  646.    if FilterSpec^.Count > 0 then       {if any filter terms in the collection}
  647.       MakeFilterSpecs;
  648.  
  649.    {Work on extractor portion of spec.}
  650.    inc(LengthSent, 4);                       {size of fixed part of extractor}
  651.    RecordLengthReturned := 0;
  652.    MakeExtSpecs;              {there must always be at least 1 extractor spec}
  653.  
  654.    {2 for count of recs, 4 for currency pos}
  655.    RecordImageReturned := RecordLengthReturned + 6; 
  656.    {2 for count of recs}
  657.    LengthReturned := 2 + (RecordImageReturned * Extractor.NumRecords);
  658.  
  659.    Header.DBufferLen := LengthSent;
  660.  
  661.    if LengthSent >= LengthReturned then
  662.       DBufferLen := LengthSent
  663.       else
  664.       DBufferLen := LengthReturned;
  665. end;
  666.  
  667. (* BFILEEXT.MAKEEXTDBUFFER Function *)
  668. (* -------------------------------- *)
  669. {Private to BFileExt, called in BFileExt.BT, which is called by each
  670.  descendant's override of BFileExt.BT.  Assumes program has already set up
  671.  the collections required.}
  672. procedure BFileExt.MakeExtDBuffer;
  673. var
  674.    Offset : integer;
  675.  
  676.    procedure MoveFilterSpecs;
  677.       procedure MoveSingleFilterSpec(FSpec: PFilterSpec); far;
  678.       begin
  679.          with FSpec^ do
  680.             begin
  681.             {move fixed part of logic term}
  682.             move(LogicTerm, ExtDBuffer^.Entire[Offset], 7);
  683.             {now need to move variable part of logic term}
  684.             inc(Offset, 7);
  685.             if (LogicTerm.CompCode and UseField) = UseField then
  686.                begin
  687.                move(LogicTerm.CompOffset, ExtDBuffer^.Entire[Offset],
  688.                     sizeof(LogicTerm.CompOffset));
  689.                Offset := Offset + sizeof(LogicTerm.CompOffset);
  690.                end
  691.                else
  692.                begin
  693.                move(LogicTerm.Value, ExtDBuffer^.Entire[Offset],
  694.                     LogicTerm.FieldLen);
  695.                Offset := Offset + LogicTerm.FieldLen;
  696.                end;
  697.             end;
  698.       end;
  699.    begin
  700.       FilterSpec^.ForEach(@MoveSingleFilterSpec);
  701.    end;
  702.  
  703.    procedure MoveExtractorSpecs;
  704.       procedure MoveSingleExtractorSpec(ExtSpec: PExtSpec); far;
  705.       begin
  706.         with ExtSpec^ do
  707.            begin
  708.            move(ExtSpec^.ExtRepeater, ExtDBuffer^.Entire[Offset],
  709.                 sizeof(ExtSpec^.ExtRepeater));
  710.            Offset := Offset + sizeof(ExtSpec^);
  711.            end;
  712.       end;
  713.    begin
  714.       ExtractorSpec^.ForEach(@MoveSingleExtractorSpec);
  715.    end;
  716.  
  717. begin
  718.    {Move header definition into buffer.}
  719.    move(Header, ExtDBuffer^.Header, sizeof(Header));
  720.  
  721.    {Move fixed part of filter definition into buffer.}
  722.    move(Filter, ExtDBuffer^.Filter, sizeof(Filter));
  723.    Offset := 1 + sizeof(Header) + sizeof(Filter);
  724.  
  725.    {Read filter logic terms into buffer.}
  726.    if FilterSpec^.Count > 0 then
  727.       MoveFilterSpecs;
  728.  
  729.    {Move fixed part of extractor definition into buffer.}
  730.    move(Extractor, ExtDBuffer^.Entire[Offset], sizeof(Extractor.Entire));
  731.    Offset := Offset + sizeof(Extractor.Entire);
  732.  
  733.    {Move extractor terms into buffer.}
  734.    MoveExtractorSpecs;
  735. end;
  736.  
  737. (* BFILEEXT.BTExt function *)
  738. (* ----------------------- *)
  739. {In overrides of this function in BFileExt descendants, MUST call
  740.  BFileExt.BTExt, as it sets the buffer length in the header, and puts
  741.  together the 'send' buffer.  User program MUST have inserted filter logic
  742.  terms and extractor specs into their respective collections before making
  743.  a Btrieve call.}
  744. function BFileExt.BTExt(OpCode, Key: integer): integer;
  745. begin
  746.    SetExtDBufferLen;
  747.    MakeExtDBuffer;
  748. end;
  749.  
  750.  
  751. (* CREATE FILE function *)
  752. (* -------------------- *)
  753. {Assumes a PFILETYPE variable has been instantiated and assigned its values.}
  754. {No specific support for null keys, alt col, blank compression, pre-alloc or
  755.  data-only files}
  756. function CreateFile(UserFileName:string; UserFileSpec:PFileSpec): integer;
  757. var
  758.    PosBlk          : array[1..128] of char;
  759.    CFSpecLength,
  760.    Counter,
  761.    Counter1        : integer;
  762.    BtrieveFileName : BFileName;
  763. begin
  764.    if length(UserFileName) > 79 then
  765.       UserFileName[0] := chr(79);               {force short to 79 if needed}
  766.    for Counter := 1 to length(UserFileName) do      {convert string to array}
  767.       BtrieveFileName[Counter] := UserFileName[Counter];
  768.    BtrieveFileName[Counter + 1] := ' ';           {provide required pad char}
  769.    CFSpecLength := 16 + (UserFileSpec^.NumKeys * 16);
  770.    {now add 16 to CFSpecLength for every segmented key}
  771.    for Counter := 0 to 23 do
  772.       if (UserFileSpec^.KeyArray[Counter].KeyFlags and Segmented) = Segmented then
  773.           CFSpecLength := CFSpecLength + Segmented;
  774.    UserFileSpec^.Reserved[1] := chr(0);
  775.    UserFileSpec^.Reserved[2] := chr(0);
  776.    CreateFile := Btrv(BCreate, PosBlk, UserFileSpec^.SpecBuf, CFSpecLength,
  777.                       BtrieveFileName, Zero);
  778. end;
  779.  
  780. {LTrim and RTrim were taken from one of the Turbo Vision .PAS source files!}
  781. function LTrim(S: String): String;
  782. var
  783.    I: integer;
  784. begin
  785.    I := 1;
  786.    while (I < length(S)) and (S[I] = ' ') do inc(I);
  787.    LTrim := copy(S, I, 255);
  788. end;
  789.  
  790. function RTrim(S: String): String;
  791. var
  792.    I: integer;
  793. begin
  794.    while S[Length(S)] = ' ' do dec(S[0]);
  795.    RTrim := S;
  796. end;
  797.  
  798.  
  799. (* IS BTRIEVE LOADED procedure *)
  800. (* --------------------------- *)
  801. {this is private to the unit, and is executed only during unit initialization}
  802. procedure IsBtrieveLoaded;
  803. var
  804.    VarPosBlk      : array[1..128] of char;
  805. begin
  806.    BStatus := Btrv(BReset, VarPosBlk, VarNotRequired, VarNotRequired,
  807.                    VarNotRequired, Zero);
  808.    if BStatus = 20 then
  809.       begin
  810.       writeln('Please load Btrieve before running this program.');
  811.       halt;
  812.       end;
  813. end;
  814.  
  815.  
  816. (* INITIALIZATION Section *)
  817. (* ----------------------------------------------------------------------- *)
  818. begin
  819.  
  820. IsBtrieveLoaded;
  821.  
  822. end.
  823.  
  824.