Topspeed_JPI/TS-V3/EXAMPLES/TSBTRV.LST

Listing:

    1  (* Release 3.10 *)
    2  (*-------------------------------------------------------------------------*
    3  *                                                                          *
    4  *  TopSpeed Modula-2 Interface for BTRIEVE - Supports TopSpeed Extender    *
    5  *  Public Domain - May be used without restriction                         *
    6  *                                                                          *
    7  *--------------------------------------------------------------------------*)
    8  IMPLEMENTATION MODULE TSBTRV;
    9  IMPORT SYSTEM,Lib,Str;
   10  (*%T _XTD*)
   11  IMPORT TSXLIB;
   12  (*%E*)
   13  
   14  (****************************************************************************)
   15  
   16  
   17  PROCEDURE BTRV1(fn : CARDINAL);
   18  VAR
   19      NullControl    : FileControlBlock;
*****                       ^ undeclared identifier
   20      NullBuffer     : LONGCARD;
*****                       ^ undeclared identifier
   21      NullBufferSize : CARDINAL;
   22      NullKey        : KeyType;
*****                       ^ undeclared identifier
   23  BEGIN
   24      NullBufferSize := SIZE(NullBuffer);
*****                        ^ undeclared identifier
*****                             ^ not supported yet
   25      StatusCode := BTRV(fn,NullControl,NullBuffer,NullBufferSize,NullKey,0);
*****      ^ undeclared identifier
*****                    ^ undeclared identifier
*****                            ^ not supported yet
*****                                        ^ not supported yet
*****                                                                  ^ not supported yet
*****                                                                           ^ not supported yet
   26  END BTRV1;
*****      ^ not supported yet
   27  
   28  PROCEDURE BTRV2(fn : CARDINAL;VAR FileControl : FileControlBlock);
*****                                                  ^ undeclared identifier
   29  VAR
   30      NullBuffer     : LONGCARD;
*****                       ^ undeclared identifier
   31      NullBufferSize : CARDINAL;
   32      NullKey        : KeyType;
*****                       ^ undeclared identifier
   33  BEGIN
   34      NullBufferSize := SIZE(NullBuffer);
*****                        ^ undeclared identifier
*****                             ^ not supported yet
   35      StatusCode := BTRV(fn,FileControl,NullBuffer,NullBufferSize,NullKey,0);
*****      ^ undeclared identifier
*****                    ^ undeclared identifier
*****                            ^ not supported yet
*****                                        ^ not supported yet
*****                                                                  ^ not supported yet
*****                                                                           ^ not supported yet
   36  END BTRV2;
*****      ^ not supported yet
   37  
   38  PROCEDURE BTRV3(fn : CARDINAL;VAR FileControl : FileControlBlock;Key : SHORTCARD);
*****                                                  ^ undeclared identifier
   39  VAR
   40      NullBuffer     : LONGCARD;
*****                       ^ undeclared identifier
   41      NullBufferSize : CARDINAL;
   42      NullKey        : KeyType;
*****                       ^ undeclared identifier
   43  BEGIN
   44      NullBufferSize := SIZE(NullBuffer);
*****                        ^ undeclared identifier
*****                             ^ not supported yet
   45      StatusCode := BTRV(fn,FileControl,NullBuffer,NullBufferSize,NullKey,Key);
*****      ^ undeclared identifier
*****                    ^ undeclared identifier
*****                            ^ not supported yet
*****                                        ^ not supported yet
*****                                                                  ^ not supported yet
*****                                                                             ^ not supported yet
   46  END BTRV3;
*****      ^ not supported yet
   47  
   48  PROCEDURE BTRV4(fn : CARDINAL;VAR FileControl : FileControlBlock;
*****                                                  ^ undeclared identifier
   49                  VAR KeyBuffer : ARRAY OF BYTE; Key : SHORTCARD);
*****                                           ^ undeclared identifier
   50  VAR
   51      NullBuffer     : LONGCARD;
*****                       ^ undeclared identifier
   52      NullBufferSize : CARDINAL;
   53  BEGIN
   54      NullBufferSize := SIZE(NullBuffer);
*****                        ^ undeclared identifier
*****                             ^ not supported yet
   55      StatusCode := BTRV(fn,FileControl,NullBuffer,NullBufferSize,KeyBuffer,Key);
*****      ^ undeclared identifier
*****                    ^ undeclared identifier
*****                            ^ not supported yet
*****                                        ^ not supported yet
*****                                                                  ^ not supported yet
*****                                                                               ^ not supported yet
   56  END BTRV4;
*****      ^ not supported yet
   57  
   58  (****************************************************************************)
   59  
   60  PROCEDURE AbortTransaction;
   61  BEGIN
   62      BTRV1(opAbortTrans);
*****      ^ not supported yet
*****            ^ undeclared identifier
   63  END AbortTransaction;
*****      ^ not supported yet
   64  
   65  (****************************************************************************)
   66  
   67  PROCEDURE BeginTransaction;
   68  BEGIN
   69      BTRV1(opBeginTrans);
*****      ^ not supported yet
*****            ^ undeclared identifier
   70  END BeginTransaction;
*****      ^ not supported yet
   71  
   72  (****************************************************************************)
   73  
   74  PROCEDURE ClearOwner(VAR FileControl : FileControlBlock);
*****                                         ^ undeclared identifier
   75  BEGIN
   76      BTRV2(opClearOwner,FileControl);
*****      ^ not supported yet
*****            ^ undeclared identifier
*****                         ^ not supported yet
   77  END ClearOwner;
*****      ^ not supported yet
   78  
   79  (****************************************************************************)
   80  
   81  PROCEDURE Close(VAR FileControl : FileControlBlock);
*****                                    ^ undeclared identifier
   82  BEGIN
   83      BTRV2(opClose,FileControl);
*****      ^ not supported yet
*****            ^ undeclared identifier
*****                    ^ not supported yet
   84  END Close;
*****      ^ not supported yet
   85  
   86  (****************************************************************************)
   87  
   88  PROCEDURE Create(  VAR FileControl : FileControlBlock;
*****                                       ^ undeclared identifier
   89                     FileDescriptor : ARRAY OF BYTE;
*****                                               ^ undeclared identifier
   90                     DescriptorLength : CARDINAL;
   91                     FileName : ARRAY OF CHAR);
*****                                         ^ not supported yet
   92  VAR
   93      KeyBuffer       : KeyType;
*****                        ^ undeclared identifier
   94  BEGIN
   95      Str.Copy(KeyBuffer,FileName);
*****      ^ not supported yet
*****          ^ not supported yet
*****               ^ not supported yet
*****                         ^ not supported yet
   96      StatusCode := BTRV(opCreate,FileControl,FileDescriptor,DescriptorLength,KeyBuffer,0);
