Topspeed_JPI/TS-V3/MODBASE/DBFTEST.LST

Listing:

    1  IMPLEMENTATION MODULE DBFTest;
    2  FROM ModBase3 IMPORT InitDBF,OpenDBF,CloseDBF,ReadDBRec,GetField,DBFile,
    3                DeleteRecord,DefaultFixUp,NilDBF,PosOfField,DBFieldArray,
    4  	      DBFieldPtr,BuildDBF,DBFieldDescriptor;
    5  FROM DBCopier IMPORT DBPack;
    6  FROM DBIndxes IMPORT InitIndex,OpenIndex,AddToUpdateList,CloseIndex,
    7                CurrentRec,FindPositionCh,BuildIndex,GoTop,GoBottom,
    8                NextRecord,PrevRecord,CurrentKeyCh,FindPositionN,
    9                CurrentKeyN,InitCompIndex,BuildCompIndex,DBIndex;
   10  FROM StrEdit IMPORT CrunchBlanks;
   11  FROM HandleIO IMPORT FileExists;
   12  FROM Storage IMPORT ALLOCATE,DEALLOCATE;
   13  FROM DBStuff IMPORT MakeKey;
   14  FROM Drectory IMPORT DeleteFile;
   15  FROM StrConv IMPORT StrToReal;
   16  FROM NumTypes IMPORT Real8;
   17  FROM M2Strings IMPORT Assign;
   18  FROM DBStuff IMPORT MakeKey,MakeDescriptor;
*****       ^ duplicate identifier
*****                      ^ duplicate identifier
   19  FROM ScanUtils IMPORT Present,CaseSens;
   20  FROM LowLevel IMPORT Fill;
   21  FROM DBFields IMPORT GetDateField,GetLogicalField,GetNumField,Replace,
   22       ReplaceD,ReplaceN;
   23  
   24  CONST
   25    Buffer = 0;
   26    Safty = TRUE;
   27    Exclusive = FALSE;
   28    AutoLock = TRUE;
   29    KeepDeleted = FALSE;
   30  VAR
   31    IndexOpen : BOOLEAN;
   32   
   33  PROCEDURE MakeDatabase();
   34  VAR 
   35   Error : CARDINAL;
   36   Desc : POINTER TO ARRAY [1..200] OF DBFieldDescriptor;
*****                               ^ not supported yet
*****                                       ^ not supported yet
   37  BEGIN
   38    ALLOCATE(Desc,  2 * SIZE(DBFieldDescriptor));
*****    ^ not supported yet
*****             ^ not supported yet
*****                        ^ undeclared identifier
*****                             ^ not supported yet
   39    Fill(Desc,   2 * SIZE(DBFieldDescriptor),0);
*****    ^ not supported yet
*****         ^ not supported yet
*****                     ^ undeclared identifier
*****                          ^ not supported yet
*****                                              ^ not supported yet
   40     MakeDescriptor(  Desc^[  1], 'TEST', 30,  0, 'C');
*****     ^ not supported yet
*****                      ^ not supported yet
*****                               ^ not supported yet
*****                                  ^ not supported yet
*****                                                     ^ not supported yet
   41     MakeDescriptor(  Desc^[  2], 'TEMP', 20,  0, 'C');
*****     ^ not supported yet
*****                      ^ not supported yet
*****                               ^ not supported yet
*****                                  ^ not supported yet
*****                                                     ^ not supported yet
   42     InitDBF('Test.DBF',TestDBF,0,FALSE,TRUE,FALSE,DefaultFixUp);
*****     ^ not supported yet
*****             ^ not supported yet
*****                        ^ undeclared identifier
*****                                                   ^ not supported yet
   43     (* It would be a good to test error.*)
   44     Error:=BuildDBF(Desc^,  2,TestDBF);
*****            ^ not supported yet
*****                     ^ not supported yet
*****                               ^ undeclared identifier
   45     CloseDBF(TestDBF);
*****     ^ not supported yet
*****              ^ undeclared identifier
   46   DEALLOCATE(Desc,  2 * SIZE(DBFieldDescriptor));
*****   ^ not supported yet
*****              ^ not supported yet
*****                         ^ undeclared identifier
*****                              ^ not supported yet
   47  END MakeDatabase;
*****      ^ not supported yet
   48   
   49  PROCEDURE MoveTestToDBF(Rec : TestRec ); 
*****                                ^ undeclared identifier
   50  (* This code will move the data from the record to *)
   51  (* the data base                                   *)
   52  BEGIN
   53    WITH Rec DO
*****         ^ not supported yet
   54      Replace( TestDBF,  1,TEST);    (*  *)
