UNIT BTP;    {Version 1.5  11/9/91                      (C) 1991 John C. Leon}

{$A+}    {word alignment.  Btrieve interface call wants this global directive
          set; is the default compiler setting anyway.                       }

INTERFACE
(* ------------------------------------------------------------------------ *)
(* ------------------------------------------------------------------------ *)
USES Objects, Memory;

CONST
{      Key Attributes            Key Types          Open Modes               }
{    ------------------      ----------------     ---------------            }
     Duplicates   =   1;     BString    =  0;     Normal    =  0;
     Modifiable   =   2;     BInteger   =  1;     Accel     = -1;
     Binary       =   4;     BFloat     =  2;     ReadOnly  = -2;
     Null         =   8;     BDate      =  3;     Verify    = -3;
     Segmented    =  16;     BTime      =  4;     Exclusive = -4;
     AltCol       =  32;     BDecimal   =  5;
     Descending   =  64;     BMoney     =  6;   {        File Flags        }
     Supplemental = 128;     BLogical   =  7;   { ------------------------ }
     ExtType      = 256;     BNumeric   =  8;     VarLength   =  1;
     Manual       = 512;     BBFloat    =  9;     BlankTrunc  =  2;
                             BLString   = 10;     PreAllocate =  4;
                             BZString   = 11;     DataComp    =   8;
                             BUnsBinary = 14;     KeyOnly     =  16;
                             BAutoInc   = 15;     Free10      =  64;
                                                  Free20      = 128;
                                                  Free30      = 192;

{              Btrieve Op Codes                      Error Codes             }
{  -----------------------------------------   ------------------------      }
   BOpen      =  0;       BAbortTran   = 21;   FileNotOpen      =  3;
   BClose     =  1;       BGetPos      = 22;   InvalidKeyNumber =  6;
   BInsert    =  2;       BGetDir      = 23;   DiffKeyNumber    =  7;
   BUpdate    =  3;       BStepNext    = 24;   InvalidPosition  =  8;
   BDelete    =  4;       BStop        = 25;   EndofFile        =  9;
   BGetEqual  =  5;       BVersion     = 26;   FileNotFound     = 12;
   BGetNext   =  6;       BUnlock      = 27;   DataBufferLength = 22;
   BGetPrev   =  7;       BReset       = 28;   RejectCount      = 60;
   BGetGr     =  8;       BSetOwner    = 29;   IncorrectDesc    = 62;
   BGetGrEq   =  9;       BClrOwner    = 30;   FilterLimit      = 64;
   BGetLess   = 10;       BCrSuppIdx   = 31;   IncorrectFldOff  = 65;
   BGetLessEq = 11;       BDropSuppIdx = 32;   LostPosition     = 82;
   BGetFirst  = 12;       BStepFirst   = 33;
   BGetLast   = 13;       BStepLast    = 34;
   BCreate    = 14;       BStepPrev    = 35;
   BStat      = 15;       BGetNextExt  = 36;
   BExtend    = 16;       BGetPrevExt  = 37;
   BSetDosDir = 17;       BStepNextExt = 38;
   BGetDosDir = 18;       BStepPrevExt = 39;
   BBegTran   = 19;       BInsertExt   = 40;
   BEndTran   = 20;       BGetKey      = 50;

{  Extended Ops Comp Codes/Bias           Extended Ops Logic Constants       }
{  -----------------------------       -----------------------------------   }
   Equal       : byte =   1;           NoFilter    : integer = 0;
   GreaterThan : byte =   2;           LastTerm    : byte    = 0;
   LessThan    : byte =   3;           NextTermAnd : byte    = 1;
   NotEqual    : byte =   4;           NextTermOr  : byte    = 2;
   GrOrEqual   : byte =   5;
   LessOrEqual : byte =   6;
   UseAltColl  : byte =  32;
   UseField    : byte =  64;
   UseNoCase   : byte = 128;

{   Other Unit-Specific Constants   }
{ --------------------------------- }
   Zero        : integer = 0;
   NotRequired : integer = 0;
   MaxFixedRecLength   =  4090; {Btrieve limits fixed record length for std  }
   MaxKBufferLength    =   255; {files to 4090.  Max key size is 255.        }
   MaxExtDBufferLength = 32767;

TYPE

(* Data types for TRecMgr object *)
(* ----------------------------- *)
   TVersion    = record
                    case integer of
                    1: (Number  : word;
                        Rev     : integer;
                        Product : char);
                    2: (Entire  : array[1..5] of char);
                    end;
   PRecMgr     = ^TRecMgr;
   TRecMgr     = object(TObject)            {Base obj handles abort/begin/end}
                    Version      : TVersion;{tran, reset, version and stop.  }
                    VersionString: string;
                    constructor Init;
                    function BT(OpCode, Key: integer): integer; virtual;
                    destructor Done; virtual;
                    end;