*****      ^ undeclared identifier
*****                    ^ undeclared identifier
*****                         ^ undeclared identifier
*****                                  ^ not supported yet
*****                                              ^ not supported yet
*****                                                                              ^ not supported yet
*****                                                                                         ^ not supported yet
   97  END Create;
*****      ^ not supported yet
   98  
   99  (****************************************************************************)
  100  PROCEDURE DeleteRec(VAR FileControl : FileControlBlock; KeyID : SHORTCARD);
*****                                        ^ undeclared identifier
  101  BEGIN
  102      BTRV3(opDelete,FileControl,KeyID);
*****      ^ not supported yet
*****            ^ undeclared identifier
*****                     ^ not supported yet
*****                                      ^ not supported yet
  103  END DeleteRec;
*****      ^ not supported yet
  104  
  105  (****************************************************************************)
  106  
  107  PROCEDURE EndTransaction;
  108  BEGIN
  109      BTRV1(opEndTrans);
*****      ^ not supported yet
*****            ^ undeclared identifier
  110  END EndTransaction;
*****      ^ not supported yet
  111  
  112  (****************************************************************************)
  113  
  114  PROCEDURE Extend(VAR FileControl : FileControlBlock; FileName : ARRAY OF CHAR;
*****                                     ^ undeclared identifier
*****                                                                           ^ not supported yet
  115                     UseNow : BOOLEAN);
  116  VAR
  117      KeyBuffer       : KeyType;
*****                        ^ undeclared identifier
  118      KeyID           : SHORTCARD;
  119  BEGIN
  120      Str.Copy(KeyBuffer,FileName);
*****      ^ not supported yet
*****          ^ not supported yet
*****               ^ not supported yet
*****                         ^ not supported yet
  121      IF UseNow THEN KeyID := 255 ELSE KeyID := 0; END;
  122      BTRV4(opExtend,FileControl,KeyBuffer,KeyID);
*****      ^ not supported yet
*****            ^ undeclared identifier
*****                     ^ not supported yet
*****                                 ^ not supported yet
*****                                                ^ not supported yet
  123  END Extend;
*****      ^ not supported yet
  124  
  125  (****************************************************************************)
  126  
  127  PROCEDURE FindEQ(VAR FileControl : FileControlBlock;
*****                                     ^ undeclared identifier
  128                   VAR KeyBuffer : ARRAY OF BYTE;
*****                                            ^ undeclared identifier
  129                   KeyID : SHORTCARD);
  130  BEGIN
  131    BTRV4(opGetEQ+opKeyOnly,FileControl,KeyBuffer,KeyID);
*****    ^ not supported yet
*****          ^ undeclared identifier
*****                  ^ undeclared identifier
*****                            ^ not supported yet
*****                                        ^ not supported yet
*****                                                       ^ not supported yet
  132  END FindEQ;
*****      ^ not supported yet
  133  
  134  (****************************************************************************)
  135  
  136  PROCEDURE FindGT(VAR FileControl : FileControlBlock;
*****                                     ^ undeclared identifier
  137                   VAR KeyBuffer : ARRAY OF BYTE;
*****                                            ^ undeclared identifier
  138                   KeyID : SHORTCARD);
  139  BEGIN
  140    BTRV4(opGetGT+opKeyOnly,FileControl,KeyBuffer,KeyID);
*****    ^ not supported yet
*****          ^ undeclared identifier
*****                  ^ undeclared identifier
*****                            ^ not supported yet
*****                                        ^ not supported yet
*****                                                       ^ not supported yet
  141  END FindGT;
*****      ^ not supported yet
  142  
  143  (****************************************************************************)
  144  
  145  PROCEDURE FindGE(VAR FileControl : FileControlBlock;
*****                                     ^ undeclared identifier
  146                   VAR KeyBuffer : ARRAY OF BYTE;
*****                                            ^ undeclared identifier
  147                   KeyID : SHORTCARD);
  148  BEGIN
  149    BTRV4(opGetGE+opKeyOnly,FileControl,KeyBuffer,KeyID);
*****    ^ not supported yet
*****          ^ undeclared identifier
*****                  ^ undeclared identifier
*****                            ^ not supported yet
*****                                        ^ not supported yet
*****                                                       ^ not supported yet
  150  END FindGE;
*****      ^ not supported yet
  151  
  152  (****************************************************************************)
  153  
  154  PROCEDURE FindLast(VAR FileControl : FileControlBlock;
*****                                       ^ undeclared identifier
  155                   VAR KeyBuffer : ARRAY OF BYTE;
*****                                            ^ undeclared identifier
  156                   KeyID : SHORTCARD);
  157  BEGIN
  158    BTRV4(opGetLast+opKeyOnly,FileControl,KeyBuffer,KeyID);
*****    ^ not supported yet
*****          ^ undeclared identifier
*****                    ^ undeclared identifier
*****                              ^ not supported yet
*****                                          ^ not supported yet
*****                                                         ^ not supported yet
  159  END FindLast;
*****      ^ not supported yet
  160  
  161  (****************************************************************************)
  162  
  163  PROCEDURE FindLT(VAR FileControl : FileControlBlock;
*****                                     ^ undeclared identifier
  164                   VAR KeyBuffer : ARRAY OF BYTE;
*****                                            ^ undeclared identifier
  165                   KeyID : SHORTCARD);
  166  BEGIN
  167    BTRV4(opGetLT+opKeyOnly,FileControl,KeyBuffer,KeyID);
*****    ^ not supported yet
*****          ^ undeclared identifier
*****                  ^ undeclared identifier
*****                            ^ not supported yet
*****                                        ^ not supported yet
*****                                                       ^ not supported yet
  168  END FindLT;
*****      ^ not supported yet
  169  
  170  (****************************************************************************)
  171  
  172  PROCEDURE FindLE(VAR FileControl : FileControlBlock;
*****                                     ^ undeclared identifier
  173                   VAR KeyBuffer : ARRAY OF BYTE;
*****                                            ^ undeclared identifier
  174                   KeyID : SHORTCARD);
  175  BEGIN
  176    BTRV4(opGetLE+opKeyOnly,FileControl,KeyBuffer,KeyID);
*****    ^ not supported yet
*****          ^ undeclared identifier
*****                  ^ undeclared identifier
*****                            ^ not supported yet
*****                                        ^ not supported yet
*****                                                       ^ not supported yet
  177  END FindLE;
*****      ^ not supported yet
  178  
  179  (****************************************************************************)
  180  
  181  PROCEDURE FindFirst(VAR FileControl : FileControlBlock;
*****                                        ^ undeclared identifier
  182                   VAR KeyBuffer : ARRAY OF BYTE;
*****                                            ^ undeclared identifier
  183                   KeyID : SHORTCARD);
  184  BEGIN
  185    BTRV4(opGetFirst+opKeyOnly,FileControl,KeyBuffer,KeyID);
