Topspeed_JPI/TS-V3/MODBASE/DBSTUFF.LST

Listing:

    1  IMPLEMENTATION MODULE DBStuff;
    2  (*
    3   *  ModBase
    4   *  Release 3.0
    5   *  (c) Copyright 1986 - 1991 PMI
    6      Copyright 1988 - 1991 John McMonagle
    7   *  P.O. Box 8402
    8   *  Green Bay Wi 53308
    9   *  All Rights Reserved
   10   *  by Ed Ross
   11   *)
   12  
   13  FROM DBIndxes IMPORT DBIndex,GoTop,FindPositionCh,
   14       CurrentRec,CurrentKeyCh,NextRecord;
   15  FROM ModBase3 IMPORT DBFile,ReadDBRec,DeleteRecord,DBFieldDescriptor;     
   16  FROM StrConv IMPORT CardinalToStr;
   17  FROM ScrnTypes IMPORT DisplayFrame;
   18  FROM ControlUtils IMPORT ReadInput,ChangeField;
   19  FROM DateFunctions IMPORT Date,DateToStr,StrToDate;
   20  FROM GenLists IMPORT GenList,DisposeList,ListInsert,NewList,
   21                       GetElmt,ListInsertAdr,ListLength,Initialized;
   22  FROM StrEdit IMPORT CrunchBlanks,SetLength,Append,
   23       CAPstr,DeleteChar;
   24  FROM Str IMPORT Length,Compare,Copy;
   25  FROM PosUtils IMPORT Pos,Present;
   26  FROM LowLevel IMPORT Fill;
   27  FROM SYSTEM IMPORT ADR,SIZE,ADDRESS;
   28  FROM HandleIO IMPORT FileExists,OpenFile,SetFilePtr,CreateFile,BlockWrite,
   29       CloseHandle,BlockRead,FromStart;
   30  FROM StringIO IMPORT ErrorMessage;
   31       
   32  VAR
   33    CharSet : SET OF CHAR;
*****                     ^ not supported yet
   34    J : CHAR;
   35  
   36  PROCEDURE MakeDescriptor(VAR Desc : DBFieldDescriptor;
   37                           Name : ARRAY OF CHAR; Size : CARDINAL;
*****                                           ^ not supported yet
   38  			 Dec  : CARDINAL;Type : CHAR);
   39  BEGIN
   40    Fill(ADR(Desc),SIZE(Desc),0);
*****    ^ not supported yet
*****         ^ not supported yet
*****             ^ not supported yet
*****                   ^ not supported yet
*****                        ^ not supported yet
*****                               ^ not supported yet
   41    Copy(Desc.name , Name);
*****    ^ not supported yet
*****         ^ not supported yet
*****              ^ not supported yet
*****                     ^ not supported yet
   42    Desc.size := Size;
*****    ^ not supported yet
*****         ^ not supported yet
   43    Desc.decplaces := Dec;			
*****    ^ not supported yet
*****         ^ not supported yet
   44    Copy(Desc.fldtype , Type);
*****    ^ not supported yet
*****         ^ not supported yet
*****              ^ not supported yet
*****                            ^ not supported yet
   45  END MakeDescriptor;			 