(* Data types for BFile object *)
(* --------------------------- *)
   BFileName   = array[1..80] of char;    {79 + blank pad required by Btrieve}
   TAltColSpec = record               {The data types for alternate collating}
                    case integer of   {sequence are used in CreateFile fcn.  }
                    1: (Header : byte;              {Header always equals $AC}
                        Name   : array[1..8] of char;
                        Table  : array[1..256] of char);
                    2: (Entire : array[1..265] of byte);
                    end;
   PAltColSeq  = ^TAltColSeq;
   TAltColSeq  = object(TObject)
                    Spec : TAltColSpec;
                    constructor Init(SpecName: FNameStr);
                    destructor Done; virtual;
                    end;
   PKeySpec    = ^KeySpec;
   KeySpec     = record                     {data type for a Btrieve key spec}
                    case integer of
                    1: (KeyPos     : integer;
                        KeyLen     : integer;
                        KeyFlags   : integer;             {Tho not used in a }
                        NotUsed    : array[1..4] of byte; {create call, these}
                        ExtKeyType : byte;                {4 bytes return #  }
                        NullValue  : byte;                {unique recs in key}
                        Reserved   : array[1..4] of byte);{after a stat call.}
                    2: (Irrelevant : array[1..3] of integer;
                        NumUnique  : longint);      {great after a stat call!}
                    3: (Entire     : array[1..16] of byte);
                    end;
   PFileSpec   = ^TFileSpec;
   TFileSpec   = record                      {Strictly speaking, the KeyArray}
                    case integer of          {and AltColSpec elements here   }
                    1: (RecLen     : integer;{only serve to reserve space for}
                        PageSize   : integer;{the buffer.                    }
                        NumKeys    : integer;
                        NumRecs    : array[1..2] of integer;
                        FileFlags  : integer;
                        Reserved   : array[1..2] of char;
                        PreAlloc   : integer;
                        KeyArray   : array[0..23] of KeySpec;  {24=max # segs}
                        AltColSpec : TAltColSpec);   {here just to allow room}
                    2: (Irrelevant : array[1..14] of byte;
                        UnusedPgs  : word);         {great after a stat call!}
                    3: (SpecBuf    : integer); {used to refer to addr of spec}
                                        4: (Entire     : array[1..665] of byte);
                    end;
   PBFile      = ^BFile;
   BFile       = object(TObject)
                    DFileName  : FNameStr;                      {DOS filename}
                    Specs      : TFileSpec;               {Btrieve file specs}
                    SpecLength : integer;         {length of actual file spec}
                    NumRecs    : longint;             {# records at Init time}
                    NumSegs    : integer;                   {total # key segs}
                    HasAltCol  : boolean;       {true if file has alt col seq}
                    AltColName : string[8];    {name of alt col seq from file}
                    PosBlk     : array[1..128] of char;       {position block}
                    DBufferLen : integer;
                    constructor Init(UserFileName: FNameStr; OpenMode: integer);
                    function BT(OpCode, Key: integer): integer; virtual;
                    function Open(OpenMode: integer):  integer; virtual;
                    function Close: integer; virtual;
                    destructor Done; virtual;
                    private
                    FileName   : BFileName;            {Btrieve-type filename}
                    procedure ConvertName(UserFileName: FNameStr);
                    end;

(* Data types for BFixed object - descendant of BFile *)
(* -------------------------------------------------- *)
   TDBuffer    = array[1..MaxFixedRecLength] of byte;
   TKBuffer    = array[1..MaxKBufferLength] of byte;
   PBFixed     = ^BFixed;
   BFixed      = object(BFile)
                    DBuffer : TDBuffer;
                    KBuffer : TKBuffer;
                    constructor Init(UserFileName: FNameStr; OpenMode: integer);
                                  function BT(OpCode, Key: integer): integer; virtual;
                    destructor Done; virtual;
                    end;

(* Data types for BFileExt object - descendant of BFile *)
(* ---------------------------------------------------- *)
   TCharArray  = array[1..255] of char;
   THeader     = record
                    case integer of
                    1: (DBufferLen : integer;
                        Constant   : array[1..2] of char);
                    2: (Entire     : array[1..4] of byte);
                    end;
   TFilter     = record
                    case integer of
                    1: (MaxSkip       : integer;
                        NumLogicTerms : integer);
                    2: (Entire        : array[1..2] of integer);
                    end;
   TLogicTerm  = record
                    case integer of
                    1: (FieldType  : byte;
                        FieldLen   : integer;
                        Offset     : integer;  {0 relative to start of record}
                        CompCode   : byte;
                        Expression : byte;{0 last term, 1 AND next, 2 OR next}
                        case FieldComp: boolean of
                           True : (CompOffset: integer);
                           False: (Value: TCharArray));{an arbitrary limit of}
                    2: (Fixed : array[1..7] of byte);  {255 on len of values }
                    end;
   PFilterSpec = ^TFilterSpec;
   TFilterSpec = object(TObject)
                    LogicTerm: TLogicTerm;
                    constructor InitF(FieldType: byte; FieldLen, Offset:
                                      integer; CompCode, Expression: byte;
                                      CompOffset: integer);
                    constructor InitV(FieldType: byte; FieldLen, Offset:
                                      integer; CompCode, Expression: byte;
                                      Value: TCharArray);
                    destructor Done; virtual;
                    end;
   TExtractor  = record
                    case integer of
                    1: (NumRecords : integer;
                        NumFields  : integer);
                    2: (Entire     : array[1..2] of integer);
                    end;
   TExtRepeater= record
                    FieldLen : integer;
                    Offset   : integer;
                    end;
   PExtSpec    = ^TExtSpec;
   TExtSpec    = object(TObject)
                    ExtRepeater : TExtRepeater;
                    constructor Init(Len, Ofs: integer);
                    destructor Done; virtual;
                    end;
   PExtDBuffer = ^TExtDBuffer;
   TExtDBuffer = record
                    case integer of
                    1: (Header   : THeader;       {Buffer sent includes these}
                        Filter   : TFilter);         {types at its beginning.}
                    2: (NumRecs  : integer;               {Buffer rec'd looks}
                        Repeater : array[1..32765] of char);      {like this.}
                    {Repeater structure is: 2 for length of record image,    }
                    {                       4 for currency position of rec,  }
                    {                       n for record image itself        }
                    3: (Entire   : array[1..32767] of byte);   {Whole buffer.}
                    end;
   PBFileExt   = ^BFileExt;
   BFileExt    = object(BFile)
                    Header        : THeader;
                    Filter        : TFilter;
                    FilterSpec    : PCollection;
                    Extractor     : TExtractor;
                    ExtractorSpec : PCollection;
                    ExtDBuffer    : PExtDBuffer;
                    constructor Init(UserFileName: FNameStr; OpenMode: integer);
                    function BTExt(OpCode, Key: integer): integer; virtual;
                    destructor Done; virtual;
                    private
                    procedure SetExtDBufferLen;
                    procedure MakeExtDBuffer;
                    end;


(* PUBLIC/EXPORTED VARS *)
(* -------------------- *)
VAR
     BStatus        : integer;
     VarNotRequired : integer;                              {Dummy parameter.}
     VarPosBlk      : array[1..128] of char;    {Dummy used in ops that don't}
                                                {pass/return position block. }

(* PUBLIC/EXPORTED FUNCTIONS *)
(* ------------------------- *)
{The Btrv function declared here is public, but should not ever be needed. It
 is included in the public declaration only to be complete and give you
 access to the standard call if you should need it.}

function Btrv(Op:integer; var Pos,Data; var DataLen:integer; var KBuf;
              Key:integer): integer;
function CreateFile(UserFileName: FNameStr; UserFileSpec:PFileSpec;
                    AltColFile: FNameStr): integer;
function CloneFile(CurrentFile, NewFile: FNameStr): integer;
function LTrim(S: String): String;   {LTrim and RTrim were taken from one of }
function RTrim(S: String): String;   {the Turbo Vision .PAS source files.    }


IMPLEMENTATION
(* ------------------------------------------------------------------------ *)
(* ------------------------------------------------------------------------ *)
USES Dos;        {Dos unit needed for the Btrieve interface call (interrupts)}

{$R-}	 {Range checking off...is TP's default}
{$B+}	 {Boolean complete evaluation on...NOT a default, but apparently
          required by the interface call.  Is turned off at end of Btrieve
          interface definition}
{$V-}    {Non-strict string var checking...Btrieve wants it so.  Strict
          checking is turned back on at the end of the interface definition.}
{$S+}	 {Stack checking on}
{$I+}	 {I/O checking on}

{  Module Name: TUR5BTRV.PAS                                                 }

{  Description: This is the Btrieve interface for Turbo Pascal (MS-DOS).     }
{		This routine sets up the parameter block expected by	     }
{		Btrieve, and issues interrupt 7B.  It should be compiled     }
{		with the $V- switch so that runtime checks will not be	     }
{		performed on the variable parameters.			     }
{									     }
{  Synopsis:	STAT := BTRV (OP, POS.START, DATA.START, DATALEN,	     }
{				 KBUF.START, KEY);			     }
{			      where					     }
{			OP is an integer,				     }
{			POS is a 128 byte array,			     }
{			DATA is an untyped parameter for the data buffer,    }
{			DATALEN is the integer length of the data buffer,    }
{			KBUF is the untyped parameter for the key buffer,    }
{		    and KEY is an integer.				     }
{									     }
{  Returns:	Btrieve status code (see Appendix B of the Btrieve Manual).  }
{									     }
{  Note:	The Btrieve manual states that the 2nd, 3rd, and 5th	     }
{		parameters be declared as variant records, with an integer   }
{		type as one of the variants (used only for Btrieve calls),   }
{		as is shown in the example below.  This is supported, but    }
{		the restriction is no longer necessary.  In other words, any }
{		variable can be sent in those spots as long as the variable  }
{		uses the correct amount of memory so Btrieve does not	     }
{		overwrite other variables.				     }
{									     }
{		   var DATA = record case boolean of			     }
{		      FALSE: ( START: integer );			     }
{		      TRUE:  ( EMPLOYEE_ID: 0..99999;			     }
{			       EMPLOYEE_NAME: packed array[1..50] of char;   }
{			       SALARY: real;				     }
{			       DATA_OF_HIRE: DATE_TYPE );		     }
{		      end;						     }
{									     }
{		There should NEVER be any string variables declared in the   }
{		data or key records, because strings store an extra byte for }
{		the length, which affects the total size of the record.      }
{									     }
{									     }

(* BTRV function *)
(* ------------- *)
function Btrv (Op: integer; var Pos, Data; var DataLen: integer; var Kbuf;
               Key: integer): integer;

const
     VAR_ID		= $6176;       {id for variable length records - 'va'}
     BTR_INT		= $7B;
     BTR2_INT		= $2F;
     BTR_OFFSET 	= $0033;
     MULTI_FUNCTION	= $AB;

{  ProcId is used for communicating with the Multi Tasking Version of	     }
{  Btrieve. It contains the process id returned from BMulti and should	     }
{  not be changed once it has been set. 				     }
{									     }
     ProcId: integer = 0;	               { initialize to no process id }
     MULTI: boolean = false;	           { set to true if BMulti is loaded }
     VSet: boolean = false;	 { set to true if we have checked for BMulti }

type
     ADDR32 = record					      {32 bit address}
        OFFSET : word;				             {&&&old->integer}
        SEGMENT: word;				            {&&&used->integer}
     end;

     BTR_PARMS = record
	USER_BUF_ADDR: ADDR32;		                 {data buffer address}
	USER_BUF_LEN: integer;				  {data buffer length}
	USER_CUR_ADDR: ADDR32;			      {currency block address}
	USER_FCB_ADDR: ADDR32;			  {file control block address}
	USER_FUNCTION: integer; 		           {Btrieve operation}
	USER_KEY_ADDR: ADDR32;				  {key buffer address}
	USER_KEY_LENGTH: BYTE;				   {key buffer length}
	USER_KEY_NUMBER: shortint;		      {key number&&&old->BYTE}
	USER_STAT_ADDR: ADDR32; 	               {return status address}
	XFACE_ID: integer;		               {language interface id}
     end;

var
     STAT: integer;					 {Btrieve status code}
     XDATA: BTR_PARMS;				     {Btrieve parameter block}
     REGS: Dos.Registers;	  {register structure used on interrrupt call}
     DONE: boolean;

begin
     REGS.AX := $3500 + BTR_INT;
     INTR ($21, REGS);
     if (REGS.BX <> BTR_OFFSET) then	      {make sure Btrieve is installed}
	STAT := 20
     else
	begin
	   if (not VSet) then	{if we haven't checked for Multi-User version}
	      begin
		 REGS.AX := $3000;
		 INTR ($21, REGS);
		 if ((REGS.AX AND $00FF) >= 3) then
		    begin
		       VSet := true;
		       REGS.AX := MULTI_FUNCTION * 256;
		       INTR (BTR2_INT, REGS);
		       MULTI := ((REGS.AX AND $00FF) = $004D);
		    end
		 else
		    MULTI := false;
	      end;
						    {make normal btrieve call}
	   with XDATA do
	      begin
		 USER_BUF_ADDR.SEGMENT := SEG (DATA);
		 USER_BUF_ADDR.OFFSET := OFS (DATA); {set data buffer address}
		 USER_BUF_LEN := DATALEN;
		 USER_FCB_ADDR.SEGMENT := SEG (POS);
		 USER_FCB_ADDR.OFFSET := OFS (POS);	     {set FCB address}
		 USER_CUR_ADDR.SEGMENT := USER_FCB_ADDR.SEGMENT; {set cur seg}
		 USER_CUR_ADDR.OFFSET := USER_FCB_ADDR.OFFSET+38;{set cur ofs}
		 USER_FUNCTION := OP;		  {set Btrieve operation code}
		 USER_KEY_ADDR.SEGMENT := SEG (KBUF);
		 USER_KEY_ADDR.OFFSET := OFS (KBUF);  {set key buffer address}
		 USER_KEY_LENGTH := 255;	     {assume its large enough}
		 USER_KEY_NUMBER := KEY;		      {set key number}
		 USER_STAT_ADDR.SEGMENT := SEG (STAT);
		 USER_STAT_ADDR.OFFSET := OFS (STAT);	  {set status address}
		 XFACE_ID := VAR_ID;			     {set lamguage id}
	      end;

	   REGS.DX := OFS (XDATA);
	   REGS.DS := SEG (XDATA);

	   if (NOT MULTI) then		     {MultiUser version not installed}
	      INTR (BTR_INT, REGS)
	   else
	      begin
		 DONE := FALSE;
		 repeat
		    REGS.BX := ProcId;
		    REGS.AX := 1;
		    if (REGS.BX <> 0) then
		       REGS.AX := 2;
		    REGS.AX := REGS.AX + (MULTI_FUNCTION * 256);
		    INTR (BTR2_INT, REGS);
		    if ((REGS.AX AND $00FF) = 0) then
		       DONE := TRUE
		    else begin
		       REGS.AX := $0200;
		       INTR ($7F, REGS);
		       DONE := FALSE;
		    end;
		 until (DONE);
		 if (ProcId = 0) then
		    ProcId := REGS.BX;
	      end;
	   DATALEN := XDATA.USER_BUF_LEN;
	end;
     BTRV := STAT;
end;
{$B-}
{$V+}


(* BRECMGR.INIT Constructor *)
(* ------------------------ *)
constructor TRecMgr.Init;
var
   Counter  : integer;
   BNumber,
   BRev     : string[2];
   BProduct : string[1];
begin
   TObject.Init;                              {assures all data fields zeroed}
   BStatus := Btrv(BVersion, VarPosBlk, Version, Counter, VarNotRequired, Zero);
   str(Version.Number:2, BNumber);
   BNumber := LTrim(BNumber);
   str(Version.Rev:2, BRev);
   BProduct := Version.Product;
   VersionString := BNumber + '.' + BRev + BProduct;
end;

(* BRECMGR.BT function *)
(* ------------------- *)
{Will not handle reset of other workstations as written, as no true key
 buffer is passed.   Will handle begin/end/abort transaction, reset & stop.
 Would also handle version op, but is handled by BRecMgr.Init anyway!}
function TRecMgr.BT(OpCode, Key: integer): integer;
begin
   BT := Btrv(OpCode, VarPosBlk, VarNotRequired, VarNotRequired,
              VarNotRequired, Key);
end;

(* BRECMGR Destructor *)
(* ------------------ *)
destructor TRecMgr.Done;
begin
   TObject.Done;
end;


(* TALTCOLSEQ.INIT Constructor *)
(* ---------------------------- *)
constructor TAltColSeq.Init(SpecName: FNameStr);
var
   AltFile: file of TAltColSpec;      {The TAltColSpec object type is used   }
begin                                 {internally by the CreateFile function.}
   TObject.Init;
   assign(AltFile, SpecName);
   {$I-} reset(AltFile); {$I+}    {It's up to user program to assure that the}
   if ioresult = 0 then           {alternate collating sequence file exists  }
     begin                        {in the current directory when the         }
       read(AltFile, Spec);       {CreateFile fcn is called, and is of the   }
       close(AltFile);            {standard format expected by Btrieve.      }
     end
     else
     Fail;
end;


(* TALTCOLSEQ.DONE Destructor *)
(* --------------------------- *)
destructor TAltColSeq.Done;
begin
   TObject.Done;
end;


(* BFILE.INIT Constructor *)
(* ---------------------- *)
constructor BFile.Init(UserFileName: FNameStr; OpenMode: integer);

const                          {665 = 16 for filespec + 384 for max key specs}
   FileBufLen : integer = 665; {+ 265 for an alternate collating sequence.   }
   KeyBufLen  : integer = 384;       {Max of 24 keys * 16 bytes per key spec.}

var
   AltColNameOffset,
   Counter, Counter1,
   Status             : integer;
   NumRecsWord1,
   NumRecsWord2       : word;

procedure CountSegments;
begin
   repeat
   if (Specs.KeyArray[Counter1].KeyFlags and Segmented) = Segmented then
      begin
      if (Specs.KeyArray[Counter1].KeyFlags and AltCol) = AltCol then
         HasAltCol  := true;
      inc(NumSegs);
      inc(Counter1);
      end
      else
      begin
      if (Specs.KeyArray[Counter1].KeyFlags and AltCol) = AltCol then
         HasAltCol  := true;
      inc(Counter);
      inc(Counter1);
      end;
   until (Specs.KeyArray[Counter1].KeyFlags and Segmented) <> Segmented;
end;

begin
   TObject.Init;                              {assures all data fields zeroed}
   HasAltCol := false;            {initialize to false 'until proven guilty!'}
   ConvertName(UserFileName);             {Sets fields DFileName and FileName}
   Status := Open(OpenMode);
   if Status = 0 then                    {if open op successful, do a stat op}
      begin
         Status := Btrv(BStat, PosBlk, Specs.SpecBuf, FileBufLen, KeyBufLen,
                        Zero);
         {Btrieve filespecs and key specs are now in the BFile object!}
         {Typed constant FileBufLen will have been changed to size of data
          buffer returned by stat call.  Save that value now.}
         SpecLength := FileBufLen;
         if Status = 0 then     {if stat successfull, fill object data fields}
            begin
               NumRecsWord1 := Specs.NumRecs[1];  {get rid of sign bit!! by  }
               NumRecsWord2 := Specs.NumRecs[2];  {converting 2 ints to words}
               NumRecs := NumRecsWord1 + NumRecsWord2 * 65536;
               NumSegs := Specs.NumKeys;
               Counter := 1; Counter1 := 0;
               while Counter <= Specs.NumKeys do     {Will be skipped if data}
                  CountSegments;                     {only file.             }
               if HasAltCol = true then
                  begin
                  AltColNameOffset := (16+16*NumSegs+1);
                  for Counter := 1 to 8 do
                     AltColName[Counter] := chr(Specs.Entire[AltColNameOffset + Counter]);
                  end;
               DBufferLen := Specs.RecLen;
               BStatus := 0;                  {all went well, return a code 0}
            end
            else
            begin
               BStatus := Status;  {Open op succeeded but stat failed; put   }
               Status  := Close;   {error code for bad stat in global var and}
            end;                   {close the damn file quick!}
         end
   else
   BStatus := Status;             {assign err code for bad open to global var}
end;

(* BFILE.BT function *)
(* ----------------- *)
function BFile.BT(OpCode, Key: integer): integer;
begin
   Abstract;
end;

(* BFILE.OPEN function *)
(* ------------------- *)
function BFile.Open(OpenMode: integer):integer;
begin
   Open := Btrv(BOpen, PosBlk, VarNotRequired, Specs.RecLen, FileName, OpenMode);
end;

(* BFILE.CLOSE Function *)
(* -------------------- *)
function BFile.Close:integer;
begin
   Close := Btrv(BClose, PosBlk, VarNotRequired, VarNotRequired,
                 VarNotRequired, NotRequired);
end;

(* BFILE.DONE Destructor *)
(* --------------------- *)
destructor BFile.Done;
begin
   TObject.Done;
end;

(* BFILE.CONVERTNAME Procedure *)
(* --------------------------- *)
{this one is private to BFile}
procedure BFile.ConvertName(UserFileName: FNameStr);
begin
   DFileName := UserFileName;
   move(DFileName[1], FileName[1], length(DFileName));  {conv string to array}
   FileName[length(DFileName) + 1] := ' ';         {provide required pad char}
end;

(* BFIXED.INIT Constructor *)
(* ----------------------- *)
constructor BFixed.Init(UserFileName: FNameStr; OpenMode: integer);
begin
   BFile.Init(UserFileName, OpenMode);
end;

(* BFIXED.BT function *)
(* ----------------- *)
function BFixed.BT(OpCode, Key: integer): integer;
begin
   BT := Btrv(OpCode, PosBlk, DBuffer, Specs.RecLen, KBuffer, Key);
end;

(* BFIXED.DONE Destructor *)
(* ---------------------- *)
destructor BFixed.Done;
begin
   BFile.Done;
end;

(* TFILTERSPEC.INITF Constructor *)
(* ----------------------------- *)
{Be sure to remember that the offset parameter here is 0 relative to start of
 record!!}
constructor TFilterSpec.InitF(FieldType: byte; FieldLen, Offset: integer;
                              CompCode, Expression: byte; CompOffset: integer);
begin
   TObject.Init;                              {assures all data fields zeroed}
   LogicTerm.FieldType  := FieldType;
   LogicTerm.FieldLen   := FieldLen;
   LogicTerm.Offset     := Offset;
   LogicTerm.CompCode   := CompCode;
   LogicTerm.Expression := Expression;
   LogicTerm.FieldComp  := true;
   LogicTerm.CompOffset := Offset;
end;

(* TFILTERSPEC.INITV Constructor *)
(* ----------------------------- *)
{Be sure to remember that the offset parameter here is 0 relative to start of
 record!!}
constructor TFilterSpec.InitV(FieldType: byte; FieldLen, Offset: integer;
                              CompCode, Expression: byte; Value: TCharArray);
begin
   TObject.Init;                              {assures all data fields zeroed}
   LogicTerm.FieldType := FieldType;
   LogicTerm.FieldLen  := FieldLen;
   LogicTerm.Offset    := Offset;
   LogicTerm.CompCode  := CompCode;
   LogicTerm.Expression:= Expression;
   LogicTerm.FieldComp := false;
   LogicTerm.Value     := Value;
end;

(* TFILTERSPEC.DONE Destructor *)
(* --------------------------- *)
destructor TFilterSpec.Done;
begin
   TObject.Done;
end;

(* TEXTSPEC.INIT Constructor *)
(* ------------------------- *)
constructor TExtSpec.Init(Len, Ofs: integer);
begin
   TObject.Init;                              {assures all data fields zeroed}
   ExtRepeater.FieldLen := Len;
   ExtRepeater.Offset   := Ofs;
end;

(* TEXTSPEC.DONE Destructor *)
(* ----------------------- *)
destructor TExtSpec.Done;
begin
   TObject.Done;
end;

(* BFILEEXT.INIT Constructor *)
(* ------------------------- *)
{always check for a failure!}
constructor BFileExt.Init(UserFileName: FNameStr; OpenMode: integer);
begin
   BFile.Init(UserFileName, OpenMode);
   Header.Constant[1] := 'E';
   Header.Constant[2] := 'G';
   ExtDBuffer    := memallocseg(MaxExtDBufferLength);
   FilterSpec    := new(PCollection, Init(2,2));
   ExtractorSpec := new(PCollection, Init(5,2));
   if (ExtDBuffer = nil) or (FilterSpec = nil) or (ExtractorSpec = nil) then
      Fail;
end;

(* BFILEEXT.DONE Destructor *)
(* ------------------------ *)
destructor BFileExt.Done;
begin
   BFile.Done;
   dispose(ExtDBuffer);
   dispose(ExtractorSpec, Done);
   dispose(FilterSpec, Done);
end;

(* BFILEEXT.SETEXTDBUFFERLEN function *)
(* ---------------------------------- *)
{Compute sizes of data buffers sent and returned, to determine proper size to
 specify in call.}
{Assumes user program has inserted proper items into the collections for
 filter terms and extractor specs.}
procedure BFileExt.SetExtDBufferLen;
var
   LengthSent, LengthReturned,
   RecordLengthReturned, RecordImageReturned : integer;

   procedure MakeFilterSpecs;
      procedure CalcFilterLengths(FSpec: PFilterSpec); far;
      begin
      with FSpec^ do
         begin
         inc(LengthSent, 7);
         if (LogicTerm.CompCode and UseField) = UseField then
            inc(LengthSent, 2)
            else
            LengthSent := LengthSent + LogicTerm.FieldLen;
         end;
      end;
   begin
      FilterSpec^.ForEach(@CalcFilterLengths);
   end;

   procedure MakeExtSpecs;
      procedure CalcExtLengths(ExtSpec: PExtSpec); far;
      begin
         with ExtSpec^ do
            begin
            inc(LengthSent, 4);
            RecordLengthReturned := RecordLengthReturned + ExtRepeater.FieldLen;
            end;
      end;
   begin
      ExtractorSpec^.ForEach(@CalcExtLengths);
   end;

begin
   LengthSent := 8; {4 for header length, 4 for fixed filter length}

   {Work on filter logic term portion of spec.}
   if FilterSpec^.Count > 0 then       {if any filter terms in the collection}
      MakeFilterSpecs;

   {Work on extractor portion of spec.}
   inc(LengthSent, 4);                       {size of fixed part of extractor}
   RecordLengthReturned := 0;
   MakeExtSpecs;              {there must always be at least 1 extractor spec}

   {2 for count of recs, 4 for currency pos}
   RecordImageReturned := RecordLengthReturned + 6; 
   {2 for count of recs}
   LengthReturned := 2 + (RecordImageReturned * Extractor.NumRecords);

   Header.DBufferLen := LengthSent;

   if LengthSent >= LengthReturned then
      DBufferLen := LengthSent
      else
      DBufferLen := LengthReturned;
end;

(* BFILEEXT.MAKEEXTDBUFFER Function *)
(* -------------------------------- *)
{Private to BFileExt, called in BFileExt.BT, which is called by each
 descendant's override of BFileExt.BT.  Assumes program has already set up
 the collections required.}
procedure BFileExt.MakeExtDBuffer;
var
   Offset : integer;

   procedure MoveFilterSpecs;
      procedure MoveSingleFilterSpec(FSpec: PFilterSpec); far;
      begin
         with FSpec^ do
            begin
            {move fixed part of logic term}
            move(LogicTerm, ExtDBuffer^.Entire[Offset], sizeof(LogicTerm.Fixed));
            inc(Offset, sizeof(LogicTerm.Fixed));
            {now need to move variable part of logic term}
            if (LogicTerm.CompCode and UseField) = UseField then
               begin
               move(LogicTerm.CompOffset, ExtDBuffer^.Entire[Offset],
                    sizeof(LogicTerm.CompOffset));
               Offset := Offset + sizeof(LogicTerm.CompOffset);
               end
               else
               begin
               move(LogicTerm.Value, ExtDBuffer^.Entire[Offset],
                    LogicTerm.FieldLen);
               Offset := Offset + LogicTerm.FieldLen;
               end;
            end;
      end;
   begin
      FilterSpec^.ForEach(@MoveSingleFilterSpec);
   end;

   procedure MoveExtractorSpecs;
      procedure MoveSingleExtractorSpec(ExtSpec: PExtSpec); far;
      begin
        with ExtSpec^ do
           begin
           move(ExtSpec^.ExtRepeater, ExtDBuffer^.Entire[Offset],
                sizeof(ExtSpec^.ExtRepeater));
           Offset := Offset + sizeof(ExtSpec^);
           end;
      end;
   begin
      ExtractorSpec^.ForEach(@MoveSingleExtractorSpec);
   end;

begin
   {Move header definition into buffer.}
   move(Header, ExtDBuffer^.Header, sizeof(Header));

   {Move fixed part of filter definition into buffer.}
   move(Filter, ExtDBuffer^.Filter, sizeof(Filter));
   Offset := 1 + sizeof(Header) + sizeof(Filter);

   {Read filter logic terms into buffer.}
   if FilterSpec^.Count > 0 then
      MoveFilterSpecs;

   {Move fixed part of extractor definition into buffer.}
   move(Extractor, ExtDBuffer^.Entire[Offset], sizeof(Extractor.Entire));
   Offset := Offset + sizeof(Extractor.Entire);

   {Move extractor terms into buffer.}
   MoveExtractorSpecs;
end;

(* BFILEEXT.BTEXT function *)
(* ----------------------- *)
{In overrides of this function in BFileExt descendants, MUST call
 BFileExt.BTExt, as it sets the buffer length in the header, and puts
 together the 'send' buffer.  User program MUST have inserted filter logic
 terms and extractor specs into their respective collections before making
 a Btrieve call.}
function BFileExt.BTExt(OpCode, Key: integer): integer;
begin
   SetExtDBufferLen;
   MakeExtDBuffer;
end;


(* CREATEFILE function *)
(* -------------------- *)
{Assumes a PFILESPEC variable has been instantiated and assigned its values,
 and that if you use an alternate collating sequence, it exists in the
 current directory.}
{No specific support for null keys, blank compression, data-only files.}
function CreateFile(UserFileName: FNameStr; UserFileSpec:PFileSpec;
                    AltColFile: FNameStr): integer;
var
   CFSpecLength,
   Counter,
   Counter1,
   NumSegs         : integer;
   BtrieveFileName : BFileName;
   HasAltCol       : boolean;
   AltColObj       : PAltColSeq;

procedure CountSegments;
begin
   with UserFileSpec^ do
   repeat
   if (KeyArray[Counter1].KeyFlags and Segmented) = Segmented then
      begin
      if (KeyArray[Counter1].KeyFlags and AltCol) = AltCol then
         HasAltCol  := true;
      inc(NumSegs);
      inc(Counter1);
      end
      else
      begin
      if (KeyArray[Counter1].KeyFlags and AltCol) = AltCol then
         HasAltCol  := true;
      inc(Counter);
      inc(Counter1);
      end;
   until (KeyArray[Counter1].KeyFlags and Segmented) <> Segmented;
end;

begin
   move(UserFileName[1], BtrieveFileName[1], length(UserFileName));
   BtrieveFileName[length(UserFileName) + 1] := ' ';
   Counter := 1; Counter1 := Counter;
   NumSegs := UserFileSpec^.NumKeys;
   while Counter <= UserFileSpec^.NumKeys do
      CountSegments;
   CFSpecLength := 16 + (NumSegs * 16);
   UserFileSpec^.Reserved[1] := chr(0);
   UserFileSpec^.Reserved[2] := chr(0);
   if (AltColFile <> '') and (HasAltCol = true) then  {Note the double check!}
      begin
      AltColObj   := new(PAltColSeq, Init(AltColFile));
      move(AltColObj^.Spec, UserFileSpec^.Entire[CFSpecLength+1],
         sizeof(AltColObj^.Spec));
      CFSpecLength := CFSpecLength + sizeof(AltColObj^.Spec);
      dispose(AltColObj, Done);
      end;
   CreateFile := Btrv(BCreate, VarPosBlk, UserFileSpec^.SpecBuf, CFSpecLength,
                      BtrieveFileName, Zero);
end;

(* CLONEFILE function *)
(* ------------------ *)
{Programmer is responsible for assuring that 'CurrentFile' exists and can be
 opened.  Function will overwrite any existing file with 'NewFile' name.
 The integer returned here can be meaningless if the current file does not
 exist or is not opened properly.  This function is as streamlined as
 possible, but puts RESPONSIBILITY on the programmer.

 It is entirely possible that this clone function will NOT return a byte for
 byte matching file, if cloning an 'empty' Btrieve file.  This would be due
 to the inability to determine the number of pages pre-allocated when a file
 was created, if preallocation had been used.  The Btrieve Stat call uses
 the 'Preallocate # of pages' bytes to return the number of unused pages!!
 Thus, the CloneFile function clears the Preallocation bit in the FileFlags,
 among other things, before creating the new file.}

function CloneFile(CurrentFile, NewFile:FNameStr): integer;
var
   Counter, Counter1 : integer;
   CurrentBFile      : PBFile;
   NewBFile          : BFileName;
begin
   CurrentBFile := new(PBFile, Init(CurrentFile, ReadOnly));

   move(NewFile[1], NewBFile[1], length(NewFile));
   NewBFile[length(NewFile) + 1] := ' ';

   {Undo the 'damage' due to a virgin filespec by the stat call on init of
    the CurrentBFile object...tho technically the 'NotUsed' bytes we clear
    in the next 'if' probably do NOT really need to be cleared.}
   if CurrentBFile^.NumSegs > 0 then              {don't do if data only file}
      {Zero the bytes that after the init call hold # unique records!}
      for Counter := 1 to CurrentBFile^.NumSegs do
         fillchar(CurrentBFile^.Specs.KeyArray[Counter].NotUsed, 4, 0);

   {Clear the PreAllocate file flag bit if it had been set in CurrentBFile.}
   CurrentBFile^.Specs.FileFlags := CurrentBFile^.Specs.FileFlags and $FD;
   CurrentBFile^.Specs.UnusedPgs := 0; {If preallocate file flag was set, the}
                                        {cloned file will have no pages pre- }
                                        {allocated...NO way to get the       }
                                        {original # of pre-allocated pages!  }

   CloneFile := Btrv(BCreate, VarPosBlk, CurrentBFile^.Specs,
                     CurrentBFile^.SpecLength, NewBFile, Zero);
   BStatus := CurrentBFile^.Close;
   dispose(CurrentBFile, Done);
end;

{LTrim and RTrim were taken from one of the Turbo Vision .PAS source files!}
function LTrim(S: String): String;
var
   I: integer;
begin
   I := 1;
   while (I < length(S)) and (S[I] = ' ') do inc(I);
   LTrim := copy(S, I, 255);
end;

function RTrim(S: String): String;
var
   I: integer;
begin
   while S[Length(S)] = ' ' do dec(S[0]);
   RTrim := S;
end;


(* IS BTRIEVE LOADED procedure *)
(* --------------------------- *)
{this is private to the unit, and is executed only during unit initialization}
procedure IsBtrieveLoaded;
begin
   BStatus := Btrv(BReset, VarPosBlk, VarNotRequired, VarNotRequired,
                   VarNotRequired, Zero);
   if BStatus = 20 then
      begin
      writeln('Please load Btrieve before running this program.');
      halt;
      end;
end;


(* INITIALIZATION Section *)
(* ----------------------------------------------------------------------- *)
BEGIN

   IsBtrieveLoaded;

END.