*****    ^ not supported yet
*****          ^ undeclared identifier
*****                     ^ undeclared identifier
*****                               ^ not supported yet
*****                                           ^ not supported yet
*****                                                          ^ not supported yet
  186  END FindFirst;
*****      ^ not supported yet
  187  
  188  (****************************************************************************)
  189  
  190  PROCEDURE FindNext(VAR FileControl : FileControlBlock;
*****                                       ^ undeclared identifier
  191                     VAR KeyBuffer : ARRAY OF BYTE;
*****                                              ^ undeclared identifier
  192                     KeyID : SHORTCARD);
  193  BEGIN
  194    BTRV4(opGetNext+opKeyOnly,FileControl,KeyBuffer,KeyID);
*****    ^ not supported yet
*****          ^ undeclared identifier
*****                    ^ undeclared identifier
*****                              ^ not supported yet
*****                                          ^ not supported yet
*****                                                         ^ not supported yet
  195  END FindNext;
*****      ^ not supported yet
  196  
  197  (****************************************************************************)
  198  
  199  PROCEDURE FindPrev(VAR FileControl : FileControlBlock;
*****                                       ^ undeclared identifier
  200                     VAR KeyBuffer : ARRAY OF BYTE;
*****                                              ^ undeclared identifier
  201                     KeyID : SHORTCARD);
  202  BEGIN
  203    BTRV4(opGetPrev+opKeyOnly,FileControl,KeyBuffer,KeyID);
*****    ^ not supported yet
*****          ^ undeclared identifier
*****                    ^ undeclared identifier
*****                              ^ not supported yet
*****                                          ^ not supported yet
*****                                                         ^ not supported yet
  204  END FindPrev;
*****      ^ not supported yet
  205  
  206  (****************************************************************************)
  207  
  208  PROCEDURE GetDirect(VAR FileControl : FileControlBlock;
*****                                        ^ undeclared identifier
  209                      VAR DataBuffer : ARRAY OF BYTE;
*****                                                ^ undeclared identifier
  210                      VAR BufferLength : CARDINAL;
  211                      VAR KeyBuffer : ARRAY OF BYTE;
*****                                               ^ undeclared identifier
  212                      KeyID : SHORTCARD);
  213  BEGIN
  214      StatusCode := BTRV(opGetDirect,FileControl,DataBuffer,BufferLength,KeyBuffer,KeyID);
*****      ^ undeclared identifier
*****                    ^ undeclared identifier
*****                         ^ undeclared identifier
*****                                     ^ not supported yet
*****                                                 ^ not supported yet
*****                                                                         ^ not supported yet
*****                                                                                        ^ not supported yet
  215  END GetDirect;
*****      ^ not supported yet
  216  
  217  (****************************************************************************)
  218  
  219  PROCEDURE GetDir(Drive : SHORTCARD; VAR DirName : ARRAY OF CHAR);
*****                                                             ^ not supported yet
  220  VAR
  221      NullControl    : FileControlBlock;
*****                       ^ undeclared identifier
  222  BEGIN
  223      BTRV4(opGetDir,NullControl,DirName,Drive);
*****      ^ not supported yet
*****            ^ undeclared identifier
*****                     ^ not supported yet
*****                                 ^ not supported yet
*****                                              ^ not supported yet
  224  END GetDir;
*****      ^ not supported yet
  225  
  226  (****************************************************************************)
  227  
  228  PROCEDURE GetEQ(VAR FileControl : FileControlBlock;
*****                                    ^ undeclared identifier
  229                  VAR DataBuffer : ARRAY OF BYTE;
*****                                            ^ undeclared identifier
  230                  VAR BufferLength : CARDINAL;
  231                  VAR KeyBuffer : ARRAY OF BYTE;
*****                                           ^ undeclared identifier
  232                  KeyID : SHORTCARD);
  233  BEGIN
  234      StatusCode := BTRV(opGetEQ,FileControl,DataBuffer,BufferLength,KeyBuffer,KeyID);
*****      ^ undeclared identifier
*****                    ^ undeclared identifier
*****                         ^ undeclared identifier
*****                                 ^ not supported yet
*****                                             ^ not supported yet
*****                                                                     ^ not supported yet
*****                                                                                    ^ not supported yet
  235  END GetEQ;
*****      ^ not supported yet
  236  
  237  (****************************************************************************)
  238  
  239  PROCEDURE GetGT(VAR FileControl : FileControlBlock;
*****                                    ^ undeclared identifier
  240                  VAR DataBuffer : ARRAY OF BYTE;
*****                                            ^ undeclared identifier
  241                  VAR BufferLength : CARDINAL;
  242                  VAR KeyBuffer : ARRAY OF BYTE;
*****                                           ^ undeclared identifier
  243                  KeyID : SHORTCARD);
  244  BEGIN
  245      StatusCode := BTRV(opGetGT,FileControl,DataBuffer,BufferLength,KeyBuffer,KeyID);
*****      ^ undeclared identifier
*****                    ^ undeclared identifier
*****                         ^ undeclared identifier
*****                                 ^ not supported yet
*****                                             ^ not supported yet
*****                                                                     ^ not supported yet
*****                                                                                    ^ not supported yet
  246  END GetGT;
*****      ^ not supported yet
  247  
  248  (****************************************************************************)
  249  
  250  PROCEDURE GetGE(VAR FileControl : FileControlBlock;
*****                                    ^ undeclared identifier
  251                  VAR DataBuffer : ARRAY OF BYTE;
*****                                            ^ undeclared identifier
  252                  VAR BufferLength : CARDINAL;
  253                  VAR KeyBuffer : ARRAY OF BYTE;
*****                                           ^ undeclared identifier
  254                  KeyID : SHORTCARD);
  255  BEGIN
  256      StatusCode := BTRV(opGetGE,FileControl,DataBuffer,BufferLength,KeyBuffer,KeyID);
*****      ^ undeclared identifier
*****                    ^ undeclared identifier
*****                         ^ undeclared identifier
*****                                 ^ not supported yet
*****                                             ^ not supported yet
*****                                                                     ^ not supported yet
*****                                                                                    ^ not supported yet
  257  END GetGE;
*****      ^ not supported yet
  258  
  259  (****************************************************************************)
  260  
  261  PROCEDURE GetLast(VAR FileControl : FileControlBlock;
*****                                      ^ undeclared identifier
  262                  VAR DataBuffer : ARRAY OF BYTE;
*****                                            ^ undeclared identifier
  263                  VAR BufferLength : CARDINAL;
  264                  VAR KeyBuffer : ARRAY OF BYTE;
*****                                           ^ undeclared identifier
  265                  KeyID : SHORTCARD);
  266  BEGIN
  267      StatusCode := BTRV(opGetLast,FileControl,DataBuffer,BufferLength,KeyBuffer,KeyID);