*****      ^ not supported yet
*****               ^ undeclared identifier
*****                           ^ undeclared identifier
   55      Replace( TestDBF,  2,TEMP);    (*  *)
*****      ^ not supported yet
*****               ^ undeclared identifier
*****                           ^ undeclared identifier
   56  END;  (* end of with REC *)
*****  ^ not supported yet
   57  END MoveTestToDBF;
*****      ^ not supported yet
   58  
   59  
   60  
   61  PROCEDURE MoveTestFromDBF(VAR Rec : TestRec ); 
*****                                      ^ undeclared identifier
   62  (* This code will move the data from the Database to *)
   63  (* the record                                        *)
   64  VAR B : BOOLEAN;
   65      R : Real8;
   66  BEGIN
   67    WITH Rec DO
*****         ^ not supported yet
   68      GetField( TestDBF,  1,TEST);   (*  *)
*****      ^ not supported yet
*****                ^ undeclared identifier
*****                            ^ undeclared identifier
   69      GetField( TestDBF,  2,TEMP);   (*  *)
*****      ^ not supported yet
*****                ^ undeclared identifier
*****                            ^ undeclared identifier
   70  END;  (* end of with REC^ *)
*****  ^ not supported yet
   71  END MoveTestFromDBF;
*****      ^ not supported yet
   72  
   73  
   74  
   75  PROCEDURE OpenTestDBF(WithIdx : BOOLEAN);
   76  VAR ER : CARDINAL;
   77  BEGIN
   78  
   79  IndexOpen := WithIdx;
   80  (* Open the DBF file *)
   81  IF NOT FileExists("Test.DBF")
*****         ^ not supported yet
*****                    ^ not supported yet
   82    THEN MakeDatabase();
*****         ^ not supported yet
*****                      ^ not supported yet
   83    END;
   84  InitDBF("Test.DBF", TestDBF,Buffer,Safty,Exclusive,
*****  ^ not supported yet
*****          ^ not supported yet
*****                      ^ undeclared identifier
*****                                     ^ not supported yet
*****                                           ^ not supported yet
   85           AutoLock,DefaultFixUp );
*****           ^ not supported yet
*****                    ^ not supported yet
   86   IF NOT OpenDBF( TestDBF)
*****          ^ not supported yet
*****                   ^ undeclared identifier
   87       THEN END;
   88  
   89  
   90  (* open all indexes and append to dbfile *)
   91  IF WithIdx THEN
   92  
   93    InitIndex( "Test.NDX",TestIdx,TestDBF,Buffer, Safty,
*****    ^ not supported yet
*****               ^ not supported yet
*****                          ^ undeclared identifier
*****                                  ^ undeclared identifier
*****                                                  ^ not supported yet
   94                  KeepDeleted,Exclusive);
*****                  ^ not supported yet
*****                              ^ not supported yet
   95   IF NOT OpenIndex( TestIdx )
*****          ^ not supported yet
*****                     ^ undeclared identifier
   96     THEN
   97      ER := BuildIndex(TestIdx,'Test'); (* check key lenght *)
*****            ^ not supported yet
*****                       ^ undeclared identifier
*****                               ^ not supported yet
   98     END;
   99   AddToUpdateList( TestDBF, TestIdx );
*****   ^ not supported yet
*****                    ^ undeclared identifier
*****                             ^ undeclared identifier
  100  
  101  
  102   ActTestIdx := TestIdx; (* make current index *)
*****   ^ undeclared identifier
*****                 ^ undeclared identifier
  103   GoTop(ActTestIdx);
*****   ^ not supported yet
*****         ^ undeclared identifier
  104    END; (* end with indext *)
  105  END OpenTestDBF;
*****      ^ not supported yet
  106  
  107  
  108  
  109  PROCEDURE CloseTestDBF ();   (* close Data and index files *)
  110  
  111  BEGIN
  112    CloseDBF(TestDBF);  (* close dbf file *)
*****    ^ not supported yet
*****             ^ undeclared identifier
  113    IF IndexOpen
  114      THEN
  115  
  116       CloseIndex(TestIdx ); (* close index file *)
*****       ^ not supported yet
*****                  ^ undeclared identifier
  117      END; (* end index open*)
  118  END CloseTestDBF;
*****      ^ not supported yet
  119  
  120  
  121  
  122  PROCEDURE FindTestByTest( Key : ARRAY OF CHAR) : BOOLEAN;
*****                                           ^ not supported yet
  123  VAR Found : BOOLEAN;
  124      CKey : ARRAY[0..80] OF CHAR;
*****                      ^ not supported yet
*****                             ^ not supported yet
  125  BEGIN
  126     ActTestIdx := TestIdx ;   (* make this index the active idx*)
