Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/MKEY.ZIP/MKEYB.PAS

Pascal/Delphi Source File | 1988-06-05 | 14.9 KB | 436 lines

UNIT MkeyB;

INTERFACE

USES Crt, TPAsciiZ, Btrieve;

  {$I-}
CONST
  MaxKeys = 5;
  MaxFields = 25;
  MaxKeyLen = 80;
  MaxDatarecSize = 1024;
  { --------------------- Btrieve Operation Codes ----------------------- }

  { Operation codes sent to Btrieve          }
  { ---------------------------------------- }
  AbortTransactionOp = 21;
  BeginTransactionOp = 19;
  ClearOwnerOp = 30;
  CloseOp = 1;
  CreateOp = 14;
  DeleteOp = 4;
  EndTransactionOp = 20;
  ExtendOp = 16;
  GetDirectOp = 23;
  GetEqualOp = 5;
  GetGreaterOp = 8;
  GetGreaterOrEqualOp = 9;
  GetHighestOp = 13;
  GetKeyOp = 50;
  GetLessThanOp = 10;
  GetLessThanOrEqualOp = 11; { Retireves a record with a key value less }
  GetLowestOp = 12;
  GetNextOp = 6;
  GetPositionOp = 22;
  GetPreviousOp = 7;
  InsertOp = 2;
  OpenOp = 0;
  ResetOp = 28;
  SetOwnerOp = 29;
  StatOp = 15;
  StepDirectOp = 24;
  UnlockOp = 27;
  UpdateOp = 3;
  VersionOp = 26;

  { -------------------- Extended Key Types Constants ------------------- }

  ArrayCharKey = 0; { Array of character     1-255 bytes       }
  SignedIntKey = 1; { Signed whole number    Even # of bytes   }
  FloatKey = 2; { IEEE floating point    4 or 8            }
  DateKey = 3; { Date                   4 bytes           }
  TimeKey = 4; { Time                   4 bytes           }
  DecimalKey = 5; { semi-BCD               1-?? (variable)   }
  MoneyKey = 6; { same as Decimal        1-?? (variable)   }
  LogicalKey = 7; { Logical key            1 or 2 bytes      }
  NumericKey = 8; { Numeric                1-255 variable    }
  BFloatKey = 9; { Old Microsoft float    4 or 8 bytes      }
  lStringKey = 10; { Pascal string          1-254 (255) bytes }
  NullStringKey = 11; { Null terminated string 1-255 bytes       }
  UnsignedIntKey = 14; { Unsigned whole number  Even # of bytes   }

TYPE
  KEY_TYPE = (KEY_INTEGER, KEY_CHAR, KEY_STRING, KEY_REAL);
  Field_Type = (Valid_Date_Field, Date_Field, Integer_Field,
                Real_Field, String_Field, Non_Blank, Memo_Field);

  {***** All Date Fields must be a STRING of at LEAST
                       Length 10. Memo fields must be LongInts. All
                       other fields are STRINGS of appropriate lengths *****}


  ColSeqType = RECORD
                 ColSeqSign : BYTE; { The signature byte }
                 ColSeqName : ARRAY[1..10] OF CHAR;
                 ColSeq : ARRAY[1..10] OF CHAR;
               END; {colseqtype}
  KeyDescrip = RECORD
                 Offset : INTEGER;
                 KEYLENGTH : WORD;
                 Flags : WORD;
                 KEYTYPE : KEY_TYPE;
                 EXTENSION : STRING[3];
                 UNIQUE : BOOLEAN;
                 UPSHIFT : BOOLEAN;
                 INDEX_FILE : FILE;
               END;
  DBField = RECORD
              XCoord : INTEGER;
              YCoord : INTEGER;
              FieldData : ^STRING;
              FieldType : Field_Type;
              FieldLength : INTEGER;
              LegalChars : STRING[80];
              ScreenPrompt : STRING[80];
              HelpPrompt : STRING[80];
            END;

  FileSpecType = RECORD
                   CASE BYTE OF
                     0 : (RecSize : WORD; { Record length in bytes }
                          PageSize : WORD; { Page size to use       }
                          Number_of_keys : WORD; { # of keys NOT segments }
                          NumRecs : LONGINT; { # of records in file }
                          FileFlags : WORD; { Bit flags for file     }
                          ReservedWord : WORD; { Fill with $0000        }
                          Allocation : WORD; { # pages to preallocate }
                          {Key : ARRAY[0..MaxKeys] OF KeySpecType;}
                          AltColSeq : ColSeqType); { Alternate col seq }
                     1 : (MinSize : ARRAY[1..128] OF BYTE);
                 END; {FileSpecType}
  File_Type = RECORD
                Name : STRING[60];
                PositionBlock : ARRAY[1..128] OF BYTE;
                IOERROR : BOOLEAN;
                REC_REF : LONGINT;
                DATA_FILE : FILE;
                LastKeyUsed : WORD;
                Key : ARRAY[0..MaxKeys] OF KeyDescrip;
                PromptAttribute : INTEGER;
                GetAttribute : INTEGER;
                DisplayAttribute : INTEGER;
                HelpAttribute : INTEGER;
                NumOfFields : INTEGER;
                Field : ARRAY[1..MaxFields] OF DBField;
                FileSpec : FileSpecType;
              END;

VAR
  BtError : WORD;

FUNCTION KEYOFFSET(VAR R; VAR F) : WORD;
PROCEDURE DebugBt(FileDesc : File_Type; Bt_Error : WORD);
PROCEDURE CLOSE_FILE(VAR F : File_Type; VAR R);
PROCEDURE OPEN_FILE(VAR F : File_Type);
PROCEDURE DELETE_RECORD(VAR F : File_Type; VAR R);
PROCEDURE READ_RECORD(VAR F : File_Type; K : INTEGER; VAR R);
PROCEDURE NEXT_RECORD(VAR F : File_Type; K : INTEGER; VAR R);
PROCEDURE PREVIOUS_RECORD(VAR F : File_Type; K : INTEGER; VAR R);
PROCEDURE ADD_RECORD(VAR F : File_Type; VAR R);
PROCEDURE UPDATE_RECORD(VAR F : File_Type; VAR R);


IMPLEMENTATION

  {$I-}
  {=========================================================================}
  {These are the MULKEY Routines themselves}
  {=========================================================================}

  PROCEDURE DebugBt(FileDesc : File_Type; Bt_Error : WORD);
  VAR
    I : WORD;
    Ch : CHAR;
  BEGIN
    IF (Bt_Error <> 0) OR (Bt_Error = 0) THEN
      BEGIN
        WITH FileDesc DO
          BEGIN
            WITH FileSpec DO
              BEGIN
                WRITELN('RecSize := ', RecSize);
                WRITELN('PageSize := ', PageSize);
                WRITELN('Number_of_keys := ', Number_of_keys);
                WRITELN('LastKeyUsed := ', LastKeyUsed);
                WRITELN('FileFlags := ', FileFlags);
                WRITELN('ReservedWord := ', ReservedWord);
                WRITELN('Allocation := ', Allocation);
                FOR I := 0 TO Number_of_keys DO
                  BEGIN
                    WITH Key[I] DO
                      BEGIN
                        WRITELN('Key #', I, ' Offset := ', Offset);
                        WRITELN('Key #', I, ' KeyLength := ', KEYLENGTH);
                        WRITELN('Key #', I, ' Flags := ', Flags);
                      END;
                  END; {With Key}
                WRITELN('Num_Of_Fields := ', NumOfFields);
              END; {with FileSpec}
          END; {with FileDesc}
        WRITELN('Btrieve Error #', Bt_Error);
        Ch := readkey;
      END;      {If Bt_Error}
  END;

  FUNCTION KEYOFFSET(VAR R; VAR F) : WORD;
  BEGIN
    {Use to compute the OFFSET parameter of a key}
    KEYOFFSET := (OFS(F) + $8000) - (OFS(R) + $8000);
  END;

  PROCEDURE OPEN_FILE(VAR F : File_Type);
    {Opens a multi- key database and all index files, re- builds missing index
    file(s) and database freespace chain}
  TYPE
    BKeySpecType = RECORD
                     Offset : WORD;
                     KEYLENGTH : WORD;
                     Flags : WORD;
                     NotUsed : ARRAY[1..4] OF BYTE;
                     KEYTYPE : BYTE;
                     Reserved : ARRAY[1..5] OF BYTE;
                   END;
    BFileSpecType = RECORD
                      CASE BYTE OF
                        0 : (RecSize : WORD; { Record length in bytes }
                             PageSize : WORD; { Page size to use       }
                             Number_of_keys : WORD; { # of keys NOT segments }
                             NumRecs : LONGINT; { # of records in file }
                             FileFlags : WORD; { Bit flags for file     }
                             ReservedWord : WORD; { Fill with $0000        }
                             Allocation : WORD; { # pages to preallocate }
                             BKey : ARRAY[0..MaxKeys] OF BKeySpecType;
                             AltColSeq : ColSeqType); { Alternate col seq }
                        1 : (MinSize : ARRAY[1..128] OF BYTE);
                    END; {FileSpecType}

  VAR
    R : ARRAY[0..MaxDatarecSize] OF BYTE;
    I : INTEGER;
    Bt_Error : WORD ABSOLUTE BtError;
    FileBufSize : WORD;
    Key_Len : WORD;
    FyleName : Asciiz;
    F2 : BFileSpecType;
    J : INTEGER;

  BEGIN
    Str2Asc(F.Name, FyleName);
    FILLCHAR(F2, SIZEOF(F2), 0);
    FOR I := 1 TO F.FileSpec.Number_Of_Keys DO
      BEGIN
        F2.BKey[I-1].Offset := F.Key[I].Offset + 1;
        F2.BKey[I-1].KEYLENGTH := F.Key[I].KEYLENGTH;
        F2.BKey[I-1].Flags := F.Key[I].Flags;
        F2.BKey[I-1].KEYTYPE := 10;
      END;
    F2.RecSize := F.FileSpec.RecSize;
    F2.PageSize := F.FileSpec.PageSize;
    F2.Number_of_keys := F.FileSpec.Number_of_keys;
    F2.NumRecs := F.FileSpec.NumRecs;
    F2.FileFlags := F.FileSpec.FileFlags;
    F2.ReservedWord := F.FileSpec.ReservedWord;
    F2.Allocation := F.FileSpec.Allocation;
    I := 0;
    FileBufSize := SIZEOF(F2);
    WITH F DO
      BEGIN
        LastKeyUsed := 0;
        Key_Len := F2.BKey[LastKeyUsed].KEYLENGTH;
        Bt_Error := BTRV(OpenOp, PositionBlock, R, F2.RecSize,
                         FyleName, I, Key_Len);
        IF Bt_Error <> 0 THEN
          BEGIN
            Bt_Error := BTRV(CreateOp, PositionBlock, F2, FileBufSize,
                             FyleName, I, Key_Len);

            Bt_Error := BTRV(OpenOp, PositionBlock, R, F2.RecSize,
                             FyleName, I, Key_Len);
            IF Bt_Error <> 0 THEN
              BEGIN
                HALT(1);
              END;
          END;
        LastKeyUsed := 0;
      END;
  END;

  PROCEDURE CLOSE_FILE(VAR F : File_Type; VAR R);
    {Close database and all index files}
  VAR
    Bt_Error : WORD ABSOLUTE BtError;
    FileBufSize : WORD;
    Key_Buf : STRING;
    Key_Len : WORD;
  BEGIN
    FileBufSize := SIZEOF(F);
    WITH F DO
      BEGIN
        Key_Len := Key[LastKeyUsed].KEYLENGTH;
        Bt_Error := BTRV(CloseOp,
                         PositionBlock,
                         FileSpec,
                         FileBufSize,
                         Key_Buf,
                         LastKeyUsed,
                         Key_Len);
        IOERROR := Bt_Error <> 0;
      END;
  END;

  PROCEDURE DELETE_RECORD(VAR F : File_Type; VAR R);
    {Delete the last record retrieved from the database and all its keys.
    IOERROR indicates no valid last record retrieved.}
  VAR
    Bt_Error : WORD ABSOLUTE BtError;
    Key_Len, RecSiz : WORD;
  BEGIN
    WITH F DO
      BEGIN
        Key_Len := Key[LastKeyUsed].KEYLENGTH;
        RecSiz := FileSpec.RecSize;
        Bt_Error := BTRV(GetEqualOp, PositionBlock, R, RecSiz,
                         PTR(SEG(R), OFS(R) +
                             Key[LastKeyUsed].Offset)^,
                         LastKeyUsed -1,
                         Key_Len);
        Bt_Error := BTRV(DeleteOp, PositionBlock, R, RecSiz,
                         PTR(SEG(R), OFS(R) +
                             Key[LastKeyUsed].Offset)^,
                         LastKeyUsed-1,
                         Key_Len);
        IOERROR := Bt_Error <> 0;
      END;
  END;

  PROCEDURE READ_RECORD(VAR F : File_Type; K : INTEGER; VAR R);
    {Read a record from the database with a key equal to or higher than that
    indicated by key field K in record R. IOERROR indicates search key was
    higher than any in the index.}
  VAR
    Bt_Error : WORD ABSOLUTE BtError;
    Key_Len : WORD;
    I : word;
    S_Ptr : ^STRING;
    WorkBuffer, HoldBuffer, Blanks : STRING;
  BEGIN
    WITH F DO
      BEGIN
        LastKeyUsed := K;
        Key_Len := Key[LastKeyUsed].KEYLENGTH;
        S_Ptr := PTR(SEG(R), OFS(R) + Key[LastKeyUsed].Offset);
        HoldBuffer := S_Ptr^ ;
        WorkBuffer := '';
        Bt_Error := BTRV(GetLowestOp, PositionBlock, R,
                         FileSpec.RecSize,
                         WorkBuffer,
                         K - 1, Key_Len);
        Bt_Error := BTRV(GetGreaterOrEqualOp, PositionBlock,
                         R, FileSpec.RecSize,
                         HoldBuffer,
                         K - 1, Key_Len);
        IOERROR := Bt_Error <> 0;
      END;
  END;

  PROCEDURE NEXT_RECORD(VAR F : File_Type; K : INTEGER; VAR R);
    {Read the next record by key K from the database. IOERROR indicates end of
    file by key K.}
  VAR
    Bt_Error : WORD ABSOLUTE BtError;
    Key_Len : WORD;
  BEGIN
    WITH F DO
      BEGIN
        Key_Len := Key[LastKeyUsed].KEYLENGTH;
        Bt_Error := BTRV(GetNextOp, PositionBlock, R,
                         FileSpec.RecSize,
                         PTR(SEG(R), OFS(R)
                             + Key[LastKeyUsed].Offset)^,
                         LastKeyUsed-1, Key_Len);
        IOERROR := Bt_Error <> 0;
      END;
  END;

  PROCEDURE PREVIOUS_RECORD(VAR F : File_Type; K : INTEGER; VAR R);
    {Read the previous record by key K from the database. IOERROR indicates start
    of file by key K.}
  VAR
    Bt_Error : WORD ABSOLUTE BtError;
    Key_Len : WORD;
  BEGIN
    WITH F DO
      BEGIN
        Key_Len := Key[LastKeyUsed].KEYLENGTH;
        Bt_Error := BTRV(GetPreviousOp, PositionBlock, R,
                         FileSpec.RecSize,
                         PTR(SEG(R), OFS(R)
                             + Key[LastKeyUsed].Offset)^,
                         LastKeyUsed-1, Key_Len);
        IOERROR := Bt_Error <> 0;
      END;
  END;


  PROCEDURE ADD_RECORD(VAR F : File_Type; VAR R);
    {
    Add record R to the database and update all index files. IOERROR usually
    indicates a duplicate key in a unique key index.
    }
  VAR
    Bt_Error : WORD ABSOLUTE BtError;
    Key_Len, Posit : WORD;
    P : ^String;
    WorkBuffer : String;
  BEGIN
    WITH F DO
      BEGIN
        Posit := Key[1].Offset;
        P := PTR(SEG(R), OFS(R) + (Posit));
        WorkBuffer := P^;
        Key_Len := Key[1].KEYLENGTH;
        Bt_Error := BTRV(InsertOp, PositionBlock, R,
                         FileSpec.RecSize,
                         WorkBuffer,
                         0, Key_Len);
        IOERROR := Bt_Error <> 0;
      END;
  END;

  PROCEDURE UPDATE_RECORD(VAR F : File_Type; VAR R);
    {
    Update the last retrieved record with data from record R and update any
    index files whose keys were changed. IOERROR usually indicates a duplicate
    key in a unique key index.
    }
  VAR
    Bt_Error : WORD ABSOLUTE BtError;
    Key_Len : WORD;
  BEGIN
    WITH F DO
      BEGIN
        Key_Len := Key[LastKeyUsed].KEYLENGTH;
        Bt_Error := BTRV(UpdateOp, PositionBlock, R,
                         FileSpec.RecSize,
                         PTR(SEG(R), OFS(R)
                             + Key[LastKeyUsed].Offset)^,
                         LastKeyUsed-1, Key_Len);
        IOERROR := Bt_Error <> 0;
      END;
  END;


  {End of MULTIKEY routines}
END.