*****      ^ undeclared identifier
*****                    ^ undeclared identifier
*****                         ^ undeclared identifier
*****                                   ^ not supported yet
*****                                               ^ not supported yet
*****                                                                       ^ not supported yet
*****                                                                                      ^ not supported yet
  268  END GetLast;
*****      ^ not supported yet
  269  
  270  (****************************************************************************)
  271  
  272  PROCEDURE GetLT(VAR FileControl : FileControlBlock;
*****                                    ^ undeclared identifier
  273                  VAR DataBuffer : ARRAY OF BYTE;
*****                                            ^ undeclared identifier
  274                  VAR BufferLength : CARDINAL;
  275                  VAR KeyBuffer : ARRAY OF BYTE;
*****                                           ^ undeclared identifier
  276                  KeyID : SHORTCARD);
  277  BEGIN
  278      StatusCode := BTRV(opGetLT,FileControl,DataBuffer,BufferLength,KeyBuffer,KeyID);
*****      ^ undeclared identifier
*****                    ^ undeclared identifier
*****                         ^ undeclared identifier
*****                                 ^ not supported yet
*****                                             ^ not supported yet
*****                                                                     ^ not supported yet
*****                                                                                    ^ not supported yet
  279  END GetLT;
*****      ^ not supported yet
  280  
  281  (****************************************************************************)
  282  
  283  PROCEDURE GetLE(VAR FileControl : FileControlBlock;
*****                                    ^ undeclared identifier
  284                  VAR DataBuffer : ARRAY OF BYTE;
*****                                            ^ undeclared identifier
  285                  VAR BufferLength : CARDINAL;
  286                  VAR KeyBuffer : ARRAY OF BYTE;
*****                                           ^ undeclared identifier
  287                  KeyID : SHORTCARD);
  288  BEGIN
  289      StatusCode := BTRV(opGetLE,FileControl,DataBuffer,BufferLength,KeyBuffer,KeyID);
*****      ^ undeclared identifier
*****                    ^ undeclared identifier
*****                         ^ undeclared identifier
*****                                 ^ not supported yet
*****                                             ^ not supported yet
*****                                                                     ^ not supported yet
*****                                                                                    ^ not supported yet
  290  END GetLE;
*****      ^ not supported yet
  291  
  292  (****************************************************************************)
  293  
  294  PROCEDURE GetFirst(VAR FileControl : FileControlBlock;
*****                                       ^ undeclared identifier
  295                  VAR DataBuffer : ARRAY OF BYTE;
*****                                            ^ undeclared identifier
  296                  VAR BufferLength : CARDINAL;
  297                  VAR KeyBuffer : ARRAY OF BYTE;
*****                                           ^ undeclared identifier
  298                  KeyID : SHORTCARD);
  299  BEGIN
  300      StatusCode := BTRV(opGetFirst,FileControl,DataBuffer,BufferLength,KeyBuffer,KeyID);
*****      ^ undeclared identifier
*****                    ^ undeclared identifier
*****                         ^ undeclared identifier
*****                                    ^ not supported yet
*****                                                ^ not supported yet
*****                                                                        ^ not supported yet
*****                                                                                       ^ not supported yet
  301  END GetFirst;
*****      ^ not supported yet
  302  
  303  (****************************************************************************)
  304  
  305  PROCEDURE GetNext(VAR FileControl : FileControlBlock;
*****                                      ^ undeclared identifier
  306                    VAR DataBuffer : ARRAY OF BYTE;
*****                                              ^ undeclared identifier
  307                    VAR BufferLength : CARDINAL;
  308                    VAR KeyBuffer : ARRAY OF BYTE;
*****                                             ^ undeclared identifier
  309                    KeyID : SHORTCARD);
  310  BEGIN
  311      StatusCode := BTRV(opGetNext,FileControl,DataBuffer,BufferLength,KeyBuffer,KeyID);
*****      ^ undeclared identifier
*****                    ^ undeclared identifier
*****                         ^ undeclared identifier
*****                                   ^ not supported yet
*****                                               ^ not supported yet
*****                                                                       ^ not supported yet
*****                                                                                      ^ not supported yet
  312  END GetNext;
*****      ^ not supported yet
  313  
  314  (****************************************************************************)
  315  
  316  PROCEDURE GetPosition(VAR FileControl :FileControlBlock;
*****                                         ^ undeclared identifier
  317                        VAR pos : ARRAY OF BYTE);
*****                                           ^ undeclared identifier
  318  VAR BufferSize : CARDINAL;
  319      NullKey : KeyType;
*****                ^ undeclared identifier
  320  BEGIN
  321      BufferSize := SIZE(pos);
*****                    ^ undeclared identifier
*****                         ^ not supported yet
  322      StatusCode := BTRV(opGetPos,FileControl,pos,BufferSize,NullKey,0);
*****      ^ undeclared identifier
*****                    ^ undeclared identifier
*****                         ^ undeclared identifier
*****                                  ^ not supported yet
*****                                              ^ not supported yet
*****                                                             ^ not supported yet
*****                                                                      ^ not supported yet
  323  END GetPosition;
*****      ^ not supported yet
  324  
  325  (****************************************************************************)
  326  
  327  PROCEDURE GetPrev(VAR FileControl : FileControlBlock;
*****                                      ^ undeclared identifier
  328                    VAR DataBuffer : ARRAY OF BYTE;
*****                                              ^ undeclared identifier
  329                    VAR BufferLength : CARDINAL;
  330                    VAR KeyBuffer : ARRAY OF BYTE;
*****                                             ^ undeclared identifier
  331                    KeyID : SHORTCARD);
  332  BEGIN
  333      StatusCode := BTRV(opGetPrev,FileControl,DataBuffer,BufferLength,KeyBuffer,KeyID);
*****      ^ undeclared identifier
*****                    ^ undeclared identifier
*****                         ^ undeclared identifier
*****                                   ^ not supported yet
*****                                               ^ not supported yet
*****                                                                       ^ not supported yet
*****                                                                                      ^ not supported yet
  334  END GetPrev;
*****      ^ not supported yet
  335  
  336  (****************************************************************************)
  337  
  338  PROCEDURE Insert(VAR FileControl : FileControlBlock;
*****                                     ^ undeclared identifier
  339                   VAR DataBuffer : ARRAY OF BYTE;
*****                                             ^ undeclared identifier
  340                   VAR BufferLength : CARDINAL;
  341                   VAR KeyBuffer : ARRAY OF BYTE;
*****                                            ^ undeclared identifier
  342                   KeyID : SHORTCARD);
  343  BEGIN
  344      StatusCode := BTRV(opInsert,FileControl,DataBuffer,BufferLength,KeyBuffer,KeyID);
