High Voltage Shareware/high1.zip/high1/DIR36/BTV200.ZIP/BTV.INT

Text File | 1993-12-18 | 21KB | 551 lines

{*
*=========================================================================
*  BTV.PAS  Version 2.00
*
*  BTRIEVE object oriented interface for Turbo Pascal 6.0, 7.0
*
*  Copyright (c) 1993 by Richard W. Hansen, all rights reserved.
*
*
*
*  Requires Turbo Pascal version 6.0, 7.0
*
*
*  Registration and payment of a license fee is required for any use, whether
*  in whole or part, of this source code.
*=========================================================================
*
*}

{****************************************************************************}
{*   REVISION HISTORY                                                       *}
{*                                                                          *}
{*  Date     Who  What                                                      *}
{* ======================================================================== *}
{* 02/01/92  RWH  Changed DataSize, BytesRead, BytesToWrite from Integer to *}
{*                Word so variable length records can be up to 64K.         *}
{* 02/04/92  RWH  Check that memory allocation size > 0 before issuing an   *}
{*                out of memory error.                                      *}
{*                Added ErrorHandler calls for out of memory errors.        *}
{* 02/08/92  RWH  Added error setting routines to the file object, so calls *}
{*                through the error handler object pointer are not needed.  *}
{* 02/20/92  RWH  BUG FIX-In Clone the wrong file name being used caused    *}
{*                lockup.                                                   *}
{* 02/28/92  RWH  Added Recover, Save and Load methods.                     *}
{* 03/14/92  RWH  BUG FIX-Open was not calculating the largest key correctly*}
{* 04/25/92  RWH  Added the FillKeyBuffer method.                           *}
{* 05/13/92  RWH  BUG FIX-Problem with KeyStart buffer not being setup when *}
{*                key segments not defined before opening a file.           *}
{*                Changed Error Handler and Error Display in fields in all  *}
{*                objects, and the corresponding parameters in methods, to  *}
{*                pointers. This allows nil objects.                        *}
{* 12/30/92  RWH  BUG FIX-Off by one error in Open when loading key info.   *}
{* 06/06/93  RWH  Added protected mode support for BP 7.0                   *}
{*                Moved all consts into the file BtvConst.pas               *}
{*                Added Windows 3.1 support.                                *}
{*                Defined a DefErrorHandler. DefErrorHandler has the default*}
{*                error messages that are stored in the data segment.       *}
{*                Added ErrorON flag and ErrorsOnOff procedures to          *}
{*                BtrieveFile and ErrorHandler.                             *}
{* 09/07/93  RWH  BUG FIX-In CheckForBtrieve Stat was no initialized.       *}
{*                Cleaned up the owner name (password) routines Open,       *}
{*                SetOwner, ClearOwner in BtrieveFile.                      *}
{*                Added bNoAccess constant for owner names.                 *}
{* 11/03/93  RWH  Made all occurences of OpCode or Op integer.              *}
{*                Added SetFillValue and GetFillValue procedures to         *}
{*                BtrieveFile. Modified to ClearBuffer and ClearKey to use  *}
{*                the new FillValue field in BtrieveFile.                   *}
{*                Added AddKeyBuffer procedure to BtrieveFile for external  *}
{*                programmer defined key buffers.                           *}
{*                Renamed "Allocate" field in BtrieveFile to "AllocateData".*}
{*                Added GetBtrieveVersion and UnloadBtrieve global          *}
{*                procedures.                                               *}
{*                Added a DiskErrorHandler object. DiskErrorHandler stores  *}
{*                all messages strings in a BtrieveFile.                    *}
{*                Changed BtrieveFile.MakeKey to a virtual function.        *}
{*                Internal BTV.PAS errors increased to start at 5000.       *}
{*                Renamed Recover to Copy.                                  *}
{*                Added a new Recover that uses Step reads and writes to a  *}
{*                DOS text file.                                            *}
{*                Changed Save to use Get instead of Step reads, to allow   *}
{*                for sorting.                                              *}
{*                Added ResetStation for networks.                          *}
{*                Added justification of ZString and String types.          *}
{****************************************************************************}

Unit Btv;
{$F-}
{$V-}
{$X+}
{$A-}

{$IFOPT R+}
{$DEFINE __RANGE_ON}
{$ENDIF}

{$IFOPT Q+}
{$DEFINE __OVERFLOW_ON}
{$ENDIF}


{.$DEFINE BCHECK}    { Define this to check for Btrieve during initialization }
{$DEFINE BTRIEVE50} { Define this to make all opcodes new in V 5.0 available }


INTERFACE