*****     ^ undeclared identifier
*****                   ^ undeclared identifier
  127     FindPositionCh( TestIdx, Key, Found);
*****     ^ not supported yet
*****                     ^ undeclared identifier
*****                              ^ not supported yet
*****                                        ^ not supported yet
  128     CurrentKeyCh(TestIdx,CKey);
*****     ^ not supported yet
*****                  ^ undeclared identifier
*****                          ^ not supported yet
  129     Found := Present(Key,CKey,CaseSens);
*****              ^ not supported yet
*****                      ^ not supported yet
*****                          ^ not supported yet
*****                               ^ not supported yet
  130      IF Found
  131         THEN ReadDBRec( TestDBF, CurrentRec( TestIdx));
*****              ^ not supported yet
*****                         ^ undeclared identifier
*****                                  ^ not supported yet
*****                                              ^ undeclared identifier
  132     END;
  133     RETURN Found;
  134  END FindTestByTest;
*****      ^ not supported yet
  135  
  136  
  137  
  138  
  139  
  140  
  141  
  142  PROCEDURE NextTest () : BOOLEAN; 
  143  VAR
  144    L : LONGINT;    (* record number *)
  145  BEGIN
  146    IF  NextRecord( ActTestIdx,L)    
*****        ^ not supported yet
*****                    ^ undeclared identifier
*****                                ^ not supported yet
  147      THEN ReadDBRec( TestDBF,L  );  
*****           ^ not supported yet
*****                      ^ undeclared identifier
*****                                 ^ not supported yet
  148           RETURN TRUE;
  149      ELSE RETURN FALSE;
  150      END;
  151  END NextTest;
*****      ^ not supported yet
  152  
  153  PROCEDURE PrevTest () : BOOLEAN; 
  154  VAR
  155    L : LONGINT;    (* record number *)
  156  BEGIN
  157    IF  PrevRecord( ActTestIdx,L) 
*****        ^ not supported yet
*****                    ^ undeclared identifier
*****                                ^ not supported yet
  158      THEN ReadDBRec( TestDBF,L  );  
*****           ^ not supported yet
*****                      ^ undeclared identifier
*****                                 ^ not supported yet
  159           RETURN TRUE;
  160      ELSE RETURN FALSE;
  161      END; 
  162  END PrevTest;
*****      ^ not supported yet
  163  
  164  PROCEDURE FirstTest (); 
  165  VAR
  166    L : LONGINT;    (* record number *)
  167  BEGIN
  168    GoTop(ActTestIdx); 
*****    ^ not supported yet
*****          ^ undeclared identifier
  169    ReadDBRec( TestDBF,CurrentRec(  ActTestIdx));
*****    ^ not supported yet
*****               ^ undeclared identifier
*****                       ^ not supported yet
*****                                    ^ undeclared identifier
  170  END FirstTest;
*****      ^ not supported yet
  171  
  172  PROCEDURE LastTest (); 
  173  VAR
  174    L : LONGINT;    (* record number *)
  175  BEGIN
  176    GoBottom(ActTestIdx); 
*****    ^ not supported yet
*****             ^ undeclared identifier
  177    ReadDBRec( TestDBF,CurrentRec(  ActTestIdx));
*****    ^ not supported yet
*****               ^ undeclared identifier
*****                       ^ not supported yet
*****                                    ^ undeclared identifier
  178  END LastTest;
*****      ^ not supported yet
  179  PROCEDURE PackTest();
  180  VAR
  181    EM : CARDINAL;
  182    LI : LONGINT;
  183    Tmp : TestRec;
*****          ^ undeclared identifier
  184  BEGIN
  185    CloseTestDBF();
*****    ^ not supported yet
*****                 ^ not supported yet
  186    OpenTestDBF(FALSE);  (* open with no index *)
*****    ^ not supported yet
*****                     ^ not supported yet
  187    DBPack(TestDBF);
*****    ^ not supported yet
*****           ^ undeclared identifier
  188    CloseTestDBF();
*****    ^ not supported yet
*****                 ^ not supported yet
  189  
  190    EM := DeleteFile('Test');
*****          ^ not supported yet
*****                     ^ not supported yet
  191    OpenTestDBF(TRUE);  (* open to rebuild the indexes*)
*****    ^ not supported yet
*****                    ^ not supported yet
  192    CloseTestDBF();    
*****    ^ not supported yet
*****                 ^ not supported yet
  193  END PackTest;
*****      ^ not supported yet
  194  
  195  (* initialization code *)
  196  BEGIN
  197   NilDBF(TestDBF);
*****   ^ not supported yet
*****          ^ undeclared identifier
  198   IndexOpen := FALSE;
  199  
  200  END DBFTest.
*****      ^ not supported yet
  201  

  163 errors