*****      ^ undeclared identifier
*****                    ^ undeclared identifier
*****                         ^ undeclared identifier
*****                                  ^ not supported yet
*****                                              ^ not supported yet
*****                                                                      ^ not supported yet
*****                                                                                     ^ not supported yet
  345  END Insert;
*****      ^ not supported yet
  346  
  347  (****************************************************************************)
  348  
  349  PROCEDURE Open(VAR FileControl : FileControlBlock;
*****                                   ^ undeclared identifier
  350                 FileName,OwnerName : ARRAY OF CHAR;
*****                                               ^ not supported yet
  351                 OpenMode : SHORTCARD);
  352  VAR
  353      DataBuffer      : ARRAY [0..7] OF CHAR;
*****                                  ^ not supported yet
*****                                        ^ not supported yet
  354      KeyBuffer       : KeyType;
*****                        ^ undeclared identifier
  355      BufferLength    : CARDINAL;
  356  
  357  BEGIN
  358      Str.Copy(KeyBuffer,FileName);
*****      ^ not supported yet
*****          ^ not supported yet
*****               ^ not supported yet
*****                         ^ not supported yet
  359      Str.Copy(DataBuffer,OwnerName);
*****      ^ not supported yet
*****          ^ not supported yet
*****               ^ not supported yet
*****                          ^ not supported yet
  360      DataBuffer[7] := 0C;
*****      ^ not supported yet
*****                  ^ not supported yet
  361      BufferLength := Str.Length(DataBuffer) + 1;
*****                      ^ not supported yet
*****                          ^ not supported yet
*****                                 ^ not supported yet
  362      StatusCode := BTRV(opOpen,FileControl,DataBuffer,BufferLength,
*****      ^ undeclared identifier
*****                    ^ undeclared identifier
*****                         ^ undeclared identifier
*****                                ^ not supported yet
*****                                            ^ not supported yet
  363                         KeyBuffer,OpenMode);
*****                         ^ not supported yet
*****                                           ^ not supported yet
  364  END Open;
*****      ^ not supported yet
  365  
  366  (****************************************************************************)
  367  
  368  PROCEDURE Reset;
  369  BEGIN
  370      BTRV1(opReset);
*****      ^ not supported yet
*****            ^ undeclared identifier
  371  END Reset;
*****      ^ not supported yet
  372  
  373  (****************************************************************************)
  374  
  375  PROCEDURE SetDirectory(DirName : ARRAY OF CHAR);
*****                                            ^ not supported yet
  376  VAR
  377      KeyBuffer       : KeyType;
*****                        ^ undeclared identifier
  378      NullControl     : FileControlBlock;
*****                        ^ undeclared identifier
  379  BEGIN
  380      Str.Copy(KeyBuffer,DirName);
*****      ^ not supported yet
*****          ^ not supported yet
*****               ^ not supported yet
*****                         ^ not supported yet
  381      BTRV4(opSetDir,NullControl,KeyBuffer,0);
*****      ^ not supported yet
*****            ^ undeclared identifier
*****                     ^ not supported yet
*****                                 ^ not supported yet
*****                                            ^ not supported yet
  382  END SetDirectory;
*****      ^ not supported yet
  383  
  384  (****************************************************************************)
  385  
  386  PROCEDURE SetOwner(VAR FileControl : FileControlBlock;
*****                                       ^ undeclared identifier
  387                       OwnerName : ARRAY OF CHAR;
*****                                            ^ not supported yet
  388                       AccessMode : SHORTCARD);
  389  VAR
  390      DataBuffer      : OwnerType;
*****                        ^ undeclared identifier
  391      KeyBuffer       : KeyType;
*****                        ^ undeclared identifier
  392      BufferLength    : CARDINAL;
  393  
  394  BEGIN
  395      Str.Copy(DataBuffer,OwnerName);
*****      ^ not supported yet
*****          ^ not supported yet
*****               ^ not supported yet
*****                          ^ not supported yet
  396      Str.Copy(KeyBuffer,OwnerName);
*****      ^ not supported yet
*****          ^ not supported yet
*****               ^ not supported yet
*****                         ^ not supported yet
  397      DataBuffer[7] := 0C;
*****      ^ not supported yet
*****                  ^ not supported yet
  398      BufferLength := Str.Length(DataBuffer) + 1;
*****                      ^ not supported yet
*****                          ^ not supported yet
*****                                 ^ not supported yet
  399      StatusCode := BTRV(opSetOwner,FileControl,DataBuffer,
*****      ^ undeclared identifier
*****                    ^ undeclared identifier
*****                         ^ undeclared identifier
*****                                    ^ not supported yet
*****                                                ^ not supported yet
  400                           BufferLength,KeyBuffer,AccessMode);
*****                                        ^ not supported yet
*****                                                            ^ not supported yet
  401  END SetOwner;
*****      ^ not supported yet
  402  
  403  (****************************************************************************)
  404  
  405  PROCEDURE Status(VAR FileControl : FileControlBlock;
*****                                     ^ undeclared identifier
  406                   VAR DataBuffer : ARRAY OF BYTE;
*****                                             ^ undeclared identifier
  407                   VAR BufferLength : CARDINAL;
  408                   VAR KeyBuffer : ARRAY OF BYTE;
*****                                            ^ undeclared identifier
  409                   KeyID : SHORTCARD);
  410  BEGIN
  411      StatusCode := BTRV(opStat,FileControl,DataBuffer,BufferLength,KeyBuffer,0);
*****      ^ undeclared identifier
*****                    ^ undeclared identifier
*****                         ^ undeclared identifier
*****                                ^ not supported yet
*****                                            ^ not supported yet
*****                                                                    ^ not supported yet
*****                                                                               ^ not supported yet
  412  END Status;
*****      ^ not supported yet
  413  
  414  (****************************************************************************)
  415  
  416  PROCEDURE StepDirect(VAR FileControl : FileControlBlock;
*****                                         ^ undeclared identifier
  417                       VAR DataBuffer : ARRAY OF BYTE;
*****                                                 ^ undeclared identifier
  418                       VAR BufferLength : CARDINAL);
  419  VAR
  420      NullKey       : KeyType;
*****                      ^ undeclared identifier
  421  BEGIN
  422      StatusCode := BTRV(opStepDirect,FileControl,DataBuffer,
*****      ^ undeclared identifier
*****                    ^ undeclared identifier
*****                         ^ undeclared identifier
*****                                      ^ not supported yet
*****                                                  ^ not supported yet
  423                           BufferLength,NullKey,0);
*****                                        ^ not supported yet
*****                                                 ^ not supported yet
  424  END StepDirect;
*****      ^ not supported yet
  425  
  426  (****************************************************************************)
  427  
  428  PROCEDURE Stop;
  429  BEGIN
  430      BTRV1(opStop);
*****      ^ not supported yet
*****            ^ undeclared identifier
  431  END Stop;