USES
  BtvConst,
  {$IFDEF VER70}
  WinDos,
  {$ELSE}
  Dos,
  {$ENDIF}

  {$IFDEF MSDOS}
  Crt,
  BTRVDOS;
  {$ENDIF}

  {$IFDEF DPMI}
  Crt,
  BTRVDPMI;
  {$ENDIF}

  {$IFDEF WINDOWS}
  WinProcs,
  WinTypes,
  BTRVWIN;
  {$ENDIF}


TYPE
  {$IFDEF VER70}
  PathStr  = String[fsPathName];
  {$ENDIF}

  AllErrors     = bInvalidOp..bLastError;
    {- a superset of all Btrieve errors allowing for customization }

  ErrorSet      = Set of AllErrors;
    {- will hold Btrieve errors and possibly some custom error codes }

  ErrorAction = (erAbort, erDone, erRetry);
    {- the possible return states from an error              }
    {- these codes are returned by the error display routine }


  PBytes        = ^Bytes;
  Bytes         = Array[1..65534] of Byte;
    {- define a byte array and pointer to make access easier }


  PProgress = ^TProgress;
  TProgress = Object
    Constructor Init;
    Procedure   Display(Count : LongInt);         Virtual;
  end;
    {- object to display progress for recover, save and load }


  { Btrieve key specs record }
  KeySpec       = record
    KeyPos    : Word;           { position of key or segment in data      }
    KeyLen    : Word;           { length of the key or segment            }
    KeyFlags  : Word;           { key flags as defined by Btrieve         }
    KeyCount  : LongInt;        { not used except for STAT                }
    KeyType   : Byte;           { extended key type                       }
    NullValue : Byte;           { null character if defined               }
    Reserved  : Array[1..4] of Byte;
  end;

  KeySpecArray   = Array[1..MaxSegments] of KeySpec;


  { Our own key definition record }
  KeyDef        = record
    KeyPos    : Word;         { position of key or segment in data      }
    KeyLen    : Word;         { length of the key or segment            }
    KeyFlags  : Word;         { key flags as defined by Btrieve         }
    KeyType   : Byte;         { extended key type                       }
    NullValue : Byte;         { null character if defined               }
    Justify   : Byte;         { lString justification type              }
  end;

  KeyDefArray     = Array[1..MaxSegments] of KeyDef;


  { Btrieve file specs record }
  FileSpec      = record
    RecordLen : Word;           { length of a record in the file          }
    PageSize  : Word;           { physical page size for file             }
    Indexes   : Word;           { number of keys                          }
    Records   : LongInt;        { not used except for STAT                }
    FileFlags : Word;           { file flags as defined by Btrieve        }
    Reserved  : Array[1..2] of Byte;
    FreePages : Word;           { pages to pre allocate                   }
    KeyBuff   : KeySpecArray;   { array of key info (one for each segment)}
    Extra     : Array[1..265] of Byte; { might be needed for alt. sequence}
  end;



  { This is the object that will display errors to the user.              }
  { This is an ABSTRACT object and should never be instantiated, you must }
  { define a descendant object that does what you want in each program.   }
  PErrorDisplay  = ^ErrorDisplay;
  ErrorDisplay   = Object
    Constructor Init;
      {- init the error display }

    Function    Display(Error     : Integer;
                        ErrorMsg  : String;
                        OpCode    : Integer;
                        OpCodeMsg : String;
                        FileName  : PathStr
                        ): ErrorAction;             Virtual;
      {- display the error, returns True if program should abort }

    Destructor  Done;                               Virtual;
      {- destroy the object }
  end;



  { This is the error object used by the file to trap IO errors.  }
  PErrorHandler   = ^ErrorHandler;
  ErrorHandler    = Object
    RetryCount    : Word;         { current number of retries on an error   }
    MaxRetry      : Word;         { maximum number of retries on an error   }
    RetryDelay    : Word;         { milliseconds between retries            }
    TrappedErrors : ErrorSet;     { errors this object will handle          }
    ErrDisplay    : PErrorDisplay;{ pointer to an error display object      }
    ErrorsON      : Boolean;

    Constructor Init(DisplayObject : PErrorDisplay);
      {- initialize the error object }

    Function    ErrorDispacther(ErrorCode : Integer;
                                OpCode    : Integer;
                                FileName  : PathStr
                               ): ErrorAction;      Virtual;
      {- send errors and messages to the user error display }

    Function    Error(Status   : Integer;
                      OpCode   : Integer;
                      FileName : PathStr
                     ): Boolean;                    Virtual;
      {- check for errors and control the number of retries after an error }

    Procedure   SetMaxRetry(Retry : Word);
      {- set the maximum retries per error }

    Function    GetMaxRetry: Word;
      {- return the maximum retries per error }

    Procedure   ClearRetry;
      {- clear the current count of retries }

    Procedure   SetDelay(Seconds : Word);
      {- set the delay in seconds between retries }

    Function    GetDelay: Word;
      {- return the delay in seconds between retries }

    Procedure   AddErrors(ErrorCodes : ErrorSet);
      {- add an error to the set of errors trapped }

    Procedure   RemoveErrors(ErrorCodes : ErrorSet);
      {- remove an error from the set of errors trapped }

    Procedure   SetErrors(ErrorCodes : ErrorSet);
      {- set the entire trapped error set }

    Procedure   GetErrors(var ErrorCodes : ErrorSet);
      {- get the trapped error set }

    Procedure   ErrorsOnOff(State : Boolean);
      {- toggle all error trapping ON/OFF }

    Function    ErrorMsg(ErrorCode : Integer): String; Virtual;
      {- return an error message for a Btrieve error code }

    Function    OpMsg(OpCode : Integer): String;    Virtual;
      {- return a message for a Btrieve operation code }

    Destructor  Done;                               Virtual;
      {- destroy the object }
  end;


  { This error handler has descriptive error and opcode message }
  { strings stored in memory.                                   }
  PDefErrorHandler = ^DefErrorHandler;
  DefErrorHandler = Object(ErrorHandler)
    Function    ErrorMsg(ErrorCode : Integer): String; Virtual;
    Function    OpMsg(OpCode : Integer): String;    Virtual;
  end;


  { This error handler has descriptive error and opcode message }
  { strings stored in a Btrieve file.                           }
  PDiskErrorHandler = ^DiskErrorHandler;
  DiskErrorHandler = Object(ErrorHandler)
    PosBlock  : Array[1..PosBlockSize] of Byte;
    FileOpen  : Boolean;

    Constructor Init(DisplayObject : PErrorDisplay;
                     ErrorPath : PathStr);
    Destructor  Done;                               Virtual;
    Function    ErrorMsg(ErrorCode : Integer): String; Virtual;
    Function    OpMsg(OpCode : Integer): String;    Virtual;
  end;


  { record type for message file }
  BtrieveMsgRec = record
    TypeID  : Integer;
    Code    : Integer;
    Name    : Array[0..80] of Char;
    MsgText : Array[0..900] of Char;
  end;


  { This is the Btrieve file file interface object  }
  PBtrieveFile  = ^BtrieveFile;
  BtrieveFile   = Object
    Path        : PathStr;            { File name and path                }
    AltPath     : PathStr;            { Alternate collating seq. file     }
    Data        : Pointer;            { pointer to record data buffer     }
    DataSize    : Word;               { length of record data buffer      }
    AllocateData: Boolean;            { allocate data buffer memory       }
    AllocateKey : Boolean;            { allocate key buffer memory        }
    BytesRead   : Word;               { number of bytes on last file read }
    BytesToWrite: Word;               { number of bytes to write to file  }
    Key         : Pointer;            { pointer to the file key buffer    }
    KeySize     : Byte;               { actual size of the key buffer     }
    SegmentCnt  : Byte;               { total number of key segments      }
    CurIndex    : Word;               { current key being used            }
    IndexCnt    : Byte;               { number of defined keys            }
    Status      : Integer;            { status of last Btrieve operation  }
    FileOpen    : Boolean;            { is the file open                  }
    ErrHandler  : PErrorHandler;      { pointer to the error handler      }
    KeyList     : KeyDefArray;        { list of key definitions           }
                                      { offset of 1st segment in each key }
    KeyStart    : Array[0..MaxSegments - 1] of Byte;
                                      { position block for Btrieve        }
    PosBlock    : Array[1..PosBlockSize] of Byte;
    VariableLen : Boolean;            { does file use var length records  }
    SISegments  : Byte;
    ReadKeyDefs : Boolean;
    CurrentKeySize : Byte;
    FillValue   : Byte;               { value used to clear buffers       }

    Constructor Init(FilePath    : PathStr;
                     ErrorObject : PErrorHandler;
                     DataBuf     : Pointer;
                     DataBufSize : Word);
      {- initialize a file object }

    Destructor  Done;                               Virtual;
      {- destroy the object }

    Procedure   AbortTransaction;

    Procedure   AddAltSequence(AltSeqPath : PathStr);
      {- add an alternate collating sequence file }

    Procedure   AddErrors(ErrorCodes : ErrorSet);
      {- add an error to the set of errors trapped }

    Procedure   AddSupplKeySegment(Position  : Word;
                                   Size      : Word;
                                   Flags     : Word;
                                   KeyType   : Byte;
                                   NullValue : Byte;
                                   Justify   : Byte);
      {- define a key segment for a supplemental index }

    Procedure   AddKeyBuffer(KeyBuf     : Pointer;
                             KeyBufSize : Byte);
      {- setup a programmer defined external key buffer }

    Procedure   AddKeySegment(Position  : Word;
                              Size      : Word;
                              Flags     : Word;
                              KeyType   : Byte;
                              NullValue : Byte;
                              Justify   : Byte);
      {- define a key segment }

    Function    bResult: Integer;
      {- return the last IO status }

    Procedure   ChangeBufferSize(Size : Word);
      {- change the size of the output buffer }

    Procedure   ClearBuffer;
      {- clear the data buffer }

    Procedure   ClearKey;
      {- clear the key buffer }

    Procedure   ClearOwner;
      {- set the file owner }

    Procedure   Clone(NewFilePath : PathStr;
                      Mode        : Integer);
      {- clone an empty copy of the file }

    Procedure   Close;
      {- close the file }

    Function    Copy(OutFile    : PBtrieveFile;
                     DisplayObj : PProgress): Integer;
      {- copy all possible records to a new Btrieve file }

    Procedure   Create(Flags      : Word;
                       RecordSize : Word;
                       PageSize   : Word;
                       Pages      : Word;
                       Mode       : Integer);
      {- create the file }

    Procedure   CreateIndex;
      {- add a supplemental index to the file }

    Procedure   Delete;
      {- delete the current record }

    Procedure   DropIndex(Index : Integer);
      {- remove a supplemental index from the file }

    Procedure   EndTransaction;

    Function    Error(ErrStatus : Integer;
                      OpCode    : Integer;
                      FileName  : PathStr
                     ): Boolean;
      {- call the error handler to check for errors }

    Procedure   ErrorsOnOff(State : Boolean);
      {- toggle all error trapping ON/OFF }

    Procedure   FillKeyBuffer(var Buff; Size : Byte);
      {- fill the key buffer from the data in Buff }

    Procedure   Get(Op   : Integer;
                    Lock : Word);
      {- read a record using by a key }

    Procedure   GetDirect(Lock     : Word;
                          Position : LongInt);
      {- read a record by file position }

    Procedure   GetErrors(var ErrorCodes : ErrorSet);
      {- get the trapped error set }

    Function    GetFillValue: Byte;
      {- get the value used to clear data and key buffers }

    Function    GetPosition: LongInt;
      {- return the position of the record }

    Procedure   Insert;
      {- add a new record to the file }

    Function    IsOpen: Boolean;
      {- return True if the file is open }

    Function    Load(InputFilePath : PathStr;
                     DisplayObj    : PProgress): Integer;
      {- read the contents of a DOS file and insert }

    Procedure   MakeKey(V1 : Pointer;
                        V2 : Pointer;
                        V3 : Pointer;
                        V4 : Pointer;
                        V5 : Pointer;
                        V6 : Pointer);         Virtual;
      {- copy the passed fields into the key buffer }

    Function    NumberOfRecords: LongInt;
      {- return the number of records in the file }

    Procedure   Open(Mode : Integer;
                     Owner: String);
      {- open the file }

    Function    Recover(NewFilePath : PathStr;
                        DisplayObj  : PProgress): Integer;
      {- write the contents of the file to a DOS file }

    Procedure   RemoveErrors(ErrorCodes : ErrorSet);
      {- remove an error from the set of errors trapped }

    Procedure   Reset;
      {- reset Btrieve }

    Procedure   ResetStation(Connection : Word);
      {- reset Btrieve }

    Function    Save(NewFilePath : PathStr;
                     DisplayObj  : PProgress): Integer;
      {- write the contents of the file to a DOS file }

    Procedure   SetErrors(ErrorCodes : ErrorSet);
      {- set the entire trapped error set }

    Procedure   SetFillValue(Value : Byte);
      {- set the value used to clear data and key buffers }

    Procedure   SetKeyPath(Number : Word);
      {- change the current file key path }

    Procedure   SetOutputSize(Size : Word);
      {- use for variable length records only, sets the size of the
         record to be written to the file  }

    Procedure   SetOwner(Owner  : String;
                         Mode   : Integer);
      {- set the file owner }

    Procedure   StartTransaction(Lock : Word);

    Procedure   Stat(var FData : FileSpec);
      {- get the file statistics }

    Procedure   Update;
      {- update an existing record in the file }

    Procedure   Unload;
      {- unload Btrieve }

    Procedure   UnlockAll(Lock : Word);
      {- unlock all records in the file }

    Procedure   Version(var Ver    : Word;
                        var Rev    : Word;
                        var OSFlag : Char);
      {- get Btrieve version }

    PRIVATE

    Procedure   FixKeyStrings;
    Procedure   JustifyString(Buff    : PBytes;
                              Size    : Byte;
                              KeyType : Byte;
                              Justify : Byte);
  end;


Procedure CheckForBtrieve;

Procedure GetBtrieveVersion(var Ver    : Word;
                            var Rev    : Word;
                            var OSFlag : Char);

Procedure UnloadBtrieve;