home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / ADC_TP3.ZIP / MULKEY.BOX < prev    next >
Encoding:
Text File  |  1987-03-01  |  31.3 KB  |  848 lines
  1. (*
  2. MULTIKEY v 1.0 - Routines to help you use Turbo Database Toolbox
  3.                  Edwin Floyd 76067,747
  4.  
  5. These routines provide three services to the programmer:
  6.  
  7.    1. Automate the creation and maintenance of multiple index files within
  8.       a Database Toolbox application.
  9.  
  10.    2. Automatically rebuild a lost/corrupted (or build a new) index file.
  11.  
  12.    3. Rebuild the freespace chain on a corrupted data file.
  13.  
  14. Under the premise that an example is worth a basketfull of exposition, a
  15. brief description of the routines and data structures is provided followed
  16. by an example program.
  17.  
  18.    CONST MaxKeys        = nn;
  19.  
  20. Must appear before the include for MULTIKEY.BOX.  This specifies the
  21. maximum number of keys to be defined for any record in this program.
  22.  
  23.    {$I MULTIKEY.BOX}
  24.  
  25. Must appear after all Database Toolbox includes.  All Toolbox routines
  26. are referenced, so don't leave any Includes out.
  27.  
  28.    Anyname_File, ...: File_Type;
  29.  
  30. File_Type is defined in MULTIKEY.BOX.  For each File_Type record, you
  31. must fill out a description of the file and all key fields in the record
  32. sometime before calling Open_File:
  33.  
  34.    WITH Anyname_File DO BEGIN
  35.       Name := 'xxxxxxxx';        You may specify the Drive, path and file name,
  36.                                  Leave off the extension, the data file will
  37.                                  have the extension ".DAT" and you may specify
  38.                                  the extension of each index file below.
  39.  
  40.       RecSize := Sizeof (Rec);   Specify the size of the data record
  41.  
  42.       Number_Of_Keys := nn;      Specify the number of keys (<= MaxKeys) for
  43.                                  This file.
  44.  
  45.       WITH Key [1] DO BEGIN      Describe each key...
  46.  
  47.          Offset    := KeyOffset (Rec, Rec.Key);
  48.                                  Specify offset of first byte of key from
  49.                                  beginning of record (first byte of record
  50.                                  is offset zero (0) but the minimum key
  51.                                  offset allowed is 2 because of the record
  52.                                  status word).  You may use the KeyOffset
  53.                                  function described below.
  54.  
  55.          KeyLength := Sizeof (Rec.Key);
  56.                                  Specify the length in bytes of the key for
  57.                                  CHAR or ARRAY of CHAR key.
  58.  
  59.          Extension := 'iii';     Specify the extension for the index file
  60.  
  61.          Unique    := TRUE/FALSE;Is this a unique key (TRUE) or are duplicates
  62.                                  allowed (FALSE)?
  63.  
  64.          Upshift   := TRUE/FALSE;Should the key be shifted to upper case
  65.                                  before insertion into the index and before
  66.                                  index search? (key field in data record is
  67.                                  not changed)
  68.  
  69.          KeyType   := Key_xxxxx; Specify key type... Allowed types are:
  70.  
  71.             Key_Integer - Key is integer, KeyLength is assumed to be 2.
  72.  
  73.             Key_Char    - Key is CHAR or ARRAY of CHAR or BYTE; KeyLength
  74.                           specifies the number of bytes in the array.
  75.  
  76.             Key_String  - Key is a string; KeyLength is ignored.
  77.  
  78.             Key_Real    - Key is a REAL number; converted to a 16 byte
  79.                           string for the index; KeyLength is ignored.
  80.                           (Note.. I have yet to find a use for Real
  81.                           number keys)
  82.       END;
  83.       WITH Key [2] DO BEGIN... Etc for each key
  84.    END;
  85.  
  86. Also defined in File_Type is IOError: BOOLEAN which should be checked
  87. after each call to a MULTIKEY routine.  The meaning of IOError varies
  88. with the routine.
  89.  
  90.    Anyname_Rec: Your_Record_Description;  Must contain a "Status"
  91.       INTEGER field at the very beginning of the record as recommended
  92.       in the Turbo Database Toolbox refrence manual.  The first two
  93.       bytes of every record are FORCED to binary zeros on each Add
  94.       or Update operation and may not be part of a key field.
  95.  
  96. Routines:
  97.  
  98.    PROCEDURE Open_File (VAR F: File_Type);
  99.  
  100.       Opens the data/index files; Rebuilds missing index files;
  101.       Rebuilds freespace chain while it's at it if any index
  102.       files were missing.
  103.  
  104.       (The rebuild features were incorporated for an application
  105.       running on a CP/M machine 40 miles away supported by
  106.       clerical personnel and me by long-distance telephone.  If
  107.       the system crashed, it was OK in this case to lose a little
  108.       data as long as the application could be run to check/re-do
  109.       updates.  It is quick and relatively safe to tell the clerk
  110.       over the phone how to delete the index files, then when she
  111.       fires up the application, rebuild guarantees the
  112.       consistancy and viability of the database.  There is no
  113.       guarantee here however of cross-file consistancey.  If your
  114.       application involves multiple files, that will have to be
  115.       checked at the application level)
  116.  
  117.       F.IOError will be TRUE iff, while rebuilding an index file,
  118.       a duplicate key was encountered which prevented a key from
  119.       being added normally.  This usually only happens where a
  120.       program change has added or altered a key field
  121.       description and existing data violates the new Unique
  122.       attribute (in other words.. programmer error).
  123.  
  124.    PROCEDURE Read_Record (VAR F: File_Type; K: INTEGER; VAR Rec);
  125.  
  126.       Read a record from file.  Key number is specified by K.
  127.       Search key should be placed in the record at the proper
  128.       offset prior to calling Read_Record.  Index file K is
  129.       searched for a match to search key or next higher key if no
  130.       match found.  If search key is higher than any on file,
  131.       F.IOError is set TRUE and Rec remains unchanged.  This
  132.       routine sets the beginning record for subsequent
  133.       Next_Record, Previous_Record calls for the same K.
  134.  
  135.    PROCEDURE Next_Record (VAR F: File_Type; K: INTEGER; VAR Rec);
  136.  
  137.       Read the next record by key K from the file.  At EOF,
  138.       F.IOError is set TRUE and the contents of Rec are unchanged.
  139.  
  140.    PROCEDURE Previous_Record (VAR F: File_Type; K: INTEGER; VAR Rec);
  141.  
  142.       Read the previous record by key K from the file.  At BOF,
  143.       F.IOError is set TRUE and the contents of Rec are unchanged.
  144.  
  145.    PROCEDURE Add_Record (VAR F: File_Type; VAR Rec);
  146.  
  147.       Add record Rec to the file.  Insert all keys in index files.
  148.       IOError set TRUE if duplicate key on a Unique key index.
  149.       If IOError then record is not added and any key insertions
  150.       made before discovery of duplicate key are backed out.
  151.  
  152.    PROCEDURE Update_Record (VAR F: File_Type; VAR Rec);
  153.  
  154.       Update last record retrieved or added.  Delete and re-insert
  155.       any key fields which may have changed.  You must have done a
  156.       valid (no IOError) retrieval, Add, or Update operation immediately
  157.       before calling Update_Record and you should check to be certain
  158.       you received the record you were expecting.  See sample program
  159.       for details.  IOError set TRUE if any key field was changed
  160.       to a duplicate key on a Unique index.  If IOError then record
  161.       is not updated and any key changes are backed out.
  162.  
  163.    PROCEDURE Delete_Record (VAR F: File_Type);
  164.  
  165.       Delete last record retrieved, updated, or added.  Delete any
  166.       key fields which may have changed.  You must have done a valid
  167.       (no IOError) retrieval, Add, or Update operation immediately
  168.       before calling Delete_Record and you should check to be certain
  169.       you received the record you were expecting.  See sample program
  170.       for details.  IOError set TRUE if no valid record retrieval done
  171.       before Delete_Record called.
  172.  
  173.    PROCEDURE Close_File (Var Anyname_File: File_Type);
  174.  
  175.       Obvious. IOError never set.
  176.  
  177.    FUNCTION KeyOffset (VAR Rec; VAR Field): INTEGER;
  178.  
  179.       Pass it a record and a field within that record (untyped parameters)
  180.       and KeyOffset returns the offset in bytes from the record to the field.
  181.       This function may be used to tie the key description set-up as
  182.       described above to the record description and thereby save you
  183.       much frustration should the record layout change and you forget to
  184.       change the key description.
  185.  
  186. Five things to check when adding a new key field to your program:
  187.  
  188.    1. Check MaxKeyLen to be sure your new key will fit.
  189.  
  190.    2. Check MaxKeys to be sure the key table in File_Type is big enough for
  191.       your new key ($R+ will catch this I think).
  192.  
  193.    3. Change Number_Of_Keys in the file description set-up (Be sure to do
  194.       this if you _Remove_ a key too).
  195.  
  196.    4. Build a new key description for your new key in the file description
  197.       set-up (WITH Key [nn] DO BEGIN...) making sure the offset is at
  198.       least 2.
  199.  
  200.    5. Use the new key for something (Why did you create it?).
  201.  
  202. 8 Bit / 16 Bit changes:
  203.  
  204.    The program is set up for 16 bit system use, but it was developed
  205.    on an 8 bit system.  There are two changes to be made near the top
  206.    of the file for 8 bit operation.  They are marked with the
  207.    string "8 Bit" for which you may ^QF if you can fit this file in
  208.    your 8 bit editor.  The changes involve moving comment brackets
  209.    around and should be obvious.  If you cannot fit this file in your
  210.    editor and have no other editor, or the changes are not obvious,
  211.    you may insert the following short routine in your program before
  212.    the {$I MULTIKEY.BOX} Include to allow the program to compile:
  213.  
  214.    FUNCTION Ofs (VAR x): INTEGER; BEGIN
  215.       Ofs := ADDR (x);
  216.    END;
  217.  
  218. Any comments or improvements would be welcome.  Address EasyPlex or
  219. Borland SIG correspondence to: Edwin Floyd 76067,747.  Please claim
  220. credit for any modifications in the update history below.
  221.  
  222. Update History
  223. Date     Who                      Change
  224. -------- ------------------------ --------------------------------------------
  225. 03/26/86 Edwin Floyd              First release, v1.0
  226.  
  227. ------------------------------------------------------------------------------
  228.  
  229. The following program is submitted as an example.  Block-mark the
  230. program and write it to a file; Compile and run.  Wipe out the index
  231. files (DEL CLASS.IX* or ERA CLASS.IX*.) and run again; note that the
  232. index files are rebuilt.  Add a new key field: Location (^QF Search
  233. for "{@" for suggested changes); re-compile/run program; note that new
  234. index file is built; note ease of adding key fields.
  235.  
  236. {Beginning of Example Program}
  237.  
  238. PROGRAM MultiKey_Example;
  239. {$R+}
  240. CONST
  241.    MaxDataRecSize = 150;
  242.    MaxKeylen      = 30; {@ Check to add new key; will it fit? Yes.}
  243.    PageSize       = 16;
  244.    Order          = 8;
  245.    PageStackSize  = 8;
  246.    MaxHeight      = 7;
  247.  
  248.    MaxKeys        = 3; {Must appear before $I MULTIKEY.BOX}
  249.  {@MaxKeys        = 4;  Change to add new key}
  250.  
  251. {$I ACCESS.BOX    }
  252. {$I GETKEY.BOX    }
  253. {$I ADDKEY.BOX    }
  254. {$I DELKEY.BOX    }
  255.  
  256. {$I MULTIKEY.BOX  } {<-- This is it!}
  257.  
  258. TYPE
  259.    NameType     = ARRAY [1..25] OF CHAR;
  260.    Class_Record = RECORD  {Record for sample application}
  261.       Status:     INTEGER;   {Always allocate the first 2 bytes; Never touch}
  262.       Id:         INTEGER;   {Primary Key}
  263.       Title:      NameType;  {Secondary Key}
  264.       Instructor: NameType;  {Tertiary Key}
  265.       Location:   NameType;  {New Key, add later}
  266.       Registered: INTEGER;
  267.    END;
  268.  
  269. VAR
  270.    Rec:            Class_Record;
  271.    Indexed_File:   File_Type;   {Defined in MULTIKEY.BOX}
  272.  
  273. PROCEDURE Display_Record (VAR R: Class_Record); BEGIN
  274.    WITH R DO BEGIN
  275.       WRITELN (' Id: ', Id, ', Registered: ', Registered, ', Title: ', Title);
  276.       WRITELN (' Instructor: ', Instructor);
  277.       WRITELN (' Location:   ', Location);
  278.       WRITELN;
  279.    END;
  280. END;
  281.  
  282. PROCEDURE Pause;
  283. VAR
  284.    Ch: Char;
  285. BEGIN
  286.    WRITELN;
  287.    WRITE ('Press any key to continue...');
  288.    READ (KBD, Ch);
  289.    WRITELN
  290. END;
  291.  
  292. BEGIN {MultiKey_Example}
  293.  
  294.    InitIndex;
  295.  
  296.    WITH Indexed_File DO BEGIN
  297.       Name := 'CLASS';
  298.       RecSize := Sizeof (Rec);
  299.       Number_Of_Keys := 3;
  300.     {@Number_Of_Keys := 4;    Change to add new key}
  301.       WITH Key [1] DO BEGIN
  302.          Offset    := KeyOffset (Rec, Rec.Id);
  303.          KeyLength := Sizeof (Rec.Id);
  304.          Extension := 'IX1';
  305.          Unique    := TRUE;  {No duplicates allowed}
  306.          Upshift   := FALSE;
  307.          KeyType   := Key_Integer;
  308.       END;
  309.       WITH Key [2] DO BEGIN
  310.          Offset    := KeyOffset (Rec, Rec.Title);
  311.          KeyLength := Sizeof (Rec.Title);
  312.          Extension := 'IX2';
  313.          Unique    := FALSE;
  314.          Upshift   := TRUE;
  315.          KeyType   := Key_Char;
  316.       END;
  317.       WITH Key [3] DO BEGIN
  318.          Offset    := KeyOffset (Rec, Rec.Instructor);
  319.          KeyLength := Sizeof (Rec.Instructor);
  320.          Extension := 'IX3';
  321.          Unique    := FALSE;
  322.          Upshift   := TRUE;
  323.          KeyType   := Key_Char;
  324.       END;
  325.       {@                    Delete this line to add new key
  326.       WITH Key [4] DO BEGIN
  327.          Offset    := KeyOffset (Rec, Rec.Location);
  328.          KeyLength := Sizeof (Rec.Location);
  329.          Extension := 'IX4';
  330.          Unique    := FALSE;
  331.          Upshift   := TRUE;
  332.          KeyType   := Key_Char;
  333.       END;
  334.                             Delete this line to add new key}
  335.    END;
  336.  
  337.    Open_File (Indexed_File);
  338.    IF Indexed_File.IOError THEN BEGIN
  339.       WRITELN ('Error rebuilding index file, duplicate key.');
  340.       WRITELN ('Continuing anyway just to see what it does.');
  341.    END;
  342.  
  343.    WITH Rec DO BEGIN
  344.  
  345.       {Dummy up some data for demonstration}
  346.       WRITELN;
  347.       WRITELN ('Inserting records into database');
  348.       WRITELN ('On first run, add for Record 3 will fail (duplicate key)');
  349.       WRITELN ('On subsequent runs, three or four adds will fail');
  350.  
  351.       Id :=         1;
  352.       Title :=      'Marking Time for Managers';
  353.       Instructor := 'White, Perry             ';
  354.       Location :=   'Daily Globe Building     ';
  355.       Registered := 10;
  356.       Add_Record (Indexed_File, Rec);
  357.       IF Indexed_File.IOError THEN WRITELN ('Record ', Id, ' not added');
  358.  
  359.       Id :=         2;
  360.       Title :=      'Evading FAA Regulations  ';
  361.       Instructor := 'Yeager, Chuck            ';
  362.       Location :=   'Nevada Desert            ';
  363.       Registered := 20;
  364.       Add_Record (Indexed_File, Rec);
  365.       IF Indexed_File.IOError THEN WRITELN ('Record ', Id, ' not added');
  366.  
  367.       Id :=         3;
  368.       Title :=      'Elementary Wall Crawling ';
  369.       Instructor := 'Parker, Peter            ';
  370.       Location :=   'Apt 3B                   ';
  371.       Registered := 30;
  372.       Add_Record (Indexed_File, Rec);
  373.       IF Indexed_File.IOError THEN WRITELN ('Record ', Id, ' not added');
  374.  
  375.       Id :=         3;
  376.       Title :=      'This record has the same ';
  377.       Instructor := 'primary key as the previo';
  378.       Location :=   'us one.  Add will fail.  ';
  379.       Registered := 35;
  380.       Add_Record (Indexed_File, Rec);
  381.       IF Indexed_File.IOError THEN WRITELN ('Record ', Id, ' not added');
  382.  
  383.       Id :=         4;
  384.       Title :=      'Stalls, Spins, Wreckage  ';
  385.       Instructor := 'Yeager, Chuck            '; {Duplicate OK}
  386.       Location :=   'All over Nevada          ';
  387.       Registered := 40;
  388.       Add_Record (Indexed_File, Rec);
  389.       IF Indexed_File.IOError THEN WRITELN ('Record ', Id, ' not added');
  390.       Pause;
  391.  
  392.       {Now read them back in various ways}
  393.  
  394.       WRITELN ('Reading forward by primary key: Id');
  395.       WRITELN ('Four records, first time thru');
  396.       WRITELN;
  397.       Id := 0;
  398.       Read_Record (Indexed_File, 1, Rec);
  399.       WHILE NOT Indexed_File.IOError DO BEGIN
  400.          Display_Record (Rec);
  401.          Next_Record (Indexed_File, 1, Rec);
  402.       END;
  403.       Pause;
  404.  
  405.       WRITELN ('Reading forward by secondary key: Title');
  406.       WRITELN;
  407.       Title := '                         ';
  408.       Read_Record (Indexed_File, 2, Rec);
  409.       WHILE NOT Indexed_File.IOError DO BEGIN
  410.          Display_Record (Rec);
  411.          Next_Record (Indexed_File, 2, Rec);
  412.       END;
  413.       Pause;
  414.  
  415.       WRITELN ('Reading backward by secondary key: Title');
  416.       WRITELN;
  417.       Title := '                         ';
  418.       Read_Record (Indexed_File, 2, Rec);
  419.       Previous_Record (Indexed_File, 2, Rec); {Get to BOF}
  420.       REPEAT
  421.          Previous_Record (Indexed_File, 2, Rec);
  422.          IF NOT Indexed_File.IOError THEN Display_Record (Rec);
  423.       UNTIL Indexed_File.IOError;
  424.       Pause;
  425.  
  426.       WRITELN ('Locate by partial tertiary key: Instructor = "YEAG "');
  427.       WRITELN ('And forward from there to EOF by key: Instructor');
  428.       WRITELN;
  429.       Instructor := 'YEAG                     '; {Note upper case search}
  430.       Read_Record (Indexed_File, 3, Rec);
  431.       WHILE NOT Indexed_File.IOError DO BEGIN
  432.          Display_Record (Rec);
  433.          Next_Record (Indexed_File, 3, Rec);
  434.       END;
  435.       Pause;
  436.  
  437.       WRITELN ('Locate, Update - Record Id = 4');
  438.       WRITELN ('Update will fail (duplicate key) second time through');
  439.       Id := 4;
  440.       Read_Record (Indexed_File, 1, Rec);
  441.       IF (Id = 4) AND NOT Indexed_File.IOError THEN BEGIN
  442.          WRITELN ('  Locate OK');
  443.          Id :=         0;                            {OK to change key}
  444.          Title :=      'Luck in Aviation         ';  {""}
  445.          Instructor := 'Yeager, Chuck            ';
  446.          Location :=   'This record updated      ';
  447.          Registered := 60;
  448.          Writeln ('  Record changed...');
  449.          Display_Record (Rec);
  450.          Update_Record (Indexed_File, Rec);
  451.          IF Indexed_File.IOError THEN WRITELN ('Record ', Id, ' not updated')
  452.          ELSE WRITELN (' Update successful');
  453.       END;
  454.       Pause;
  455.  
  456.       WRITELN ('Locate, Delete - Record Id = 3');
  457.       Id := 3;
  458.       Read_Record (Indexed_File, 1, Rec);
  459.       IF (Id = 3) AND NOT Indexed_File.IOError THEN BEGIN
  460.          WRITELN ('  Locate OK');
  461.          delete_Record (Indexed_File);
  462.          IF Indexed_File.IOError THEN WRITELN ('Record ', Id, ' not deleted')
  463.          ELSE WRITELN (' Delete Successful');
  464.  
  465.          {Note... At this point, the record just deleted remains unchanged
  466.           in Rec and may be immediately added back to the database}
  467.  
  468.       END;
  469.       Pause;
  470.  
  471.       WRITELN ('Reading forward by primary key again');
  472.       Id := 0;
  473.       Read_Record (Indexed_File, 1, Rec);
  474.       WHILE NOT Indexed_File.IOError DO BEGIN
  475.          Display_Record (Rec);
  476.          Next_Record (Indexed_File, 1, Rec);
  477.       END;
  478.       Pause;
  479.  
  480.       {@                Delete this line to read by new key
  481.       WRITELN ('Reading forward by new key');
  482.       Location := '                         ';
  483.       Read_Record (Indexed_File, 4, Rec);
  484.       WHILE NOT Indexed_File.IOError DO BEGIN
  485.          Display_Record (Rec);
  486.          Next_Record (Indexed_File, 4, Rec);
  487.       END;
  488.       Pause;
  489.                         Delete this line to read by new key}
  490.    END;
  491.  
  492.    Close_File (Indexed_File);
  493.    WRITELN ('End of Demo');
  494. END.
  495.  
  496. {End of Example Program}
  497.  
  498. *)
  499.  
  500. {Beginning of MULTIKEY routines}
  501.  
  502. TYPE
  503.    KEY_TYPE  = (KEY_INTEGER, KEY_CHAR, KEY_STRING, KEY_REAL);
  504.    FILE_TYPE = RECORD   {Fields marked with * must be set before OPEN_FILE}
  505.       NAME: {8 Bit..  STRING [10];}{* Data/Index file [drive:\path and] base}
  506.             {16 Bit.} STRING [60]; {    name; extension will be .DAT for data
  507.                                         file or EXTENSION (see below) for
  508.                                         index.}
  509.       RECSIZE: INTEGER;            {* Length of records in file;
  510.                                         use RECSIZE := SIZEOF (rec)}
  511.       IOERROR: BOOLEAN;            {  Test after each call; True if error}
  512.       REC_REF: INTEGER;            {  Record reference in data file}
  513.       DATA_FILE: DATAFILE;         {  Data file control block}
  514.       NUMBER_OF_KEYS: BYTE;        {* Counter for array below}
  515.       KEY: ARRAY [1..MAXKEYS] OF RECORD {Each key must be explicitly described}
  516.          OFFSET:    INTEGER;       {* Offset from start of record to this key;
  517.                                         use OFFSET := KEYOFFSET (rec, field)}
  518.          KEYLENGTH: BYTE;          {* Length of this key;
  519.                                         use KEYLENGTH := SIZEOF (field)}
  520.          EXTENSION: STRING [3];    {* Extension for this index file name; the
  521.                                         [drive:\path and] name is from NAME
  522.                                         above}
  523.          UNIQUE:    BOOLEAN;       {* True if this key is to be unique}
  524.          UPSHIFT:   BOOLEAN;       {* True if case to be ignored on index}
  525.          KEYTYPE:   KEY_TYPE;      {* Data type of key}
  526.          INDEX_FILE: INDEXFILE;    {  Index file control block}
  527.       END;
  528.    END;
  529.  
  530. VAR
  531.    WORK_KEY: TaKeyStr; {Key work area}
  532.    WORK_REC: ARRAY [0..MAXDATARECSIZE] OF CHAR;
  533.                        {Record work area}
  534.  
  535. FUNCTION KEYOFFSET (VAR R; VAR F): INTEGER; BEGIN
  536. {Use to compute the OFFSET parameter of a key}
  537.    KEYOFFSET :=
  538.    {8 Bit..  (ADDR (F) + $8000) - (ADDR (R) + $8000); }
  539.    {16 Bit.} (OFS  (F) + $8000) - (OFS  (R) + $8000);
  540. END;
  541.  
  542. PROCEDURE KEY_TO_STRING (VAR KEY; LEN: BYTE; TYP: KEY_TYPE; UP: BOOLEAN);
  543. {Converts a key of the designated type to a string in WORK_KEY for Turbo
  544.  Index storage}
  545. VAR
  546.    INTEGER_KEY: INTEGER ABSOLUTE KEY;
  547.    CHAR_KEY:    ARRAY [1..MAXKEYLEN] OF CHAR ABSOLUTE KEY;
  548.    STRING_KEY:  STRING [MAXKEYLEN] ABSOLUTE KEY;
  549.    REAL_KEY:    REAL ABSOLUTE KEY;
  550.    I:           INTEGER;
  551. BEGIN
  552.    CASE TYP OF
  553.       KEY_INTEGER: BEGIN
  554.             I := INTEGER_KEY + $8000;
  555.             WORK_KEY := CHR (HI (I)) + CHR (LO (I));
  556.          END;
  557.       KEY_CHAR: BEGIN
  558.             IF LEN > MAXKEYLEN THEN LEN := MAXKEYLEN;
  559.             WORK_KEY [0] := CHR (LEN);
  560.             IF LEN > 0 THEN MOVE (KEY, WORK_KEY [1], LEN);
  561.          END;
  562.       KEY_STRING:  WORK_KEY := STRING_KEY;
  563.       KEY_REAL:    STR (REAL_KEY:16, WORK_KEY);
  564.    END;
  565.    IF UP AND ((TYP = KEY_CHAR) OR (TYP = KEY_STRING)) THEN
  566.       FOR I := 1 TO LENGTH (WORK_KEY) DO
  567.          WORK_KEY [I] := UPCASE (WORK_KEY [I]);
  568. END;
  569.  
  570. PROCEDURE CLOSE_FILE (VAR F: FILE_TYPE);
  571. {Close database and all index files}
  572. VAR
  573.    I: INTEGER;
  574. BEGIN
  575.    WITH F DO BEGIN
  576.       CLOSEFILE (DATA_FILE);
  577.       FOR I := 1 TO NUMBER_OF_KEYS DO BEGIN
  578.          WITH KEY [I] DO CLOSEINDEX (INDEX_FILE);
  579.       END;
  580.    END;
  581. END;
  582.  
  583. PROCEDURE OPEN_FILE (VAR F: FILE_TYPE);
  584. {Opens a multi-key database and all index files, re-builds missing index
  585.  file(s) and database freespace chain}
  586. VAR
  587.    I, DUP: INTEGER;
  588.    FLAG: INTEGER ABSOLUTE WORK_REC;
  589.    KEY_FILE_OK: ARRAY [1..MAXKEYS] OF BOOLEAN;
  590.    ALL_KEYS_OK: BOOLEAN;
  591. BEGIN
  592.    WITH F DO BEGIN
  593.       IF (NUMBER_OF_KEYS < 1) OR (NUMBER_OF_KEYS > MAXKEYS) THEN BEGIN
  594.          WRITELN ('In file ', NAME, ', ', NUMBER_OF_KEYS,
  595.             ' keys specified, 1..', MAXKEYS, ' keys allowed');
  596.          HALT;
  597.       END;
  598.       ALL_KEYS_OK := TRUE;
  599.       IOERROR := FALSE;
  600.       OPENFILE (DATA_FILE, NAME + '.DAT', RECSIZE);
  601.       IF NOT OK THEN BEGIN
  602.          MAKEFILE (DATA_FILE, NAME + '.DAT', RECSIZE);
  603.          FOR I := 1 TO NUMBER_OF_KEYS DO BEGIN
  604.             WITH KEY [I] DO BEGIN
  605.                IF UNIQUE THEN DUP := 0 ELSE DUP := 1;
  606.                MAKEINDEX (INDEX_FILE, NAME + '.' + EXTENSION, KEYLENGTH, DUP);
  607.                CLEARKEY (INDEX_FILE);
  608.             END;
  609.          END;
  610.       END ELSE BEGIN
  611.          FOR I := 1 TO NUMBER_OF_KEYS DO BEGIN
  612.             WITH KEY [I] DO BEGIN
  613.                IF OFFSET < 2 THEN BEGIN
  614.                   WRITELN ('Key Offset for key ', I, ' is ', OFFSET,
  615.                      ', Minimum is 2 for file ', NAME);
  616.                   HALT;
  617.                END;
  618.                IF (KEYTYPE = KEY_CHAR)
  619.                AND ((KEYLENGTH < 1) OR (KEYLENGTH > MAXKEYLEN)) THEN BEGIN
  620.                   WRITELN ('KeyLength for key ', I, ' is ', KEYLENGTH,
  621.                      ', it must be between 1 and ', MAXKEYLEN, ' in file ',
  622.                      NAME);
  623.                   HALT;
  624.                END;
  625.                IF UNIQUE THEN DUP := 0 ELSE DUP := 1;
  626.                OPENINDEX (INDEX_FILE, NAME + '.' + EXTENSION, KEYLENGTH, DUP);
  627.                IF NOT OK THEN BEGIN
  628.                   MAKEINDEX (INDEX_FILE, NAME + '.' + EXTENSION, KEYLENGTH,
  629.                      DUP);
  630.                   ALL_KEYS_OK := FALSE;
  631.                   KEY_FILE_OK [I] := FALSE;
  632.                END ELSE KEY_FILE_OK [I] := TRUE;
  633.                CLEARKEY (INDEX_FILE);
  634.             END;
  635.          END;
  636.       END;
  637.       IF NOT ALL_KEYS_OK THEN BEGIN
  638.          WRITELN ('Please wait, rebuilding index file(s) in ', NAME, ' for ',
  639.             FILELEN (DATA_FILE), ' records');
  640.          REC_REF := 1;
  641.          WITH DATA_FILE DO BEGIN
  642.             FirstFree := -1;
  643.             NumberFree := 0;
  644.          END;
  645.          WHILE REC_REF < FILELEN (DATA_FILE) DO BEGIN
  646.             GETREC (DATA_FILE, REC_REF, WORK_REC);
  647.             IF FLAG = 0 THEN BEGIN
  648.                FOR I := 1 TO NUMBER_OF_KEYS DO
  649.                IF NOT KEY_FILE_OK [I] THEN WITH KEY [I] DO BEGIN
  650.                   KEY_TO_STRING (WORK_REC [OFFSET], KEYLENGTH, KEYTYPE,
  651.                      UPSHIFT);
  652.                   ADDKEY (INDEX_FILE, REC_REF, WORK_KEY);
  653.                   IF NOT OK THEN IOERROR := TRUE;
  654.                END;
  655.             END ELSE BEGIN
  656.                WITH DATA_FILE DO BEGIN
  657.                   IF FLAG <> FirstFree THEN BEGIN
  658.                      FLAG := FirstFree;
  659.                      PUTREC (DATA_FILE, REC_REF, WORK_REC);
  660.                      FirstFree := REC_REF;
  661.                   END;
  662.                   NumberFree := SUCC (NumberFree);
  663.                END;
  664.             END;
  665.             REC_REF := SUCC (REC_REF);
  666.          END;
  667.       END;
  668.       REC_REF := 0;
  669.    END;
  670. END;
  671.  
  672. PROCEDURE DELETE_RECORD (VAR F: FILE_TYPE);
  673. {Delete the last record retrieved from the database and all its keys.
  674.  IOERROR indicates no valid last record retrieved.}
  675. VAR
  676.    K: INTEGER;
  677. BEGIN
  678.    WITH F DO IF REC_REF <> 0 THEN BEGIN
  679.       GETREC (DATA_FILE, REC_REF, WORK_REC);
  680.       DELETEREC (DATA_FILE, REC_REF);
  681.       FOR K := 1 TO NUMBER_OF_KEYS DO WITH KEY [K] DO BEGIN
  682.          KEY_TO_STRING (WORK_REC [OFFSET], KEYLENGTH, KEYTYPE, UPSHIFT);
  683.          DELETEKEY (INDEX_FILE, REC_REF, WORK_KEY);
  684.       END;
  685.       IOERROR := FALSE;
  686.       REC_REF := 0;
  687.    END ELSE IOERROR := TRUE;
  688. END;
  689.  
  690. PROCEDURE READ_RECORD (VAR F: FILE_TYPE; K: INTEGER; VAR R);
  691. {Read a record from the database with a key equal to or higher than that
  692.  indicated by key field K in record R.  IOERROR indicates search key was
  693.  higher than any in the index.}
  694. VAR
  695.    REC: ARRAY [0..MAXDATARECSIZE] OF CHAR ABSOLUTE R;
  696.    REF: INTEGER;
  697. BEGIN
  698.    WITH F DO BEGIN
  699.       IF (K > NUMBER_OF_KEYS) OR (K < 1) THEN BEGIN
  700.          WRITELN ('Key ', K, ' Referenced, Keys 1..', NUMBER_OF_KEYS,
  701.             ' Defined in file ', NAME);
  702.          HALT;
  703.       END;
  704.       WITH KEY [K] DO BEGIN
  705.          KEY_TO_STRING (REC [OFFSET], KEYLENGTH, KEYTYPE, UPSHIFT);
  706.          SEARCHKEY (INDEX_FILE, REF, WORK_KEY);
  707.          IF OK THEN GETREC (DATA_FILE, REF, REC);
  708.          IF OK THEN REC_REF := REF;
  709.          IOERROR := NOT OK;
  710.       END;
  711.    END;
  712. END;
  713.  
  714. PROCEDURE NEXT_RECORD (VAR F: FILE_TYPE; K: INTEGER; VAR R);
  715. {Read the next record by key K from the database.  IOERROR indicates end of
  716.  file by key K.}
  717. VAR
  718.    REC: ARRAY [0..MAXDATARECSIZE] OF CHAR ABSOLUTE R;
  719.    REF: INTEGER;
  720. BEGIN
  721.    WITH F DO BEGIN
  722.       IF (K > NUMBER_OF_KEYS) OR (K < 1) THEN BEGIN
  723.          WRITELN ('Key ', K, ' Referenced, Keys 1..', NUMBER_OF_KEYS,
  724.             ' Defined in file ', NAME);
  725.          HALT;
  726.       END;
  727.       WITH KEY [K] DO BEGIN
  728.          NEXTKEY (INDEX_FILE, REF, WORK_KEY);
  729.          IF OK THEN GETREC (DATA_FILE, REF, REC);
  730.          IF OK THEN REC_REF := REF;
  731.          IOERROR := NOT OK;
  732.       END;
  733.    END;
  734. END;
  735.  
  736. PROCEDURE PREVIOUS_RECORD (VAR F: FILE_TYPE; K: INTEGER; VAR R);
  737. {Read the previous record by key K from the database.  IOERROR indicates start
  738.  of file by key K.}
  739. VAR
  740.    REC: ARRAY [0..MAXDATARECSIZE] OF CHAR ABSOLUTE R;
  741.    REF: INTEGER;
  742. BEGIN
  743.    WITH F DO BEGIN
  744.       IF (K > NUMBER_OF_KEYS) OR (K < 1) THEN BEGIN
  745.          WRITELN ('Key ', K, ' Referenced, Keys 1..', NUMBER_OF_KEYS,
  746.             ' Defined in file', NAME);
  747.          HALT;
  748.       END;
  749.       WITH KEY [K] DO BEGIN
  750.          PREVKEY (INDEX_FILE, REF, WORK_KEY);
  751.          IF OK THEN GETREC (DATA_FILE, REF, REC);
  752.          IF OK THEN REC_REF := REF;
  753.          IOERROR := NOT OK;
  754.       END;
  755.    END;
  756. END;
  757.  
  758. PROCEDURE ADD_RECORD (VAR F: FILE_TYPE; VAR R);
  759. {
  760.  Add record R to the database and update all index files.  IOERROR usually
  761.  indicates a duplicate key in a unique key index.
  762. }
  763. VAR
  764.    REC: ARRAY [0..MAXDATARECSIZE] OF CHAR ABSOLUTE R;
  765.    FLAG: INTEGER ABSOLUTE R;
  766.    REF, K: INTEGER;
  767. BEGIN
  768.    WITH F DO BEGIN
  769.       IOERROR := FALSE;
  770.       FLAG := 0;
  771.       ADDREC (DATA_FILE, REF, REC);
  772.       K := 1;
  773.       WHILE (K <= NUMBER_OF_KEYS) AND NOT IOERROR DO BEGIN
  774.          WITH KEY [K] DO BEGIN
  775.             KEY_TO_STRING (REC [OFFSET], KEYLENGTH, KEYTYPE, UPSHIFT);
  776.             ADDKEY (INDEX_FILE, REF, WORK_KEY);
  777.             IOERROR := NOT OK;
  778.          END;
  779.          K := SUCC (K);
  780.       END;
  781.       IF IOERROR THEN BEGIN
  782.          K := PRED (PRED (K));
  783.          WHILE K > 0 DO BEGIN
  784.             WITH KEY [K] DO BEGIN
  785.                KEY_TO_STRING (REC [OFFSET], KEYLENGTH, KEYTYPE, UPSHIFT);
  786.                DELETEKEY (INDEX_FILE, REF, WORK_KEY);
  787.             END;
  788.             K := PRED (K);
  789.          END;
  790.          DELETEREC (DATA_FILE, REF);
  791.       END ELSE REC_REF := REF;
  792.    END;
  793. END;
  794.  
  795. PROCEDURE UPDATE_RECORD (VAR F: FILE_TYPE; VAR R);
  796. {
  797.  Update the last retrieved record with data from record R and update any
  798.  index files whose keys were changed.  IOERROR usually indicates a duplicate
  799.  key in a unique key index.
  800. }
  801. VAR
  802.    REC: ARRAY [0..MAXDATARECSIZE] OF CHAR ABSOLUTE R;
  803.    FLAG: INTEGER ABSOLUTE R;
  804.    S: STRING [MAXKEYLEN];
  805.    K: INTEGER;
  806. BEGIN
  807.    WITH F DO BEGIN
  808.       IOERROR := FALSE;
  809.       IF REC_REF <> 0 THEN BEGIN
  810.          FLAG := 0;
  811.          GETREC (DATA_FILE, REC_REF, WORK_REC);
  812.          K := 1;
  813.          WHILE (K <= NUMBER_OF_KEYS) AND NOT IOERROR DO BEGIN
  814.             WITH KEY [K] DO BEGIN
  815.                KEY_TO_STRING (WORK_REC [OFFSET], KEYLENGTH, KEYTYPE, UPSHIFT);
  816.                S := WORK_KEY;
  817.                KEY_TO_STRING (REC [OFFSET], KEYLENGTH, KEYTYPE, UPSHIFT);
  818.                IF S <> WORK_KEY THEN BEGIN
  819.                   DELETEKEY (INDEX_FILE, REC_REF, S);
  820.                   ADDKEY (INDEX_FILE, REC_REF, WORK_KEY);
  821.                   IOERROR := NOT OK;
  822.                   IF IOERROR THEN ADDKEY (INDEX_FILE, REC_REF, S);
  823.                END;
  824.                K := SUCC (K);
  825.             END;
  826.          END;
  827.          IF IOERROR THEN BEGIN
  828.             K := PRED (PRED (K));
  829.             WHILE K > 0 DO BEGIN
  830.                WITH KEY [K] DO BEGIN
  831.                   KEY_TO_STRING (WORK_REC [OFFSET], KEYLENGTH, KEYTYPE,
  832.                      UPSHIFT);
  833.                   S := WORK_KEY;
  834.                   KEY_TO_STRING (REC [OFFSET], KEYLENGTH, KEYTYPE, UPSHIFT);
  835.                   IF S <> WORK_KEY THEN BEGIN
  836.                      DELETEKEY (INDEX_FILE, REC_REF, WORK_KEY);
  837.                      ADDKEY (INDEX_FILE, REC_REF, S);
  838.                   END;
  839.                END;
  840.                K := PRED (K);
  841.             END;
  842.          END ELSE PUTREC (DATA_FILE, REC_REF, REC);
  843.       END ELSE IOERROR := TRUE;
  844.    END;
  845. END;
  846.  
  847. {End of MULTIKEY routines}
  848.