*****      ^ not supported yet
  432  
  433  (****************************************************************************)
  434  
  435  PROCEDURE Update(VAR FileControl : FileControlBlock;
*****                                     ^ undeclared identifier
  436                   VAR DataBuffer : ARRAY OF BYTE;
*****                                             ^ undeclared identifier
  437                   VAR BufferLength : CARDINAL;
  438                   VAR KeyBuffer : ARRAY OF BYTE;
*****                                            ^ undeclared identifier
  439                   KeyID : SHORTCARD);
  440  BEGIN
  441      StatusCode := BTRV(opUpdate,FileControl,DataBuffer,BufferLength,KeyBuffer,0);
*****      ^ undeclared identifier
*****                    ^ undeclared identifier
*****                         ^ undeclared identifier
*****                                  ^ not supported yet
*****                                              ^ not supported yet
*****                                                                      ^ not supported yet
*****                                                                                 ^ not supported yet
  442  END Update;
*****      ^ not supported yet
  443  
  444  (****************************************************************************)
  445  
  446  PROCEDURE Version(VAR DataBuffer : ARRAY OF BYTE );
*****                                              ^ undeclared identifier
  447  VAR
  448      NullControl    : FileControlBlock;
*****                       ^ undeclared identifier
  449      BufferSize : CARDINAL;
  450      NullKey        : KeyType;
*****                       ^ undeclared identifier
  451  BEGIN
  452      BufferSize := SIZE(DataBuffer);
*****                    ^ undeclared identifier
*****                         ^ not supported yet
  453      StatusCode := BTRV(opVersion,NullControl,DataBuffer,BufferSize,NullKey,0);
*****      ^ undeclared identifier
*****                    ^ undeclared identifier
*****                         ^ undeclared identifier
*****                                   ^ not supported yet
*****                                               ^ not supported yet
*****                                                                     ^ not supported yet
*****                                                                              ^ not supported yet
  454  END Version;
*****      ^ not supported yet
  455  
  456  (****************************************************************************)
  457  (* Low Level Btrieve Call                                                   *)
  458  (****************************************************************************)
  459  
  460  VAR
  461    ProcId: CARDINAL;  (* initialize to no process id *)
  462    Multi:  BOOLEAN;   (* set to true if BMulti is loaded *)
  463    VSet:   BOOLEAN;   (* set to true if we have checked for BMulti *)
  464  
  465  (*%T _XTD*)
  466  
  467  TYPE
  468    rADDRESS  = LONGCARD;
*****                ^ undeclared identifier
  469  
  470  PROCEDURE RealAlloc(VAR handle : CARDINAL; size : CARDINAL; VAR src : ARRAY OF BYTE):rADDRESS;
*****                                                                                 ^ undeclared identifier
  471  (* Needed to copy to Real Memory (i.e. addressable from real mode) *)
  472  VAR csize : CARDINAL;
  473  BEGIN
  474    IF size=0 THEN handle:=0; RETURN 0 END;
*****                                     ^ bad RETURN
  475    handle := TSXLIB.ALLOCLOWSEG(size);
*****              ^ not supported yet
*****                     ^ not supported yet
*****                                     ^ not supported yet
  476    IF Seg(src)<>0 THEN (* copy in *)
*****       ^ undeclared identifier
*****           ^ not supported yet
  477      (* protect against buffers that are too short *)
  478      csize := TSXLIB.GETSEGLIMIT(Seg(src));
*****               ^ not supported yet
*****                      ^ not supported yet
*****                                  ^ undeclared identifier
*****                                      ^ not supported yet
  479      IF (csize>=Ofs(src)) THEN
*****                 ^ undeclared identifier
*****                     ^ not supported yet
  480        DEC(csize,Ofs(src)-1);
*****        ^ undeclared identifier
*****                  ^ undeclared identifier
*****                      ^ not supported yet
*****                            ^ not supported yet
  481        IF (csize=0)OR(csize>size) THEN csize := size END;
  482        Lib.FastMove(ADR(src),[handle:0],csize);
*****        ^ not supported yet
*****            ^ not supported yet
*****                     ^ undeclared identifier
*****                         ^ not supported yet
*****                                      ^ not supported yet
*****                                              ^ not supported yet
  483      END;
  484    ELSE
  485      Lib.Fill([handle:0],size,0);
*****      ^ not supported yet
*****          ^ not supported yet
*****                       ^ not supported yet
*****                                ^ not supported yet
  486    END;
  487    RETURN TSXLIB.MAKEREALADDR(handle,0);
*****           ^ not supported yet
*****                  ^ not supported yet
*****                                       ^ not supported yet
  488  END RealAlloc;
*****      ^ not supported yet
  489  
  490  PROCEDURE RealFree(handle :CARDINAL; size : CARDINAL; VAR dst : ARRAY OF BYTE);
*****                                                                           ^ undeclared identifier
  491  VAR csize : CARDINAL;
  492  BEGIN
  493    IF handle=0 THEN RETURN END;
  494    IF Seg(dst)<>0 THEN (* copy out *)
*****       ^ undeclared identifier
*****           ^ not supported yet
  495      (* protect against buffers that are too short *)
  496      csize := TSXLIB.GETSEGLIMIT(Seg(dst));
*****               ^ not supported yet
*****                      ^ not supported yet
*****                                  ^ undeclared identifier
*****                                      ^ not supported yet
  497      IF (csize>=Ofs(dst)) THEN
*****                 ^ undeclared identifier
*****                     ^ not supported yet
  498        DEC(csize,Ofs(dst)-1);
*****        ^ undeclared identifier
*****                  ^ undeclared identifier
*****                      ^ not supported yet
*****                            ^ not supported yet
  499        IF (csize=0)OR(csize>size) THEN csize := size END;
  500        Lib.FastMove([handle:0],ADR(dst),csize);
*****        ^ not supported yet
*****            ^ not supported yet
*****                             ^ not supported yet
*****                                ^ undeclared identifier
*****                                    ^ not supported yet
*****                                              ^ not supported yet
  501      END;
  502    END;
  503    TSXLIB.FREESEG(handle);
*****    ^ not supported yet
*****           ^ not supported yet
*****                         ^ not supported yet
  504  END RealFree;
*****      ^ not supported yet
  505  
  506  PROCEDURE BTRV ( op: CARDINAL;              (* Operation          *)
  507                   VAR pos: FileControlBlock; (* Position Block     *)
*****                            ^ undeclared identifier
  508                   VAR data: ARRAY OF BYTE;   (* Data Buffer        *)
*****                                      ^ undeclared identifier
  509                   VAR datalen: CARDINAL;     (* Data Length        *)
  510                   VAR kbuf: ARRAY OF BYTE;   (* Key Buffer         *)
*****                                      ^ undeclared identifier
  511                   key: SHORTCARD             (* Key Number         *)
  512  
  513                 ): StatusCodes ;             (* Btrieve error code *)
