Chip 2001 October/Chip_2001-10_cd1.bin/zkuste/delphi/nastroje/d23456/SPLBASE.ZIP/Splbase/Include/Splinc.pas

Pascal/Delphi Source File | 2001-08-05 | 34KB | 1,389 lines

(*********** SplitBase Data Management Systems ***********
 *                                                       *
 *           Copyright (c) 2001 Leon O. Romain           *
 *                                                       *
 *                     [e-mail]                    *
 *                                                       *
 *********************************************************)

{
This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License
as published by the Free Software Foundation; either version 2
of the License, or (at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
}

const
   spllen = 26;   {Length of index field}
   splmax = 2000; {Maximum number of records before split}
   fldmax = 100;  {Maximum number of fields in record}

type
  Splitrec = record          {SplitBase index structure}
    data : string[spllen];   {Actual index field value}
    ptr : longint;           {Pointer to record containing index}
  end;

  splitbox = record          {Full SplitBase index structure}
     state : byte;           {0 = empty}
     count : longint;        {number of index fields in SplitBase index}
     index :                 {All indexes values within SplitBase index}
             array [1..splmax] of Splitrec;
  end;

  recdef = record            {Record definition for DB}
     size : integer;         {Total number of fields}
     recout : longint;       {Number of deleted record}
     indout : longint;       {Number of indexes deleted}
     SplID : longint;        {SplitBase Identifier}
     rsv101,                 {Reserved}
     rsv102,                 {Reserved}
     rsv103,                 {Reserved}
     rsv104 : longint;       {Reserved}
     def :                   {Size of each field}
            array [1..fldmax] of string[3]
  end;

  splerror = record          {Error definition structure}
     recnum : integer;       {Error number}
     recstr : string;        {Error description}
  end;

var
   topbox,   {First or top index holder}
   varbox :  {Variable or current index holder}
            ^splitbox;
   allrec :  {Definition for all fields in record}
            recdef;
   curtop :  {Pointer to current position within top index}
            longint;
   curind,   {Value of current index}
   curdtb :  {Name of current database}
            string;
   cursub,   {Pointer to current subindex}
   curpos,   {Pointer to current data in SplitBase index}
   currec :  {Pointer to current record within DB}
            longint;
   rechld : {Holder for all fields in record}
            ansistring;
   splerr : {Holds number and description of last error}
            splerror;
   recmax,  {Maximum number of record in DB. Useful if the
             Database must be limited to a specific number
             of records to avoid overflow}
   limrec : {Limits the number of recors that can entered
             by comparison to recmax}
            Longint;

function initspl : boolean;
{Initialize spliter system by reserving space in memory
 for the top and curent SplitBase indexes. Return false if
 process fails}
var
   b : boolean;
begin
   recmax := ( splmax div 2 ) * splmax;
   b := true;
   try
      new ( topbox );
      new ( varbox );
   except
      on EOutOfMemory do b := false;
   end;
   if b = false then
   begin
      splerr.recnum := 0;
      splerr.recstr := 'Unable to allocate system memory';
   end;
   initspl := b;
end;

function releasespl : boolean;
{Releases memory allocated to spliter system by disposing
 of that memory. The function returns false if
 process fails}
var
   b : boolean;
begin
   b := true;
   try
      dispose ( topbox );
      dispose ( varbox );
   except
      on EInvalidPointer do b := false
   end;
   if b = false then
   begin
      splerr.recnum := 28;
      splerr.recstr := 'No SplitBase Sytem to unload';
   end;
   releasespl := b;
end;

function initbase : boolean;
{Initializes all variables of SplitBase DB before creating
 a new Database or opening one.}
var
   b : boolean;
   s : string;
begin
   b := false;
   try
      topbox.state := 0;
      topbox.count := 0;
      varbox.state := 0;
      varbox.count := 0;
   except
      b := false;
   end;
   allrec.size := 0;
   allrec.recout := 0;
   allrec.indout := 0;
   s := 'SB10';
   move ( s[1], allrec.SplID, 4 );
   curind := '';
   curdtb := '';
   currec := 0;
   rechld := '';
   limrec := 0;
   initbase := b;
end;

function activedb : boolean;
{This function checks if there is an active DB}
var
   b : boolean;
begin
   b := true;
   if curdtb = '' then
      b := false;
   activedb := b
end;

function activerec : boolean;
{This function checks if there is an active record}
var
   b : boolean;
begin
   b := true;
   if currec = 0 then
      b := false;
   activerec := b
end;

function dbempty : boolean;
{This function checks if DB is empty}
var
   b : boolean;
begin
   b := true;
   if activedb then
   begin
      if topbox^.count > 0 then
         b := false;
   end;
   dbempty := b
end;

function reccount : longint;
{Returns the number of records in database}
var
   l1, l2 : longint;
   f : file;
begin
   l1 := sizeof ( splitbox );
   assignfile ( f, curdtb );
   {$I-}
   reset ( f, 1 );
   l2 := filesize ( f );
   closefile ( f );
   {$I+}
   if ioresult = 0 then
   begin
      if topbox^.count > 0 then
      begin
         l1 := ( l2 - sizeof ( allrec ) - ( l1 *
               ( topbox^.count + 1 ) ) ) div allrec.size;
         l1 := l1 - allrec.recout - ( allrec.indout *
               ( sizeof ( splitbox ) ) );
      end
      else
         l1 := 0;
   end
   else
      l1 := 0;
   reccount := l1;
end;

function createspl ( splname : string ) : boolean;
{Creates a new SplitBase DB and saves it to disk. This
 function will return false if process fails}
var
   b : boolean;
   f : file;
   s : string;
begin
   b := true;
   s := splname + '.spd';
   if fileexists ( s ) then
   begin
      b := false;
      splerr.recnum := 1;
      splerr.recstr := 'File already exits.';
   end
   else
   if allrec.size <= 0 then
   begin
      b := false;
      splerr.recnum := 31;
      splerr.recstr := 'Record structure not defined.';
   end
   else
   begin
      assignfile ( f, s );
      {$I-}
      rewrite ( f, 1 );
      {$I+}
      if ioresult = 0 then
      begin
         {initbase;}
         {$I-}
         blockwrite ( f, topbox^, sizeof ( splitbox ) );
         blockwrite ( f, allrec, sizeof ( allrec ) );
         blockwrite ( f, varbox^, sizeof ( splitbox ) );
         {$I+}
         if ioresult <> 0 then
         begin
            b := false;
            splerr.recnum := 3;
            splerr.recstr := 'Unable to write SplitBase file.';
         end;
         {$I-}
         closefile ( f );
         {$I+}
         if ioresult <> 0 then
         begin
            b := false;
            splerr.recnum := 4;
            splerr.recstr := 'Unable to close SplitBase file.';
         end;
      end
      else
      begin
         b := false;
         splerr.recnum := 2;
         splerr.recstr := 'Unable to create SplitBase file.';
      end;
   end;
   if b then
   begin
      curdtb := splname + '.spd';
      setlength ( rechld, allrec.size );
   end
   else
      curdtb := '';
   createspl := b
end;

function openspl ( splname : string ) : boolean;
{Opens an existing SplitBase DB from disk. This
 function will return false if process fails}
var
   b : boolean;
   f : file;
   s : string;
begin
   b := true;
   s := splname + '.spd';
   assignfile ( f, s );
   {$I-}
   reset ( f, 1 );
   {$I+}
   if ioresult = 0 then
   begin
      {$I-}
      blockread ( f, topbox^, sizeof ( splitbox ) );
      blockread ( f, allrec, sizeof ( allrec ) );
      blockread ( f, varbox^, sizeof ( splitbox ) );
      {$I+}
      if ioresult = 0 then
      begin
         s := '    ';
         move ( allrec.SplID, s[1], 4 );
         if s <> 'SB10' then
         begin
            b := false;
            splerr.recnum := 100;
            splerr.recstr := 'Not a SplitBase file.';
         end
      end
      else
      begin
         b := false;
         splerr.recnum := 6;
         splerr.recstr := 'Unable to read SplitBase file.';
      end;
      {$I-}
      closefile ( f );
      {$I+}
      if ioresult <> 0 then
      begin
         b := false;
         splerr.recnum := 7;
         splerr.recstr := 'Unable to close SplitBase file.';
      end;
   end
   else
   begin
      b := false;
      splerr.recnum := 5;
      splerr.recstr := 'Unable to open SplitBase file.';
   end;
   if b then
   begin
      curdtb := splname + '.spd';
      setlength ( rechld, allrec.size );
   end
   else
      curdtb := '';
   openspl := b
end;

function putdef : boolean;
{Updates DB definition record}
var
   b : boolean;
   f : file;
begin
   b := true;
   if activedb then
   begin
      assignfile ( f, curdtb );
      {$I-}
      reset ( f, 1 );
      seek ( f, sizeof ( splitbox ) );
      blockwrite ( f, allrec, sizeof ( allrec ) );
      closefile ( f );
      {$I+}
      if ioresult <> 0 then
      begin
         b := false;
         splerr.recnum := 49;
         splerr.recstr := 'Unable to close SplitBase file.';
      end
   end
   else
      b := false;
   putdef := b;
end;

Function getsubindex (ind : longint) : boolean;
{Locates and loads the current secondary index into memory}
var
   b : boolean;
   f : file;
begin
   b := true;
   assignfile ( f, curdtb );
   {$I-}
   reset ( f, 1 );
   seek ( f, ind );
   {$I+}
   if ioresult = 0 then
   begin
      {$I-}
      blockread ( f, varbox^, sizeof ( splitbox ) );
      {$I+}
      if ioresult <> 0 then
      begin
         b := false;
         splerr.recnum := 9;
         splerr.recstr := 'Unable to read SplitBase file.';
      end;
      {$I-}
      closefile ( f );
      {$I+}
      if ioresult <> 0 then
      begin
         b := false;
         splerr.recnum := 10;
         splerr.recstr := 'Unable to close SplitBase file.';
      end;
   end
   else
   begin
      b := false;
      splerr.recnum := 12;
      splerr.recstr := 'Unable to open SplitBase file.';
   end;
   if b then
      cursub := ind;
   getsubindex := b;
end;

function findpos (idx : string) : boolean;
{Finds the position of the search field within the
 secondary index or subindex}
var
   b : boolean;
   cnt, l, l1, l2 : longint;
   s : string;
begin
   cnt := varbox^.count;
   b := true;
   l := 0;
   currec := 0;
   if cnt > 0 then
   begin
      if cnt > 1 then
      begin
         l1 := 1;
         l2 := cnt;
         while l1 <= l2 do
         begin
            l := (l2 - l1) div 2 + l1;
            s := varbox^.index[l].data;
            if ansicomparetext ( idx, s ) > 0 then
               l1 := l + 1
            else if ansicomparetext ( idx, s ) < 0 then
               l2 := l - 1
            else
               l2 := l1 - 1
         end
      end
      else
         l := 1;
      s := varbox^.index[l].data;
      {ind := varbox^.index[l].ptr;}
      currec := varbox^.index[l].ptr;
      curind := s;
      curpos := l
   end;
   findpos := b
end;

function findsubindex (idx : string) : boolean;
{Locates the secondary index that may contain the
 search field}
var
   b : boolean;
   l1, l2, l, cnt, ind : longint;
   s : string;
begin
   cnt := topbox^.count;
   l := 0;
   if cnt > 0 then
   begin
      if cnt > 1 then
      begin
         l1 := 1;
         l2 := cnt;
         while l1 <= l2 do
         begin
            l := (l2 - l1) div 2 + l1;
            s := topbox^.index[l].data;
            if ansicomparetext ( idx, s ) > 0 then
               l1 := l + 1
            else if ansicomparetext ( idx, s ) < 0 then
               l2 := l - 1
            else
               l2 := l1 - 1
         end
      end
      else
         l := 1;
      s := topbox^.index[l].data;
      if ansicomparetext ( idx, s ) < 0 then
         l := l - 1;
      if l = 0 then
         l := 1;
      s := topbox^.index[l].data;
      ind := topbox^.index[l].ptr;
      curtop := l;

      if ind > 0 then
      begin
         b := getsubindex(ind)
      end
      else
      begin
         b := false;
         splerr.recnum := 11;
         splerr.recstr := 'Illegal SplitBase index value.';
      end;

      if b then
      begin
         b := findpos (idx)
      end

   end
   else
   begin
      b := false;
      splerr.recnum := 8;
      splerr.recstr := 'SplitBase index is empty.';
   end;
   if b = false then
      currec := 0;
   findsubindex := b;
end;

function pullrec : boolean;
{Reads record into memory}
var
   b : boolean;
   f : file;
begin
   b := true;
   assignfile ( f, curdtb );
   {$I-}
   reset ( f, 1 );
   seek ( f, currec );
   {$I+}
   if ioresult = 0 then
   begin
      {$I-}
      setlength ( rechld, allrec.size );
      blockread ( f, rechld[1], allrec.size );
      {$I+}
      if ioresult <> 0 then
      begin
         b := false;
         splerr.recnum := 32;
         splerr.recstr := 'Unable to read record.';
      end;
      {$I-}
      closefile ( f );
      {$I+}
      if ioresult <> 0 then
      begin
         b := false;
         splerr.recnum := 33;
         splerr.recstr := 'Unable to close SplitBase file.';
      end;
   end
   else
   begin
      b := false;
      splerr.recnum := 34;
      splerr.recstr := 'Unable to open SplitBase file.';
   end;
   pullrec := b;
end;

function getrec (idx : string) : boolean;
{Loads the found record into memory}
var
   b : boolean;
   f : file;
begin
   b := true;
   if findsubindex (idx) then
   begin
      if comparetext (idx, curind) = 0 then
      begin
         assignfile ( f, curdtb );
         {$I-}
         reset ( f, 1 );
         seek ( f, currec );
         {$I+}
         if ioresult = 0 then
         begin
            {$I-}
            setlength ( rechld, allrec.size );
            blockread ( f, rechld[1], allrec.size );
            {$I+}
            if ioresult <> 0 then
            begin
               b := false;
               splerr.recnum := 14;
               splerr.recstr := 'Unable to read record.';
            end;
            {$I-}
            closefile ( f );
            {$I+}
            if ioresult <> 0 then
            begin
               b := false;
               splerr.recnum := 15;
               splerr.recstr := 'Unable to close SplitBase file.';
            end;
         end
         else
         begin
            b := false;
            splerr.recnum := 13;
            splerr.recstr := 'Unable to open SplitBase file.';
         end;
      end
      else
      begin
         b := false;
         splerr.recnum := 16;
         splerr.recstr := 'Data not found';
      end;
   end
   else
      b := false;
   if b = false then
      currec := 0;
   getrec := b;
end;

function putrec : boolean;
{Saves the new record within DB}
var
   b : boolean;
   f : file;
   l : longint;
begin
   b := true;
   assignfile ( f, curdtb );
   {$I-}
   reset ( f, 1 );
   l := filesize ( f );
   seek ( f, l );
   {$I+}
   if ioresult = 0 then
   begin
      {$I-}
      blockwrite ( f, rechld[1], allrec.size );
      {$I+}
      if ioresult <> 0 then
      begin
         b := false;
         splerr.recnum := 18;
         splerr.recstr := 'Unable to save record.';
      end;
      {$I-}
      closefile ( f );
      {$I+}
      if ioresult <> 0 then
      begin
         b := false;
         splerr.recnum := 19;
         splerr.recstr := 'Unable to close SplitBase file.';
      end;
   end
   else
   begin
      b := false;
      splerr.recnum := 17;
      splerr.recstr := 'Unable to open SplitBase file.';
   end;
   if b then
      currec := l
   else
      currec := 0;
   putrec := b;
end;

Function putsubindex (ind : longint) : boolean;
{Saves the secondary index within DB}
var
   b : boolean;
   f : file;
begin
   b := true;
   assignfile ( f, curdtb );
   {$I-}
   reset ( f, 1 );
   seek ( f, ind );
   {$I+}
   if ioresult = 0 then
   begin
      {$I-}
      blockwrite ( f, varbox^, sizeof ( splitbox ) );
      {$I+}
      if ioresult <> 0 then
      begin
         b := false;
         splerr.recnum := 20;
         splerr.recstr := 'Unable to write SplitBase file.';
      end;
      {$I-}
      closefile ( f );
      {$I+}
      if ioresult <> 0 then
      begin
         b := false;
         splerr.recnum := 21;
         splerr.recstr := 'Unable to close SplitBase file.';
      end;
   end
   else
   begin
      b := false;
      splerr.recnum := 22;
      splerr.recstr := 'Unable to open SplitBase file.';
   end;
   putsubindex := b;
end;

function puttop : boolean;
{Saves main SplitBase index into DB. This
 function will return false if process fails}
var
   b : boolean;
   f : file;
begin
   b := true;
   assignfile ( f, curdtb );
   {$I-}
   reset ( f, 1 );
   {$I+}
   if ioresult = 0 then
   begin
      {$I-}
      blockwrite ( f, topbox^, sizeof ( splitbox ) );
      {$I+}
      if ioresult <> 0 then
      begin
         b := false;
         splerr.recnum := 25;
         splerr.recstr := 'Unable top index.';
      end;
      {$I-}
      closefile ( f );
      {$I+}
      if ioresult <> 0 then
      begin
         b := false;
         splerr.recnum := 26;
         splerr.recstr := 'Unable to close SplitBase file.';
      end;
   end
   else
   begin
      b := false;
      splerr.recnum := 27;
      splerr.recstr := 'Unable to open SplitBase file.';
   end;
   puttop := b;
end;

function splitit : boolean;
{Saves the index field within the main or secondary index
 and splits secondary index}
var
   b : boolean;
   l1, l2 : longint;
   f : file;
   s : string;
begin
   b := true;
   l1 := varbox^.count div 2;
   l2 := varbox^.count - l1;
   varbox^.count := l1;
   putsubindex ( cursub );
   move ( varbox^.index[l1 + 1], varbox^.index[1],
          l2 * sizeof ( Splitrec ) );
   varbox^.count := l2;
   assignfile ( f, curdtb );
   {$I-}
   reset ( f, 1 );
   cursub := filesize ( f );
   close ( f );
   {$I+}
   if ioresult = 0 then
   begin
      if putsubindex ( cursub ) then
      begin
         s := varbox.index[1].data;
         if comparetext ( topbox^.index[ curtop ].data,
                           s ) < 0 then
            curtop := curtop + 1;
         move ( topbox^.index[curtop],
                topbox^.index[curtop + 1],
                (splmax - curtop) * sizeof (Splitrec) );
         topbox^.index[curtop].data :=
            varbox.index[1].data;
         topbox^.index[curtop].ptr := cursub;
         topbox^.count := topbox^.count + 1;
         if not (puttop) then
            b := false;
      end
      else
      begin
         b := false;
         splerr.recnum := 24;
         splerr.recstr := 'Unable to split subindex.';
      end
   end
   else
   begin
      b := false;
      splerr.recnum := 23;
      splerr.recstr := 'Unable to size SplitBase file.';
   end;
   splitit := b
end;

function addrec (idx : string) : boolean;
{Adds a new record to DB}
var
   b : boolean;
   l : longint;
begin
   b := true;
   if activedb then
   begin
      {if topbox.count = splmax then}
      if limrec >= recmax then
      begin
         b := false;
         splerr.recstr := 'Maximum records exceeded';
      end
   end
   else
   begin
      b := false;
      splerr.recstr := 'No active database.';
   end;
   if b then
   begin
      if findsubindex (idx) then
      begin
         if ansicomparetext ( idx, curind ) > 0 then
            l := curpos + 1
         else
            l := curpos;
         if putrec then
         begin
            move ( varbox^.index[l], varbox^.index[l + 1],
                   (splmax - l) * sizeof ( Splitrec ) );
            varbox^.index[l].data := idx;
            varbox^.index[l].ptr := currec;
            varbox^.count := varbox^.count + 1;
            if varbox^.count = splmax then
            begin
               if splitit = false then
                  b := false
            end
            else
            begin
               if not (putsubindex ( cursub )) then
                  b := false
            end;
            if (l = 1) and (b) then
            begin
               topbox^.index[1].data := varbox.index[1].data;
               if not (puttop) then
                  b := false;
            end;
         end
      end
      else
      begin
         if splerr.recnum = 8 then
         begin
            if putrec then
            begin
               topbox^.state := 1;
               topbox^.count := 1;
               topbox^.index[1].data := idx;
               topbox^.index[1].ptr := sizeof ( splitbox ) +
                                       sizeof ( recdef );
               cursub := sizeof ( splitbox ) +
                         sizeof ( recdef );
               if puttop then
               begin
                  varbox^.index[1].data := idx;
                  varbox^.index[1].ptr := currec;
                  varbox^.count := 1;
                  if not (putsubindex ( cursub )) then
                     b := false
               end
               else
                  b := false
            end
            else
               b := false
         end
         else
            b := false;
      end;
   end
   else
      splerr.recnum := 50;
   if b then
      limrec := limrec + 1;
   addrec := b;
end;

function setspl ( spldat : string ) : boolean;
{Automated record definition through a string. The string
 contains the length of each field starting with the first
 and defined by three digits. If the field length is less
 than three digits fill the left part with zeroes.}
var
   b : boolean;
   x, y, len : integer;
   s : string;
begin
   b := true;
   x := length ( spldat );
   if ( x mod 3 = 0 ) and ( x > 0 ) then
   begin
      x := x div 3;
      len := 0;
      for y := 0 to x - 1 do
      begin
         s := copy ( spldat, (y * 3) + 1, 3 );
         if strtoint ( s ) > 0 then
         begin
            len := len + strtoint ( s );
            allrec.def [ y + 1 ] := s
         end
         else
         begin
            b := false;
            splerr.recnum := 29;
            splerr.recstr := 'Illegal definition data';
         end;
      end;
      if b then
      begin
         allrec.size := len;
         setlength ( rechld, len );
      end
   end
   else
   begin
      b := false;
      splerr.recnum := 30;
      splerr.recstr := 'Illegal definition data';
   end;
   setspl := b;
end;

function addfield ( recdat : string; pos : integer ) :
         boolean;
{Adds a field to a record in DB}
var
   x, y : integer;
   b : boolean;
begin
   b := true;
   y := 0;
   x := 1;
   while x < pos do
   begin
      y := y + strtoint ( allrec.def[x] );
      x := x + 1;
   end;
   x := strtoint ( allrec.def[pos] );
   while length ( recdat ) < x do
      recdat := recdat + ' ';
   setlength ( recdat, x );
   rechld := copy ( rechld, 1, y ) + recdat +
             copy ( rechld, y + x + 1, length ( rechld ) -
                    ( x + y ) );
   addfield := b;
end;

function getfield ( pos : integer ) : string;
{Retreives a field from a record in DB}
var
   x, y : integer;
   s : string;
begin
   y := 0;
   x := 1;
   s := '';
   while x < pos do
   begin
      y := y + strtoint ( allrec.def[x] );
      x := x + 1;
   end;
   x := strtoint ( allrec.def[pos] );
   s := copy ( rechld, y + 1, x );
   getfield := s;
end;

function delrec: boolean;
{Deletes the current record from the database}
var
   b : boolean;
   l : longint;
begin
   b := true;
   if activedb then
   begin
      if not (dbempty) then
      begin
         if not (activerec) then
         begin
            splerr.recstr := 'No active record.';
            b := false
         end
      end
      else
      begin
         splerr.recstr := 'Empty database.';
         b := false
      end
   end
   else
   begin
      splerr.recstr := 'No active database';
      b := false
   end;
   if b then
   begin
      l := curpos;
      move ( varbox^.index[l + 1], varbox^.index[l],
           (splmax - l) * sizeof ( Splitrec ) );
      varbox^.count := varbox^.count - 1;
      if varbox^.count > 0 then
      begin
         if putsubindex ( cursub ) then
         begin
            allrec.recout := allrec.recout + 1;
            if not (putdef) then
               b := false;
            if l = 1 then
            begin
               topbox^.index[curtop].data :=
                  varbox.index[1].data;
               if not (puttop) then
                  b := false;
            end;
         end
         else
            b := false;
      end
      else
      begin
         move ( topbox^.index[curtop + 1],
                varbox^.index[curtop],
                (splmax - curtop) * sizeof ( Splitrec ) );
         topbox^.count := topbox^.count - 1;
         allrec.indout := allrec.indout + 1;
         allrec.recout := allrec.recout + 1;
         if puttop then
         begin
            if not (putdef) then
               b := false;
         end
         else
            b := false
      end;
   end
   else
      splerr.recnum := 48;
   if b then
      limrec := limrec - 1;
   if limrec < 0 then
      limrec := 0;
   delrec := b;
end;

function modrec ( idx : string ) : boolean;
{This function replaces the current record by a new one}
var
   b : boolean;
begin
   b := true;
   if delrec then
   begin
      if not ( addrec ( idx ) ) then
         b := false
   end
   else
      b := false;
   modrec := b
end;

function firstrec : boolean;
{This function locates and loads the first record in DB}
var
   l, ind : longint;
   s : string;
   b : boolean;
begin
   b := true;
   if activedb then
   begin
      if dbempty then
      begin
         splerr.recstr := 'Empty database.';
         b := false
      end
   end
   else
   begin
      splerr.recstr := 'No active database';
      b := false
   end;
   if b then
   begin
      curtop := 1;
      l := 1;
      s := topbox^.index[l].data;
      ind := topbox^.index[l].ptr;

      if ind > 0 then
      begin
         if getsubindex(ind) then
         begin
            s := varbox^.index[1].data;
            currec := varbox^.index[1].ptr;
            curind := s;
            curpos := 1;
            if not (pullrec) then
            begin
               b := false;
               splerr.recnum := 35;
               splerr.recstr := 'Unable to load record';
            end;
         end
         else
         begin
            b := false;
            splerr.recnum := 36;
            splerr.recstr := 'Error loading subindex';
         end;
      end
   end
   else
      splerr.recnum := 47;
   firstrec := b;
end;

function lastrec : boolean;
{This function locates and loads the last record in DB}
var
   l, ind : longint;
   s : string;
   b : boolean;
begin
   b := true;
   if activedb then
   begin
      if dbempty then
      begin
         splerr.recstr := 'Empty database.';
         b := false
      end
   end
   else
   begin
      splerr.recstr := 'No active database';
      b := false
   end;
   if b then
   begin
      curtop := topbox^.count;
      l := topbox^.count;
      s := topbox^.index[l].data;
      ind := topbox^.index[l].ptr;

      if ind > 0 then
      begin
         if getsubindex(ind) then
         begin
            s := varbox^.index[varbox^.count].data;
            currec := varbox^.index[varbox^.count].ptr;
            curind := s;
            curpos := varbox^.count;
            if not (pullrec) then
            begin
               b := false;
               splerr.recnum := 37;
               splerr.recstr := 'Unable to load record.';
            end;
         end
         else
         begin
            b := false;
            splerr.recnum := 38;
            splerr.recstr := 'Error loading subindex';
         end;
      end
   end
   else
      splerr.recnum := 46;
   lastrec := b;
end;

function nextrec : boolean;
{This function locates and loads the next record in DB}
var
   l, ind : longint;
   s : string;
   b : boolean;
begin
   b := true;
   if activedb then
   begin
      if not (dbempty) then
      begin
         if not (activerec) then
         begin
            splerr.recstr := 'No active record.';
            b := false
         end
      end
      else
      begin
         splerr.recstr := 'Empty database.';
         b := false
      end
   end
   else
   begin
      splerr.recstr := 'No active database';
      b := false
   end;
   if b then
   begin
      l := curpos + 1;
      if l > varbox^.count then
      begin
         if curtop < topbox^.count then
         begin
            curtop := curtop + 1;
            l := curtop;
            s := topbox^.index[l].data;
            ind := topbox^.index[l].ptr;
            if ind > 0 then
            begin
               if getsubindex(ind) then
               begin
                  s := varbox^.index[1].data;
                  currec := varbox^.index[1].ptr;
                  curind := s;
                  curpos := 1;
                  if not (pullrec) then
                  begin
                     b := false;
                     splerr.recnum := 39;
                     splerr.recstr := 'Error accesing fields';
                  end;
               end
               else
               begin
                  b := false;
                  splerr.recnum := 40;
                  splerr.recstr := 'Error loading subindex';
               end;
            end
         end
      end
      else
      begin
         s := varbox^.index[l].data;
         currec := varbox^.index[l].ptr;
         curind := s;
         curpos := l;
         if not (pullrec) then
         begin
            b := false;
            splerr.recnum := 41;
            splerr.recstr := 'Error loading record';
         end;
      end
   end
   else
      splerr.recnum := 45;
   nextrec := b
end;

function prevrec : boolean;
{This function locates and loads the previous record in DB}
var
   l, ind : longint;
   s : string;
   b : boolean;
begin
   b := true;
   if activedb then
   begin
      if not (dbempty) then
      begin
         if not (activerec) then
         begin
            splerr.recstr := 'No active record.';
            b := false
         end
      end
      else
      begin
         splerr.recstr := 'Empty database.';
         b := false
      end
   end
   else
   begin
      splerr.recstr := 'No active database';
      b := false
   end;
   if b then
   begin
      l := curpos - 1;
      if l = 0 then
      begin
         if curtop > 1 then
         begin
            curtop := curtop - 1;
            l := curtop;
            s := topbox^.index[l].data;
            ind := topbox^.index[l].ptr;
            if ind > 0 then
            begin
               if getsubindex(ind) then
               begin
                  s := varbox^.index[varbox^.count].data;
                  currec := varbox^.index[varbox^.count].ptr;
                  curind := s;
                  curpos := varbox^.count;
                  if not (pullrec) then
                  begin
                     b := false;
                     splerr.recnum := 42;
                     splerr.recstr := 'Error loading record';
                  end;
               end
               else
               begin
                  b := false;
                  splerr.recnum := 43;
                  splerr.recstr := 'Error loading subindex';
               end;
            end
         end
      end
      else
      begin
         s := varbox^.index[l].data;
         currec := varbox^.index[l].ptr;
         curind := s;
         curpos := l;
         if not (pullrec) then
         begin
            b := false;
            splerr.recnum := 41;
            splerr.recstr := 'Error loading record';
         end;
      end
   end
   else
      splerr.recnum := 44;
   prevrec := b
end;

(******* End of SplitBase Data Management Program *******)