*****      ^ not supported yet
   46  
   47  PROCEDURE MakeSeqNbr(SeqFile,  (* file name where seq kept -no extention *)
   48                       Prefix : ARRAY OF CHAR; (*key prefix "91-','C'*)
*****                                         ^ not supported yet
   49  	             VAR  Key : ARRAY OF CHAR); (* returned key *)
*****  	                                 ^ not supported yet
   50  	 
   51  
   52  VAR
   53   H : CARDINAL;
   54   Str : ARRAY [0..8] OF CHAR;
*****                   ^ not supported yet
*****                         ^ not supported yet
   55   Seq : CARDINAL;
   56   FileName : ARRAY[0..15] OF CHAR;	 
*****                       ^ not supported yet
*****                              ^ not supported yet
   57   EM : ErrorMessage;
   58   J : CARDINAL;
   59  BEGIN
   60    Copy(FileName , SeqFile);
*****    ^ not supported yet
*****         ^ not supported yet
*****                    ^ not supported yet
   61    CrunchBlanks(FileName);
*****    ^ not supported yet
*****                 ^ not supported yet
   62    IF Pos(FileName,'.') < HIGH(FileName)+1
*****       ^ not supported yet
*****           ^ not supported yet
*****                       ^ not supported yet
*****                           ^ undeclared identifier
*****                                ^ not supported yet
   63      THEN SetLength(FileName,Pos(FileName,'.'));
*****           ^ not supported yet
*****                     ^ not supported yet
*****                              ^ not supported yet
*****                                  ^ not supported yet
*****                                              ^ not supported yet
   64      END;
   65    Append(FileName,'Seq');
*****    ^ not supported yet
*****           ^ not supported yet
*****                    ^ not supported yet
   66    IF FileExists(FileName)
*****       ^ not supported yet
*****                  ^ not supported yet
   67      THEN
   68        EM := OpenFile(H,FileName);
*****        ^ not supported yet
*****              ^ not supported yet
*****                         ^ not supported yet
   69        EM := BlockRead(H,ADR(Seq),SIZE(Seq));
*****        ^ not supported yet
*****              ^ not supported yet
*****                          ^ not supported yet
*****                                 ^ not supported yet
*****                                   ^ not supported yet
*****                                           ^ not supported yet
   70        SetFilePtr(H,FromStart,0);
*****        ^ not supported yet
*****                     ^ not supported yet
*****                                ^ not supported yet
   71      ELSE
   72        EM := CreateFile(H,FileName);   (* initialize seq number *)
*****        ^ not supported yet
*****              ^ not supported yet
*****                           ^ not supported yet
   73        Seq := 999;      
   74      END;
   75      INC(Seq);
*****      ^ undeclared identifier
*****             ^ not supported yet
   76      EM := BlockWrite(H,ADR(Seq),SIZE(Seq)); (* update the file *)
*****      ^ not supported yet
*****            ^ not supported yet
*****                         ^ not supported yet
*****                                ^ not supported yet
*****                                  ^ not supported yet
*****                                          ^ not supported yet
   77      EM := CloseHandle(H);
*****      ^ not supported yet
*****            ^ not supported yet
*****                         ^ not supported yet
   78      CardinalToStr(Seq,5,Str);
*****      ^ not supported yet
*****                          ^ not supported yet
   79      Copy(Key , Prefix);
*****      ^ not supported yet
*****           ^ not supported yet
*****                 ^ not supported yet
   80      FOR J := 0 TO Length(Str) DO
*****                    ^ not supported yet
*****                           ^ not supported yet
   81        IF Str[J] = ' '
*****           ^ not supported yet
*****                ^ not supported yet
   82          THEN Str[J] := '0';
*****               ^ not supported yet
*****                    ^ not supported yet
   83  	END;
   84        END;	
   85      Append(Key,Str);
*****      ^ not supported yet
*****             ^ not supported yet
*****                 ^ not supported yet
   86      MakeKey(Key);
*****      ^ undeclared identifier
*****              ^ not supported yet
   87  END MakeSeqNbr;
*****      ^ not supported yet
   88  
   89  
   90  PROCEDURE MakeKey(VAR Key : ARRAY OF CHAR);
*****                                       ^ not supported yet
   91  VAR J : CARDINAL;
   92      L : CARDINAL;
   93   BEGIN
   94     CAPstr(Key);
*****     ^ not supported yet
*****            ^ not supported yet
   95     L := Length(Key);
*****          ^ not supported yet
*****                 ^ not supported yet
   96     IF L > 0
   97       THEN
   98         DEC(L);
*****         ^ undeclared identifier
*****              ^ not supported yet
   99       END;  
  100     FOR J := 0 TO L DO
  101       IF NOT (Key[J] IN CharSet)
*****               ^ not supported yet
*****                    ^ not supported yet
*****                         ^ not supported yet
  102         THEN Key[J] := ' ';
*****              ^ not supported yet
*****                   ^ not supported yet
  103         END;
  104     END;  
  105     DeleteChar(' ',Key);
*****     ^ not supported yet
*****                    ^ not supported yet
  106  
  107  END MakeKey;    
*****      ^ not supported yet
  108  
  109  
  110  
  111  
  112  PROCEDURE ReadDateField( DF : DisplayFrame; VAR D : Date; 
  113                          FldName : ARRAY OF CHAR);
*****                                             ^ not supported yet
  114  VAR
  115   S : ARRAY [0..15] OF CHAR;
*****                 ^ not supported yet
*****                        ^ not supported yet
  116   Ok : BOOLEAN;
  117  BEGIN
  118   ReadInput(DF,S,FldName);
*****   ^ not supported yet
*****             ^ not supported yet
*****                ^ not supported yet
*****                  ^ not supported yet
  119   StrToDate(S,D,Ok);
*****   ^ not supported yet
*****             ^ not supported yet
*****               ^ not supported yet
*****                   ^ not supported yet
  120  END ReadDateField;
*****      ^ not supported yet
  121  
  122  PROCEDURE ChangeDateField(VAR DF : DisplayFrame; D : Date; 
  123                            FldName : ARRAY OF CHAR);
*****                                               ^ not supported yet
  124  VAR
  125    S : ARRAY[0..15] OF CHAR;
*****                 ^ not supported yet
*****                        ^ not supported yet
  126    B : BOOLEAN;
  127  BEGIN
  128    DateToStr(D,S,B);
*****    ^ not supported yet
*****              ^ not supported yet
*****                ^ not supported yet
*****                   ^ not supported yet
  129    ChangeField(DF,S,FldName,TRUE);
*****    ^ not supported yet
*****                ^ not supported yet
*****                   ^ not supported yet
*****                     ^ not supported yet
*****                                 ^ not supported yet
  130  END ChangeDateField;   
*****      ^ not supported yet
  131  
  132  
  133  
  134  PROCEDURE ReadAllRecs(VAR DBF : DBFile; ReadProc :ReadRec; VAR TheList : GenList);
*****                                                    ^ undeclared identifier
  135  
  136  VAR
  137   TmpList : GenList;
  138   LI : LONGINT;
  139   J : CARDINAL;
  140   Code : CARDINAL;
  141   RecAddr : ADDRESS;
  142   Size : CARDINAL;
  143  BEGIN
  144   NewList(TmpList);
*****   ^ not supported yet
*****           ^ not supported yet
  145   FOR J := 1 TO ListLength(TheList) DO
*****                 ^ not supported yet
*****                            ^ not supported yet
  146     GetElmt(TheList,J,LI,Code);
*****     ^ not supported yet
*****             ^ not supported yet
*****                              ^ not supported yet
  147     ReadDBRec(DBF,LI);
*****     ^ not supported yet
*****               ^ not supported yet
*****                     ^ not supported yet
  148     ReadProc(RecAddr,Size);
*****     ^ not supported yet
*****              ^ not supported yet
*****                          ^ not supported yet
  149     ListInsertAdr(RecAddr,Size,1,TmpList,J)
*****     ^ not supported yet
*****                   ^ not supported yet
*****                                  ^ not supported yet
*****                                           ^ not supported yet
  150   END;
  151   DisposeList(TheList);
*****   ^ not supported yet
*****               ^ not supported yet
  152   TheList := TmpList;  
*****   ^ not supported yet
*****              ^ not supported yet
  153   
  154  END ReadAllRecs;
*****      ^ not supported yet
  155  
  156  PROCEDURE DeleteAllRecs(VAR DBF : DBFile; TheList : GenList);
  157  VAR
  158    LI : LONGINT;
  159    J : CARDINAL;
  160    Code : CARDINAL;
  161  BEGIN
  162   FOR J := 1 TO ListLength(TheList) DO
*****                 ^ not supported yet
*****                            ^ not supported yet
  163     GetElmt(TheList,J,LI,Code);
*****     ^ not supported yet
*****             ^ not supported yet
*****                              ^ not supported yet
  164     ReadDBRec(DBF,LI);  (* position data file *)
*****     ^ not supported yet
*****               ^ not supported yet
*****                     ^ not supported yet
  165     DeleteRecord(DBF);
*****     ^ not supported yet
*****                  ^ not supported yet
  166   END;  
  167  END DeleteAllRecs;  
*****      ^ not supported yet
  168  		      
  169  PROCEDURE FindAll(Idx : DBIndex; KeyExp : ARRAY OF CHAR;
*****                                                     ^ not supported yet
  170  		  Condition : ConditionType;                  
*****  		              ^ undeclared identifier
  171  		  VAR TheList : GenList );
  172  		  
  173  VAR
  174    B : BOOLEAN;	
  175    Str : ARRAY[0..80] OF CHAR;	  
*****                   ^ not supported yet
*****                          ^ not supported yet
  176    Cond : INTEGER;
  177    CRec : LONGINT;
  178  BEGIN
  179    IF Initialized(TheList)
*****       ^ not supported yet
*****                   ^ not supported yet
  180      THEN
  181        DisposeList(TheList);
*****        ^ not supported yet
*****                    ^ not supported yet
  182      END;  
  183    NewList(TheList);
*****    ^ not supported yet
*****            ^ not supported yet
  184    CASE Condition OF 
*****         ^ not supported yet
  185        LT,LE         : GoTop(Idx);
*****        ^ undeclared identifier
*****           ^ undeclared identifier
*****                        ^ not supported yet
*****                              ^ not supported yet
  186                     B := TRUE;
  187       |EQ,BeginsWith,GE : FindPositionCh(Idx,KeyExp,B);
*****        ^ undeclared identifier
*****           ^ undeclared identifier
*****                      ^ undeclared identifier
*****                           ^ not supported yet
*****                                          ^ not supported yet
*****                                              ^ not supported yet
*****                                                      ^ not supported yet
  188    END; (* end case of *)
  189    IF Condition = BeginsWith
*****       ^ not supported yet
*****                   ^ undeclared identifier
  190      THEN
  191        CurrentKeyCh(Idx,Str);    (* get the current key *) 
*****        ^ not supported yet
*****                     ^ not supported yet
*****                         ^ not supported yet
  192        B := (Pos(KeyExp,Str) = 0)
*****              ^ not supported yet
*****                  ^ not supported yet
*****                         ^ not supported yet
  193      END;
  194    IF NOT B
  195      THEN RETURN; 
  196      END;
  197  
  198    LOOP
  199     CurrentKeyCh(Idx,Str);    (* get the current key *)
*****     ^ not supported yet
*****                  ^ not supported yet
*****                      ^ not supported yet
  200     Cond := Compare(KeyExp,Str);  (* do it here so I do it only once*)
*****             ^ not supported yet
*****                     ^ not supported yet
*****                            ^ not supported yet
  201     CASE Condition OF
*****          ^ not supported yet
  202       LT : IF Cond = 1
*****       ^ undeclared identifier
  203            THEN
  204  	    EXIT;   (* done with this loop *)
  205            END;      
  206      |LE : IF Cond < 1
*****       ^ undeclared identifier
  207              THEN
  208                ListInsert(CurrentRec(Idx),1,TheList,1);  (* put in front of the list*)
*****                ^ not supported yet
*****                           ^ not supported yet
*****                                      ^ not supported yet
*****                                             ^ not supported yet
*****                                                      ^ not supported yet
  209  	    END;  
  210      |EQ : IF Cond = 0
*****       ^ undeclared identifier
  211              THEN
  212    	      ListInsert(CurrentRec(Idx),1,TheList,1);  (* put in front of the list*)
*****    	      ^ not supported yet
*****    	                 ^ not supported yet
*****    	                            ^ not supported yet
*****    	                                   ^ not supported yet
*****    	                                            ^ not supported yet
  213              ELSE
  214  	      EXIT;
  215  	   END;
  216      |GE  : IF Cond >= 0	      	    
*****       ^ undeclared identifier
  217                THEN
  218  	        ListInsert(CurrentRec(Idx),1,TheList,1);  (* put in front of the list*)
*****  	        ^ not supported yet
*****  	                   ^ not supported yet
*****  	                              ^ not supported yet
*****  	                                     ^ not supported yet
*****  	                                              ^ not supported yet
  219      	      END;	
  220      |BeginsWith :
*****       ^ undeclared identifier
  221             IF Pos(KeyExp,Str) = 0
*****                ^ not supported yet
*****                    ^ not supported yet
*****                           ^ not supported yet
  222  	     THEN
  223    	       ListInsert(CurrentRec(Idx),1,TheList,1);  (* put in front of the list*)	  
*****    	       ^ not supported yet
*****    	                  ^ not supported yet
*****    	                             ^ not supported yet
*****    	                                    ^ not supported yet
*****    	                                             ^ not supported yet
  224  	     ELSE
  225  	       EXIT;
  226  	    END;   
  227      |Contains  : IF Present(KeyExp,Str)
*****       ^ undeclared identifier
*****                      ^ not supported yet
*****                              ^ not supported yet
*****                                     ^ not supported yet
  228                    THEN
  229  		   ListInsert(CurrentRec(Idx),1,TheList,1); 
*****  		   ^ not supported yet
*****  		              ^ not supported yet
*****  		                         ^ not supported yet
*****  		                                ^ not supported yet
*****  		                                         ^ not supported yet
  230  		  END;
  231     END;    (* end of case condition of *)
  232     CRec := CurrentRec(Idx);   
*****             ^ not supported yet
*****                        ^ not supported yet
  233     IF NOT NextRecord(Idx, CRec)	   
*****            ^ not supported yet
*****                       ^ not supported yet
*****                                ^ not supported yet
  234       THEN
  235         EXIT;
  236       END;  
  237    END;  (* end of loop *)         	    
  238  
  239     
  240  END FindAll;	
*****      ^ not supported yet
  241  
  242  BEGIN
  243    CharSet := CharSet / CharSet;
*****    ^ not supported yet
*****               ^ not supported yet
*****                         ^ not supported yet
  244    FOR J := 'A' TO 'Z'  DO
*****        ^ FOR needs integer variable and bounds
*****             ^ FOR needs integer variable and bounds
*****                    ^ FOR needs integer variable and bounds
  245     INCL ( CharSet,J);
*****     ^ undeclared identifier
*****            ^ not supported yet
*****                     ^ not supported yet
  246     END;  
  247    FOR J := '0' TO '9' DO
*****        ^ FOR needs integer variable and bounds
*****             ^ FOR needs integer variable and bounds
*****                    ^ FOR needs integer variable and bounds
  248     INCL(CharSet,J);
*****     ^ undeclared identifier
*****          ^ not supported yet
*****                   ^ not supported yet
  249     END; 
  250   INCL(CharSet,'-');   
*****   ^ undeclared identifier
*****        ^ not supported yet
*****                   ^ not supported yet
  251   INCL(CharSet,'&');
*****   ^ undeclared identifier
*****        ^ not supported yet
*****                   ^ not supported yet
  252   INCL(CharSet,'!');
*****   ^ undeclared identifier
*****        ^ not supported yet
*****                   ^ not supported yet
  253   INCL(CharSet,'?');
*****   ^ undeclared identifier
*****        ^ not supported yet
*****                   ^ not supported yet
  254  	  
  255  END DBStuff.
*****      ^ not supported yet
  256  

  272 errors