*****                    ^ undeclared identifier
  514  
  515    CONST
  516      VarID         = 06176H; (* id for variable length records - 'va'*)
  517      BtrInt        = 07BH;
  518      Btr2Int       = 02FH;
  519      BtrOffset     = 00033H;
  520      MultiFunction = 0AB00H;
  521  
  522    TYPE
  523      rBtrParms = RECORD
  524                   UserBufAddr  : rADDRESS;      (* data buffer address *)
  525                   UserBufLen   : CARDINAL;      (* data buffer length *)
  526                   UserCurAddr  : rADDRESS;      (* currency block address *)
  527                   UserFCBAddr  : rADDRESS;      (* file control block address *)
  528                   UserFunction : CARDINAL;      (* Btrieve operation *)
  529                   UserKeyAddr  : rADDRESS;      (* key buffer address *)
  530                   UserKeyLength: SHORTCARD;     (* key buffer length *)
  531                   UserKeyNumber: SHORTCARD;     (* key number *)
  532                   UserStatAddr : rADDRESS;      (* return status address *)
  533                   xFaceID      : CARDINAL;      (* language interface id *)
  534                 END;
*****                 ^ not supported yet
  535    VAR
  536      Stat: CARDINAL;  (* Btrieve status code *)
  537      Params: rBtrParms; (* Btrieve parameter block *)
*****              ^ not supported yet
  538      r: SYSTEM.Registers;    (* register structure used on interrrupt call *)
*****                ^ not supported yet
  539      DataSel,PosSel,KeySel,StatSel,ParamSel : CARDINAL;
  540      rParams : rADDRESS;
  541  BEGIN
  542    Lib.Fill(ADR(r),SIZE(r),0);
*****    ^ not supported yet
*****        ^ not supported yet
*****             ^ undeclared identifier
*****                 ^ not supported yet
*****                    ^ undeclared identifier
*****                         ^ not supported yet
*****                             ^ not supported yet
  543    r.AX:= 03500H + BtrInt;
*****    ^ not supported yet
*****      ^ not supported yet
  544    TSXLIB.REALINTR(ADR(r), 21H);  (* NB using Lib.Intr will return
*****    ^ not supported yet
*****           ^ not supported yet
*****                    ^ undeclared identifier
*****                        ^ not supported yet
*****                               ^ not supported yet
  545                                              prot mode address *)
  546    IF r.BX # BtrOffset THEN (* make sure Btrieve is installed *)
*****       ^ not supported yet
*****         ^ not supported yet
  547      RETURN BtrieveAbsent
