home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / BTP20.ZIP / BTP.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-06-10  |  59.4 KB  |  1,533 lines
  1. UNIT BTP;     { Version 2.0 - last mod 6/10/93         (C) 1993 John C. Leon }
  2.  
  3. {$A+}     {Btrieve interface call wants this set.}
  4. {$X+,D+}
  5.  
  6. INTERFACE
  7. (* ------------------------------------------------------------------------ *)
  8. (* ------------------------------------------------------------------------ *)
  9. USES Objects, Memory;
  10.  
  11. CONST
  12.  
  13. {      Key Attributes            Key Types          Open Modes               }
  14. {    ------------------      ----------------     ---------------            }
  15.      Duplicates   =   1;     BString    =  0;     Normal    =  0;
  16.      Modifiable   =   2;     BInteger   =  1;     Accel     = -1;
  17.      Binary       =   4;     BFloat     =  2;     ReadOnly  = -2;
  18.      Null         =   8;     BDate      =  3;     Verify    = -3;
  19.      Segmented    =  16;     BTime      =  4;     Exclusive = -4;
  20.      AltCol       =  32;     BDecimal   =  5;
  21.      Descending   =  64;     BMoney     =  6;   {        File Flags        }
  22.      Supplemental = 128;     BLogical   =  7;   { ------------------------ }
  23.      ExtType      = 256;     BNumeric   =  8;     VarLength   =   1;
  24.      Manual       = 512;     BBFloat    =  9;     BlankTrunc  =   2;
  25.                              BLString   = 10;     PreAllocate =   4;
  26.                              BZString   = 11;     DataComp    =   8;
  27.                              BUnsBinary = 14;     KeyOnly     =  16;
  28.                              BAutoInc   = 15;     Free10      =  64;
  29.                                                   Free20      = 128;
  30.                                                   Free30      = 192;
  31.  
  32. {              Btrieve Op Codes                      Error Codes             }
  33. {  -----------------------------------------   ------------------------      }
  34.    BOpen      =  0;       BAbortTran   = 21;   FileNotOpen      =  3;
  35.    BClose     =  1;       BGetPos      = 22;   InvalidKeyNumber =  6;
  36.    BInsert    =  2;       BGetDir      = 23;   DiffKeyNumber    =  7;
  37.    BUpdate    =  3;       BStepNext    = 24;   InvalidPosition  =  8;
  38.    BDelete    =  4;       BStop        = 25;   EndofFile        =  9;
  39.    BGetEqual  =  5;       BVersion     = 26;   FileNotFound     = 12;
  40.    BGetNext   =  6;       BUnlock      = 27;   BtrieveNotLoaded = 20;
  41.    BGetPrev   =  7;       BReset       = 28;   DataBufferLength = 22;
  42.    BGetGr     =  8;       BSetOwner    = 29;   RejectCount      = 60;
  43.    BGetGrEq   =  9;       BClrOwner    = 30;   IncorrectDesc    = 62;
  44.    BGetLess   = 10;       BCrSuppIdx   = 31;   FilterLimit      = 64;
  45.    BGetLessEq = 11;       BDropSuppIdx = 32;   IncorrectFldOff  = 65;
  46.    BGetFirst  = 12;       BStepFirst   = 33;   LostPosition     = 82;
  47.    BGetLast   = 13;       BStepLast    = 34;
  48.    BCreate    = 14;       BStepPrev    = 35;
  49.    BStat      = 15;       BGetNextExt  = 36;
  50.    BExtend    = 16;       BGetPrevExt  = 37;
  51.    BSetDosDir = 17;       BStepNextExt = 38;
  52.    BGetDosDir = 18;       BStepPrevExt = 39;
  53.    BBegTran   = 19;       BInsertExt   = 40;
  54.    BEndTran   = 20;       BGetKey      = 50;
  55.  
  56. {  Extended Ops Comp Codes/Bias           Extended Ops Logic Constants       }
  57. {  -----------------------------       -----------------------------------   }
  58.    Equal       : byte =   1;           NoFilter    : integer = 0;
  59.    GreaterThan : byte =   2;           LastTerm    : byte    = 0;
  60.    LessThan    : byte =   3;           NextTermAnd : byte    = 1;
  61.    NotEqual    : byte =   4;           NextTermOr  : byte    = 2;
  62.    GrOrEqual   : byte =   5;
  63.    LessOrEqual : byte =   6;        {              Owner Access              }
  64.    UseAltColl  : byte =  32;        { -------------------------------------- }
  65.    UseField    : byte =  64;          RQ = 0; RO = 1; RQENC = 2; ROENC = 3;
  66.    UseNoCase   : byte = 128;
  67.  
  68. {   Other Unit-Specific Constants   }
  69. { --------------------------------- }
  70.    Zero        : integer = 0;
  71.    NotRequired : integer = 0;
  72.    MaxFixedRecLength   =  4090;   {Btrieve limits fixed record length for std}
  73.    MaxKBufferLength    =   255;   {files to 4090.  Max key size is 255.      }
  74.    MaxExtDBufferLength = 32767;
  75.    MaxFileSpecLength   =   665;
  76.    MaxDBufferLength    = 32767;
  77.    MaxNumSegments      =    24;
  78.    KeySpecSize         =    16;
  79.    None = 0; Drop = 1; Retain = 2;                 {Used in CloneFileFunction}
  80.  
  81.  
  82. TYPE
  83.  
  84.    TOwnerName = string[9];
  85.  
  86.  
  87. (* Data types for TRecMgr object *)
  88. (* ----------------------------- *)
  89.    TVersion    = record
  90.                     case integer of
  91.                     1: (Number  : word;
  92.                         Rev     : integer;
  93.                         Product : char);
  94.                     2: (Entire  : array[1..5] of char);
  95.                     end;
  96.    PRecMgr     = ^TRecMgr;
  97.    TRecMgr     = object(TObject)            {Base obj handles abort/begin/end}
  98.                     BtrieveIsLoaded: boolean;
  99.                     Version      : TVersion;   {tran, reset, version and stop}
  100.                     VersionString: string;
  101.                     constructor Init;
  102.                     destructor Done; virtual;
  103.                     function BT(OpCode, Key: integer): integer; virtual;
  104.                     function GetVersion: string;
  105.                     end;
  106.  
  107.  
  108. (* Data types for BFile object *)
  109. (* --------------------------- *)
  110.    BFileName   = array[1..80] of char;    {79 + blank pad required by Btrieve}
  111.    TAltColSpec = record               {The data types for alternate collating}
  112.                     case integer of   {sequence are used in CreateFile fcn.  }
  113.                     1: (Header : byte;              {Header always equals $AC}
  114.                         Name   : array[1..8] of char;
  115.                         Table  : array[1..256] of char);
  116.                     2: (Entire : array[1..265] of byte);
  117.                     end;
  118.    PAltColSeq  = ^TAltColSeq;
  119.    TAltColSeq  = object(TObject)
  120.                     Spec : TAltColSpec;
  121.                     constructor Init(const SpecName: FNameStr);
  122.                     destructor Done; virtual;
  123.                     end;
  124.    PKeySpec    = ^TKeySpec;
  125.    TKeySpec    = record                     {data type for a Btrieve key spec}
  126.                     case integer of
  127.                     1: (KeyPos     : integer;
  128.                         KeyLen     : integer;
  129.                         KeyFlags   : integer;             {Tho not used in a }
  130.                         NotUsed    : array[1..4] of byte; {create call, these}
  131.                         ExtKeyType : byte;                {4 bytes return #  }
  132.                         NullValue  : byte;                {unique recs in key}
  133.                         Reserved   : array[1..4] of byte);{after a stat call.}
  134.                     2: (Irrelevant : array[1..3] of integer;
  135.                         NumUnique  : longint);      {great after a stat call!}
  136.                     3: (Entire     : array[1..KeySpecSize] of byte);
  137.                     end;
  138.    PKeyList    = ^TKeyList;
  139.    TKeyList     = record
  140.                      KeySpec: TKeySpec;
  141.                      Next: PKeyList;
  142.                      end;
  143.    PFileSpec   = ^TFileSpec;
  144.    TFileSpec   = record                      {Strictly speaking, the KeyArray}
  145.                     case integer of          {and AltColSpec elements here   }
  146.                     1: (RecLen     : integer;{only serve to reserve space for}
  147.                         PageSize   : integer;{the buffer.                    }
  148.                         NumKeys    : integer;
  149.                         NumRecs    : array[1..2] of word;
  150.                         FileFlags  : integer;
  151.                         Reserved   : array[1..2] of char;
  152.                         PreAlloc   : integer;
  153.                         KeyArray   : array[0..23] of TKeySpec;  {24=max # segs}
  154.                         AltColSpec : TAltColSpec);   {here just to allow room}
  155.                     2: (Irrelevant : array[1..14] of byte;
  156.                         UnusedPgs  : word);         {great after a stat call!}
  157.                     3: (SpecBuf    : integer); {used to refer to addr of spec}
  158.                     4: (Entire     : array[1..665] of byte);
  159.                     end;
  160.    PFileSpecObj   = ^TFileSpecObj;
  161.    TFileSpecObj   = object(TObject)
  162.                        Specs: PFileSpec;
  163.                        Keys : PKeyList;
  164.                        constructor Init(RecLen, PageSize, NumKeys,
  165.                                         FileFlags, PreAlloc: integer;
  166.                                         AKeyList: PKeyList);
  167.                        destructor Done; virtual;
  168.                        end;
  169.    PBFile      = ^BFile;
  170.    BFile       = object(TObject)
  171.                     DFileName  : FNameStr;                      {DOS filename}
  172.                     Specs      : TFileSpec;               {Btrieve file specs}
  173.                     SpecLength : integer;         {length of actual file spec}
  174.                     NumRecs    : longint;             {# records at Init time}
  175.                     NumSegs    : integer;                   {total # key segs}
  176.                     HasAltCol  : boolean;       {true if file has alt col seq}
  177.                     AltColName : string[8];    {name of alt col seq from file}
  178.                     IsVarLength: boolean;
  179.                     HasOwner   : boolean;
  180.                     OwnerName  : TOwnerName;                   {8 plus 1 null}
  181.                     PosBlk     : array[1..128] of char;       {position block}
  182.                     DBufferLen : integer;
  183.                     constructor Init(const UserFileName: FNameStr; OpenMode: integer;
  184.                                      const OName: TOwnerName);
  185.                     function BT(OpCode, Key: integer): integer; virtual;
  186.                     function Open(OpenMode: integer):  integer; virtual;
  187.                     function Close: integer; virtual;
  188.                     function AddSuppIdx(KeyList: PKeyList;
  189.                                         const AltColFile: FNameStr): boolean; virtual;
  190.                     destructor Done; virtual;
  191.                     private
  192.                     FileName : BFileName;              {Btrieve-type filename}
  193.                     procedure ConvertName(const UserFileName: FNameStr);
  194.                     end;
  195.  
  196.  
  197. (* Data types for BFixed object - descendant of BFile *)
  198. (* -------------------------------------------------- *)
  199.    TDBuffer    = array[1..MaxFixedRecLength] of byte;
  200.    TKBuffer    = array[1..MaxKBufferLength] of byte;
  201.    PBFixed     = ^BFixed;
  202.    BFixed      = object(BFile)
  203.                     DBuffer : TDBuffer;
  204.                     KBuffer : TKBuffer;
  205.                     constructor Init(const UserFileName: FNameStr; OpenMode: integer;
  206.                                      const OName: TOwnerName);
  207.                     function BT(OpCode, Key: integer): integer; virtual;
  208.                     destructor Done; virtual;
  209.                     end;
  210.  
  211.  
  212. (* Data types for BSized object - descendant of BFile *)
  213. (* -------------------------------------------------- *)
  214.    PBSized = ^BSized;
  215.    BSized  = object(BFile)
  216.                 DBuffer    : pointer;
  217.                 KBuffer    : pointer;
  218.                 DBufferSize: integer;
  219.                 constructor Init(const UserFileName: FNameStr; OpenMode: integer;
  220.                                  const OName: TOwnerName; BuffSize: integer);
  221.                 function BT(OpCode, Key: integer): integer; virtual;
  222.                 destructor Done; virtual;
  223.                 end;
  224.  
  225.  
  226. (* Data types for BFileExt object - descendant of BFile *)
  227. (* ---------------------------------------------------- *)
  228.    TByteArray  = array[1..255] of byte;
  229.    THeader     = record
  230.                     case integer of
  231.                     1: (DBufferLen : integer;
  232.                         Constant   : array[1..2] of char);
  233.                     2: (Entire     : array[1..4] of byte);
  234.                     end;
  235.    TFilter     = record
  236.                     case integer of
  237.                     1: (MaxSkip       : integer;
  238.                         NumLogicTerms : integer);
  239.                     2: (Entire        : array[1..2] of integer);
  240.                     end;
  241.    TLogicTerm  = record
  242.                     case integer of
  243.                     1: (FieldType  : byte;
  244.                         FieldLen   : integer;
  245.                         Offset     : integer;  {0 relative to start of record}
  246.                         CompCode   : byte;
  247.                         Expression : byte;{0 last term, 1 AND next, 2 OR next}
  248.                         case FieldComp: boolean of
  249.                            True : (CompOffset: integer);
  250.                            False: (Value: TByteArray));{an arbitrary limit of}
  251.                     2: (Fixed : array[1..7] of byte);  {255 on len of values }
  252.                     end;
  253.    PFilterSpec = ^TFilterSpec;
  254.    TFilterSpec = object(TObject)
  255.                     LogicTerm: TLogicTerm;
  256.                     constructor InitF(FieldType: byte; FieldLen, Offset:
  257.                                       integer; CompCode, Expression: byte;
  258.                                       CompOffset: integer);
  259.                     constructor InitV(FieldType: byte; FieldLen, Offset:
  260.                                       integer; CompCode, Expression: byte;
  261.                                       const Value: array of byte);
  262.                     destructor Done; virtual;
  263.                     end;
  264.    TExtractor  = record
  265.                     case integer of
  266.                     1: (NumRecords : integer;
  267.                         NumFields  : integer);
  268.                     2: (Entire     : array[1..2] of integer);
  269.                     end;
  270.    TExtRepeater= record
  271.                     FieldLen : integer;
  272.                     Offset   : integer;
  273.                     end;
  274.    PExtSpec    = ^TExtSpec;
  275.    TExtSpec    = object(TObject)
  276.                     ExtRepeater : TExtRepeater;
  277.                     constructor Init(Len, Ofs: integer);
  278.                     destructor Done; virtual;
  279.                     end;
  280.    PExtDBuffer = ^TExtDBuffer;
  281.    TExtDBuffer = record
  282.                     case integer of
  283.                     1: (Header   : THeader;       {Buffer sent includes these}
  284.                         Filter   : TFilter);         {types at its beginning.}
  285.                     2: (NumRecs  : integer;               {Buffer rec'd looks}
  286.                         Repeater : array[1..32765] of char);      {like this.}
  287.                     {Repeater structure is: 2 for length of record image,    }
  288.                     {                       4 for currency position of rec,  }
  289.                     {                       n for record image itself        }
  290.                     3: (Entire   : array[1..32767] of byte);   {Whole buffer.}
  291.                     end;
  292.    PBFileExt   = ^BFileExt;
  293.    BFileExt    = object(BFile)
  294.                     Header        : THeader;
  295.                     Filter        : TFilter;
  296.                     FilterSpec    : PCollection;
  297.                     Extractor     : TExtractor;
  298.                     ExtractorSpec : PCollection;
  299.                     ExtDBuffer    : PExtDBuffer;
  300.                     constructor Init(const UserFileName: FNameStr; OpenMode: integer;
  301.                                      const OName: TOwnerName);
  302.                     function BTExt(OpCode, Key: integer): integer; virtual;
  303.                     procedure SetTerms(MSkip, NumLTerms, NRecs, NumFlds: integer);
  304.                     destructor Done; virtual;
  305.                     private
  306.                     procedure SetExtDBufferLen;
  307.                     procedure MakeExtDBuffer;
  308.                     end;
  309.  
  310.  
  311. (* PUBLIC VARS *)
  312. (* ----------- *)
  313. VAR
  314.      BStatus        : integer;
  315.      VarNotRequired : integer;                              {Dummy parameter.}
  316.      VarPosBlk      : array[1..128] of char;    {Dummy used in ops that don't}
  317.                                                 {pass/return position block. }
  318.  
  319. (* PUBLIC FUNCTIONS *)
  320. (* ---------------- *)
  321.  
  322. {The Btrv function declared here is public, but should not be needed much. It
  323.  is included in the public declaration only to be complete and give you
  324.  access to the standard call if you should need it.}
  325.  
  326. function Btrv(Op:integer; var Pos,Data; var DataLen:integer; var KBuf;
  327.               Key:integer): integer;
  328. function CreateFile(const UserFileName: FNameStr; UserFileSpec:PFileSpec;
  329.                     const AltColFile: FNameStr; const OName: TOwnerName;
  330.                     Access: integer): integer;
  331. function CloneFile(const CurrentFile, NewFile: FNameStr; Option: integer;
  332.                    const OName: TOwnerName): integer;
  333. function NewKeySpec(KPos, KLen, KFlags: integer; EType: byte;
  334.                     NextKey: PKeyList): PKeyList;
  335. function IsBtrieveLoaded: boolean;
  336. function LTrim(S: String): String;   {LTrim and RTrim were taken from one of }
  337. function RTrim(S: String): String;   {the Turbo Vision .PAS source files.    }
  338.  
  339.  
  340. IMPLEMENTATION
  341. (* ------------------------------------------------------------------------ *)
  342. (* ------------------------------------------------------------------------ *)
  343. USES Dos;        {Dos unit needed for the Btrieve interface call (interrupts)}
  344.  
  345. {$R-}     {Range checking off...is TP's default}
  346. {$B+}     {Boolean complete evaluation on...NOT a default, but apparently
  347.           required by the interface call.  Is turned off at end of
  348.           implementation of Btrieve interface definition}
  349. {$V-}    {Non-strict string var checking...Btrieve wants it so.  Strict
  350.           checking is turned back on at the end of the interface definition.}
  351. {$S+}     {Stack checking on}
  352. {$I+}     {I/O checking on}
  353.  
  354. {  Module Name: TUR5BTRV.PAS                                                 }
  355.  
  356. {  Description: This is the Btrieve interface for Turbo Pascal (MS-DOS).     }
  357. {   This routine sets up the parameter block expected by                     }
  358. {   Btrieve, and issues interrupt 7B.  It should be compiled                 }
  359. {   with the $V- switch so that runtime checks will not be                   }
  360. {   performed on the variable parameters.                                    }
  361. {                                                                            }
  362. {  Synopsis:  STAT := BTRV (OP, POS.START, DATA.START, DATALEN,              }
  363. {        KBUF.START, KEY);                                                   }
  364. {           where                                                            }
  365. {     OP is an integer,                                                      }
  366. {     POS is a 128 byte array,                                               }
  367. {     DATA is an untyped parameter for the data buffer,                      }
  368. {     DATALEN is the integer length of the data buffer,                      }
  369. {     KBUF is the untyped parameter for the key buffer,                      }
  370. {       and KEY is an integer.                                               }
  371. {                                                                            }
  372. {  Returns: Btrieve status code (see Appendix B of the Btrieve Manual).      }
  373. {                                                                            }
  374. {  Note:  The Btrieve manual states that the 2nd, 3rd, and 5th               }
  375. {   parameters be declared as variant records, with an integer               }
  376. {   type as one of the variants (used only for Btrieve calls),               }
  377. {   as is shown in the example below.  This is supported, but                }
  378. {   the restriction is no longer necessary.  In other words, any             }
  379. {   variable can be sent in those spots as long as the variable              }
  380. {   uses the correct amount of memory so Btrieve does not                    }
  381. {   overwrite other variables.                                               }
  382. {                                                                            }
  383. {      var DATA = record case boolean of                                     }
  384. {         FALSE: ( START: integer );                                         }
  385. {         TRUE:  ( EMPLOYEE_ID: 0..99999;                                    }
  386. {            EMPLOYEE_NAME: packed array[1..50] of char;                     }
  387. {            SALARY: real;                                                   }
  388. {            DATA_OF_HIRE: DATE_TYPE );                                      }
  389. {         end;                                                               }
  390. {                                                                            }
  391. {   There should NEVER be any string variables declared in the               }
  392. {   data or key records, because strings store an extra byte for             }
  393. {   the length, which affects the total size of the record.                  }
  394.  
  395. (* BTRV function *)
  396. (* ------------- *)
  397. function Btrv (Op: integer; var Pos, Data; var DataLen: integer; var Kbuf;
  398.                Key: integer): integer;
  399.  
  400. const
  401.      VAR_ID         = $6176;           {id for variable length records - 'va'}
  402.      BTR_INT        = $7B;
  403.      BTR2_INT       = $2F;
  404.      BTR_OFFSET     = $0033;
  405.      MULTI_FUNCTION = $AB;
  406.  
  407. {  ProcId is used for communicating with the Multi Tasking Version of        }
  408. {  Btrieve. It contains the process id returned from BMulti and should       }
  409. {  not be changed once it has been set.                                      }
  410. {                                                                            }
  411.      ProcId: integer = 0;                      { initialize to no process id }
  412.      MULTI : boolean = false;              { set to true if BMulti is loaded }
  413.      VSet  : boolean = false;    { set to true if we have checked for BMulti }
  414.  
  415. type
  416.      ADDR32 = record                                          {32 bit address}
  417.         OFFSET : word;                                       {&&&old->integer}
  418.         SEGMENT: word;                                      {&&&used->integer}
  419.      end;
  420.  
  421.      BTR_PARMS = record
  422.         USER_BUF_ADDR  : ADDR32;                         {data buffer address}
  423.         USER_BUF_LEN   : integer;                         {data buffer length}
  424.         USER_CUR_ADDR  : ADDR32;                      {currency block address}
  425.         USER_FCB_ADDR  : ADDR32;                  {file control block address}
  426.         USER_FUNCTION  : integer;                          {Btrieve operation}
  427.         USER_KEY_ADDR  : ADDR32;                          {key buffer address}
  428.         USER_KEY_LENGTH: BYTE;                             {key buffer length}
  429.         USER_KEY_NUMBER: shortint;                    {key number&&&old->BYTE}
  430.         USER_STAT_ADDR : ADDR32;                       {return status address}
  431.         XFACE_ID       : integer;                      {language interface id}
  432.      end;
  433.  
  434. var
  435.      STAT : integer;                                     {Btrieve status code}
  436.      XDATA: BTR_PARMS;                               {Btrieve parameter block}
  437.      REGS : Dos.Registers;        {register structure used on interrrupt call}
  438.      DONE : boolean;
  439.  
  440. begin
  441.      REGS.AX := $3500 + BTR_INT;
  442.      INTR ($21, REGS);
  443.      if (REGS.BX <> BTR_OFFSET) then          {make sure Btrieve is installed}
  444.         STAT := 20
  445.      else
  446.         begin
  447.            if (not VSet) then   {if we haven't checked for Multi-User version}
  448.               begin
  449.                  REGS.AX := $3000;
  450.                  INTR ($21, REGS);
  451.                  if ((REGS.AX AND $00FF) >= 3) then
  452.                     begin
  453.                        VSet := true;
  454.                        REGS.AX := MULTI_FUNCTION * 256;
  455.                        INTR (BTR2_INT, REGS);
  456.                        MULTI := ((REGS.AX AND $00FF) = $004D);
  457.                     end
  458.                  else
  459.                     MULTI := false;
  460.               end;
  461.                                                     {make normal btrieve call}
  462.            with XDATA do
  463.               begin
  464.                  USER_BUF_ADDR.SEGMENT := SEG (DATA);
  465.                  USER_BUF_ADDR.OFFSET := OFS (DATA); {set data buffer address}
  466.                  USER_BUF_LEN := DATALEN;
  467.                  USER_FCB_ADDR.SEGMENT := SEG (POS);
  468.                  USER_FCB_ADDR.OFFSET := OFS (POS);          {set FCB address}
  469.                  USER_CUR_ADDR.SEGMENT := USER_FCB_ADDR.SEGMENT; {set cur seg}
  470.                  USER_CUR_ADDR.OFFSET := USER_FCB_ADDR.OFFSET+38;{set cur ofs}
  471.                  USER_FUNCTION := OP;             {set Btrieve operation code}
  472.                  USER_KEY_ADDR.SEGMENT := SEG (KBUF);
  473.                  USER_KEY_ADDR.OFFSET := OFS (KBUF);  {set key buffer address}
  474.                  USER_KEY_LENGTH := 255;             {assume its large enough}
  475.                  USER_KEY_NUMBER := KEY;                      {set key number}
  476.                  USER_STAT_ADDR.SEGMENT := SEG (STAT);
  477.                  USER_STAT_ADDR.OFFSET := OFS (STAT);     {set status address}
  478.                  XFACE_ID := VAR_ID;                         {set language id}
  479.           end;
  480.  
  481.            REGS.DX := OFS (XDATA);
  482.            REGS.DS := SEG (XDATA);
  483.  
  484.            if (NOT MULTI) then               {MultiUser version not installed}
  485.               INTR (BTR_INT, REGS)
  486.            else
  487.               begin
  488.                  DONE := FALSE;
  489.                  repeat
  490.                     REGS.BX := ProcId;
  491.                     REGS.AX := 1;
  492.                     if (REGS.BX <> 0) then
  493.                        REGS.AX := 2;
  494.                     REGS.AX := REGS.AX + (MULTI_FUNCTION * 256);
  495.                     INTR (BTR2_INT, REGS);
  496.                     if ((REGS.AX AND $00FF) = 0) then
  497.                        DONE := TRUE
  498.                     else begin
  499.                        REGS.AX := $0200;
  500.                        INTR ($7F, REGS);
  501.                        DONE := FALSE;
  502.                     end;
  503.                  until (DONE);
  504.                  if (ProcId = 0) then
  505.                     ProcId := REGS.BX;
  506.               end;
  507.            DATALEN := XDATA.USER_BUF_LEN;
  508.         end;
  509.      BTRV := STAT;
  510. end;
  511. {$B-}
  512. {$V+}
  513.  
  514.  
  515. (* IMPLEMENTATION OF OBJECT METHODS *)
  516. (* ------------------------------------------------------------------------ *)
  517.  
  518. (* BRECMGR.INIT Constructor *)
  519. (* ------------------------ *)
  520. constructor TRecMgr.Init;
  521. var
  522.    Counter  : integer;
  523.    BNumber,
  524.    BRev     : string[2];
  525.    BProduct : string[1];
  526. begin
  527.    inherited Init;                            {assures all data fields zeroed}
  528.    BStatus := Btrv(BVersion, VarPosBlk, Version, Counter, VarNotRequired, Zero);
  529.    str(Version.Number:2, BNumber);
  530.    BNumber := LTrim(BNumber);
  531.    str(Version.Rev:2, BRev);
  532.    BProduct := Version.Product;
  533.    VersionString := BNumber + '.' + BRev + BProduct;
  534. end;
  535.  
  536.  
  537. (* BRECMGR.BT function *)
  538. (* ------------------- *)
  539. {Will not handle reset of other workstations as written, as no true key
  540.  buffer is passed.   Will handle begin/end/abort transaction, reset & stop.
  541.  Would also handle version op, but is handled by BRecMgr.Init anyway!}
  542.  
  543. function TRecMgr.BT(OpCode, Key: integer): integer;
  544. begin
  545.    BT := Btrv(OpCode, VarPosBlk, VarNotRequired, VarNotRequired,
  546.               VarNotRequired, Key);
  547. end;
  548.  
  549.  
  550. (* BRECMGR Destructor *)
  551. (* ------------------ *)
  552. destructor TRecMgr.Done;
  553. begin
  554.    inherited Done;
  555. end;
  556.  
  557.  
  558. (* BRECMGR.GetVersion function *)
  559. (* --------------------------- *)
  560. function TRecMgr.GetVersion: string;
  561. begin
  562.    GetVersion := VersionString;
  563. end;
  564.  
  565.  
  566. (* TALTCOLSEQ.INIT Constructor *)
  567. (* ---------------------------- *)
  568. constructor TAltColSeq.Init(const SpecName: FNameStr);
  569. var
  570.    AltFile: file of TAltColSpec;      {The TAltColSpec object type is used   }
  571. begin                                 {internally by the CreateFile function.}
  572.    inherited Init;
  573.    assign(AltFile, SpecName);
  574.    {$I-} reset(AltFile); {$I+}    {It's up to user program to assure that the}
  575.    if ioresult = 0 then           {alternate collating sequence file exists  }
  576.      begin                        {in the current directory when the         }
  577.        read(AltFile, Spec);       {CreateFile fcn is called, and is of the   }
  578.        close(AltFile);            {standard format expected by Btrieve.      }
  579.      end
  580.      else
  581.      Fail;
  582. end;
  583.  
  584.  
  585. (* TALTCOLSEQ.DONE Destructor *)
  586. (* --------------------------- *)
  587. destructor TAltColSeq.Done;
  588. begin
  589.    inherited Done;
  590. end;
  591.  
  592.  
  593. (* TFILESPECOBJ.INIT Constructor *)
  594. (* ----------------------------- *)
  595. constructor TFileSpecObj.Init(RecLen, PageSize, NumKeys,
  596.                               FileFlags, PreAlloc: integer;
  597.                               AKeyList: PKeyList);
  598. var
  599.    Counter: integer;
  600.    Key: PKeyList;
  601. begin
  602.    inherited Init;
  603.    Specs := new(PFileSpec);
  604.    Keys := AKeyList;                          {save head of list for disposal}
  605.    fillchar(Specs^, sizeof(Specs^), 0);
  606.    Specs^.RecLen    := RecLen;
  607.    Specs^.PageSize  := PageSize;
  608.    Specs^.NumKeys   := NumKeys;
  609.    Specs^.FileFlags := FileFlags;
  610.    Specs^.PreAlloc  := PreAlloc;
  611.    Counter := 0;
  612.    Key := AKeyList;
  613.    if Key <> nil then
  614.       repeat
  615.          Specs^.KeyArray[Counter].KeyPos     := Key^.KeySpec.KeyPos;
  616.          Specs^.KeyArray[Counter].KeyLen     := Key^.KeySpec.KeyLen;
  617.          Specs^.KeyArray[Counter].KeyFlags   := Key^.KeySpec.KeyFlags;
  618.          Specs^.KeyArray[Counter].ExtKeyType := Key^.KeySpec.ExtKeyType;
  619.          inc(Counter);
  620.          Key := Key^.Next;
  621.       until Key = nil;
  622. end;
  623.  
  624.  
  625. (* TFILESPECOBJ.DONE Destructor *)
  626. (* ---------------------------- *)
  627. destructor TFileSpecObj.Done;
  628.  
  629.    procedure KillKeyList(x: PKeyList);
  630.    var
  631.       x1, x2: PKeyList;
  632.    begin
  633.       if x = nil then exit;
  634.       x1 := x;
  635.       while x1^.next <> nil do
  636.          begin
  637.          x2 := x1^.next;
  638.          dispose(x1);
  639.          x1 := x2;
  640.          end;
  641.       dispose(x1);
  642.    end;
  643.  
  644. begin
  645.    inherited Done;
  646.    dispose(Specs);
  647.    KillKeyList(Keys);
  648. end;
  649.  
  650.  
  651. (* BFILE.INIT Constructor *)
  652. (* ---------------------- *)
  653. constructor BFile.Init(const UserFileName: FNameStr; OpenMode: integer;
  654.                        const OName: TOwnerName);
  655.  
  656. var
  657.                                {665 = 16 for filespec + 384 for max key specs}
  658.    FileBufLen,                 {+ 265 for an alternate collating sequence.   }
  659.    KeyBufLen,                        {Max of 24 keys * 16 bytes per key spec.}
  660.    AltColNameOffset,
  661.    Counter, Counter1,
  662.    Status             : integer;
  663.    NumRecsWord1,
  664.    NumRecsWord2       : word;
  665.  
  666.    procedure CountSegments;
  667.    begin
  668.       repeat
  669.          if (Specs.KeyArray[Counter1].KeyFlags and Segmented) = Segmented then
  670.             begin
  671.             if (Specs.KeyArray[Counter1].KeyFlags and AltCol) = AltCol then
  672.                HasAltCol := true;
  673.             inc(NumSegs);
  674.             inc(Counter1);
  675.             end
  676.             else
  677.             begin
  678.             if (Specs.KeyArray[Counter1].KeyFlags and AltCol) = AltCol then
  679.                HasAltCol := true;
  680.             inc(Counter);
  681.             inc(Counter1);
  682.             end;
  683.       until (Specs.KeyArray[Counter1-1].KeyFlags and Segmented) <> Segmented;
  684.    end;
  685.  
  686. begin
  687.    inherited Init;                            {assures all data fields zeroed}
  688.                                {665 = 16 for filespec + 384 for max key specs}
  689.    FileBufLen := MaxFileSpecLength;{+ 265 for an alternate collating sequence}
  690.    KeyBufLen  := 384;                {Max of 24 keys * 16 bytes per key spec.}
  691.    HasAltCol := false;            {initialize to false 'until proven guilty!'}
  692.    AltColName := '';
  693.    ConvertName(UserFileName);             {Sets fields DFileName and FileName}
  694.    IsVarLength := false;
  695.    HasOwner := false;
  696.    OwnerName := '';
  697.    if OName <> '' then
  698.       begin
  699.       OwnerName := OName;
  700.       HasOwner := true;
  701.       end;
  702.    Status := Open(OpenMode);
  703.    if Status = 0 then                    {if open op successful, do a stat op}
  704.       begin
  705.          Status := Btrv(BStat, PosBlk, Specs.SpecBuf, FileBufLen, KeyBufLen,
  706.                         Zero);
  707.          {Btrieve filespecs and key specs are now in the BFile object!}
  708.          {Variable FileBufLen will have been changed to size of data
  709.           buffer returned by stat call.  Save that value now.}
  710.          if Status = 0 then     {if stat successfull, fill object data fields}
  711.             begin
  712.                SpecLength := FileBufLen;
  713.                NumRecsWord1 := Specs.NumRecs[1];  {get rid of sign bit!! by  }
  714.                NumRecsWord2 := Specs.NumRecs[2];  {converting 2 ints to words}
  715.                NumRecs := NumRecsWord1 + NumRecsWord2 * 65536;
  716.                NumSegs := Specs.NumKeys;
  717.                if (Specs.FileFlags and VarLength) = VarLength then
  718.                   IsVarLength := true;
  719.                Counter := 1; Counter1 := 0;
  720.                while Counter <= Specs.NumKeys do     {Will be skipped if data}
  721.                   CountSegments;                     {only file.             }
  722.                if HasAltCol then
  723.                   begin
  724.                   AltColNameOffset := (16+KeySpecSize*NumSegs+1);
  725.                   for Counter := 1 to 8 do
  726.                      AltColName[Counter] := chr(Specs.Entire[AltColNameOffset + Counter]);
  727.                   end;
  728.                DBufferLen := Specs.RecLen;
  729.                BStatus := 0;                  {all went well, return a code 0}
  730.             end
  731.             else
  732.             begin
  733.                BStatus := Status;  {Open op succeeded but stat failed; put   }
  734.                Status  := Close;   {error code for bad stat in global var and}
  735.             end;                   {close the damn file quick!}
  736.          end
  737.    else
  738.    BStatus := Status;             {assign err code for bad open to global var}
  739. end;
  740.  
  741.  
  742. (* BFILE.BT function *)
  743. (* ----------------- *)
  744. function BFile.BT(OpCode, Key: integer): integer;
  745. begin
  746.    Abstract;
  747. end;
  748.  
  749.  
  750. (* BFILE.OPEN function *)
  751. (* ------------------- *)
  752. function BFile.Open(OpenMode: integer): integer;
  753. var
  754.    BufferSize: integer;
  755. begin
  756.    if HasOwner then
  757.       begin
  758.       BufferSize := 8;
  759.       Open := Btrv(BOpen, PosBlk, OwnerName[1], BufferSize, FileName, OpenMode);
  760.       end
  761.       else
  762.       Open := Btrv(BOpen, PosBlk, VarNotRequired, VarNotRequired, FileName, OpenMode);
  763. end;
  764.  
  765.  
  766. (* BFILE.CLOSE Function *)
  767. (* -------------------- *)
  768. function BFile.Close: integer;
  769. begin
  770.    Close := Btrv(BClose, PosBlk, VarNotRequired, VarNotRequired,
  771.                  VarNotRequired, NotRequired);
  772. end;
  773.  
  774.  
  775. (* BFILE.ADDSUPPIDX Function *)
  776. (* ------------------------- *)
  777. function BFile.AddSuppIdx(KeyList: PKeyList; const AltColFile: FNameStr): boolean;
  778. type
  779.    PBuffer = ^TBuffer;
  780.    TBuffer =  array[0..MaxFileSpecLength] of byte;
  781. var
  782.    NewSegmentCount,
  783.    Offset:           integer;
  784.    SuppIdxHasAltCol: boolean;
  785.    AKeyList, X1, X2: PKeyList;
  786.    ACS:              PAltColSeq;
  787.    Buffer:           PBuffer;
  788.    BufferLength:     integer;
  789. begin
  790.    NewSegmentCount := 1;
  791.    SuppIdxHasAltCol := false;
  792.    Offset := 0;
  793.    AKeyList := KeyList;
  794.    while (AKeyList^.Next <> nil) do  {Count # segs in new supp idx.}
  795.       begin
  796.       inc(NewSegmentCount);
  797.       AKeyList := AKeyList^.Next;
  798.       end;
  799.    if (NewSegmentCount + NumSegs) > MaxNumSegments then
  800.       AddSuppIdx := false
  801.       else
  802.       begin
  803.       new(Buffer);
  804.       fillchar(Buffer^, sizeof(Buffer^), 0);
  805.       AKeyList := KeyList;
  806.       repeat
  807.          if (AKeyList^.KeySpec.KeyFlags and AltCol) = AltCol then
  808.             SuppIdxHasAltCol := true;
  809.          move(AKeyList^.KeySpec, Buffer^[Offset], KeySpecSize);
  810.          inc(Offset, KeySpecSize);
  811.          AKeyList := AKeyList^.Next;
  812.          until (AKeyList = nil);
  813.       if (KeyList <> nil) then          {Dispose of linked list of key specs.}
  814.          begin
  815.          X1 := KeyList;
  816.          while (X1^.Next <> nil) do
  817.             begin
  818.             X2 := X1^.Next;
  819.             dispose(X1);
  820.             X1 := X2;
  821.             end;
  822.          dispose(X1);
  823.          end;
  824.       BufferLength := KeySpecSize * NewSegmentCount;
  825.       {If the supp index will have an ACS, get it into data buffer, and add
  826.        its size to DBufferLen parameter.}
  827.       if (AltColFile <> '') and SuppIdxHasAltCol then
  828.          begin
  829.          ACS := new(PAltColSeq, Init(AltColFile));
  830.          if (ACS <> nil) then
  831.             begin
  832.             move(ACS^.Spec, Buffer^[BufferLength], sizeof(ACS^.Spec));
  833.             inc(BufferLength, sizeof(ACS^.Spec));
  834.             dispose(ACS, Done);
  835.             end;
  836.          end;
  837.       BStatus := Btrv(BCrSuppIdx, PosBlk, Buffer^, BufferLength, VarNotRequired, NotRequired);
  838.       dispose(Buffer);
  839.       if BStatus = 0 then
  840.          AddSuppIdx := true
  841.          else
  842.          AddSuppIdx := false;
  843.       end;
  844. end;
  845.  
  846.  
  847. (* BFILE.DONE Destructor *)
  848. (* --------------------- *)
  849. destructor BFile.Done;
  850. begin
  851.    inherited Done;
  852. end;
  853.  
  854.  
  855. (* BFILE.CONVERTNAME Procedure *)
  856. (* --------------------------- *)
  857. {this one is private to BFile}
  858. procedure BFile.ConvertName(const UserFileName: FNameStr);
  859. begin
  860.    DFileName := UserFileName;
  861.    move(DFileName[1], FileName[1], length(DFileName));  {conv string to array}
  862.    FileName[length(DFileName) + 1] := ' ';         {provide required pad char}
  863. end;
  864.  
  865.  
  866. (* BFIXED.INIT Constructor *)
  867. (* ----------------------- *)
  868. constructor BFixed.Init(const UserFileName: FNameStr; OpenMode: integer;
  869.                         const OName: TOwnerName);
  870. begin
  871.    inherited Init(UserFileName, OpenMode, OName);
  872. end;
  873.  
  874.  
  875. (* BFIXED.BT function *)
  876. (* ----------------- *)
  877. function BFixed.BT(OpCode, Key: integer): integer;
  878. begin
  879.    BT := Btrv(OpCode, PosBlk, DBuffer, Specs.RecLen, KBuffer, Key);
  880. end;
  881.  
  882.  
  883. (* BFIXED.DONE Destructor *)
  884. (* ---------------------- *)
  885. destructor BFixed.Done;
  886. begin
  887.    inherited Done;
  888. end;
  889.  
  890.  
  891. (* BSIZED.INIT Constructor *)
  892. (* ----------------------- *)
  893. constructor BSized.Init(const UserFileName: FNameStr; OpenMode: integer;
  894.                         const OName: TOwnerName; BuffSize: integer);
  895. begin
  896.    inherited Init(UserFileName, OpenMode, OName);
  897.    if BuffSize <= 0 then
  898.       BuffSize := MaxFixedRecLength;
  899.    DBufferSize := BuffSize;
  900.    DBuffer := memallocseg(BuffSize);
  901.    KBuffer := memallocseg(MaxKBufferLength);
  902.    fillchar(DBuffer^, BuffSize, 0);
  903.    fillchar(KBuffer^, MaxKBufferLength, 0);
  904. end;
  905.  
  906.  
  907. (* BSIZED.DONE Destructor *)
  908. (* ---------------------- *)
  909. destructor BSized.Done;
  910. begin
  911.    if DBuffer <> nil then freemem(DBuffer, DBufferSize);
  912.    if KBuffer <> nil then freemem(KBuffer, MaxKBufferLength);
  913.    DBuffer := nil;
  914.    KBuffer := nil;
  915.    inherited Done;
  916. end;
  917.  
  918.  
  919. (* BSIZED.BT Function *)
  920. (* ------------------ *)
  921. function BSized.BT(OpCode, Key: integer): integer;
  922. begin
  923.    BT := Btrv(OpCode, PosBlk, DBuffer^, DBufferLen, KBuffer^, Key);
  924. end;
  925.  
  926.  
  927. (* TFILTERSPEC.INITF Constructor *)
  928. (* ----------------------------- *)
  929. {Be sure to remember that the offset parameter here is 0 relative to start of
  930.  record!!}
  931.  
  932. constructor TFilterSpec.InitF(FieldType: byte; FieldLen, Offset: integer;
  933.                               CompCode, Expression: byte; CompOffset: integer);
  934. begin
  935.    inherited Init;                            {assures all data fields zeroed}
  936.    LogicTerm.FieldType  := FieldType;
  937.    LogicTerm.FieldLen   := FieldLen;
  938.    LogicTerm.Offset     := Offset;
  939.    LogicTerm.CompCode   := CompCode;
  940.    LogicTerm.Expression := Expression;
  941.    LogicTerm.FieldComp  := true;
  942.    LogicTerm.CompOffset := Offset;
  943. end;
  944.  
  945.  
  946. (* TFILTERSPEC.INITV Constructor *)
  947. (* ----------------------------- *)
  948. {Be sure to remember that the offset parameter here is 0 relative to start of
  949.  record!!}
  950.  
  951. constructor TFilterSpec.InitV(FieldType: byte; FieldLen, Offset: integer;
  952.                               CompCode, Expression: byte; const Value: array of byte);
  953. begin
  954.    inherited Init;                            {assures all data fields zeroed}
  955.    LogicTerm.FieldType := FieldType;
  956.    LogicTerm.FieldLen  := FieldLen;
  957.    LogicTerm.Offset    := Offset;
  958.    LogicTerm.CompCode  := CompCode;
  959.    LogicTerm.Expression:= Expression;
  960.    LogicTerm.FieldComp := false;
  961.    move(Value[0], LogicTerm.Value[1], high(Value)+1);
  962. end;
  963.  
  964.  
  965. (* TFILTERSPEC.DONE Destructor *)
  966. (* --------------------------- *)
  967. destructor TFilterSpec.Done;
  968. begin
  969.    inherited Done;
  970. end;
  971.  
  972.  
  973. (* TEXTSPEC.INIT Constructor *)
  974. (* ------------------------- *)
  975. constructor TExtSpec.Init(Len, Ofs: integer);
  976. begin
  977.    inherited Init;                            {assures all data fields zeroed}
  978.    ExtRepeater.FieldLen := Len;
  979.    ExtRepeater.Offset   := Ofs;
  980. end;
  981.  
  982.  
  983. (* TEXTSPEC.DONE Destructor *)
  984. (* ----------------------- *)
  985. destructor TExtSpec.Done;
  986. begin
  987.    inherited Done;
  988. end;
  989.  
  990.  
  991. (* BFILEEXT.INIT Constructor *)
  992. (* ------------------------- *)
  993. {always check for a failure!}
  994.  
  995. constructor BFileExt.Init(const UserFileName: FNameStr; OpenMode: integer;
  996.                           const OName: TOwnerName);
  997. begin
  998.    inherited Init(UserFileName, OpenMode, OName);
  999.    Header.Constant[1] := 'E';
  1000.    Header.Constant[2] := 'G';
  1001.    ExtDBuffer    := memallocseg(MaxExtDBufferLength);
  1002.    FilterSpec    := new(PCollection, Init(2,2));
  1003.    ExtractorSpec := new(PCollection, Init(5,2));
  1004.    if (ExtDBuffer = nil) or (FilterSpec = nil) or (ExtractorSpec = nil) then
  1005.       Fail;
  1006. end;
  1007.  
  1008.  
  1009. (* BFILEEXT.DONE Destructor *)
  1010. (* ------------------------ *)
  1011. destructor BFileExt.Done;
  1012. begin
  1013.    inherited Done;
  1014.    dispose(ExtDBuffer);
  1015.    dispose(ExtractorSpec, Done);
  1016.    dispose(FilterSpec, Done);
  1017. end;
  1018.  
  1019.  
  1020. (* BFILEEXT.SETEXTDBUFFERLEN function *)
  1021. (* ---------------------------------- *)
  1022. {Compute sizes of data buffers sent and returned, to determine proper size to
  1023.  specify in call.  Assumes user program has inserted proper items into the
  1024.  collections for filter terms and extractor specs.  Is private to BFileExt.}
  1025.  
  1026. procedure BFileExt.SetExtDBufferLen;
  1027. var
  1028.    LengthSent, LengthReturned,
  1029.    RecordLengthReturned, RecordImageReturned : integer;
  1030.  
  1031.    procedure MakeFilterSpecs;
  1032.       procedure CalcFilterLengths(FSpec: PFilterSpec); far;
  1033.       begin
  1034.       with FSpec^ do
  1035.          begin
  1036.          inc(LengthSent, 7);
  1037.          if (LogicTerm.CompCode and UseField) = UseField then
  1038.             inc(LengthSent, 2)
  1039.             else
  1040.             inc(LengthSent, LogicTerm.FieldLen);
  1041.          end;
  1042.       end;
  1043.    begin
  1044.       FilterSpec^.ForEach(@CalcFilterLengths);
  1045.    end;
  1046.  
  1047.    procedure MakeExtSpecs;
  1048.       procedure CalcExtLengths(ExtSpec: PExtSpec); far;
  1049.       begin
  1050.          with ExtSpec^ do
  1051.             begin
  1052.             inc(LengthSent, 4);
  1053.             inc(RecordLengthReturned, ExtRepeater.FieldLen);
  1054.             end;
  1055.       end;
  1056.    begin
  1057.       ExtractorSpec^.ForEach(@CalcExtLengths);
  1058.    end;
  1059.  
  1060. begin
  1061.    LengthSent := 8; {4 for header length, 4 for fixed filter length}
  1062.  
  1063.    {Work on filter logic term portion of spec.}
  1064.    if FilterSpec^.Count > 0 then       {if any filter terms in the collection}
  1065.       MakeFilterSpecs;
  1066.  
  1067.    {Work on extractor portion of spec.}
  1068.    inc(LengthSent, 4);                       {size of fixed part of extractor}
  1069.    RecordLengthReturned := 0;
  1070.    MakeExtSpecs;              {there must always be at least 1 extractor spec}
  1071.  
  1072.    {2 for count of recs, 4 for currency pos}
  1073.    RecordImageReturned := RecordLengthReturned + 6;
  1074.    {2 for count of recs}
  1075.    LengthReturned := 2 + (RecordImageReturned * Extractor.NumRecords);
  1076.  
  1077.    Header.DBufferLen := LengthSent;
  1078.  
  1079.    if LengthSent >= LengthReturned then
  1080.       DBufferLen := LengthSent
  1081.       else
  1082.       DBufferLen := LengthReturned;
  1083. end;
  1084.  
  1085.  
  1086. (* BFILEEXT.MAKEEXTDBUFFER Function *)
  1087. (* -------------------------------- *)
  1088. {Private to BFileExt, called in BFileExt.BT, which is called by each
  1089.  descendant's override of BFileExt.BT.  Assumes program has already set up
  1090.  the collections required.}
  1091.  
  1092. procedure BFileExt.MakeExtDBuffer;
  1093. var
  1094.    Offset : integer;
  1095.  
  1096.    procedure MoveFilterSpecs;
  1097.       procedure MoveSingleFilterSpec(FSpec: PFilterSpec); far;
  1098.       begin
  1099.          with FSpec^ do
  1100.             begin
  1101.             {move fixed part of logic term}
  1102.             move(LogicTerm, ExtDBuffer^.Entire[Offset], sizeof(LogicTerm.Fixed));
  1103.             inc(Offset, sizeof(LogicTerm.Fixed));
  1104.             {now need to move variable part of logic term}
  1105.             if (LogicTerm.CompCode and UseField) = UseField then
  1106.                begin
  1107.                move(LogicTerm.CompOffset, ExtDBuffer^.Entire[Offset],
  1108.                     sizeof(LogicTerm.CompOffset));
  1109.                Offset := Offset + sizeof(LogicTerm.CompOffset);
  1110.                end
  1111.                else
  1112.                begin
  1113.                move(LogicTerm.Value, ExtDBuffer^.Entire[Offset],
  1114.                     LogicTerm.FieldLen);
  1115.                Offset := Offset + LogicTerm.FieldLen;
  1116.                end;
  1117.             end;
  1118.       end;
  1119.    begin
  1120.       FilterSpec^.ForEach(@MoveSingleFilterSpec);
  1121.    end;
  1122.  
  1123.    procedure MoveExtractorSpecs;
  1124.       procedure MoveSingleExtractorSpec(ExtSpec: PExtSpec); far;
  1125.       begin
  1126.         with ExtSpec^ do
  1127.            begin
  1128.            move(ExtSpec^.ExtRepeater, ExtDBuffer^.Entire[Offset],
  1129.                 sizeof(ExtSpec^.ExtRepeater));
  1130.            Offset := Offset + sizeof(ExtSpec^);
  1131.            end;
  1132.       end;
  1133.    begin
  1134.       ExtractorSpec^.ForEach(@MoveSingleExtractorSpec);
  1135.    end;
  1136.  
  1137. begin
  1138.    {Move header definition into buffer.}
  1139.    move(Header, ExtDBuffer^.Header, sizeof(Header));
  1140.  
  1141.    {Move fixed part of filter definition into buffer.}
  1142.    move(Filter, ExtDBuffer^.Filter, sizeof(Filter));
  1143.    Offset := 1 + sizeof(Header) + sizeof(Filter);
  1144.  
  1145.    {Read filter logic terms into buffer.}
  1146.    if FilterSpec^.Count > 0 then
  1147.       MoveFilterSpecs;
  1148.  
  1149.    {Move fixed part of extractor definition into buffer.}
  1150.    move(Extractor, ExtDBuffer^.Entire[Offset], sizeof(Extractor.Entire));
  1151.    Offset := Offset + sizeof(Extractor.Entire);
  1152.  
  1153.    {Move extractor terms into buffer.}
  1154.    MoveExtractorSpecs;
  1155. end;
  1156.  
  1157.  
  1158. (* BFILEEXT.BTEXT function *)
  1159. (* ----------------------- *)
  1160. {Overrides of this function in BFileExt descendants MUST call
  1161.  BFileExt.BTExt, as it sets the buffer length in the header, and puts
  1162.  together the 'send' buffer.  User programs MUST have inserted filter logic
  1163.  terms and extractor specs into their respective collections before invoking
  1164.  this function, or they'll make a fine mess of things, Ollie!}
  1165.  
  1166. function BFileExt.BTExt(OpCode, Key: integer): integer;
  1167. begin
  1168.    SetExtDBufferLen;
  1169.    MakeExtDBuffer;
  1170. end;
  1171.  
  1172.  
  1173. (* BFILEEXT.SETTERMS procedure *)
  1174. (* --------------------------- *)
  1175. procedure BFileExt.SetTerms(MSkip, NumLTerms, NRecs, NumFlds: integer);
  1176. begin
  1177.    Filter.MaxSkip       := MSkip;
  1178.    Filter.NumLogicTerms := NumLTerms;
  1179.    Extractor.NumRecords := NRecs;
  1180.    Extractor.NumFields  := NumFlds;
  1181. end;
  1182.  
  1183.  
  1184. (* IMPLEMENTATION OF UTILITY FUNCTIONS/PROCEDURES *)
  1185. (* ------------------------------------------------------------------------ *)
  1186.  
  1187. (* CREATEFILE function *)
  1188. (* -------------------- *)
  1189. {Assumes a PFILESPEC variable has been instantiated and assigned its values,
  1190.  and that if you use an alternate collating sequence, it exists in the
  1191.  current directory.  No specific support for null keys, blank compression,
  1192.  data-only files.}
  1193.  
  1194. function CreateFile(const UserFileName: FNameStr; UserFileSpec:PFileSpec;
  1195.                     const AltColFile: FNameStr; const OName: TOwnerName;
  1196.                     Access: integer): integer;
  1197. var
  1198.    CFSpecLength,
  1199.    Counter,
  1200.    Counter1,
  1201.    NumSegs,
  1202.    Temp            : integer;
  1203.    BtrieveFileName : BFileName;
  1204.    HasAltCol       : boolean;
  1205.    AltColObj       : PAltColSeq;
  1206.    NewFile         : PBFixed;
  1207.  
  1208.    procedure CountSegments;
  1209.    begin
  1210.       with UserFileSpec^ do
  1211.          repeat
  1212.          if (KeyArray[Counter1].KeyFlags and Segmented) = Segmented then
  1213.             begin
  1214.             if (KeyArray[Counter1].KeyFlags and AltCol) = AltCol then
  1215.                HasAltCol  := true;
  1216.             inc(NumSegs);
  1217.             inc(Counter1);
  1218.             end
  1219.             else
  1220.             begin
  1221.             if (KeyArray[Counter1].KeyFlags and AltCol) = AltCol then
  1222.                HasAltCol  := true;
  1223.             inc(Counter);
  1224.             inc(Counter1);
  1225.             end;
  1226.          until (KeyArray[Counter1-1].KeyFlags and Segmented) <> Segmented;
  1227.    end;
  1228.  
  1229. begin
  1230.    move(UserFileName[1], BtrieveFileName[1], length(UserFileName));
  1231.    BtrieveFileName[length(UserFileName) + 1] := ' ';
  1232.    Counter := 1; Counter1 := 0;
  1233.    NumSegs := UserFileSpec^.NumKeys;
  1234.    while Counter <= UserFileSpec^.NumKeys do
  1235.       CountSegments;
  1236.    CFSpecLength := 16 + (NumSegs * KeySpecSize);
  1237.    UserFileSpec^.Reserved[1] := chr(0);
  1238.    UserFileSpec^.Reserved[2] := chr(0);
  1239.    if (AltColFile <> '') and (HasAltCol = true) then  {Note the double check!}
  1240.       begin
  1241.       AltColObj   := new(PAltColSeq, Init(AltColFile));
  1242.       move(AltColObj^.Spec, UserFileSpec^.Entire[CFSpecLength+1],
  1243.          sizeof(AltColObj^.Spec));
  1244.       CFSpecLength := CFSpecLength + sizeof(AltColObj^.Spec);
  1245.       dispose(AltColObj, Done);
  1246.       end;
  1247.    BStatus := Btrv(BCreate, VarPosBlk, UserFileSpec^.SpecBuf, CFSpecLength,
  1248.                    BtrieveFileName, Zero);
  1249.    if (BStatus = 0) and (OName <> '')  then
  1250.       begin
  1251.       NewFile := new(PBFixed, Init(UserFileName, Exclusive, ''));
  1252.       fillchar(NewFile^.DBuffer[1], 9, 0);
  1253.       fillchar(NewFile^.KBuffer[1], 9, 0);
  1254.       Temp := length(OName);
  1255.       with NewFile^ do
  1256.          begin
  1257.          move(OName[1], DBuffer[1], Temp);
  1258.          move(OName[1], KBuffer[1], Temp);
  1259.          inc(Temp);
  1260.          Specs.RecLen := Temp;
  1261.          BStatus := BT(BSetOwner, Access);
  1262.          Close;
  1263.          end;
  1264.       dispose(NewFile, Done);
  1265.       end;
  1266.    CreateFile := BStatus;
  1267. end;
  1268.  
  1269.  
  1270. (* CLONEFILE function *)
  1271. (* ------------------ *)
  1272. {Programmer is responsible for assuring that 'CurrentFile' exists and can be
  1273.  opened.  Function will overwrite any existing file with 'NewFile' name.
  1274.  The integer returned here can be meaningless if the current file does not
  1275.  exist or is not opened properly.  This function is as streamlined as
  1276.  possible, but puts RESPONSIBILITY on the programmer.
  1277.  
  1278.  It is entirely possible that this clone function will NOT return a byte for
  1279.  byte matching file, if cloning an 'empty' Btrieve file.  This would be due
  1280.  to the inability to determine the number of pages pre-allocated when a file
  1281.  was created, if preallocation had been used.  The Btrieve Stat call uses
  1282.  the 'Preallocate # of pages' bytes to return the number of unused pages!!
  1283.  Thus, the CloneFile function clears the Preallocation bit in the FileFlags
  1284.  before creating the new file.  A non-exact copy would also result if the
  1285.  source file used an owner name, as the clone will NOT bear an owner name.
  1286.  If you want an owner name in the clone, add it AFTER creating the clone.
  1287.  
  1288.  NOTE: This function goes beyond the capability of "BUTIL -CLONE" in that
  1289.        this function has flexible handling of supplemental indexes in the
  1290.  cloned file. It can drop, retain, or make them permanent in the clone.  In
  1291.  addition, if no permanent indexes use an alternate collating sequence, but
  1292.  one or more supplemental indexes DOES use one, the clone can retain the
  1293.  supplemental indexes WITH the collating sequence, duplicating the source
  1294.  file's structure perfectly.  This is something that "BUTIL -CLONE" simply
  1295.  CANNOT HANDLE!!
  1296. }
  1297.  
  1298. function CloneFile(const CurrentFile, NewFile:FNameStr; Option: integer;
  1299.                    const OName: TOwnerName): integer;
  1300. type
  1301.    PSuppIdxList       = ^TSuppIdxList;
  1302.    TSuppIdxList       = array[0..23] of boolean;   {will hold list of indexes}
  1303.    PSuppIdx           = ^TSuppIdx;
  1304.    TSuppIdx           = array[0..23] of TKeySpec;
  1305.    PSuppIdxHasAltCol  = ^TSuppIdxHasAltCol;
  1306.    TSuppIdxHasAltCol  = array[0..23] of boolean;
  1307. var
  1308.    HasSuppIdx,
  1309.    PermKeyHasAltCol  : boolean;
  1310.    NumberSuppSegs,
  1311.    NumberSuppIdx,
  1312.    NewOffset,
  1313.    DBuffOffset,
  1314.    Counter, Counter1,
  1315.    NewSpecLength,
  1316.    NewNumKeys        : integer;
  1317.    CurrentBFile      : PBFile;
  1318.    NewBFile          : PBFixed;
  1319.    NewBFileName      : BFileName;
  1320.    NewFileSpec       : PFileSpec;
  1321.    SuppIdxList       : PSuppIdxList;
  1322.    SuppIdx           : PSuppIdx;
  1323.    SuppIdxHasAltCol  : PSuppIdxHasAltCol;
  1324. begin
  1325.    HasSuppIdx       := false;
  1326.    PermKeyHasAltCol := false;
  1327.    NumberSuppSegs   :=  0;
  1328.    NumberSuppIdx    :=  0;
  1329.    NewOffset        := 17;
  1330.    DBuffOffset      :=  1;
  1331.    SuppIdxList      := new(PSuppIdxList);
  1332.    SuppIdx          := new(PSuppIdx);
  1333.    SuppIdxHasAltCol := new(PSuppIdxHasAltCol);
  1334.    NewFileSpec      := new(PFileSpec);
  1335.    fillchar(SuppIdxList^, sizeof(SuppIdxList^), false);
  1336.    fillchar(SuppIdx^, sizeof(SuppIdx^), 0);
  1337.    fillchar(SuppIdxHasAltCol^, sizeof(SuppIdxHasAltCol^), false);
  1338.    fillchar(NewFileSpec^, sizeof(NewFileSpec^), 0);  {initialize spec w/zeros}
  1339.  
  1340.    move(NewFile[1], NewBFileName[1], length(NewFile));{establish new filename}
  1341.    NewBFileName[length(NewFile) + 1] := ' ';
  1342.  
  1343.    CurrentBFile := new(PBFile, Init(CurrentFile, ReadOnly, OName));
  1344.    if BStatus <> 0 then        {Exit function if problem opening source file.}
  1345.      begin
  1346.      CloneFile := BStatus;
  1347.      exit;
  1348.      end;
  1349.  
  1350.    {Clear the PreAllocate file flag bit if it had been set in CurrentBFile.}
  1351.    CurrentBFile^.Specs.FileFlags := CurrentBFile^.Specs.FileFlags and $FD;
  1352.    CurrentBFile^.Specs.UnusedPgs := 0; {If preallocate file flag was set, the}
  1353.                                         {cloned file will have no pages pre- }
  1354.                                         {allocated...NO way to get the       }
  1355.                                         {original # of pre-allocated pages!  }
  1356.  
  1357.    NewSpecLength := CurrentBFile^.SpecLength;        {Initialize...may reduce}
  1358.    NewNumKeys    := CurrentBFile^.Specs.NumKeys;     {both of these later.   }
  1359.    move(CurrentBFile^.Specs, NewFileSpec^, 16);      {Get filespecs, not keys}
  1360.  
  1361.    {Determine if there are any supplemental indexes in source file.  If so,
  1362.     set indicator HasSuppIdx to true, set boolean in an array to true, and
  1363.     get a count of number of supplemental indexes, and count of total number
  1364.     of supplemental index segments.}
  1365.    with CurrentBFile^ do
  1366.       for Counter := 1 to NumSegs do
  1367.          with Specs.KeyArray[Counter-1] do
  1368.             begin
  1369.             if ((KeyFlags and AltCol) = AltCol) and
  1370.                ((KeyFlags and Supplemental) <> Supplemental) then
  1371.                PermKeyHasAltCol := true;
  1372.             if (KeyFlags and Supplemental) = Supplemental then
  1373.                begin
  1374.                if (KeyFlags and AltCol) = AltCol then
  1375.                   SuppIdxHasAltCol^[NumberSuppSegs] := true;
  1376.                HasSuppIdx := true;
  1377.                SuppIdxList^[Counter-1] := true;
  1378.                move(Specs.KeyArray[Counter-1], SuppIdx^[NumberSuppSegs], KeySpecSize);
  1379.                SuppIdx^[NumberSuppSegs].KeyFlags :=     {Zero supplemental bit}
  1380.                   SuppIdx^[NumberSuppSegs].KeyFlags and $FF7F;
  1381.                inc(NumberSuppSegs);      {inc count of supplemental segments.}
  1382.                if (Specs.KeyArray[Counter-1].KeyFlags and Segmented) <>
  1383.                    Segmented then
  1384.                    inc(NumberSuppIdx);    {inc count of supplemental indexes.}
  1385.                end;            {if (KeyFlags and Supplemental) = Supplemental}
  1386.             end;
  1387.  
  1388.    if ((Option = Drop) or (Option = Retain)) and HasSuppIdx then
  1389.       begin
  1390.          Counter1 := 0;
  1391.          for Counter := 1 to CurrentBFile^.Specs.NumKeys do
  1392.             begin
  1393.                if SuppIdxList^[Counter1] = true then dec(NewNumKeys);
  1394.                repeat
  1395.                   if (SuppIdxList^[Counter1] = false) then
  1396.                      begin
  1397.                      move(CurrentBFile^.Specs.KeyArray[Counter1],
  1398.                           NewFileSpec^.KeyArray[Counter1], KeySpecSize);
  1399.                      inc(NewOffset, KeySpecSize);
  1400.                      end
  1401.                      else
  1402.                      dec(NewSpecLength, KeySpecSize);
  1403.                   inc(Counter1);
  1404.                until (CurrentBFile^.Specs.KeyArray[Counter1-1].KeyFlags and Segmented)
  1405.                       <> Segmented;
  1406.             end;          {for Counter := 1 to CurrentBFile^.Specs.NumKeys do}
  1407.  
  1408.          NewFileSpec^.NumKeys := NewNumKeys;
  1409.  
  1410.          if (CurrentBFile^.HasAltCol) = true then
  1411.             move(CurrentBFile^.Specs.Entire[17 + (CurrentBFile^.NumSegs * KeySpecSize)],
  1412.                NewFileSpec^.Entire[NewOffset], 265);
  1413.  
  1414.          {Next line executed if source file has supplemental indexes, whether
  1415.           they are to be dropped or retained.}
  1416.          CloneFile := Btrv(BCreate, VarPosBlk, NewFileSpec^, NewSpecLength,
  1417.                            NewBFileName, Zero);
  1418.       end;{if ((Option = Drop) or (Option = Retain)) and HasSuppIdx}
  1419.  
  1420.    {If retaining the supplemental indexes, then at this point we're ready to
  1421.     add them to the newly created file.}
  1422.    if (Option = Retain) and HasSuppIdx then
  1423.       begin
  1424.          NewBFile := new(PBFixed, Init(NewFile, Accel, ''));
  1425.          Counter1 := 0;
  1426.          for Counter := 1 to NumberSuppIdx do
  1427.             begin
  1428.                repeat
  1429.                   move(SuppIdx^[Counter1], NewBFile^.DBuffer[DBuffOffset], KeySpecSize);
  1430.                   inc(DBuffOffset, KeySpecSize);
  1431.                   inc(Counter1);
  1432.                until ((SuppIdx^[Counter1-1].KeyFlags) and Segmented) <> Segmented;
  1433.                with NewBFile^ do
  1434.                   begin
  1435.                   DBufferLen := Counter1 * KeySpecSize;
  1436.                   if SuppIdxHasAltCol^[Counter1-1] and (PermKeyHasAltCol = false) then
  1437.                      begin
  1438.                      move(CurrentBFile^.Specs.Entire[CurrentBFile^.SpecLength - 264],
  1439.                           DBuffer[DBuffOffset], 265);
  1440.                      inc(DBufferLen, 265);
  1441.                      end;
  1442.                   BStatus := Btrv(BCrSuppIdx, PosBlk, DBuffer, DBufferLen, KBuffer, Zero);
  1443.                   fillchar(DBuffer, sizeof(DBuffer), 0);
  1444.                   end;
  1445.                inc(DBuffOffset);
  1446.             end;
  1447.          BStatus := NewBFile^.Close;
  1448.          CloneFile := BStatus;
  1449.          dispose(NewBFile, Done);
  1450.       end;
  1451.  
  1452.    {WARNING!! If user program specified 'None' and there actually ARE one or
  1453.     more supplemental indexes in the source file, they WILL be retained in
  1454.     the target file, as permanent indexes!}
  1455.    if (Option = None) or ((Option = Retain) and (not HasSuppIdx)) or
  1456.       ((Option = Drop) and (not HasSuppIdx)) then
  1457.       begin
  1458.       BStatus := Btrv(BCreate, VarPosBlk, CurrentBFile^.Specs,
  1459.                       CurrentBFile^.SpecLength, NewBFileName, Zero);
  1460.       CloneFile := BStatus;
  1461.       end;
  1462.  
  1463.    CurrentBFile^.Close;
  1464.    dispose(CurrentBFile, Done);
  1465.    dispose(NewFileSpec); {Note NewFileSpec is not used if HandleSupps=None}
  1466.    dispose(SuppIdxHasAltCol);
  1467.    dispose(SuppIdx);
  1468.    dispose(SuppIdxList);
  1469. end;
  1470.  
  1471.  
  1472. (* NEWKEYSPEC Function *)
  1473. (* ------------------- *)
  1474. function NewKeySpec(KPos, KLen, KFlags: integer; EType: byte;
  1475.                     NextKey: PKeyList): PKeyList;
  1476. var TheKeyList: PKeyList;
  1477. begin
  1478.    TheKeyList := new(PKeyList);
  1479.    fillchar(TheKeyList^, sizeof(TheKeyList^), 0);
  1480.    with TheKeyList^.KeySpec do
  1481.       begin
  1482.       KeyPos := KPos;
  1483.       KeyLen := KLen;
  1484.       KeyFlags := KFlags;
  1485.       ExtKeyType := EType;
  1486.       end;
  1487.    TheKeyList^.Next := NextKey;
  1488.    NewKeySpec := TheKeyList;
  1489. end;
  1490.  
  1491.  
  1492. (* IS BTRIEVE LOADED procedure *)
  1493. (* --------------------------- *)
  1494. {this is private to the unit, and is executed only during unit initialization}
  1495. function IsBtrieveLoaded: boolean;
  1496. begin
  1497.    BStatus := Btrv(BReset, VarPosBlk, VarNotRequired, VarNotRequired,
  1498.                    VarNotRequired, Zero);
  1499.    if BStatus = BtrieveNotLoaded then
  1500.       IsBtrieveLoaded := false
  1501.       else
  1502.       IsBtrieveLoaded := true;
  1503. end;
  1504.  
  1505.  
  1506. (* MISCELLANEOUS Functions *)
  1507. (* ----------------------- *)
  1508.  
  1509. {LTrim and RTrim were taken from one of the Turbo Vision .PAS source files!}
  1510.  
  1511. function LTrim(S: String): String;
  1512. var
  1513.    I: integer;
  1514. begin
  1515.    I := 1;
  1516.    while (I < length(S)) and (S[I] = ' ') do inc(I);
  1517.    LTrim := copy(S, I, 255);
  1518. end;
  1519.  
  1520. function RTrim(S: String): String;
  1521. var
  1522.    I: integer;
  1523. begin
  1524.    while S[Length(S)] = ' ' do dec(S[0]);
  1525.    RTrim := S;
  1526. end;
  1527.  
  1528.  
  1529. (* INITIALIZATION Section *)
  1530. (* ----------------------------------------------------------------------- *)
  1531. END.
  1532.  
  1533.