*****             ^ undeclared identifier
  548    END;
  549    IF NOT VSet THEN (* if we haven't checked for Multi-User version *)
  550      r.AX:= 03000H;
*****      ^ not supported yet
*****        ^ not supported yet
  551      Lib.Intr(r, 021H);
*****      ^ not supported yet
*****          ^ not supported yet
*****               ^ not supported yet
*****                      ^ not supported yet
  552      IF r.AL >= 3 THEN (* DOS version >= 3.0 *)
*****         ^ not supported yet
*****           ^ not supported yet
  553        VSet:= TRUE;
  554        r.AX:= MultiFunction;
*****        ^ not supported yet
*****          ^ not supported yet
  555        Lib.Intr(r, Btr2Int);
*****        ^ not supported yet
*****            ^ not supported yet
*****                 ^ not supported yet
*****                           ^ not supported yet
  556        Multi:= r.AL = 4DH   (* ORD('M') *)
*****                ^ not supported yet
*****                  ^ not supported yet
  557      ELSE
  558        Multi:= FALSE
  559      END
  560    END; (* make normal btrieve call *)
  561    IF datalen > HIGH(data)+1 THEN datalen:= HIGH(data)+1 END;
*****                 ^ undeclared identifier
*****                      ^ not supported yet
*****                                             ^ undeclared identifier
*****                                                  ^ not supported yet
  562    WITH Params DO
*****         ^ not supported yet
  563      UserBufAddr := RealAlloc(DataSel,datalen,data); (* set data buffer address *)
*****      ^ not supported yet
*****                     ^ not supported yet
*****                                               ^ not supported yet
  564      UserBufLen := datalen;                          (* set length *)
*****      ^ not supported yet
*****                    ^ incompatible assignment
  565      UserFCBAddr := RealAlloc(PosSel,38+90,pos);     (* set FCB address*)
*****      ^ not supported yet
*****                     ^ not supported yet
*****                                            ^ not supported yet
  566      UserCurAddr := UserFCBAddr+38;
*****      ^ not supported yet
*****                     ^ not supported yet
  567      UserFunction := op;                             (* set Btrieve operation code *)
*****      ^ not supported yet
*****                      ^ incompatible assignment
  568      UserKeyAddr := RealAlloc(KeySel,255,kbuf);      (* set key buffer address *)
*****      ^ not supported yet
*****                     ^ not supported yet
*****                                          ^ not supported yet
  569      UserKeyLength := 255;
*****      ^ not supported yet
*****                       ^ incompatible assignment
  570      UserKeyNumber := key;                           (* set key number *)
*****      ^ not supported yet
*****                       ^ incompatible assignment
  571      UserStatAddr := RealAlloc(StatSel,SIZE(Stat),Stat);;
*****      ^ not supported yet
*****                      ^ not supported yet
*****                                        ^ undeclared identifier
*****                                                 ^ not supported yet
*****                                                       ^ not supported yet
  572      xFaceID      := VarID;                          (* set language id *)
*****      ^ not supported yet
*****                      ^ incompatible assignment
  573    END;
*****    ^ not supported yet
  574    rParams := RealAlloc(ParamSel,SIZE(Params),Params);
*****    ^ not supported yet
*****               ^ not supported yet
*****                                  ^ undeclared identifier
*****                                       ^ not supported yet
*****                                               ^ not supported yet
  575    r.DX := CARDINAL(rParams);
*****    ^ not supported yet
*****      ^ not supported yet
*****                     ^ not supported yet
  576    r.DS := CARDINAL(rParams>>16);
*****    ^ not supported yet
*****      ^ not supported yet
*****                     ^ not supported yet
*****                              ^ arithmetic operand must be numeric
  577    IF NOT Multi THEN  (* MultiUser version not installed *)
  578      TSXLIB.REALINTR(ADR(r), BtrInt); (* passing real addresses *)
*****      ^ not supported yet
*****             ^ not supported yet
*****                      ^ undeclared identifier
*****                          ^ not supported yet
*****                                    ^ not supported yet
  579    ELSE
  580      LOOP
  581        r.BX:= ProcId;
*****        ^ not supported yet
*****          ^ not supported yet
  582        IF r.BX # 0 THEN r.AX:= 2 ELSE r.AX:= 1 END;
*****           ^ not supported yet
*****             ^ not supported yet
*****                         ^ not supported yet
*****                           ^ not supported yet
*****                                       ^ not supported yet
*****                                         ^ not supported yet
  583        INC(r.AX, MultiFunction);
*****        ^ undeclared identifier
*****            ^ not supported yet
*****              ^ not supported yet
*****                               ^ not supported yet
  584        Lib.Intr(r, Btr2Int);
*****        ^ not supported yet
*****            ^ not supported yet
*****                 ^ not supported yet
*****                           ^ not supported yet
  585        IF r.AL = 0 THEN EXIT END;
*****           ^ not supported yet
*****             ^ not supported yet
  586        r.AX:= 200H;
*****        ^ not supported yet
*****          ^ not supported yet
  587        TSXLIB.REALINTR(ADR(r), 07FH); (* passing real addresses *)
*****        ^ not supported yet
*****               ^ not supported yet
*****                        ^ undeclared identifier
*****                            ^ not supported yet
*****                                    ^ not supported yet
  588      END;
  589      IF ProcId = 0 THEN ProcId:= r.BX END
*****                                  ^ not supported yet
*****                                    ^ not supported yet
  590    END;
  591    RealFree(ParamSel,SIZE(Params),Params);
*****    ^ not supported yet
*****                      ^ undeclared identifier
*****                           ^ not supported yet
*****                                   ^ not supported yet
  592    RealFree(DataSel,datalen,data);
*****    ^ not supported yet
*****                             ^ not supported yet
  593    RealFree(PosSel,38,pos);
*****    ^ not supported yet
*****                       ^ not supported yet
  594    RealFree(KeySel,255,kbuf);
*****    ^ not supported yet
*****                        ^ not supported yet
  595    RealFree(StatSel,SIZE(Stat),Stat);
*****    ^ not supported yet
*****                     ^ undeclared identifier
*****                              ^ not supported yet
*****                                    ^ not supported yet
  596    datalen:= Params.UserBufLen;
*****              ^ not supported yet
*****                     ^ not supported yet
  597    RETURN StatusCodes(Stat);
*****           ^ undeclared identifier
*****                           ^ not supported yet
  598  END BTRV;
*****      ^ not supported yet
  599  
  600  (*%E*)
  601  
  602  (*%F _XTD*)
  603  
  604  
  605  PROCEDURE BTRV ( op: CARDINAL;              (* Operation          *)
  606                   VAR pos: FileControlBlock; (* Position Block     *)
  607                   VAR data: ARRAY OF BYTE;   (* Data Buffer        *)
  608                   VAR datalen: CARDINAL;     (* Data Length        *)
  609                   VAR kbuf: ARRAY OF BYTE;   (* Key Buffer         *)
  610                   key: SHORTCARD             (* Key Number         *)
  611                 ): StatusCodes ;             (* Btrieve error code *)
  612    CONST
  613      VarID         = 06176H; (* id for variable length records - 'va'*)
  614      BtrInt        = 07BH;
  615      Btr2Int       = 02FH;
  616      BtrOffset     = 00033H;
  617      MultiFunction = 0AB00H;
  618  
  619    TYPE
  620      BtrParms = RECORD
  621                   UserBufAddr  : ADDRESS;      (* data buffer address *)
  622                   UserBufLen   : CARDINAL;     (* data buffer length *)
  623                   UserCurAddr  : ADDRESS;      (* currency block address *)
  624                   UserFCBAddr  : ADDRESS;      (* file control block address *)
  625                   UserFunction : CARDINAL;     (* Btrieve operation *)
  626                   UserKeyAddr  : ADDRESS;      (* key buffer address *)
  627                   UserKeyLength: SHORTCARD;    (* key buffer length *)
  628                   UserKeyNumber: SHORTCARD;    (* key number *)
  629                   UserStatAddr : ADDRESS;      (* return status address *)
  630                   xFaceID      : CARDINAL;     (* language interface id *)
  631                 END;
  632    VAR
  633      Stat: CARDINAL;  (* Btrieve status code *)
  634      XData: BtrParms; (* Btrieve parameter block *)
  635      r: SYSTEM.Registers;    (* register structure used on interrrupt call *)
  636  
  637  BEGIN
  638    r.AX:= 03500H + BtrInt;
  639    Lib.Intr(r, 021H);
  640    IF r.BX # BtrOffset THEN (* make sure Btrieve is installed *)
  641      RETURN BtrieveAbsent
  642    END;
  643    IF NOT VSet THEN (* if we haven't checked for Multi-User version *)
  644      r.AX:= 03000H;
  645      Lib.Intr(r, 021H);
  646      IF r.AL >= 3 THEN (* DOS version >= 3.0 *)
  647        VSet:= TRUE;
  648        r.AX:= MultiFunction;
  649        Lib.Intr(r, Btr2Int);
  650        Multi:= r.AL = 4DH   (* ORD('M') *)
  651      ELSE
  652        Multi:= FALSE
  653      END
  654    END; (* make normal btrieve call *)
  655    IF datalen > HIGH(data)+1 THEN datalen:= HIGH(data)+1 END;
  656    WITH XData DO
  657      UserBufAddr  := ADR(data);        (* set data buffer address *)
  658      UserBufLen   := datalen;          (* set length *)
  659      UserFCBAddr  := ADR(pos);         (* set FCB address*)
  660      UserCurAddr  := ADR(pos[38]);
  661      UserFunction := op;               (* set Btrieve operation code *)
  662      UserKeyAddr  := ADR(kbuf);        (* set key buffer address *)
  663      UserKeyLength := 255;
  664      UserKeyNumber:= key;              (* set key number *)
  665      UserStatAddr := ADR(Stat);        (* set status address *)
  666      xFaceID      := VarID;            (* set language id *)
  667    END;
  668    r.DX:= SYSTEM.Ofs(XData);
  669    r.DS:= SYSTEM.Seg(XData);
  670    IF NOT Multi THEN  (* MultiUser version not installed *)
  671      Lib.Intr(r, BtrInt)
  672    ELSE
  673      LOOP
  674        r.BX:= ProcId;
  675        IF r.BX # 0 THEN r.AX:= 2 ELSE r.AX:= 1 END;
  676        INC(r.AX, MultiFunction);
  677        Lib.Intr(r, Btr2Int);
  678        IF r.AL = 0 THEN EXIT END;
  679        r.AX:= 200H;
  680        Lib.Intr(r, 07FH)
  681      END;
  682      IF ProcId = 0 THEN ProcId:= r.BX END
  683    END;
  684    datalen:= XData.UserBufLen;
  685    RETURN StatusCodes(Stat);
  686  END BTRV;
  687  (*%E*)
  688  
  689  BEGIN
  690    VSet  := FALSE;
  691    Multi := FALSE;
  692    ProcId:= 0;
  693  END TSBTRV.
*****      ^ not supported yet

  632 errors